zjm.frm

功能强大的个人工作通讯录

    PopupMenu menu1
End If
End Sub
Private Sub lv_keydown(keycode As Integer, Shift As Integer)
If keycode = 46 Then
  Call delxx
End If
End Sub
Private Sub lv_dblclick()
On Error GoTo err

Dim i As Long
SelectNo = lv.SelectedItem

ReDim infoarr(i)
Set infoarr(i) = New Class1
Set infoarr(i).newForm = New infoma
Load infoarr(i).newForm

err:
If err.Description <> "" Then
   MsgBox "列表中没有项目", vbOKOnly + 61, "提示"
End If
End Sub
'“文件”菜单的“退出”项被点击时
Private Sub mnuFileExit_Click()
   End
End Sub


Private Sub frame1_mousemove(Button As Integer, Shift As Integer, X As Single, Y As Single)
TJ.ForeColor = &HFF0000

SC.ForeColor = &HFF0000
End Sub
Private Sub frame2_mousemove(Button As Integer, Shift As Integer, X As Single, Y As Single)
SG1.ForeColor = &HFF0000
TJ1.ForeColor = &HFF0000
End Sub
Private Sub frame5_mousemove(Button As Integer, Shift As Integer, X As Single, Y As Single)
person.ForeColor = &HFF0000
addre.ForeColor = &HFF0000

delete.ForeColor = &HFF0000
End Sub

Private Sub newadd_Click()

If QX <> "管理员" And TopRight <> "超级管理员" Then
    MsgBox "非管理员没有执行此操作的权限", 0 + 64, "提示"
    Exit Sub
End If

Dim ff As Form
                        For Each ff In Forms
                    
                        If ff.Name = "AddLXR" Then
                           ff.SetFocus
                        Else
                           AddLXR.Show
                        End If
                        Next
End Sub

Private Sub RefreshList_Click()
Call Addall
End Sub

Private Sub SG_mousedown(Button As Integer, Shift As Integer, X As Single, Y As Single)
SG.BorderStyle = 1
End Sub
Private Sub SG_mouseup(Button As Integer, Shift As Integer, X As Single, Y As Single)
SG.BorderStyle = 0
SGXX.Show
End Sub
Private Sub SG_mousemove(Button As Integer, Shift As Integer, X As Single, Y As Single)
SG.ForeColor = &HFF&
SG.MousePointer = 99
End Sub

Private Sub SelectAll_Click()
Dim nitem As ListItem
 For n = 1 To lv.ListItems.Count
    With lv
        .ListItems.Item(n).Checked = True
        .ListItems.Item(n).Selected = True
        
    End With
 Next n
End Sub

Private Sub sjbfgl_Click()
BFGL.Show
End Sub

Private Sub tab_Click()
XX.Show
End Sub
Private Sub Text1_gotfocus()
 Text1.IMEMode = 1
End Sub
Private Sub Text1_keypress(KeyAscii As Integer)
If KeyAscii = 13 Then
    cmd_CZ_Click
End If
End Sub



Private Sub TJ_mousedown(Button As Integer, Shift As Integer, X As Single, Y As Single)
TJ.BorderStyle = 1
End Sub
Private Sub TJ_mouseup(Button As Integer, Shift As Integer, X As Single, Y As Single)
TJ.BorderStyle = 0

add_Click

End Sub
Private Sub TJ_mousemove(Button As Integer, Shift As Integer, X As Single, Y As Single)
TJ.ForeColor = &HFF&
TJ.MousePointer = 99
End Sub
Private Sub SC_mousedown(Button As Integer, Shift As Integer, X As Single, Y As Single)
SC.BorderStyle = 1
End Sub
Private Sub SC_mouseup(Button As Integer, Shift As Integer, X As Single, Y As Single)
SC.BorderStyle = 0
del_Click
End Sub
Private Sub SC_mousemove(Button As Integer, Shift As Integer, X As Single, Y As Single)
SC.ForeColor = &HFF&
SC.MousePointer = 99
End Sub
Private Sub SG1_mousedown(Button As Integer, Shift As Integer, X As Single, Y As Single)
SG1.BorderStyle = 1
End Sub
Private Sub SG1_mouseup(Button As Integer, Shift As Integer, X As Single, Y As Single)
SG1.BorderStyle = 0
      For Each ff In Forms
      If ff.Name = "frmPASSWORD" Then
          ff.SetFocus
       Else
          frmPASSWORD.Show
      End If
      Next

End Sub
Private Sub SG1_mousemove(Button As Integer, Shift As Integer, X As Single, Y As Single)
SG1.ForeColor = &HFF&
SG1.MousePointer = 99
End Sub
Private Sub TJ1_mousedown(Button As Integer, Shift As Integer, X As Single, Y As Single)
TJ1.BorderStyle = 1
End Sub
Private Sub TJ1_mouseup(Button As Integer, Shift As Integer, X As Single, Y As Single)
TJ1.BorderStyle = 0

If QX <> "管理员" And TopRight <> "超级管理员" Then
    MsgBox "非管理员没有执行此操作的权限", 0 + 64, "提示"
    Exit Sub
End If

      For Each ff In Forms
      If ff.Name = "frmPASSWORDMA" Then
          ff.SetFocus
       Else
          frmPASSWORDMA.Show
      End If
      Next
End Sub
Private Sub TJ1_mousemove(Button As Integer, Shift As Integer, X As Single, Y As Single)
TJ1.ForeColor = &HFF&
TJ1.MousePointer = 99
End Sub
Private Sub person_mousedown(Button As Integer, Shift As Integer, X As Single, Y As Single)
person.BorderStyle = 1

End Sub
Private Sub person_mouseup(Button As Integer, Shift As Integer, X As Single, Y As Single)
person.BorderStyle = 0
lv_dblclick
End Sub
Private Sub person_mousemove(Button As Integer, Shift As Integer, X As Single, Y As Single)
person.ForeColor = &HFF&
person.MousePointer = 99
End Sub
Private Sub addre_mousedown(Button As Integer, Shift As Integer, X As Single, Y As Single)
addre.BorderStyle = 1
End Sub
Private Sub addre_mouseup(Button As Integer, Shift As Integer, X As Single, Y As Single)
addre.BorderStyle = 0

If QX <> "管理员" And TopRight <> "超级管理员" Then
    MsgBox "非管理员没有执行此操作的权限", 0 + 64, "提示"
    Exit Sub
End If

addlw_Click
End Sub
Private Sub addre_mousemove(Button As Integer, Shift As Integer, X As Single, Y As Single)
addre.ForeColor = &HFF&
addre.MousePointer = 99
End Sub

Private Sub delete_mousedown(Button As Integer, Shift As Integer, X As Single, Y As Single)
delete.BorderStyle = 1
End Sub
Private Sub delete_mouseup(Button As Integer, Shift As Integer, X As Single, Y As Single)
delete.BorderStyle = 0

If QX <> "管理员" And TopRight <> "超级管理员" Then
    MsgBox "非管理员没有执行此操作的权限", 0 + 64, "提示"
    Exit Sub
End If

Call delxx
End Sub
Private Sub delete_mousemove(Button As Integer, Shift As Integer, X As Single, Y As Single)
delete.ForeColor = &HFF&
delete.MousePointer = 99
End Sub


Sub View() '显示项目模块
For viewindex = 1 To 5
    If Check2(viewindex).Value = 1 Then
        Select Case Check2(viewindex).Caption
            Case "朋友", "经销商", "印花厂", "供应商"
            sql1 = "select * from 联系人档案 where 分类='" & Check2(viewindex).Caption & "'"
            Case Else
            sql1 = "select * from 联系人档案 where " & "分类<>'朋友'" & "and" & " 分类<>'经销商'" & "and" & " 分类<>'印花厂'" & "and" & " 分类<>'供应商'"
        End Select
        Call OpenConn
        rs.Open sql1, cn, 3, 3
          If rs.RecordCount > 0 Then
            Do While Not rs.EOF
          
                Set addlist = lv.ListItems.add(, , IIf(IsNull(rs.Fields(rs.Fields(0).Name)), "", rs.Fields(rs.Fields(0).Name)), , 1)
                
               
                    For v = 1 To rs.Fields.Count - 1
                 
                    addlist.SubItems(v) = IIf(IsNull(rs.Fields(rs.Fields(v).Name)), "", rs.Fields(rs.Fields(v).Name))
                  
                Next v
                
                rs.MoveNext
            Loop
        Call CloseConn
          End If
   End If
Next viewindex
End Sub

Sub lookinfo()
Static i
i = i + 1
Call OpenConn
sql = "select * from 联系人档案 where 籍贯='广东广州'"
rs.Open sql, cn, 3, 3

MsgBox rs.Bookmark & Space(10) & rs.Fields("编号") & rs.Fields("姓名") & rs.AbsolutePosition

End Sub
Sub delxx() '删除选中项目过程模块
On Error GoTo err
err:
 If err.Description <> "" Then
 End If

 Dim nCount     As Integer
          Dim nIndex     As Integer
          Dim oitem     As ListItem
    If lv.ListItems.Count = 0 Then
        MsgBox "列表中没有可操作的项目！", vbOKOnly, "提示"
        Exit Sub
    End If
    
    If MsgBox("此操作将删除所有选中项目的联系人信息以及来往记录，是否继续操作？", vbYesNo, "确认删除") = vbNo Then Exit Sub
    
          With lv
                  nCount = .ListItems.Count
                  For nIndex = nCount To 1 Step -1
                          If .ListItems.Item(nIndex).Selected = True Or .ListItems.Item(nIndex).Checked = True Then
                       
                           '------------------------------------------------------删除对应编号联系人
                                Call OpenConn
                                sql = "select * from 联系人档案 where 编号=" & .ListItems.Item(nIndex).Text
                                rs.Open sql, cn, 3, 3
                                rs.delete
                                rs.Update
                                Call CloseConn
                         '------------------------------------------------------删除对应编号联系人的来往记录
                                 Call OpenConn
                                sql = "select * from 来往记录 where 编号='" & .ListItems.Item(nIndex).Text & "'"
                                rs.Open sql, cn, 3, 3
                                Do While Not rs.EOF
                                   rs.delete
                                   rs.Update
                                   rs.MoveNext
                                Loop
                                Call CloseConn
                         '------------------------------------------------------删除对应编号联系人的相片
                         
                               If Dir(App.Path & "\picture\" & .ListItems.Item(nIndex).Text & ".jpg", vbDirectory) <> "" Then

                                         Kill App.Path & "\picture\" & .ListItems.Item(nIndex).Text & ".jpg"
                                
                                End If
                        '------------------------------------------------------列表中删除选中项
                                .ListItems.Remove nIndex '
                          End If
                  Next
          End With
End Sub


Sub Addall()
On Error GoTo err
 '----------------------------------------------------加载默认列表项目
    lv.ColumnHeaders.clear '清除列头
    
    sql = "select * from 联系人档案 order by 编号"
    Call OpenConn
    rs.Open sql, cn, 3, 3
    
    Me.lv.ListItems.clear
    
    For i = 0 To rs.Fields.Count - 1
    
        Me.lv.ColumnHeaders.add = rs.Fields(i).Name
        
        Next i
    
    lv.ColumnHeaders(1).Width = 800
    
    
    lv.ListItems.clear '清除列表项目
         
If rs.RecordCount > 0 Then
    
    Do While Not rs.EOF
    
        Set addlist = lv.ListItems.add(, , IIf(IsNull(rs.Fields(rs.Fields(0).Name)), "", rs.Fields(rs.Fields(0).Name)), , 1)
        
       
            For k = 1 To rs.Fields.Count - 1
         
            addlist.SubItems(k) = IIf(IsNull(rs.Fields(rs.Fields(k).Name)), "", rs.Fields(rs.Fields(k).Name))
          
        Next k
        
        rs.MoveNext
    Loop

 End If

Call CloseConn

'----------------------设置前四列列宽
lv.ColumnHeaders(1).Width = 800
lv.ColumnHeaders(2).Width = 800
lv.ColumnHeaders(3).Width = 800
lv.ColumnHeaders(4).Width = 1000
lv.ColumnHeaders(5).Width = 1600
lv.ColumnHeaders(6).Width = 1600
lv.ColumnHeaders(7).Width = 800
lv.ColumnHeaders(8).Width = 1600
t = 1
 
err:
 If err.Description <> "" Then
 End If
 
End Sub
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Dim ff As Form

Select Case Button.Index
   Case Is = 2
     newadd_Click
   Case Is = 4
   
                        For Each ff In Forms
                    
                        If ff.Name = "GJfind" Then
                           ff.SetFocus
                        Else
                          GJfind.Show
                        End If
                        Next
    
   Case Is = 5
                        For Each ff In Forms
                    
                        If ff.Name = "findHistory" Then
                           ff.SetFocus
                        Else
                          findHistory.Show
                        End If
                        Next

   Case Is = 7
   
     If QX <> "管理员" And TopRight <> "超级管理员" Then
      MsgBox "非管理员没有执行此操作的权限", 0 + 64, "提示"
      Exit Sub
      End If
      For Each ff In Forms
      If ff.Name = "frmPASSWORDMA" Then
                           ff.SetFocus
                        Else
                          frmPASSWORDMA.Show
                        End If
                        Next
    

End Select
End Sub

Private Sub toolbar1_ButtonMenuClick(ByVal buttonmenu As MSComctlLib.buttonmenu)

                    Dim i As Long
        
          Select Case buttonmenu.Key
          Case "MinAll"
                  
                        Dim f As Form
                        For Each f In Forms
                        
                            If f.Caption <> "客户通讯录管理系统" And f.Caption <> "客户信息汇总" Then
                                 f.WindowState = 1
                            End If
                        Next
                        
                  Case "ShutdownAll"
                         Dim ff As Form
                        For Each ff In Forms
                    
                        If ff.Caption <> "客户信息汇总" And ff.Caption <> "客户通讯录管理系统" Then
                             Unload ff
                        End If
                        Next
                  Case "reAll"
                         Dim fff As Form
                        For Each fff In Forms
                    
                        If fff.Caption <> "客户信息汇总" And fff.Caption <> "客户通讯录管理系统" Then
                             fff.WindowState = 0
                        End If
                        Next
            
                  Case "MeBack"
                    Me.ZOrder 1
                    
            
            End Select

          
End Sub