home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic 4 Unleashed / Visual_Basic_4_Unleashed_SAMS_Publishing_1995.iso / source / chap35 / frmdeliv.frm (.txt) < prev    next >
Visual Basic Form  |  1995-07-30  |  17KB  |  433 lines
  1. VERSION 4.00
  2. Begin VB.Form frmOrder 
  3.    Appearance      =   0  'Flat
  4.    BackColor       =   &H00C0C0C0&
  5.    Caption         =   "Place Order"
  6.    ClientHeight    =   4920
  7.    ClientLeft      =   1005
  8.    ClientTop       =   1185
  9.    ClientWidth     =   8325
  10.    BeginProperty Font 
  11.       name            =   "MS Sans Serif"
  12.       charset         =   1
  13.       weight          =   700
  14.       size            =   8.25
  15.       underline       =   0   'False
  16.       italic          =   0   'False
  17.       strikethrough   =   0   'False
  18.    EndProperty
  19.    ForeColor       =   &H80000008&
  20.    Height          =   5325
  21.    Left            =   945
  22.    LinkTopic       =   "Form1"
  23.    MaxButton       =   0   'False
  24.    ScaleHeight     =   4920
  25.    ScaleWidth      =   8325
  26.    Top             =   840
  27.    Width           =   8445
  28.    Begin VB.Data CustProdHist 
  29.       Appearance      =   0  'Flat
  30.       Caption         =   "CustProdHist"
  31.       Connect         =   ""
  32.       DatabaseName    =   "C:\VBPROJ\SAMS\VB4DB.MDB"
  33.       Exclusive       =   0   'False
  34.       Height          =   270
  35.       Left            =   720
  36.       Options         =   0
  37.       ReadOnly        =   0   'False
  38.       RecordsetType   =   1  'Dynaset
  39.       RecordSource    =   "CustProdHist"
  40.       Top             =   4560
  41.       Visible         =   0   'False
  42.       Width           =   2535
  43.    End
  44.    Begin VB.CommandButton btnDelTickets 
  45.       Caption         =   "&Close"
  46.       Height          =   615
  47.       Left            =   6120
  48.       TabIndex        =   7
  49.       Top             =   3600
  50.       Width           =   1815
  51.    End
  52.    Begin VB.TextBox txtDelDate 
  53.       Height          =   375
  54.       Left            =   5640
  55.       TabIndex        =   6
  56.       Top             =   3000
  57.       Width           =   1335
  58.    End
  59.    Begin VB.Data CustThisOrder 
  60.       Appearance      =   0  'Flat
  61.       Caption         =   "CustThisOrder"
  62.       Connect         =   ""
  63.       DatabaseName    =   "C:\VBPROJ\SAMS\VB4DB.MDB"
  64.       Exclusive       =   0   'False
  65.       Height          =   270
  66.       Left            =   3960
  67.       Options         =   0
  68.       ReadOnly        =   0   'False
  69.       RecordsetType   =   1  'Dynaset
  70.       RecordSource    =   "CustThisOrder"
  71.       Top             =   4320
  72.       Visible         =   0   'False
  73.       Width           =   3135
  74.    End
  75.    Begin VB.CommandButton cmdPrintOrder 
  76.       Appearance      =   0  'Flat
  77.       BackColor       =   &H80000005&
  78.       Caption         =   "&Print This Order"
  79.       Height          =   615
  80.       Left            =   4080
  81.       TabIndex        =   1
  82.       Top             =   3600
  83.       Width           =   1815
  84.    End
  85.    Begin VB.Data CustProd 
  86.       Appearance      =   0  'Flat
  87.       Caption         =   "CUSTPROD"
  88.       Connect         =   ""
  89.       DatabaseName    =   "C:\VBPROJ\SAMS\VB4DB.MDB"
  90.       Exclusive       =   0   'False
  91.       Height          =   270
  92.       Left            =   3960
  93.       Options         =   0
  94.       ReadOnly        =   0   'False
  95.       RecordsetType   =   1  'Dynaset
  96.       RecordSource    =   "CustProd"
  97.       Top             =   4560
  98.       Visible         =   0   'False
  99.       Width           =   3135
  100.    End
  101.    Begin MSDBGrid.DBGrid OrderHistoryGrid 
  102.       Bindings        =   "FRMDELIV.frx":0000
  103.       Height          =   975
  104.       Left            =   360
  105.       OleObjectBlob   =   "FRMDELIV.frx":0015
  106.       TabIndex        =   9
  107.       Top             =   360
  108.       Width           =   7575
  109.    End
  110.    Begin MSDBGrid.DBGrid ThisOrder 
  111.       Bindings        =   "FRMDELIV.frx":0E60
  112.       Height          =   975
  113.       Left            =   360
  114.       OleObjectBlob   =   "FRMDELIV.frx":0E76
  115.       TabIndex        =   8
  116.       Top             =   1800
  117.       Width           =   7575
  118.    End
  119.    Begin Crystal.CrystalReport rptOrderTicket 
  120.       Left            =   3480
  121.       Top             =   4320
  122.       _extentx        =   741
  123.       _extenty        =   741
  124.       _stockprops     =   0
  125.       reportfilename  =   ""
  126.       destination     =   0
  127.       windowleft      =   100
  128.       windowtop       =   100
  129.       windowwidth     =   490
  130.       windowheight    =   300
  131.       windowtitle     =   ""
  132.       windowborderstyle=   2
  133.       windowcontrolbox=   -1  'True
  134.       windowmaxbutton =   -1  'True
  135.       windowminbutton =   -1  'True
  136.       copiestoprinter =   1
  137.       printfilename   =   ""
  138.       printfiletype   =   0
  139.       selectionformula=   ""
  140.       groupselectionformula=   ""
  141.       connect         =   ""
  142.       username        =   ""
  143.    End
  144.    Begin Threed.SSPanel pnlDelivMsg 
  145.       Height          =   1215
  146.       Left            =   120
  147.       TabIndex        =   5
  148.       Top             =   2880
  149.       Width           =   3255
  150.       _version        =   65536
  151.       _extentx        =   5741
  152.       _extenty        =   2143
  153.       _stockprops     =   15
  154.       caption         =   "Gathering Order Information"
  155.       BeginProperty font {FB8F0823-0164-101B-84ED-08002B2EC713} 
  156.          name            =   "MS Sans Serif"
  157.          charset         =   1
  158.          weight          =   700
  159.          size            =   18
  160.          underline       =   0   'False
  161.          italic          =   0   'False
  162.          strikethrough   =   0   'False
  163.       EndProperty
  164.    End
  165.    Begin VB.Label Label2 
  166.       Alignment       =   2  'Center
  167.       Appearance      =   0  'Flat
  168.       BackColor       =   &H00808000&
  169.       BorderStyle     =   1  'Fixed Single
  170.       Caption         =   "Current Order"
  171.       ForeColor       =   &H00FFFFFF&
  172.       Height          =   255
  173.       Left            =   360
  174.       TabIndex        =   4
  175.       Top             =   1560
  176.       Width           =   7575
  177.    End
  178.    Begin VB.Label Label13 
  179.       Alignment       =   1  'Right Justify
  180.       Appearance      =   0  'Flat
  181.       BackColor       =   &H00C0C0C0&
  182.       Caption         =   "Ship date"
  183.       ForeColor       =   &H80000008&
  184.       Height          =   255
  185.       Left            =   4560
  186.       TabIndex        =   3
  187.       Top             =   3120
  188.       Width           =   975
  189.    End
  190.    Begin VB.Label lblPrntMsg 
  191.       Alignment       =   2  'Center
  192.       Appearance      =   0  'Flat
  193.       BackColor       =   &H00FF0000&
  194.       BorderStyle     =   1  'Fixed Single
  195.       Caption         =   "Loading Print Engine"
  196.       BeginProperty Font 
  197.          name            =   "MS Sans Serif"
  198.          charset         =   1
  199.          weight          =   700
  200.          size            =   12
  201.          underline       =   0   'False
  202.          italic          =   0   'False
  203.          strikethrough   =   0   'False
  204.       EndProperty
  205.       ForeColor       =   &H00FFFFFF&
  206.       Height          =   495
  207.       Left            =   120
  208.       TabIndex        =   2
  209.       Top             =   4080
  210.       Visible         =   0   'False
  211.       Width           =   3375
  212.    End
  213.    Begin VB.Label Label1 
  214.       Alignment       =   2  'Center
  215.       Appearance      =   0  'Flat
  216.       BackColor       =   &H00808000&
  217.       BorderStyle     =   1  'Fixed Single
  218.       Caption         =   "Past Orders"
  219.       ForeColor       =   &H00FFFFFF&
  220.       Height          =   255
  221.       Left            =   360
  222.       TabIndex        =   0
  223.       Top             =   120
  224.       Width           =   7575
  225.    End
  226. Attribute VB_Name = "frmOrder"
  227. Attribute VB_Creatable = False
  228. Attribute VB_Exposed = False
  229. Private Sub btnDelTickets_Click()
  230.     Dim buffer As String
  231.         
  232.     MousePointer = 11 ' hourglass
  233.     ' Delete any blank records which might exist for this customer in
  234.     ' CustProd
  235.     buffer = "Delete * From CustProd Where CustomerNum = " & Str(Customer_number)
  236.     buffer = buffer & " AND IsNull(product);"
  237.     CustDB.Execute (buffer)
  238.     Unload frmOrder
  239. End Sub
  240. Private Sub cmdPrintOrder_Click()
  241.     Dim Tbl As TABLE              ' general purpose table pointer
  242.     Dim CustomerTbl As TABLE      ' table pointer to the custmain table
  243.     Dim CustProdHistTbl As TABLE      ' table pointer for the general order history
  244.     Dim CustOrdMstTbl As TABLE    ' table pointer for the master list of orders
  245.     Dim CustOrdDtlTbl As TABLE    ' table pointer for the order detail
  246.     Dim CustThisOrderTbl As TABLE ' table pointer for the current order table
  247.     Dim OrdersTbl As TABLE   ' Table pointer for the ORDERS table
  248.     Dim dynset As Dynaset    ' dynaset for customer order history
  249.     Dim Flag As Integer      ' Indicator for whether we have checked the history or not
  250.     Dim buffer As String     ' Query string to pass execute statements
  251.     Dim OrderNumber As Long  ' the invoice/order number
  252.     Dim mboxresp             ' result from message box responses
  253.     Dim CustOrdStr           ' string for the customer order
  254.     Dim histrecnum           ' Counter for the history record we are on
  255.     Dim deldate              ' date to check for deleting old history records
  256.     On Error GoTo deliverr
  257.     mboxresp = MsgBox("Confirmed Order on " & txtDelDate.TEXT & "?", vbYesNo, "Confirm Order Date")
  258.     If mboxresp <> vbYes Then
  259.         Exit Sub
  260.     End If
  261.     MousePointer = 11 ' hourglass
  262.     ' Display a message explaining something
  263.     ' is happening.  This routine can take a
  264.     ' few seconds.  To keep the user from pressing
  265.     ' the buttons on the screen, make them invisible
  266.     ' and put the "loading Print Engine" label over
  267.     ' them.
  268.     lblPrntMsg.Left = 4200
  269.     lblPrntMsg.TOP = 3600
  270.     lblPrntMsg.Visible = True
  271.     cmdPrintOrder.Visible = False
  272.     btnDelTickets.Visible = False
  273.     DoEvents
  274.     ' Clear out any records contained in CUSTORDMST and CUSTORDDTL
  275.     CustDB.Execute ("Delete * From CustOrdMst;")
  276.     CustDB.Execute ("Delete * From CustOrdDtl;")
  277.     Set CustOrdMstTbl = CustDB.OpenTable("CustOrdMst")
  278.     Set CustOrdDtlTbl = CustDB.OpenTable("CustOrdDtl")
  279.     Set CustomerTbl = CustDB.OpenTable("CustMain")
  280.     Set CustThisOrderTbl = CustDB.OpenTable("CustThisOrder")
  281.     Set CustProdHistTbl = CustDB.OpenTable("CustProdHist")
  282.     Set OrdersTbl = CustDB.OpenTable("Orders")
  283.     ' Find the customer record
  284.     CustomerTbl.Index = "PrimaryKey"
  285.     CustomerTbl.Seek "=", Customer_number
  286.     If (CustomerTbl.NoMatch = True) Then
  287.         MsgBox ("The customer you have selected is not in the database.")
  288.         MousePointer = 0 ' default
  289.         Exit Sub
  290.     End If
  291.     ' Add a record to ORDERS.  This must be done before the CUSTORDMST
  292.     ' record is added because an order number is needed.
  293.     OrdersTbl.AddNew
  294.     OrdersTbl.Fields("CustomerNum") = Customer_number
  295.     OrdersTbl.Fields("Date") = txtDelDate.TEXT
  296.     OrdersTbl.Fields("Description") = "Order"
  297.     OrdersTbl.Fields("Charge") = CustThisOrder.Recordset.Fields("Total")
  298.     OrdersTbl.UPDATE
  299.     ' Update the current balance
  300.     Call CalculateCurrentBalance
  301.     ' Now retrieve the order number of the order just placed in ORDERS
  302.     OrdersTbl.Index = "PrimaryKey"
  303.     OrdersTbl.Seek "<=", 9999999
  304.     ' Populate the CUSTORDMST table
  305.     CustOrdMstTbl.AddNew
  306.     CustOrdMstTbl.Fields("CustomerNum") = Customer_number
  307.     CustOrdMstTbl.Fields("InvoiceDate") = txtDelDate.TEXT
  308.     CustOrdMstTbl.Fields("OrderNum") = OrdersTbl.Fields("OrderNum")
  309.     CustOrdMstTbl.UPDATE
  310.     ' Populate the CUSTORDDTL table.  One record for each record contained
  311.     ' in CUSTTHISORDER
  312.     CustThisOrderTbl.MoveFirst
  313.     While (CustThisOrderTbl.EOF = False)
  314.         CustOrdDtlTbl.AddNew
  315.         CustOrdDtlTbl.Fields("OrderNum") = OrdersTbl.Fields("OrderNum")
  316.         CustOrdDtlTbl.Fields("product") = CustThisOrderTbl.Fields("product")
  317.         CustOrdDtlTbl.Fields("Qty") = CustThisOrderTbl.Fields("Qty")
  318.         CustOrdDtlTbl.Fields("Price") = CustThisOrderTbl.Fields("Price")
  319.         CustOrdDtlTbl.Fields("Subtotal") = CustThisOrderTbl.Fields("Subtotal")
  320.         CustOrdDtlTbl.Fields("Tax") = CustThisOrderTbl.Fields("Tax")
  321.         CustOrdDtlTbl.Fields("Deposit") = CustThisOrderTbl.Fields("Deposit")
  322.         CustOrdDtlTbl.Fields("Total") = CustThisOrderTbl.Fields("Total")
  323.         CustOrdDtlTbl.UPDATE
  324.         ' Now add a record to CustProdHist.  To keep the the filesize
  325.         ' down, limit the history to the last 10 records.
  326.         ' If more than 10 unique orders exist
  327.         ' for the current customer, remove the earliest orders
  328.         ' until there are only 10.
  329.         If (Flag = False) Then
  330.             ' "Flag" is False which means I have not yet checked to see if
  331.             ' there are 10 unique orders for the current customer.
  332.             buffer = "SELECT DISTINCT OrderNum, CustomerNum, Date_Delivered FROM CustProdHist WHERE "
  333.             buffer = buffer & "((CustProdHist.CustomerNum = " & Str(Customer_number) & ")) "
  334.             buffer = buffer & " Order By Date_Delivered"
  335.             Set dynset = CustDB.CreateDynaset(buffer)
  336.             If (dynset.RecordCount > 0) Then
  337.                 dynset.MoveLast
  338.             End If
  339.             If (dynset.RecordCount >= 10) Then
  340.                 dynset.MoveFirst
  341.                 deldate = dynset.Fields("Date_Delivered")
  342.                 If deldate Then
  343.                     buffer = "Delete * From CustProdHist Where CustomerNum = " & Str(CustProdHistTbl.Fields("CustomerNum")) & " AND "
  344.                     buffer = buffer & "Date_Delivered = " & dynset.Fields("Date_Delivered")
  345.                     CustDB.Execute (buffer)
  346.                 Else
  347.                     buffer = "Delete * from CustProdHist where CustomerNum = " & Str(CustProdHistTbl.Fields("CustomerNum")) & " AND "
  348.                     buffer = buffer & "product = NULL"
  349.                     CustDB.Execute (buffer)
  350.                 End If
  351.             End If
  352.             Flag = True
  353.         End If
  354.         
  355.         CustProdHistTbl.AddNew
  356.         CustProdHistTbl.Fields("CustomerNum") = Customer_number
  357.         CustProdHistTbl.Fields("Date_Delivered") = txtDelDate.TEXT
  358.         CustProdHistTbl.Fields("product") = CustThisOrderTbl.Fields("Product")
  359.         CustProdHistTbl.Fields("Qty") = CustThisOrderTbl.Fields("Qty")
  360.         CustProdHistTbl.Fields("OrderNum") = OrdersTbl.Fields("OrderNum")
  361.         CustProdHistTbl.UPDATE
  362.         CustThisOrderTbl.MoveNext
  363.     Wend
  364.     rptOrderTicket.ReportFileName = "c:\vbproj\sams\ordtick.rpt"
  365.     rptOrderTicket.WindowTitle = "Printing Order Ticket"
  366.     rptOrderTicket.Destination = 0 '1=printer, 0=screen
  367.     rptOrderTicket.Action = 1
  368.     lblPrntMsg.Visible = False
  369.     cmdPrintOrder.Visible = True
  370.     btnDelTickets.Visible = True
  371.     CustProdHist.Refresh
  372.     MousePointer = 0 ' default
  373.     Exit Sub
  374. deliverr:
  375.     MsgBox ("Error printing this Order ticket: " & Err.Description)
  376.     lblPrntMsg.Visible = False
  377.     cmdPrintOrder.Visible = True
  378.     btnDelTickets.Visible = True
  379.     CustProdHist.Refresh
  380.     MousePointer = 0 ' default
  381. End Sub
  382. Private Sub Form_Activate()
  383.     Dim SQLCustProdHistInq
  384.     Dim CustProdRTEDynaset As Dynaset
  385.     Dim CustProdTbl As TABLE
  386.     Dim CustThisOrdTbl As TABLE
  387.     Dim buffer As String
  388.     ' Reset to the default  pointer when returning to this form.
  389.     MousePointer = 0
  390.     If IsNull(CustmainDynaset.Fields("Last_Name")) <> True Then
  391.         frmOrder.Caption = "Order information for " & CustmainDynaset.Fields("Last_Name")
  392.     Else
  393.         If IsNull(CustmainDynaset.Fields("Company")) <> True Then
  394.             frmOrder.Caption = "Order information for " & CustmainDynaset.Fields("Company")
  395.         Else
  396.             frmOrder.Caption = "Order Information"
  397.         End If
  398.     End If
  399.     ' The process of looking up stuff could take a few
  400.     ' seconds (especially if there are a lot of orders),
  401.     ' so put up a message telling the user what is going on.
  402.     pnlDelivMsg.Visible = True
  403.     ' Set up the Product history data control
  404.     SQLCustProdHistInq = "Select * from CustProdHist where CustomerNum = " & Customer_number & ";"
  405.     CustProdHist.RecordSource = SQLCustProdHistInq
  406.     CustProdHist.Refresh
  407.     ' Insert a record in the CustThisOrder.
  408.     Set CustThisOrderTbl = CustDB.OpenTable("CustThisOrder")
  409.     CustThisOrderTbl.AddNew
  410.     CustThisOrderTbl.Fields("CustomerNum") = Customer_number
  411.     CustThisOrderTbl.UPDATE
  412.     CustThisOrder.Refresh
  413.     ' Set the delivery date to be tomorrow
  414.     txtDelDate.TEXT = Format$(Now + 1, "dd-mmm-yy")
  415.     ' Turn off the message saying we are looking
  416.     ' up stuff.
  417.     pnlDelivMsg.Visible = False
  418. End Sub
  419. Private Sub Form_Load()
  420.     'Center the form
  421.     Left = (Screen.Width - Width) / 2
  422.     TOP = (Screen.Height - Height) / 2
  423. End Sub
  424. Private Sub OrderHistoryGrid_BeforeDelete(Cancel As Integer)
  425. Dim response As Integer
  426.     response = MsgBox("Are you sure you want to delete this record?", vbYesNo + vbQuestion, "Delete")
  427.     If response = vbYes Then
  428.         Exit Sub
  429.     Else
  430.         Cancel = True
  431.     End If
  432. End Sub
  433.