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

📄 addnew.frm

📁 Address Book implemented in VB 6,can be use for storing person information
💻 FRM
📖 第 1 页 / 共 5 页
字号:
   Begin Project1.lvButtons_H lvbutton2Cancel 
      Height          =   975
      Left            =   1200
      TabIndex        =   40
      Top             =   5280
      Width           =   975
      _ExtentX        =   1720
      _ExtentY        =   1720
      Caption         =   "Canc&el"
      CapAlign        =   2
      BackStyle       =   7
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "Arial"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      cFore           =   65280
      cFHover         =   65535
      cBhover         =   255
      LockHover       =   3
      cGradient       =   0
      Gradient        =   3
      Mode            =   0
      Value           =   0   'False
      ImgAlign        =   4
      Image           =   "AddNew.frx":3556
      ImgSize         =   32
      cBack           =   16711680
   End
   Begin Project1.lvButtons_H lvbutton1New 
      Height          =   975
      Left            =   120
      TabIndex        =   41
      Top             =   5280
      Width           =   975
      _ExtentX        =   1720
      _ExtentY        =   1720
      Caption         =   "&New"
      CapAlign        =   2
      BackStyle       =   7
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "Arial"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      cFore           =   65280
      cFHover         =   65535
      cBhover         =   255
      LockHover       =   3
      cGradient       =   0
      Gradient        =   3
      Mode            =   0
      Value           =   0   'False
      ImgAlign        =   4
      Image           =   "AddNew.frx":3E30
      ImgSize         =   32
      cBack           =   16711680
   End
   Begin VB.CommandButton Command3 
      BackColor       =   &H00808080&
      Enabled         =   0   'False
      Height          =   1215
      Left            =   0
      Style           =   1  'Graphical
      TabIndex        =   37
      Top             =   5160
      Width           =   8895
   End
   Begin VB.Label Label26 
      Alignment       =   2  'Center
      BackStyle       =   0  'Transparent
      Caption         =   "Copyright April 2005 Jessie Panerio Philippines"
      BeginProperty Font 
         Name            =   "La Bamba LET"
         Size            =   12
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00C00000&
      Height          =   975
      Left            =   3240
      TabIndex        =   75
      Top             =   2280
      Width           =   2415
   End
End
Attribute VB_Name = "frmAddNew"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub Form_Load()
     
     infomode = True
     findmode = False
     
End Sub

Private Sub txtNickName_KeyPress(KeyAscii As Integer)
   
     KeyAscii = Asc(UCase(Chr(KeyAscii)))
     If Not ((KeyAscii >= 65 And KeyAscii <= 90) Or KeyAscii = 8) Then KeyAscii = 0
   
End Sub

Private Sub txtLastName_KeyPress(KeyAscii As Integer)
  
     KeyAscii = Asc(UCase(Chr(KeyAscii)))
     If Not ((KeyAscii >= 65 And KeyAscii <= 90) Or KeyAscii = 8) Then KeyAscii = 0
       
End Sub

Private Sub txtFirstName_KeyPress(KeyAscii As Integer)
   
     KeyAscii = Asc(UCase(Chr(KeyAscii)))
     If Not ((KeyAscii >= 65 And KeyAscii <= 90) Or KeyAscii = 8) Then KeyAscii = 0
   
End Sub

Private Sub txtMiddleName_KeyPress(KeyAscii As Integer)
   
     KeyAscii = Asc(UCase(Chr(KeyAscii)))
     If Not ((KeyAscii >= 65 And KeyAscii <= 90) Or KeyAscii = 8) Then KeyAscii = 0
   
End Sub

Private Sub MaskEdBoxBirthDay_GotFocus()
   
     If lvButtons_H1Cover.Visible = True Then
        MaskEdBoxBirthDay.Mask = "##/##/####"
     End If

End Sub

Private Sub MaskEdBoxBirthDay_KeyPress(KeyAscii As Integer)
   
     Dim strvalid
     strvalid = "0123456789"
     If KeyAscii > 26 Then
       If InStr(strvalid, Chr(KeyAscii)) = 0 Then
          KeyAscii = 0
       End If
     End If

End Sub

Private Sub cmbGender_KeyPress(KeyAscii As Integer)
   
     Dim strvalid
     strvalid = ""
     If KeyAscii > 26 Then
        If InStr(strvalid, Chr(KeyAscii)) = 0 Then
           KeyAscii = 0
        End If
     End If

End Sub

Private Sub txtReligion_KeyPress(KeyAscii As Integer)
   
     KeyAscii = Asc(UCase(Chr(KeyAscii)))
     If Not ((KeyAscii >= 65 And KeyAscii <= 90) Or KeyAscii = 8) Then KeyAscii = 0

End Sub

Private Sub txtCitizenship_KeyPress(KeyAscii As Integer)
   
     KeyAscii = Asc(UCase(Chr(KeyAscii)))
     If Not ((KeyAscii >= 65 And KeyAscii <= 90) Or KeyAscii = 8) Then KeyAscii = 0
   
End Sub

Private Sub txtCivilStatus_KeyPress(KeyAscii As Integer)
   
     KeyAscii = Asc(UCase(Chr(KeyAscii)))
     If Not ((KeyAscii >= 65 And KeyAscii <= 90) Or KeyAscii = 8) Then KeyAscii = 0
   
End Sub

Private Sub txtContactLandLine_KeyPress(KeyAscii As Integer)

     Dim strvalid
     strvalid = "0123456789-+()"
     If KeyAscii > 26 Then
       If InStr(strvalid, Chr(KeyAscii)) = 0 Then
          KeyAscii = 0
       End If
     End If

End Sub

Private Sub txtContactMobile_KeyPress(KeyAscii As Integer)
  
     Dim strvalid
     strvalid = "0123456789-+()"
     If KeyAscii > 26 Then
       If InStr(strvalid, Chr(KeyAscii)) = 0 Then
          KeyAscii = 0
       End If
     End If
     
End Sub

Private Sub txtOfficePhone_KeyPress(KeyAscii As Integer)
  
     Dim strvalid
     strvalid = "0123456789-+()"
     If KeyAscii > 26 Then
        If InStr(strvalid, Chr(KeyAscii)) = 0 Then
           KeyAscii = 0
        End If
     End If

End Sub

Private Sub cmdAddPicture_Click()
    
     With jjessiepanerio
       .InitDir = "C:\My Documents"
       .Filter = "JPEG image|*.jpg|GIF image|*.gif|BITMAP image|*.bmp|Icon image|*.ico|Cursor image|*.cur|Panerio image|*.pan"
       .ShowOpen
          If .FileName <> "" Then
             strImgN = .FileName
             txtPictureName.Text = .FileTitle
             imgpic.Picture = LoadPicture(.FileName)
          End If
     End With
    
End Sub

Private Sub cmdChangePicture_Click()
    
     cmdAddPicture_Click

End Sub

Private Sub lvbutton1New_Click()
        
     MsgBox "Note! Duplication of entries is not allowed in this application." & vbCrLf & vbCrLf & "Make sure that Nickname field is unique and does not exist in database", vbInformation, "Information"
     adoview.AddNew
     Call LoadDataInControls
     Call cmdCover(True, False, False, True, True)
     Call lockcontrols(False)
     txtNickName.SetFocus
     
End Sub

Private Sub lvbutton2Cancel_Click()
 
     adoview.CancelUpdate
     Call clearcontrols
     Call cmdCover(False, True, True, False, False)
     Call lockcontrols(True)
          
End Sub

Private Sub lvbutton3Save_Click()
     On Error GoTo err:
     Dim res As VbMsgBoxResult
     If frmAddNew.txtNickName.Text = "" Or frmAddNew.txtLastName.Text = "" Then
        MsgBox "Either Nickname or Lastname field is empty." & vbCrLf & "Please enter a value for the said fields.", vbInformation, "Information"
        Exit Sub
     Else
        res = MsgBox("Save this to Database?", vbYesNo, "Confirmation")
           If res = vbYes Then
              WriteDataFromControls
              adoview.Update
              Call clearcontrols
              Call cmdCover(False, True, True, False, False)
              Call lockcontrols(True)
              Call loaddataforviewing
              Load frmPersonalInfo
              frmPersonalInfo.Show
              Unload Me
            
           Else
              Exit Sub
           End If
     End If
     Exit Sub

err:
MsgBox "Warning! Duplication of entries is not allowed in this application." & vbCrLf & vbCrLf & "Nickname: '" & txtNickName.Text & "' already exist.", vbExclamation, "Address Book"
adoview.CancelBatch adAffectCurrent
lvbutton1New_Click

End Sub

Private Sub lvbutton4Close_Click()
 
     Unload Me
     Load frmPersonalInfo
     frmPersonalInfo.Show
         
End Sub

Private Sub lvbuttonsEditCancel_Click()
   
     Call loaddatatoedit
   
End Sub

Private Sub lvbuttonsEditSave_Click()
   
     Dim res As VbMsgBoxResult
     res = MsgBox("Save this to Database?", vbYesNo, "Confirmation")
        If res = vbYes Then
           WriteDataFromControlsEdit
           adoview.Update
           Load frmPersonalInfo
           frmPersonalInfo.Show
           Unload Me
        Else
           Exit Sub
        End If
     
End Sub

Private Sub lvbuttonsEditClose_Click()
   
     Call LoadImage
     frmPersonalInfo.imgpic.Picture = frmAddNew.imgpic.Picture
     Load frmPersonalInfo
     frmPersonalInfo.Show
     Unload Me
 
End Sub

⌨️ 快捷键说明

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