📄 frmmain.frm
字号:
Left = 180
TabIndex = 30
Top = 3000
Width = 255
End
Begin VB.Label Label7
Caption = "地址:"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 255
Left = 120
TabIndex = 24
Top = 2280
Width = 495
End
Begin VB.Label Label6
Caption = "通迅:"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 255
Left = 120
TabIndex = 23
Top = 1920
Width = 495
End
Begin VB.Label Label5
Caption = "大小:"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 255
Left = 120
TabIndex = 21
Top = 1560
Width = 495
End
Begin VB.Label lable5
Caption = "图号:"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 255
Left = 120
TabIndex = 19
Top = 1200
Width = 495
End
Begin VB.Image MyImage
BorderStyle = 1 'Fixed Single
Height = 1710
Left = 2520
Stretch = -1 'True
Top = 120
Width = 2175
End
Begin VB.Label Label4
Caption = "描述:"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 255
Left = 120
TabIndex = 8
Top = 2640
Width = 495
End
Begin VB.Label Label3
Caption = "日期:"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 255
Left = 120
TabIndex = 7
Top = 840
Width = 495
End
Begin VB.Label Labe2
Caption = "作者:"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 255
Left = 120
TabIndex = 5
Top = 480
Width = 495
End
Begin VB.Label Label1
Caption = "名称:"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 255
Left = 120
TabIndex = 3
Top = 120
Width = 495
End
Begin VB.Menu mnuAction
Caption = "操作"
Begin VB.Menu mnuActionAdd
Caption = "增加图档"
End
Begin VB.Menu mnuActionEdit
Caption = "编辑图档"
End
Begin VB.Menu mnuActionDel
Caption = "删除图档"
End
Begin VB.Menu mnuActionClear
Caption = "清空图档"
End
Begin VB.Menu mnuActionBar0
Caption = "-"
End
Begin VB.Menu mnuPasModify
Caption = "修改密码"
End
Begin VB.Menu mnuUserSet
Caption = "用户设置"
End
Begin VB.Menu mnuActionBar1
Caption = "-"
End
Begin VB.Menu mnuActionQuit
Caption = "退出"
End
End
Begin VB.Menu mnuFind
Caption = "查找"
Begin VB.Menu mnuFindFindFirst
Caption = "首次查找"
End
Begin VB.Menu mnuFindFindNext
Caption = "查找下一个"
End
Begin VB.Menu mnuFindFindPre
Caption = "查找上一个"
End
End
Begin VB.Menu mnuHelp
Caption = "帮助"
Begin VB.Menu mnuHelpSee
Caption = "帮助"
End
Begin VB.Menu mnuHelpAbout
Caption = "关于"
End
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Dim picfilename As String '载入的图片文件名
Dim seefilename As String '查看图片的临时文件名
Public reload As Boolean '是否要重新导入图片
Private Sub Label2_Click()
mnuHelpAbout_Click
End Sub
Private Sub mnuActionAdd_Click()
Add_Click
End Sub
Private Sub mnuActionClear_Click()
Clear_Click
End Sub
Private Sub mnuActionDel_Click()
Delete_Click
End Sub
Private Sub mnuActionEdit_Click()
Edit_Click
End Sub
Private Sub mnuActionQuit_Click()
Unload Me
End Sub
Private Sub mnuFindFindFirst_Click()
FindFirst_Click
End Sub
Private Sub mnuFindFindNext_Click()
FindNext_Click
End Sub
Private Sub mnuFindFindPre_Click()
FindPre_Click
End Sub
Private Sub mnuHelpAbout_Click()
Dim dlg As New frmAbout
dlg.Show vbModal, Me
End Sub
'设置状态条第一格文字
Private Sub SetStatusText(text As String)
sbStatusBar.Panels(1).text = text
End Sub
'当前数据改变
Private Sub Data1_Reposition()
If reload = True Then
Dim pos As Long
pos = Data1.Recordset.AbsolutePosition
'如果存在记录
If pos >= 0 And pos < Data1.Recordset.RecordCount Then
'将数据字段保存为临时文件，将有image控件显示
Dim filename As String
filename = App.Path + "\pic.tmp"
FieldToFileStream filename, Data1.Recordset.Fields("数据")
MyImage.Picture = LoadPicture(filename)
End If
picfilename = ""
'设置状态条
sbStatusBar.Panels(2).text = Str$(Data1.Recordset.AbsolutePosition + 1) + "/" + Str$(Data1.Recordset.RecordCount())
End If
End Sub
'相关数据控件置空
Function cleardata()
PicName.text = ""
Outhor.text = ""
PicDate.text = ""
Des.text = ""
PicCode.text = ""
PicSize.text = ""
Address.text = ""
Commucation.text = ""
PicName.DataChanged = False
Outhor.DataChanged = False
PicDate.DataChanged = False
Des.DataChanged = False
PicCode.DataChanged = False
PicSize.DataChanged = False
Address.DataChanged = False
Commucation.DataChanged = False
picfilename = ""
MyImage.Picture = LoadPicture("")
End Function
Private Sub Add_Click()
If Len(PicName.text) = 0 Then
SetStatusText ("请输入名称.")
MsgBox "名称不能为空!"
Exit Sub
End If
If Len(PicDate.text) > 0 And IsDate(PicDate.text) = 0 Then
SetStatusText ("日期格式无效,请输入2000-10-10的格式.")
MsgBox "无效的日期格式!"
Exit Sub
End If
If isnumber(PicCode.text) = 0 Then
SetStatusText ("图号不能为空，而且必须是数字.")
MsgBox "图号只能是数字!"
Exit Sub
End If
reload = False
Dim s0, s1, s2, s3, s4, s5, s6, s7, s8 As String
s0 = picfilename
s1 = PicName.text
s2 = Outhor.text
s3 = PicDate.text
s4 = Des.text
s5 = PicCode.text
s6 = PicSize.text
s7 = Commucation.text
s8 = Address.text
PicName.DataChanged = False
Outhor.DataChanged = False
PicDate.DataChanged = False
Des.DataChanged = False
PicCode.DataChanged = False
PicSize.DataChanged = False
Commucation.DataChanged = False
Address.DataChanged = False
Dim temp As String
temp = picfilename
Dim fit As String
fit = "图号="
fit = fit + PicCode.text
'保存当前记录号以便更新失败时恢复
Dim mark As Long
mark = Data1.Recordset.AbsolutePosition
Data1.Recordset.FindFirst fit
If Data1.Recordset.NoMatch = False Then
SetStatusText ("图号已存在,请输入另一个图号")
Data1.Recordset.Requery
Data1.Recordset.Move mark
MsgBox "图号已存在!"
reload = True
Exit Sub
End If
If MyImage.Picture.Handle = 0 Then
SetStatusText ("您还没有选择图片，在图片显示框中单击选择.")
MsgBox "请选择图片!"
reload = True
Exit Sub
End If
Data1.Recordset.AddNew
picfilename = s0
PicName.text = s1
Outhor.text = s2
PicDate.text = s3
Des.text = s4
PicCode.text = s5
PicSize.text = s6
Commucation.text = s7
Address.text = s8
picfilename = temp
If Len(picfilename) <> 0 Then
FileStreamToField Data1.Recordset.Fields("数据"), picfilename
Else
FileStreamToField Data1.Recordset.Fields("数据"), App.Path + "\pic.tmp"
End If
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -