frmnewpersonal.frm

很好的个人数字助理软件代码

   Begin VB.Label Label7 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "公司:"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   9
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   225
      Left            =   840
      TabIndex        =   13
      Top             =   2520
      Width           =   405
   End
   Begin VB.Label Label6 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "E-Mail:"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   9
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   225
      Left            =   720
      TabIndex        =   11
      Top             =   2160
      Width           =   555
   End
   Begin VB.Label Label5 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "地址(H):"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   9
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   225
      Left            =   600
      TabIndex        =   9
      Top             =   1800
      Width           =   660
   End
   Begin VB.Label Label4 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "手机:"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   9
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   225
      Left            =   840
      TabIndex        =   7
      Top             =   1440
      Width           =   405
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "传真 (H):"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   9
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   225
      Left            =   555
      TabIndex        =   5
      Top             =   1080
      Width           =   705
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "电话(H):"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   9
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   225
      Left            =   600
      TabIndex        =   3
      Top             =   720
      Width           =   660
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "姓名:"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   9
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   225
      Left            =   840
      TabIndex        =   1
      Top             =   360
      Width           =   405
   End
   Begin VB.Line Line1 
      BorderWidth     =   2
      X1              =   15
      X2              =   0
      Y1              =   240
      Y2              =   5280
   End
   Begin VB.Label lblCaption 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "Hirdhav Digital Diary  -  New Contacts"
      Height          =   225
      Left            =   195
      TabIndex        =   0
      Top             =   15
      Width           =   3120
   End
   Begin VB.Shape shapeCaption 
      BackStyle       =   1  'Opaque
      BorderWidth     =   2
      Height          =   255
      Left            =   0
      Top             =   0
      Width           =   4575
   End
End
Attribute VB_Name = "frmNewPersonal"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Form_Load()
Me.BackColor = RGB(145, 155, 100)
lblCaption.ForeColor = RGB(145, 155, 100)
shapeCaption.BackColor = vbBlack
txtName.BackColor = RGB(145, 155, 100)
txtPhoneH.BackColor = RGB(145, 155, 100)
txtFaxH.BackColor = RGB(145, 155, 100)
txtAddressH.BackColor = RGB(145, 155, 100)
txtMobile.BackColor = RGB(145, 155, 100)
txtEMail.BackColor = RGB(145, 155, 100)
txtCompany.BackColor = RGB(145, 155, 100)
txtWebSite.BackColor = RGB(145, 155, 100)
txtNote.BackColor = RGB(145, 155, 100)
txtPhoneB.BackColor = RGB(145, 155, 100)
txtFaxB.BackColor = RGB(145, 155, 100)
txtAddressB.BackColor = RGB(145, 155, 100)
shapeAdd.BackColor = RGB(145, 155, 100)
shapeCancel.BackColor = RGB(145, 155, 100)
End Sub

Private Sub lblAddSupport_Click()
Dim conType As String
conType = frmContacts.lstNew.Text
If txtName.Text = "" Then
    HDDMsgBox "Please enter Name."
    Exit Sub
End If
If txtName.Text = " " Then
    HDDMsgBox "Please enter Name."
    Exit Sub
End If
Dim strUsername As String
strUsername = frmMain.lblUsername.Caption
Me.Controls.Add "VB.textBox", "txtN"
With Me!txtN
    .Visible = False
    .MaxLength = 1
    .Text = txtName.Text
End With

Dim db As Database
Dim ReS As Recordset

On Error GoTo ErrHan:
Set db = OpenDatabase(App.Path + "\Data\" + strUsername + "\Personal.dat")
Set ReS = db.OpenRecordset(Me!txtN.Text)

ReS.AddNew
ReS("Name") = txtName.Text
ReS("Phone(H)") = txtPhoneH.Text
ReS("Fax(H)") = txtFaxH.Text
ReS("Mobile") = txtMobile.Text
ReS("Address(H)") = txtAddressH.Text
ReS("EMail") = txtEMail.Text
ReS("Company") = txtCompany.Text
ReS("Phone(B)") = txtPhoneB.Text
ReS("Fax(B)") = txtFaxB.Text
ReS("Address(B)") = txtAddressB.Text
ReS("Note") = txtNote.Text
ReS("WebSite") = txtWebSite.Text
ReS.Update
HDDMsgBox "Record inserted successfully."
ReS.Close
db.Close
Set db = Nothing
Set ReS = Nothing
Unload frmContacts
frmContacts.Show
Unload Me
Exit Sub

ErrHan:
    
    If Err.Number = 3078 Then
        Me!txtN.Text = "*"
        'Dim db As Database
        'Dim ReS As Recordset

        Set db = OpenDatabase(App.Path + "\Data\" + strUsername + "\Personal.dat")
        Set ReS = db.OpenRecordset(Me!txtN.Text)

        ReS.AddNew
        ReS("Name") = txtName.Text
        ReS("Phone(H)") = txtPhoneH.Text
        ReS("Fax(H)") = txtFaxH.Text
        ReS("Mobile") = txtMobile.Text
        ReS("Address(H)") = txtAddressH.Text
        ReS("EMail") = txtEMail.Text
        ReS("Company") = txtCompany.Text
        ReS("Phone(B)") = txtPhoneB.Text
        ReS("Fax(B)") = txtFaxB.Text
        ReS("Address(B)") = txtAddressB.Text
        ReS("Note") = txtNote.Text
        ReS("WebSite") = txtWebSite.Text
        ReS.Update
        HDDMsgBox "Record inserted successfully."
        ReS.Close
        db.Close
        Set db = Nothing
        Set ReS = Nothing
        Unload frmContacts
        frmContacts.Show
        Unload Me
        Exit Sub
    End If
End Sub

Private Sub lblAddSupport_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
lblAdd.ForeColor = RGB(145, 155, 100)
shapeAdd.BackColor = vbBlack
End Sub

Private Sub lblAddSupport_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
lblAdd.ForeColor = vbBlack
shapeAdd.BackColor = RGB(145, 155, 100)
End Sub

Private Sub lblCancelSupport_Click()
frmContacts.Show
Unload Me
End Sub

Private Sub lblCancelSupport_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
lblCancel.ForeColor = RGB(145, 155, 100)
shapeCancel.BackColor = vbBlack
End Sub

Private Sub lblCancelSupport_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
lblCancel.ForeColor = vbBlack
shapeCancel.BackColor = RGB(145, 155, 100)
End Sub

Private Sub lblCaptionSupport_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
DragForm Me
End Sub

Private Sub txtWebSite_GotFocus()
SendKeys "{END}"
End Sub