frmmdi.frm

一个用VB开发的考勤管理系统... 希望大家来看看..提出见意.. 谢谢.

         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