frmmain.frm

用VB6.0编写的QQ聊天软件

    
    DataRefresh = False

    ' 标识所选择的菜单
    mnuLookAdminUser(prevAdminUser).Checked = False
    mnuLookAdminUser(Index).Checked = True
    prevAdminUser = Index
    
    If mnuLookFull.Enabled = False Then
        mnuLookSingle.Enabled = True
        mnuLookFull.Enabled = True
        mnuLookFind.Enabled = True
        mnuLookFindNext.Enabled = True
        mnuLookRefresh.Enabled = True
        tbTools.Buttons("个人资料").Enabled = True
        tbTools.Buttons("完整资料").Enabled = True
        tbTools.Buttons("查找").Enabled = True
        tbTools.Buttons("刷新").Enabled = True
    End If

    ' 取消详细资料查看，以加快浏览速度
    mnuLookFull.Checked = False
    tbTools.Buttons("完整资料").Value = tbrUnpressed
    mnuViewIcon(prevView).Checked = False
    mnuViewIcon(0).Checked = True
    prevView = 0

    ' 是否为管理员
    If Index = 0 Then
        ' 列出所有管理员并按下相应按钮
        tbTools.Buttons("管理员").Value = tbrPressed
        tkAddTreeView "管理员"
    Else
        ' 列出所有用户并按下相应按钮
        tbTools.Buttons("用户").Value = tbrPressed
        tkAddTreeView "用户"
    End If
End Sub

Private Sub Form_Resize()
    On Error Resume Next
    If Me.WindowState = vbMinimized Then
        ' 窗体最小时在任务栏添加图标并隐藏该窗体
        Shell_NotifyIcon NIM_ADD, tkIcon
        ShowWindow Me.hwnd, SW_HIDE
    Else
        With tvAdminUser
            .Move .Left, .Top, .Width, Me.ScaleHeight - cbTool.Height - pbStatus.Height - 2
        End With
        With lvDetailData
            .Move .Left, .Top, Me.ScaleWidth - tvAdminUser.Width - 4, Me.ScaleHeight - cbTool.Height - pbStatus.Height - 2
        End With
        With pbStatus
            .Move .Left, tvAdminUser.Top + tvAdminUser.Height + 5
        End With
    End If
End Sub

Private Sub mnuEditAdmin_Click(Index As Integer)
    If pbStatus.Value <> 0 Then Exit Sub
    tkModify = Index
    frmEdit.Show vbModal
End Sub

Private Sub mnuEditUser_Click(Index As Integer)
    If pbStatus.Value <> 0 Then Exit Sub
    tkModify = Index + 3
    frmEdit.Show vbModal
End Sub

Private Sub mnuHelpAbout_Click()
    If pbStatus.Value <> 0 Then Exit Sub
    ' 显示关于对话框
    ShellAbout Me.hwnd, _
        Me.Caption, _
        "孙建华" & vbCrLf & "[e-mail]", _
        tkCursor
End Sub

Private Sub mnuHelpTheme_Click()
    If pbStatus.Value <> 0 Then Exit Sub
End Sub

Private Sub mnuLookFind_Click()
    If pbStatus.Value <> 0 Then Exit Sub
    
    If frmMain.lvDetailData.ListItems.Count = 0 Then
        MsgBox "没有数据以供您查找，请先添加！", vbInformation, Me.Caption
        Exit Sub
    End If

    frmSearch.Show vbModeless, Me
End Sub

Private Sub mnuLookFindNext_Click()
    If pbStatus.Value <> 0 Then Exit Sub
    If tkSearchContext = vbNullString Then
        mnuLookFind_Click
    Else
        frmSearch.cmdSearchNext_Click
    End If
End Sub

Private Sub mnuLookFull_Click()
    If pbStatus.Value <> 0 Then Exit Sub

    ' 初始化将要查找的内容
    tkSearchContext = vbNullString
    If frmSearch.Visible = True Then
        Unload frmSearch
    End If

    lvDetailData.SortOrder = lvwAscending
    lvDetailData.Sorted = False

    mnuLookFull.Checked = Not mnuLookFull.Checked
    If mnuLookFull.Checked = True Then
        tbTools.Buttons("完整资料").Value = tbrPressed
        lvDetailData.View = lvwReport
    ElseIf mnuLookFull.Checked = False Then
        tbTools.Buttons("完整资料").Value = tbrUnpressed
        lvDetailData.View = lvwIcon
    End If

    ' 当前操作是否为管理员
    If mnuLookAdminUser(0).Checked = True Then
        ' 查看管理员的完整资料
        tkLookFull "管理员", "管理员资料"
    ElseIf mnuLookAdminUser(1).Checked = True Then
        ' 查看用户的完整资料
        tkLookFull "用户", "用户资料"
    End If
End Sub

Public Sub mnuLookRefresh_Click()
    If pbStatus.Value <> 0 Then Exit Sub
    tbTools.Enabled = False
    DataRefresh = True

    ' 操作对象为管理员或用户
    tbTools.Buttons("完整资料").Value = tbrUnpressed
    mnuLookFull.Checked = False
    mnuLookAdminUser_Click (prevAdminUser)
    
    tvAdminUser.Refresh
    lvDetailData.Refresh

    tbTools.Enabled = True
End Sub

Private Sub mnuProgramLeave_Click()
    ' 退出程序
    Unload Me
End Sub

Private Sub mnuLookSingle_Click()
    lvDetailData_DblClick
End Sub

Private Sub mnuLookFriends_Click()
    frmFriends.Show vbModal
End Sub

Private Sub mnuLookOnline_Click()
'
End Sub

Private Sub mnuViewIcon_Click(Index As Integer)
    mnuViewIcon(prevView).Checked = False
    mnuViewIcon(Index).Checked = True
    prevView = Index
    lvDetailData.View = Index
End Sub

Private Sub tbTools_ButtonClick(ByVal Button As MSComctlLib.Button)
    tbTools.Enabled = False
    Select Case Button.Key
        Case "好友信息"
            mnuLookFriends_Click
        Case "在线情况"
            mnuLookOnline_Click
        Case "个人资料"
            mnuLookSingle_Click
        Case "完整资料"
            mnuLookFull_Click
        Case "查找"
            mnuLookFind_Click
        Case "刷新"
            mnuLookRefresh_Click
        Case "视图"
            If lvDetailData.View = lvwIcon Then
                lvDetailData.View = lvwList
            ElseIf lvDetailData.View = lvwList Then
                lvDetailData.View = lvwReport
            Else
                lvDetailData.View = lvwIcon
            End If
            mnuViewIcon(prevView).Checked = False
            mnuViewIcon(lvDetailData.View).Checked = True
            prevView = lvDetailData.View
        Case "帮助"
            mnuHelpTheme_Click
        Case "离开"
            Unload Me
            Exit Sub
        Case Else
            ' 操作对象为管理员或用户
            tbTools.Buttons("完整资料").Value = tbrUnpressed
            mnuLookFull.Checked = False
            mnuLookAdminUser_Click (Button.Index - 1)
    End Select
    tbTools.Enabled = True
End Sub

Private Sub tbTools_ButtonMenuClick(ByVal ButtonMenu As MSComctlLib.ButtonMenu)
    lvDetailData.View = Val(ButtonMenu.Tag)
    mnuViewIcon(prevView).Checked = False
    mnuViewIcon(Val(ButtonMenu.Tag)).Checked = True
    prevView = lvDetailData.View
End Sub

Private Sub tkAddTreeView(tkTable As String)
    ' 清空集合
    While tvAdminUser.Nodes.Count > 0
        tvAdminUser.Nodes.Remove 1
        tvAdminUser.Nodes.Clear
    Wend
    
    ' 设置所要操作对象
    If tkTable = "管理员" Then
        tvAdminUser.ImageList = imgLstFaces
        tvAdminUser.Nodes.Add , , tkTable, tkTable, imgLstFaces.ListImages.Count
        lvDetailData.Icons = imgLstFaces
        lvDetailData.SmallIcons = imgLstFaces
    ElseIf tkTable = "用户" Then
        tvAdminUser.ImageList = imgLstFaces
        tvAdminUser.Nodes.Add , , tkTable, tkTable, imgLstFaces.ListImages.Count
        lvDetailData.Icons = imgLstFaces
        lvDetailData.SmallIcons = imgLstFaces
    End If

    ' 打开记录集
    If rst.State = adStateOpen Then rst.Close
    rst.Open "SELECT 标识,昵称,头像 FROM " & tkTable, cnn, adOpenKeyset, adLockReadOnly

    If rst.RecordCount = 0 Then
        ' 清空集合
        While lvDetailData.ListItems.Count > 0
            lvDetailData.ListItems.Clear
        Wend
        Exit Sub
    End If
    pbStatus.Max = rst.RecordCount

    While Not rst.EOF
        ' 将记录集中指定数据添加到集合
        tvAdminUser.Nodes.Add tkTable, tvwChild, tkTable & rst!标识, rst!昵称, Val(rst!头像)
        pbStatus.Value = pbStatus.Value + 1
        rst.MoveNext
    Wend
    pbStatus.Value = 0

    ' 展开节点
    If tvAdminUser.Nodes.Count > 1 Then
        tvAdminUser.Nodes(2).EnsureVisible
    End If
    
    ' 在列表中显示记录
    tkAddListView tkTable
End Sub

Private Sub tkAddListView(tkTable As String)
    ' 清空所有列表
    lvDetailData.ColumnHeaders.Clear
    lvDetailData.ListItems.Clear

    ' 注：为加快数据的读取，不要查看详细资料
    lvDetailData.View = lvwIcon
    
    ' 打开记录集
    If rst.State = adStateOpen Then rst.Close
    rst.Open "SELECT 标识,昵称,头像,性别 FROM " & tkTable, cnn, adOpenKeyset, adLockReadOnly
    
    ' 查看基本资料
    lvDetailData.ColumnHeaders.Add , , rst.Fields("昵称").Name
    lvDetailData.ColumnHeaders.Add , , rst.Fields("标识").Name, TextWidth("标识") * 2, lvwColumnCenter
    lvDetailData.ColumnHeaders.Add , , rst.Fields("性别").Name, TextWidth("性别") * 2, lvwColumnCenter
    While Not rst.EOF
        lvDetailData.ListItems.Add , tkTable & rst!标识, rst!昵称, Val(rst!头像), Val(rst!头像)
        lvDetailData.ListItems(tkTable & rst!标识).ListSubItems.Add , , rst!标识
        lvDetailData.ListItems(tkTable & rst!标识).ListSubItems.Add , , rst!性别
        pbStatus.Value = pbStatus.Value + 1
        rst.MoveNext
    Wend
    pbStatus.Value = 0
End Sub

Private Sub tkLookFull(tkItem As String, tkTable As String)
    On Error Resume Next
    ' 字段总数
    Dim iFields As Integer
    If lvDetailData.ListItems.Count = 0 Then Exit Sub
    If tbTools.Buttons("完整资料").Value = tbrPressed Then
        ' 打开记录集
        If rst.State = adStateOpen Then rst.Close
        rst.Open tkTable, cnn, adOpenKeyset, adLockReadOnly, adCmdTable

        ' 增加列头
        For iFields = 1 To rst.Fields.Count - 1
            lvDetailData.ColumnHeaders.Add , , rst(iFields).Name, TextWidth(rst(iFields).Name) * 2, lvwColumnCenter
        Next iFields

        ' 判断是否已经更新过
        If lvDetailData.ListItems(lvDetailData.ListItems.Count).SubItems(3) = vbNullString Then

            ' 列出所有详细资料
            While Not rst.EOF
                ' 循环所有字段并添加至列表
                For iFields = 1 To rst.Fields.Count - 1
                    lvDetailData.ListItems(tkItem & rst!标识).ListSubItems.Add , , rst(iFields) & ""
                Next iFields
                pbStatus.Value = pbStatus.Value + 1
                rst.MoveNext
                DoEvents
            Wend
            pbStatus.Value = 0
        End If
    ElseIf tbTools.Buttons("完整资料").Value = tbrUnpressed Then
        ' 只显示基本资料
        While lvDetailData.ColumnHeaders.Count > 3
            lvDetailData.ColumnHeaders.Remove lvDetailData.ColumnHeaders.Count
        Wend
    End If
End Sub

Private Sub tvAdminUser_DblClick()
    On Error Resume Next
    If tvAdminUser.Nodes.Count > 0 Then
        If tvAdminUser.SelectedItem.Key <> tvAdminUser.SelectedItem.Root Then
            lvDetailData_DblClick
        End If
    End If
End Sub

Private Sub tvAdminUser_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    On Error Resume Next
    If pbStatus.Value = 0 Then
        If lvDetailData.ListItems.Count > 0 Then
            If tvAdminUser.SelectedItem.Index > 1 Then
                lvDetailData.ListItems(tvAdminUser.SelectedItem.Index - 1).Selected = True
                lvDetailData.ListItems(tvAdminUser.SelectedItem.Index - 1).EnsureVisible
            End If
        End If
        If Button = vbRightButton Then
            ' 弹出环境菜单
            PopupMenu mnuLook, vbPopupMenuLeftButton Or vbPopupMenuRightButton
        End If
    End If
End Sub