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

Visual Basic Form | 1995-09-10 | 14KB | 377 lines

VERSION 4.00
Begin VB.Form frmAccounts
   Appearance      =   0  'Flat
   BackColor       =   &H00C0C0C0&
   Caption         =   "Customer Accounts"
   ClientHeight    =   6255
   ClientLeft      =   795
   ClientTop       =   525
   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            =   735
   LinkTopic       =   "Form3"
   ScaleHeight     =   6255
   ScaleWidth      =   9270
   Top             =   180
   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 Crystal.CrystalReport rptBilling
      Left            =   120
      Top             =   5640
      _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 CustMainGrid
      Bindings        =   "FRMACCNT.frx":0000
      Height          =   4935
      Left            =   6960
      OleObjectBlob   =   "FRMACCNT.frx":0011
      TabIndex        =   4
      Top             =   240
      Width           =   2295
   End
   Begin MSDBGrid.DBGrid OrdersGrid
      Bindings        =   "FRMACCNT.frx":1C62
      Height          =   4935
      Left            =   120
      OleObjectBlob   =   "FRMACCNT.frx":1C71
      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 = "frmAccounts"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Dim CurrentCustomerNumber As Double
Private Sub btnCloseBilling_Click()
    Unload frmAccounts
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 = App_location + "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(LastRow As Variant, 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.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.RecordSource = "Select * from ORDERS Order By CustomerNum, Date DESC;"
    custmain.RecordSource = "Select * from CUSTMAIN order by CustomerNum;"
    ' Late breaking customer request: I need to know the date before
    ' I start making changes to my accounts.
    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
    orders.DatabaseName = Database_name
    custmain.DatabaseName = Database_name
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(LastRow As Variant, 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