⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frmclerkset.frm

📁 证券公司监测内部客户资金流向的系统
💻 FRM
📖 第 1 页 / 共 2 页
字号:
            cmdNew.Enabled = False
            cmdCancel.Enabled = True
            cmdSave.Enabled = True
            cmdModify.Enabled = False
            cmdDelete.Enabled = False
            cmdExit.Enabled = False
        Case "Modify"
            cmdNew.Enabled = False
            cmdCancel.Enabled = True
            cmdSave.Enabled = True
            cmdModify.Enabled = False
            cmdDelete.Enabled = False
            cmdExit.Enabled = False
        Case Else
            Exit Sub
    End Select
    
End Sub

Private Sub cmdModify_Click()
    
    lsvClerk.Enabled = False
    Frame1.Enabled = True
    txtClerkCode.Locked = True
    
    txtClerkName.SetFocus
    
    msStatus = "Modify"
    Call SetCmdEnabled(msStatus)
    
End Sub

Private Sub cmdNew_Click()
Dim sCode As String

    mlClerkID = 0
    msStatus = "New"
    Call SetCmdEnabled(msStatus)
    
    lsvClerk.Enabled = False
    Frame1.Enabled = True
    txtClerkCode.Locked = False
    
    Call iniClerk
    sCode = GetClerkCode
    
    txtClerkCode.Text = sCode
    
    txtClerkCode.SetFocus
    
End Sub

Private Function GetClerkCode() As String
Dim sSQL        As String
Dim sClerkCode  As String
Dim rsClerkCode As ADODB.Recordset
    
    sClerkCode = "0000"
    sSQL = "select max(ClerkCode) as MaxCode from clerk where status<>'2'"
    Set rsClerkCode = GDB.Execute(sSQL)
    With rsClerkCode
    Do While Not .EOF
        sClerkCode = IIf(IsNull(rsClerkCode!MaxCode), "0000", rsClerkCode!MaxCode)
        .MoveNext
    Loop
    End With
    
    sClerkCode = Right(String(4, "0") + CStr(CLng(sClerkCode) + 1), 4)
    GetClerkCode = sClerkCode
    
    
End Function

Private Sub cmdSave_Click()
Dim lsvItem As MSComctlLib.ListItem
Dim lIndex As Long
Dim lClerkID As Long
    
    If CheckClerkValid = False Then Exit Sub
    
    Set Clerk = New clsClerk
    
    If msStatus = "New" Then
        lClerkID = GetID
        mlClerkID = lClerkID
        With Clerk
            .ClerkID = lClerkID
            .ClerkCode = Trim(txtClerkCode.Text)
            .ClerkName = Trim(txtClerkName.Text)
            .PassWord = Trim(txtPassWord.Text)
        End With
        
        Call Clerk.SaveClerk
        
        lIndex = lsvClerk.ListItems.Count + 1
        Set lsvItem = lsvClerk.ListItems.Add(lIndex, "U" & lIndex)
        lsvItem.Text = CStr(lIndex)
        lsvItem.SubItems(1) = Clerk.ClerkCode
        lsvItem.SubItems(2) = Clerk.ClerkName
        lsvItem.SubItems(3) = Clerk.ClerkID
        lsvClerk.ListItems(lIndex).Selected = True
    ElseIf msStatus = "Modify" Then
        With Clerk
            .ClerkID = mlClerkID
            .ClerkCode = Trim(txtClerkCode.Text)
            .ClerkName = Trim(txtClerkName.Text)
            .PassWord = Trim(txtPassWord.Text)
        End With
        
        Call Clerk.ModifyClerk
        lsvClerk.SelectedItem.SubItems(1) = Clerk.ClerkCode
        lsvClerk.SelectedItem.SubItems(2) = Clerk.ClerkName
        lsvClerk.SelectedItem.SubItems(3) = Clerk.ClerkID
    End If
    
    Set Clerk = Nothing
    
    
    lsvClerk.Enabled = True
    Frame1.Enabled = False
    
    msStatus = "Init"
    Call SetCmdEnabled(msStatus)
    Call lsvClerk_ItemClick(lsvClerk.SelectedItem)
    
End Sub

Private Function CheckClerkValid() As Boolean
Dim sSQL As String
Dim i As Long
Dim rsClerk As ADODB.Recordset
Dim sClerkCode As String, sClerkName As String
    
    CheckClerkValid = False
    
    sClerkCode = (txtClerkCode.Text)
    sClerkName = (txtClerkName.Text)
    If sClerkCode = "" Then
        MsgBox "请输入操作员代码!", vbCritical + vbOKOnly, "系统提示"
        txtClerkCode.SetFocus
        CheckClerkValid = False
        Exit Function
    End If
    
    If sClerkName = "" Then
        MsgBox "请输入操作员姓名!", vbCritical + vbOKOnly, "系统提示"
        txtClerkName.SetFocus
        CheckClerkValid = False
        Exit Function
    End If
    
    If Trim(txtPassWord.Text) <> Trim(txtConfirm.Text) Then
        MsgBox "密码不一致,请重新输入密码!", vbCritical + vbOKOnly, "系统提示"
        txtPassWord.SetFocus
        CheckClerkValid = False
        Exit Function
    End If
    
'检查操作员代码是否已存在
    If msStatus = "New" Then
        sSQL = "select * from clerk where clerkcode='" & sClerkCode & "'"
        Set rsClerk = GDB.Execute(sSQL)
        i = 0
        With rsClerk
        Do While Not .EOF
           i = i + 1
           .MoveNext
        Loop
        End With
        rsClerk.Close
        Set rsClerk = Nothing
        
        If i > 0 Then
            MsgBox "该操作员代码已存在,请重新输入!", vbCritical + vbOKOnly, "系统提示"
            txtClerkCode.SetFocus
            CheckClerkValid = False
            Exit Function
        Else
            CheckClerkValid = True
        End If
     ElseIf msStatus = "Modify" Then
        CheckClerkValid = True
     End If
     
End Function

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    
    If KeyCode = vbKeyEscape Then
        Call cmdExit_Click
    End If
    
End Sub

Private Sub Form_Load()
On Error Resume Next

    msStatus = "Init"
    Frame1.Enabled = False
    Call SetCmdEnabled(msStatus)
    
    Call iniListView
    Call SetLsvClerk
    
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
   
    If msStatus = "New" Or msStatus = "Modify" Then
        If MsgBox("是否退出操作员设置?", vbQuestion + vbYesNo, "提示") = vbYes Then
            Cancel = False
        Else
            Cancel = True
        End If
    Else
        Cancel = False
    End If
   
End Sub

Private Sub lsvClerk_DblClick()
    
    Call cmdModify_Click
    
End Sub

Private Sub lsvClerk_ItemClick(ByVal Item As MSComctlLib.ListItem)
    
    Set Clerk = New clsClerk
    
    If lsvClerk.ListItems.Count < 1 Then Exit Sub
    mlClerkID = lsvClerk.SelectedItem.SubItems(3)
    Call Clerk.OpenClerk(mlClerkID)
    
    txtClerkCode.Text = Clerk.ClerkCode
    txtClerkName = Clerk.ClerkName
    txtPassWord = Clerk.PassWord
    txtConfirm.Text = Clerk.PassWord
    
    lsvClerk.DropHighlight = lsvClerk.SelectedItem
    
    Set Clerk = Nothing
    
End Sub

Private Sub txtClerkCode_GotFocus()
    txtClerkCode.SelStart = 0
    txtClerkCode.SelLength = Len(txtClerkCode.Text)
End Sub

Private Sub txtClerkCode_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn Then
        SendKeys "{tab}"
    End If
End Sub

Private Sub txtClerkCode_KeyPress(KeyAscii As Integer)
'    Call ChgNumeric(KeyAscii)
End Sub

Private Sub txtClerkCode_LostFocus()
    
    txtClerkCode.Text = Right(String(4, "0") + txtClerkCode.Text, 4)
    
End Sub

Private Sub txtClerkName_GotFocus()
    txtClerkName.SelStart = 0
    txtClerkName.SelLength = Len(txtClerkName.Text)
End Sub

Private Sub txtClerkName_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn Then
        SendKeys "{tab}"
    End If
End Sub

Private Sub txtConfirm_GotFocus()
    txtConfirm.SelStart = 0
    txtConfirm.SelLength = Len(txtConfirm.Text)
End Sub

Private Sub txtConfirm_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn Then
        SendKeys "{tab}"
    End If
End Sub


Private Sub txtPassWord_GotFocus()
    txtPassWord.SelStart = 0
    txtPassWord.SelLength = Len(txtPassWord.Text)
End Sub

Private Sub txtpassword_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn Then
        SendKeys "{tab}"
    End If
End Sub

Private Sub iniListView()
    
    lsvClerk.View = lvwReport
    lsvClerk.FullRowSelect = True
    lsvClerk.LabelEdit = lvwManual
    
    lsvClerk.ListItems.Clear
    lsvClerk.ColumnHeaders.Add 1, "K1", "序号", 600, lvwColumnLeft
    lsvClerk.ColumnHeaders.Add 2, "K2", "操作员代码", 1400, lvwColumnLeft
    lsvClerk.ColumnHeaders.Add 3, "K3", "操作员姓名", 1800, lvwColumnLeft
    lsvClerk.ColumnHeaders.Add 4, "K4", "操作员ID", 0
    
End Sub

Private Sub SetLsvClerk()
Dim sSQL As String
Dim i As Long
Dim lsvItem As MSComctlLib.ListItem
Dim rsClerk As ADODB.Recordset
    
    sSQL = "select * from clerk where status='1' order by clerkcode"
    Set rsClerk = GDB.Execute(sSQL)
    lsvClerk.ListItems.Clear
    
    i = 1
    With rsClerk
    Do While Not .EOF
        Set lsvItem = lsvClerk.ListItems.Add(i, "U" & i)
        lsvItem.Text = CStr(i)
        lsvItem.SubItems(1) = rsClerk!ClerkCode
        lsvItem.SubItems(2) = rsClerk!ClerkName
        lsvItem.SubItems(3) = rsClerk!ClerkID
        
        i = i + 1
        .MoveNext
    Loop
    End With
'    Set DataGrid1.DataSource = rsClerk
    rsClerk.Filter = ("clerkcode='0001'")
    rsClerk.Close
    Set rsClerk = Nothing
        
    If lsvClerk.ListItems.Count >= 1 Then
        lsvClerk.ListItems(1).Selected = True
        Call lsvClerk_ItemClick(lsvClerk.SelectedItem)
    End If
    
End Sub

Private Sub iniClerk()
    
    txtClerkCode.Text = ""
    txtClerkName.Text = ""
    txtPassWord.Text = ""
    txtConfirm.Text = ""

End Sub

Private Function GetID() As Long
Dim sSQL As String
Dim rsTemp As Recordset
Dim lMaxID As Long
Dim lTempID As Long

    sSQL = "select max(ClerkID) as MaxClerkID from Clerk "
    Set rsTemp = GDB.Execute(sSQL)
    
    With rsTemp
    Do While Not .EOF
        lMaxID = IIf(IsNull(rsTemp!maxClerkid), 0, rsTemp!maxClerkid)
        .MoveNext
    Loop
    End With
    
        
    lTempID = IIf(IsNull(lMaxID), 0, lMaxID) + 1
    
    GetID = lTempID
    
    rsTemp.Close
    Set rsTemp = Nothing
    
End Function

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -