Hướng Dẫn Học VB 6 ppt

Hướng Dẫn Học VB 6.0 Qua Các Ví Dụ Code - Tutorial - VB 6.0 #1 PhươngĐiệp2410 • Nhóm:VIP • Bài Viết:1917 • Gia Nhập:08-March 07 • • Thạc sĩ CSTH • Gửi vào 21 September 2009 - 05:47 AM 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! <div align='center'><! coloro:#008080 ><span style="color:#008080"><! /coloro ><i><b><! sizeo:5 ><span style="font-size:18pt;line-height:100%"><! /sizeo ><a href="http://winsocks.net/" target="_blank">http://winsocks.net/</a> <! sizec ></span><! /sizec ></b></i><! colorc ></span><! /colorc ><! sizeo:3 ><span style="font- size:12pt;line-height:100%"><! /sizeo ><! coloro:#0000ff ><span style="color:#0000ff"><! /coloro ><b>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.</b><! colorc ></span><! /colorc ><! sizec ></span><! /sizec > <! sizeo:3 ><span style="font- size:12pt;line-height:100%"><! /sizeo ><! coloro:#0000ff ><span style="color:#0000ff"><! /coloro ><b><i>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</i></b><! colorc ></span><! /colorc ><! sizec ></span><! /sizec > </div> 0 #2 PhươngĐiệp2410 • Nhóm:VIP • Bài Viết:1917 • Gia Nhập:08-March 07 • • Thạc sĩ CSTH • Gửi vào 21 September 2009 - 05:48 AM 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 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 : 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 Tạo Bảng Sau Trong Access (Cơ sở dữ liệu của mình tên là "aa.mdb") 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 . Hướng Dẫn Học VB 6. 0 Qua Các Ví Dụ Code - Tutorial - VB 6. 0 #1 PhươngĐiệp2410 • Nhóm:VIP • Bài Viết:1917 • Gia Nhập:08-March. "*.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