www.pudn.com > 考勤管理系统源码(VB含串口接口程序).zip > frmMDI.frm
VERSION 5.00
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX"
Begin VB.MDIForm frmMDI
BackColor = &H00808000&
Caption = "考勤系统"
ClientHeight = 8310
ClientLeft = 165
ClientTop = 450
ClientWidth = 11880
Icon = "frmMDI.frx":0000
LinkTopic = "MDIForm1"
Picture = "frmMDI.frx":030A
StartUpPosition = 2 '屏幕中心
WindowState = 2 'Maximized
Begin ComctlLib.Toolbar tlbMain
Align = 1 'Align Top
Height = 750
Left = 0
TabIndex = 1
Top = 0
Width = 11880
_ExtentX = 20955
_ExtentY = 1323
ButtonWidth = 1455
ButtonHeight = 1164
Appearance = 1
ImageList = "imlToolbarIcons"
_Version = 327682
BeginProperty Buttons {0713E452-850A-101B-AFC0-4210102A8DA7}
NumButtons = 5
BeginProperty Button1 {0713F354-850A-101B-AFC0-4210102A8DA7}
Key = "tbCollection"
Object.ToolTipText = "打卡数据采集"
Object.Tag = ""
ImageIndex = 2
EndProperty
BeginProperty Button2 {0713F354-850A-101B-AFC0-4210102A8DA7}
Key = ""
Object.Tag = ""
Style = 3
MixedState = -1 'True
EndProperty
BeginProperty Button3 {0713F354-850A-101B-AFC0-4210102A8DA7}
Key = "tbLeave"
Object.ToolTipText = "请假登记"
Object.Tag = ""
ImageIndex = 3
EndProperty
BeginProperty Button4 {0713F354-850A-101B-AFC0-4210102A8DA7}
Key = ""
Object.Tag = ""
Style = 3
MixedState = -1 'True
EndProperty
BeginProperty Button5 {0713F354-850A-101B-AFC0-4210102A8DA7}
Key = "mClose"
Object.Tag = ""
ImageIndex = 1
EndProperty
EndProperty
End
Begin ComctlLib.StatusBar stbMain
Align = 2 'Align Bottom
Height = 360
Left = 0
TabIndex = 0
Top = 7950
Width = 11880
_ExtentX = 20955
_ExtentY = 635
SimpleText = ""
_Version = 327682
BeginProperty Panels {0713E89E-850A-101B-AFC0-4210102A8DA7}
NumPanels = 5
BeginProperty Panel1 {0713E89F-850A-101B-AFC0-4210102A8DA7}
AutoSize = 2
Key = ""
Object.Tag = ""
Object.ToolTipText = "日期"
EndProperty
BeginProperty Panel2 {0713E89F-850A-101B-AFC0-4210102A8DA7}
Style = 5
AutoSize = 2
TextSave = "16:36"
Key = ""
Object.Tag = ""
Object.ToolTipText = "时间"
EndProperty
BeginProperty Panel3 {0713E89F-850A-101B-AFC0-4210102A8DA7}
AutoSize = 2
Text = "操作员"
TextSave = "操作员"
Key = "stbOperater"
Object.Tag = ""
Object.ToolTipText = "操作员"
EndProperty
BeginProperty Panel4 {0713E89F-850A-101B-AFC0-4210102A8DA7}
Text = "操作级别"
TextSave = "操作级别"
Key = "stbLevel"
Object.Tag = ""
Object.ToolTipText = "操作级别"
EndProperty
BeginProperty Panel5 {0713E89F-850A-101B-AFC0-4210102A8DA7}
AutoSize = 1
Object.Width = 10134
Text = "提示信息"
TextSave = "提示信息"
Key = "stbMsg"
Object.Tag = ""
Object.ToolTipText = "提示信息"
EndProperty
EndProperty
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin ComctlLib.ImageList imlToolbarIcons
Left = 2265
Top = 1740
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 42
ImageHeight = 38
MaskColor = 12632256
_Version = 327682
BeginProperty Images {0713E8C2-850A-101B-AFC0-4210102A8DA7}
NumListImages = 3
BeginProperty ListImage1 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmMDI.frx":E8C0
Key = ""
EndProperty
BeginProperty ListImage2 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmMDI.frx":FC12
Key = ""
EndProperty
BeginProperty ListImage3 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmMDI.frx":10F64
Key = ""
EndProperty
EndProperty
End
Begin VB.Menu mnuFile
Caption = "文件(&F)"
Begin VB.Menu mnuFileReg
Caption = "登录(&L)..."
End
Begin VB.Menu mnuFileBar1
Caption = "-"
End
Begin VB.Menu mnuFileExit
Caption = "退出(&X)"
End
End
Begin VB.Menu mnuEdit
Caption = "编辑(&E)"
Visible = 0 'False
Begin VB.Menu mnuEditCut
Caption = "剪切(&T)"
Shortcut = ^X
End
Begin VB.Menu mnuEditCopy
Caption = "复制(&C)"
Shortcut = ^C
End
Begin VB.Menu mnuEditPaste
Caption = "粘贴(&P)"
Shortcut = ^V
End
End
Begin VB.Menu mnuApp
Caption = "应用(&A)"
Begin VB.Menu mnuAppCollection
Caption = "打卡数据采集(&C)..."
End
Begin VB.Menu mnuAppBar1
Caption = "-"
End
Begin VB.Menu mnuAppDefine
Caption = "班次定义(&D)..."
End
Begin VB.Menu mnuAppPlan
Caption = "日常排班(&P)..."
End
Begin VB.Menu mnuAppChange
Caption = "调班换班(&H)..."
End
Begin VB.Menu mnuAppBar2
Caption = "-"
End
Begin VB.Menu mnuAppLeave
Caption = "请假登记(&L)..."
End
Begin VB.Menu mnuAppAbsent
Caption = "其他缺席登记(B)..."
End
End
Begin VB.Menu mnuGuard
Caption = "数据管理(&G)"
Begin VB.Menu mnuGuardBase
Caption = "基本数据管理(&B)..."
End
Begin VB.Menu mnuGuardEmployee
Caption = "员工管理(&E)..."
End
Begin VB.Menu mnuGuardBar1
Caption = "-"
End
Begin VB.Menu mnuGuardRight
Caption = "权限管理(&R)..."
End
Begin VB.Menu mnuGuardBar2
Caption = "-"
End
Begin VB.Menu mnuGuardLib
Caption = "数据库管理..."
End
End
Begin VB.Menu mnuRep
Caption = "报表中心(&R)"
Begin VB.Menu mnuRepShift
Caption = "班次表(&S)..."
Visible = 0 'False
End
Begin VB.Menu mnuRepPlan
Caption = "排班表(&P)..."
Visible = 0 'False
End
Begin VB.Menu mnuRepDyn
Caption = "日动态考勤报表(&D)"
End
Begin VB.Menu mnuRepFlow
Caption = "打卡流水报表(&F)..."
End
Begin VB.Menu mnuRepBar1
Caption = "-"
End
Begin VB.Menu mnuRepKQ
Caption = "考勤明细报表(&K)..."
End
Begin VB.Menu mnuRepMonth
Caption = "考勤月报表(&M)..."
End
End
Begin VB.Menu mnuCard
Caption = "IC卡管理(&I)"
Begin VB.Menu mnuCardNew
Caption = "发新卡(&N)..."
End
Begin VB.Menu mnuCardChange
Caption = "更换IC卡(&C)..."
End
Begin VB.Menu mnuCardBar1
Caption = "-"
End
Begin VB.Menu mnuPowerOn
Caption = "上电"
End
Begin VB.Menu mnuPowerOff
Caption = "下电"
End
Begin VB.Menu mnuATR
Caption = "复位应答"
End
Begin VB.Menu mnuReadMain
Caption = "读主存储器"
End
Begin VB.Menu mnuReadProtect
Caption = "读保护存储器"
End
Begin VB.Menu mnuSecurity
Caption = "读保密存储器"
End
Begin VB.Menu mnuReadErrorCount
Caption = "读错误计数"
End
Begin VB.Menu mnuPSCCheck
Caption = "校对密码"
End
Begin VB.Menu mnuChangePSC
Caption = "更改密码"
End
Begin VB.Menu mnuWriteMain
Caption = "写主存储器"
End
End
Begin VB.Menu mnuPos
Caption = "考勤机管理(&K)"
Begin VB.Menu mnuPosSetDate
Caption = "考勤机时间设置(&S)..."
End
Begin VB.Menu mnuPosSetRecordCount
Caption = "考勤机记录总数设置"
End
Begin VB.Menu mnuPosSetPort
Caption = "通讯端口设置"
Begin VB.Menu mnuPosSetComm
Caption = "串口1"
Index = 0
End
Begin VB.Menu mnuPosSetComm
Caption = "串口2"
Index = 1
End
End
End
Begin VB.Menu mnuSet
Caption = "设置(&S)"
Begin VB.Menu mnuSetOption
Caption = "选项(&O)..."
End
End
End
Attribute VB_Name = "frmMDI"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Const MDIMsg1 = "您确定要退出本系统吗?"
Const mStrCollection = "打卡数据采集"
Const mStrLeave = "请假登记"
Const mstrAbsent = "其他缺席登记"
Const mMsg2 = "抱歉,您的权限不够操作该模块!!!"
'tlbMain
Const mClose = 5
'stbMain
Const mstbDate = 1
Const mstbTime = 2
Const mstbOperator = 3
Const mstbLevel = 4
Const mstbMsg = 5
Dim misStart As Boolean
Private Sub MDIForm_Activate()
If misStart Then
SetMenu gLoginGrade = 1
misStart = False
End If
End Sub
Private Sub MDIForm_Load()
mnuPosSetComm(gCommPort).Checked = True
Me.WindowState = 2
misStart = True
End Sub
Private Sub MDIForm_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If UnloadMode = vbFormControlMenu Then
If MsgBox(MDIMsg1, _
vbQuestion + vbYesNo + vbDefaultButton2, _
gTitle) = vbNo Then Cancel = True
End If
End Sub
Private Sub MDIForm_Unload(Cancel As Integer)
EndSystem
End Sub
Private Sub mnuAppAbsent_Click()
IntofrmMain gMAINABSENT
End Sub
Private Sub mnuAppChange_Click()
frmChange.Show vbModal
End Sub
Private Sub mnuAppCollection_Click()
IntofrmMain gMAINCOLLECT
End Sub
Private Sub IntofrmMain(intMainType As Integer)
Dim MyfrmMain As frmMain
Set MyfrmMain = New frmMain
Dim Str As String
With MyfrmMain
.mMenuIndex = intMainType
Select Case intMainType
Case gMAINCOLLECT
Str = mStrCollection
Case gMAINLEAVE
Str = mStrLeave
Case gMAINABSENT
Str = mstrAbsent
End Select
.Caption = Str
.Show 0, Me
End With
'Unload MyfrmMain
End Sub
Private Sub mnuAppDefine_Click()
frmShift.Show vbModal
End Sub
Private Sub mnuAppLeave_Click()
IntofrmMain gMAINLEAVE
End Sub
Private Sub mnuAppPlan_Click()
frmPlan.Show vbModal
End Sub
Private Sub mnuATR_Click()
Dim strATR As String * 8
Dim nRet As Integer
nRet = OpenComm(0)
nRet = CardExist
If nRet = 0 Then
MsgBox "No Card"
Exit Sub
End If
nRet = IC_ATR(strATR)
If nRet <> 0 Then
MsgBox "Error Read ATR"
Exit Sub
End If
frmReadWrite.txtData.Text = Mid(strATR, 1, 1) & Mid(strATR, 2, 1) & " " & _
Mid(strATR, 3, 1) & Mid(strATR, 4, 1) & " " & _
Mid(strATR, 5, 1) & Mid(strATR, 6, 1) & " " & _
Mid(strATR, 7, 1) & Mid(strATR, 8, 1)
frmReadWrite.Show 1
End Sub
Private Sub mnuCardNew_Click()
frmNewCard.Show 1
End Sub
Private Sub mnuFileExit_Click()
If MsgBox(MDIMsg1, _
vbQuestion + vbYesNo + vbDefaultButton2, _
gTitle) = vbNo Then Exit Sub
EndSystem
End Sub
Private Sub mnuFileReg_Click()
frmLogin.Show 1
SetMenu gLoginGrade = 1
End Sub
Private Sub mnuGuardBase_Click()
frmItem.Show 1
End Sub
Private Sub mnuGuardEmployee_Click()
frmEmploy.Show vbModal
End Sub
Private Sub mnuGuardLib_Click()
frmSys.Show 1
End Sub
Private Sub mnuPosSetComm_Click(Index As Integer)
mnuPosSetComm(0).Checked = (Index = 0)
mnuPosSetComm(1).Checked = (Index = 1)
gCommPort = Index
End Sub
Private Sub mnuPosSetDate_Click()
frmSetDate.Show 1
End Sub
Private Sub mnuPosSetRecordCount_Click()
frmSetRecordCount.Show 1
End Sub
Private Sub mnuPowerOff_Click()
Dim nRet As Integer
nRet = OpenComm(0)
nRet = PowerOff
End Sub
Private Sub mnuPowerOn_Click()
Dim nRet As Integer
nRet = OpenComm(0)
nRet = PowerOn
End Sub
Private Sub mnuReadMain_Click()
Dim strMain As String * 512
Dim i As Integer, j As Integer, nRet As Integer
nRet = OpenComm(0)
nRet = IC_ReadMain(0, 256, strMain)
If nRet <> 0 Then
MsgBox "Error Read Main Memory"
Exit Sub
End If
frmReadWrite.txtData.Text = ""
For i = 0 To 15
For j = 0 To 15
frmReadWrite.txtData.Text = frmReadWrite.txtData.Text & Mid(strMain, 32 * i + 2 * j + 1, 1) & Mid(strMain, 32 * i + 2 * j + 2, 1) & " "
Next j
frmReadWrite.txtData.Text = frmReadWrite.txtData.Text & Chr(13) & Chr(10)
Next i
frmReadWrite.Show 1
End Sub
Private Sub mnuRepDyn_Click()
frmDyn.Show 1
End Sub
Private Sub mnuRepFlow_Click()
frmFlow.Show 1
End Sub
Private Sub mnuRepKQ_Click()
frmPrn.Show 1
End Sub
Private Sub mnuRepMonth_Click()
With frmMonth
.Show '不能显示有模式,因当中有显示非模式的窗体
End With
End Sub
Private Sub SetMenu(isEnable As Boolean)
'mnuFile.Enabled = isEnable
mnuApp.Enabled = isEnable
mnuGuard.Enabled = isEnable
mnuRep.Enabled = isEnable
mnuCard.Enabled = isEnable
mnuPos.Enabled = isEnable
mnuSet.Enabled = isEnable
SetstbMain mstbOperator, gLoginName
Dim strTmp As String
If isEnable Then
strTmp = "管理员"
Else
strTmp = "客户级"
End If
SetstbMain mstbLevel, strTmp
SetstbMain mstbDate, Format(Date, "yyyy-mm-dd")
SetstbMain mstbMsg, gOwnName
End Sub
Private Sub SetstbMain(Index As Integer, strText As String)
stbMain.Panels(Index).Text = strText
End Sub
Private Sub mnuSetOption_Click()
frmOption.Show 1
End Sub
Private Sub Toolbar1_ButtonClick(ByVal Button As ComctlLib.Button)
On Error Resume Next
If Button.Index <> mClose Then
If gLoginGrade = 0 Then
MsgBox mMsg2, vbInformation, gTitle
Exit Sub
End If
End If
Select Case Button.Key
Case "tbCollection"
mnuAppCollection_Click
Case "tbLeave"
mnuAppLeave_Click
End Select
End Sub