frmclients.vb

VBA专业项目进行开发的实例项目的一些源代码

		db = New ADODB.Connection
		db.CursorLocation = ADODB.CursorLocationEnum.adUseClient
		db.Open("PROVIDER=MSDASQL;dsn=test;uid=;pwd=;")
		
		adoPrimaryRS = New ADODB.Recordset
		adoPrimaryRS.Open("select Client_ID,Client_Name,Contact_Person,Title,Address_Line1,Address_Line2,City,State,ZipCode,Remarks,CellPhoneNumber,PhoneNumber,Fax,EmailAddress from tblClients", db, ADODB.CursorTypeEnum.adOpenStatic, ADODB.LockTypeEnum.adLockOptimistic)
		
		Dim oText As System.Windows.Forms.TextBox
		'Bind the text boxes to the data provider
		For	Each oText In Me.txtFields
			'UPGRADE_ISSUE: TextBox property oText.DataSource was not upgraded. Click for more: 'ms-help://MS.VSCC/commoner/redir/redirect.htm?keyword="vbup2064"'
            oText.DataSource = adoPrimaryRS

		Next oText
		
		mbDataChanged = False
	End Sub
	
	'UPGRADE_WARNING: Event frmClients.Resize may fire when form is intialized. Click for more: 'ms-help://MS.VSCC/commoner/redir/redirect.htm?keyword="vbup2075"'
	Private Sub frmClients_Resize(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MyBase.Resize
		On Error Resume Next
		lblStatus.Width = VB6.TwipsToPixelsX(VB6.PixelsToTwipsX(Me.Width) - 1500)
		cmdNext.Left = VB6.TwipsToPixelsX(VB6.PixelsToTwipsX(lblStatus.Width) + 700)
		cmdLast.Left = VB6.TwipsToPixelsX(VB6.PixelsToTwipsX(cmdNext.Left) + 340)
	End Sub
	
	Private Sub frmClients_KeyDown(ByVal eventSender As System.Object, ByVal eventArgs As System.Windows.Forms.KeyEventArgs) Handles MyBase.KeyDown
		Dim KeyCode As Short = eventArgs.KeyCode
		Dim Shift As Short = eventArgs.KeyData \ &H10000
		If mbEditFlag Or mbAddNewFlag Then Exit Sub
		
		Select Case KeyCode
			Case System.Windows.Forms.Keys.Escape
				cmdClose_Click(cmdClose, New System.EventArgs())
			Case System.Windows.Forms.Keys.End
				cmdLast_Click(cmdLast, New System.EventArgs())
			Case System.Windows.Forms.Keys.Home
				cmdFirst_Click(cmdFirst, New System.EventArgs())
			Case System.Windows.Forms.Keys.Up, System.Windows.Forms.Keys.PageUp
				If Shift = VB6.ShiftConstants.CtrlMask Then
					cmdFirst_Click(cmdFirst, New System.EventArgs())
				Else
					cmdPrevious_Click(cmdPrevious, New System.EventArgs())
				End If
			Case System.Windows.Forms.Keys.Down, System.Windows.Forms.Keys.PageDown
				If Shift = VB6.ShiftConstants.CtrlMask Then
					cmdLast_Click(cmdLast, New System.EventArgs())
				Else
					cmdNext_Click(cmdNext, New System.EventArgs())
				End If
		End Select
	End Sub
	
	'UPGRADE_WARNING: Form event frmClients.Unload has a new behavior. Click for more: 'ms-help://MS.VSCC/commoner/redir/redirect.htm?keyword="vbup2065"'
	Private Sub frmClients_Closed(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MyBase.Closed
		'UPGRADE_WARNING: Screen property Screen.MousePointer has a new behavior. Click for more: 'ms-help://MS.VSCC/commoner/redir/redirect.htm?keyword="vbup2065"'
		System.Windows.Forms.Cursor.Current = System.Windows.Forms.Cursors.Default
	End Sub
	
	Private Sub adoPrimaryRS_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, ByVal pError As ADODB.Error, ByRef adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset) Handles adoPrimaryRS.MoveComplete
		'This will display the current record position for this recordset
		lblStatus.Text = "Record: " & CStr(adoPrimaryRS.AbsolutePosition)
	End Sub
	
	Private Sub adoPrimaryRS_WillChangeRecord(ByVal adReason As ADODB.EventReasonEnum, ByVal cRecords As Integer, ByRef adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset) Handles adoPrimaryRS.WillChangeRecord
		'This is where you put validation code
		'This event gets called when the following actions occur
		Dim bCancel As Boolean
		
		Select Case adReason
			Case ADODB.EventReasonEnum.adRsnAddNew
			Case ADODB.EventReasonEnum.adRsnClose
			Case ADODB.EventReasonEnum.adRsnDelete
			Case ADODB.EventReasonEnum.adRsnFirstChange
			Case ADODB.EventReasonEnum.adRsnMove
			Case ADODB.EventReasonEnum.adRsnRequery
			Case ADODB.EventReasonEnum.adRsnResynch
			Case ADODB.EventReasonEnum.adRsnUndoAddNew
			Case ADODB.EventReasonEnum.adRsnUndoDelete
			Case ADODB.EventReasonEnum.adRsnUndoUpdate
			Case ADODB.EventReasonEnum.adRsnUpdate
		End Select
		
		If bCancel Then adStatus = ADODB.EventStatusEnum.adStatusCancel
	End Sub
	
	Private Sub cmdAdd_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles cmdAdd.Click
		On Error GoTo AddErr
		With adoPrimaryRS
			If Not (.BOF And .EOF) Then
				'UPGRADE_WARNING: Couldn't resolve default property of object adoPrimaryRS.Bookmark. Click for more: 'ms-help://MS.VSCC/commoner/redir/redirect.htm?keyword="vbup1037"'
				'UPGRADE_WARNING: Couldn't resolve default property of object mvBookMark. Click for more: 'ms-help://MS.VSCC/commoner/redir/redirect.htm?keyword="vbup1037"'
				mvBookMark = .Bookmark
			End If
			.AddNew()
			lblStatus.Text = "Add record"
			mbAddNewFlag = True
			SetButtons(False)
		End With
		
		Exit Sub
AddErr: 
		MsgBox(Err.Description)
	End Sub
	
	Private Sub cmdDelete_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles cmdDelete.Click
		On Error GoTo DeleteErr
		With adoPrimaryRS
			.Delete()
			.MoveNext()
			If .EOF Then .MoveLast()
		End With
		Exit Sub
DeleteErr: 
		MsgBox(Err.Description)
	End Sub
	
	Private Sub cmdRefresh_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles cmdRefresh.Click
		'This is only needed for multi user apps
		On Error GoTo RefreshErr
		adoPrimaryRS.Requery()
		Exit Sub
RefreshErr: 
		MsgBox(Err.Description)
	End Sub
	
	Private Sub cmdEdit_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles cmdEdit.Click
		On Error GoTo EditErr
		
		lblStatus.Text = "Edit record"
		mbEditFlag = True
		SetButtons(False)
		Exit Sub
		
EditErr: 
		MsgBox(Err.Description)
	End Sub
	Private Sub cmdCancel_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles cmdCancel.Click
		On Error Resume Next
		
		SetButtons(True)
		mbEditFlag = False
		mbAddNewFlag = False
		adoPrimaryRS.CancelUpdate()
		'UPGRADE_WARNING: Couldn't resolve default property of object mvBookMark. Click for more: 'ms-help://MS.VSCC/commoner/redir/redirect.htm?keyword="vbup1037"'
		If mvBookMark > 0 Then
			'UPGRADE_WARNING: Couldn't resolve default property of object mvBookMark. Click for more: 'ms-help://MS.VSCC/commoner/redir/redirect.htm?keyword="vbup1037"'
			adoPrimaryRS.Bookmark = mvBookMark
		Else
			adoPrimaryRS.MoveFirst()
		End If
		mbDataChanged = False
		
	End Sub
	
	Private Sub cmdUpdate_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles cmdUpdate.Click
		On Error GoTo UpdateErr
		
		adoPrimaryRS.UpdateBatch(ADODB.AffectEnum.adAffectAll)
		
		If mbAddNewFlag Then
			adoPrimaryRS.MoveLast() 'move to the new record
		End If
		
		mbEditFlag = False
		mbAddNewFlag = False
		SetButtons(True)
		mbDataChanged = False
		
		Exit Sub
UpdateErr: 
		MsgBox(Err.Description)
	End Sub
	
	Private Sub cmdClose_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles cmdClose.Click
		Me.Close()
	End Sub
	
	Private Sub cmdFirst_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles cmdFirst.Click
		On Error GoTo GoFirstError
		
		adoPrimaryRS.MoveFirst()
		mbDataChanged = False
		
		Exit Sub
		
GoFirstError: 
		MsgBox(Err.Description)
	End Sub
	
	Private Sub cmdLast_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles cmdLast.Click
		On Error GoTo GoLastError
		
		adoPrimaryRS.MoveLast()
		mbDataChanged = False
		
		Exit Sub
		
GoLastError: 
		MsgBox(Err.Description)
	End Sub
	
	Private Sub cmdNext_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles cmdNext.Click
		On Error GoTo GoNextError
		
		If Not adoPrimaryRS.EOF Then adoPrimaryRS.MoveNext()
		If adoPrimaryRS.EOF And adoPrimaryRS.RecordCount > 0 Then
			Beep()
			'moved off the end so go back
			adoPrimaryRS.MoveLast()
		End If
		'show the current record
		mbDataChanged = False
		
		Exit Sub
GoNextError: 
		MsgBox(Err.Description)
	End Sub
	
	Private Sub cmdPrevious_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles cmdPrevious.Click
		On Error GoTo GoPrevError
		
		If Not adoPrimaryRS.BOF Then adoPrimaryRS.MovePrevious()
		If adoPrimaryRS.BOF And adoPrimaryRS.RecordCount > 0 Then
			Beep()
			'moved off the end so go back
			adoPrimaryRS.MoveFirst()
		End If
		'show the current record
		mbDataChanged = False
		
		Exit Sub
		
GoPrevError: 
		MsgBox(Err.Description)
	End Sub
	
	Private Sub SetButtons(ByRef 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
	End Sub

    Private Sub _lblLabels_0_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles _lblLabels_0.Click

    End Sub

    Private Sub PictureBox1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs)

    End Sub
End Class