展开全部
Dim i As Integer
Dim str As String
Dim conn As ADODB.Connection
Dim iStm As ADODB.Stream
Dim iRe As ADODB.Recordset
Dim n As Integer
Private Sub Form_Load()
'‘----------------------------
Picture1.Picture = LoadPicture(App.Path + "\界面素材\加载图片.jpg")
str = "Provider=SQLOLEDB;data Source= 192.168.12.67 ; Initial Catalog=服装销售32313133353236313431303231363533e4b893e5b19e31333330346533系统;User Id= sa ;Password= 5332852 "
Set conn = New ADODB.Connection
conn.Open str
n = Val(Trim(Text1.Text))
End Sub
Sub SaveFile() '定义读入图片程序
On Error Resume Next '重复保存同一幅图片会出错提示,忽略,保持程序运行的流畅性。
Set iStm = New ADODB.Stream '读取文件到内容
Dim sFile As String
'数据库支持PNG图片,但VB的image、picture控件不支持PNG格式的图片。
CommonDialog1.Filter = "JPG|*.jpg|位图|*.bmp|GIF|*.gif"
CommonDialog1.ShowOpen
If CommonDialog1.FileName = "" Then
Exit Sub
End If
sFile = CommonDialog1.FileName
Picture1.Picture = LoadPicture(sFile) '把图片显示到图片框(Pictrure1)
With iStm
.Type = adTypeBinary '数据类型为二进制数
.Open
.LoadFromFile "" & sFile & "" '保存图片
End With
End Sub
Sub ReadFile() '定义读出图片程序
If Trim(Text1.Text) = "" Then
MsgBox "图片编号为空", vbInformation, "提示"
Exit Sub
End If
Set iRe = New ADODB.Recordset
iRe.Open "select * from img where 编号=" & n, conn, adOpenKeyset, adLockReadOnly '注意此处数值型参数n的语法形式
On Error GoTo Err
Set iStm = New ADODB.Stream
With iStm
.Mode = adModeReadWrite
.Type = adTypeBinary
.Open
.Write iRe("photo") '读取图片字段数据
.SaveToFile App.Path & "\temp1.jpg" '保存图片。注意,图片也可以保存为其他格式。
End With
Picture1.Picture = LoadPicture(App.Path & "\temp1.jpg") '读取图片到图片框(Pictrure1)
iRe.Close '关闭对象
iStm.Close
Kill App.Path & "\temp1.jpg" '删除临时文件
Exit Sub
Err:
MsgBox "此图片编号不存在", vbInformation, "提示"
End Sub
Private Sub Command1_Click() '读入图片
Call ReadFile
End Sub
Private Sub Command2_Click() '读出图片
Call SaveFile
End Sub
Private Sub Command3_Click() '图片另存
If Trim(Text1.Text) = "" Then
MsgBox "图片编号为空", vbInformation, "提示"
Exit Sub
End If
If Picture1.Picture = 0 Then
MsgBox "图片为空,请读出图片", vbInformation, "提示"
Exit Sub
End If
Set iRe = New ADODB.Recordset
iRe.Open "select * from img where 编号=" & n, conn, adOpenKeyset, adLockReadOnly
Set iStm = New ADODB.Stream
If iRe("photo").ActualSize = 0 Then '注意判断语句
MsgBox "相片为空,请重新选择!", vbInformation, "提示"
Exit Sub '退出
End If
CommonDialog1.Filter = "JPG|*.jpg|GIF|*.gif|位图|*.bmp"
CommonDialog1.ShowSave
If CommonDialog1.FileName = "" Then
Exit Sub
End If
sFile = CommonDialog1.FileName
On Error GoTo Err '利用出错提示进行删除保存操作(类似于覆盖)
With iStm
.Mode = adModeReadWrite
.Type = adTypeBinary
.Open
.Write iRe("photo") '读取图片字段数据
.SaveToFile sFile '保存到路径
Exit Sub
End With
Err:
Dim Result As Integer
Result = MsgBox("文件名重复,请重新输入新的文件名。否则,将覆盖源文件!", vbYesNo + vbInformation, "提示")
If Result = vbYes Then
Kill sFile '先删除,后保存。
iStm.Write iRe("photo")
iStm.SaveToFile sFile
End If
End Sub
Private Sub Command5_Click()
Set iRe = New ADODB.Recordset '打开保存文件的表
Dim P As String
P = MsgBox("添加成功!是否保存?", vbQuestion + vbOKCancel, "系统消息")
If P = vbOK Then
With iRe
.Open "Select * from A人员信息 WHERE 工号='" + Text2 + "'", conn, adOpenKeyset, adLockOptimistic
.Fields("图片") = iStm.Read 'iStm把载入的图片传递给iRe.Fields("photo"):img表的photo字段
.Update
End With
Else
Picture1.Picture = LoadPicture(App.Path + "\界面素材\加载图片.jpg")
End If
End Sub
Private Sub Form_Unload(Cancel As Integer) '退出
conn.Close
Set conn = Nothing
End Sub
已赞过
已踩过<
你对这个回答的评价是?
评论
收起