frmselectlinkman.frm

一个日程管理和通讯录管理的软件

VERSION 5.00
Begin VB.Form frmSelectlinkman 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "选择联系人"
   ClientHeight    =   4860
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   5820
   Icon            =   "frmSelectlinkman.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4860
   ScaleWidth      =   5820
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  'CenterScreen
   Begin VB.ListBox lstSelectedlinkman 
      Height          =   3210
      Left            =   2970
      Style           =   1  'Checkbox
      TabIndex        =   4
      Top             =   900
      Width           =   2715
   End
   Begin VB.CommandButton cmdCancel 
      Caption         =   "取消"
      Height          =   330
      Left            =   3184
      TabIndex        =   6
      Top             =   4365
      Width           =   1140
   End
   Begin VB.CommandButton cmdOK 
      Caption         =   "确定"
      Height          =   330
      Left            =   1496
      TabIndex        =   5
      Top             =   4365
      Width           =   1140
   End
   Begin VB.CommandButton cmdSelectGroup 
      Caption         =   "..."
      Height          =   240
      Left            =   5130
      TabIndex        =   2
      Top             =   180
      Width           =   420
   End
   Begin VB.ListBox lstLinkman 
      Height          =   3210
      Left            =   135
      Style           =   1  'Checkbox
      TabIndex        =   3
      Top             =   900
      Width           =   2715
   End
   Begin VB.TextBox txtLinkmanposition 
      BackColor       =   &H80000004&
      Height          =   285
      Left            =   720
      Locked          =   -1  'True
      TabIndex        =   1
      Top             =   135
      Width           =   4245
   End
   Begin VB.Label Label2 
      Caption         =   "选择的联系人："
      Height          =   195
      Left            =   2970
      TabIndex        =   7
      Top             =   630
      Width           =   1275
   End
   Begin VB.Label Label1 
      Caption         =   "位置："
      Height          =   240
      Left            =   180
      TabIndex        =   0
      Top             =   180
      Width           =   555
   End
End
Attribute VB_Name = "frmSelectlinkman"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'*****************************************************
'*                                                   *
'*             选择任务或计划的联系人所属类别          *
'*                                                   *
'*****************************************************

Dim ChangedFlag As Boolean      '所选择的联系人已改变的标志
Dim Newlinkman As String        '保存新选择的联系人ID
Dim blnItemCheck As Boolean     '防上执行ItemCheck事件内代码的标志

Private Sub cmdCancel_Click()
    
    '取消所做的选择
    If ChangedFlag Then
    
        '联系人已改变(如选择的联系人已删除)
        frmSelectlinkman.Tag = Newlinkman
    Else
        frmSelectlinkman.Tag = ""
    End If
    
    frmSelectlinkman.Visible = False
    
End Sub

Private Sub cmdOK_Click()

    Dim arryLinkman() As String         '保存选择的联系人的ID
    
    ReDim arryLinkman(0)
    frmCalendar.SelectedLinkman = ""
    For i = 0 To lstSelectedlinkman.ListCount - 1
    
        If lstSelectedlinkman.Selected(i) Then
        
            '将选中联系人的ID加入数组
            arryLinkman(UBound(arryLinkman())) = Trim(Str(lstSelectedlinkman.ItemData(i)))
            ReDim Preserve arryLinkman(UBound(arryLinkman()) + 1)
            
            '将选中联系人的名字连入字符串
            frmCalendar.SelectedLinkman = frmCalendar.SelectedLinkman & lstSelectedlinkman.List(i) & "、"
        End If
        
    Next i
    
    If UBound(arryLinkman()) <> 0 Then
        ReDim Preserve arryLinkman(UBound(arryLinkman()) - 1)
        frmSelectlinkman.Tag = Join(arryLinkman, ",")
        
        '去除尾部的逗号
        frmCalendar.SelectedLinkman = Left(frmCalendar.SelectedLinkman, Len(frmCalendar.SelectedLinkman) - 1)
    Else
    
        '联系人清空
        frmSelectlinkman.Tag = "clear"
    
    End If
    
    frmSelectlinkman.Visible = False
    
End Sub

Private Sub cmdSelectGroup_Click()
    
    Dim i As Long, j As Long
    
    '调用联系人组选择窗体
    frmSelectGroup.Show vbModal
    
    If frmSelectGroup.Tag <> "" Then
        txtLinkmanposition.Text = frmSelectGroup.TVSelectGroup.SelectedItem.FullPath
        Listlinkman frmSelectGroup.Tag
        
        '选择了一个新组时,搜索可选联系人列表框中的项目是否为选中状态
        For i = 0 To lstLinkman.ListCount - 1
        
            For j = 0 To lstSelectedlinkman.ListCount - 1
            
                If lstSelectedlinkman.ItemData(j) = lstLinkman.ItemData(i) Then
        
                    '若存在,同步两个项目的状态
                    blnItemCheck = True
                    lstLinkman.Selected(i) = lstSelectedlinkman.Selected(j)
                    blnItemCheck = False
                End If
                
            Next j
            
        Next i
        
    End If
    
    Unload frmSelectGroup
    
End Sub

Private Sub Form_Load()
    
    txtLinkmanposition.Text = "联系人"
    
    '初始化可选联系人的ListBox
    Call Listlinkman("0")
    
End Sub

'列表指定组的联系人
Private Sub Listlinkman(groupID As String)
    
    
    lstLinkman.Clear
    
    '返回指定组的联系人
    strQry = "select name,personal_ID from linkman where ID='" & UserID & "' and group_id=" & groupID
    Set rstCustomers = GetRecordSet(cnnConnection, strQry)
    
    If rstCustomers.RecordCount <> 0 Then
        lstLinkman.Enabled = True
        rstCustomers.MoveFirst
        
        While rstCustomers.EOF = False
        
            '将联系人名加入可选联系人列表框
            lstLinkman.AddItem rstCustomers!Name
            
            '将联系人对应的ID保存到ItemData数组中
            lstLinkman.ItemData(lstLinkman.NewIndex) = Trim(Str(rstCustomers!personal_ID))
            rstCustomers.MoveNext
        Wend
    Else
        lstLinkman.Enabled = False
    End If
    
End Sub


Private Sub Form_Resize()

    Dim i As Long
    
    If frmSelectlinkman.Tag <> "" Then
    
        frmCalendar.SelectedLinkman = ""
        
        '列出已选联系人,检查所联系人的有效性
        strQry = "select name,personal_ID from linkman where personal_ID in (" & frmSelectlinkman.Tag & ")"
        Set rstCustomers = GetRecordSet(cnnConnection, strQry)
        
        If rstCustomers.RecordCount <> 0 Then
            rstCustomers.MoveFirst
            
            While rstCustomers.EOF = False
            
                '将联系人名加入可选联系人列表框
                lstSelectedlinkman.AddItem rstCustomers!Name
                
                '将联系人对应的ID保存到ItemData数组中
                lstSelectedlinkman.ItemData(lstSelectedlinkman.NewIndex) = Trim(Str(rstCustomers!personal_ID))
                Newlinkman = Newlinkman & Trim(Str(rstCustomers!personal_ID)) & ","
                frmCalendar.SelectedLinkman = frmCalendar.SelectedLinkman & rstCustomers!Name & "、"
                
                For i = 0 To lstLinkman.ListCount - 1
                    If lstLinkman.ItemData(i) = Trim(Str(rstCustomers!personal_ID)) Then
                    
                        '已选项目在可选列表框中出现,标记复选框
                        lstLinkman.Selected(i) = True
                    End If
                Next i
                
                rstCustomers.MoveNext
            Wend
            
            frmCalendar.SelectedLinkman = Left(frmCalendar.SelectedLinkman, Len(frmCalendar.SelectedLinkman) - 1)
            Newlinkman = Left(Newlinkman, Len(Newlinkman) - 1)
            
            If Len(Newlinkman) <> Len(frmSelectlinkman.Tag) Then
            
                '有选择的联系人无效时则修改"改变标志"
                ChangedFlag = True
            End If
            
            For i = 0 To lstSelectedlinkman.ListCount - 1
                lstSelectedlinkman.Selected(i) = True
            Next i
            
        Else
            Newlinkman = "clear"
            ChangedFlag = True
        End If
            
    End If
    
End Sub

'改变可选联系人列表框所引起的已选联系人列表框的改变
Private Sub lstLinkman_ItemCheck(Item As Integer)
  
    Dim i As Long
    Dim existFlag As Boolean
    
    If blnItemCheck Then
    
        '若是程序触发的ItemCheck事件,则不处理
        Exit Sub
    End If
    
    For i = 0 To lstSelectedlinkman.ListCount - 1
    
        '搜索已选联系人列表框是否存在可选联系人列表框中的选择项目
        If lstLinkman.ItemData(Item) = lstSelectedlinkman.ItemData(i) Then
            existFlag = True
            Exit For
        End If
    Next i
    If existFlag = False Then
    
        '不存在,添加进已选联系人列表框,并标记为已选
        lstSelectedlinkman.AddItem lstLinkman.List(Item)
        blnItemCheck = True     '设置标志,防止执行ItemCheck事件内的代码
        lstSelectedlinkman.Selected(lstSelectedlinkman.NewIndex) = True
        blnItemCheck = False
        lstSelectedlinkman.ItemData(lstSelectedlinkman.NewIndex) = lstLinkman.ItemData(Item)
    Else
    
        '已存在,改变状态即可
        blnItemCheck = True     '设置标志,防止执行ItemCheck事件内的代码
        lstSelectedlinkman.Selected(i) = Not lstSelectedlinkman.Selected(i)
        blnItemCheck = False
    End If
    lstLinkman.ListIndex = -1
    lstSelectedlinkman.ListIndex = -1
    
End Sub

Private Sub hi_Click()

End Sub

Private Sub lstSelectedlinkman_ItemCheck(Item As Integer)
    
    Dim i As Long
    
    If blnItemCheck Then
    
        '若是程序触发的ItemCheck事件,则不处理
        Exit Sub
    End If
    
    '改变已选联系人列表框内项目的状态时,搜索可选联系人列表框中是否对应项目
    For i = 0 To lstLinkman.ListCount - 1
        If lstSelectedlinkman.ItemData(Item) = lstLinkman.ItemData(i) Then
        
            '若存在,同步两个项目的状态
            blnItemCheck = True
            lstLinkman.Selected(i) = lstSelectedlinkman.Selected(Item)
            blnItemCheck = False
            Exit Sub
        End If
    Next i
    
End Sub