⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frmmain.frm

📁 这是一个家庭信息管理的小软件!
💻 FRM
📖 第 1 页 / 共 5 页
字号:
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Private Sub btnCancel_Click()
  On Error GoTo CancelErr
 'Cancel Changes
  MainData1.Recordset.CancelUpdate
 'Refresh
  MainData1.Recordset.Fields.Refresh
  Make_Changes (False)
  Currently_Editting = False
  Currently_Adding = False
  Empty_Main_Fields
 'Used to select and expand the last Parent Node Used
  MTView.Nodes(Last_Parent).Selected = True
  MTView.Nodes(Last_Parent).Expanded = True
  Exit Sub
CancelErr:
  If Err.Number <> 0 Then
     MsgBox "Error Add " & Str(Err.Number) & " " & Err.Description, vbCritical + vbOKOnly
     Make_Changes (False)
     Empty_Main_Fields
     Err.Clear
  End If
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Private Sub btnCancel_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  StatusBar1.Panels(1).Text = "Cancel Changes Made"
End Sub
'**********************************************************************
'**********************************************************************


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


'**********************************************************************
'**********************************************************************
Private Sub btnDelete_Click()
  Dim DelYN As VbMsgBoxResult
  On Error GoTo DelErr
  
  DelYN = MsgBox("Do you want to delete this record ?", vbQuestion + vbYesNo, "Delete current record")
  If DelYN = vbYes Then
     MainData1.Recordset.Delete
     MainData1.Recordset.Fields.Refresh
     
     Load_DB_TO_Treeview Current_LoginName, MTView, ImageList1
     
    'Used to select and expand the last Parent Node Used
     MTView.Nodes(Last_Parent).Selected = True
     MTView.Nodes(Last_Parent).Expanded = True
     
     Make_Changes (False)
     Empty_Main_Fields
  End If
  Exit Sub
  
DelErr:
  If Err.Number <> 0 Then
     MsgBox "An error has been encountered while trying to delete a record. Error:" & Str(Err.Number) & " " & Err.Description, vbCritical + vbOKOnly
     Make_Changes (False)
     Empty_Main_Fields
     Err.Clear
  End If
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Private Sub btnDelete_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  StatusBar1.Panels(1).Text = "Delete The Current Record"
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Private Sub btnEdit_Click()
  On Error GoTo EditErr
  TmpRelation = Relation.Text
  Currently_Editting = True
  Call Make_Changes(True)
  First_Name.SetFocus
  MainData1.Recordset.Edit
  Exit Sub
EditErr:
  If Err.Number <> 0 Then
     MsgBox "An error has been encountered while trying to edita record  Error:" & Str(Err.Number) & " " & Err.Description, vbCritical + vbOKOnly
     Currently_Editting = False
     Call Make_Changes(False)
     Err.Clear
  End If
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Private Sub btnEdit_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  StatusBar1.Panels(1).Text = "Edit The Current Record"
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Private Sub btnLinks_Click()
  If (Currently_Editting = True) Or (Currently_Adding = True) Then
     MsgBox Current_LoginName & ", please Save or Cancel the changes that you have made.", vbInformation + vbOKOnly
     Exit Sub
  End If

  TrayArea1.Visible = False
  MainData1.Recordset.Close
  MainData1.Database.Close
  Load frmLinks
  frmLinks.Show
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Private Sub btnLinks_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  If Button = vbRightButton Then
     PopupMenu mnuLinks
  End If
End Sub
'**********************************************************************
'**********************************************************************


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


'**********************************************************************
'**********************************************************************
Private Sub btnProfile_Click()
  If (Currently_Editting = True) Or (Currently_Adding = True) Then
     MsgBox Current_LoginName & ", please Save or Cancel the changes that you have made.", vbInformation + vbOKOnly
     Exit Sub
  End If
  
  TrayArea1.Visible = False
  MainData1.Recordset.Close
  MainData1.Database.Close
  Load frmProfile
  frmProfile.Show
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Private Sub btnProfile_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  StatusBar1.Panels(1).Text = "User Profile(s)"
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Private Sub btnSave_Click()
  Dim MsgRes(1 To 2) As VbMsgBoxResult
  On Error GoTo SaveErr
  
 'Check For Invalid Characters ( ' _ " )
  If InStr(First_Name.Text, "'") > 0 Then
     MsgBox " Please Remove the Apostrophe(/s) [ ' ] from the First Name field", vbInformation + vbOKOnly
     Exit Sub
    Else
     If InStr(First_Name.Text, "_") > 0 Then
        MsgBox " Please Remove the Underscore(/s) [ _ ] from the First Name field", vbInformation + vbOKOnly
        Exit Sub
     End If
  End If
   
  If InStr(Last_Name.Text, "'") > 0 Then
     MsgBox " Please Remove the Apostrophe(/s) [ ' ] from the Last Name field", vbInformation + vbOKOnly
     Exit Sub
    Else
     If InStr(Last_Name.Text, "_") > 0 Then
        MsgBox " Please Remove the Underscore(/s) [ _ ] from the Last Name field", vbInformation + vbOKOnly
        Exit Sub
     End If
  End If
   
  If InStr(First_Name.Text, Chr$(34)) > 0 Then
     MsgBox " Please Remove the Quotes(/s) [ " & Chr$(34) & " ] from the First Name field", vbInformation + vbOKOnly
     Exit Sub
  End If
  If InStr(Last_Name.Text, Chr$(34)) > 0 Then
     MsgBox " Please Remove the Quotes(/s) [ " & Chr$(34) & " ] from the Last Name field", vbInformation + vbOKOnly
     Exit Sub
  End If
    
  If Len(Trim(Last_Name.Text)) < 1 Then
     Last_Name.Text = "Unknown"
  End If
 
  MsgRes(1) = MsgBox("Do you want to save the changes made", vbQuestion + vbYesNo)
    
  If MsgRes(1) = vbYes Then
     If (Len(Trim(First_Name.Text)) < 3) Then
         MsgBox "Note: The First Name Field should contain at least 3 characters", vbInformation + vbOKOnly
         Exit Sub
     End If
     
     If Currently_Editting = True Then
        Last_Parent = Relation.Text
        If (TmpRelation <> Relation.Text) Then
           If ChildExist(MTView, Relation.Text, First_Name.Text & "_" & Last_Name.Text) = True Then
              MsgBox First_Name.Text & "_" & Last_Name.Text & " already exists in " & Relation.Text, vbInformation + vbOKOnly
              Exit Sub
             Else
              GoTo Label1
           End If
          Else 'tmpRelation = Relation.Text
           GoTo Label1
        End If
     End If
     
     If Currently_Adding = True Then
        Last_Parent = Relation.Text
       'Search if record already exist
        If ChildExist(MTView, Relation.Text, First_Name.Text & "_" & Last_Name.Text) = True Then
           MsgBox First_Name.Text & "_" & Last_Name.Text & " already exist in " & Relation.Text, vbInformation + vbOKOnly
           Exit Sub
          Else
           Currently_Adding = False
           GoTo Label1
        End If
     End If
          
Label1:
     MainData1.Recordset.Fields("FirstName") = ProperString(Trim(First_Name.Text))
     MainData1.Recordset.Fields("LastName") = ProperString(Trim(Last_Name.Text))
     MainData1.Recordset.Fields("Sex") = Sex.Text
     MainData1.Recordset.Fields("Telephone") = Telephone.Text
     MainData1.Recordset.Fields("Address") = Address.Text
     MainData1.Recordset.Fields("City_State") = City_State.Text
     MainData1.Recordset.Fields("ZipCode") = ZipCode.Text
     MainData1.Recordset.Fields("EmailAddress") = Email.Text
     MainData1.Recordset.Fields("Relation") = Relation.Text
     MainData1.Recordset.Update
     MainData1.Recordset.Fields.Refresh
    
     Make_Changes (False)
     Load_DB_TO_Treeview Current_LoginName, MTView, ImageList1
     Call Empty_Main_Fields
     Currently_Editting = False
          
    'Used to select and expand the last Parent Node Used
     MTView.Nodes(Last_Parent).Selected = True
     MTView.Nodes(Last_Parent).Expanded = True
  End If
  Exit Sub
  
SaveErr:
  If Err.Number <> 0 Then
     MsgBox "An error has been encountered whilet trying to save a record. Error:" & Str(Err.Number) & " " & Err.Description, vbCritical + vbOKOnly
     Make_Changes (False)
     Call Empty_Main_Fields
     Err.Clear
  End If
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Private Sub btnSave_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  StatusBar1.Panels(1).Text = "Save Changes Made"
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Private Sub btnSearch_Click()
  If (Currently_Editting = True) Or (Currently_Adding = True) Then
     MsgBox Current_LoginName & ", please Save or Cancel the changes that you have made.", vbInformation + vbOKOnly
     Exit Sub
  End If

  TrayArea1.Visible = False
  MainData1.Recordset.Close
  MainData1.Database.Close
  Load frmSearch
  frmSearch.Show
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Private Sub btnSearch_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  StatusBar1.Panels(1).Text = "Print / Search or Delete Record(s)..."
End Sub
'**********************************************************************
'**********************************************************************


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


'**********************************************************************
'**********************************************************************
Private Sub Email_DblClick()
  If (Auto_Send_Email = On_) And Valid_Email_Address(Email.Text) Then
      Send_Email_To (Email.Text)
  End If
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Private Sub Email_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  If Button = vbRightButton Then
     Email.Enabled = False
     PopupMenu mnuEnable

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -