📄 mdiform1.frm
字号:
VERSION 5.00
Object = "{4932CEF1-2CAA-11D2-A165-0060081C43D9}#2.0#0"; "Actbar2.ocx"
Begin VB.MDIForm MDIFormMain
BackColor = &H0098F499&
Caption = "便利店管理系统"
ClientHeight = 8835
ClientLeft = 60
ClientTop = 345
ClientWidth = 10920
Icon = "MDIForm1.frx":0000
LinkTopic = "MDIForm1"
Picture = "MDIForm1.frx":08CA
ScrollBars = 0 'False
StartUpPosition = 3 'Windows Default
Begin ActiveBar2LibraryCtl.ActiveBar2 ActiveBar21
Align = 1 'Align Top
Height = 8835
Left = 0
TabIndex = 0
Top = 0
Width = 10920
_LayoutVersion = 1
_ExtentX = 19262
_ExtentY = 15584
_DataPath = ""
Bands = "MDIForm1.frx":2181E
End
End
Attribute VB_Name = "MDIFormMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub loadMenuCaption(ByVal language As String)
'装载中英文菜单
Dim rsMenu As ADODB.Recordset
Dim mnuCode As String
Dim mnuCaption As String
'Dim mnuShortCut As String
On Error GoTo loadMenuCaptionErrDelWith
Me.Caption = getResource("resSystemCaption")
Set rsMenu = myDE.rsrsAppMenu
If Not (rsMenu.BOF And rsMenu.EOF) Then
rsMenu.MoveFirst
Do Until rsMenu.EOF
mnuCode = Trim(rsMenu.Fields("MenuCode").Value & "")
mnuCaption = Trim(rsMenu.Fields("MenuCaption" & language & "n").Value & "")
'mnuShortCut = Trim(rsMenu.Fields("ShortCut").Value & "")
If Right(mnuCode, 2) = "00" Then '导航器和主菜单
If Left(mnuCode, 2) <> "04" And Left(mnuCode, 2) <> "05" Then
Me.ActiveBar21.Bands("barNavigation").ChildBands("bar" & mnuCode).Caption = mnuCaption
End If
Me.ActiveBar21.Bands("mnuMain").Tools("mnu" & mnuCode).Caption = mnuCaption '& mnuShortCut
Else '导航器项和菜单项
If Left(mnuCode, 2) <> "04" And Left(mnuCode, 2) <> "05" Then
Me.ActiveBar21.Bands("barNavigation").ChildBands("bar" & Left(mnuCode, 2) & "00").Tools("mi" & mnuCode).Caption = mnuCaption
Me.ActiveBar21.Bands("barNavigation").ChildBands("bar" & Left(mnuCode, 2) & "00").Tools("mi" & mnuCode).Description = mnuCaption
End If
Me.ActiveBar21.Bands("pop" & Left(mnuCode, 2) & "00").Tools("mi" & mnuCode).Caption = mnuCaption
Me.ActiveBar21.Bands("pop" & Left(mnuCode, 2) & "00").Tools("mi" & mnuCode).Description = mnuCaption
End If
rsMenu.MoveNext
Loop
End If
Me.ActiveBar21.RecalcLayout
loadMenuCaptionExit:
Exit Sub
loadMenuCaptionErrDelWith:
Resume loadMenuCaptionExit
End Sub
Public Sub loadMenuEnable()
'根据当前用户设置菜单是否可用
'Dim i As Integer
'Dim fN, fNC1, fNC2 As String
With curSystemUser
'0000
Me.ActiveBar21.Bands("barNavigation").ChildBands("bar0000").Tools("mi0001").Enabled = (.uOp0001 > 0)
Me.ActiveBar21.Bands("pop0000").Tools("mi0001").Enabled = (.uOp0001 > 0)
Me.ActiveBar21.Bands("barNavigation").ChildBands("bar0000").Tools("mi0002").Enabled = (.uOp0002 > 0)
Me.ActiveBar21.Bands("pop0000").Tools("mi0002").Enabled = (.uOp0002 > 0)
Me.ActiveBar21.Bands("barNavigation").ChildBands("bar0000").Tools("mi0003").Enabled = (.uOp0003 > 0)
Me.ActiveBar21.Bands("pop0000").Tools("mi0003").Enabled = (.uOp0003 > 0)
'0100
Me.ActiveBar21.Bands("barNavigation").ChildBands("bar0100").Tools("mi0101").Enabled = (.uOp0101 > 0)
Me.ActiveBar21.Bands("pop0100").Tools("mi0101").Enabled = (.uOp0101 > 0)
Me.ActiveBar21.Bands("barNavigation").ChildBands("bar0100").Tools("mi0102").Enabled = (.uOp0102 > 0)
Me.ActiveBar21.Bands("pop0100").Tools("mi0102").Enabled = (.uOp0102 > 0)
Me.ActiveBar21.Bands("barNavigation").ChildBands("bar0100").Tools("mi0103").Enabled = (.uOp0103 > 0)
Me.ActiveBar21.Bands("pop0100").Tools("mi0103").Enabled = (.uOp0103 > 0)
Me.ActiveBar21.Bands("barNavigation").ChildBands("bar0100").Tools("mi0104").Enabled = (.uOp0104 > 0)
Me.ActiveBar21.Bands("pop0100").Tools("mi0104").Enabled = (.uOp0104 > 0)
'0200
Me.ActiveBar21.Bands("barNavigation").ChildBands("bar0200").Tools("mi0201").Enabled = (.uOp0201 > 0)
Me.ActiveBar21.Bands("pop0200").Tools("mi0201").Enabled = (.uOp0201 > 0)
Me.ActiveBar21.Bands("barNavigation").ChildBands("bar0200").Tools("mi0202").Enabled = (.uOp0202 > 0)
Me.ActiveBar21.Bands("pop0200").Tools("mi0202").Enabled = (.uOp0202 > 0)
Me.ActiveBar21.Bands("barNavigation").ChildBands("bar0200").Tools("mi0203").Enabled = (.uOp0203 > 0)
Me.ActiveBar21.Bands("pop0200").Tools("mi0203").Enabled = (.uOp0203 > 0)
'0300
Me.ActiveBar21.Bands("barNavigation").ChildBands("bar0300").Tools("mi0301").Enabled = (.uOp0301 > 0)
Me.ActiveBar21.Bands("pop0300").Tools("mi0301").Enabled = (.uOp0301 > 0)
Me.ActiveBar21.Bands("barNavigation").ChildBands("bar0300").Tools("mi0302").Enabled = (.uOp0302 > 0)
Me.ActiveBar21.Bands("pop0300").Tools("mi0302").Enabled = (.uOp0302 > 0)
Me.ActiveBar21.Bands("barNavigation").ChildBands("bar0300").Tools("mi0303").Enabled = (.uOp0303 > 0)
Me.ActiveBar21.Bands("pop0300").Tools("mi0303").Enabled = (.uOp0303 > 0)
Me.ActiveBar21.Bands("barNavigation").ChildBands("bar0300").Tools("mi0304").Enabled = (.uOp0304 > 0)
Me.ActiveBar21.Bands("pop0300").Tools("mi0304").Enabled = (.uOp0304 > 0)
End With
' myDE.rsrsSystemUser.Filter = "ID='" & curSystemUser.uID & "'"
' If myDE.rsrsSystemUser.RecordCount > 0 Then
' For i = 4 To 17
' fN = myDE.rsrsSystemUser.Fields(i).Name
' fNC1 = Mid(fN, 3, 2)
' fNC2 = Mid(fN, 3)
' If myDE.rsrsSystemUser.Fields(i).Value = 1 Then
' Me.ActiveBar21.Bands("barNavigation").ChildBands("bar" & fNC1 & "00").Tools("mi" & fNC2).Enabled = True
' Me.ActiveBar21.Bands("pop" & fNC1 & "00").Tools("mi" & fNC2).Enabled = True
' Else
' Me.ActiveBar21.Bands("barNavigation").ChildBands("bar" & fNC1 & "00").Tools("mi" & fNC2).Enabled = False
' Me.ActiveBar21.Bands("pop" & fNC1 & "00").Tools("mi" & fNC2).Enabled = False
' End If
' Next i
' End If
End Sub
Private Sub ActiveBar21_ToolClick(ByVal Tool As ActiveBar2LibraryCtl.Tool)
'If Me.ActiveForm.Name <> "frmBackGround" And Me.ActiveForm.Name <> "frm" & Right$(Tool.Name, 4) Then
' MsgBox getResource("resMsgMDIF001"), vbCritical + vbOKOnly
' Unload Me.ActiveForm
'End If
Select Case Tool.Name
'业务处理
Case "mi0001": sub0001 '采购入库/采购退货
Case "mi0002": sub0002 '销售出库/销售退货
Case "mi0003": sub0003 '其它库存变动
'业务报表
Case "mi0101": sub0101 '采购报表
Case "mi0102": sub0102 '销售报表
Case "mi0103": sub0103 '其它库存变动报表
Case "mi0104": sub0104 '库存报表
'基本资料
Case "mi0201": sub0201 '货品资料
Case "mi0202": sub0202 '供应商资料
Case "mi0203": sub0203 '客户资料
'系统维护
Case "mi0301": sub0301 '系统设置
Case "mi0302": sub0302 '用户管理
Case "mi0303": sub0303 '口令修改
Case "mi0304": sub0304 '数据管理
'系统命令
Case "mi0401": sub0401 '导航器
Case "mi0402": sub0402 '汉语
Case "mi0403": sub0403 '英语
Case "mi0404": sub0404 '退出
'帮助
Case "mi0501": sub0501 '关于…
End Select
End Sub
Private Sub sub0001()
'采购入库/采购退货
frm0001.Show
frm0001.ZOrder 0
End Sub
Private Sub sub0002()
'销售出库/销售退货
frm0002.Show
frm0002.ZOrder 0
End Sub
Private Sub sub0003()
'其它库存变动
frm0003.Show
frm0003.ZOrder 0
End Sub
Private Sub sub0101()
'采购报表
frm0101.Show
frm0101.ZOrder 0
End Sub
Private Sub sub0102()
'销售报表
frm0102.Show
frm0102.ZOrder 0
End Sub
Private Sub sub0103()
'其它库存变动报表
frm0103.Show
frm0103.ZOrder 0
End Sub
Private Sub sub0104()
'库存报表
On Error GoTo errDealWith
myDE.rsrsStorage.Requery
If myDE.rsrsStorage.RecordCount = 0 Then
MsgBox getResource("resMsgF0000007"), vbCritical + vbOKOnly
Else
If curLang = "E" Then
rpStorageE.Show
rpStorageE.ZOrder 0
Else
rpStorageC.Show
rpStorageC.ZOrder 0
End If
End If
errExit:
Exit Sub
errDealWith:
MsgBox Err.Description, vbCritical
Resume errExit
End Sub
Private Sub sub0201()
'商品
frm0201.Show
frm0201.ZOrder 0
End Sub
Private Sub sub0202()
'供应商
frm0202.Show
frm0202.ZOrder 0
End Sub
Private Sub sub0203()
'客户
frm0203.Show
frm0203.ZOrder 0
End Sub
Private Sub sub0301()
'系统设置
frm0301.Show
frm0301.ZOrder 0
End Sub
Private Sub sub0302()
'用户管理
frm0302.Show
frm0302.ZOrder 0
End Sub
Private Sub sub0303()
'口令修改
frm0303.Show
frm0303.ZOrder 0
End Sub
Private Sub sub0304()
'数据管理
frm0304.Show
frm0304.ZOrder 0
End Sub
Private Sub sub0401()
Me.ActiveBar21.Bands("barNavigation").Visible = True
Me.ActiveBar21.RecalcLayout
End Sub
Private Sub sub0402()
Me.ActiveBar21.Tools("mi0402").Checked = True
Me.ActiveBar21.Tools("mi0403").Checked = False
curLang = "C"
Call loadMenuCaption("C")
Call SetUpINI("baseinfo", "language", "C", iniFile)
'Me.ActiveBar21.RecalcLayout
End Sub
Private Sub sub0403()
Me.ActiveBar21.Tools("mi0402").Checked = False
Me.ActiveBar21.Tools("mi0403").Checked = True
curLang = "E"
Call loadMenuCaption("E")
Call SetUpINI("baseinfo", "language", "E", iniFile)
'Me.ActiveBar21.RecalcLayout
End Sub
Private Sub sub0404()
Call ShutDownSystem(True)
End Sub
Private Sub sub0501()
'about...
frmAbout.Show
frmAbout.ZOrder 0
End Sub
Private Sub MDIForm_Load()
'iniFile = App.Path & "\baseinfo.ini"
'curLang = GetFromINI("baseinfo", "language", iniFile)
'Call openDataBase
Call loadMenuCaption(curLang)
Call loadMenuEnable
Me.Top = 0
Me.Left = 0
Me.Height = Screen.Height - 400
Me.Width = Screen.Width
'Me.ActiveBar21.Tools("miStau3").Caption = curSystemUser.uID
'frmBackGround.Show
'frmBackGround.Top = 0
'frmBackGround.Left = 0
End Sub
Private Sub MDIForm_Unload(Cancel As Integer)
Call sub0404
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -