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