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="
target="_blank"> /><! 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,
'
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