Visual Basic 4 Unleashed

home *** CD-ROM | disk | FTP | other *** search

/ Visual Basic 4 Unleashed / Visual_Basic_4_Unleashed_SAMS_Publishing_1995.iso / source / chap35 / frmorder.frm (.txt) < prev next >

Wrap

Visual Basic Form | 1995-09-11 | 19.0 KB | 496 lines

VERSION 4.00 Begin VB.Form frmOrder Appearance = 0 'Flat BackColor = &H00C0C0C0& Caption = "Place Order" ClientHeight = 4920 ClientLeft = 1440 ClientTop = 1455 ClientWidth = 8325 BeginProperty Font name = "MS Sans Serif" charset = 1 weight = 700 size = 8.25 underline = 0 'False italic = 0 'False strikethrough = 0 'False EndProperty ForeColor = &H80000008& Height = 5325 Left = 1380 LinkTopic = "Form1" MaxButton = 0 'False ScaleHeight = 4920 ScaleWidth = 8325 Top = 1110 Width = 8445 Begin VB.Data CustProdHist Appearance = 0 'Flat Caption = "CustProdHist" Connect = "" DatabaseName = "C:\VBPROJ\SAMS\VB4DB.MDB" Exclusive = 0 'False Height = 270 Left = 120 Options = 0 ReadOnly = 0 'False RecordsetType = 1 'Dynaset RecordSource = "CustProdHist" Top = 4560 Visible = 0 'False Width = 2535 End Begin VB.CommandButton btnDelTickets Caption = "&Close" Height = 615 Left = 6120 TabIndex = 7 Top = 3840 Width = 1815 End Begin VB.TextBox txtDelDate Height = 375 Left = 5640 TabIndex = 6 Top = 3240 Width = 1335 End Begin VB.Data CustThisOrder Appearance = 0 'Flat Caption = "CustThisOrder" Connect = "" DatabaseName = "C:\VBPROJ\SAMS\VB4DB.MDB" Exclusive = 0 'False Height = 270 Left = 2760 Options = 0 ReadOnly = 0 'False RecordsetType = 1 'Dynaset RecordSource = "CustThisOrder" Top = 4560 Visible = 0 'False Width = 2775 End Begin VB.CommandButton btnPrintOrder Appearance = 0 'Flat BackColor = &H80000005& Caption = "&Print This Order" Height = 615 Left = 4080 TabIndex = 1 Top = 3840 Width = 1815 End Begin VB.Data CustProd Appearance = 0 'Flat Caption = "CUSTPROD" Connect = "" DatabaseName = "C:\VBPROJ\SAMS\VB4DB.MDB" Exclusive = 0 'False Height = 270 Left = 5640 Options = 0 ReadOnly = 0 'False RecordsetType = 1 'Dynaset RecordSource = "CustProd" Top = 4560 Visible = 0 'False Width = 2655 End Begin Threed.SSPanel pnlDelivMsg Height = 975 Left = 120 TabIndex = 5 Top = 3240 Width = 3855 _version = 65536 _extentx = 6800 _extenty = 1720 _stockprops = 15 caption = "Gathering Order Information" BeginProperty font {FB8F0823-0164-101B-84ED-08002B2EC713} name = "MS Sans Serif" charset = 1 weight = 700 size = 18 underline = 0 'False italic = 0 'False strikethrough = 0 'False EndProperty End Begin VB.Label Label3 Caption = $"FRMORDER.frx":0000 Height = 975 Left = 120 TabIndex = 10 Top = 3240 Width = 3855 End Begin Crystal.CrystalReport rptOrderTicket Left = 3600 Top = 4080 _extentx = 741 _extenty = 741 _stockprops = 0 reportfilename = "" destination = 0 windowleft = 100 windowtop = 100 windowwidth = 490 windowheight = 300 windowtitle = "" windowborderstyle= 2 windowcontrolbox= -1 'True windowmaxbutton = -1 'True windowminbutton = -1 'True copiestoprinter = 1 printfilename = "" printfiletype = 0 selectionformula= "" groupselectionformula= "" connect = "" username = "" reportsource = 0 boundreportheading= "" boundreportfooter= 0 'False End Begin MSDBGrid.DBGrid OrderHistoryGrid Bindings = "FRMORDER.frx":00C9 Height = 1455 Left = 360 OleObjectBlob = "FRMORDER.frx":00DE TabIndex = 9 Top = 360 Width = 7575 End Begin MSDBGrid.DBGrid ThisOrder Bindings = "FRMORDER.frx":0E7F Height = 975 Left = 360 OleObjectBlob = "FRMORDER.frx":0E95 TabIndex = 8 Top = 2160 Width = 7575 End Begin VB.Label Label2 Alignment = 2 'Center Appearance = 0 'Flat BackColor = &H00808000& BorderStyle = 1 'Fixed Single Caption = "Current Order" ForeColor = &H00FFFFFF& Height = 255 Left = 360 TabIndex = 4 Top = 1920 Width = 7575 End Begin VB.Label Label13 Alignment = 1 'Right Justify Appearance = 0 'Flat BackColor = &H00C0C0C0& Caption = "Ship date" ForeColor = &H80000008& Height = 255 Left = 4560 TabIndex = 3 Top = 3360 Width = 975 End Begin VB.Label lblPrntMsg Alignment = 2 'Center Appearance = 0 'Flat BackColor = &H00FF0000& BorderStyle = 1 'Fixed Single Caption = "Loading Print Engine" BeginProperty Font name = "MS Sans Serif" charset = 1 weight = 700 size = 12 underline = 0 'False italic = 0 'False strikethrough = 0 'False EndProperty ForeColor = &H00FFFFFF& Height = 495 Left = 120 TabIndex = 2 Top = 4080 Visible = 0 'False Width = 3375 End Begin VB.Label Label1 Alignment = 2 'Center Appearance = 0 'Flat BackColor = &H00808000& BorderStyle = 1 'Fixed Single Caption = "Past Orders" ForeColor = &H00FFFFFF& Height = 255 Left = 360 TabIndex = 0 Top = 120 Width = 7575 End Attribute VB_Name = "frmOrder" Attribute VB_Creatable = False Attribute VB_Exposed = False Private Sub btnDelTickets_Click() Dim buffer As String MousePointer = 11 ' hourglass ' Delete any blank records which might exist for this customer in ' CustProd buffer = "Delete * From CustProd Where CustomerNum = " & Str(Customer_number) buffer = buffer & " AND IsNull(product);" CustDB.Execute (buffer) Me.Hide End Sub Private Sub btnPrintOrder_Click() Dim Tbl As Table ' general purpose table pointer Dim CustProdHistTbl As Table ' table pointer for the general order history Dim CustOrdMstTbl As Table ' table pointer for the master list of orders Dim CustOrdDtlTbl As Table ' table pointer for the order detail Dim CustThisOrderTbl As Table ' table pointer for the current order table Dim OrdersTbl As Table ' Table pointer for the ORDERS table Dim dynset As Dynaset ' dynaset for customer order history Dim Flag As Integer ' Indicator for whether we have checked the history or not Dim buffer As String ' Query string to pass execute statements Dim OrderNumber As Long ' the invoice/order number Dim mboxresp ' result from message box responses Dim CustOrdStr ' string for the customer order Dim histrecnum ' Counter for the history record we are on Dim deldate ' date to check for deleting old history records On Error GoTo deliverr mboxresp = MsgBox("Confirmed Order on " & txtDelDate.Text & "?", vbYesNo, "Confirm Order Date") If mboxresp <> vbYes Then Exit Sub End If MousePointer = 11 ' hourglass ' Display a message explaining something ' is happening. This routine can take a ' few seconds. To keep the user from pressing ' the buttons on the screen, make them invisible ' and put the "loading Print Engine" label over ' them. ' NOTE: Under Windows 3.1 with VB3 and CR3, ' a GPF may occur if another click event is invoked ' between the time that this click event starts and ' Crystal Reports is loaded. The buttons are disabled ' to minimize the chance of this happening. lblPrntMsg.Left = 4200 lblPrntMsg.Top = 3620 lblPrntMsg.Visible = True btnPrintOrder.Visible = False btnDelTickets.Visible = False DoEvents ' Clear out any records contained in CUSTORDMST and CUSTORDDTL CustDB.Execute ("Delete * From CustOrdMst;") CustDB.Execute ("Delete * From CustOrdDtl;") Set CustOrdMstTbl = CustDB.OpenTable("CustOrdMst") Set CustOrdDtlTbl = CustDB.OpenTable("CustOrdDtl") Set CustThisOrderTbl = CustDB.OpenTable("CustThisOrder") Set CustProdHistTbl = CustDB.OpenTable("CustProdHist") Set OrdersTbl = CustDB.OpenTable("Orders") ' Add a record to ORDERS. This must be done before the CUSTORDMST ' record is added because an order number is needed. OrdersTbl.AddNew OrdersTbl.Fields("CustomerNum") = Customer_number OrdersTbl.Fields("Date") = txtDelDate.Text OrdersTbl.Fields("Description") = CustThisOrder.Recordset.Fields("Product") OrdersTbl.Fields("Charge") = CustThisOrder.Recordset.Fields("Total") OrdersTbl.Update ' Update the current balance Call CalculateCurrentBalance ' Now retrieve the order number of the order just placed in ORDERS OrdersTbl.Index = "PrimaryKey" OrdersTbl.Seek "<=", 9999999 ' Populate the CUSTORDMST table CustOrdMstTbl.AddNew CustOrdMstTbl.Fields("CustomerNum") = Customer_number CustOrdMstTbl.Fields("InvoiceDate") = txtDelDate.Text CustOrdMstTbl.Fields("OrderNum") = OrdersTbl.Fields("OrderNum") CustOrdMstTbl.Update ' Populate the CUSTORDDTL table. One record for each record contained ' in CUSTTHISORDER CustThisOrderTbl.MoveFirst While (CustThisOrderTbl.EOF = False) CustOrdDtlTbl.AddNew CustOrdDtlTbl.Fields("OrderNum") = OrdersTbl.Fields("OrderNum") CustOrdDtlTbl.Fields("product") = CustThisOrderTbl.Fields("product") CustOrdDtlTbl.Fields("Qty") = CustThisOrderTbl.Fields("Qty") CustOrdDtlTbl.Fields("Price") = CustThisOrderTbl.Fields("Price") CustOrdDtlTbl.Fields("Subtotal") = CustThisOrderTbl.Fields("Subtotal") CustOrdDtlTbl.Fields("Tax") = CustThisOrderTbl.Fields("Tax") CustOrdDtlTbl.Fields("Deposit") = CustThisOrderTbl.Fields("Deposit") CustOrdDtlTbl.Fields("Total") = CustThisOrderTbl.Fields("Total") CustOrdDtlTbl.Update ' Now add a record to CustProdHist. To keep the the filesize ' down, limit the history to the last 10 records. ' If more than 10 unique orders exist ' for the current customer, remove the earliest orders ' until there are only 10. If (Flag = False) Then ' "Flag" is False which means I have not yet checked to see if ' there are 10 unique orders for the current customer. buffer = "SELECT DISTINCT OrderNum, CustomerNum, Date_Delivered FROM CustProdHist WHERE " buffer = buffer & "((CustProdHist.CustomerNum = " & Str(Customer_number) & ")) " buffer = buffer & " Order By Date_Delivered" Set dynset = CustDB.CreateDynaset(buffer) If (dynset.RecordCount > 0) Then dynset.MoveLast End If If (dynset.RecordCount >= 10) Then dynset.MoveFirst deldate = dynset.Fields("Date_Delivered") If deldate Then buffer = "Delete * From CustProdHist Where CustomerNum = " & Str(CustProdHistTbl.Fields("CustomerNum")) & " AND " buffer = buffer & "Date_Delivered = " & dynset.Fields("Date_Delivered") CustDB.Execute (buffer) Else buffer = "Delete * from CustProdHist where CustomerNum = " & Str(CustProdHistTbl.Fields("CustomerNum")) & " AND " buffer = buffer & "product = NULL" CustDB.Execute (buffer) End If End If Flag = True End If CustProdHistTbl.AddNew CustProdHistTbl.Fields("CustomerNum") = Customer_number CustProdHistTbl.Fields("Date_Delivered") = txtDelDate.Text CustProdHistTbl.Fields("product") = CustThisOrderTbl.Fields("Product") CustProdHistTbl.Fields("Qty") = CustThisOrderTbl.Fields("Qty") CustProdHistTbl.Fields("OrderNum") = OrdersTbl.Fields("OrderNum") CustProdHistTbl.Update CustThisOrderTbl.MoveNext Wend ' Kick off the report. rptOrderTicket.ReportFileName = App_location + "ordtick.rpt" rptOrderTicket.WindowTitle = "Printing Order Ticket" rptOrderTicket.Destination = 0 '1=printer, 0=screen rptOrderTicket.Action = 1 lblPrntMsg.Visible = False btnPrintOrder.Visible = True btnDelTickets.Visible = True CustProdHist.Refresh MousePointer = 0 ' default Exit Sub deliverr: MsgBox ("Error printing this Order ticket: " & Err.Description) lblPrntMsg.Visible = False btnPrintOrder.Visible = True btnDelTickets.Visible = True CustProdHist.Refresh MousePointer = 0 ' default End Sub Private Sub Form_Activate() Dim SQLCustProdHistInq Dim CustProdRTEDynaset As Dynaset Dim CustProdTbl As Table Dim CustThisOrdTbl As Table Dim buffer As String On Error GoTo frmOrderActError ' Make the pointer an hourglass. MousePointer = 11 If IsNull(CustmainDynaset.Fields("Last_Name")) <> True Then frmOrder.Caption = "Order information for " & CustmainDynaset.Fields("Last_Name") Else If IsNull(CustmainDynaset.Fields("Company")) <> True Then frmOrder.Caption = "Order information for " & CustmainDynaset.Fields("Company") Else frmOrder.Caption = "Order Information" End If End If ' The process of looking up stuff could take a few ' seconds (especially if there are a lot of orders), ' so put up a message telling the user what is going on. pnlDelivMsg.Visible = True ' Set up the Product history data control SQLCustProdHistInq = "Select * from CustProdHist where CustomerNum = " & Customer_number & ";" CustProdHist.RecordSource = SQLCustProdHistInq CustProdHist.Refresh ' Clear out any old orders CustDB.Execute ("Delete * from CustThisOrder") ' Insert a record in the CustThisOrder. Set CustThisOrderTbl = CustDB.OpenTable("CustThisOrder") CustThisOrderTbl.AddNew CustThisOrderTbl.Fields("CustomerNum") = Customer_number CustThisOrderTbl.Update CustThisOrder.Refresh ' Set the delivery date to be tomorrow txtDelDate.Text = Format$(Now + 1, "dd-mmm-yy") ' Turn off the message saying we are looking ' up stuff. pnlDelivMsg.Visible = False ' Reset to the default pointer. MousePointer = 0 Exit Sub frmOrderActError: ' Reset to the default pointer. MousePointer = 0 response = MsgBox(Err.Description, vbExclamation, "Activation error") End Sub Private Sub Form_Load() 'Center the form Left = (Screen.Width - Width) / 2 Top = (Screen.Height - Height) / 2 CustProdHist.DatabaseName = Database_name CustThisOrder.DatabaseName = Database_name CustProd.DatabaseName = Database_name End Sub Private Sub OrderHistoryGrid_AfterDelete() If (CustProdHist.Recordset.RecordCount = 0) Then CustProdHist.Recordset.AddNew CustProdHist.Recordset.Fields("CustomerNum") = Customer_number Exit Sub End If CustProdHist.Recordset.MoveFirst CustProdHist.Refresh End Sub Private Sub OrderHistoryGrid_BeforeDelete(Cancel As Integer) Dim response As Integer Dim buffer As String On Error GoTo HistDelError response = MsgBox("Are you sure you want to delete this record?", vbYesNo + vbQuestion, "Delete") If response = vbYes Then If IsNull(CustProdHist.Recordset.Fields("OrderNum")) = False Then buffer = "Delete * from Orders where OrderNum = " & CustProdHist.Recordset.Fields("OrderNum") & ";" CustDB.Execute (buffer) Exit Sub End If Else Cancel = True End If Exit Sub HistDelError: If Err.Number = 3021 Then 'no current record, nothing to delete Resume Else MsgBox Err.Description End If End Sub Private Sub OrderHistoryGrid_BeforeUpdate(Cancel As Integer) CustProdHist.Recordset.Fields("CustomerNum") = Customer_number End Sub Private Sub OrderHistoryGrid_GotFocus() Dim Tbl As Table DoEvents If (CustProdHist.Recordset.RecordCount = 0) Then DoEvents CustProdHist.Recordset.AddNew CustProdHist.Recordset.Fields("CustomerNum") = Customer_number End If End Sub Private Sub ThisOrder_AfterDelete() If (CustThisOrder.Recordset.RecordCount = 0) Then CustThisOrder.Recordset.AddNew CustThisOrder.Recordset.Fields("CustomerNum") = Customer_number End If End Sub Private Sub ThisOrder_BeforeUpdate(Cancel As Integer) CustThisOrder.Recordset.Fields("CustomerNum") = Customer_number End Sub