zjm.frm

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

      Begin VB.Menu eew 
         Caption         =   "-"
      End
      Begin VB.Menu DeleteSelect 
         Caption         =   "【删除选中联系人】"
         Shortcut        =   +{DEL}
      End
      Begin VB.Menu order 
         Caption         =   "排序"
         Visible         =   0   'False
         Begin VB.Menu AddDate 
            Caption         =   "按添加日期"
         End
         Begin VB.Menu a 
            Caption         =   "按"
         End
      End
   End
End
Attribute VB_Name = "ZJM"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim t '定义控件是否随窗体变化而变化控制变量

Private FormOldWidth As Long
    '保存窗体的原始宽度
Private FormOldHeight As Long
    '保存窗体的原始高度
Public sFind As String

Private Sub aboutmenu_Click()
about.Show
End Sub

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

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

addlw_Click
End Sub



Private Sub addlw_Click()
On Error GoTo err

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

If lv.ListItems.Count > 0 Then
    Dim i As Long
    AddNO = lv.SelectedItem
    ReDim infoarr(i)
    Set infoarr(i) = New Class1
    Set infoarr(i).newForm = New LWJL
    Load infoarr(i).newForm
Else
    MsgBox "列表中没有项目", 0 + 64, "提示"
End If

err:
If err.Description <> "" Then
    MsgBox "操作失败！", 0 + 64, "错误 "
End If
End Sub

Private Sub all_Click()
CommandButton1_Click

End Sub

Private Sub bwlmenu_Click()
BWL.Show
End Sub

Private Sub Check1_Click()

If Check1.Value = 1 Then
  Combo2.Visible = True
  Combo2.clear
  sql = "select distinct 分类 from 联系人档案"
  Call OpenConn
  rs.Open sql, cn, 1, 1
  If rs.RecordCount > 0 Then
    Do While Not rs.EOF
        If IIf(IsNull(rs!分类), "", rs!分类) <> "" Then
            Combo2.AddItem IIf(IsNull(rs!分类), "", rs!分类)
        End If
        rs.MoveNext
    Loop
  End If
Else
  Combo2.Visible = False
End If

End Sub

Private Sub Check2_Click(Index As Integer)
Check1.Value = 0
lv.ListItems.clear
Call View

End Sub

Private Sub cmd_CZ_Click()
On Error GoTo err

lv.ListItems.clear

'-----------------------------当查询条件为“所有项目时"
If Combo1 = "所有项目" Then
    Me.lv.ListItems.clear '先清空listview
Call OpenConn
   sql = "select * from 联系人档案"
   rs.Open sql, cn, 3, 3
   
 For i = 0 To rs.Fields.Count - 1
     xmmc = rs.Fields(i).Name
            
         Call OpenConn1
    sql1 = "select * from 联系人档案 where " & xmmc & " like '%" & Text1 & "%'"
         rs1.Open sql1, cn1, 3, 3
         If rs1.RecordCount > 0 Then
            Do While Not rs1.EOF
            
            Set Item = lv.FindItem(rs1.Fields("编号"), , , lvwPartial) '判断是否是重复客户
            If Item Is Nothing Then
                it = 1
            Else
                it = 0
            End If
            
             If it = 1 Then
              Set addlist = lv.ListItems.add(, , IIf(IsNull(rs1.Fields(rs1.Fields(0).Name)), "", rs1.Fields(rs1.Fields(0).Name)), , 1)
                   
                For h = 1 To rs1.Fields.Count - 1
             
                addlist.SubItems(h) = IIf(IsNull(rs1.Fields(rs1.Fields(h).Name)), "", rs1.Fields(rs1.Fields(h).Name))
              
                Next h
             End If
             
            rs1.MoveNext
            Loop
         End If
          Call CloseConn1
  
 Next i
Call CloseConn
Exit Sub
End If

'-----------------------------当查询条件不为“所有项目时"
Call OpenConn
sql = "select * from 联系人档案 where " & Combo1 & " like '%" & Text1 & "%'"
rs.Open sql, 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 u = 1 To rs.Fields.Count - 1
         
            addlist.SubItems(u) = IIf(IsNull(rs.Fields(rs.Fields(u).Name)), "", rs.Fields(rs.Fields(u).Name))
          
        Next u
        
        rs.MoveNext
    Loop
       
End If

err:
If err.Description <> "" Then
    MsgBox "操作错误，请检查你的查询条件", vbOKOnly, "提示"
End If

End Sub

Private Sub Combo1_click()
Text1.SetFocus
End Sub

Private Sub Command1_Click()

End Sub

Private Sub Combo2_click()
lv.ListItems.clear
sql = "select distinct * from 联系人档案 where 分类='" & Combo2.Text & "'"
        Call OpenConn
        rs.Open sql, 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 Sub

Private Sub CommandButton1_Click()
 For X = 1 To 5
     Check2(X).Value = 1
 Next X
End Sub

Private Sub CommandButton2_Click()
lv.ListItems.clear
 For Y = 1 To 5
     Check2(Y).Value = 0
   Next Y

End Sub



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

Private Sub deletenow_Click()
On Error GoTo err

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

If lv.ListItems.Count = 0 Then
     MsgBox "没有选中项目！", 0 + 64, "提示"
     Exit Sub
End If

 If MsgBox("此操作将删除当前联系人信息以及来往记录，是否继续操作？", vbYesNo, "确认删除") = vbNo Then Exit Sub
                       
                           '------------------------------------------------------删除对应编号联系人
                                Call OpenConn
                                sql = "select * from 联系人档案 where 编号=" & lv.SelectedItem
                                rs.Open sql, cn, 3, 3
                                rs.delete
                                rs.Update
                                Call CloseConn
                         '------------------------------------------------------删除对应编号联系人的来往记录
                                 Call OpenConn
                                sql = "select * from 来往记录 where 编号='" & lv.SelectedItem & "'"
                                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\" & lv.SelectedItem & ".jpg", vbDirectory) <> "" Then
                            
                            '------------------------------------------------------删除对应编号联系人的相片

                                         Kill App.Path & "\picture\" & lv.SelectedItem & ".jpg"
                                                          
                           End If
                        '------------------------------------------------------列表中删除选中项
                           Call Addall
err:
If err.Description <> "" Then
    MsgBox "没有选中项目！", 0 + 64, "提示"
End If

End Sub

Private Sub DeleteSelect_Click()

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

If lv.ListItems.Count = 0 Then
     MsgBox "没有选中项目！", 0 + 64, "提示"
     Exit Sub
End If

   Call delxx
End Sub

Private Sub edit_Click()
SGXX.Show
End Sub
Private Sub form_activate()
On Error GoTo err
Text1.SetFocus

err:
If err.Description <> "" Then
    err.clear
End If

End Sub
'当主窗体加载时
Private Sub Form_Load()

Me.Width = 17820
Me.Height = 11310
Me.Top = Screen.Height / 2 - Me.Height / 2 - 800
Me.Left = Screen.Width / 2 - Me.Width / 2

Call ResizeInit(Me)

'----------------------加载列表项目

Call Addall

'----------------------加载可选查询条件

Combo1.AddItem "所有项目"
sql = "select * from 联系人档案"
Call OpenConn
rs.Open sql, cn, 3, 3

 For i = 0 To rs.Fields.Count - 1
    
    Combo1.AddItem rs.Fields(i).Name
        
 Next i
Call CloseConn


End Sub
Private Sub Form_queryunload(Cancel As Integer, unloadmode As Integer) '退出子窗体时卸载所有窗体
If click = 0 Then
    Cancel = True
    Me.Hide
Else
   RemoveFromTray
End If
End Sub


Private Sub Form_Resize()
If t = 1 Then

 Call ResizeForm(Me)
 Combo1.Width = Text1.Width
 Combo1.Left = Text1.Left
End If
End Sub



Private Sub AllCancel_Click()
CommandButton2_Click
End Sub

Private Sub geren_Click()
lv_dblclick
End Sub

Private Sub gj_Click()
For Each ff In Forms
    If ff.Name = "GJfind" Then
        ff.SetFocus
    Else
        GJfind.Show
    End If
Next
End Sub



Private Sub gjCZ_Click()
For Each ff In Forms
    If ff.Name = "GJfind" Then
       ff.SetFocus
    Else
        GJfind.Show
    End If
Next
End Sub

Private Sub gl_Click()

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 jsq_Click()
frmcount.Show
End Sub

Private Sub lookAll_Click()
                      For Each ff In Forms
                    
                        If ff.Name = "findHistory" Then
                           ff.SetFocus
                        Else
                          findHistory.Show
                        End If
                        Next

End Sub

Private Sub LookForAll_Click() '显示所有联系人信息
Call Addall
End Sub



Private Sub LookSelect_Click()
lv_dblclick
End Sub

Private Sub lv_mousedown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then