Private Sub LoadPictureFromDB(cn As ADODB.Connection) '载数据库中读出BMP图片 On Error GoTo EH Dim strTemp As String Set stm = New ADODB.Stream strTemp = "c:\temp.tmp" '临时文件,用来保存读出的图片 rs.Open "select ImagePath,ImageValue from tbl_image", cn, , , adCmdText With stm .Type = adTypeBinary .Open .Write rs("ImageValue") .SaveToFile strTemp, adSaveCreateOverWrite .Close End With Image1.Picture = LoadPicture(strTemp) Set stm = Nothing rs.Close Set rs = Nothing Exit Sub EH: MsgBox Err.Description, vbInformation, "Error" End Sub
Dim cn As New ADODB.Connection, rs As New ADODB.Recordset'保存 Private Sub Command1_Click() Dim bteContent() As Byte
Open "C:\aa.bmp" For Binary Access Read As #1 bteContent = InputB(LOF(1), #1) Close #1
If rs.State = adStateOpen Then rs.Close rs.Open "select * from tablename", cn, adOpenDynamic, adLockPessimistic rs.AddNew rs!Name = "张三" rs!AGE = 22 rs!SEX = "男" rs.Fields("PHOTO").AppendChunk bteContent rs.Update
Erase bteContent End Sub'打开 Private Sub Command2_Click() Dim bteContent() As Byte If rs.State = adStateOpen Then rs.Close rs.Open "select * from tablename", cn, adOpenForwardOnly, adLockReadOnly bteContent = rs.Fields("PHOTO").GetChunk(rs.Fields("PHOTO").ActualSize) Open "C:\aa.bmp" For Binary Access Write As #1 Put #1, , bteContent Close #1 Image1.Picture = LoadPicture("C:\aa.bmp") End SubPrivate Sub Form_Load() On Error GoTo Errhandle cn.ConnectionString = "Driver={SQL Server};SERVER=DataServer;DATABASE=zxzx;UID=information;PWD=information*&#" cn.Open
Exit Sub Errhandle: MsgBox Err.Description, vbExclamation End SubPrivate Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) On Error Resume Next rs.Close Set rs = Nothing cn.Close Set cn = Nothing End Sub
上面的各位兄弟,我已以解决啦其实不要那们烦! dim cn as new adodb.connection dim rs as new adodb.recordset . . .... set image1.datasource=rs image1.datafield="图片" 这样就ok啦!~
'载数据库中读出BMP图片
On Error GoTo EH
Dim strTemp As String
Set stm = New ADODB.Stream
strTemp = "c:\temp.tmp" '临时文件,用来保存读出的图片
rs.Open "select ImagePath,ImageValue from tbl_image", cn, , , adCmdText
With stm
.Type = adTypeBinary
.Open
.Write rs("ImageValue")
.SaveToFile strTemp, adSaveCreateOverWrite
.Close
End With
Image1.Picture = LoadPicture(strTemp)
Set stm = Nothing
rs.Close
Set rs = Nothing
Exit Sub
EH: MsgBox Err.Description, vbInformation, "Error"
End Sub
Private Sub Command1_Click()
Dim bteContent() As Byte
Open "C:\aa.bmp" For Binary Access Read As #1
bteContent = InputB(LOF(1), #1)
Close #1
If rs.State = adStateOpen Then rs.Close
rs.Open "select * from tablename", cn, adOpenDynamic, adLockPessimistic
rs.AddNew
rs!Name = "张三"
rs!AGE = 22
rs!SEX = "男"
rs.Fields("PHOTO").AppendChunk bteContent
rs.Update
Erase bteContent
End Sub'打开
Private Sub Command2_Click()
Dim bteContent() As Byte
If rs.State = adStateOpen Then rs.Close
rs.Open "select * from tablename", cn, adOpenForwardOnly, adLockReadOnly
bteContent = rs.Fields("PHOTO").GetChunk(rs.Fields("PHOTO").ActualSize) Open "C:\aa.bmp" For Binary Access Write As #1
Put #1, , bteContent
Close #1
Image1.Picture = LoadPicture("C:\aa.bmp")
End SubPrivate Sub Form_Load()
On Error GoTo Errhandle
cn.ConnectionString = "Driver={SQL Server};SERVER=DataServer;DATABASE=zxzx;UID=information;PWD=information*&#"
cn.Open
Exit Sub
Errhandle:
MsgBox Err.Description, vbExclamation
End SubPrivate Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
On Error Resume Next
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub
dim cn as new adodb.connection
dim rs as new adodb.recordset
.
.
....
set image1.datasource=rs
image1.datafield="图片"
这样就ok啦!~