frmitem.frm

一个完整的考勤管理系统。开发工具vb6.0

    Exit Sub
SaveErr:
    MsgBox gMsg5 & vbCrLf & Err.Description, vbExclamation, gTitle
    Err.Clear
End Sub
Private Sub DeleteData()
    Dim IsTrans As Boolean
    With msfGrid
        If .Rows <= .FixedRows Then Exit Sub
        If .row < .FixedRows Then
            MsgBox gMsg4, vbExclamation, gTitle
            Exit Sub
        End If
        Dim tmpStr As String
'        If mTableName = "Title" Then
'            tmpStr = mMsg3
'        ElseIf mTableName = "LeaveType" Then
'            tmpStr = mMsg4
'        ElseIf mTableName = "Department" Then
'            tmpStr = mMsg5
'        End If
'
'        If MsgBox(tmpStr, vbQuestion + vbOKCancel _
'            + vbDefaultButton2, gTitle) = vbCancel Then Exit Sub
        If MsgBox(gMsg10, vbOKCancel + vbQuestion + vbDefaultButton2) = vbCancel Then Exit Sub
        
        Dim lngID As Long
        lngID = Val(.TextMatrix(.row, mGRIDID))
        
        If mTableName = "Title" Then
            mSql = "select * from Employee where TitleID=" _
                & lngID & " order by WorkNo"
        ElseIf mTableName = "LeaveType" Then
            mSql = "select * from Leave where TypeId=" _
                & lngID & " order by WorkNo"
        ElseIf mTableName = "Department" Then
            mSql = "select * from Employee where DeptID=" _
                & lngID & " order by WorkNo"
        End If
        
        Set mRst = gDataBase.OpenRecordset(mSql)
        If mRst.RecordCount > 0 Then
            If mTableName = "Title" Then
                tmpStr = mMsg3
            ElseIf mTableName = "LeaveType" Then
                tmpStr = mMsg4
            ElseIf mTableName = "Department" Then
                tmpStr = mMsg5
            End If
            MsgBox tmpStr, vbExclamation, gTitle
            Exit Sub
        End If

        If Not ValidTableName Then Exit Sub
        On Error GoTo DeleteErr
        BeginTrans
        IsTrans = True
        
'        If mTableName = "LeaveType" Then
'            mSql = "update " & "Leave" & _
'                " set F_DelFlag=" & gTRUE _
'                & " Where TypeID=" & lngID
'        ElseIf mTableName = "Title" Then
'            mSql = "update " & "Employee" & _
'                " set F_DelFlag=" & gTRUE _
'                & " Where TitleID=" & lngID
'        ElseIf mTableName = "Department" Then
'            mSql = "update " & "Employee" & _
'                " set F_DelFlag=" & gTRUE _
'                & " Where DeptID=" & lngID
'        End If
'        gDataBase.Execute mSql
        
        mSql = "update " & mTableName & _
            " set F_DelFlag=" & gTRUE _
            & " Where ID=" & lngID
        gDataBase.Execute mSql
        CommitTrans
        IsTrans = False
        
        If .Rows = .FixedRows + 1 Then
            .Rows = .FixedRows
        Else
            .RemoveItem .row
        End If
        
    End With
    mSql = ""
    Exit Sub
DeleteErr:
    If IsTrans Then Rollback
    MsgBox gMsg6 & vbCrLf & Err.Description, vbExclamation, gTitle
    Err.Clear
End Sub

Private Function ValidTableName() As Boolean
    ValidTableName = True
    If mTableName = "" Then
        MsgBox mMsg2, vbInformation, gTitle
        cboTable.SetFocus
        ValidTableName = False
        Exit Function
    End If
End Function

Private Sub AppendData()
    Dim strName As String
    strName = Trim(txtName)
    If strName = Empty Then
        MsgBox mMsg1, vbInformation, gTitle
        txtName.SetFocus
        Exit Sub
    End If
    
    If Not ValidTableName Then Exit Sub
    
    On Error GoTo AppendErr
    mSql = " select * from " & mTableName _
        & " where Name='" & strName & "'" _
        & " and F_DelFlag=" & gFALSE
    Set mRst = gDataBase.OpenRecordset(mSql)
    If mRst.RecordCount > 0 Then
        MsgBox gMsg3, vbExclamation, gTitle
        txtName.SetFocus
        Exit Sub
    End If
    
    mSql = "Insert into " & mTableName & "(Name)" _
        & " values('" & strName & "')"
    gDataBase.Execute mSql
    RefreshGrid mTableName
    txtName = ""
    txtName.SetFocus
    Exit Sub
AppendErr:
    MsgBox gMsg7 & vbCrLf & Err.Description, vbExclamation, gTitle
    Err.Clear
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    Dim AltDown As Boolean
    AltDown = (Shift And vbAltMask) > 0
    If AltDown Then
        Select Case KeyCode
            Case vbKeyA
                cmdEdit_Click mAPPEND
            Case vbKeyS
                cmdEdit_Click mSAVE
            Case vbKeyD
                cmdEdit_Click mDELETE
            Case vbKeyR
                cmdEdit_Click mRETURN
        End Select
    End If
    
    If KeyCode = vbKeyF2 Then
        cmdEdit_Click mSAVE
    End If
    If KeyCode = 27 Then
        cmdEdit_Click mRETURN
    End If
End Sub

Private Sub Form_Load()
    IniForm
    IniCbo
End Sub


Private Function GetTableName(IntID As Long) As String
    GetTableName = Empty
    Dim I As Integer
    For I = 0 To UBound(mATable)
        If mATable(I).ID = IntID Then
            GetTableName = Trim(mATable(I).TableName)
            Exit For
        End If
    Next
End Function

Private Sub IniCbo()
    ReDim mATable(0)
    Dim IntLen As Integer
    mATable(0).ID = 0
    mSql = "select F_ID,F_TableName,F_ItemName from T_Struct order by F_ID "
    Set mRst = gDataBase.OpenRecordset(mSql, dbOpenSnapshot)
    While Not mRst.EOF
        IntLen = UBound(mATable)
        IntLen = IntLen + 1
        ReDim Preserve mATable(IntLen)
        With mATable(IntLen)
            .ID = mRst!F_ID
            .TableName = IIf(IsNull(mRst!F_TableName), "", Trim(mRst!F_TableName))
            .Alias = IIf(IsNull(mRst!F_ItemName), "", Trim(mRst!F_ItemName))
        End With
        mRst.MoveNext
    Wend
    mRst.Close
    Set mRst = Nothing
    
    Dim I As Integer
    If UBound(mATable) > 0 Then
        For I = 1 To UBound(mATable)
            With mATable(I)
                cboTable.AddItem .Alias
                cboTable.ItemData(cboTable.NewIndex) = .ID
            End With
        Next
        cboTable.ListIndex = 0
    End If
    cmdEdit(mAPPEND).Enabled = (cboTable.ListCount > 0)
End Sub


Private Sub msfGrid_DblClick()
    With msfGrid
        If .MouseRow = 0 Then Exit Sub
        If .Rows <= .FixedRows Then Exit Sub
        mOldName = Trim(.TextMatrix(.row, mGridName))
        SetTxtPosition msfGrid, txtEdit
    End With
End Sub

Private Sub msfGrid_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn Then
        msfGrid_DblClick
    End If
End Sub

Private Sub txtEdit_GotFocus()
    GotFocus txtEdit
End Sub

Private Sub txtEdit_KeyDown(KeyCode As Integer, Shift As Integer)
    Select Case KeyCode
        Case vbKeyReturn
            Dim strName As String
            strName = Trim(txtEdit)
            If strName = Empty Then Exit Sub
            txtEdit.Visible = False
            If mOldName <> strName Then
                With msfGrid
                    .TextMatrix(.row, mGridName) = strName
                    .TextMatrix(.row, mGRIDLOG) = gTRUE
                End With
                If Not cmdEdit(mSAVE).Enabled Then cmdEdit(mSAVE).Enabled = True
            End If
            msfGrid.SetFocus
        Case vbKeyDown, vbKeyUp
            txtEdit.Visible = False
            KeyDownByUpDown msfGrid, KeyCode
            msfGrid.SetFocus
    End Select
End Sub

Private Sub txtEdit_LostFocus()
    txtEdit.Visible = False
End Sub

Private Sub txtName_GotFocus()
    GotFocus txtName
End Sub

Private Sub txtName_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn Then
        SendKeyTab KeyCode
    End If
End Sub