frmuser.frm

mnnnml , ,l, ,mk mmkkmlklmkkkkkkkkkkkkkm,mkl

   End
   Begin VB.Image imgWindowLeft 
      Height          =   450
      Left            =   720
      Picture         =   "frmuser.frx":81AA
      Stretch         =   -1  'True
      Top             =   480
      Width           =   285
   End
   Begin VB.Image imgWindowBottom 
      Height          =   450
      Left            =   360
      Picture         =   "frmuser.frx":88F4
      Stretch         =   -1  'True
      Top             =   480
      Width           =   285
   End
   Begin VB.Image imgTitleRight 
      Height          =   450
      Left            =   360
      Picture         =   "frmuser.frx":903E
      Top             =   0
      Width           =   285
   End
   Begin VB.Image imgTitleLeft 
      Height          =   450
      Left            =   0
      Picture         =   "frmuser.frx":9788
      Top             =   0
      Width           =   285
   End
End
Attribute VB_Name = "frmuser"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim WithEvents adoPrimaryRS As Recordset
Attribute adoPrimaryRS.VB_VarHelpID = -1
Dim mbChangedByCode As Boolean
Dim mvBookMark As Variant
Dim mbEditFlag As Boolean
Dim mbAddNewFlag As Boolean
Dim mbDataChanged As Boolean
Dim k As Long
Private Sub Form_Load()
On Error GoTo err_1
    MakeWindow Me
    
    Dim db1 As Connection
    Set db1 = New Connection
    db1.CursorLocation = adUseClient
    pt = fullpath("user.lbl")
    mysql = "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" & pt
    db1.Open mysql
    Set adoPrimaryRS = New Recordset
    adoPrimaryRS.Open "select user_id,user_ps from user1", db1, adOpenStatic, adLockOptimistic
    
    Dim oText As TextBox
    For Each oText In Me.txtFields
        Set oText.DataSource = adoPrimaryRS
    Next
    
    SetButtons True
    mbDataChanged = False
Exit Sub
err_1:
    MsgBox Err.Description, vbCritical
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
   If mbEditFlag Or mbAddNewFlag Then Exit Sub
   Select Case KeyCode
   Case vbKeyEscape
      cmdClose_Click
   Case vbKeyEnd
      cmdLast_Click
   Case vbKeyHome
      cmdFirst_Click
   Case vbKeyUp, vbKeyPageUp
      If Shift = vbCtrlMask Then
          cmdFirst_Click
      Else
          cmdPrevious_Click
      End If
   Case vbKeyDown, vbKeyPageDown
      If Shift = vbCtrlMask Then
          cmdLast_Click
      Else
          cmdNext_Click
      End If
  End Select
End Sub
Private Sub adoPrimaryRS_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
On Error GoTo err2:
    lblStatus.Caption = "用户: " & CStr(adoPrimaryRS.AbsolutePosition) & "      共" & CStr(adoPrimaryRS.RecordCount) & "个用户"
Exit Sub
err2:
    MsgBox Err.Description, vbExclamation
End Sub
Private Sub cmdAdd_Click()
On Error GoTo AddErr
    With adoPrimaryRS
        If Not (.BOF And .EOF) Then
            mvBookMark = .Bookmark
        End If
        .AddNew
        lblStatus.Caption = "添加记录"
        mbAddNewFlag = True
        SetButtons False
    End With
Exit Sub
AddErr:
  MsgBox Err.Description, vbExclamation
End Sub
Private Sub cmdDelete_Click()
On Error GoTo DeleteErr
   If adoPrimaryRS.RecordCount = 1 Then
       MsgBox "最后一个用户不能删除！", vbExclamation
       Exit Sub
   End If
   Y = MsgBox("你确认要删除吗", vbQuestion + vbYesNo)
   If Y = 6 Then
       With adoPrimaryRS
       .Delete
       .MoveNext
       If .EOF Then .MoveLast
       End With
   End If
Exit Sub
DeleteErr:
    MsgBox Err.Description, vbExclamation
End Sub
Private Sub cmdRefresh_Click()
   On Error GoTo RefreshErr
   adoPrimaryRS.Requery
   Exit Sub
RefreshErr:
   MsgBox Err.Description, vbExclamation
End Sub
Private Sub cmdEdit_Click()
On Error GoTo EditErr
  k = adoPrimaryRS.AbsolutePosition
  lblStatus.Caption = "编辑记录"
  mbEditFlag = True
  SetButtons False
Exit Sub
EditErr:
  MsgBox Err.Description, vbExclamation
End Sub
Private Sub cmdCancel_Click()
On Error Resume Next
  Y = MsgBox("你要放弃修改吗?", vbQuestion + vbYesNo)
  If Y = 6 Then
      SetButtons True
      mbEditFlag = False
      mbAddNewFlag = False
      adoPrimaryRS.CancelUpdate
      If mvBookMark > 0 Then
          adoPrimaryRS.Bookmark = mvBookMark
      Else
          adoPrimaryRS.MoveFirst
      End If
      mbDataChanged = False
  End If
End Sub
Private Sub cmdUpdate_Click()
On Error GoTo UpdateErr
  adoPrimaryRS.UpdateBatch
  If mbAddNewFlag Then
     adoPrimaryRS.MoveLast              '移到新记录
  Else
     adoPrimaryRS.MoveFirst
     adoPrimaryRS.AbsolutePosition = k
  End If
  mbEditFlag = False
  mbAddNewFlag = False
  SetButtons True
  mbDataChanged = False
Exit Sub
UpdateErr:
    MsgBox Err.Description, vbExclamation
End Sub

Private Sub cmdClose_Click()
    Unload Me
End Sub
Private Sub cmdFirst_Click()
On Error GoTo GoFirstError
    adoPrimaryRS.MoveFirst
    mbDataChanged = False
Exit Sub
GoFirstError:
    MsgBox Err.Description, vbExclamation
End Sub
Private Sub cmdLast_Click()
On Error GoTo GoLastError
    adoPrimaryRS.MoveLast
    mbDataChanged = False
Exit Sub
GoLastError:
    MsgBox Err.Description, vbExclamation
End Sub
Private Sub cmdNext_Click()
On Error GoTo GoNextError
  If Not adoPrimaryRS.EOF Then adoPrimaryRS.MoveNext
  If adoPrimaryRS.EOF And adoPrimaryRS.RecordCount > 0 Then
    Beep
     '已到最后返回
    adoPrimaryRS.MoveLast
  End If
  '显示当前记录
  mbDataChanged = False
  Exit Sub
GoNextError:
  MsgBox Err.Description, vbExclamation
End Sub
Private Sub cmdPrevious_Click()
On Error GoTo GoPrevError
  If Not adoPrimaryRS.BOF Then adoPrimaryRS.MovePrevious
  If adoPrimaryRS.BOF And adoPrimaryRS.RecordCount > 0 Then
    Beep
    '已到最后返回
    adoPrimaryRS.MoveFirst
  End If
    '显示当前记录
  mbDataChanged = False
  Exit Sub
GoPrevError:
  MsgBox Err.Description, vbExclamation
End Sub
Private Sub SetButtons(bVal As Boolean)
  cmdAdd.Visible = bVal
  cmdEdit.Visible = bVal
  cmdUpdate.Visible = Not bVal
  cmdCancel.Visible = Not bVal
  cmdDelete.Visible = bVal
  cmdClose.Visible = bVal
  cmdRefresh.Visible = bVal
  cmdNext.Enabled = bVal
  cmdFirst.Enabled = bVal
  cmdLast.Enabled = bVal
  cmdPrevious.Enabled = bVal
  txtFields(0).Locked = bVal
  txtFields(1).Locked = bVal
  If bVal Then
    txtFields(0).Appearance = 1
    txtFields(1).Appearance = 1
  Else
    txtFields(0).Appearance = 0
    txtFields(1).Appearance = 0
  End If
End Sub

Private Sub imgTitleClose_Click()
    Unload Me
End Sub

Private Sub imgTitleLeft_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    DoDrag Me
End Sub

Private Sub imgTitleMain_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    DoDrag Me
End Sub

Private Sub imgTitleMinimize_Click()
    Me.WindowState = 1
End Sub

Private Sub imgTitleRight_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    DoDrag Me
End Sub

Private Sub lblTitle_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    DoDrag Me
End Sub