VB 与ACCESS的图片保存读取方案  二进制保存和用数据库保存图片路径再读取代码块


这是我直接指定路径实现的
 Image1.Picture = LoadPicture("D:\资产管理系统\Image\a.JPG", vbLPLarge, vbLPColor)
我想给每一条记录都有图片，上传保存，怎么实现！

PropertyBag class
谢谢。自己查吧。

二进制保存：直接读取付值
保存路径：调用文件

Private Sub xuan_Click()
cd1.DialogTitle = "添加房客的相片"
    cd1.Filter = "图片文件(*.gif;*.jpg;*.png)|*.jpg;*.gif;*.png|所有文件(*.*)|*.*"
    cd1.ShowOpen
    If Len(cd1.FileName) Then
       Labelph.Caption = cd1.FileName
       Labelph.Visible = False
         
         
         Picture1.Picture = LoadPicture(Labelph.Caption)
End If

End Sub

Private Sub zeng_Click()
gai.Enabled = False
shan.Enabled = False
If frm_fangke.fkid.Text = Empty Then
MsgBox "请输入数字作为房客编号", vbCritical, "提示"
Exit Sub
frm_fangke.fkid.SetFocus
End If
If Len(frm_fangke.fkid.Text) > 6 Then
MsgBox "房客编号不能大于6位数字", vbCritical, "提示"
Exit Sub
frm_fangke.fkid.SetFocus
End If
If frm_fangke.fkxm.Text = Empty Then
MsgBox "房客姓名不能为空", vbCritical, "提示"
frm_fangke.fkxm.SetFocus
End If
If Len(frm_fangke.fkxm.Text) > 5 Then
MsgBox "房客姓名不得大于5个字符", vbCritical, "提示!"
Exit Sub
frm_fangke.fkxm.SetFocus
End If
If frm_fangke.sfid.Text = Empty Then
MsgBox "身份证号码不能为空", vbCritical, "提示!"
Exit Sub
frm_fangke.sfid.SetFocus
End If
If Len(frm_fangke.sfid.Text) < 18 Then
MsgBox "身份证位数不够，正确的应该是18位的", vbCritical, "提示!"
Exit Sub
frm_fangke.sfid.SetFocus
End If
If Len(frm_fangke.sfid.Text) > 18 Then
MsgBox "身份证号码不能大于18位", vbCritical, "提示!"
Exit Sub
frm_fangke.sfid.SetFocus
End If
If frm_fangke.bz.Text = "" Then
MsgBox "备注没有填写", vbCritical, "提示!"
Exit Sub
frm_fangke.bz.SetFocus
End If

Call opencn
Dim mst As ADODB.Stream

Set mst = New ADODB.Stream
strSQl = "select * from 房客"
rslogin.Open strSQl, cn, dOpenKeyset, adLockOptimistic
If frm_fangke.Labelph.Caption = "" Then

MsgBox "请先添加房客相片", vbInformation + vbYesNo, "提示"
Exit Sub
Else

mst.Type = adTypeBinary
    mst.Open
    mst.LoadFromFile Labelph.Caption

rslogin.AddNew
rslogin.Fields("房客ID") = Trim(frm_fangke.fkid.Text)
rslogin.Fields("性别") = frm_fangke.cbo1.Text
rslogin.Fields("身份证号") = Trim(frm_fangke.sfid.Text)
rslogin.Fields("房客姓名") = Trim(frm_fangke.fkxm.Text)
rslogin.Fields("入住日期") = frm_fangke.DT1.Value
rslogin.Fields("期满日") = frm_fangke.DT2.Value
rslogin.Fields("备注") = Trim(frm_fangke.bz.Text)
rslogin.Fields("相片").Value = mst.Read

rslogin.Update
MsgBox "数据保存成功!", vbCritical, "恭喜你!"
End If





End Sub

BITMAP的二进制流存放的

看看这个绝对行

谢谢分享!!!!!!!!!!!

呵呵，缺这个呢

谢谢分享