📄 frmmain.frm
字号:
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 300
Index = 0
Left = 240
TabIndex = 14
Top = 480
Value = -1 'True
Width = 1935
End
Begin VB.TextBox TxtQueryName
Height = 375
Left = 2280
TabIndex = 12
Top = 480
Width = 2055
End
Begin VB.TextBox TxtQueryRes
Height = 735
Left = 2280
MultiLine = -1 'True
TabIndex = 11
Top = 2400
Width = 3495
End
Begin VB.CommandButton CmdQuery
Caption = "确定"
Height = 375
Left = 4560
TabIndex = 10
Top = 3720
Width = 1095
End
Begin MSComCtl2.DTPicker DTPickerQuery
Height = 330
Left = 2280
TabIndex = 13
Top = 1560
Width = 1320
_ExtentX = 2328
_ExtentY = 582
_Version = 393216
Format = 169082881
CurrentDate = 37987
End
End
Begin VB.Frame FrameResult
Caption = "查询结果"
BeginProperty Font
Name = "楷体_GB2312"
Size = 14.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 4215
Left = 240
TabIndex = 18
Top = 1320
Visible = 0 'False
Width = 5895
Begin MSComctlLib.ListView LvResult
Height = 3735
Left = 120
TabIndex = 19
Top = 360
Width = 5600
_ExtentX = 9869
_ExtentY = 6588
View = 3
Arrange = 2
Sorted = -1 'True
LabelWrap = -1 'True
HideSelection = -1 'True
FullRowSelect = -1 'True
_Version = 393217
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
NumItems = 6
BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Text = "姓名"
Object.Width = 1587
EndProperty
BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 1
Text = "性别"
Object.Width = 1060
EndProperty
BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 2
Text = "来访时间"
Object.Width = 4234
EndProperty
BeginProperty ColumnHeader(4) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 3
Text = "来访理由"
Object.Width = 3175
EndProperty
BeginProperty ColumnHeader(5) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 4
Text = "记录用户"
Object.Width = 1589
EndProperty
BeginProperty ColumnHeader(6) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 5
Text = "备注"
Object.Width = 2540
EndProperty
End
End
Begin MSComctlLib.ImageList toolbarImg16
Left = 9000
Top = 0
_ExtentX = 1005
_ExtentY = 1005
BackColor = 16777215
ImageWidth = 16
ImageHeight = 16
MaskColor = 16777215
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 8
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "FrmMain.frx":0841
Key = "user"
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "FrmMain.frx":0D53
Key = "history"
EndProperty
BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "FrmMain.frx":0FCB
Key = "op_search"
EndProperty
BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "FrmMain.frx":1156
Key = "help"
EndProperty
BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "FrmMain.frx":154E
Key = "search"
EndProperty
BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "FrmMain.frx":1917
Key = "exit"
EndProperty
BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "FrmMain.frx":1BAD
Key = "out"
EndProperty
BeginProperty ListImage8 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "FrmMain.frx":1F5F
Key = "in"
EndProperty
EndProperty
End
Begin VB.Label labUser2
BackColor = &H80000001&
BackStyle = 0 'Transparent
Caption = " 当前用户："
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 270
Left = 0
TabIndex = 35
Top = 450
Width = 9975
End
Begin VB.Label labFoot
BackColor = &H80000005&
Caption = "版权所有： http://www.trfsoft.com 2007-2008"
Height = 615
Left = 4800
TabIndex = 27
Top = 4920
Width = 5535
End
Begin VB.Label labUser
BackColor = &H80000001&
Caption = " 当前用户："
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 300
Left = 50
TabIndex = 25
Top = 500
Width = 9975
End
Begin VB.Menu File
Caption = "文件"
Begin VB.Menu File_Exit
Caption = "退出(&X)"
End
End
Begin VB.Menu Operate
Caption = "车辆进出管理"
Begin VB.Menu Ope_Enter
Caption = "车辆进入(&E)"
Shortcut = ^E
End
Begin VB.Menu Ope_Exit
Caption = "车辆离开(&X)"
Shortcut = ^X
End
Begin VB.Menu Ope_Query
Caption = "车辆查询(&Q)"
Shortcut = ^Q
End
End
Begin VB.Menu Manage
Caption = "系统管理"
Begin VB.Menu Mgr_User
Caption = "用户管理..."
End
Begin VB.Menu Mgr_Operate
Caption = "操作记录..."
End
End
Begin VB.Menu Help
Caption = "帮助"
Begin VB.Menu Hlp_About
Caption = "关于"
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 m_ActivePage As Object '代表当前活动的页（用户控件）
'============================================
'功能：用来显示某一个用户控件
'参数：target_ctl: 在窗体主显示区域中要显示的用户控件
'============================================
Private Sub ShowGroup(ByRef target_ctl As Object)
'先设置所有控件均不可见
Me.ucEnter1.Visible = False
Me.ucExit1.Visible = False
Me.ucSearch1.Visible = False
Me.ucSearchResult1.Visible = False
Me.ucAbout1.Visible = False
'然后再设置目标控件可见并调整大小
target_ctl.Visible = True
target_ctl.Left = 0
target_ctl.Top = 0
target_ctl.Width = Me.picBody.Width
target_ctl.Height = Me.picBody.Height
Set m_ActivePage = target_ctl
End Sub
'============================================
'功能：响应菜单 文件/退出命令
'============================================
Private Sub File_Exit_Click()
Dim MyExit As Integer
MyExit = MsgBox("是否要退出程序？", vbYesNo + vbQuestion, "退出")
If MyExit = vbYes Then End
End Sub
'============================================
'功能：响应窗体加载事件
'============================================
Private Sub Form_Load()
Dim str As String
'显示当前用户状态
Select Case UserNow.Type
Case 0
str = "系统管理员"
Case 1
str = "普通用户"
Case 2
str = "高级用户"
End Select
Me.labUser.Caption = " 当前用户：" & UserNow.ID & " 用户类型：" & str
Me.labUser2.Caption = " 当前用户：" & UserNow.ID & " 用户类型：" & str
Call ShowGroup(Me.ucEnter1)
End Sub
'============================================
'功能：响应窗体大小更改事件
'============================================
Private Sub Form_Resize()
On Error Resume Next
With picBody
.Width = Me.Width
.Height = Me.ScaleHeight - .Top - Me.StatusBar1.Height
End With
End Sub
'============================================
'功能：响应窗体卸载更改事件
'============================================
Private Sub Form_Unload(Cancel As Integer)
'关闭数据库连接
DBCnn.Close
'退出整个系统
End
End Sub
'============================================
'功能：响应菜单 帮助/关于 命令
'============================================
Private Sub Hlp_About_Click()
Call ShowGroup(Me.ucAbout1)
End Sub
'============================================
'功能：响应菜单 系统管理/操作记录 命令
'============================================
Private Sub Mgr_Operate_Click()
If UserNow.Type <> 0 Then
MsgBox "对不起，您不是系统管理员，不能查询用户！"
Exit Sub
End If
'Call ShowGroup(Me.ucEnter1)
Call frmQueryRec.Show(vbModal, Me)
End Sub
'============================================
'功能：响应菜单 系统管理/用户管理 命令
'============================================
Private Sub Mgr_User_Click()
If UserNow.Type <> 0 Then
MsgBox "对不起，您不是系统管理员，不能查询用户！"
Exit Sub
End If
'Call ShowGroup(Me.ucEnter1)
Call frmUser.Show(vbModal, Me)
End Sub
'============================================
'功能：响应菜单 车辆进出管理/车辆进入 命令
'============================================
Private Sub Ope_Enter_Click()
Call ShowGroup(Me.ucEnter1)
End Sub
'============================================
'功能：响应菜单 车辆进出管理/车辆离开 命令
'============================================
Private Sub Ope_Exit_Click()
Call ShowGroup(Me.ucExit1)
End Sub
'============================================
'功能：响应菜单 车辆进出管理/车辆查询 命令
'============================================
Private Sub Ope_Query_Click() '查询
Call ShowGroup(Me.ucSearch1)
End Sub
'============================================
'功能：响应工具栏按钮命令
'============================================
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Key
Case "TB_IN" '车辆进入
Call Ope_Enter_Click
Case "TB_OUT" '车辆离开
Call Ope_Exit_Click
Case "TB_SEARCH" '查找车辆
Call Ope_Query_Click
Case "TB_USER" '用户管理
Call Mgr_User_Click
Case "TB_OP_SEARCH" '操作查询
Call Mgr_Operate_Click
Case "TB_ABOUT" '帮助/关于
Call Hlp_About_Click
Case "TB_EXIT" '退出
Call File_Exit_Click
End Select
End Sub
'============================================
'功能：响应 Picture 控件 picBody的Resize事件，其实可以放在Form_Resize中一起处理
'picBody是每一个用户控件的容器
'============================================
Private Sub picBody_Resize()
On Error Resume Next
If Not m_ActivePage Is Nothing Then
m_ActivePage.Width = picBody.Width
m_ActivePage.Height = picBody.Height
End If
Me.labUser.Width = picBody.Width
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -