VERSION 4.00 Begin VB.Form frmBilling Appearance = 0 'Flat BackColor = &H00C0C0C0& Caption = "Billing" ClientHeight = 6255 ClientLeft = 210 ClientTop = 420 ClientWidth = 9270 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 = 6660 Left = 150 LinkTopic = "Form3" ScaleHeight = 6255 ScaleWidth = 9270 Top = 75 Width = 9390 Begin VB.TextBox CustomerNumberField Height = 375 Left = 6360 TabIndex = 5 Top = 5320 Width = 1095 End Begin VB.CommandButton btnCloseBilling Caption = "&Close" Height = 495 Left = 7680 TabIndex = 3 Top = 5280 Width = 1455 End Begin VB.Data ORDERS Appearance = 0 'Flat Caption = "ORDERS" Connect = "" DatabaseName = "C:\VBPROJ\SAMS\VB4DB.MDB" Exclusive = 0 'False Height = 270 Left = 840 Options = 0 ReadOnly = 0 'False RecordsetType = 1 'Dynaset RecordSource = "ORDERS" Top = 5880 Visible = 0 'False Width = 2055 End Begin VB.CommandButton Command2 Appearance = 0 'Flat BackColor = &H80000005& Caption = "Print &Statements" Height = 495 Left = 2520 TabIndex = 0 Top = 5280 Width = 1575 End Begin VB.Data CUSTMAIN Appearance = 0 'Flat Caption = "CUSTMAIN" Connect = "" DatabaseName = "C:\VBPROJ\SAMS\VB4DB.MDB" Exclusive = 0 'False Height = 270 Left = 3360 Options = 0 ReadOnly = 0 'False RecordsetType = 1 'Dynaset RecordSource = "CUSTMAIN" Top = 5880 Visible = 0 'False Width = 2655 End Begin MSDBGrid.DBGrid CustMainGrid Bindings = "FRMBILLI.frx":0000 Height = 4935 Left = 6960 OleObjectBlob = "FRMBILLI.frx":0011 TabIndex = 4 Top = 240 Width = 2295 End Begin Crystal.CrystalReport rptBilling Left = 240 Top = 5760 _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 = "" End Begin MSDBGrid.DBGrid OrdersGrid Bindings = "FRMBILLI.frx":1E4C Height = 4935 Left = 120 OleObjectBlob = "FRMBILLI.frx":1E5B TabIndex = 2 Top = 240 Width = 6735 End Begin VB.Label Label1 Alignment = 1 'Right Justify Appearance = 0 'Flat BackColor = &H00C0C0C0& Caption = "Find Customer #: " ForeColor = &H80000008& Height = 255 Left = 4680 TabIndex = 1 Top = 5400 Width = 1695 End Attribute VB_Name = "frmBilling" Attribute VB_Creatable = False Attribute VB_Exposed = False Dim CurrentCustomerNumber As Double Private Sub btnCloseBilling_Click() Unload frmBilling End Sub Private Sub CalculateCurrentBalance(CustomerNumber As Double) Dim RecSet As Snapshot Dim buffer As String Dim charge Dim credit buffer = "Select Sum(Charge),Sum(Credit) From Orders Where CustomerNum = " & Str(CustomerNumber) & ";" Set RecSet = CustDB.CreateSnapshot(buffer) If (IsNull(RecSet.Fields(0))) = True Then charge = 0 Else charge = RecSet.Fields(0) End If If (IsNull(RecSet.Fields(1))) = True Then credit = 0 Else credit = RecSet.Fields(1) End If CurrentBalance = charge - credit End Sub Private Sub Command2_Click() Dim BillingTbl As TABLE Dim RecSet As Snapshot Dim print_statements Set BillingTbl = CustDB.OpenTable("BILLING") On Error GoTo billerr ' Retrieve all records from CUSTMAIN where the current balance is greater ' than 0. Set RecSet = CustDB.CreateSnapshot("Select * From CUSTMAIN Where Current_Balance > 0.0;") If Not RecSet.RecordCount > 0 Then MsgBox ("All accounts are up to date. There are no outstanding balances to print statements for.") Exit Sub End If RecSet.MoveLast print_statements = MsgBox("This will print ALL (up to " & RecSet.RecordCount & ") of the statements. Proceed? ", vbYesNo, " Print Statements ") If print_statements <> 6 Then 'Anything but YES will exit the subroutine Exit Sub End If RecSet.MoveFirst While (RecSet.EOF = False) Screen.MousePointer = 11 ' Remove any records existing in BILLING CustDB.Execute ("Delete * From BILLING") BillingTbl.AddNew BillingTbl.Fields("CustomerNumber") = RecSet.Fields("CustomerNum") BillingTbl.Fields("CompanyName") = RecSet.Fields("Company") BillingTbl.Fields("LastName") = RecSet.Fields("Last_Name") BillingTbl.Fields("FirstName") = RecSet.Fields("First_Name") BillingTbl.Fields("Address") = RecSet.Fields("Address") BillingTbl.Fields("City") = RecSet.Fields("City") BillingTbl.Fields("State") = RecSet.Fields("State") BillingTbl.Fields("Zip") = RecSet.Fields("Zip") BillingTbl.Fields("Apt") = RecSet.Fields("Suite_Apt") BillingTbl.Fields("POBox") = RecSet.Fields("PO_Box") BillingTbl.Fields("StatementDate") = Date BillingTbl.UPDATE rptBilling.ReportFileName = "c:\vbproj\sams\statemnt.rpt" rptBilling.Destination = 0 ' 1=Output to Printer, 0=Screen rptBilling.Action = 1 RecSet.MoveNext Screen.MousePointer = 0 Wend Exit Sub billerr: MsgBox (Err.Description) End Sub Private Sub btnCustMain_Click() If orders.Recordset.RecordCount = 0 Then MsgBox ("no records to insert into.") Exit Sub End If OrdersGrid.Visible = False orders.Refresh DoEvents orders.Recordset.MoveLast DoEvents OrdersGrid.Refresh DoEvents OrdersGrid.Visible = True OrdersGrid.SetFocus SendKeys "{Down}" End Sub Private Sub CustMainGrid_RowColChange(ByVal LastRow As String, ByVal LastCol As Integer) Dim OrdersTbl As TABLE ' Synchronize the Orders grid with the CustMain grid If orders.Recordset.RecordCount <> 0 Then If custmain.Recordset.RecordCount = 0 Then 'custmain.Recordset.Refresh End If If (orders.Recordset.Fields("CustomerNum") <> custmain.Recordset.Fields("CustomerNum")) Then ' Only synchronize if records exist in ORDERS for this customer Set OrdersTbl = CustDB.OpenTable("Orders") OrdersTbl.Index = "CustomerNum" OrdersTbl.Seek "=", custmain.Recordset.Fields("CustomerNum") If (OrdersTbl.NoMatch = False) Then buffer = "CustomerNum = " & custmain.Recordset.Fields("CustomerNum") orders.Recordset.FindFirst buffer End If End If End If End Sub Private Sub CustomerNumberField_KeyPress(KeyAscii As Integer) ' While not a Windows standard, the client ' prefers to use the enter key to move from field to field. ' This subroutine should trap the keypress and ' and process all "ENTER" keys as "TAB" If KeyAscii = 13 Then SendKeys "{tab}" KeyAscii = 0 End If End Sub Private Sub CustomerNumberField_LostFocus() Dim buffer As String If (IsNull(CustomerNumberField) = False And Len(CustomerNumberField) >= 1) Then buffer = "CustomerNum = " & CustomerNumberField custmain.Recordset.FindFirst buffer End If CustomerNumberField.TEXT = "" End Sub Private Sub Form_Activate() Dim message Dim retvalue ' Reset to the default pointer when returning to this form. MousePointer = 0 orders.DatabaseName = Database_name orders.RecordSource = "Select * from ORDERS Order By CustomerNum, Date DESC;" custmain.DatabaseName = Database_name custmain.RecordSource = "Select * from CUSTMAIN order by CustomerNum;" message = "Today's date is " & Format$(Now, "mmmm dd, yyyy") retvalue = MsgBox(message, MB_ICONINFORMATION, "") custmain.Refresh orders.Refresh OrdersGrid.SetFocus FirstTimeFocus = True CurrentCustomerNumber = -1 End Sub Private Sub Form_Load() 'Center the form Left = (Screen.Width - Width) / 2 TOP = (Screen.Height - Height) / 2 End Sub Private Sub OrdersGrid_AfterDelete() Dim CustMainTbl As TABLE Dim response As Integer If (orders.Recordset.RecordCount = 0) Then orders.Recordset.AddNew orders.Recordset.Fields("CustomerNum") = Customer_number OrdersGrid.SetFocus End If Set CustMainTbl = CustDB.OpenTable("CustMain") CustMainTbl.Index = "PrimaryKey" CustMainTbl.Seek "=", CurrentCustomerNumber If (CustMainTbl.NoMatch = False) Then CustMainTbl.Edit CustMainTbl.Fields("Current_Balance") = CurrentBalance CustMainTbl.UPDATE End If CalculateCurrentBalance (Val(Customer_number)) orders.Recordset.MoveFirst orders.Refresh custmain.Refresh CustMainGrid.Refresh OrdersGrid.SetFocus Exit Sub DeleteError: response = MsgBox("Error Deleting record: " & Err.Description, vbExclamation, "Delete Record") OrdersGrid.SetFocus Exit Sub End Sub Private Sub OrdersGrid_BeforeDelete(Cancel As Integer) Dim response As Integer response = MsgBox("REALLY delete the current order?", 4, "Delete Record") If (response = IDNO) Then OrdersGrid.SetFocus Exit Sub End If End Sub Private Sub OrdersGrid_GotFocus() Dim Tbl As TABLE If (orders.Recordset.RecordCount = 0) Then ' The following DoEvents is necessary. DoEvents orders.Recordset.AddNew orders.Recordset.Fields("CustomerNum") = Customer_number End If ' If this is the first time the grid has the focus, populate the billing ' fields from an existing record or enter a new record in CustBillAddr. If (FirstTimeFocus = True) Then Set Tbl = CustDB.OpenTable("CustBillAddr") Tbl.Index = "PrimaryKey" Tbl.Seek "=", Customer_number If (Tbl.NoMatch = True) Then Tbl.AddNew Tbl.Fields("CustomerNum") = Customer_number Tbl.UPDATE End If End If End Sub Private Sub OrdersGrid_RowColChange(ByVal LastRow As String, ByVal LastCol As Integer) Dim buffer As String Dim CustMainTbl As TABLE ' This routine is called after the user has already moved to a different ' row. The value of 'CurrentCustomerNumber' still contains the customer ' number of the previous record. CalculateCurrentBalance (CurrentCustomerNumber) ' Update the current balance in CUSTMAIN Set CustMainTbl = CustDB.OpenTable("CustMain") CustMainTbl.Index = "PrimaryKey" CustMainTbl.Seek "=", CurrentCustomerNumber If (CustMainTbl.NoMatch = False) Then CustMainTbl.Edit CustMainTbl.Fields("Current_Balance") = CurrentBalance CustMainTbl.UPDATE custmain.Refresh End If ' Synchronize the CustMain grid with the Orders grid If orders.Recordset.RecordCount <> 0 Then If (IsNull(orders.Recordset.Fields("CustomerNum")) = False) Then CurrentCustomerNumber = orders.Recordset.Fields("CustomerNum") buffer = "CustomerNum = " & orders.Recordset.Fields("CustomerNum") custmain.Recordset.FindFirst buffer CustMainGrid.Refresh End If End If NewRecord = False End Sub