The Final Windows Shareware CD/_.img/winshare/vb/fldpak12/fpdemo1.frm

Text File | 1993-11-30 | 10KB | 270 lines

VERSION 2.00
Begin Form Form1
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Invoice Browser (FieldPack demo program 1)"
   ClientHeight    =   2505
   ClientLeft      =   2220
   ClientTop       =   1995
   ClientWidth     =   5655
   Height          =   3195
   Left            =   2160
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   2505
   ScaleWidth      =   5655
   Top             =   1365
   Width           =   5775
   Begin ListBox lstInvoices
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "Courier"
      FontSize        =   9.75
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   1005
      Left            =   810
      Sorted          =   -1  'True
      TabIndex        =   2
      Top             =   1080
      Width           =   4035
   End
   Begin TextBox txt_hidden_NumberOfInvoices
      BackColor       =   &H00808080&
      DataField       =   "NumberOfInvoices"
      DataSource      =   "Data1"
      Height          =   285
      Left            =   4440
      TabIndex        =   0
      Top             =   0
      Visible         =   0   'False
      Width           =   495
   End
   Begin Data Data1
      BackColor       =   &H0000FF00&
      Caption         =   "Customer Name"
      Connect         =   ""
      DatabaseName    =   "c:\FPDEMO1.MDB"
      Exclusive       =   0   'False
      ForeColor       =   &H00000000&
      Height          =   270
      Left            =   1440
      Options         =   0
      ReadOnly        =   0   'False
      RecordSource    =   "InvoicesByCustomer"
      Top             =   240
      Width           =   2565
   End
   Begin Label lblCountDisplay
      BackColor       =   &H00C0C0C0&
      Caption         =   "3"
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   12
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      ForeColor       =   &H000000FF&
      Height          =   255
      Left            =   2850
      TabIndex        =   6
      Top             =   2130
      Width           =   195
   End
   Begin Label Label3
      BackColor       =   &H00C0C0C0&
      Caption         =   "open invoices."
      FontBold        =   -1  'True
      FontItalic      =   -1  'True
      FontName        =   "MS Sans Serif"
      FontSize        =   8.25
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   255
      Left            =   3090
      TabIndex        =   5
      Top             =   2160
      Width           =   1695
   End
   Begin Label Label1
      BackColor       =   &H00C0C0C0&
      Caption         =   "This customer has"
      FontBold        =   -1  'True
      FontItalic      =   -1  'True
      FontName        =   "MS Sans Serif"
      FontSize        =   8.25
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   255
      Left            =   1080
      TabIndex        =   4
      Top             =   2160
      Width           =   1695
   End
   Begin Label lblCustomerName
      BorderStyle     =   1  'Fixed Single
      DataField       =   "CustomerName"
      DataSource      =   "Data1"
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "Courier"
      FontSize        =   9.75
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   255
      Left            =   2010
      TabIndex        =   3
      Top             =   480
      Width           =   1425
   End
   Begin Label Label2
      BackColor       =   &H00C0C0C0&
      Caption         =   "Invoice Date           Amount          Terms"
      Height          =   255
      Left            =   960
      TabIndex        =   1
      Top             =   840
      Width           =   3615
   End
   Begin Menu mnuFile
      Caption         =   "&File"
      Begin Menu mnuExit
         Caption         =   "E&xit"
      End
   End
   Begin Menu mnuExplain
      Caption         =   "&Explain"
   End
End
Option Explicit

'Program FPDEMO1
'October 1993
'By: Sam Cohen
'Software Source
'42808 Christy St., Ste. 222
'Fremont, CA  94538  USA
'Tel [phone]   Fax [phone]

'Most of the commentary in this program is in the single
'subroutine "LoadListBox."   (The only other code at all
'is in Form_Load, lblCustomerName_Change, mnuExplain, and
'mnuExit.)

Sub Form_Load ()

    Dim rc As Integer
    MsgBox "This program expects to find the file FPDEMO1.MDB in the root directory of your C: drive.  Please wait while the VB3 MS-Access engine opens this file.", 64, "FieldPack Demo Program 1 -- Software Source"
    rc = FP_Password("Sorry, you'll have to register to get a proper password.")

End Sub

Sub lblCustomerName_Change ()

    'A change to this data-linked control means that
    'we need to reload the list box, since the user has
    'selected a new record.  Each record represents a
    'different customer.  There are three fields in each
    'record:  customer name (which is automatically dis-
    'played in the caption of this data-linked label
    'control); the number of "packed" invoices; and a
    'SuperString (physically stored as a Memo field in
    'the Access database file) containing the packed
    'invoices.  We use a SuperString function to unpack
    'the invoice information and display it in the list
    'box, one invoice per line.

    LoadListBox

End Sub

Sub LoadListBox ()

    Dim SS_Format As String
    Dim NumberOfInvoices As Integer
    Dim InvoiceCount As String
    Dim SuperString As String
    Dim Invoice As String
    Dim InvoiceDate As String
    Dim Amount As String
    Dim Terms As String
    Dim ListBoxLine As String
    Dim LoopCounter As Integer
    Dim rc As Integer

    lstInvoices.Clear       'Just to be neat, let's first clear out the list box.

    SuperString = Data1.Recordset.Fields("Invoices").Value   'Reads the SuperString out of the Access database.

    InvoiceCount = US_StripOut((txt_hidden_NumberOfInvoices.Text), " ")   'Note data-linked text box.

    SS_Format = "A" + InvoiceCount + "$"
        'The above line of code builds the "Format Description String" we need to supply with
        'any call to a SuperString function (such as the SS_FetchItem call you see below).
        'In this demo, we use a simple SuperString format consisting of only one "piece,"
        'an array of variable length strings.  The number of array elements varies from
        'instance to instance (i.e., from record to record).  Each array element (variable-
        'length string) contains information about a single invoice.  So, if customer XYZ
        'has 6 invoices outstanding, the SuperString for that record contains a 6-element
        'array of variable-length strings, and that SuperString is described with the
        'format string "A6$".


    lblCountDisplay.Caption = InvoiceCount   'Big red digits.

    NumberOfInvoices = Val(InvoiceCount)

    For LoopCounter = 1 To NumberOfInvoices

        rc = SS_FetchItem(SuperString, SS_Format, LoopCounter, "$", Invoice)
            'The above function call extracts an "item" (in this case, a string containing
            'information about a single invoice) from a SuperString.

        If rc <> 0 Then MsgBox "SS error " + Str$(rc)

        'Now, we're going to switch gears and demonstrate use of our Delimited Substring (DS_)
        'capabilities (in a very minor way); the DS_GetField calls pick out variable-length
        'substrings ("fields") delimited, in this case, by the "|" character:

        InvoiceDate = DS_GetField(Invoice, "|", 1)
        Amount = DS_GetField(Invoice, "|", 2)
        Terms = DS_GetField(Invoice, "|", 3)

        'Finally, just for completeness, the next line demonstrates use of some of our Utility
        'String (US_) functions.  (We actually used one of these functions a few lines earlier,
        'to remove blank characters from a string.)

        ListBoxLine = US_LJustify(InvoiceDate, 11, " ") + " " + US_RJustify(Amount, 7, "$") + " " + US_RJustify(Terms, 8, " ")

        lstInvoices.AddItem ListBoxLine

    Next LoopCounter

End Sub

Sub mnuExit_Click ()

    End

End Sub

Sub mnuExplain_Click ()

    Dim K As Integer
    Dim Msg As String

    Msg = "This is a very simple demo of how you can use SuperStrings to store a VARIABLE NUMBER of subrecords in a database record.  "
    Msg = Msg + "(SuperStrings are one of the three capabilities in FieldPack.)  "
    Msg = Msg + "In this case, we use a file of customer records, each of which contains a different number of invoice subrecords.  "
    Msg = Msg + Chr$(10) + Chr$(10)
    Msg = Msg + "We use a single MS-Access table of customer records.  Each record has three fields:  "
    Msg = Msg + "customer name, number of invoices (N), and a Memo field.  The Memo field is a SuperString, "
    Msg = Msg + "into which we're packed N invoice 'subrecords.'"
    Msg = Msg + Chr$(10) + Chr$(10)
    Msg = Msg + "Remember, this program is just an illustration of one of the simplest applications of SuperStrings.  "
    Msg = Msg + "By all means, look at the source code; there's only one subroutine ('LoadListBox')."
    MsgBox Msg, 64, "FieldPack Demo Program 1 -- Software Source"

End Sub