给一个vb的例子给你
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim stm As ADODB.StreamPrivate Sub SavePictureToDB(cn As ADODB.Connection)
'将BMP图片存入数据库
On Error GoTo EH
Set stm = New ADODB.Stream
rs.Open "select ImagePath,ImageValue from tbl_Image", cn, adOpenKeyset, adLockOptimistic
CommonDialog1.ShowOpen
Text1.Text = CommonDialog1.FileName
With stm
.Type = adTypeBinary
.Open
.LoadFromFile CommonDialog1.FileName
End With
With rs
.AddNew
.Fields("ImagePath") = Text1.Text
.Fields("ImageValue") = stm.Read
.Update
End With
rs.Close
Set rs = Nothing
Exit Sub
EH: MsgBox Err.Description, vbInformation, "Error"
End Sub
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
image类型
用picture显示
'以下两个函数是从数据库中读出图片的核心程序Public Function GetImage(Optional Filename As String) As Variant
On Error GoTo ProcErr Dim objRS As adodb.Recordset
Dim strSQL As String
Dim Chunk() As Byte
Set objRS = New adodb.Recordset
'strSQL = "select thumb from tblpictures where idpict='" & tblID(ThumbIndex) & "'"
strSQL = "select thumb from tblpictures where idpict= " & thumb
'strSQL = "select thumb from tblpictures where idpict='387'"
'db.Execute strSQL
objRS.Open strSQL, db, adOpenForwardOnly, adLockReadOnly
If objRS.BOF And objRS.EOF Then
GetImage = 0
GoTo ProcExit
ElseIf IsNull(objRS.Fields(0)) Then
'ErrNumber = 1001
'ErrDesc = "字段为空"
GoTo ProcExit
End If
Chunk() = objRS.Fields(0).GetChunk(objRS.Fields(0).ActualSize)
Set GetImage = Chunk2Image(Chunk(), Filename)ProcExit:
On Error Resume Next
'objRS.Close
' Chunk() = objRS.Fields(0).GetChunk(0)
Set GetImage = Chunk2Image(Chunk(), Filename)
' Set objRS = Nothing Exit FunctionProcErr:
GetImage = 0
Resume ProcExit
End Function
Private Function Chunk2Image(Chunk() As Byte, Optional Filename As String) As Variant
On Error GoTo ProcErr
Dim KeepFile As Boolean
Dim Datafile As Integer KeepFile = True
If Trim(Filename) = "" Then
Filename = "c:\tmpxxdb.fil"
KeepFile = False
End If Datafile = FreeFile
Open Filename For Binary Access Write As Datafile
Put Datafile, , Chunk()
Close DatafileProcExit:
Set Chunk2Image = LoadPicture(Filename)
On Error Resume Next
' If Not KeepFile Then Kill filename
Exit FunctionProcErr:
On Error Resume Next
Kill Filename
Chunk2Image = 0
End Function
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim stm As ADODB.StreamPrivate Sub SavePictureToDB(cn As ADODB.Connection)
'将BMP图片存入数据库
On Error GoTo EH
Set stm = New ADODB.Stream
rs.Open "select ImagePath,ImageValue from tbl_Image", cn, adOpenKeyset, adLockOptimistic
CommonDialog1.ShowOpen
Text1.Text = CommonDialog1.FileName
With stm
.Type = adTypeBinary
.Open
.LoadFromFile CommonDialog1.FileName
End With
With rs
.AddNew
.Fields("ImagePath") = Text1.Text
.Fields("ImageValue") = stm.Read
.Update
End With
rs.Close
Set rs = Nothing
Exit Sub
EH: MsgBox Err.Description, vbInformation, "Error"
End Sub
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
image类型
用picture显示
'以下两个函数是从数据库中读出图片的核心程序Public Function GetImage(Optional Filename As String) As Variant
On Error GoTo ProcErr Dim objRS As adodb.Recordset
Dim strSQL As String
Dim Chunk() As Byte
Set objRS = New adodb.Recordset
'strSQL = "select thumb from tblpictures where idpict='" & tblID(ThumbIndex) & "'"
strSQL = "select thumb from tblpictures where idpict= " & thumb
'strSQL = "select thumb from tblpictures where idpict='387'"
'db.Execute strSQL
objRS.Open strSQL, db, adOpenForwardOnly, adLockReadOnly
If objRS.BOF And objRS.EOF Then
GetImage = 0
GoTo ProcExit
ElseIf IsNull(objRS.Fields(0)) Then
'ErrNumber = 1001
'ErrDesc = "字段为空"
GoTo ProcExit
End If
Chunk() = objRS.Fields(0).GetChunk(objRS.Fields(0).ActualSize)
Set GetImage = Chunk2Image(Chunk(), Filename)ProcExit:
On Error Resume Next
'objRS.Close
' Chunk() = objRS.Fields(0).GetChunk(0)
Set GetImage = Chunk2Image(Chunk(), Filename)
' Set objRS = Nothing Exit FunctionProcErr:
GetImage = 0
Resume ProcExit
End Function
Private Function Chunk2Image(Chunk() As Byte, Optional Filename As String) As Variant
On Error GoTo ProcErr
Dim KeepFile As Boolean
Dim Datafile As Integer KeepFile = True
If Trim(Filename) = "" Then
Filename = "c:\tmpxxdb.fil"
KeepFile = False
End If Datafile = FreeFile
Open Filename For Binary Access Write As Datafile
Put Datafile, , Chunk()
Close DatafileProcExit:
Set Chunk2Image = LoadPicture(Filename)
On Error Resume Next
' If Not KeepFile Then Kill filename
Exit FunctionProcErr:
On Error Resume Next
Kill Filename
Chunk2Image = 0
End Function
解决方案 »
免费领取超大流量手机卡,每月29元包185G流量+100分钟通话, 中国电信官方发货