Visual Basic 4 Unleashed/Visual_Basic_4_Unleashed_SAMS_Publishing_1995.iso/source/chap35/frmorder.frm

Visual Basic Form | 1995-09-10 | 19KB | 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