VERSION 5.00 Begin VB.Form frmPOMatrl BorderStyle = 3 'Fixed Dialog Caption = "POMATRL" ClientHeight = 2985 ClientLeft = 1095 ClientTop = 330 ClientWidth = 5775 KeyPreview = -1 'True LinkTopic = "Form1" MaxButton = 0 'False MinButton = 0 'False ScaleHeight = 2985 ScaleWidth = 5775 Begin VB.PictureBox picButtons Align = 2 'Align Bottom Appearance = 0 'Flat BorderStyle = 0 'None ForeColor = &H80000008& Height = 300 Left = 0 ScaleHeight = 300 ScaleWidth = 5775 TabIndex = 20 Top = 2385 Width = 5775 Begin VB.CommandButton cmdCancel Caption = "&Cancel" Height = 300 Left = 1675 TabIndex = 26 Top = 0 Visible = 0 'False Width = 1095 End Begin VB.CommandButton cmdUpdate Caption = "&Update" Height = 300 Left = 290 TabIndex = 25 Top = 0 Visible = 0 'False Width = 1095 End Begin VB.CommandButton cmdClose Caption = "&Close" Height = 300 Left = 4445 TabIndex = 24 Top = 0 Width = 1095 End Begin VB.CommandButton cmdDelete Caption = "&Delete" Height = 300 Left = 3060 TabIndex = 23 Top = 0 Width = 1095 End Begin VB.CommandButton cmdEdit Caption = "&Edit" Height = 300 Left = 1675 TabIndex = 22 Top = 0 Width = 1095 End Begin VB.CommandButton cmdAdd Caption = "&Add" Height = 300 Left = 290 TabIndex = 21 Top = 0 Width = 1095 End End Begin VB.PictureBox picStatBox Align = 2 'Align Bottom Appearance = 0 'Flat BorderStyle = 0 'None ForeColor = &H80000008& Height = 300 Left = 0 ScaleHeight = 300 ScaleWidth = 5775 TabIndex = 14 Top = 2685 Width = 5775 Begin VB.CommandButton cmdLast Height = 300 Left = 4545 Picture = "frmPOMatrl.frx":0000 Style = 1 'Graphical TabIndex = 18 Top = 0 UseMaskColor = -1 'True Width = 345 End Begin VB.CommandButton cmdNext Height = 300 Left = 4200 Picture = "frmPOMatrl.frx":0342 Style = 1 'Graphical TabIndex = 17 Top = 0 UseMaskColor = -1 'True Width = 345 End Begin VB.CommandButton cmdPrevious Height = 300 Left = 345 Picture = "frmPOMatrl.frx":0684 Style = 1 'Graphical TabIndex = 16 Top = 0 UseMaskColor = -1 'True Width = 345 End Begin VB.CommandButton cmdFirst Height = 300 Left = 0 Picture = "frmPOMatrl.frx":09C6 Style = 1 'Graphical TabIndex = 15 Top = 0 UseMaskColor = -1 'True Width = 345 End Begin VB.Label lblStatus BackColor = &H00FFFFFF& BorderStyle = 1 'Fixed Single Height = 285 Left = 690 TabIndex = 19 Top = 0 Width = 3360 End End Begin VB.TextBox txtFields DataField = "CALC_FLAG" Height = 285 Index = 6 Left = 2040 TabIndex = 13 Top = 1980 Width = 3375 End Begin VB.TextBox txtFields DataField = "CALC_AMT" Height = 285 Index = 5 Left = 2040 TabIndex = 11 Top = 1660 Width = 3375 End Begin VB.TextBox txtFields DataField = "M_TYPE" Height = 285 Index = 4 Left = 2040 TabIndex = 9 Top = 1340 Width = 3375 End Begin VB.TextBox txtFields DataField = "D_FLAG" Height = 285 Index = 3 Left = 2040 TabIndex = 7 Top = 1020 Width = 3375 End Begin VB.TextBox txtFields DataField = "QTY" Height = 285 Index = 2 Left = 2040 TabIndex = 5 Top = 700 Width = 3375 End Begin VB.TextBox txtFields DataField = "DESC" Height = 285 Index = 1 Left = 2040 TabIndex = 3 Top = 380 Width = 3375 End Begin VB.TextBox txtFields DataField = "INV_NO" Height = 285 Index = 0 Left = 2040 TabIndex = 1 Top = 60 Width = 3375 End Begin VB.Label lblLabels Alignment = 1 'Right Justify Caption = "Metal Calc Flag:" Height = 255 Index = 6 Left = 120 TabIndex = 12 Top = 1980 Width = 1815 End Begin VB.Label lblLabels Alignment = 1 'Right Justify Caption = "Metal Calc Amount:" Height = 255 Index = 5 Left = 120 TabIndex = 10 Top = 1660 Width = 1815 End Begin VB.Label lblLabels Alignment = 1 'Right Justify Caption = "Material Type:" Height = 255 Index = 4 Left = 120 TabIndex = 8 Top = 1340 Width = 1815 End Begin VB.Label lblLabels Alignment = 1 'Right Justify Caption = "Delivery Flag:" Height = 255 Index = 3 Left = 120 TabIndex = 6 Top = 1020 Width = 1815 End Begin VB.Label lblLabels Alignment = 1 'Right Justify Caption = "Quantity:" Height = 255 Index = 2 Left = 120 TabIndex = 4 Top = 700 Width = 1815 End Begin VB.Label lblLabels Alignment = 1 'Right Justify Caption = "Description:" Height = 255 Index = 1 Left = 120 TabIndex = 2 Top = 380 Width = 1815 End Begin VB.Label lblLabels Alignment = 1 'Right Justify Caption = "Inventory Number:" Height = 255 Index = 0 Left = 120 TabIndex = 0 Top = 60 Width = 1815 End End Attribute VB_Name = "frmPOMatrl" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit 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 Private Sub Form_Load() Dim db As Connection Set db = New Connection db.CursorLocation = adUseClient db.Open "PROVIDER=Microsoft.Jet.OLEDB.3.51;Data Source=C:\Program Files\Microsoft Visual Studio\VB98\VWP\VWP.mdb;" Set adoPrimaryRS = New Recordset adoPrimaryRS.Open "select INV_NO,DESC,QTY,D_FLAG,M_TYPE,CALC_AMT,CALC_FLAG from POMATRL Order by INV_NO", db, adOpenStatic, adLockOptimistic Dim oText As TextBox 'Bind the text boxes to the data provider For Each oText In Me.txtFields Set oText.DataSource = adoPrimaryRS Next mbDataChanged = False End Sub Private Sub Form_Resize() On Error Resume Next lblStatus.Width = Me.Width - 1500 cmdNext.Left = lblStatus.Width + 700 cmdLast.Left = cmdNext.Left + 340 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 Form_Unload(Cancel As Integer) Screen.MousePointer = vbDefault 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) 'This will display the current record position for this recordset lblStatus.Caption = "Record: " & CStr(adoPrimaryRS.AbsolutePosition) End Sub Private Sub adoPrimaryRS_WillChangeRecord(ByVal adReason As ADODB.EventReasonEnum, ByVal cRecords As Long, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset) 'This is where you put validation code 'This event gets called when the following actions occur Dim bCancel As Boolean Select Case adReason Case adRsnAddNew Case adRsnClose Case adRsnDelete Case adRsnFirstChange Case adRsnMove Case adRsnRequery Case adRsnResynch Case adRsnUndoAddNew Case adRsnUndoDelete Case adRsnUndoUpdate Case adRsnUpdate End Select If bCancel Then adStatus = adStatusCancel 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 = "Add record" mbAddNewFlag = True SetButtons False End With Exit Sub AddErr: MsgBox Err.Description End Sub Private Sub 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 cmdEdit_Click() On Error GoTo EditErr lblStatus.Caption = "Edit record" mbEditFlag = True SetButtons False Exit Sub EditErr: MsgBox Err.Description End Sub Private Sub cmdCancel_Click() On Error Resume Next SetButtons True mbEditFlag = False mbAddNewFlag = False adoPrimaryRS.CancelUpdate If mvBookMark > 0 Then adoPrimaryRS.Bookmark = mvBookMark Else adoPrimaryRS.MoveFirst End If mbDataChanged = False End Sub Private Sub cmdUpdate_Click() On Error GoTo UpdateErr adoPrimaryRS.UpdateBatch 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() Unload Me End Sub Private Sub cmdFirst_Click() On Error GoTo GoFirstError adoPrimaryRS.MoveFirst mbDataChanged = False Exit Sub GoFirstError: MsgBox Err.Description End Sub Private Sub cmdLast_Click() On Error GoTo GoLastError adoPrimaryRS.MoveLast mbDataChanged = False Exit Sub GoLastError: MsgBox Err.Description 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 '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() 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(bVal As Boolean) cmdAdd.Visible = bVal cmdEdit.Visible = bVal cmdUpdate.Visible = Not bVal cmdCancel.Visible = Not bVal cmdDelete.Visible = bVal cmdClose.Visible = bVal cmdNext.Enabled = bVal cmdFirst.Enabled = bVal cmdLast.Enabled = bVal cmdPrevious.Enabled = bVal End Sub