frmsearch.frm

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

     Printer.Print vbNewLine
     PRec.MoveNext
  Loop
  Printer.EndDoc
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Private Sub RelationCheck1_Click()
  If RelationCheck1.Value = 1 Then
     ListAllCheck1.Value = 0
  End If
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Private Sub SexCheck1_Click()
  If SexCheck1.Value = 1 Then
     ListAllCheck1.Value = 0
  End If
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Public Sub SrchBtn_Click()
  Dim TMP_KEY As String
  Dim TmpFN As String
  Dim TmpLN As String
  On Error Resume Next

  Search_Sql = ""
  Public_Sql = ""
  TmpFN = ""
  TmpLN = ""
  
  If ListAllCheck1.Value = 1 Then
     Public_Sql = Current_LoginName
     Search_Sql = "SELECT * FROM " & Public_Sql
  End If
     
 'Store First Name and Last Name in Temporary Variables
  TmpFN = Trim(FName.Text)
  TmpLN = Trim(LName.Text)
     
 'Fast Name
  If FNameCheck1.Value = 1 Then
     If Len(TmpFN) < 1 Then
        StatusBar1.Panels(1).Text = "You need to enter a value for [First Name]"
        Exit Sub
       Else
       'Check for apostrophies
        TmpFN = Apostrophe(TmpFN)
        
        Public_Sql = Current_LoginName & " WHERE FirstName LIKE '*" & TmpFN & "*'"
        Search_Sql = "SELECT * FROM " & Public_Sql
     End If
  End If
  
 'Last Name
  If LNameCheck1.Value = 1 Then
     LName.Text = Trim(TmpLN)
     If Len(TmpLN) < 1 Then
        StatusBar1.Panels(1).Text = "You need to enter a value for [Last Name]"
        Exit Sub
       Else
      'Check for apostrophies
        TmpLN = Apostrophe(TmpLN)
        If Len(Search_Sql) > 0 Then
          ' Search_Sql = Search_Sql & " AND LastName LIKE '*" & TmpLN & "*'"
           Public_Sql = Public_Sql & " AND LastName LIKE '*" & TmpLN & "*'"
           Search_Sql = "SELECT * FROM " & Public_Sql
          Else
           Public_Sql = Current_LoginName & " WHERE LastName LIKE '*" & TmpLN & "*'"
           Search_Sql = "SELECT * FROM " & Public_Sql
        End If
     End If
  End If
    
 'Relation
  If RelationCheck1.Value = 1 Then
     If Len(Search_Sql) > 0 Then
        Public_Sql = Public_Sql & " AND Relation = '" & RelCombo1.Text & "'"
        Search_Sql = "SELECT * FROM " & Public_Sql
       Else
        Public_Sql = Current_LoginName & " WHERE Relation = '" & RelCombo1.Text & "'"
        Search_Sql = "SELECT * FROM " & Public_Sql
     End If
  End If
  
 'Sex
  If SexCheck1.Value = 1 Then
     If Len(Search_Sql) > 0 Then
        Public_Sql = Public_Sql & " AND Sex = '" & SexCombo1.Text & "'"
        Search_Sql = "SELECT * FROM " & Public_Sql
       Else
        Public_Sql = Current_LoginName & " WHERE Sex = '" & SexCombo1.Text & "'"
        Search_Sql = "SELECT * FROM " & Public_Sql
     End If
  End If
    
 'Check if the search string is empty
  If Len(Search_Sql) < 1 Then
     StatusBar1.Panels(1).Text = "You need to select one or more of the search options above"
     Exit Sub
  End If
  
  Set Search_Database = OpenDatabase(Database_Path & "\" & Database_Name, False, True, ";pwd=" & Database_Password)
  Set Search_Recordset = Search_Database.OpenRecordset(Search_Sql)
 
 'ListSubItems 1 = Last Name
 'ListSubItems 2 = Sex
 'ListSubItems 3 = Telephone
 'ListSubItems 4 = Address
 'ListSubItems 5 = City-State
 'ListSubItems 6 = Zip Code
 'ListSubItems 7 = Email Address
 
 'clear the listview
  srchListView1.ListItems.Clear
  
  If Search_Recordset.RecordCount > 0 Then
     Search_Recordset.Fields.Refresh
     Do While Not Search_Recordset.EOF
        TMP_KEY = ProperString(Search_Recordset.Fields("FirstName")) & "_" & _
                    ProperString(Search_Recordset.Fields("LastName")) & "_" & _
                    ProperString(Search_Recordset.Fields("Relation")) & "_" & _
                    Search_Recordset.Fields("Sex")
        
        If Search_Recordset.Fields("Sex") = "Male" Then
           Set lvListItems = srchListView1.ListItems.Add(, TMP_KEY, ProperString(Search_Recordset.Fields("FirstName")), "person1", "person1")
          Else
           Set lvListItems = srchListView1.ListItems.Add(, TMP_KEY, ProperString(Search_Recordset.Fields("FirstName")), "person2", "person2")
        End If
        lvListItems.SubItems(1) = ProperString(Search_Recordset.Fields("LastName"))
        lvListItems.SubItems(2) = Search_Recordset.Fields("Sex")
        lvListItems.SubItems(3) = Search_Recordset.Fields("Telephone")
        lvListItems.SubItems(4) = Search_Recordset.Fields("Address")
        lvListItems.SubItems(5) = Search_Recordset.Fields("City_State")
        lvListItems.SubItems(6) = Search_Recordset.Fields("ZipCode")
        lvListItems.SubItems(7) = Search_Recordset.Fields("EmailAddress")
        lvListItems.SubItems(8) = Search_Recordset.Fields("Relation")
        Search_Recordset.MoveNext
     Loop
     StatusBar1.Panels(1).Text = Str(Search_Recordset.RecordCount) & " record(s) found in the last search"
    'Close the recordset and the database
     Search_Recordset.Close
     Search_Database.Close
    Else
     StatusBar1.Panels(1).Text = "No Match Found"
  End If
End Sub
'**********************************************************************
'**********************************************************************



'**********************************************************************
'**********************************************************************
Private Sub SrchBtn_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  StatusBar1.Panels(1).Text = "Search"
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Private Sub srchClose_Click()
   Unload Me
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Private Sub srchClose_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  StatusBar1.Panels(1).Text = "Close"
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Private Sub srchListView1_ColumnClick(ByVal ColumnHeader As ComctlLib.ColumnHeader)
  With srchListView1
       If .SortKey <> ColumnHeader.Index - 1 Then
          .SortKey = ColumnHeader.Index - 1
          .SortOrder = lvwAscending
         Else
          If .SortOrder = lvwAscending Then
             .SortOrder = lvwDescending
            Else
             .SortOrder = lvwAscending
          End If
       End If
       .Sorted = True
  End With
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Private Sub Load_LV_Header()
  srchListView1.ListItems.Clear
  Set lvHeader = Nothing
  Set lvHeader = srchListView1.ColumnHeaders.Add(, "C1", "First Name", 2500, lvwColumnLeft)
  Set lvHeader = srchListView1.ColumnHeaders.Add(, "C2", "Last Name", 2500, lvwColumnLeft)
  Set lvHeader = srchListView1.ColumnHeaders.Add(, "C3", "Sex", 1000, lvwColumnLeft)
  Set lvHeader = srchListView1.ColumnHeaders.Add(, "C4", "Telephone #", 1300, lvwColumnLeft)
  Set lvHeader = srchListView1.ColumnHeaders.Add(, "C5", "Address", 3000, lvwColumnLeft)
  Set lvHeader = srchListView1.ColumnHeaders.Add(, "C6", "City-State", 3000, lvwColumnLeft)
  Set lvHeader = srchListView1.ColumnHeaders.Add(, "C7", "Zip Code", 1000, lvwColumnLeft)
  Set lvHeader = srchListView1.ColumnHeaders.Add(, "C8", "Email Address", 2000, lvwColumnLeft)
  Set lvHeader = srchListView1.ColumnHeaders.Add(, "C9", "Relationship", 1000, lvwColumnLeft)
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Private Sub srchListView1_ItemClick(ByVal item As ComctlLib.ListItem)
  Dim Select_State As Long
  Select_State = 1
 'set full row select
  Call SendMessage(srchListView1.hwnd, LVM_SETEXTENDEDLISTVIEWSTYLE, LVS_EX_FULLROWSELECT, Select_State)
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Private Sub srchListView1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  Dim t As ListItem
  Dim Select_State As Long
  If Button = 2 Then
     Set t = srchListView1.HitTest(X, Y)
     If t Is Nothing Then
        Exit Sub
       Else
        srchListView1.ListItems(t.Index).Selected = True
        Record_To_Delete = srchListView1.ListItems(t.Index).Key
        Select_State = 1
       'set full row select
        Call SendMessage(srchListView1.hwnd, LVM_SETEXTENDEDLISTVIEWSTYLE, LVS_EX_FULLROWSELECT, Select_State)
        PopupMenu mnuChanges
     End If
  End If
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Private Sub srchListView1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  Dim t As ListItem
  Set t = srchListView1.HitTest(X, Y)
  If t Is Nothing Then
     StatusBar1.Panels(1).Text = ""
     Exit Sub
    Else
     StatusBar1.Panels(1).Text = t.Text
  End If
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Private Sub srchRestore_Click()
  Call SrchTrayArea1_DblClick
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Private Sub SrchTrayArea1_DblClick()
  On Error Resume Next
  If frmEdit_Editting = True Then
     Exit Sub
  End If
  SrchTrayArea1.Visible = False
  frmSearch.WindowState = 0
  frmSearch.Show
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Private Sub SrchTrayArea1_MouseDown(Button As Integer)
  If Button = 2 Then
     PopupMenu m
  End If
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'Print Text in the Center of the page
'**********************************************************************
Public Sub PrintCenter(PrintString$)
  'print the string in the center of the page
   Printer.CurrentX = (Printer.ScaleWidth / 2) - ((Printer.FontSize * _
                      (TextWidth(PrintString$) / 8.28)) / 2)
   'where the 8.28 is the PC
   'default font size   (where the width of the letters comnes from)
    Printer.Print PrintString$
End Sub
'**********************************************************************
'**********************************************************************