?? formd7.frm
字號:
End Sub
Private Sub MSFlexGrid1_Click() ' 選中一用戶
With MSFlexGrid1
m = .Row
.Row = intRow: For i = 1 To 3: .Col = i: .CellBackColor = intCy1: Next
intRow = m
.Row = intRow: For i = 1 To 3: .Col = i: .CellBackColor = intCn1: Next
.Col = 1: Text1.Text = .Text
.Col = 2: Text2.Text = .Text
End With
strDmp = arrUsn(intRow, 0)
strMcp = arrUsn(intRow, 1)
strJcp = arrUsn(intRow, 2)
strBzk = arrUsn(intRow, 3) ' 用戶級別
Call P_atxt
bytMod = 2 ' 修改標志
Command4.Enabled = True
Command3.Enabled = True
Command2.Enabled = True
Command2.Caption = "修改用戶"
Command2.SetFocus
End Sub
Private Sub P_atxt()
Text1.Visible = True
Text2.Visible = True
Label1.Visible = True
Label2.Visible = True
End Sub
Private Sub Text1_Change() ' 檢查用戶名
StrUsm = Trim(Text1.Text)
If myF_Len(StrUsm) > 6 Then
MsgBox " 用戶名最大長度為六個英文字符位,請修改 ... ", 48, " 請注意"
Text1.Text = Left(StrUsm, 6)
Text1.SetFocus ' 重新輸入
End If
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer) ' 用戶名
If KeyAscii = 13 Then
StrUsm = Trim(Text1.Text)
If StrUsm = "" Then
Command1.SetFocus ' Quit
Else
If bytMod > 1 Then
If StrUsm = arrUsn(intRow, 2) Then
Text2.Text = ""
Text2.SetFocus: Exit Sub
End If
End If
If P_HcUse(StrUsm) = True Then ' 用戶名通過
Text2.Text = ""
Text2.Visible = True: Label2.Visible = True
Text2.SetFocus
Else
MsgBox " 很抱歉,用戶名重復,請重新設置 ... ", 48, " 請注意"
Text1.Text = ""
Text1.SetFocus
End If
End If
End If
End Sub
Function P_HcUse(Usn As String) As Boolean ' 核對用戶名
If bytUss < 1 Then P_HcUse = True: Exit Function
MyRs0.MoveFirst
Do While Not MyRs0.EOF
If Usn = Trim(MyRs0![Mc]) Then
P_HcUse = False
Exit Function
Exit Do
End If
MyRs0.MoveNext
Loop
P_HcUse = True ' 用戶名不重復
End Function
Private Sub Text2_Change() ' 檢查密碼
strUsk = Trim(Text2.Text)
If strUsk = "" Then Exit Sub
If myF_Len(strUsk) > 6 Then
MsgBox " 密碼最大長度為六個英文字符位,請修改 ... ", 48, " 請注意"
Text2.Text = Left(strUsk, 6)
Text2.SetFocus ' 重新輸入
End If
End Sub
Private Sub Text2_KeyPress(KeyAscii As Integer) ' txtPassword
If KeyAscii <> 13 Then Exit Sub
strUsk = Trim(Text2.Text)
If strUsk = "" Then
Command1.SetFocus ' Quit
Else
If P_HcKls(strUsk) = False Then
If MsgBox(" 請注意:密碼重復,是否修改 ... ", 4 + 32 + 256, " 請確認") = 6 Then
Text2.Text = ""
Text2.SetFocus
Else
Command2.Enabled = True: Command2.SetFocus
End If
Else
Command2.Enabled = True: Command2.SetFocus
End If
End If
End Sub
Function P_HcKls(Usk As String) As Boolean ' 核對密碼
If bytUss < 1 Then P_HcKls = True: Exit Function
MyRs0.MoveFirst
Do While Not MyRs0.EOF
If Usk = Trim(MyRs0![Jc]) Then
P_HcKls = False
Exit Function
Exit Do
End If
MyRs0.MoveNext
Loop
P_HcKls = True ' 密碼不重復
End Function
Private Sub Command1_KeyPress(KeyAscii As Integer) ' cmdOK
If KeyAscii = 13 Then Call Command1_Click
End Sub
Private Sub Command1_Click() ' cmdCancel
'StrUsj = "3"
Unload Me
End Sub
Private Sub Command2_Click() ' 確認處理
If Command2.Caption = "修改用戶" Then
Command2.Caption = "確 認"
bytMod = 2 ' 修改標志
Text1.SetFocus
Exit Sub
End If
strMck = Trim(Text1.Text)
strJck = Trim(Text2.Text)
If Len(strMck) = 0 Then
Command1.SetFocus: Exit Sub
End If
If bytMod = 1 Then
If Len(strJck) = 0 Then
MsgBox " 應為新增用戶 " & strMck & " 預置密碼 ... ", 48, " 請注意"
Text2.SetFocus: Exit Sub
End If
StrMsg = " 確實要將新增加的用戶信息存盤嗎 ? " ' 追加
If MsgBox(StrMsg, 33, " 請確認") = 1 Then
strDmk = "Kl" & Right(Str(Val(Right(strDmk, 2)) + 1001), 3) ' 新代碼
strXhk = Right(Str(Val(strXhk) + 1001), 3) ' 新序號
StrSQL = "INSERT INTO " & strT0 & "( Dm,Xh,Mc,Jc,Bz) VALUES " & _
"('" & strDmk & "','" & strXhk & "','" & strMck & "','" & strJck & "','" & strBzk & "' ) "
cnnTce.Execute StrSQL
Call P_RecorSet
End If
Else
StrMsg = " 確實要將用戶 " & strMcp & " 的信息修改存盤嗎 ? "
If MsgBox(StrMsg, 33, " 請確認") = 1 Then
MyRs0.MoveFirst
Do While Not MyRs0.EOF
If MyRs0![dm] = strDmp Then
MyRs0![Mc] = strMck: arrUsn(intRow, 1) = strMck
MyRs0![Jc] = strJck: arrUsn(intRow, 2) = strJck
MyRs0.Update
Exit Do
End If
MyRs0.MoveNext
Loop
With MSFlexGrid1
.Row = intRow: .Col = 1: .Text = " " & strMck
For i = 1 To 3: .Col = i: .CellBackColor = intCy1: Next
End With
Call P_dtxt
MsgBox " 用戶 " & strMck & " 信息修改完畢 ... ", 48, " Ok !"
End If
End If
End Sub
Private Sub P_dtxt()
Text1.Visible = False
Text2.Visible = False
Label1.Visible = False
Label2.Visible = False
Command2.Enabled = False
Command3.Enabled = False
Command4.Caption = "添加用戶"
Command4.SetFocus
End Sub
Private Sub Command3_Click() ' 刪除
strMcp = Trim(arrUsn(intRow, 1))
StrMsg = " 確實要刪除有關 " & strMcp & " 的條目信息嗎 ? " ' 追加
If MsgBox(StrMsg, 33, " 請確認") = 1 Then
strDmp = Trim(arrUsn(intRow, 0))
StrSQL = "Delete From " & strT0 & " Where Dm = '" & strDmp & "'"
cnnTce.Execute StrSQL
Call P_RecorSet
Call P_dtxt
Else
Call Command2_Click ' 放棄
End If
End Sub
Private Sub Command4_Click() ' 追加按鈕
bytMod = 1
Label1.Visible = True
Text1.Text = ""
Text1.Visible = True
Label2.Visible = False
Text2.Text = ""
Text2.Visible = False
Text1.SetFocus
End Sub
Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
MyRs0.Close: Set MyRs0 = Nothing
MyRs1.Close: Set MyRs1 = Nothing
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -