frmpass.frm

Visual basic 数据库编程技术与实例源码 源码

      End
      Begin MSComCtl2.DTPicker DatePick 
         Height          =   315
         Left            =   4140
         TabIndex        =   2
         Top             =   1440
         Width           =   1455
         _ExtentX        =   2566
         _ExtentY        =   556
         _Version        =   393216
         BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         CustomFormat    =   "MM/dd/yyyy"
         Format          =   20054019
         CurrentDate     =   36511
      End
      Begin VB.Label Label 
         Alignment       =   1  'Right Justify
         AutoSize        =   -1  'True
         BackColor       =   &H00808080&
         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
         Index           =   7
         Left            =   3630
         TabIndex        =   36
         Top             =   1080
         Width           =   360
      End
      Begin VB.Label Label 
         Alignment       =   1  'Right Justify
         AutoSize        =   -1  'True
         BackColor       =   &H00808080&
         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
         Index           =   3
         Left            =   3450
         TabIndex        =   35
         Top             =   720
         Width           =   540
      End
      Begin VB.Label Label 
         Alignment       =   1  'Right Justify
         AutoSize        =   -1  'True
         BackColor       =   &H00808080&
         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
         Index           =   8
         Left            =   3630
         TabIndex        =   34
         Top             =   1440
         Width           =   360
      End
      Begin VB.Label Label 
         Alignment       =   1  'Right Justify
         AutoSize        =   -1  'True
         BackColor       =   &H00808080&
         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
         Index           =   2
         Left            =   3630
         TabIndex        =   33
         Top             =   1800
         Width           =   360
      End
   End
   Begin VB.Shape Shape1 
      BorderColor     =   &H00FFFFFF&
      BorderWidth     =   2
      Height          =   6360
      Left            =   15
      Top             =   15
      Width           =   9300
   End
End
Attribute VB_Name = "frmPassword"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False


Dim dummy As adodb.Recordset
Dim datprimary As adodb.Recordset
Dim rec_Isnew As Boolean
Dim p_add, p_edit, p_save, p_undo, p_top, p_prev, p_next, p_last, p_del
Dim p_isadding, p_isediting, p_isnavigate

Private Sub cmdDel_Click()
    On Error Resume Next
    EditMode = True
    Call MessageBox("frmPassword", "Are you sure you want to delete User Name " + datprimary("USER_NAME") + " ?", 1)
    frmMessageBox2.Show
    Call MacButton("  Delete", frmPassword.cmdDel, 0, 0, 73, 50, frmLogin.Source, 0, 0, 1)
End Sub

Private Sub cmdDel_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Call MacButton("  Delete", frmPassword.cmdDel, 0, 0, 73, 50, frmLogin.Source, 74, 0, 1)
End Sub

Private Sub cmdDel_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Call MacButton("  Delete", frmPassword.cmdDel, 0, 0, 73, 50, frmLogin.Source, 0, 0, 1)
End Sub

Private Sub cmdEdit_Click()
'    On Error GoTo ErrorEdit
    EditMode = True
    Press_Buttons ("Edit")
    txtField(1).SetFocus
    txtField(0).TabStop = False
'ErrorEdit:
'    Call MessageBox("frmPassword", Err.Description, 0)
End Sub

Private Sub cmdEdit_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Call MacButton("    Edit", frmPassword.cmdEdit, 0, 0, 73, 50, frmLogin.Source, 74, 0, 1)
End Sub

Private Sub cmdEdit_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Call MacButton("    Edit", frmPassword.cmdEdit, 0, 0, 73, 50, frmLogin.Source, 0, 0, 1)
End Sub

Private Sub cmdExit_Click()
    EditMode = False
    Unload Me
End Sub

Private Sub cmdExit_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Call MacButton("    Exit", frmPassword.cmdExit, 0, 0, 73, 50, frmLogin.Source, 74, 0, 1)
End Sub

Private Sub cmdExit_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Call MacButton("    Exit", frmPassword.cmdExit, 0, 0, 73, 50, frmLogin.Source, 0, 0, 1)
End Sub

Private Sub cmdFind_Click()
    On Error Resume Next
    EditMode = True
    Call FindBox(" Find by User Name ", _
                    "USER_PASSWORD", "USER_NAME", 0, 1, "frmLogin")
    Call MacButton("   Find", frmPassword.cmdFind, 0, 0, 73, 50, frmLogin.Source, 0, 0, 1)
End Sub

Public Sub FindUserName()
    On Error Resume Next
    strs = "select * from USER_PASSWORD where USER_NAME = '" & frmFind.txtWord & "'"
    Set dummy = New adodb.Recordset
    dummy.Open strs, myDB, 1, 3
    
    'Set dummy = frmLogin.db.OpenRecordset(strs)
    If Not dummy.BOF Then
        datprimary.MoveFirst
        Do While Not datprimary.EOF
            If datprimary("USER_NAME") = frmFind.txtWord Then
                Exit Do
            End If
                datprimary.MoveNext
        Loop
            Display_Fields
            Enable_Buttons
    Else
        Call MessageBox("frmPassword", "User Name not found", 0)
    End If
End Sub

Private Sub cmdFind_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Call MacButton("   Find", frmPassword.cmdFind, 0, 0, 73, 50, frmLogin.Source, 74, 0, 1)
End Sub

Private Sub cmdFind_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Call MacButton("   Find", frmPassword.cmdFind, 0, 0, 73, 50, frmLogin.Source, 0, 0, 1)
End Sub

Private Sub cmdLast_Click()
    Press_Buttons ("Last")
End Sub

Private Sub cmdLast_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Call MacButton("q", frmPassword.cmdLast, 0, 0, 100, 50, frmLogin.Source, 112, 39, 3)
End Sub

Private Sub cmdLast_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Call MacButton("q", frmPassword.cmdLast, 0, 0, 100, 50, frmLogin.Source, 138, 39, 3)
End Sub

Private Sub cmdNew_Click()
    On Error Resume Next
    EditMode = False
    If datprimary.RecordCount = 0 Then
        txtField(0).Text = "1"
    Else
        datprimary.MoveLast
        txtField(0).Text = Val(datprimary("USER_NAME")) + 1
    End If
    Press_Buttons ("New")
    DatePick.Value = Get_Last_Date("USER_BIRTHDATE", "USER_PASSWORD")
    txtField(0).SetFocus
End Sub

Private Sub cmdNew_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Call MacButton("   New", frmPassword.cmdNew, 0, 0, 73, 50, frmLogin.Source, 74, 0, 1)
End Sub

Private Sub cmdNew_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Call MacButton("   New", frmPassword.cmdNew, 0, 0, 73, 50, frmLogin.Source, 0, 0, 1)
End Sub

Private Sub cmdNext_Click()
    Press_Buttons ("Next")
End Sub

Private Sub cmdNext_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Call MacButton("u", frmPassword.cmdNext, 0, 0, 100, 49, frmLogin.Source, 112, 39, 3)
End Sub

Private Sub cmdNext_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Call MacButton("u", frmPassword.cmdNext, 0, 0, 100, 49, frmLogin.Source, 138, 39, 3)
End Sub

Private Sub cmdOk_Click()
    BoxContainer2.Visible = False
End Sub


Private Sub cmdPrev_Click()
    Press_Buttons ("Prev")
End Sub

Private Sub cmdPrev_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Call MacButton("t", frmPassword.cmdPrev, 0, 0, 100, 50, frmLogin.Source, 112, 39, 3)
End Sub

Private Sub cmdPrev_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Call MacButton("t", frmPassword.cmdPrev, 0, 0, 100, 50, frmLogin.Source, 138, 39, 3)
End Sub

Private Sub cmdSave_Click()
    On Error Resume Next
    If EditMode = True Then
        Call MacButton("    Edit", frmPassword.cmdEdit, 0, 0, 73, 50, frmLogin.Source, 0, 0, 1)
        Press_Buttons ("Save")
    Else
        Call MacButton("   New", frmPassword.cmdNew, 0, 0, 73, 50, frmLogin.Source, 0, 0, 1)
        If Get_User_Name Then
            Call MessageBox("frmPassword", "User Name already exists.", 0)
            frmMessageBox.SetFocus
            txtField(0) = ""
            Press_Buttons ("Undo")
        ElseIf txtField(0) = "" Then
            Call MessageBox("frmPassword", "User Name cannot be null", 0)
            frmMessageBox.SetFocus
            txtField(0) = ""
            Press_Buttons ("Undo")
        'ENABLE ONLY FOR SPECIFIC LENGTH OF 10 CHARACTERS NUMBERING
        'ElseIf Len(txtField(1)) > 1 And Len(txtField(1)) < 20 Then
        '    Call MessageBox("frmPassword", "User Name must be 20 in length", 0)
        '    frmMessageBox.SetFocus
        '    txtField(0) = ""
        '    Press_Buttons ("Undo")
        Else
            Press_Buttons ("Save")
        End If
    End If
    Call MacButton("   Save", frmPassword.cmdSave, 0, 0, 73, 50, frmLogin.Source, 0, 0, 1)
End Sub

Private Sub cmdSave_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Call MacButton("   Save", frmPassword.cmdSave, 0, 0, 73, 50, frmLogin.Source, 74, 0, 1)
End Sub

Private Sub cmdSave_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Call MacButton("   Save", frmPassword.cmdSave, 0, 0, 73, 50, frmLogin.Source, 0, 0, 1)
End Sub

Private Sub cmdTop_Click()
    Press_Buttons ("Top")
End Sub

Private Sub cmdTop_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Call MacButton("p", frmPassword.cmdTop, 0, 0, 100, 50, frmLogin.Source, 112, 39, 3)