frmmain.frm

利用Visual Basic编写的小程序

      Begin VB.Label Label8 
         Caption         =   "办公电话"
         Height          =   255
         Left            =   210
         TabIndex        =   13
         Top             =   1085
         Width           =   870
      End
   End
   Begin VB.Frame Frame1 
      Caption         =   "姓名"
      Height          =   3885
      Left            =   120
      TabIndex        =   3
      Top             =   480
      Width           =   1605
      Begin VB.ListBox lstName 
         Height          =   3480
         ItemData        =   "frmMain.frx":0E71
         Left            =   120
         List            =   "frmMain.frx":0E73
         TabIndex        =   4
         Top             =   270
         Width           =   1350
      End
   End
   Begin VB.ComboBox comSex 
      Height          =   300
      ItemData        =   "frmMain.frx":0E75
      Left            =   2160
      List            =   "frmMain.frx":0E82
      Style           =   2  'Dropdown List
      TabIndex        =   2
      Top             =   105
      Width           =   615
   End
   Begin VB.ComboBox comCity 
      Height          =   300
      ItemData        =   "frmMain.frx":0E94
      Left            =   600
      List            =   "frmMain.frx":0E9B
      Style           =   2  'Dropdown List
      TabIndex        =   0
      Top             =   105
      Width           =   975
   End
   Begin VB.Label Label16 
      Caption         =   "职务"
      Height          =   255
      Left            =   2880
      TabIndex        =   41
      Top             =   135
      Width           =   495
   End
   Begin VB.Label Label1 
      Caption         =   "城市"
      Height          =   255
      Left            =   120
      TabIndex        =   7
      Top             =   128
      Width           =   495
   End
   Begin VB.Label Label2 
      Caption         =   "性别"
      Height          =   255
      Left            =   1680
      TabIndex        =   1
      Top             =   120
      Width           =   495
   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 Sub cmdAdd_Click()
    frmEdit.mode = 1
    frmEdit.Show 1

End Sub
Private Sub cmdEdit_Click()
    frmEdit.mode = 2
    frmEdit.Show 1
    If lstName.ListIndex >= 0 Then
        Call ShowInfo(lstName.ItemData(lstName.ListIndex))
    End If
End Sub

Private Sub cmdDelete_Click()
    Dim i As Integer, j As Integer
    If lstName.ListIndex < 0 Then Exit Sub
    If MsgBox("是否要永久删除 " & Trim(lstName.Text) & " 的信息？", vbQuestion + vbDefaultButton2 + vbYesNo) = vbNo Then Exit Sub
    Kill App.Path & "\photos\" & Trim(lstName.Text) & ".jpg"
    Addrs(lstName.ItemData(lstName.ListIndex)).Deleted = True
    lstName.RemoveItem lstName.ListIndex
    Call Clear_Control
End Sub


Private Sub cmdNavi_Click(Index As Integer)
    If lstName.ListCount = 0 Then Exit Sub
    Select Case Index
    Case 0
        lstName.ListIndex = 0
    Case 1
        If lstName.ListIndex > 0 Then lstName.ListIndex = lstName.ListIndex - 1
    Case 2
        If lstName.ListIndex < lstName.ListCount - 1 Then lstName.ListIndex = lstName.ListIndex + 1
    Case 3
        lstName.ListIndex = lstName.ListCount - 1
    End Select
    
End Sub

Private Sub comCity_Click()
    Dim i As Integer, j As Integer
    Call Clear_Control
    lstName.Clear
    
    For i = 1 To RecNum
        If Not Addrs(i).Deleted Then
            If comCity.Text = "全部" Or Left(Trim(Addrs(i).City), Len(Trim(comCity.Text))) = Trim(comCity.Text) Then
                If comSex.Text = "全部" Or comSex.Text = "男" And Addrs(i).Sex Or comSex.Text = "女" And Not Addrs(i).Sex Then
                     If comTitle.Text = "全部" Or Left(Trim(Addrs(i).Title), Len(Trim(comTitle.Text))) = Trim(comTitle.Text) Then
                        lstName.AddItem Addrs(i).Name
                        lstName.ItemData(lstName.NewIndex) = i
                     End If
                End If
            End If
        
        End If
    Next
    If lstName.ListCount > 0 Then lstName.ListIndex = 0
    
End Sub

Private Sub comSex_click()
    Call comCity_Click
End Sub

Private Sub comTitle_click()
    Call comCity_Click
End Sub

Private Sub Form_Load()
    Dim addr1 As Addr
    Dim i As Integer, j As Integer
    Dim str1 As String
    Dim lng1 As Long
    Dim s As String * 100
    Dim n As Integer
    
    comCity.Text = "全部"
    comSex.Text = "全部"
    comTitle.Text = "全部"
    '读入城市名==============================
    n = GetPrivateProfileString("系统", "城市名", "", s, 99, App.Path & "\addr.ini")        '读入城市名称
    s = Left(s, n)
    n = DivideString(s, ",", Cities)
    For i = 1 To n
        comCity.AddItem Cities(i)
    Next
    
    '读入职务名==============================
    n = GetPrivateProfileString("系统", "职务名", "", s, 99, App.Path & "\addr.ini")
    s = Left(s, n)
    n = DivideString(s, ",", Titles)
    
    For i = 1 To n
        comTitle.AddItem Titles(i)
    Next
    
    
    i = 0
    
    Do
        i = i + 1
        n = GetPrivateProfileString("Record" & i, "姓名", "", s, 99, App.Path & "\addr.ini")
        
        If n < 2 Then Exit Do
        ReDim Preserve Addrs(i)
       
        Addrs(i).Name = Left(s, n / 2)
        
        n = GetPrivateProfileString("Record" & i, "性别", "", s, 99, App.Path & "\addr.ini")
        If Left(s, n / 2) = "男" Then           '一个汉字两上字节
            Addrs(i).Sex = True
        Else
            Addrs(i).Sex = False
        End If

        n = GetPrivateProfileString("Record" & i, "邮政编码", "", s, 99, App.Path & "\addr.ini")
        Addrs(i).PostalCode = s
        n = GetPrivateProfileString("Record" & i, "手机", "", s, 99, App.Path & "\addr.ini")
        Addrs(i).Mobile = s
        n = GetPrivateProfileString("Record" & i, "电子邮件", "", s, 99, App.Path & "\addr.ini")
        Addrs(i).Email = s
        n = GetPrivateProfileString("Record" & i, "出生日期", "", s, 99, App.Path & "\addr.ini")
        Addrs(i).Birthday = s
        n = GetPrivateProfileString("Record" & i, "所在城市", "", s, 99, App.Path & "\addr.ini")
        Addrs(i).City = s
        n = GetPrivateProfileString("Record" & i, "工作单位", "", s, 99, App.Path & "\addr.ini")
        Addrs(i).Company = s
        n = GetPrivateProfileString("Record" & i, "住宅电话", "", s, 99, App.Path & "\addr.ini")
        Addrs(i).Tel_Home = s
        n = GetPrivateProfileString("Record" & i, "办公电话", "", s, 99, App.Path & "\addr.ini")
        Addrs(i).Tel_Office = s
        n = GetPrivateProfileString("Record" & i, "照片", "", s, 99, App.Path & "\addr.ini")
        Addrs(i).photo = CBool(Left(s, n))
        n = GetPrivateProfileString("Record" & i, "职务职称", "", s, 99, App.Path & "\addr.ini")
        Addrs(i).Title = Left(s, n)
        n = GetPrivateProfileString("Record" & i, "地址", "", s, 99, App.Path & "\addr.ini")
        Addrs(i).Address = Left(s, n)

        lstName.AddItem Addrs(i).Name
        lstName.ItemData(lstName.NewIndex) = i      '使用itemdata属性记住列表框中的每个人在数组中的位置

    Loop
    RecNum = i - 1
    
    lstName.ListIndex = 0
    
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Dim addr1 As Addr                                       '退出时保存数据
    Dim i As Integer
    Dim s As String
   ' Dim modifiednum As Integer
    
    For i = 1 To RecNum
        If Addrs(i).Modified Or Addrs(i).Deleted Then Exit For
    Next
    If i > RecNum Then Exit Sub     '如果未编辑则不重新保存
    
    If Dir(App.Path & "\addr.bak") <> "" Then Kill App.Path & "\addr.bak"   '生成备份文件
    If Dir(App.Path & "\addr.ini") <> "" Then Name App.Path & "\addr.ini" As App.Path & "\addr.bak"         '打开通讯录数据文件，读入记录
    If Dir(App.Path & "\addr.ini") <> "" Then Kill App.Path & "\addr.ini"        '打开通讯录数据文件，读入记录
    
   '将通讯录记录保存到文件中===================================
    For i = 1 To RecNum
        If Not Addrs(i).Deleted Then
            WritePrivateProfileString "Record" & i, "姓名", Addrs(i).Name, App.Path & "\addr.ini"
            If Addrs(i).Sex Then
                WritePrivateProfileString "Record" & i, "性别", "男", App.Path & "\addr.ini"
            Else
                WritePrivateProfileString "Record" & i, "性别", "女", App.Path & "\addr.ini"
            End If
            WritePrivateProfileString "Record" & i, "邮政编码", Addrs(i).PostalCode, App.Path & "\addr.ini"
            WritePrivateProfileString "Record" & i, "手机", Addrs(i).Mobile, App.Path & "\addr.ini"
            WritePrivateProfileString "Record" & i, "电子邮件", Addrs(i).Email, App.Path & "\addr.ini"
            WritePrivateProfileString "Record" & i, "出生日期", CStr(Addrs(i).Birthday), App.Path & "\addr.ini"
            WritePrivateProfileString "Record" & i, "所在城市", Addrs(i).City, App.Path & "\addr.ini"
            WritePrivateProfileString "Record" & i, "工作单位", Addrs(i).Company, App.Path & "\addr.ini"
            WritePrivateProfileString "Record" & i, "住宅电话", Addrs(i).Tel_Home, App.Path & "\addr.ini"
            WritePrivateProfileString "Record" & i, "办公电话", Addrs(i).Tel_Office, App.Path & "\addr.ini"
            WritePrivateProfileString "Record" & i, "照片", CStr(Addrs(i).photo), App.Path & "\addr.ini"
            WritePrivateProfileString "Record" & i, "职务职称", Addrs(i).Title, App.Path & "\addr.ini"
            WritePrivateProfileString "Record" & i, "地址", Addrs(i).Address, App.Path & "\addr.ini"
        End If
    Next
    
    
    '将城市名称记录到文件中==================================
    For i = 1 To UBound(Cities())
        If i = 1 Then
            s = Trim(Cities(i))
        Else
            s = s & "," & Cities(i)
        End If
    Next
    
    WritePrivateProfileString "系统", "城市名", s, App.Path & "\addr.ini"
    '将职务职称名称记录到文件中==================================
    For i = 1 To UBound(Titles)
        If i = 1 Then
            s = Trim(Titles(i))
        Else
            s = s & "," & Trim(Titles(i))
        End If
    Next
    
    WritePrivateProfileString "系统", "职务名", s, App.Path & "\addr.ini"
    

End Sub

Private Sub lstName_Click()
    Dim i As Integer
    i = lstName.ItemData(lstName.ListIndex)
    Call ShowInfo(i)
End Sub
Private Sub Clear_Control()
    txtName = ""
    txtSex = ""
    txtBirthday = ""
    txtCity = ""
    txtCompany = ""
    txtTelHome = ""
    txtTelOffice = ""
    txtPostalCode = ""
    txtEmail = ""
    txtMobile = ""
    txtTitle = ""
    txtAddress = ""
    imgPhoto.Picture = LoadPicture
End Sub

Private Sub ShowInfo(i As Integer)
    txtName = Addrs(i).Name
    If Addrs(i).Sex Then txtSex = "男" Else txtSex = "女"
    With Addrs(i)
        txtBirthday = .Birthday
        txtCity = .City
        txtCompany = .Company
        txtTelHome = .Tel_Home
        txtTelOffice = .Tel_Office
        txtPostalCode = .PostalCode
        txtMobile = .Mobile
        txtEmail = .Email
        txtTitle = .Title
        txtAddress = .Address
        
        If Dir(App.Path & "\photos\" & Trim(Addrs(i).Name) & ".jpg") = "" Then
            Addrs(i).photo = False
        End If
        
        If Addrs(i).photo Then
            imgPhoto.Picture = LoadPicture(App.Path & "\photos\" & Trim(Addrs(i).Name) & ".jpg")
        Else
            imgPhoto.Picture = LoadPicture()
        End If
    End With

End Sub