📄 frmmain.frm
字号:
Caption = "记录"
ToolTip = "从服务器取得记录"
BackColor = 13752539
MouseDownColor = 12363422
MouseOnColor = 14204854
StyleColor = 6956042
Style3dColor1 = 6956042
Style3dColor2 = 6956042
Picture = "frmMain.frx":6CF0
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin VB.Line Line1
BorderColor = &H00A6A6A6&
Index = 1
X1 = 528
X2 = 528
Y1 = 0
Y2 = 24
End
Begin VB.Line Line1
BorderColor = &H00A6A6A6&
Index = 0
X1 = 40
X2 = 40
Y1 = 0
Y2 = 24
End
Begin VB.Image Image3
Height = 360
Left = 0
Picture = "frmMain.frx":708A
Top = 0
Width = 360
End
End
Begin yfDNetMenu.DNetMenu DNetMenu1
Left = 4680
Top = 4680
_ExtentX = 847
_ExtentY = 847
BmpCount = 6
Bmp:1 = "frmMain.frx":77F4
Key:1 = "#mnuLeft:6"
Bmp:2 = "frmMain.frx":855C
Key:2 = "#mnuLogin"
Bmp:3 = "frmMain.frx":8984
Key:3 = "#mnuDBBackUp"
Bmp:4 = "frmMain.frx":8DAC
Key:4 = "#mnuDBResume"
Bmp:5 = "frmMain.frx":91D4
Key:5 = "#mnuExit"
Bmp:6 = "frmMain.frx":95FC
Key:6 = "#mnuAbout"
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 mnuFile
Caption = "文件(&F)"
Begin VB.Menu mnuLogin
Caption = "返回登陆界面(&R)"
Shortcut = ^R
End
Begin VB.Menu mnuFileSP1
Caption = "-"
End
Begin VB.Menu mnuDBBackUp
Caption = "备份数据库"
End
Begin VB.Menu mnuDBResume
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 = "销售管理(&S)"
Index = 3
Shortcut = ^S
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
Begin VB.Menu mnuViewSP1
Caption = "-"
End
Begin VB.Menu mnuGuide
Caption = "导航栏(&G)"
Checked = -1 'True
Shortcut = ^G
End
Begin VB.Menu mnuTB
Caption = "工具条(&T)"
Checked = -1 'True
Shortcut = ^T
End
Begin VB.Menu mnuSB
Caption = "状态栏(&B)"
Checked = -1 'True
Shortcut = ^B
End
End
Begin VB.Menu mnuHelp
Caption = "帮助(&H)"
Begin VB.Menu mnuContent
Caption = "内容(&C)"
Shortcut = {F1}
End
Begin VB.Menu mnuSupply
Caption = "技术支持(&S)"
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
If LastFrm > -1 Then
cmdLeft(LastFrm).IfDraw = False
tbLeft(LastFrm).IfDraw = False
'mnuLeft(LastFrm).Checked = False
cmdLeft(LastFrm).BackColor = picLeft.BackColor
tbLeft(LastFrm).BackColor = picTB.BackColor
Else
Unload frmWelcome
End If
Select Case LastFrm
Case 0: Unload frmks
Case 1: Unload frmBk
Case 2: Unload Frmxxlr
Case 3: Unload Frmgrkscj
Case 4:
Case 5: Unload frmUser
Case 6: Unload frmbj
Case 7:
Case 8:
End Select
LastFrm = Index
cmdLeft(Index).IfDraw = True
tbLeft(Index).IfDraw = True
'mnuLeft(Index).Checked = True
cmdLeft(Index).BackColor = 14210516
tbLeft(Index).BackColor = 14210516
SetSB 1, "现在位置：" & cmdLeft(Index).Caption
Select Case Index
Case 0: frmks.Show
Case 1: frmBk.Show
Case 2: Frmxxlr.Show
Case 3: Frmgrkscj.Show
Case 4:
Case 5: frmUser.Show
Case 6: frmbj.Show
Case 7:
Case 8:
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()
'取消窗体最大化
Dim TempLng As Long
TempLng = GetWindowLong(Me.hWnd, GWL_STYLE)
TempLng = TempLng And Not WS_MAXIMIZEBOX '最大化
SetWindowLong Me.hWnd, GWL_STYLE, TempLng
'读取窗体位置,视图信息
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
picLeft.Visible = False
mnuGuide.Checked = False
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
mnuSB.Checked = False
End If
'判断用户类型
'cmdLeft(6).Enabled = (curUserStyle >= 3)
'tbLeft(6).Enabled = (curUserStyle >= 3)
'mnuLeft(6).Enabled = (curUserStyle >= 3)
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
frmWelcome.SetBack
frmWelcome.Hide
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 "唐红独立开发完成。", 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 + -