frmsearch.frm

这是一个家庭信息管理的小软件！

      End
      Begin VB.Menu mnuDeleteall 
         Caption         =   "Delete &All Records Listed"
      End
      Begin VB.Menu gtjyg 
         Caption         =   "-"
      End
      Begin VB.Menu kgb 
         Caption         =   "-"
      End
      Begin VB.Menu mnuPrintSelcted 
         Caption         =   "&Print Selected Record"
      End
      Begin VB.Menu fghgh 
         Caption         =   "-"
      End
      Begin VB.Menu mnuPrintAll 
         Caption         =   "Prin&t All Records Listed"
      End
      Begin VB.Menu fgtyhf 
         Caption         =   "-"
      End
   End
End
Attribute VB_Name = "frmSearch"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'**********************************************************************
'To God Be The Glory
'**********************************************************************
Option Explicit
 'Variable Declaration
  Public Search_Database As Database
  Public Search_Recordset As Recordset
  Public Search_Sql As String
  Public Public_Sql As String
  Public lvHeader As ColumnHeader
  Public lvListItems As ListItem
  Dim Record_To_Delete As String
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Private Sub FNameCheck1_Click()
  If FNameCheck1.Value = 1 Then
     ListAllCheck1.Value = 0
  End If
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Private Sub Form_Load()
 frmEdit_Editting = False
 frmMain.Enabled = False
 frmMain.Hide
 Call Load_LV_Header
 
 SexCombo1.Clear
 SexCombo1.AddItem "Male"
 SexCombo1.AddItem "Female"
 SexCombo1.ListIndex = 0
 RelCombo1.Clear
 RelCombo1.AddItem "Family"
 RelCombo1.AddItem "Spouse"
 RelCombo1.AddItem "Friend"
 RelCombo1.AddItem "Co-Worker"
 RelCombo1.AddItem "Acquaintance"
 RelCombo1.ListIndex = 0
 StatusBar1.Panels(1).Text = "My Family Address Book v2.0 :[Record Search]"
 
 FName.Text = ""
 LName.Text = ""
 FNameCheck1.Value = 0
 LNameCheck1.Value = 0
 RelationCheck1.Value = 0
 SexCheck1.Value = 0
End Sub
'**********************************************************************
'**********************************************************************



'**********************************************************************
'**********************************************************************
Private Sub Form_Resize()
  'Minimized
  If Me.WindowState = 1 Then
     If Minimize_To_Tray Then
        Set SrchTrayArea1.Icon = Me.Icon
        SrchTrayArea1.ToolTip = " Double-Click To Restore " & frmSearch.Caption & " "
        SrchTrayArea1.Visible = True
        frmSearch.Hide
     End If
  End If
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Private Sub Form_Unload(Cancel As Integer)
  Load frmMain
  frmMain.Enabled = True
  frmMain.Init_Main
  frmMain.Show
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Private Sub ListAllCheck1_Click()
 If ListAllCheck1.Value = 1 Then
    FNameCheck1.Value = 0
    LNameCheck1.Value = 0
    RelationCheck1.Value = 0
    SexCheck1.Value = 0
 End If
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Private Sub LNameCheck1_Click()
  If LNameCheck1.Value = 1 Then
     ListAllCheck1.Value = 0
  End If
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Private Sub mnuAbout_Click()
  Load frmAbout
  frmAbout.Show
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Private Sub mnuDelete_Click()
  Dim DelAns As VbMsgBoxResult
  Dim DelTokens() As String
  Dim DNumberOfTokens As Integer
  Dim DelDB As Database
  On Error GoTo DEL_ALL_ERR
  
  DNumberOfTokens = ParseDelimitedString(Record_To_Delete, DelTokens, "_")
  DelAns = MsgBox("Are you sure that you want to delete " & DelTokens(0) & " " & DelTokens(1) & " ?", vbQuestion + vbYesNo)
  
  If DelAns = vbYes Then
     If DNumberOfTokens > 0 Then
        Set DelDB = OpenDatabase(Database_Path & "\" & Database_Name, False, False, ";pwd=" & Database_Password)
        DelDB.Execute "DELETE FROM " & Current_LoginName & " WHERE FirstName = '" & DelTokens(0) _
                     & "' AND LastName = '" & DelTokens(1) & "' AND Relation = '" & DelTokens(2) & "'"
        DelDB.Close
        Call SrchBtn_Click
     End If
  End If
  Exit Sub
  
DEL_ALL_ERR:
  If Err.Number <> 0 Then
     MsgBox "Error " & Str(Err.Number) & " " & Err.Description, vbCritical + vbOKOnly
     Err.Clear
  End If
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Private Sub mnuDeleteall_Click()
  Dim DelallAns As VbMsgBoxResult
 ' On Error GoTo DelAllErr
  DelallAns = MsgBox("Are you sure that you want to delete the " & Str(srchListView1.ListItems.Count) & " record(/s) listed?", vbQuestion + vbYesNo)
  
  If DelallAns = vbYes Then
     Dim DelDB As Database
     Dim DelRec As Recordset
    'Open Database
     Set DelDB = OpenDatabase(Database_Path & "\" & Database_Name, False, False, ";pwd=" & Database_Password)
    'Set DelRec =
     DelDB.Execute "DELETE FROM " & Apostrophe(Public_Sql)
    'DelRec.Close
     DelDB.Close
     Call SrchBtn_Click
  End If
  Exit Sub
DelAllErr:
  If Err.Number <> 0 Then
     Err.Clear
  End If
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Private Sub mnuEdit_Click()
  Dim tmpStr As String
  Dim Token() As String
  Dim NumberOfTokens As Integer
  
 'Phrase the data
  NumberOfTokens = ParseDelimitedString(Record_To_Delete, Token, "_")
  
  tmpStr = " WHERE FirstName = '" & Token(0) & "'"
  tmpStr = tmpStr & "AND LastName = '" & Token(1) & "'"
  tmpStr = tmpStr & "AND Relation = '" & Token(2) & "'"
 'Store the value in tmpstr to the vaiable Edit_SQL in frmEdit
  frmEdit.Edit_SQL = tmpStr
 'Minimize frmSearch
  Me.WindowState = vbMinimized
 'Load and show frmEdit
  Load frmEdit
  frmEdit.Show
End Sub
'**********************************************************************
'**********************************************************************



'**********************************************************************
'**********************************************************************
Private Sub mnuExit_Click()
 Call SrchTrayArea1_DblClick
 Call srchClose_Click
End Sub
'**********************************************************************
'**********************************************************************



'**********************************************************************
'**********************************************************************
Private Sub mnuHelp_Click()
  Load frmHelp
  frmHelp.Show
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Private Sub mnuPrintAll_Click()
 'Print All Records Listed
  Dim PR_ALL_DB As Database
  Dim PR_ALL_REC As Recordset
  On Error Resume Next
  
  Set PR_ALL_DB = OpenDatabase(Database_Path & "\" & Database_Name, False, True, ";pwd=" & Database_Password)
  Set PR_ALL_REC = PR_ALL_DB.OpenRecordset("SELECT * FROM " & Public_Sql)
  
  PR_ALL_REC.Fields.Refresh
  PR_ALL_REC.MoveFirst
  
  Printer.Font = "Times New Roman"
  Printer.FontBold = False
  Printer.FontUnderline = True
  Printer.FontSize = 10
  Printer.Print vbNewLine
  PrintCenter (Current_LoginName & "'s " & App.ProductName)
  Printer.FontUnderline = False
  Printer.FontBold = False
  Printer.Print vbNewLine
  Do While Not PR_ALL_REC.EOF
     Printer.Print Space(6) & "Name : " & ProperString(PR_ALL_REC.Fields("FirstName")) & " " & ProperString(PR_ALL_REC.Fields("LastName"))
     Printer.Print Space(6) & "Sex : " & PR_ALL_REC.Fields("Sex")
     Printer.Print Space(6) & "Telephone : " & PR_ALL_REC.Fields("Telephone") & " "
     Printer.Print Space(6) & "Address : " & PR_ALL_REC.Fields("Address") & ""
     Printer.Print Space(6) & "City-State-ZipCode : " & PR_ALL_REC.Fields("City_State"); "-"; PR_ALL_REC.Fields("ZipCode")
     Printer.Print vbNewLine
     PR_ALL_REC.MoveNext
  Loop
  Printer.EndDoc
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Private Sub mnuPrintSelcted_Click()
 'Print Selected Record
  Dim PStr As String
  Dim Token() As String
  Dim NumberOfPTokens As Integer
  Dim PDB As Database
  Dim PRec As Recordset
  On Error Resume Next
  
  NumberOfPTokens = ParseDelimitedString(Record_To_Delete, Token, "_")
  PStr = "SELECT * FROM " & Current_LoginName & " WHERE FirstName = '" & Token(0) & "'"
  PStr = PStr & "AND LastName = '" & Token(1) & "'"
  PStr = PStr & "AND Relation = '" & Token(2) & "'"
  
  Set PDB = OpenDatabase(Database_Path & "\" & Database_Name, False, True, ";pwd=" & Database_Password)
  Set PRec = PDB.OpenRecordset(PStr)
  PRec.Fields.Refresh
  PRec.MoveFirst
  
  Printer.Font = "Times New Roman"
  Printer.FontBold = False
  Printer.FontUnderline = True
  Printer.FontSize = 10
  Printer.Print vbNewLine
  PrintCenter (Current_LoginName & "'s " & App.ProductName)
  Printer.FontUnderline = False
  Printer.FontBold = False
  Printer.Print vbNewLine
  Do While Not PRec.EOF
     Printer.Print vbNewLine
     Printer.Print Space(6) & "Name : " & ProperString(PRec.Fields("FirstName")) & " " & ProperString(PRec.Fields("LastName"))
     Printer.Print Space(6) & "Sex : " & PRec.Fields("Sex")
     Printer.Print Space(6) & "Telephone : " & PRec.Fields("Telephone") & " "
     Printer.Print Space(6) & "Address : " & PRec.Fields("Address") & ""
     Printer.Print Space(6) & "City-State-ZipCode : " & PRec.Fields("City_State"); "-"; PRec.Fields("ZipCode")