VERSION 5.00 Object = "{CDE57A40-8B86-11D0-B3C6-00A0C90AEA82}#1.0#0"; "MSDATGRD.OCX" Begin VB.Form frmentry Appearance = 0 'Flat BackColor = &H00400000& Caption = "MAPLE TREND CHART" ClientHeight = 7905 ClientLeft = 1110 ClientTop = 450 ClientWidth = 11790 BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty KeyPreview = -1 'True LinkTopic = "frmselect" ScaleHeight = 7905 ScaleWidth = 11790 Begin VB.PictureBox picButtons Align = 2 'Align Bottom Appearance = 0 'Flat BorderStyle = 0 'None BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H80000008& Height = 300 Left = 0 ScaleHeight = 300 ScaleWidth = 11790 TabIndex = 7 Top = 7305 Width = 11790 Begin VB.CommandButton cmdCancel Caption = "&Cancel" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 300 Left = 1213 TabIndex = 14 Top = 0 Visible = 0 'False Width = 1095 End Begin VB.CommandButton cmdUpdate Caption = "&Update" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 300 Left = 59 TabIndex = 13 Top = 0 Visible = 0 'False Width = 1095 End Begin VB.CommandButton cmdClose Caption = "&Close" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 300 Left = 4675 TabIndex = 12 Top = 0 Width = 1095 End Begin VB.CommandButton cmdRefresh Caption = "&Refresh" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 300 Left = 3521 TabIndex = 11 Top = 0 Width = 1095 End Begin VB.CommandButton cmdDelete Caption = "&Delete" Enabled = 0 'False BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 300 Left = 2367 TabIndex = 10 Top = 0 Width = 1095 End Begin VB.CommandButton cmdEdit Caption = "&Edit" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 300 Left = 1213 TabIndex = 9 Top = 0 Width = 1095 End Begin VB.CommandButton cmdAdd Caption = "&Add" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 300 Left = 59 TabIndex = 8 Top = 0 Width = 1095 End End Begin VB.PictureBox picStatBox Align = 2 'Align Bottom Appearance = 0 'Flat BorderStyle = 0 'None BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H80000008& Height = 300 Left = 0 ScaleHeight = 300 ScaleWidth = 11790 TabIndex = 1 Top = 7605 Width = 11790 Begin VB.CommandButton cmdLast BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 300 Left = 4545 Picture = "frmentry.frx":0000 Style = 1 'Graphical TabIndex = 5 Top = 0 UseMaskColor = -1 'True Width = 345 End Begin VB.CommandButton cmdNext BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 300 Left = 4200 Picture = "frmentry.frx":0342 Style = 1 'Graphical TabIndex = 4 Top = 0 UseMaskColor = -1 'True Width = 345 End Begin VB.CommandButton cmdPrevious BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 300 Left = 345 Picture = "frmentry.frx":0684 Style = 1 'Graphical TabIndex = 3 Top = 0 UseMaskColor = -1 'True Width = 345 End Begin VB.CommandButton cmdFirst BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 300 Left = 0 Picture = "frmentry.frx":09C6 Style = 1 'Graphical TabIndex = 2 Top = 0 UseMaskColor = -1 'True Width = 345 End Begin VB.Label lblStatus BackColor = &H00FFFFFF& BorderStyle = 1 'Fixed Single BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 285 Left = 690 TabIndex = 6 Top = 0 Width = 3360 End End Begin MSDataGridLib.DataGrid grdDataGrid Align = 1 'Align Top Height = 3495 Left = 0 TabIndex = 0 Top = 0 Width = 11790 _ExtentX = 20796 _ExtentY = 6165 _Version = 393216 AllowUpdate = -1 'True AllowArrows = 0 'False HeadLines = 1 RowHeight = 15 AllowAddNew = -1 'True BeginProperty HeadFont {0BE35203-8F91-11CE-9DE3-00AA004BB851} Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Caption = "MAPLE BY SHIPMENT" ColumnCount = 2 BeginProperty Column00 DataField = "" Caption = "" BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} Type = 0 Format = "" HaveTrueFalseNull= 0 FirstDayOfWeek = 0 FirstWeekOfYear = 0 LCID = 1033 SubFormatType = 0 EndProperty EndProperty BeginProperty Column01 DataField = "" Caption = "" BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} Type = 0 Format = "" HaveTrueFalseNull= 0 FirstDayOfWeek = 0 FirstWeekOfYear = 0 LCID = 1033 SubFormatType = 0 EndProperty EndProperty SplitCount = 1 BeginProperty Split0 BeginProperty Column00 EndProperty BeginProperty Column01 EndProperty EndProperty End End Attribute VB_Name = "frmentry" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Public S_GateDb As New ADODB.Connection Public QQry As String Dim WithEvents QSql As ADODB.Recordset Attribute QSql.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() strStartDate = frmselect.txtSDD(0) & " " & frmselect.txtSMM(0).Text & " " & frmselect.txtSYYYY(0) strEndDate = frmselect.txtEDD(0) & " " & frmselect.txtEMM(0).Text & " " & frmselect.txtEYYYY(0) Set S_GateDb = New ADODB.Connection S_GateDb.ConnectionString = "DSN=S_GATE;UID=sgateuser;PWD=sgate007;" S_GateDb.Open Set QSql = New ADODB.Recordset QQry = "Select kl_ingot_no, shipping_date, invoice_no, material, To_char(f_resistivity_n), To_char(f_resistivity_avg), " _ & "To_char(f_resistivity_std), To_char(f_oxygen_n), To_char(f_oxygen_avg), To_char(f_oxygen_std), To_char(f_oxygen_se), To_char(f_oxygen_oe), " _ & "To_char(f_bow_n), To_char(f_bow_avg), To_char(f_bow_std), To_char(f_warp_n), To_char(f_warp_avg), To_char(f_warp_std), To_char(f_gbir_n), To_char(f_gbir_avg), " _ & "To_char(f_gbir_std), To_char(f_sbir_n), To_char(f_sbir_avg), To_char(f_sbir_std), To_char(f_gf3r_n), To_char(f_gf3r_avg), To_char(f_gf3r_std), To_char(f_thk_n), " _ & "To_char(f_thk_avg), To_char(f_thk_std) from maple " _ & "Where shipping_date >= '" & strStartDate & "'" & vbCrLf _ & "AND shipping_date <= '" & strEndDate & "'" & vbCrLf _ & "AND material like '" & frmselect.cboOrdNo(0).Text & "' " QSql.CursorLocation = adUseClient QSql.Open QQry, S_GateDb, adOpenDynamic, adLockOptimistic Set grdDataGrid.DataSource = QSql mbDataChanged = False End Sub Private Sub Form_Resize() On Error Resume Next 'This will resize the grid when the form is resized grdDataGrid.Height = Me.ScaleHeight - 30 - picButtons.Height - picStatBox.Height 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 QSql_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(QSql.AbsolutePosition) End Sub Private Sub QSql_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 QSql.MoveLast QSql.AddNew grdDataGrid.SetFocus Exit Sub AddErr: MsgBox Err.Description End Sub Private Sub cmdDelete_Click() On Error GoTo DeleteErr With QSql .Delete .MoveNext If .EOF Then .MoveLast End With Exit Sub DeleteErr: MsgBox Err.Description End Sub Private Sub cmdRefresh_Click() 'This is only needed for multi user apps On Error GoTo RefreshErr Set grdDataGrid.DataSource = Nothing QSql.Requery Set grdDataGrid.DataSource = QSql Exit Sub RefreshErr: 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 QSql.CancelUpdate If mvBookMark > 0 Then QSql.Bookmark = mvBookMark Else QSql.MoveFirst End If mbDataChanged = False End Sub Private Sub cmdUpdate_Click() On Error GoTo UpdateErr QSql.UpdateBatch adAffectAll QSql.Update If mbAddNewFlag Then QSql.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 CloseDatabase End Sub Private Sub cmdFirst_Click() On Error GoTo GoFirstError QSql.MoveFirst mbDataChanged = False Exit Sub GoFirstError: MsgBox Err.Description End Sub Private Sub cmdLast_Click() On Error GoTo GoLastError QSql.MoveLast mbDataChanged = False Exit Sub GoLastError: MsgBox Err.Description End Sub Private Sub cmdNext_Click() On Error GoTo GoNextError If Not QSql.EOF Then QSql.MoveNext If QSql.EOF And QSql.RecordCount > 0 Then Beep 'moved off the end so go back QSql.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 QSql.BOF Then QSql.MovePrevious If QSql.BOF And QSql.RecordCount > 0 Then Beep 'moved off the end so go back QSql.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 cmdRefresh.Visible = bVal cmdNext.Enabled = bVal cmdFirst.Enabled = bVal cmdLast.Enabled = bVal cmdPrevious.Enabled = bVal End Sub