📄 frmmain.frm
字号:
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":2DFAE
Key = ""
EndProperty
BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":2E888
Key = ""
EndProperty
BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":2F162
Key = ""
EndProperty
BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":2FA3C
Key = ""
EndProperty
BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":30316
Key = ""
EndProperty
BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":30BF0
Key = ""
EndProperty
BeginProperty ListImage8 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":314CA
Key = ""
EndProperty
BeginProperty ListImage9 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":31DA4
Key = ""
EndProperty
BeginProperty ListImage10 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":3267E
Key = ""
EndProperty
BeginProperty ListImage11 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":32F58
Key = ""
EndProperty
EndProperty
End
Begin MSComctlLib.ImageList imgLstToolsDisabled
Left = 8880
Top = 720
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 32
ImageHeight = 32
MaskColor = 16777215
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 11
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":33832
Key = ""
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":3410C
Key = ""
EndProperty
BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":349E6
Key = ""
EndProperty
BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":352C0
Key = ""
EndProperty
BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":35B9A
Key = ""
EndProperty
BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":36474
Key = ""
EndProperty
BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":36D4E
Key = ""
EndProperty
BeginProperty ListImage8 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":37628
Key = ""
EndProperty
BeginProperty ListImage9 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":37F02
Key = ""
EndProperty
BeginProperty ListImage10 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":387DC
Key = ""
EndProperty
BeginProperty ListImage11 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":390B6
Key = ""
EndProperty
EndProperty
End
Begin VB.Menu mnuProgram
Caption = "程序(&P)"
Begin VB.Menu mnuProgramLeave
Caption = "离开(&L)"
End
End
Begin VB.Menu mnuEdit
Caption = "编辑(&E)"
Begin VB.Menu mnuEditAdmin
Caption = "添加管理员(&A)"
Index = 0
End
Begin VB.Menu mnuEditAdmin
Caption = "删除管理员(&D)"
Index = 1
End
Begin VB.Menu mnuEditAdmin
Caption = "修改管理员(&M)"
Index = 2
End
Begin VB.Menu mnuEdit0
Caption = "-"
End
Begin VB.Menu mnuEditUser
Caption = "添加用户(&A)"
Index = 0
End
Begin VB.Menu mnuEditUser
Caption = "删除用户(&D)"
Index = 1
End
Begin VB.Menu mnuEditUser
Caption = "修改用户(&M)"
Index = 2
End
End
Begin VB.Menu mnuLook
Caption = "查看(&L)"
Begin VB.Menu mnuLookAdminUser
Caption = "管理员(&A)"
Index = 0
Shortcut = ^A
End
Begin VB.Menu mnuLookAdminUser
Caption = "用户(&U)"
Index = 1
Shortcut = ^U
End
Begin VB.Menu mnuLook0
Caption = "-"
End
Begin VB.Menu mnuLookFriends
Caption = "好友信息(&F)"
Shortcut = ^I
End
Begin VB.Menu mnuLookOnline
Caption = "在线情况(&O)"
Shortcut = ^O
End
Begin VB.Menu mnuLookSingle
Caption = "个人资料(&P)"
Enabled = 0 'False
Shortcut = ^S
End
Begin VB.Menu mnuLookFull
Caption = "完整资料(&L)"
Enabled = 0 'False
Shortcut = ^L
End
Begin VB.Menu mnuLook1
Caption = "-"
End
Begin VB.Menu mnuLookFind
Caption = "查找(&F)..."
Enabled = 0 'False
Shortcut = ^F
End
Begin VB.Menu mnuLookFindNext
Caption = "查找下一个(&N)"
Enabled = 0 'False
Shortcut = {F3}
End
Begin VB.Menu mnuLook2
Caption = "-"
End
Begin VB.Menu mnuLookRefresh
Caption = "刷新(&R)"
Enabled = 0 'False
Shortcut = {F5}
End
End
Begin VB.Menu mnuView
Caption = "视图(&V)"
Begin VB.Menu mnuViewIcon
Caption = "大图标(&B)"
Checked = -1 'True
Index = 0
End
Begin VB.Menu mnuViewIcon
Caption = "列表(&L)"
Index = 2
End
Begin VB.Menu mnuViewIcon
Caption = "详细资料(&D)"
Index = 3
End
End
Begin VB.Menu mnuHelp
Caption = "帮助(&H)"
Begin VB.Menu mnuHelpTheme
Caption = "主题(&H)"
Shortcut = {F1}
End
Begin VB.Menu mnuHelp0
Caption = "-"
End
Begin VB.Menu mnuHelpAbout
Caption = "关于(&A)..."
End
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private tkIcon As NOTIFYICONDATA ' 任务栏图标
Private prevView As Integer ' 记住上一个视图
Private prevAdminUser As Integer ' 记住上一个操作对象
Private DataRefresh As Boolean ' 是否要刷新资料
Private tkWndStyle As Long ' 窗体风格
Private Sub cbTool_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
ReleaseCapture
End Sub
Private Sub Form_Unload(Cancel As Integer)
' 操作未结束时不退出程序
If pbStatus.Value <> 0 Then
Cancel = True
Exit Sub
End If
' 取消窗体过程回调函数并清除任务栏图标
SetWindowLong Me.hwnd, GWL_WNDPROC, prevWndProc
Shell_NotifyIcon NIM_DELETE, tkIcon
' 恢复默认光标
SetClassLong tvAdminUser.hwnd, GCL_HCURSOR, tkWndStyle
SetClassLong lvDetailData.hwnd, GCL_HCURSOR, tkWndStyle
DestroyCursor tkCursor
Unload frmSearch
End Sub
Private Sub Form_Load()
If tkLogin = True Then Exit Sub
Me.Icon = imgLstTools.ListImages(1).Picture
If tkPower = 0 Then
mnuEditAdmin(0).Enabled = False
mnuEditAdmin(1).Enabled = False
mnuEditAdmin(2).Enabled = False
End If
' 将动画光标从资源文件中释放出来
Dim tkFileName As String
tkFileName = Space(255)
GetTempPath Len(tkFileName), tkFileName
tkFileName = Left(tkFileName, InStr(1, tkFileName, vbNullChar) - 1) & "Angel.ani"
If Dir(tkFileName) = "" Then
ExtractFile "Angel", "Cursor", tkFileName
End If
' 设置动画光标
tkCursor = LoadCursorFromFile(tkFileName)
If Dir(tkFileName) = "Angel.ani" Then
Kill tkFileName
End If
tkWndStyle = GetClassLong(Me.hwnd, GCL_HCURSOR)
SetClassLong tvAdminUser.hwnd, GCL_HCURSOR, tkCursor
SetClassLong lvDetailData.hwnd, GCL_HCURSOR, tkCursor
' 设置任务栏图标参数
With tkIcon
.hIcon = Me.Icon ' 在任务栏显示本窗体图标
.hwnd = Me.hwnd ' 接收窗体消息
.uCallbackMessage = WM_NOTIFYICON ' 返回消息为 WM_NOTIFYICON
.uFlags = NIF_ICON Or _
NIF_TIP Or NIF_MESSAGE ' 包含图标和提示，并接收 Windows 消息
.szTip = Me.Caption & vbNullChar ' 提示内容为窗体标题
.cbSize = Len(tkIcon) ' 结构大小
End With
' 添加任务栏图标
Shell_NotifyIcon NIM_ADD, tkIcon
' 将管理菜单下子菜单增加圆形图标
tkSetRadio Me, 2, "管理员(&A)" & vbTab & "Ctrl+A", 0
tkSetRadio Me, 2, "用户(&U)" & vbTab & "Ctrl+U", 1
' 将窗体子类化
prevWndProc = GetWindowLong(Me.hwnd, GWL_WNDPROC)
SetWindowLong Me.hwnd, GWL_WNDPROC, AddressOf WndProc
' 增加列表项默认列头
lvDetailData.ColumnHeaders.Add , , "昵称"
lvDetailData.ColumnHeaders.Add , , "标识", TextWidth("标识") * 2, lvwColumnCenter
lvDetailData.ColumnHeaders.Add , , "性别", TextWidth("性别") * 2, lvwColumnCenter
End Sub
Private Sub lvDetailData_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
With lvDetailData
If .SortOrder = lvwAscending Then
.SortOrder = lvwDescending
Else
.SortOrder = lvwAscending
End If
.SortKey = ColumnHeader.Position - 1
.Sorted = True
End With
End Sub
Private Sub lvDetailData_DblClick()
Dim iPos As Integer
If lvDetailData.ListItems.Count > 0 Then
If InStr(1, lvDetailData.SelectedItem.Key, "户") + 1 > 1 Then
iPos = InStr(1, lvDetailData.SelectedItem.Key, "户") + 1
ElseIf InStr(1, lvDetailData.SelectedItem.Key, "员") + 1 > 1 Then
iPos = InStr(1, lvDetailData.SelectedItem.Key, "员") + 1
End If
tkUserID = Mid(lvDetailData.SelectedItem.Key, iPos, Len(lvDetailData.SelectedItem.Key))
frmUserInfo.Show vbModal
End If
End Sub
Private Sub lvDetailData_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
If pbStatus.Value = 0 Then
If lvDetailData.ListItems.Count > 0 Then
tvAdminUser.Nodes(lvDetailData.SelectedItem.Index + 1).Selected = True
End If
If Button = vbRightButton Then
PopupMenu mnuLook, vbPopupMenuLeftButton Or vbPopupMenuRightButton
End If
End If
End Sub
Private Sub mnuLookAdminUser_Click(Index As Integer)
' 如果重复选择便取消当前操作
If mnuLookAdminUser(Index).Checked = True Or pbStatus.Value <> 0 Then
If DataRefresh = False Then Exit Sub
End If
' 初始化将要查找的内容
tkSearchContext = vbNullString
If frmSearch.Visible = True Then
Unload frmSearch
End If
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -