📄 frmmain.frm
字号:
'**********************************************************************
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 + -