frmsetclerk.frm

用VB6.0编写的关于车辆运输调度的系统

        .HideSelection = False
        .View = lvwReport
    End With
    Me.KeyPreview = True
    Exit Sub
Fail:
    err.Raise err.Number, , err.Description
End Sub



Private Sub lsvClerk_ItemClick(ByVal Item As MSComctlLib.ListItem)
Dim ClerkCode As String

ClerkCode = Right(lsvClerk.SelectedItem.Key, Len(lsvClerk.SelectedItem.Key) - 1)
Call ScanClerk(ClerkCode)

End Sub

Private Sub ScanClerk(ByVal ClerkCode As String)
Dim sSQL As String
Dim rstClerk As Recordset

    sSQL = "select * from sysusr where usrcode='" & ClerkCode & "'"
    Set rstClerk = Acs_cnt.Execute(sSQL)
    
    With rstClerk
    Do While Not .EOF
        txtCode = rstClerk!UsrCode
        txtName = "" & rstClerk!UrsName
        txtContack.Text = "" & rstClerk!Contack
        txtPass = "" & rstClerk!passwrd
        txtRemarks = "" & rstClerk!remarks
        If IsNull(rstClerk!RolCode) = False And Trim(rstClerk!RolCode) <> "" Then
            Call SetCmbRole(rstClerk!RolCode)
        End If
        .MoveNext
    Loop
    End With
    
    rstClerk.Close
    Set rstClerk = Nothing
    
    Exit Sub
Fail:
   
End Sub

Private Sub SetCmbRole(ByVal RolCode As String)
Dim i As Long

For i = 1 To cmbRole.ListCount
    If cmbRole.ItemData(i - 1) = RolCode Then
        cmbRole.Text = cmbRole.List(i - 1)
    End If
Next i

End Sub

Private Sub IniClerkDetail()
        
    txtCode.Locked = False
    txtPass.Locked = False
    txtconfirm.Locked = False
            
    txtCode.Text = ""
    txtPass.Text = ""
    txtName.Text = ""
    txtRemarks.Text = ""
    txtContack.Text = ""
    txtPass.Text = ""

End Sub

Private Sub SetToolBar(ByVal mkey As String)
        
        Select Case mkey
        Case "new"
            With UserControl1
                .DisplayButton "New", "New", False, , "New"
'                .DisplayButton "Find", "Find", False, , "Find"
                .DisplayButton "Delete", "Delete", False, , "Delete"
'                .DisplayButton "Print", "Print", True, , "Print"
                .DisplayButton "Modify", "Modify", False, , "Modify"
                .DisplayButton "Save", "Save", True, , "Save"
                .DisplayButton "Cancel", "Cancel", True, , "Cancel"
'                .DisplayButton "Redo", "Redo", True, , "Redo"
                .DisplayButton "Close", "Close", False, , "Close"
            End With
            frmClerk.Enabled = False
            frmClerkDetail.Enabled = True
            txtCode.SetFocus
        Case "modify"
            With UserControl1
                .DisplayButton "New", "New", False, , "New"
'                .DisplayButton "Find", "Find", False, , "Find"
                .DisplayButton "Delete", "Delete", False, , "Delete"
'                .DisplayButton "Print", "Print", False, , "Print"
                .DisplayButton "Modify", "Modify", False, , "Modify"
                .DisplayButton "Save", "Save", True, , "Save"
                .DisplayButton "Cancel", "Cancel", True, , "Cancel"
'                .DisplayButton "Redo", "Redo", True, , "Redo"
                .DisplayButton "Close", "Close", False, , "Close"
            End With
            frmClerk.Enabled = False
            frmClerkDetail.Enabled = True
        Case "cancel"
            With UserControl1
                .DisplayButton "New", "New", True, , "New"
'                .DisplayButton "Find", "Find", True, , "Find"
                .DisplayButton "Delete", "Delete", True, , "Delete"
'                .DisplayButton "Print", "Print", True, , "Print"
                .DisplayButton "Modify", "Modify", True, , "Modify"
                .DisplayButton "Save", "Save", False, , "Save"
                .DisplayButton "Cancel", "Cancel", False, , "Cancel"
'                .DisplayButton "Redo", "Redo", False, , "Redo"
                .DisplayButton "Close", "Close", True, , "Close"
            End With
            frmClerk.Enabled = True
            frmClerkDetail.Enabled = False
        Case "delete"
            With UserControl1
                .DisplayButton "New", "New", True, , "New"
'                .DisplayButton "Find", "Find", True, , "Find"
                .DisplayButton "Delete", "Delete", True, , "Delete"
'                .DisplayButton "Print", "Print", True, , "Print"
                .DisplayButton "Save", "Save", False, , "Save"
                .DisplayButton "Modify", "Modify", True, , "Modify"
                .DisplayButton "Cancel", "Cancel", False, , "Cancel"
'                .DisplayButton "Redo", "Redo", False, , "Redo"
                .DisplayButton "Close", "Close", True, , "Close"
            End With
            frmClerk.Enabled = True
            frmClerkDetail.Enabled = False
        Case "save"
            With UserControl1
                .DisplayButton "New", "New", True, , "New"
'                .DisplayButton "Find", "Find", True, , "Find"
                .DisplayButton "Delete", "Delete", True, , "Delete"
'                .DisplayButton "Print", "Print", True, , "Print"
                .DisplayButton "Save", "Save", False, , "Save"
                .DisplayButton "Modify", "Modify", True, , "Modify"
                .DisplayButton "Cancel", "Cancel", False, , "Cancel"
'                .DisplayButton "Redo", "Redo", False, , "Redo"
                .DisplayButton "Close", "Close", True, , "Close"
            End With
            frmClerk.Enabled = True
            frmClerkDetail.Enabled = False
'        Case Else
'            With UserControl1
'                .DisplayButton "New", "New", True, , "New"
''                .DisplayButton "Find", "Find", True, , "Find"
'                .DisplayButton "Delete", "Delete", True, , "Delete"
''                .DisplayButton "Print", "Print", True, , "Print"
'                .DisplayButton "Save", "Save", False, , "Save"
'                .DisplayButton "Modify", "Modify", True, , "Modify"
'                .DisplayButton "Cancel", "Cancel", False, , "Cancel"
''                .DisplayButton "Redo", "Redo", False, , "Redo"
'                .DisplayButton "Close", "Close", True, , "Close"
'            End With
'            frmClerk.Enabled = True
'            frmClerkDetail.Enabled = False
        End Select
    
    Call EnableDelete(gsRoleCode, UserControl1)
End Sub



Private Sub txtcode_KeyUp(KeyCode As Integer, Shift As Integer)

    If KeyCode = vbKeyReturn Then
         SendKeys "{tab}"
    End If
    
End Sub

Private Sub txtContack_KeyUp(KeyCode As Integer, Shift As Integer)

    If KeyCode = vbKeyReturn Then
         SendKeys "{tab}"
    End If
    
End Sub

Private Sub txtname_KeyUp(KeyCode As Integer, Shift As Integer)

    If KeyCode = vbKeyReturn Then
         SendKeys "{tab}"
    End If
    
End Sub

Private Sub txtPass_KeyUp(KeyCode As Integer, Shift As Integer)

    If KeyCode = vbKeyReturn Then
         SendKeys "{tab}"
    End If
    
End Sub



Private Sub txtRemarks_KeyUp(KeyCode As Integer, Shift As Integer)

    If KeyCode = vbKeyReturn Then
         SendKeys "{tab}"
    End If
    
End Sub

Private Sub UserControl1_ButtonClick(ByVal Button As MSComctlLib.Button)
    On Error Resume Next
    mkey = LCase(Button.Key)
    
    Select Case LCase(Button.Key)
        Case "new"
            lblStatus.Caption = mkey
            Call IniClerkDetail
            
        Case "edit"

        Case "save"
            If lblStatus.Caption = "new" Then
                If SaveClerkInfo = True Then
                    Call RefershClerk
                Else
                    Exit Sub
                End If
            ElseIf lblStatus.Caption = "modify" Then
                If ModifyClerkInfo = True Then
                    Call RefershClerk
                Else
                    Exit Sub
                End If
            End If
        Case "cancel"
            Call RefershClerk
        Case "delete"
            If MsgBox("Are you want delete this usercode?", vbYesNo + vbQuestion, "Message") = vbYes Then
                Call DeleteClerkInfo
                Call RefershClerk
            Else
                Exit Sub
            End If
        Case "modify"
            lblStatus.Caption = mkey
            txtCode.Locked = True
            txtPass.Locked = True
            txtconfirm.Locked = True
        Case "close"
            Unload Me
            Exit Sub
        Case Else
    End Select
    
    Call SetToolBar(mkey)
    
End Sub

Private Function ModifyClerkInfo() As Boolean
Dim sSQL As String
Dim sCode As String
Dim sRemark As String, sname As String, sContack As String, sRoleCode As String


ModifyClerkInfo = False

sRemark = txtRemarks.Text
sCode = txtCode.Text
sname = Trim(txtName.Text)
If sname = "" Then
    MsgBox "User name can't be null!", vbOKOnly + vbExclamation, "Message"
    Exit Function
End If
sContack = txtContack.Text
sRoleCode = cmbRole.ItemData(cmbRole.ListIndex)
If sRoleCode = "" Then
    MsgBox "Role code can't be null!", vbOKOnly + vbExclamation, "Message"
    Exit Function
End If
sSQL = "update sysusr set remarks='" & sRemark & "' ,rolcode='" & sRoleCode & "',contack='" & sContack & "' ,ursname='" & sname & "' where usrcode='" & sCode & "'"

Acs_cnt.BeginTrans
Acs_cnt.Execute (sSQL)
Acs_cnt.CommitTrans

ModifyClerkInfo = True

End Function

Private Sub DeleteClerkInfo()
Dim sSQL As String
Dim sCode As String

    sCode = Right(lsvClerk.SelectedItem.Key, Len(lsvClerk.SelectedItem.Key) - 1)
    sSQL = "delete from sysusr where usrcode='" & sCode & "'"
    
    Acs_cnt.BeginTrans
    Acs_cnt.Execute (sSQL)
    Acs_cnt.CommitTrans


End Sub
Private Function SaveClerkInfo() As Boolean
On Error GoTo err
Dim sCode As String, sname As String, sRemark As String, sContack As String
Dim sPass As String, sConPass As String
Dim rstClerk As Recordset
Dim sSQL As String, sRole As String

SaveClerkInfo = False

sCode = Trim(txtCode.Text)
If sCode = "" Then
    MsgBox "User Code Cant't be Null!", vbOKOnly + vbExclamation, "Message"
    Exit Function
End If
sname = Trim(txtName.Text)
If sname = "" Then
    MsgBox "User Name Cant't be Null!", vbOKOnly + vbExclamation, "Message"
    Exit Function
End If

sPass = Trim(txtPass.Text)
sConPass = Trim(txtconfirm.Text)
If sPass <> sConPass Then
    MsgBox "Password is worng!", vbOKOnly + vbExclamation, "Message"
    Exit Function
End If

sRole = Trim(cmbRole.ItemData(cmbRole.ListIndex))
If sRole = "" Then
    MsgBox "User Role Cant't be Null!", vbOKOnly + vbExclamation, "Message"
    Exit Function
End If
sRemark = Trim(txtRemarks.Text)
sContack = Trim(txtContack.Text)



sSQL = "select * from sysusr where usrcode='" & sCode & "'"
Set rstClerk = Acs_cnt.Execute(sSQL)
With rstClerk
If Not .EOF Then
    MsgBox "This user code is exist,please change your user code!", vbOKOnly + vbExclamation, "Error"
    Exit Function
End If
End With


sSQL = "insert into sysusr(usrcode,ursname,passwrd,rolcode,contack,remarks)" & _
       " values('" & sCode & "','" & sname & "','" & sPass & "','" & sRole & "','" & sContack & "','" & sRemark & "') "


Acs_cnt.BeginTrans
Acs_cnt.Execute (sSQL)
Acs_cnt.CommitTrans

SaveClerkInfo = True

Exit Function
err:
    MsgBox err.Description, vbOKOnly + vbExclamation, "Error"

End Function

Private Sub RefershClerk()
    
    lsvClerk.ListItems.Clear
    Call ShowClerks
    
End Sub