این کدها را امتحان کنید :
Instructions: Copy the declarations and code below and paste directly into your VB project.
Declarations:
Option Explicit
Const MAX_PATH = 255
Private Declare Function GetTempPath Lib "kernel32" _
Alias "GetTempPathA" (ByVal nBufferLength As Long, _
ByVal lpBuffer As String) As Long
Code:
Public Function SavePictureToDB(PictControl As Object, _
RS As Object, FieldName As String) As Boolean
'PURPOSE: SAVES PICTURE IN IMAGEBOX, PICTUREBOX, OR SIMILAR
'CONTROL TO RECORDSET RS IN FIELD NAME FIELDNAME
'FIELD TYPE MUST BE BINARY (OLE OBJECT IN ACCESS)
'SAMPLE USAGE
'Dim sConn As String
'Dim oConn As New ADODB.Connection
'Dim oRs As New ADODB.Recordset
'
'
'sConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\MyDb.MDB;Persist Security Info=False"
'
'oConn.Open sConn
'oRs.Open "SELECT * FROM MYTABLE", oConn, adOpenKeyset, _
adLockOptimistic
'oRs.AddNew
'SavePictureToDB Picture1, oRs, "MYFIELD"
'oRs.Update
'oRs.Close
Dim oPict As StdPicture
Dim sDir As String
Dim sTempFile As String
Dim iFileNum As Integer
Dim lFileLength As Long
Dim abBytes() As Byte
Dim iCtr As Integer
On Error GoTo ErrorHandler
If Not TypeOf RS Is ADODB.Recordset Then Exit Function
Set oPict = PictControl.Picture
If oPict Is Nothing Then Exit Function
'Save picture to temp file
sDir = GetTempDir
If sDir = "" Then sDir = "C:\"
sTempFile = sDir & "0X2341KLZX.dat"
SavePicture oPict, sTempFile
'read file contents to byte array
iFileNum = FreeFile
Open sTempFile For Binary Access Read As #iFileNum
lFileLength = LOF(iFileNum)
ReDim abBytes(lFileLength)
Get #iFileNum, , abBytes()
'put byte array contents into db field
RS.Fields(FieldName).AppendChunk abBytes()
Close #iFileNum
'Don't return false if file can't be deleted
On Error Resume Next
Kill sTempFile
SavePictureToDB = True
ErrorHandler:
End Function
Public Function LoadPictureFromDB(PictControl As Object, _
RS As Object, FieldName As String) As Boolean
'PURPOSE: LOADS PICTURE, SAVED AS BINARY DATA IN RECORDSET RS,
'FIELD FieldName TO PICTUREBOX, IMAGEBOX (OR CONTROL
'WITH SIMILAR INTERFACE)
'SAMPLE USAGE
'Dim sConn As String
'Dim oConn As New ADODB.Connection
'Dim oRs As New ADODB.Recordset
'
'
'sConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\MyDb.MDB;Persist Security Info=False"
'
'oConn.Open sConn
'oRs.Open "SELECT * FROM MyTable", oConn, adOpenKeyset,
' adLockOptimistic
'LoadPictureFromDB Picture1, oRs, "MyFieldName"
'oRs.Close
Dim oPict As StdPicture
Dim sDir As String
Dim sTempFile As String
Dim iFileNum As Integer
Dim lFileLength As Long
Dim abBytes() As Byte
Dim iCtr As Integer
On Error GoTo ErrorHandler
If Not TypeOf RS Is ADODB.Recordset Then Exit Function
sDir = GetTempDir
If sDir = "" Then sDir = "C:\"
sTempFile = sDir & "0X2341KLZX.dat"
If Len(Dir$(sTempFile)) > 0 Then
Kill sTempFile
End If
iFileNum = FreeFile
Open sTempFile For Binary As #iFileNum
lFileLength = LenB(RS(FieldName))
abBytes = RS(FieldName).GetChunk(lFileLength) ;
Put #iFileNum, , abBytes()
Close #iFileNum
PictControl.Picture = LoadPicture(sTempFile)
Kill sTempFile
LoadPictureFromDB = True
ErrorHandler:
End Function
Private Function GetTempDir() As String
Dim sRet As String, lngLen As Long
'create buffer
sRet = String(MAX_PATH, 0)
lngLen = GetTempPath(MAX_PATH, sRet)
If lngLen = 0 Then Exit Function
GetTempDir = Left$(sRet, lngLen)
End Function
از این اکتیوایکس هم میتوانید استفاده کنید که راه سادهتری هست :
قوانین ایجاد تاپیک در تالار
پاسخ با نقل قول