如有错误或你有更好的方法，请说出，大家一起讨论，呵呵。。。。
首先创建保存图片的SQL数据库，如下：
表明为image. 注意descrition的长度最好定义长一点，因为他是保存路径，不过这个字段也可以删掉不要（不会影响效果），不过要改下程序。呵呵。
代码： 连接数据库的代码偶就不写了。呵呵。 代码中有注释
初始界面如下：
Private Sub cboId_Click() ' 点击下拉框选择时从数据库提取图片
Call getImage
End Sub
Private Sub cmdChoose_Click()
dlgMain.Filter = "JPEG(*.jpg)|*.jpg|位图(*.bmp)|*.bmp|GIT(*.gif)|*.gif|所有文件|*.*" ' 设定打开文件类型
dlgMain.FilterIndex = 4
dlgMain.ShowOpen
txtPath.Text = dlgMain.FileName ' 获得路径
If txtPath.Text = Empty Then
MsgBox "请选择路径"
cmdSave.Value = False
Exit Sub
Else
imgShow.Picture = LoadPicture(txtPath.Text) ' 按路径加载图片
cmdSave.Visible = True
End If
End Sub
Private Sub cmdExit_Click()
End
End Sub
Private Sub cmdSave_Click() ' 保存图片到SQL
On Error GoTo SaveErr
Dim lngFile As Long
Dim lngCh As Long
Dim rgbArray() As Byte ' 用来存储图片的二进制代码
Dim str As String
lngFile = FileLen(txtPath.Text) ' 获得图片大小
ReDim rgbArray(lngFile) ' 动态分配内存，用来存储图片
lngCh = FreeFile
Open txtPath.Text For Binary As #lngCh
Get #lngCh, , rgbArray ' 获得图片的二进制代码
Close #lngCh
str = "select * from image where id = " & cboId.Text
Set Rs = New ADODB.Recordset
Rs.Open str, Conn, adOpenStatic, adLockOptimistic, -1
If Rs.BOF = False Then
Rs.Fields(0) = cboId.Text ' 存储图片ID
Rs.Fields(1).Value = rgbArray ' 存储图片二进制代码
Rs.Fields(2).Value = txtPath.Text ' 存储图片路径
Rs.Fields(3).Value = Dir(txtPath.Text, vbNormal + vbReadOnly) ' 获得图片名，不是路径
Rs.Update
Else
Rs.AddNew
Rs.Fields(0) = cboId.Text
Rs.Fields(1).Value = rgbArray
Rs.Fields(2).Value = txtPath.Text
Rs.Fields(3).Value = Dir(txtPath.Text, vbNormal + vbReadOnly)
Rs.Update
End If
Rs.Close
txtPath.Text = Empty
Exit Sub
SaveErr:
MsgBox Err.Number & Err.Description
End Sub
Private Sub Form_Load()
cmdSave.Visible = False
cboId.AddItem 1
cboId.AddItem 2
cboId.AddItem 3
cboId.AddItem 4
cboId.AddItem 5
cboId.AddItem 6
cboId.AddItem 7
cboId.AddItem 8
cboId.AddItem 9
cboId.AddItem 10
cboId.ListIndex = 0
End Sub
Public Function getImage() As Boolean ' 判断点击列表框时该id是否存有图片，有显示，无则不显示
On Error GoTo getErr
If RunSQL("Select * from image where id = " & cboId.Text) = False Then ' 当没有图片时则退出
imgShow.Picture = LoadPicture("")
Exit Function
End If
Dim rgbArray() As Byte
Dim lngCh As Long
Dim str As String
lngCh = FreeFile
Open App.Path & "/" & Rs.Fields(3) For Binary As #lngCh ' 打开一个路径，用来保存从SQL得到的图片
ReDim rgbArray(Rs.Fields(1).ActualSize) ' 动态分配内存，用来存储从SQL中得来的图片
rgbArray = Rs.Fields(1).Value ' 获得SQL中的图片
Put #lngCh, , rgbArray ' 创建从SQL中得来的图片
imgShow.Picture = LoadPicture(App.Path & "/" & Rs.Fields(3)) ' 显示图片
Close #lngCh
getImage = True
Exit Function
getErr:
MsgBox Err.Number & Err.Description
getImage = False
End Function
演示：当我点击下拉框选择时，如果该选项有图片则显示图片，无则不显示图片。
此时选项2无图片，则可以按“选择文件”选择图片，再按“保存到数据库”按钮将图片以下拉框的值为ID保存到SQL数据库。 如下：
现在，如果下拉框选择3时，由于3没有保存图片，则不会显示图片。再选2时，由于刚才保存了图片到数据库，所以就会显示刚才的图片。 也可以更换图片，既更换2的图片。偶就不演示了。呵呵。
评论