Jump to content

Welcome to [ iT ] Forums
Register now to gain access to all of our features. Once registered and logged in, you will be able to create topics, post replies to existing threads, give reputation to your fellow members, get your own private messenger, post status updates, manage your profile and so much more. If you already have an account, login here - otherwise create an account for free today!
MU Moi ra - MU SS2

MU Moi ra - MU Co Xua



Hình ảnh

Hướng Dẫn Học VB 6.0 Qua Các Ví Dụ


  • Please log in to reply
1 reply to this topic

#1
PhươngĐiệp2410

PhươngĐiệp2410

    Thạc sĩ CSTH

  • VIP
  • PipPipPipPipPip
  • 1917 Bài Viết:
Trong Bài Topic này các bạn có thể post những bài làm hay một đoạn code rõ ràng và đầy đủ dùng để thực hiện một thao tác nào đó trong VB 6.0 . Mình mong chúng ta có thể cùng giúp đỡ nhau tiến bộ và tạo ra một thư viện code phong phú trong topic này .
Thân! :-&
http://winsocks.net/

Are You looking for a good socks 5 service? But you don't know where to buy?
Welcome to WinSocks.Net - Crazy Socks Service
Here we provide Fresh Socks 5 with fast speed , less blacklist, especially price is cheaper than others service.
More over, if you want to test our socks 5 before buying, don't be hesitate to contact our supporter through yahoo to receive Free Socks 5

#2
PhươngĐiệp2410

PhươngĐiệp2410

    Thạc sĩ CSTH

  • VIP
  • PipPipPipPipPip
  • 1917 Bài Viết:

Bài 1: Lưu Ảnh Và Lấy Ảnh Từ Access 2003

Chú ý: Để lưu ảnh và hiển thị nó lên thì theo mình biết sẽ có hai cách làm, cách thứ nhất là bạn sẽ lưu đường dẫn của file ảnh đó trong máy của mình và cách thứ hai là bạn dùng kiểu dữ liệu OLE Object trong Access và lưu trực tiếp ảnh vào đó dưới dạng các con số nhị phân. Cách làm thứ hai tuy khó hơn nhưng nó sẽ giúp bạn thiết kế một chương trình có độ bảo mật tốt hơn và không mất dữ liệu khi máy tính bị xoá file ảnh đó hay là sẽ bị nhầm khi người dùng xáo trộn các tên của các file ảnh cho nhau ...

Code mình lấy từ nhiều nguồn và của mình :jeje:

Thân! :-&


Bước 1: Bạn tạo một Project mới và chọn Project > References sau đó chọn vào những phần còn thiếu để giống như sau :

Posted Image

Bạn tạo giao diện giống như sau trong VB 6.0 - Bạn chọn một hình ảnh trong thuộc tính Picture của control Image

Posted Image

Tạo Bảng Sau Trong Access (Cơ sở dữ liệu của mình tên là "aa.mdb")

Posted Image

Bươc 2: Bạn thêm vào một Module bằng cách chuột phải vào Project > Add > Module
Sau đó bạn thêm dòng code sau trong Module1

Option Explicit
	'
	' Copyright © 1997-1999 Brad Martinez, http://www.mvps.org
	'
	Public Enum CBoolean   ' enum members are Long data types
	  CFalse = 0
	  CTrue = 1
	End Enum
	
	Public Const S_OK = 0	' indicates successful HRESULT
	
	'WINOLEAPI CreateStreamOnHGlobal(
	'	HGLOBAL hGlobal,			// Memory handle for the stream object
	'	BOOL fDeleteOnRelease,  // Whether to free memory when the object is released
	'	LPSTREAM * ppstm		   // Indirect pointer to the new stream object
	');
	Declare Function CreateStreamOnHGlobal Lib "ole32" _
								  (ByVal hGlobal As Long, _
								  ByVal fDeleteOnRelease As CBoolean, _
								  ppstm As Any) As Long
	
	'STDAPI OleLoadPicture(
	'	IStream * pStream,  // Pointer to the stream that contains picture's data
	'	LONG lSize,			// Number of bytes read from the stream
	'	BOOL fRunmode,   // The opposite of the initial value of the picture's property
	'	REFIID riid,			 // Reference to the identifier of the interface describing the type
	'								   // of interface pointer to return
	'	VOID ppvObj		  // Indirect pointer to the object, not AddRef'd!!
	');
	Declare Function OleLoadPicture Lib "olepro32" _
								  (pStream As Any, _
								  ByVal lSize As Long, _
								  ByVal fRunmode As CBoolean, _
								  riid As GUID, _
								  ppvObj As Any) As Long
	
	Public Type GUID	' 16 bytes (128 bits)
	  dwData1 As Long	  ' 4 bytes
	  wData2 As Integer	 ' 2 bytes
	  wData3 As Integer	 ' 2 bytes
	  abData4(7) As Byte   ' 8 bytes, zero based
	End Type
	
	Declare Function CLSIDFromString Lib "ole32" (ByVal lpsz As Any, pclsid As GUID) As Long
	
	Public Const sIID_IPicture = "{7BF80980-BF32-101A-8BBB-00AA00300CAB}"
	
	Public Const GMEM_MOVEABLE = &H2
	Declare Function GlobalAlloc Lib "kernel32" (ByVal uFlags As Long, ByVal dwBytes As Long) As Long
	Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
	Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
	Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
	
	Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal dwLength As Long)
	
	' ====================================================================
	
	Public Const MAX_PATH = 260
	
	Public Type OPENFILENAME  '  ofn
	  lStructSize As Long
	  hWndOwner As Long
	  hInstance As Long
	  lpstrFilter As String
	  lpstrCustomFilter As String
	  nMaxCustFilter As Long
	  nFilterIndex As Long
	  lpstrFile As String
	  nMaxFile As Long
	  lpstrFileTitle As String
	  nMaxFileTitle As Long
	  lpstrInitialDir As String
	  lpstrTitle As String
	  Flags As Long
	  nFileOffset As Integer
	  nFileExtension As Integer
	  lpstrDefExt As String
	  lCustData As Long
	  lpfnHook As Long
	  lpTemplateName As String
	End Type
	
	' OPENFILENAME Flags
	Public Const OFN_HIDEREADONLY = &H4
	Public Const OFN_FILEMUSTEXIST = &H1000
	
	Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
	'
	
	Public Function PictureFromFile(hwnd As Long, Optional sFile As String = "") As StdPicture
	  Dim ofn As OPENFILENAME
	  Dim ff As Integer
	  Dim abFile() As Byte
	  
	  ' If a file's path is not specified show the dialog.
	  If (Len(sFile) = 0) Then
		With ofn
		  .lStructSize = Len(ofn)
		  .hWndOwner = hwnd
		  .lpstrFilter = "All Picture Files" & vbNullChar & "*.bmp;*.dib;*.gif;*.jpg;*.wmf;*.emf;*.ico;*.cur" & vbNullChar & _
							 "Bitmaps (*.bmp;*.dib)" & vbNullChar & "*.bmp;*.dib" & vbNullChar & _
							 "GIF Images (*.gif)" & vbNullChar & "*.gif" & vbNullChar & _
							 "JPEG Images (*.jpg)" & vbNullChar & "*.jpg" & vbNullChar & _
							 "Metafiles (*.wmf;*.emf)" & vbNullChar & "*.wmf;*.emf" & vbNullChar & _
							 "Icons (*.ico;*.cur)" & vbNullChar & "*.ico;*.cur" & vbNullChar & _
							 "All Files (*.*)" & vbNullChar & "*.*" & vbNullChar & vbNullChar
		  .lpstrFile = String$(MAX_PATH, 0)
		  .nMaxFile = MAX_PATH
		  .Flags = OFN_HIDEREADONLY Or OFN_FILEMUSTEXIST
		End With
	  
		If GetOpenFileName(ofn) Then
		  sFile = Left$(ofn.lpstrFile, InStr(ofn.lpstrFile, vbNullChar) - 1)
		End If
	  End If
	  
	  ' If we have a file path, load it into a byte array and try to make
	  ' a picture out of it...
	  If Len(sFile) Then
		ff = FreeFile
		Open sFile For Binary As ff
		ReDim abFile(LOF(ff) - 1)
		Get #ff, , abFile
		Close ff
		
		Set PictureFromFile = PictureFromBits(abFile)
	  End If
	  
	End Function
	
	Public Function PictureFromBits(abPic() As Byte) As IPicture  ' not a StdPicture!!
	  Dim nLow As Long
	  Dim cbMem  As Long
	  Dim hMem  As Long
	  Dim lpMem  As Long
	  Dim IID_IPicture As GUID
	  Dim istm As stdole.IUnknown '  IStream
	  Dim ipic As IPicture
	  
	  ' Get the size of the picture's bits
	  On Error GoTo Out
	  nLow = LBound(abPic)
	  On Error GoTo 0
	  cbMem = (UBound(abPic) - nLow) + 1
	  
	  ' Allocate a global memory object
	  hMem = GlobalAlloc(GMEM_MOVEABLE, cbMem)
	  If hMem Then
		
		' Lock the memory object and get a pointer to it.
		lpMem = GlobalLock(hMem)
		If lpMem Then
		  
		  ' Copy the picture bits to the memory pointer and unlock the handle.
		  MoveMemory ByVal lpMem, abPic(nLow), cbMem
		  Call GlobalUnlock(hMem)
		  
		  ' Create an ISteam from the pictures bits (we can explicitly free hMem
		  ' below, but we'll have the call do it...)
		  If (CreateStreamOnHGlobal(hMem, CTrue, istm) = S_OK) Then
			If (CLSIDFromString(StrPtr(sIID_IPicture), IID_IPicture) = S_OK) Then
			  
			  ' Create an IPicture from the IStream (the docs say the call does not
			  ' AddRef its last param, but it looks like the reference counts are correct..)
			  Call OleLoadPicture(ByVal ObjPtr(istm), cbMem, CFalse, IID_IPicture, PictureFromBits)
			  
			End If   ' CLSIDFromString
		  End If   ' CreateStreamOnHGlobal
		End If   ' lpMem
		
	'	Call GlobalFree(hMem)
	  End If   ' hMem
		  
	Out:
	End Function

Bước 3: Bạn thêm hai hàm sau trong chương trình để dùng cho nút Save .

Public Function cnx() As ADODB.Connection
		Set cnx = New ADODB.Connection
		cnx.CursorLocation = adUseClient
		cnx.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=aa.mdb;Persist Security Info=False"
	End Function

Public Function GetPictureBytes(ByVal imgFigure As StdPicture, ByVal p_FileName As String) As Byte()
		Dim imgByte()   As Byte
		Dim nPos		As Long
		Dim FileNum	 As Integer
	
	'	Kill p_FileName
		SavePicture imgFigure, p_FileName
		FileNum = FreeFile
		Open p_FileName For Binary Access Read As FileNum
		ReDim imgByte(LOF(1))
		nPos = 0
		While (Not EOF(1))
			Get FileNum, nPos + 1, imgByte(nPos)
			nPos = nPos + 1
		Wend
		Close FileNum
	
	'	Kill p_FileName
		GetPictureBytes = imgByte
	End Function

Bước 4: Code cho nút Save

Private Sub cmdSave_Click()
	Dim Success As Boolean
		Dim adoR		As ADODB.Recordset
		Dim imgByte()   As Byte
		
		Success = False
		imgByte = GetPictureBytes(ImageSave.Picture, "C:\Documents and Settings\PhuongDiep2410\Desktop\TestImageVB\5.jpg")
		Set adoR = New ADODB.Recordset
		
		With adoR
			.Open "Select * From TestImage", cnx, adOpenKeyset, adLockOptimistic
			.AddNew
			.Fields("ID") = "1"
			.Fields("Image") = imgByte
			.Update
			.Close
			Success = True
		End With
	If (Success) Then
		MsgBox "OK :D"
	End If
	
	End Sub

Bước 5: Code cho nút Load

Private Sub cmdLoad_Click()
	Dim rs As ADODB.Recordset
	Set rs = New ADODB.Recordset
	Dim arBytes() As Byte
	Dim strSource As String
	Dim strConnection As String
	
	strSource = "Select Image From TestImage"
	strConnection = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=aa.mdb;Persist Security Info=False"
	
	rs.Open strSource, strConnection, adOpenForwardOnly, adLockReadOnly, adCmdText
	If rs.EOF Then
		rs.Close
		Set rs = Nothing
	End If
	
	arBytes() = rs(0).GetChunk(rs(0).ActualSize)
	ImageLoad.Picture = PictureFromBits(arBytes())
	rs.Close
	Set rs = Nothing
	
	End Sub

Bài viết này được chỉnh sửa bởi PhươngĐiệp2410: 21 September 2009 - 06:45 AM

http://winsocks.net/

Are You looking for a good socks 5 service? But you don't know where to buy?
Welcome to WinSocks.Net - Crazy Socks Service
Here we provide Fresh Socks 5 with fast speed , less blacklist, especially price is cheaper than others service.
More over, if you want to test our socks 5 before buying, don't be hesitate to contact our supporter through yahoo to receive Free Socks 5






Mu Mới ra - Mu Phục Sinh

Balloon vs. Thorns

MU Phuc Hung

Làm Việc Tài Nhà

Mu Da Nang

Tuyển Nhân Viên Bán Hàng

Tư vấn sức khỏe trực tuyến