📄 frmmain.frm
字号:
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.MDIForm frmMain
BackColor = &H8000000C&
Caption = "仓库物流管理"
ClientHeight = 2400
ClientLeft = 165
ClientTop = 735
ClientWidth = 6780
Icon = "frmMain.frx":0000
LinkTopic = "MDIForm1"
StartUpPosition = 3 '窗口缺省
Begin MSComctlLib.ImageList imlIcons
Left = 3000
Top = 960
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 32
ImageHeight = 32
MaskColor = 12632256
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 7
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":1272
Key = ""
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":1B4E
Key = ""
EndProperty
BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":242A
Key = ""
EndProperty
BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":2D06
Key = ""
EndProperty
BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":39E2
Key = ""
EndProperty
BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":42BE
Key = ""
EndProperty
BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":4712
Key = ""
EndProperty
EndProperty
End
Begin MSComctlLib.StatusBar sbStatusBar
Align = 2 'Align Bottom
Height = 315
Left = 0
TabIndex = 1
Top = 2085
Width = 6780
_ExtentX = 11959
_ExtentY = 556
_Version = 393216
BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
NumPanels = 6
BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
AutoSize = 1
Object.Width = 5292
MinWidth = 5292
EndProperty
BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Style = 1
AutoSize = 2
Enabled = 0 'False
Object.Width = 1058
MinWidth = 1058
TextSave = "CAPS"
EndProperty
BeginProperty Panel3 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Style = 2
AutoSize = 2
Enabled = 0 'False
Object.Width = 1058
MinWidth = 1058
TextSave = "NUM"
EndProperty
BeginProperty Panel4 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Style = 3
AutoSize = 2
Enabled = 0 'False
Object.Width = 1058
MinWidth = 1058
TextSave = "Ins"
EndProperty
BeginProperty Panel5 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Style = 6
AutoSize = 2
Object.Width = 2117
MinWidth = 2117
TextSave = "2003-8-19"
EndProperty
BeginProperty Panel6 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Style = 5
AutoSize = 2
Object.Width = 2117
MinWidth = 2117
TextSave = "0:23"
EndProperty
EndProperty
End
Begin MSComctlLib.Toolbar tbToolBar
Align = 1 'Align Top
Height = 600
Left = 0
TabIndex = 0
Top = 0
Width = 6780
_ExtentX = 11959
_ExtentY = 1058
ButtonWidth = 1032
ButtonHeight = 1005
Appearance = 1
Style = 1
ImageList = "imlIcons"
_Version = 393216
BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628}
NumButtons = 7
BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628}
Object.ToolTipText = "工作人员登记"
ImageIndex = 1
EndProperty
BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628}
Object.ToolTipText = "物品类别登记"
ImageIndex = 2
EndProperty
BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628}
Object.ToolTipText = "数据维护"
ImageIndex = 3
EndProperty
BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628}
Object.ToolTipText = "物流处理"
ImageIndex = 4
EndProperty
BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628}
Object.ToolTipText = "物流查询"
ImageIndex = 5
EndProperty
BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628}
Object.ToolTipText = "物流汇总"
ImageIndex = 6
EndProperty
BeginProperty Button7 {66833FEA-8583-11D1-B16A-00C0F0283628}
Object.ToolTipText = "帮助"
ImageIndex = 7
EndProperty
EndProperty
End
Begin MSComDlg.CommonDialog dlgCommonDialog
Left = 4200
Top = 1560
_ExtentX = 847
_ExtentY = 847
_Version = 393216
FontName = "仿宋_GB2312"
FontSize = 9
End
Begin VB.Menu mnuXt
Caption = "系统管理(&S)"
Begin VB.Menu mnuXtGzrydj
Caption = "工作人员登记(&G)"
Shortcut = {F3}
End
Begin VB.Menu mnuXtWplbdj
Caption = "物品类别登记(&W)"
Shortcut = {F4}
End
Begin VB.Menu mnuXtBar1
Caption = "-"
End
Begin VB.Menu mnuXtSjwh
Caption = "数据维护(&S)"
Shortcut = {F5}
End
Begin VB.Menu mnuXtBar2
Caption = "-"
End
Begin VB.Menu mnuXtSetPrint
Caption = "打印设置(&P)"
Shortcut = ^P
End
Begin VB.Menu mnuXtBar3
Caption = "-"
End
Begin VB.Menu mnuXtExit
Caption = "退出(&X)"
End
End
Begin VB.Menu mnuWl
Caption = "物流管理(&L)"
Begin VB.Menu mnuWlcl
Caption = "物品登记与物流处理(&C)"
Shortcut = {F6}
End
Begin VB.Menu mnuSzBar1
Caption = "-"
End
Begin VB.Menu mnuWlcx
Caption = "物品流通情况查询(&X)"
Shortcut = {F7}
End
Begin VB.Menu mnuWlhz
Caption = "物品流通情况汇总(&H)"
Shortcut = {F8}
End
End
Begin VB.Menu mnuWindow
Caption = "窗口(&W)"
WindowList = -1 'True
Begin VB.Menu mnuWindowToolbar
Caption = "工具栏(&T)"
Checked = -1 'True
End
Begin VB.Menu mnuWindowStatusBar
Caption = "状态栏(&B)"
Checked = -1 'True
End
Begin VB.Menu mnuWindowBar1
Caption = "-"
End
Begin VB.Menu mnuWindowTileVertical
Caption = "平铺窗口(&V)"
End
Begin VB.Menu mnuWindowCascade
Caption = "层叠窗口(&C)"
End
End
Begin VB.Menu mnuHelp
Caption = "帮助(&H)"
Begin VB.Menu mnuHelpSearch
Caption = "帮助主题(&S)..."
End
Begin VB.Menu mnuHelpBar1
Caption = "-"
End
Begin VB.Menu mnuHelpAbout
Caption = "关于“仓库物流管理”(&A)..."
End
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub MDIForm_Load()
'从 Windows 注册表返回主窗体状态值,设置主窗体打开后的位置、大小
Left = GetSetting(App.Title, "Settings", "MainLeft", 1000)
Top = GetSetting(App.Title, "Settings", "MainTop", 1000)
Width = GetSetting(App.Title, "Settings", "MainWidth", 6500)
Height = GetSetting(App.Title, "Settings", "MainHeight", 6500)
If Left(gbytZyQX, 1) = 1 Then Exit Sub
mnuXtGzrydj.Enabled = False
mnuXtWplbdj.Enabled = False
mnuXtSjwh.Enabled = False
mnuWlcl.Enabled = CBool(Mid(gbytZyQX, 2, 1) + Mid(gbytZyQX, 3, 1))
mnuWlcx.Enabled = CBool(Mid(gbytZyQX, 4, 1))
mnuWlhz.Enabled = CBool(Mid(gbytZyQX, 5, 1))
End Sub
Private Sub MDIForm_Unload(Cancel As Integer)
'在 Windows 注册表中保存主窗体状态
If WindowState <> vbMinimized Then
SaveSetting App.Title, "Settings", "MainLeft", Left
SaveSetting App.Title, "Settings", "MainTop", Top
SaveSetting App.Title, "Settings", "MainWidth", Width
SaveSetting App.Title, "Settings", "MainHeight", Height
End If
EndApp '退出应用程序
End Sub
Private Sub mnuWindowStatusBar_Click()
'显示或隐藏状态栏
If mnuWindowStatusBar.Checked Then
sbStatusBar.Visible = False
mnuWindowStatusBar.Checked = False
Else
sbStatusBar.Visible = True
mnuWindowStatusBar.Checked = True
End If
End Sub
Private Sub mnuWindowTileVertical_Click()
Arrange vbTileVertical '平铺子窗口
End Sub
Private Sub mnuWindowToolbar_Click()
'显示或隐藏工具栏
If mnuWindowToolbar.Checked Then
tbToolBar.Visible = False
mnuWindowToolbar.Checked = False
Else
tbToolBar.Visible = True
mnuWindowToolbar.Checked = True
End If
End Sub
Private Sub mnuWlcl_Click()
frmWlcl.SetFocus
End Sub
Private Sub mnuWlcx_Click()
frmWlcx.SetFocus
End Sub
Private Sub mnuWlhz_Click()
frmWlhz.Show
End Sub
Private Sub mnuXtExit_Click()
Unload Me
End Sub
Private Sub mnuXtGzrydj_Click()
Dim frmNewWin As New frmGZRYDJ
frmNewWin.Show vbModal '显示工作人员登记窗
Set frmNewWin = Nothing
End Sub
Private Sub mnuXtSetPrint_Click()
SetPrint
End Sub
Private Sub mnuXtSjwh_Click()
Dim frmNewWin As New frmSJWH
frmNewWin.Show vbModal '显示数据维护窗
Set frmNewWin = Nothing
End Sub
Private Sub mnuWindowCascade_Click()
Arrange vbCascade '层叠子窗口
End Sub
Private Sub mnuHelpAbout_Click()
Dim fAbout As New frmAbout
frmAbout.Show vbModal '显示“关于……”对话框
Set frmAbout = Nothing
End Sub
Private Sub mnuHelpSearch_Click()
On Error GoTo ERRB
'打开帮助文件
dlgCommonDialog.HelpCommand = &HB&
dlgCommonDialog.ShowHelp
ERRB:
End Sub
Public Function File_Open(ByVal DFfilter As String, ByVal Title As String) As String
'显示“打开文件”对话框,搜索文件路径
On Error GoTo ERRB
dlgCommonDialog.CancelError = True
dlgCommonDialog.Filter = DFfilter
dlgCommonDialog.FilterIndex = 0
dlgCommonDialog.Flags = cdlOFNHideReadOnly
dlgCommonDialog.DialogTitle = Title
dlgCommonDialog.ShowOpen
File_Open = Trim(dlgCommonDialog.FileName)
If Dir(File_Open, vbNormal + vbReadOnly + vbHidden + vbSystem) = "" Then
MsgBox "找不到文件:" & File_Open, vbOKOnly + vbDefaultButton1 + vbExclamation
File_Open = ""
End If
ERRB:
End Function
Public Sub RsPC(strTag As String)
sbStatusBar.Panels(1).Text = strTag
End Sub
Private Sub mnuXtWplbdj_Click()
Dim frmNewWin As New frmWpzldj
frmNewWin.Show vbModal '显示物品类别登记窗
Set frmNewWin = Nothing
End Sub
Private Sub tbToolBar_ButtonClick(ByVal Button As MSComctlLib.Button)
'选择执行工具栏命令
Select Case Button.Index
Case 1
mnuXtGzrydj_Click
Case 2
mnuXtWplbdj_Click
Case 3
mnuXtSjwh_Click
Case 4
mnuWlcl_Click
Case 5
mnuWlcx_Click
Case 6
mnuWlhz_Click
End Select
End Sub
Public Sub SaveZp(ByVal strFieldName As String, rs As ADODB.Recordset, ByVal strZpFile As String)
'保存图片到数据库
On Error Resume Next
Dim DataFile As Integer, FileLong As Long, Chunks As Integer
Dim Fragment As Integer, Chunk() As Byte, I As Integer
Const ChunkSize As Integer = 16384
If strZpFile = "" Then Exit Sub
DataFile = 1
Open strZpFile For Binary Access Read As DataFile
FileLong = LOF(DataFile) ' 文件中数据长度
If FileLong = 0 Then
Close DataFile
Exit Sub
End If
Chunks = FileLong \ ChunkSize
Fragment = FileLong Mod ChunkSize
ReDim Chunk(Fragment)
Get DataFile, , Chunk()
rs(strFieldName).AppendChunk Chunk()
ReDim Chunk(ChunkSize)
For I = 1 To Chunks
Get DataFile, , Chunk()
rs(strFieldName).AppendChunk Chunk()
Next I
Close DataFile
rs.Update
End Sub
Public Sub SetPrint()
On Error Resume Next
fMain.dlgCommonDialog.Flags = cdlPDPrintSetup
fMain.dlgCommonDialog.ShowPrinter
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -