ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng)/ProfitPress-MegaCDROM2.B6I/PROG/PASCAL/ONE2MANY.ZIP/ONE2MANY.PAS

Pascal/Delphi Source File | 1991-08-07 | 8.7 KB | 360 lines

PROGRAM OneToMany;

{
   One2Many - V02.00B
   (C)opyright 1991 - Caboose Software Engineering

   This program is meant to demonstrate how one might browse a 1:M file
   using the extremely powerful Browse routine in Topaz.

   It also is meant to demonstrate some of the more advanced, and possibly
   confusing, Topaz features such as configurable and overlayed browsing,
   indexing, relational technology and filter conditions.  I apologize if
   the source code is a confusing in any way.  A slight background in
   relational technology may be required before, or obtained from, reading
   this code.

   Note that I had some problems in implementation.  Some things in the
   Topaz manual are not as clear as they should be (what does PushBrowse
   actually push? etc.) and the demonstrations included with Topaz did
   little to show me the way.  Hooray for their superior technical
   support!

   This code is hereby donated to the Public Domain.  May the tradition of
   our computing pioneers live on!  Let the code be distributed freely!
   If some techniques are of value, a comment in your source code or
   documentation would certainly make my day.

   Written by Barry Smith.

   Many thanks to Richard Matzinger of Software Science Inc., John Graves of
   NetComm Inc. and Purdue University CPT.

   If you are interested in starting a Topaz user group or newsletter please
   write me at the following address.

   Caboose Software Engineering
   2921 Bluff Point Lane
   Silver Spring, MD   20906
   301/460-1437
}

USES
   DBF4,
   Browse4,
   Index4,
   TimeDate,
   VidPop,
   TZCommon,
   SayGet4,
   Crt;

TYPE
   ACCOUNT_Record = RECORD
      Deleted    : BOOLEAN;
      _UID       : STRING[  5];
      _AMOUNT    : LONGINT;        { width =   5}
      _TRANTYPE  : STRING[  1];
      _TRANSDATE : STRING[ 10]
   End;

   {
      _TRANTYPE = 1 (Total),
                  2 (Deposit),
                  3 (Withdrawal),
                  4 (Open Account)
   }

   CUSTOMER_Record = RECORD
      Deleted : BOOLEAN;
      _NAME   : STRING[ 20];
      _UID    : STRING[  5];
   End;

VAR
   CUSTOMER           : CUSTOMER_record;
   SAVINGS,
   CHECKING,
   TempRec            : ACCOUNT_record;
   Done               : BOOLEAN;
   CurrentAccountFile : BYTE;

{$F+}
PROCEDURE DoTone;

BEGIN
   Sound(500);
   Delay(25);
   NoSound
END;

FUNCTION Center ( S          : STRING;
                  LineLength : BYTE    ) : STRING;

VAR
   I : INTEGER;
   T : STRING;

BEGIN
   T := '';
   For I := 1 To ((LineLength Div 2) - (Length(S) Div 2)) DO
      T := T + ' ';
   Center := T + S
END;

PROCEDURE InitTempRec;

BEGIN
   CASE CurrentAccountFile Of
      1 : TempRec := SAVINGS;
      2 : TempRec := CHECKING
   END;
END;

PROCEDURE ClearScreen ( C : Char );

VAR
   S : STRING;
   I : INTEGER;

BEGIN
   S := '';
   FOR I := 1 TO Lo(WindMax) + 1 DO
      S := S + C;
   GotoXY(1, 1);
   FOR I := 1 TO Hi(WindMax) + 1 DO
      Write(S)
END;

PROCEDURE InitializeMainBrowse; Forward;

PROCEDURE CustomerBrowse;

BEGIN
   InitTempRec;
   WITH DataDefinition^ DO
      BEGIN
         CASE Column Of
             1 : BEGIN
                    Prompt := 'NAME';
                    VirtualField := CUSTOMER._NAME
                 END;
             2 : BEGIN
                    Prompt := 'BALANCE';
                    VirtualField := SInteger(TempRec._AMOUNT, 5)
                 END
         END
      END
END;

PROCEDURE AccountBrowse;

BEGIN
   InitTempRec;
   WITH DataDefinition^ DO
      BEGIN
         CASE Column OF
             1 : BEGIN
                    Prompt := 'TRANSACTION';
                    CASE (TempRec._TRANTYPE[1]) OF
                       '1' : VirtualField := 'TOTAL     ';
                       '2' : VirtualField := 'DEPOSIT   ';
                       '3' : VirtualField := 'WITHDRAWAL';
                       '4' : VirtualField := 'OPEN ACCT '
                    END
                 END;
             2 : BEGIN
                    Prompt := 'DATE';
                    IF TempRec._TRANTYPE[1] = '1'
                       THEN
                          VirtualField := SystemDate
                       ELSE
                          VirtualField := TempRec._TRANSDATE
                 END;
             3 : BEGIN
                    Prompt := 'AMOUNT';
                    VirtualField := SInteger(TempRec._AMOUNT, 5)
                 END
         END
      END
END;

FUNCTION SavingsKey : STRING;

BEGIN
   SavingsKey := SAVINGS._UID + AnsiDate(SAVINGS._TRANSDATE)
END;

FUNCTION CheckingKey : STRING;

BEGIN
   CheckingKey := CHECKING._UID + AnsiDate(CHECKING._TRANSDATE)
END;

FUNCTION CustomerKey : STRING;

BEGIN
   CustomerKey := CUSTOMER._NAME
END;

PROCEDURE RelateFiles;

BEGIN
   Select(CurrentAccountFile + 1);
   Find(CUSTOMER._UID);
   Select(1)
END;

FUNCTION FilterFunction : BOOLEAN;

BEGIN
   InitTempRec;
   Select(CurrentAccountFile + 1);
   Find(CUSTOMER._UID);
   InitTempRec;
   FilterFunction := (CUSTOMER._UID = TempRec._UID);
   Select(1)
END;

FUNCTION AccountBrowseTitle ( AccountSelected : BYTE ) : STRING;

BEGIN
   CASE AccountSelected OF
      1 : AccountBrowseTitle := 'Savings';
      2 : AccountBrowseTitle := 'Checking'
   END
END;

FUNCTION OnlyThese : BOOLEAN;

BEGIN
   InitTempRec;
   OnlyThese := (TempRec._UID = CUSTOMER._UID)
END;

PROCEDURE ZoomBrowse;

BEGIN
   Case LastKey Of
      Chr(Ord(F8 ) + 128) :
         BEGIN
            IF CurrentAccountFile = 1
               THEN
                  CurrentAccountFile := 2
               ELSE
                  CurrentAccountFile := 1;
            DOTone;
            InitializeMainBrowse;
            ExitBrowse := TRUE
         END;
      Chr(Ord(F9 ) + 128) :
         BEGIN
            PushBrowse;
            Select(CurrentAccountFile + 1);
            Set_DataDefinition_To(@AccountBrowse);
            Set_While_To(@OnlyThese);
            PushWindow(22, 7, 59, 19);
            Set_BrowseWindow_To(22, 7, 57, 17,
               DoubleTopSingleSide + Explode + Shadow, Trim(CUSTOMER._NAME));
            GotoXY(1, Hi(WindMax) + 1);
            ClrEOL;
            AT(1, Hi(WindMax) + 1,
               Center('ESC - CUSTOMERS ║ ' +
                  #27#24#25#26' - MOVE CURSOR', 80));
            Set_Browse_Calc_To(NIL);
            BrowseExitKeys := [#27];
            WatchKeys := [];
            Browse('PLAIN');

            PopBrowse;
            Set_While_To(NIL);
            Select(1);
            InitializeMainBrowse;
            ExitBrowse := TRUE;
            PopWindow

            {
               We have to ExitBrowse because PopBrowse WILL NOT restore the
               browse screen to it's previous state.  We also have to push a
               Window since the pop does not remove the new browse!
            }

         END;
      Chr(Ord(F10) + 128) :
         BEGIN
            Done := TRUE;
            ExitBrowse := TRUE
         END
   END;
END;

PROCEDURE InitializeMainBrowse;

BEGIN
   Set_DataDefinition_To(@CUSTOMERBrowse);
   Set_BrowseWindow_To(20, 5, 55, 15, DoubleTopSingleSide + Shadow,
      'Topaz S & L - ' + AccountBrowseTitle(CurrentAccountFile));
   Set_Browse_Calc_To(@ZoomBrowse);
   BrowseExitKeys := [];
   WatchKeys := [ Chr(Ord(F8 ) + 128),
                  Chr(Ord(F9 ) + 128),
                  Chr(Ord(F10) + 128)  ];
   GotoXy(1, Hi(WindMax) + 1);
   ClrEOL;
   AT(1, Hi(WindMax) + 1,
      Center('F8 - SWITCH FILES ║ F9 - TRANSACTIONS ║ F10 - QUIT ║ ' +
      #27#24#25#26' - MOVE CURSOR', 80));
END;

PROCEDURE OpenFiles;

BEGIN
   Select(1);
   USE('CUSTOMER', @CUSTOMER, SizeOf(CUSTOMER));
   MakeIndex(@CustomerKey, 'CUSTOMER.IND');
   SET_INDEX_TO(@CustomerKey, 'CUSTOMER', 1);

   Select(2);
   USE('SAVINGS', @SAVINGS, SizeOf(SAVINGS));
   MakeIndex(@SavingsKey, 'SAVINGS.IND');
   SET_INDEX_TO(@SavingsKey, 'SAVINGS', 1);

   Select(3);
   USE('CHECKING', @CHECKING, SizeOf(CHECKING));
   MakeIndex(@CheckingKey, 'CHECKING.IND');
   SET_INDEX_TO(@CheckingKey, 'CHECKING', 1)
END;

BEGIN
   OpenFiles;

   Select(1);
   Done := FALSE;

   CurrentAccountFile := 1;

   {
      CurrentAccountFile = 1 (Savings),
                           2 (Checking)
   }

   Set_Relation_To(@RelateFiles);

   SET_FILTER_TO(@FilterFunction);

   {
      Set up the filter condition and later GoTop to find the first record
      meeting our ever so stringent criteria.
   }

   ClearScreen('▒');
   InitializeMainBrowse;

   WHILE (NOT Done) DO
      BEGIN
         GoTop;
         Browse('PLAIN')
      END;
   CloseDatabases
END.