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

📄 frmmain.frm

📁 这是一个家庭信息管理的小软件!
💻 FRM
📖 第 1 页 / 共 5 页
字号:
'**********************************************************************
Private Sub mnuLink_Click(Index As Integer)
 'Opens the default internet browser
  OpenURL (mnuLink(Index).Caption)
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Private Sub mnuLogout_User_Click()
  On Error GoTo FixErr
  Dim OpenFixDB As Long
  'Open Fam-Fix2.exe
   OpenFixDB = Shell(App.Path & "\Fam-Fix2.exe", vbNormalFocus)
 
FixErr:
  If Err <> 0 Then
    MsgBox "Error " & Err.Description, vbCritical + vbOKOnly
    Err.Clear
  End If
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Private Sub mnuRestore_Click()
  On Error Resume Next
  TrayArea1.Visible = False
  frmMain.WindowState = 0
  frmMain.Show
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Private Sub mnuSearch_Click()
  Call btnSearch_Click
End Sub
'**********************************************************************
'**********************************************************************



'**********************************************************************
'**********************************************************************
Private Sub mnuTray_Click()
  If mnuTray.Checked = True Then
     mnuTray.Checked = False
     Set_Minimize_To_Tray (False)
    Else
     mnuTray.Checked = True
     Set_Minimize_To_Tray (True)
  End If
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Private Sub mnuUpDateLinks_Click()
  Call btnLinks_Click
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Private Sub mnuUserProfile_Click()
  Call btnProfile_Click
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Private Sub MTView_Collapse(ByVal Node As ComctlLib.Node)
  If (Currently_Editting = True) Or (Currently_Adding = True) Then
     Exit Sub
  End If
  
  Select Case Node.Text
   Case "People"
        Call Empty_Main_Fields
        Relation.Text = "Family"
        Last_Parent = "Family"
        Node.Expanded = True
         
    Case "Family", "Spouse", "Friend", "Co-Worker", "Acquaintance"
         Call Empty_Main_Fields
         Relation.Text = Node.Text
         Last_Parent = Node.Text
  End Select
  
End Sub
'**********************************************************************
'**********************************************************************



'**********************************************************************
'**********************************************************************
Private Sub MTView_Expand(ByVal Node As ComctlLib.Node)
  If Currently_Editting = True Then
     Exit Sub
  End If
    
  If Currently_Adding = True Then
     Exit Sub
  End If
  
  Select Case Node.Text
   Case "People"
       Call Empty_Main_Fields
       Relation.Text = "Family"
       Last_Parent = "Family"
         
    Case "Family", "Spouse", "Friend", "Co-Worker", "Acquaintance"
       Call Empty_Main_Fields
       Relation.Text = Node.Text
       Last_Parent = Node.Text
  End Select
End Sub
'**********************************************************************
'**********************************************************************



'**********************************************************************
'**********************************************************************
Private Sub MTView_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
'
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Private Sub MTView_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  Dim t As Node
  Set t = MTView.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 MTView_NodeClick(ByVal Node As ComctlLib.Node)
  Dim Pos1 As Integer
  Dim FN1 As String 'First Name
  Dim LN1 As String 'Last Name
  Dim RL As String 'Relation
  Dim tmpSQL As String
  On Error GoTo NClick_Err
  
  If (Currently_Editting = True) Or (Currently_Adding = True) Then
     Exit Sub
  End If
    
  Select Case Node.Text
    Case "People"
         Call Empty_Main_Fields
         Relation.Text = "Family"
         Last_Parent = "Family"
         
    Case "Family", "Spouse", "Friend", "Co-Worker", "Acquaintance"
         Call Empty_Main_Fields
         Relation.Text = Node.Text
         Last_Parent = Node.Text
    
    Case Else
         Pos1 = InStr(1, Node.Text, "_")
         If Pos1 > 0 Then
            Changable (True)
            FN1 = Apostrophe(Mid$(Node.Text, 1, Pos1 - 1))
            LN1 = Apostrophe(Mid$(Node.Text, Pos1 + 1))
            RL = Node.Parent.Text
            tmpSQL = ""
            tmpSQL = "SELECT * FROM " & Current_LoginName
            tmpSQL = tmpSQL & " WHERE FirstName = '" & FN1 & "'"
            tmpSQL = tmpSQL & " and LastName = '" & LN1 & "'"
            tmpSQL = tmpSQL & " and Relation = '" & RL & "'"
            MainData1.RecordSource = tmpSQL
            MainData1.Refresh
            Call UpdateFileds
            Changable (True)
            Last_Parent = Node.Parent.Text
          End If
  End Select
  Exit Sub
  
NClick_Err:
   If Err.Number <> 0 Then
      MsgBox "Error : " & Str$(Err.Number) & " " & Err.Description
      Err.Clear
   End If
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Public Function Changable(Emode As Boolean)
  btnEdit.Enabled = Emode
  btnDelete.Enabled = Emode
End Function
'**********************************************************************
'**********************************************************************



'**********************************************************************
'**********************************************************************
Public Function Make_Changes(CMODE As Boolean)
  btnSave.Enabled = CMODE
  btnCancel.Enabled = CMODE
  
 If CMODE = True Then
   'UnLock Fields
    Sex.Locked = False
    Relation.Locked = False
    First_Name.Locked = False
    Last_Name.Locked = False
    Telephone.Locked = False
    Address.Locked = False
    City_State.Locked = False
    ZipCode.Locked = False
    Email.Locked = False
     
    btnEdit.Enabled = False
    btnDelete.Enabled = False
    btnAdd.Enabled = False
    btnClose.Enabled = False
  End If
  
  If CMODE = False Then
    'Lock Fields
     Sex.Locked = True
     Relation.Locked = True
     First_Name.Locked = True
     Last_Name.Locked = True
     Telephone.Locked = True
     Address.Locked = True
     City_State.Locked = True
     ZipCode.Locked = True
     Email.Locked = True
          
     btnAdd.Enabled = True
     btnClose.Enabled = True
  End If
End Function
'**********************************************************************
'**********************************************************************



'**********************************************************************
'**********************************************************************
Private Sub Empty_Main_Fields()
  Sex.ListIndex = 0
  Relation.Text = Last_Parent
  First_Name.Text = ""
  Last_Name.Text = ""
  Telephone.Text = ""
  Address.Text = ""
  City_State.Text = ""
  ZipCode.Text = ""
  Email.Text = ""
  Changable (False)
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Private Sub TrayArea1_DblClick()
  Call mnuRestore_Click
End Sub
'**********************************************************************
'**********************************************************************



'**********************************************************************
'**********************************************************************
Private Sub TrayArea1_MouseDown(Button As Integer)
  If Button = 2 Then
     PopupMenu mnuRestorer
  End If
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Public Sub Init_Main()
  btnSave.Enabled = False
  btnCancel.Enabled = False
  On Error GoTo InitError
 
 '========================================
 'Load the Combos
  Sex.Clear
  Sex.AddItem "Male"
  Sex.AddItem "Female"
  Sex.ListIndex = 0
   
  Relation.Clear
  Relation.AddItem "Family"
  Relation.AddItem "Spouse"
  Relation.AddItem "Friend"
  Relation.AddItem "Co-Worker"
  Relation.AddItem "Acquaintance"
  Relation.ListIndex = 0
 '========================================
 'Lock Fields
  First_Name.Locked = True
  Last_Name.Locked = True
  Sex.Locked = True
  Relation.Locked = True
  Telephone.Locked = True
  Address.Locked = True
  City_State.Locked = True
  ZipCode.Locked = True
  Email.Locked = True
 '========================================
  If (Table_Ok(Database_Path & "\" & Database_Name, Current_LoginName) = False) Then
     MsgBox "Error, unable to load " & Current_LoginName & "'s database", vbCritical + vbOKOnly
     Exit Sub
  End If
  
  
  Load_DB_TO_Treeview Current_LoginName, MTView, ImageList1
  Last_Parent = "Family"
  MTView.Nodes("Root").Selected = True
  MTView.Nodes("Root").Expanded = True
 '========================================
  MainData1.Databas

⌨️ 快捷键说明

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