📄 frmmain.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Object = "{74238AF8-8108-44A9-B3DE-D652F61AB8DC}#2.3#0"; "yfdnetmenu.ocx"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "Comdlg32.ocx"
Begin VB.MDIForm frmMain
BackColor = &H80000010&
Caption = "仓库库存管理系统"
ClientHeight = 7005
ClientLeft = 165
ClientTop = 855
ClientWidth = 10635
Icon = "frmMain.frx":0000
LinkTopic = "MDIForm1"
Picture = "frmMain.frx":08CA
StartUpPosition = 3 '窗口缺省
WindowState = 2 'Maximized
Begin MSComctlLib.StatusBar StatusBar1
Align = 2 'Align Bottom
Height = 375
Left = 0
TabIndex = 1
Top = 6630
Width = 10635
_ExtentX = 18759
_ExtentY = 661
_Version = 393216
BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
NumPanels = 2
BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
AutoSize = 1
Object.Width = 15663
EndProperty
BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Style = 6
TextSave = "2007-12-17"
EndProperty
EndProperty
End
Begin MSComDlg.CommonDialog cmdlgOpen
Left = 5040
Top = 3240
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin MSComctlLib.ImageList ImageList1
Left = 4920
Top = 2880
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 32
ImageHeight = 32
MaskColor = 12632256
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 5
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":11781
Key = ""
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":1205B
Key = ""
EndProperty
BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":12935
Key = ""
EndProperty
BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":1320F
Key = ""
EndProperty
BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":13AE9
Key = ""
EndProperty
EndProperty
End
Begin MSComctlLib.Toolbar Toolbar1
Align = 1 'Align Top
Height = 600
Left = 0
TabIndex = 0
Top = 0
Width = 10635
_ExtentX = 18759
_ExtentY = 1058
ButtonWidth = 1984
ButtonHeight = 1005
Appearance = 1
Style = 1
TextAlignment = 1
ImageList = "ImageList1"
_Version = 393216
BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628}
NumButtons = 7
BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628}
Style = 3
EndProperty
BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "入库"
Key = "input"
ImageIndex = 3
EndProperty
BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "出库"
Key = "output"
ImageIndex = 1
EndProperty
BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "设置"
Key = "setting"
ImageIndex = 4
EndProperty
BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "打印"
Key = "print"
ImageIndex = 2
EndProperty
BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628}
Style = 3
EndProperty
BeginProperty Button7 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "退出"
Key = "quit"
ImageIndex = 5
EndProperty
EndProperty
End
Begin yfDNetMenu.DNetMenu DNetMenu1
Left = 6480
Top = 1800
_ExtentX = 847
_ExtentY = 847
BmpCount = 10
Bmp:1 = "frmMain.frx":143C3
Key:1 = "#menuFileSelect"
Bmp:2 = "frmMain.frx":147EB
Key:2 = "#menuFileClear"
Bmp:3 = "frmMain.frx":14C13
Key:3 = "#menuFileUser"
Bmp:4 = "frmMain.frx":1503B
Key:4 = "#menuQuit"
Bmp:5 = "frmMain.frx":15463
Key:5 = "#menuWHsetting"
Bmp:6 = "frmMain.frx":1588B
Key:6 = "#menuInput"
Bmp:7 = "frmMain.frx":15CB3
Key:7 = "#menuOut"
Bmp:8 = "frmMain.frx":160DB
Key:8 = "#menuFindInput"
Bmp:9 = "frmMain.frx":16503
Key:9 = "#menuFindOutput"
Bmp:10 = "frmMain.frx":1692B
Mask:10 = 16777215
Key:10 = "#menuChangePass"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin VB.Menu menuFile
Caption = "文件(&F)"
Begin VB.Menu menuFileSelect
Caption = "选择数据库(&S)"
End
Begin VB.Menu menuFielBackup
Caption = "备份数据库(&B)"
End
Begin VB.Menu menubar1
Caption = "-"
End
Begin VB.Menu menuFileClear
Caption = "清空数据库(&D)"
End
Begin VB.Menu menuFileRestor
Caption = "还原数据库(&R)"
End
Begin VB.Menu menuFileComb
Caption = "压缩数据库(&C)"
End
Begin VB.Menu menubar2
Caption = "-"
End
Begin VB.Menu menuFileUser
Caption = "用户管理(&M)"
End
Begin VB.Menu menuChangePass
Caption = "修改密码(&P)"
End
Begin VB.Menu menubar3
Caption = "-"
End
Begin VB.Menu menuQuit
Caption = "退出(&Q)"
End
End
Begin VB.Menu menuEdit
Caption = "编辑(&E)"
Begin VB.Menu menuInput
Caption = "入库(&I)"
End
Begin VB.Menu menuOut
Caption = "出库(&O)"
End
Begin VB.Menu menuGoods
Caption = "物品资料(&G)"
End
Begin VB.Menu menuAddWH
Caption = "仓库资料(&W)"
End
Begin VB.Menu menubar4
Caption = "-"
End
Begin VB.Menu menuWHsetting
Caption = "仓库设置(&S)"
End
End
Begin VB.Menu menuFind
Caption = "查询(&F)"
Begin VB.Menu menuFindInput
Caption = "入库(&I)"
End
Begin VB.Menu menuFindOutput
Caption = "出库(&O)"
End
Begin VB.Menu menuFindWH
Caption = "库存查询(&W)"
Shortcut = {F3}
End
End
Begin VB.Menu menuWindow
Caption = "窗口(&W)"
WindowList = -1 'True
Begin VB.Menu menuWindowH
Caption = "水平平铺(&H)"
End
Begin VB.Menu menuWindowV
Caption = "垂直平铺"
End
Begin VB.Menu menuWindowC
Caption = "层叠(&C)"
End
Begin VB.Menu menuWindowT
Caption = "标题(&T)"
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
'Copyright: Clark 2007/12
'Mail: byh0337@sina.com
'设置权限
Private Sub SetQX()
Dim A() As String
A = Split(MyAppInfo.UserOP, ",")
If A(0) = "1" Then
Exit Sub '系统管理员
Else
menuFileClear.Enabled = False
menuFileRestor.Enabled = False
menuFileComb.Enabled = False
menuFileUser.Enabled = False
End If
If A(1) = "0" Then menuFielBackup.Enabled = False
If A(2) = "0" Then
menuInput.Enabled = False
Toolbar1.Buttons(2).Enabled = False
End If
If A(3) = "0" Then
menuOut.Enabled = False
Toolbar1.Buttons(3).Enabled = False
End If
If A(2) = "0" And A(3) = "0" Then
menuFileSelect.Enabled = False
menuGoods.Enabled = False
menuWHsetting.Enabled = False
menuAddWH.Enabled = False
Toolbar1.Buttons(4).Enabled = False
End If
'没有全部查询权限的人, 默认不可以对基本资料进行编辑
If A(4) = "0" Then
menuFindInput.Enabled = False
End If
If A(5) = "0" Then
menuFindOutput.Enabled = False
End If
End Sub
Private Sub MDIForm_Load()
StatusBar1.Panels(1).Text = "数据库路径[" & MyAppInfo.DataPath & "]"
SetQX
frmYC.Show
End Sub
Private Sub menuAddWH_Click()
frmWH.Show
End Sub
Private Sub menuChangePass_Click()
frmPassword.Show vbModal
End Sub
Private Sub menuFielBackup_Click()
On Error Resume Next
If Len(MyAppInfo.BackUpPath) <= 0 Then
Exit Sub
End If
If Dir(MyAppInfo.BackUpPath & "\", vbDirectory) = "" Then Call CreateNewDirectory(MyAppInfo.BackUpPath & "\")
If CopyFile(MyAppInfo.DataPath, MyAppInfo.BackUpPath & "\data-" & Date & ".mdb", 0) = 0 Then
MsgBox "备份数据库失败", vbOKOnly + vbCritical
Else
MsgBox "备份数据库成功", vbOKOnly + vbInformation
End If
End Sub
Private Sub menuFileClear_Click()
On Error GoTo ErrFlag
If MsgBox("确定要清空数据库吗，该操作将清空所有数据并不可恢复", vbYesNo + vbQuestion) = vbNo Then Exit Sub
Dim i As Integer
Dim ConnTemp As New ADODB.Connection
Dim strSQL(6) As String
ConnTemp.Open StrConn
strSQL(0) = "Delete * From goods"
strSQL(1) = "Delete * From WH"
strSQL(2) = "Delete * From WHQty"
strSQL(3) = "Delete * From WHSetting"
strSQL(4) = "Delete * From InData"
strSQL(5) = "Delete * From OutData"
For i = 0 To 5
ConnTemp.Execute strSQL(i)
DoEvents
Next
ConnTemp.Close
Set ConnTemp = Nothing
MsgBox "数据库清空完成", vbOKOnly + vbInformation
Exit Sub
ErrFlag:
MsgBox "[清空数据库]" & Err.Description, vbOKOnly + vbCritical
End Sub
Private Sub menuFileComb_Click()
Call CompactJetDatabase
End Sub
Private Sub menuFileRestor_Click()
frmRestore.Show vbModal
End Sub
Private Sub menuFileSelect_Click()
On Error GoTo ErrFlag
With cmdlgOpen
.CancelError = True
.Filter = "Microsoft Access Database(*.MDB)|*.MDB"
.flags = cdlOFNFileMustExist
.ShowOpen
End With
If Len(cmdlgOpen.FileName) > 0 Then
MyAppInfo.DataPath = cmdlgOpen.FileName
StrConn = "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" & MyAppInfo.DataPath
StatusBar1.Panels(1).Text = "数据库路径[" & MyAppInfo.DataPath & "]"
SaveSetting App.EXEName, "Settings", "DataPath", MyAppInfo.DataPath
End If
Exit Sub
ErrFlag:
End Sub
Private Sub menuFileUser_Click()
frmUser.Show vbModal
End Sub
Private Sub menuFindInput_Click()
frmFindInput.Show
End Sub
Private Sub menuFindOutput_Click()
frmFindOutput.Show
End Sub
Private Sub menuFindWH_Click()
frmFindWH.Show
End Sub
Private Sub menuGoods_Click()
frmGoods.Show
End Sub
Private Sub menuInput_Click()
frmInput.Show
End Sub
Private Sub menuOut_Click()
frmOutput.Show
End Sub
Private Sub menuQuit_Click()
End
End Sub
Private Sub menuWHsetting_Click()
frmSetting.Show
End Sub
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
On Error GoTo ErrFlag
Select Case Button.Key
Case "quit"
End
Case "input"
frmInput.Show
Case "output"
frmOutput.Show
Case "setting"
frmSetting.Show
Case "print"
If ActiveForm Is Nothing Then Exit Sub
Select Case ActiveForm.Caption
Case "入库单查询", "库存查询", "出库单查询"
ActiveForm.PrintMe
End Select
End Select
Exit Sub
ErrFlag:
MsgBox Err.Description, vbOKOnly + vbCritical
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -