📄 frmmain.frm
字号:
VERSION 5.00
Object = "{A4BF9E9F-333F-4D07-A80E-DA359D576BFF}#3.0#0"; "xpmenu.ocx"
Begin VB.MDIForm frmMain
Appearance = 0 'Flat
BackColor = &H00FFFFFF&
Caption = "超市系统后台管理界面"
ClientHeight = 8310
ClientLeft = 165
ClientTop = 735
ClientWidth = 11400
Icon = "frmMain.frx":0000
LinkTopic = "MDIForm1"
Picture = "frmMain.frx":058A
StartUpPosition = 3 '窗口缺省
Begin HookMenu.XPMenu XPMenu1
Left = 4200
Top = 3120
_ExtentX = 900
_ExtentY = 900
BmpCount = 0
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
UserSelectedMenuBackColour= 13040639
UserSelectedMenuBorderColour= 16711680
UserTopMenuBackColour= 16761765
UserTopMenuSelectedColour= 16769990
UserTopMenuHotColour= 33023
UserTopMenuHotBorderColour= 16711680
UserMenuBorderColour= 8388608
UserCheckBackColour= 8108783
UserCheckBorderColour= 16711680
UserGradientOne = 16777215
UserGradientTwo = 16761765
UserUseGradient = -1 'True
UserSelectedItemForeColour= 16384
UserSideBarColour= 16711680
CopyRight = "lcXPMenu"
End
Begin VB.PictureBox picSB
Align = 2 'Align Bottom
BorderStyle = 0 'None
Height = 300
Left = 0
ScaleHeight = 20
ScaleMode = 3 'Pixel
ScaleWidth = 760
TabIndex = 0
Top = 8010
Width = 11400
Begin VB.Image Image2
Height = 240
Left = 75
Picture = "frmMain.frx":7986
Top = 45
Width = 240
End
Begin VB.Image Image1
Height = 240
Left = 3150
Picture = "frmMain.frx":7F10
Top = 45
Width = 240
End
Begin VB.Label LBSB
AutoSize = -1 'True
BackStyle = 0 'Transparent
Height = 180
Index = 2
Left = 3465
TabIndex = 2
Top = 75
Width = 90
End
Begin VB.Label LBSB
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "欢迎使用本系统"
Height = 180
Index = 1
Left = 375
TabIndex = 1
Top = 75
Width = 1260
End
Begin VB.Shape Shb2
BorderColor = &H00A6A6A6&
Height = 270
Left = 3090
Top = 30
Width = 6885
End
Begin VB.Image imgLB
Height = 180
Left = 10080
MousePointer = 8 'Size NW SE
Picture = "frmMain.frx":829A
Top = 120
Width = 180
End
Begin VB.Shape Shb1
BorderColor = &H00A6A6A6&
Height = 270
Left = 30
Top = 30
Width = 3015
End
End
Begin VB.Menu mnuFile
Caption = "文件(&F)"
Begin VB.Menu mnuLogin
Caption = "返回登陆界面(&R)"
Shortcut = ^R
End
Begin VB.Menu mnuFileSP1
Caption = "-"
End
Begin VB.Menu mnuFileSP2
Caption = "-"
End
Begin VB.Menu mnuExit
Caption = "退出(&X)"
End
End
Begin VB.Menu mnuView
Caption = "视图(&V)"
Begin VB.Menu mnuLeft
Caption = "商品管理(&M)"
Index = 1
Shortcut = ^M
End
Begin VB.Menu mnuLeft
Caption = "进货管理(&P)"
Index = 2
Shortcut = ^P
End
Begin VB.Menu mnuLeft
Caption = "厂商/供货商(&F)"
Index = 4
Shortcut = ^F
End
Begin VB.Menu mnuLeft
Caption = "会员管理(&E)"
Index = 5
Shortcut = ^E
End
Begin VB.Menu mnuLeft
Caption = "用户管理(&U)"
Index = 6
Shortcut = ^U
End
End
Begin VB.Menu mnuHelp
Caption = "帮助(&H)"
Begin VB.Menu mnuContent
Caption = "内容(&C)"
Shortcut = {F1}
End
Begin VB.Menu mnuHelpSP1
Caption = "-"
End
Begin VB.Menu mnuAbout
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
'拖动窗体的API
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
Dim CanResize As Boolean
Dim LastFrm As Long
Private Sub cmdAbout_Click()
mnuAbout_Click
End Sub
Private Sub cmdClose_Click()
picLeft.Visible = False
mnuGuide.Checked = False
SaveINI "Main", "Guide", "n"
End Sub
Public Sub cmdLeft_Click(Index As Integer)
If LastFrm = Index Then Exit Sub
Unload frmWelcome
Select Case LastFrm
Case 1: Unload frmMerch
Case 2: Unload frmStock
Case 3: Unload frmSale
Case 4: Unload frmFP
Case 5: Unload frmMember
Case 6: Unload frmUser
End Select
LastFrm = Index
Select Case Index
Case 1: frmMerch.Show
Case 2: frmStock.Show
Case 3: frmSale.Show
Case 4: frmFP.Show
Case 5: frmMember.Show
Case 6: frmUser.Show
End Select
End Sub
Private Sub imgLB_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 1 Then
Call ReleaseCapture
Call SendMessage(hwnd, &HA1, 17, 0)
End If
End Sub
Private Sub imgLogin_Click()
End Sub
Private Sub MDIForm_Load()
'读取窗体位置,视图信息
If GetINI("Main", "Left") = "" Then
Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2
Else
Move GetLongINI("Main", "Left"), GetLongINI("Main", "Top"), GetLongINI("Main", "Width"), GetLongINI("Main", "Height")
Dim j As Long
j = GetLongINI("Main", "WindowState")
If j = 2 Then Me.WindowState = 2
End If
CanResize = True
If GetINI("Main", "Guide") = "n" Then
End If
If GetINI("Main", "ToolBar") = "n" Then
picTB.Visible = False
mnuTB.Checked = False
End If
If GetINI("Main", "StateBar") = "n" Then
picSB.Visible = False
End If
frmWelcome.Show
End Sub
Private Sub MDIForm_Resize()
On Error Resume Next
If CanResize = False Then Exit Sub
If Me.Width < 9900 Then Me.Width = 9900
If Me.Height < 8370 Then Me.Height = 8370
SaveINI "Main", "WindowState", CStr(WindowState)
If Me.WindowState = 0 Then
SaveINI "Main", "Width", CStr(Width)
SaveINI "Main", "Height", CStr(Height)
End If
End Sub
Private Sub MDIForm_Unload(Cancel As Integer)
On Error Resume Next
If Left >= 0 Then SaveINI "Main", "Left", CStr(Left)
If Top >= 0 Then SaveINI "Main", "Top", CStr(Top)
cnMain.Close
Set frmMain = Nothing
End Sub
Private Sub mnuAbout_Click()
MsgBox "满意请联系 waxiga@163.com ", vbInformation
End Sub
Private Sub mnuContent_Click()
MsgBox "暂无帮助！", vbInformation
End Sub
Private Sub mnuExit_Click()
Unload Me
End Sub
Private Sub mnuGuide_Click()
mnuGuide.Checked = Not mnuGuide.Checked
picLeft.Visible = mnuGuide.Checked
SaveINI "Main", "Guide", IIf(mnuGuide.Checked = True, "", "n")
End Sub
Private Sub mnuLeft_Click(Index As Integer)
cmdLeft_Click Index
End Sub
Private Sub mnuLogin_Click()
On Error Resume Next
Unload Me
frmLogin.Show
End Sub
Private Sub picSB_Resize()
On Error Resume Next
Shb2.Width = Me.Width / 15 - IIf(Me.WindowState = 2, 210, 230)
imgLB.Visible = (Me.WindowState <> 2)
imgLB.Left = Me.Width / 15 - 20
End Sub
Private Sub mnuSB_Click()
mnuSB.Checked = Not mnuSB.Checked
picSB.Visible = mnuSB.Checked
SaveINI "Main", "StateBar", IIf(mnuSB.Checked = True, "", "n")
End Sub
Private Sub mnuTB_Click()
mnuTB.Checked = Not mnuTB.Checked
picTB.Visible = mnuTB.Checked
SaveINI "Main", "ToolBar", IIf(mnuTB.Checked = True, "", "n")
End Sub
Private Sub picLeft_Resize()
On Error Resume Next
ShLeft.Height = picLeft.Height / 15 - 23
End Sub
Private Sub tbExit_Click()
mnuExit_Click
End Sub
Private Sub tbLeft_Click(Index As Integer)
cmdLeft_Click Index
End Sub
Private Sub tbLogin_Click()
mnuLogin_Click
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -