📄 form1.frm
字号:
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "Comdlg32.ocx"
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 7950
ClientLeft = 60
ClientTop = 450
ClientWidth = 6000
BeginProperty Font
Name = "宋体"
Size = 7.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
LinkTopic = "Form1"
ScaleHeight = 7950
ScaleWidth = 6000
StartUpPosition = 3 '窗口缺省
Begin VB.TextBox Txtname
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 720
TabIndex = 12
Top = 5760
Width = 735
End
Begin VB.TextBox TxtSex
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 2160
TabIndex = 11
Top = 5760
Width = 855
End
Begin VB.TextBox TxtAddr
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 3960
TabIndex = 10
Top = 5760
Width = 1815
End
Begin VB.CommandButton Command2
Caption = "导入Word"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 1920
TabIndex = 9
Top = 7200
Width = 855
End
Begin VB.CommandButton CmdExit
Caption = "退出"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 2880
TabIndex = 8
Top = 7200
Width = 855
End
Begin VB.CommandButton Cmddel
Caption = "删除"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 1080
TabIndex = 7
Top = 7200
Width = 735
End
Begin VB.CommandButton Cmdadd
Caption = "添加"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 240
TabIndex = 6
Top = 7200
Width = 735
End
Begin VB.CommandButton Cmdlast
Caption = "最后条"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 2760
TabIndex = 5
Top = 6600
Width = 735
End
Begin VB.CommandButton Cmdnext
Caption = "下一条"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 1920
TabIndex = 4
Top = 6600
Width = 735
End
Begin VB.CommandButton Cmdpre
Caption = "上一条"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 1080
TabIndex = 3
Top = 6600
Width = 735
End
Begin VB.CommandButton cmdfirst
Caption = "第一条"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 240
TabIndex = 2
Top = 6600
Width = 735
End
Begin VB.CommandButton Command1
Caption = "..."
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 5280
TabIndex = 1
Top = 6120
Width = 450
End
Begin VB.TextBox Text1
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 270
Left = 240
TabIndex = 0
Top = 6120
Width = 4935
End
Begin MSComDlg.CommonDialog dlg1
Left = 720
Top = 2880
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.Label Label1
Caption = "姓名"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 240
TabIndex = 15
Top = 5760
Width = 615
End
Begin VB.Label Label2
Caption = "性别"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 1800
TabIndex = 14
Top = 5760
Width = 495
End
Begin VB.Label Label3
Caption = "家庭住址"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 3120
TabIndex = 13
Top = 5760
Width = 975
End
Begin VB.Image Image1
BorderStyle = 1 'Fixed Single
Height = 5535
Left = 240
Stretch = -1 'True
Top = 120
Width = 5535
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim Cn As New ADODB.Connection
Dim Rec As New ADODB.Recordset
Dim coun As Integer
Dim id As Integer
Dim temp As String
Public Sub ConnSQL()
Dim connstr As String
Dim strPath As String
strPath = App.Path + "\DbPic.mdb"
'connstr = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=Picture;Data Source=HUJUN"
connstr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strPath & ";Persist Security Info=False"
Cn.Open connstr
'Rec.Open "pic", Cn, adOpenStatic, adLockOptimistic
'Rec.MoveFirst
End Sub
'功能:把文件输入到流中
Public Sub File2Stream(strFile As String, ByRef adofld As ADODB.Field)
Dim strContent As New ADODB.Stream
With strContent
.Mode = adModeReadWrite '可读写模式
.Type = adTypeBinary '二进制格式
.Open
.LoadFromFile strFile '把文件导入流
End With
adofld.Value = strContent.Read()
strContent.Close
'Rec.Close
'Cn.Close
End Sub
'功能:把流中数据输入到文件
Public Sub Stream2File(strFile As String, ByRef adofld As ADODB.Field)
Dim strContent As New ADODB.Stream
With strContent
.Mode = adModeReadWrite '可读写模式
.Type = adTypeBinary '二进制格式
.Open
End With
strContent.Write (adofld.Value)
strContent.SaveToFile strFile
strContent.Close
End Sub
Private Sub Cmdadd_Click()
Rec.AddNew
Rec.Fields("姓名") = Txtname.Text
Rec.Fields("性别") = TxtSex.Text
Rec.Fields("家庭住址") = TxtAddr.Text
File2Stream dlg1.FileName, Rec.Fields("照片")
Rec.Update
MsgBox "添加图片成功！"
End Sub
Private Sub CmdExit_Click()
Rec.Close
Cn.Close
Unload Me
End Sub
Private Sub cmdfirst_Click()
Rec.MoveFirst
Stream2File temp, Rec.Fields("pic")
Image1.Picture = LoadPicture(temp)
Kill temp
id = 1
End Sub
Private Sub Cmdlast_Click()
Rec.MoveLast
Stream2File temp, Rec.Fields("pic")
Image1.Picture = LoadPicture(temp)
Kill temp
id = coun
cmdfirst.Enabled = True
End Sub
Private Sub Cmdnext_Click()
cmdfirst.Enabled = True
If id < coun Then
Rec.MoveNext
Stream2File temp, Rec.Fields("照片")
Image1.Picture = LoadPicture(temp)
Kill temp
id = id + 1
Else
Cmdnext.Enabled = False
End If
End Sub
Private Sub Cmdpre_Click()
If id > 1 Then
Rec.MovePrevious
Stream2File temp, Rec.Fields("pic")
Image1.Picture = LoadPicture(temp)
Kill temp
id = id - 1
Else
Cmdpre.Enabled = False
End If
End Sub
Private Sub Command1_Click()
With dlg1
.Filter = "JPG 文件|*.jpg|BMP 文件|*.bmp"
.ShowOpen
End With
If dlg1.FileName = "" Then Exit Sub
Image1.Picture = LoadPicture(dlg1.FileName)
End Sub
'使用select * 无法查找到记录数量，rec.recordcount值始终为１，故用两种方法分开做
Private Sub Form_Load()
Dim strSQL As String
temp = App.Path + "\photo"
strSQL = "select count(*) from pic"
ConnSQL
Rec.Open strSQL, Cn, adOpenStatic, adLockOptimistic
If Rec.Fields(0).Value < 1 Then
MsgBox "数据库中没有图片！"
' Exit Sub
End If
coun = Rec.Fields(0).Value
Rec.Close
strSQL = "select * from pic"
Rec.Open strSQL, Cn, adOpenStatic, adLockOptimistic
Stream2File temp, Rec.Fields("照片")
Image1.Picture = LoadPicture(temp)
Txtname.Text = Rec.Fields("姓名")
TxtSex.Text = Rec.Fields("性别")
TxtAddr.Text = Rec.Fields("家庭住址")
cmdfirst.Enabled = False
id = 1
Kill temp
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -