?? frmsystem.frm
字號(hào):
Private Sub cmdChange_Click()
On Error Resume Next
Dim dlg As frmUserName
Set dlg = New frmUserName
Load dlg
dlg.m_sLogin = lsvUser.ListItems(m_iChange).ListSubItems(1).Text
dlg.m_sName = lsvUser.ListItems(m_iChange).ListSubItems(2).Text
dlg.Init
dlg.Show vbModal
If dlg.m_bCancel = False Then
lsvUser.ListItems(m_iChange).ListSubItems(1).Text = dlg.m_sLogin
lsvUser.ListItems(m_iChange).ListSubItems(2).Text = dlg.m_sName
End If
Set dlg = Nothing
m_bChange = False
m_iChange = 0
cmdChange.Enabled = False
cmdDelete.Enabled = False
End Sub
Private Sub cmdDelete_Click()
On Error Resume Next
Dim i As Integer
If lsvUser.ListItems.Count > m_iChange Then
For i = m_iChange To lsvUser.ListItems.Count - 1
lsvUser.ListItems(i).ListSubItems(0).Text = lsvUser.ListItems(i + 1).ListSubItems(0).Text
lsvUser.ListItems(i).ListSubItems(1).Text = lsvUser.ListItems(i + 1).ListSubItems(1).Text
lsvUser.ListItems(i).ListSubItems(2).Text = lsvUser.ListItems(i + 1).ListSubItems(2).Text
Next i
End If
lsvUser.ListItems.Remove lsvUser.ListItems.Count
m_bChange = False
m_iChange = 0
cmdChange.Enabled = False
cmdDelete.Enabled = False
End Sub
Private Sub cmdOK_Click()
On Error GoTo ERROR_EXIT
Dim sINIFile As String, sNextFile As String
Dim Subkey As String
Dim Leng As Integer, i As Integer
Dim r As clsRegistry
If CheckInfo = False Then Exit Sub
Set r = New clsRegistry
'保存INI文件
Subkey = g_strREG_SERVER_KEY
sNextFile = r.GetValue(eHKEY_LOCAL_MACHINE, Subkey, "Path")
sNextFile = RemoveNullChar(sNextFile)
If sNextFile = "" Then
sINIFile = App.Path & "\CyQueue.INI"
SetErrorLogFile App.Path
Else
AddDirSep sNextFile
sINIFile = sNextFile & "CyQueue.INI"
End If
Set r = Nothing
Leng = lsvUser.ListItems.Count
'寫INI文件
sWriteINI sINIFile, "Server", "ServerName", txtServer.Text
sWriteINI sINIFile, "Server", "ServerPort", txtPort.Text
sWriteINI sINIFile, "User", "Count", CStr(Leng)
For i = 1 To Leng
sWriteINI sINIFile, "Settings", "UserLogin" & i, _
Trim$(lsvUser.ListItems(i).ListSubItems(1).Text)
sWriteINI sINIFile, "Settings", "UserName" & i, _
Trim$(lsvUser.ListItems(i).ListSubItems(2).Text)
Next i
MsgBox "客戶端系統(tǒng)配置已更改,系統(tǒng)下次登錄時(shí)生效。", vbOKOnly, "系統(tǒng)提示"
Unload Me
Exit Sub
ERROR_EXIT:
m_tagErrInfo.strErrDate = Format(Now, "yyyy-mm-dd hh:mm:ss")
m_tagErrInfo.strErrFile = "frmSystem"
m_tagErrInfo.strErrFunc = "cmdOK_Click"
m_tagErrInfo.nErrNum = Err.Number
m_tagErrInfo.strErrDesc = Error(Err.Number)
If Err.Number <> 0 Then Err.Clear
modErrorInfo.WriteErrLog m_tagErrInfo
End Sub
Private Sub Form_Load()
On Error GoTo ERROR_EXIT
Dim sINIFile As String, sNextFile As String
Dim Subkey As String
Dim Leng As Integer, i As Integer
Dim r As clsRegistry
Dim itmX As ListItem
Set r = New clsRegistry
m_bChange = False
m_iChange = 0
'初始化 Listview顯示
lsvUser.ColumnHeaders.Add , , "編號(hào)"
lsvUser.ColumnHeaders.Add , , "員工工號(hào)"
lsvUser.ColumnHeaders.Add , , "員工名稱"
Subkey = g_strREG_SERVER_KEY
sNextFile = r.GetValue(eHKEY_LOCAL_MACHINE, Subkey, "Path")
sNextFile = RemoveNullChar(sNextFile)
If sNextFile = "" Then
sINIFile = App.Path & "\CyQueue.INI"
SetErrorLogFile App.Path
Else
AddDirSep sNextFile
sINIFile = sNextFile & "CyQueue.INI"
End If
Set r = Nothing
'檢查服務(wù)器名和端口號(hào)
txtServer.Text = sGetINI(sINIFile, "Server", "ServerName", "?")
txtPort.Text = Format(sGetINI(sINIFile, "Server", "ServerPort", "?"), "00000")
Leng = CInt(sGetINI(sINIFile, "User", "Count", 0))
If Leng = 0 Then GoTo ERROR_EXIT
ReDim strServer(Leng - 1)
For i = 1 To Leng
Set itmX = lsvUser.ListItems.Add(, , CStr(i))
itmX.SubItems(1) = sGetINI(sINIFile, "Settings", "UserLogin" & i, "?")
itmX.SubItems(2) = sGetINI(sINIFile, "Settings", "UserName" & i, "?")
Next i
cmdChange.Enabled = False
cmdDelete.Enabled = False
Exit Sub
ERROR_EXIT:
m_tagErrInfo.strErrDate = Format(Now, "yyyy-mm-dd hh:mm:ss")
m_tagErrInfo.strErrFile = "frmSystem"
m_tagErrInfo.strErrFunc = "Form_Load"
m_tagErrInfo.nErrNum = Err.Number
m_tagErrInfo.strErrDesc = Error(Err.Number)
If Err.Number <> 0 Then Err.Clear
modErrorInfo.WriteErrLog m_tagErrInfo
End Sub
Private Sub Form_Terminate()
On Error Resume Next
Set frmSystem = Nothing
End Sub
Private Sub lsvUser_ItemClick(ByVal Item As MSComctlLib.ListItem)
On Error Resume Next
If Item.Index > 0 Then
m_iChange = Item.Index
m_bChange = True
'修改按鈕狀態(tài)
cmdChange.Enabled = True
cmdDelete.Enabled = True
End If
End Sub
Private Sub txtIPNumber_GotFocus()
On Error Resume Next
txtIPNumber.BackColor = &H80000018
End Sub
Private Sub txtIPNumber_KeyPress(KeyAscii As Integer)
On Error Resume Next
If KeyAscii = 13 Then '是回車鍵?
KeyAscii = 0 '0取消輸入
SendKeys "{tab}"
End If
End Sub
Private Sub txtIPNumber_LostFocus()
On Error Resume Next
txtIPNumber.BackColor = &H80000005
End Sub
Private Sub txtPort_GotFocus()
On Error Resume Next
txtPort.BackColor = &H80000018
End Sub
Private Sub txtPort_KeyPress(KeyAscii As Integer)
On Error Resume Next
If KeyAscii = 13 Then '是回車鍵?
KeyAscii = 0 '0取消輸入
SendKeys "{tab}"
End If
End Sub
Private Sub txtPort_LostFocus()
On Error Resume Next
txtPort.BackColor = &H80000005
End Sub
Private Sub txtServer_GotFocus()
On Error Resume Next
txtServer.BackColor = &H80000018
End Sub
Private Sub txtServer_KeyPress(KeyAscii As Integer)
On Error Resume Next
If KeyAscii = 13 Then '是回車鍵?
KeyAscii = 0 '0取消輸入
SendKeys "{tab}"
End If
End Sub
Private Sub txtServer_LostFocus()
On Error Resume Next
txtServer.BackColor = &H80000005
End Sub
'//////////////////////////////////////////////////////////////////
'檢查數(shù)據(jù)有效性
Private Function CheckInfo() As Boolean
On Error Resume Next
Dim i As Integer
If Trim$(txtServer.Text) = "" Or IsNumeric(txtPort.Text) = False Then
MsgBox "請(qǐng)輸入有效的數(shù)據(jù)服務(wù)器名和服務(wù)端口號(hào)!", vbOKOnly + vbCritical, "系統(tǒng)錯(cuò)誤"
txtServer.SetFocus
CheckInfo = False
Exit Function
End If
If lsvUser.ListItems.Count = 0 Then
MsgBox "請(qǐng)輸入有效的用戶信息!", vbOKOnly + vbCritical, "系統(tǒng)錯(cuò)誤"
txtServer.SetFocus
CheckInfo = False
Exit Function
End If
For i = 1 To lsvUser.ListItems.Count
If Trim$(lsvUser.ListItems(i).ListSubItems(1).Text) = "" Then
MsgBox "請(qǐng)輸入有效的用戶工號(hào),用戶工號(hào)不能為空!", vbOKOnly + vbCritical, "系統(tǒng)錯(cuò)誤"
txtServer.SetFocus
CheckInfo = False
Exit Function
End If
Next i
CheckInfo = True
End Function
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號(hào)
Ctrl + =
減小字號(hào)
Ctrl + -