📄 frmclerkset.frm
字号:
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 + -