CD Actual 14/CDACTUAL.iso/cdactual/demobin/share/program/Pascal/TVDMX.ZIP/SAMPLES.PAS

Pascal/Delphi Source File | 1993-03-31 | 25.8 KB | 868 lines

{■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■}
{                            }
{    SAMPLES   --Multi-window sample demo program    }
{    tvDMX     --data editing project (ver 2.x)    }
{                            }
{    Copyright (c) 1992,93   Randolph Beck        }
{                P.O. Box  56-0487    }
{                Orlando, FL 32856    }
{                CIS:  72361,753        }
{                            }
{■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■}

Program SAMPLES;

{ This program was written to demonstrate various data structures.  You can
  examine the field templates and copy some portions into WORKSHOP.PAS for
  your own experiments.

  The design of some of these record structures may seem pointless since
  they are intended only to demonstrate the interface mechanism.

  The "Account" window is the simplest example here.  It's somewhat bland,
  but most programmers will only require simple data structures like this.

  The "Payroll" window is a larger data window.  It demonstrates the 'Z'
  template code, which forces the display of leading zeroes in that field.
  Its last three fields are marked as READ-ONLY (with the ^R code).  These
  are entered automatically by the virtual methods in object TDmxPayroll,
  which overrides TDmxEditor.  Unlike "Accounts" and "Busy", this window is
  a regular TWindow type.

  The "Busy" window uses a more complex template string.  Note the heavy use
  of control codes, and that the last field in the main window is Read-Only.
  One of the integer fields is marked as a "skip" field (that means that the
  cursor will not land on it).

  The DateTime type is used here, with fldDATETIME, fldDATE, and fldTIME
  constants --as defined in the DMXGIZMA unit.  Its Year, Month and Day are
  swapped by codes in the fldDATETIME and fldDATE string to place it in its
  more familiar Month-Day-Year order.  An enumerated field is now used for
  the date portion, although its corresponding dialog box does not.


  Three other views are available from the menu:  "Hex" is a tvDMX-driven
  hex-byte editor using the same data as Busy window;  and "Dialog" is a
  dialog box that uses tvDMX descendants for individual field input, using
  the data in the current window at the current record.  A dialog window
  may also be actuated by double-clicking a record with a mouse.

  The data in most windows can be reported to file SAMPLES.OUT, using the
  objects in unit tvDMXREP.PAS.

  (See file TVDMXHEX.PAS for the code used in the hexadecimal byte editor.)
 }

{$V-,X+ }

uses
    Dos, { required to define DateTime type }
    Objects, Drivers, Views, Menus, Dialogs, App, MsgBox,
    RSet, DmxGizma, tvGizma, tvDMX, StdDMX, tvDmxHex, tvDmxRep;

const
    cmHasDialog   =  103;

    cmAccounts    =  111;
    cmPayroll     =  112;
    cmBusyWin     =  113;
    cmHexWin      =  114;
    cmDialog      =  116;
    cmRecDialog   =  117;
    cmPrint      =  118;

    cmNoCmd       = 1000;

    hcDeskTop      = 1100;
    hcAccounts      = 1100;
    hcPayroll      = 1200;
    hcBusyWin      = 1300;
    hcHexWin      = 1400;
    hcDialogs      = 4000;
    hcMenus      = 5000;

    hcReadOnly    = 1500;
    hcEnumField      = 1501;


      { Data presentation template for the "Accounts" window.
        The data structure is declared as "TAccount" in the TYPE section.
       }

    AccountLabel : string =
        ' Transaction          Debit        Credit      [?] ';

    AccountInfo  : string =
    ' SSSSSSSSSSSSSSSS`SSSSSSSSSS| rrr,rrr.zz  | rrr,rrr.zz  | [x] ';

      { Note that the '`' character marks the end of the visible field.
       }



      { Data presentation template for the "Payroll" window.
    The data structure is declared as "TPayroll" in the TYPE section.
    The last three fields are marked READ-ONLY, and are automatically
    entered by the virtual methods in object TDmxPayroll.
       }

    _PayrollLblA  = ' Employee                ID     Earnings       FICA        FITW        SITW   ';
    _PayrollInfo  = ' ssssssssssssssssssssss| ZZW ║ $rr,rrr.zz | $r,rrr.zz '^R'| $r,rrr.zz '^R'| $r,rrr.zz '^R;
    _PayrollLblB  = ' (dollar amounts are dependent upon Earnings)';

    PayrollLabelA :  string [length (_PayrollLblA)]  =  _PayrollLblA;
    PayrollInfo   :  string [length (_PayrollInfo)]  =  _PayrollInfo;
    PayrollLabelB :  string [length (_PayrollLblB)]  =  _PayrollLblB;



      { The Busy Window's template uses many of the special options.  Since
        it uses an enumerated field, the template was defined in the method
        that instantiates these windows.
       }

    _BusyLabel    =
    ' Name                  SSN             Balance      Start Date   Time   <A>  [B]   Pointer       Value     RO ';

    BusyLabel     :  string [length (_BusyLabel)] =  _BusyLabel;


    MaxRecordNum  =   49;


type
    PAccount      = ^TAccount;
    PPayroll      = ^TPayroll;
    PBusyData      = ^TBusyData;


    TAccount      =  RECORD
    Account    :  string [26];
    Debit    :  real;
    Credit    :  real;
    Status    :  boolean;
    end;


    TPayroll      =  RECORD
    Employee :  string [22];
    ID     :  word;
    Earnings :  real;
    FICA     :  real;  { READ-ONLY }
    FITW     :  real;  { READ-ONLY }
    SITW     :  real;  { READ-ONLY }
    end;


    TBusyData      =  RECORD
    Marker        :  byte;    { HIDDEN field }
    Name        :  string [30];
    SSN        :  string [9];
    realfield1    :  real;
    DT        :  datetime;
    intfield0    :  integer;    { READ-ONLY }
    intfield1    :  integer;
    ptrfield    :  pointer;
    realfield2    :  real;
    hextwo        :  byte;    { READ-ONLY }
    end;


    PDmxEditTbl       = ^TDmxEditTbl;
    PDmxEditTblWin = ^TDmxEditTblWin;


    TDmxEditTbl     =  OBJECT (TDmxEditor)
      function  GetHelpCtx : word;  VIRTUAL;
      procedure HandleEvent (var Event : TEvent);  VIRTUAL;
    end;


    TDmxEditTblWin  =  OBJECT (TDmxWindow)
      procedure InitDMX (ATemplate : string;  var AData;
             ALabels, ARecInd : PDmxLink;
             BSize  : longint);  VIRTUAL;
    end;


    PDmxPayroll    = ^TDmxPayroll;

    TDmxPayroll       =  OBJECT (TDmxEditTbl)
      procedure EvaluateField;  VIRTUAL;
      procedure ZeroizeField (Whole :boolean; Field :pDMXfieldrec);  VIRTUAL;
      procedure RecalcRecord;
    end;


    PMyStatusLine  = ^TMyStatusLine;
    TMyStatusLine  =  OBJECT (TStatusLine)
      function  Hint (AHelpCtx : word) : string;  VIRTUAL;
    end;


    TAppN       =  OBJECT (TAppPrn)  { from tvDMXREP.PAS }
    end;

    TMyApp       =  OBJECT (TAppN)
      constructor Init;
      procedure Idle;  VIRTUAL;
      procedure HandleEvent (var Event : TEvent);  VIRTUAL;
      procedure InitMenuBar;     VIRTUAL;
      procedure InitStatusLine;  VIRTUAL;
      procedure AccountWindow;
      procedure PayrollWindow;
      procedure BusyWindow;
      procedure HexWindow;
      procedure AccountDialog (P : PDmxEditTbl);
      procedure PayrollDialog (P : PDmxPayroll);
      procedure BusyDialog (P : PDmxEditTbl);
    end;


var
    Accounts    :  array [0..MaxRecordNum] of TAccount;
    Payroll    :  array [0..MaxRecordNum] of TPayroll;
    BusyData    :  array [0..MaxRecordNum] of TBusyData;


  procedure InitializeData;  forward;  { for the sample data }


  { ══ TMyStatusLine ═════════════════════════════════════════════════════ }


function  TMyStatusLine.Hint (AHelpCtx : word) : string;
begin
  Case AHelpCtx of
    hcDragging:  Hint := #24#25#26#27' Move  Shift-'#24#25#26#27' Resize  '#17#196#217' Done  Esc Cancel';
    hcReadOnly:  Hint := '(Read-Only field)';
    hcEnumField: Hint := '(Use "+" or "-")';
   else         Hint := '';
    end;
end;


  { ══ TDmxEditTbl ═══════════════════════════════════════════════════════ }


function  TDmxEditTbl.GetHelpCtx : word;
begin
  If (CurrentField^.typecode = fldENUM) then
    GetHelpCtx := hcEnumField
  else
  If (CurrentField^.access and accReadOnly <> 0) then
    GetHelpCtx := hcReadOnly
  else
    GetHelpCtx := hcNoContext;
end;


procedure TDmxEditTbl.HandleEvent (var Event : TEvent);
begin
  TDmxEditor.HandleEvent (Event);
  With Event do
    If (What = evCommand) then
      begin
      Case Command of
    cmDialog,cmDMX_DoubleClick:
      Message (Application, evCommand, cmRecDialog, @Self);
    cmHasDialog:
      begin end;  { just clear the event }
       else    Exit;
    end;
      ClearEvent (Event);
      end;
end;


  { ══ TDmxEditTblWin ════════════════════════════════════════════════════ }


procedure TDmxEditTblWin.InitDMX (ATemplate : string;  var AData;
                  ALabels, ARecInd : PDmxLink;
                  BSize  : longint);
{ To override TDmxEditor (as does object TDmxEditTbl above), you could
  override a TDmxWindow object to insert the new object.  This window
  type is used for the "Accounts" and "Busy" windows.  (The "Payroll"
  window uses a regular TWindow type.)
 }
var  R    : TRect;
begin
  GetExtent (R);
  R.Grow (-1,-1);
  If ALabels <> nil then Inc (R.A.Y, ALabels^.Size.Y);
  DMX := New (PDmxEditTbl, Init (ATemplate, AData, BSize, R,
        ALabels, ARecInd,
        StandardScrollBar (sbHorizontal+ sbHandleKeyboard),
        StandardScrollBar (sbVertical  + sbHandleKeyboard)));
  Insert (DMX);
end;


  { ══ TDmxPayroll ═══════════════════════════════════════════════════════ }


procedure TDmxPayroll.EvaluateField;
{ virtual method called after a field is edited...
  -- It updates the three READ-ONLY fields when field 3 is modified.
 }
begin
  TDmxEditTbl.EvaluateField;
  If (CurrentField^.fieldnum = 3) and FieldAltered then RecalcRecord;
end;


procedure TDmxPayroll.ZeroizeField (Whole : boolean; Field : pDMXfieldrec);
{ virtual method called to clear a field...
  -- The program will still operate properly without overriding this method,
     but the READ-ONLY fields would not react until the user changes fields.
 }
begin
  TDmxEditTbl.ZeroizeField (Whole, Field);
  If (Field^.fieldnum = 3) then RecalcRecord;
end;


procedure TDmxPayroll.RecalcRecord;
{ new method to follow up on changes }
begin
  With Payroll [CurrentRecord] do
    begin
    FICA  := Earnings * 0.075;
    FITW  := Earnings * 0.28;
    SITW  := Earnings * 0.05;
    end;
  RedrawRecord := TRUE;  { forces entire record to be redrawn }
end;


  { ══ TMyApp ════════════════════════════════════════════════════════════ }


constructor TMyApp.Init;
begin
  TAppN.Init;
  MenuBar^.HelpCtx := hcMenus;
  DeskTop^.HelpCtx := hcDeskTop;
  InitializeData;  { initialize the sample data }

  { Open the first 5 selections }
  AccountWindow;
  PayrollWindow;
  BusyWindow;
  HexWindow;

  DeskTop^.SelectNext (FALSE);  { change back to account window }

  MessageBox (^C'Sample Data Editors'^M^M^C'tvDMX (c) 1993  Randolph Beck',
        nil, mfInformation + mfOKButton);

end;


procedure TMyApp.Idle;
begin
  TAppN.Idle;
  If (Message (DeskTop, evCommand, cmHasDialog, @Self) <> nil) then
    EnableCommands ([cmDialog,cmPrint])
   else
    begin
    DisableCommands ([cmDialog]);
    If (Message (DeskTop, evCommand, cmDMX_RollCall, @Self) <> nil) then
      EnableCommands ([cmPrint])
     else
      DisableCommands ([cmPrint]);
    end;
end;


procedure TMyApp.HandleEvent (var Event : TEvent);

    procedure DoRecDialog;
    var  P : PDmxEditTbl;
    begin
      P := Event.InfoPtr;
      If (P <> nil) then
    begin
    If (P^.WorkingData = @Accounts) then AccountDialog (P)
    else
    If (P^.WorkingData = @Payroll)  then PayrollDialog (PDmxPayroll (P))
    else
    If (P^.WorkingData = @BusyData) then BusyDialog (P);
    end;
    end;

    procedure PrintingNewPage;
    var  S : string;
    begin
      S := PWindow (PDmxReport (Event.InfoPtr)^.DMX^.Owner)^.Title^;
      PDmxReport (Event.InfoPtr)^.PrintStr ('SAMPLES:  Data from ' + S);
      PDmxReport (Event.InfoPtr)^.NewLine;
      PDmxReport (Event.InfoPtr)^.NewLine;
    end;

begin
  TAppN.HandleEvent (Event);
  If (Event.What and evMessage <> 0) then
    begin
    Case Event.Command of
      cmAccounts:    AccountWindow;
      cmPayroll:    PayrollWindow;
      cmBusyWin:    BusyWindow;
      cmHexWin:        HexWindow;
      cmRecDialog:    DoRecDialog;
      cmChime:        Message (Application, evCommand, cmBeep, @Self);
      cmPrint:        PrnCurrentDMX;
      cmPRN_SetOptions:    PrnSetOptions (hcDialogs, hcDialogs, hcDialogs);
      cmPRN_NewPage:    PrintingNewPage;
      cmPRN_EndPage:    PrnPageEnd (Event);
     else
      Exit;
      end;
    If (Event.What = evCommand) then ClearEvent (Event);
    end;
end;


procedure TMyApp.InitMenuBar;
var  R: TRect;
begin
  GetExtent (R);
  R.B.Y := R.A.Y + 1;
  MenuBar := New (PMenuBar, Init (R, NewMenu (
    NewSubMenu ('~S~amples', hcMenus, NewMenu (
      NewItem ('~A~ccounts', '',    kbNoKey, cmAccounts,hcMenus,
      NewItem ('~P~ayroll',  '',    kbNoKey, cmPayroll, hcMenus,
      NewItem ('~B~usy',     'F4',  kbF4,    cmBusyWin, hcMenus,
      NewItem ('~H~ex',      '',    kbNoKey, cmHexWin,  hcMenus,
      NewLine (
      NewItem ('~D~ialog',   'F2',  kbF2,    cmDialog,  hcMenus,
      NewItem ('P~r~int',    'F9',  kbF9,    cmPrint,    hcMenus,
      NewLine (
      NewItem ('e~X~it',   'Alt-X', kbAltX,  cmQuit,    hcMenus,
      nil)))))))))),
    NewSubMenu ('~W~indow', hcMenus, NewMenu (
      NewItem ('~S~ize/Move', 'Ctrl-F5', kbCtrlF5, cmResize, hcMenus,
      NewItem ('~Z~oom',      'F5',  kbF5,    cmZoom,    hcMenus,
      NewItem ('~T~ile',      '',    kbNoKey, cmTile,    hcMenus,
      NewItem ('C~a~scade',   '',    kbNoKey, cmCascade, hcMenus,
      NewItem ('~N~ext',      'F6',  kbF6,    cmNext,    hcMenus,
      NewItem ('~P~revious',  'Shift-F6', kbShiftF6, cmPrev, hcMenus,
      NewItem ('~C~lose', 'Alt-F3',  kbAltF3, cmClose,   hcMenus,
      NewLine (
      NewItem ('~U~ser screen', 'Alt-F5',  kbAltF5, cmUserScreen, hcMenus,
      nil)))))))))),
    NewSubMenu ('~O~ptions', hcMenus, NewMenu (
      NewSoundItem (hcMenus,
      NewVideoItem (hcMenus,
      NewItem ('~P~rint options...','', kbNoKey, cmPRN_SetOptions, hcMenus,
      nil)))),
    nil)
  )))));
end;


procedure TMyApp.InitStatusLine;
var  R:    TRect;
begin
  GetExtent (R);
  R.A.Y := R.B.Y - 1;
  StatusLine := New (PMyStatusLine, Init (R,
    NewStatusDef (hcNoContext, hcDeskTop - 1,
      NewStatusKey ('tvDMX',        kbNoKey,cmNoCmd,
      nil),
    NewStatusDef (hcDeskTop, hcDialogs - 1,
      NewStatusKey ('tv~DMX~  ',    kbNoKey,cmNoCmd,
      NewStatusKey ('~F2~ Dialog',    kbF2,    cmDialog,
      NewStatusKey ('~F5~ Zoom',    kbF5,    cmZoom,
      NewStatusKey ('~F6~ Next',    kbF6,    cmNext,
      NewStatusKey ('~F9~ Print',    kbF9,    cmPrint,
      NewStatusKey ('~F10~ Menu',    kbF10,    cmMenu,
      nil)))))),
    NewStatusDef (hcDialogs, hcMenus - 1,
      NewStatusKey ('tvDMX',        kbNoKey,cmNoCmd,
      NewStatusKey ('~Esc~ Cancel',    kbEsc,    cmCancel,
      nil)),
    NewStatusDef (hcMenus, $FFFF,
      NewStatusKey ('tv~DMX~',        kbNoKey,cmNoCmd,
      nil),
    nil))))
  ));
end;


procedure TMyApp.AccountWindow;
var  R  : TRect;
     W  : PDmxWindow;
begin
  AssignWinRect (R, length (AccountLabel) + 2, 0);
  W := New (PDmxEditTblWin, Init (R,    { window rectangle }
        'Accounts',        { window title }
        wnNextAvail,        { window number }
        AccountInfo,        { template string }
        Accounts,        { data records }
        sizeof (Accounts),    { data size }
        AccountLabel,        { heading label }
        7));            { indicator width }
  W^.HelpCtx := hcAccounts;
  DeskTop^.Insert (ValidView (W));
end;


procedure TMyApp.PayrollWindow;
var  R     : TRect;
     DMX : PDmxPayroll;
     W     : PWindow;
begin
  AssignWinRect (R, length (PayrollLabelA) + 2, 0);
  New (W, Init (R, 'Payroll', wnNextAvail));
  With W^ do
    begin
    Options := Options or ofTileable;
    HelpCtx := hcPayroll;
    GetExtent (R);
    R.Grow (-1,-3);        { adjust R for border and labels }
    New (DMX, Init (PayrollInfo,    { template string }
        Payroll,        { data records }
        sizeof (Payroll),    { data size }
        R,            { view rectangle }
        New (PDmxLabels, InitInsert (W, @PayrollLabelA)),
        New (PDmxRecInd, InitInsert (W, 7)),
        StandardScrollBar (sbHandleKeyboard or sbHorizontal),
        StandardScrollBar (sbHandleKeyboard or sbVertical))
     );
    Insert (DMX);
    R.Assign (1, Size.Y - 3, pred(Size.X), Size.Y - 1);
    Insert (New (PDmxLabels, Init (@PayrollLabelB, R)));
    end;
  DeskTop^.Insert (ValidView (W));
end;


procedure TMyApp.BusyWindow;
var  R  : TRect;
     W  : PDmxWindow;
     BusyInfo : string;

    function  fldEnumDATE : string;
    begin
      fldEnumDATE :=  ^F + ^P+char(2) +
    InitEnumField (TRUE, 0,0,
        NewSItem ('  0?-',
        NewSItem (' Jan-',
        NewSItem (' Feb-',
        NewSItem (' Mar-',
        NewSItem (' Apr-',
        NewSItem (' May-',
        NewSItem (' Jun-',
        NewSItem (' Jul-',
        NewSItem (' Aug-',
        NewSItem (' Sep-',
        NewSItem (' Oct-',
        NewSItem (' Nov-',
        NewSItem (' Dec-',
        NewSItem (' ERR-',
        nil))))))))))))))
    ) + ^H'B' +  { hide the upper byte of the month's field }
    #0'ZW-'^Z + ^U+char(31) +
    #0'ZZZW '^Z^F + ^P+char(-6) +
    #0 + ^P+char(4);
    end;

begin
  BusyInfo    := 'B' + ^H        { hidden byte field }
         + #0' ssssssssssssssssssss`ssssssssss'  { Name field }
         + '| ###-##-#### '    { string of numerics only }
         + '|($rrr,rrr.zz)'    { positive or negative currency }

        { DateTime type: }
         + '|' + fldEnumDATE
         + #0  + fldTIME    { constant defined in DMXGIZMA.PAS }

                 + '|iii ' + ^Z^R^S    { showzeroes/readonly/skip }
         + '\iii '        { normal integer }
         + '| HHHH:HHHH '    { hex longint value }
         + '|RRR,RRR.RRR '    { positive values only }
         + '| hh ' + ^Z^R;    { showzeroes/readonly field }

  AssignWinRect (R, length (BusyLabel) + 2, 0);
  W := New (PDmxEditTblWin, Init (R,    { window rectangle }
        'Busy Window',        { window title }
        wnNextAvail,        { window number }
        BusyInfo,        { template string }
        BusyData,        { data records }
        sizeof (BusyData),    { data size }
        BusyLabel,        { heading label }
        10));            { indicator width }
  W^.HelpCtx := hcBusyWin;
  DeskTop^.Insert (ValidView (W));
end;


procedure TMyApp.HexWindow;
{ uses objects in file tvDMXHEX.PAS }
var  R  : TRect;
     W  : PDmxWindow;
begin
  AssignWinRect (R, length (HexLabels) + 2, 0);
  W := New (PDmxHexWin, Init (R, 'Hex Window', wnNextAvail,
                  BusyData, sizeof (BusyData)));
  W^.HelpCtx := hcHexWin;
  DeskTop^.Insert (ValidView (W));
end;


procedure TMyApp.AccountDialog (P : PDmxEditTbl);
var  R       : TRect;
     Dialog  : PDialog;
     B       : PButton;
     A       : string;
     Control : word;
begin
  Str (succ (P^.CurrentRecord), A);
  DeskTop^.GetExtent (R);
  Dialog := New (PDialog, Init (R, 'Account Record #' + A));
  If (Dialog <> nil) then
    begin
    With Dialog^ do
      begin
      HelpCtx  := hcDialogs;
      InsertField (Dialog, 5,2, TRUE,  ' ~T~ransaction', ' SSSSSSSSSSSSSSSSSSSSSSSSSS');
      InsertField (Dialog, 2,5, TRUE,  '    ~D~ebit        Credit', ' rrr,rrr.zz  \ rrr,rrr.zz  ');
      InsertField (Dialog, 6,8, FALSE, '~S~tatus: ', '~[Cleared]~'^X);
      R.Assign (0, 10, 10, 12);
      B := New (PButton, Init (R, 'O~K~', cmOK, bfDefault));
      B^.Options := B^.Options or ofCenterX;
      Insert (B);
      SelectNext (FALSE);
      SetData (Accounts [P^.CurrentRecord]);
      end;
    TrimDialog (Dialog);
    Control := DeskTop^.ExecView (Dialog);
    If (Control = cmOK) then
      begin
      { return record to table }
      Dialog^.GetData (Accounts [P^.CurrentRecord]);
      { redraw all windows that use Accounts }
      Message (DeskTop, evBroadcast, cmDMX_DrawData, @Accounts);
      end;
    Dispose (Dialog, Done);
    end;
end;


procedure TMyApp.PayrollDialog (P : PDmxPayroll);
var  R       : TRect;
     Dialog  : PDialog;
     B       : PButton;
     A       : string;
     Control : word;
begin
  Str (succ (P^.CurrentRecord), A);
  DeskTop^.GetExtent (R);
  Dialog := New (PDialog, Init (R, 'Employee Record #' + A));
  If (Dialog <> nil) then
    begin
    With Dialog^ do
      begin
      HelpCtx  := hcDialogs;
      InsertField (Dialog, 2,2, FALSE, '~N~ame: ', ' ssssssssssssssssssssss');
      InsertField (Dialog, 2,4, FALSE, '~I~D Number: ', ' ZZW ');
      InsertField (Dialog, 2,6, FALSE, '~E~arnings: ', ' $rr,rrr.zz ');
      InsertField (Dialog, 0,0, FALSE, '', 'r'^H#0'r'^H#0'r'^H)^.Hide;
      R.Assign (0, 8, 10, 10);
      B := New (PButton, Init (R, 'O~K~', cmOK, bfDefault));
      B^.Options := B^.Options or ofCenterX;
      Insert (B);
      SelectNext (FALSE);
      SetData (Payroll [P^.CurrentRecord]);
      end;
    TrimDialog (Dialog);
    Control := DeskTop^.ExecView (Dialog);
    If (Control = cmOK) then
      begin
      { return record to table }
      Dialog^.GetData (Payroll [P^.CurrentRecord]);
      P^.RecalcRecord;
      { redraw all windows that use Payroll }
      Message (DeskTop, evBroadcast, cmDMX_DrawData, @Payroll);
      end;
    Dispose (Dialog, Done);
    end;
end;


procedure TMyApp.BusyDialog (P : PDmxEditTbl);
var  R       : TRect;
     Dialog  : PDialog;
     B       : PButton;
     A       : string;
     Control : word;
begin
  Str (succ (P^.CurrentRecord), A);
  DeskTop^.GetExtent (R);
  Dialog := New (PDialog, Init (R, 'Busy Record #' + A));
  If (Dialog <> nil) then
    begin
    With Dialog^ do
      begin
      HelpCtx  := hcDialogs;

      { The Read-Only and Hidden fields are also inserted into this view
    so that the entire BusyInfo record structure is transferable.
    They can be hidden using TView^.Hide() because InsertField() is
    a function that returns a PView pointer --as demonstrated in the
    following instance...
       }
      InsertField (Dialog, 0,  0, FALSE, '',  'B')^.Hide;
      InsertField (Dialog, 2,  2, FALSE, '~N~ame:    ',  ' ssssssssssssssssssssssssssssss');
      InsertField (Dialog, 2,  4, FALSE, '~S~SN:     ',  ' ###-##-#### ');
      InsertField (Dialog, 2,  6, FALSE, '~B~alance: ',  '($rrr,rrr.zz)');
      InsertField (Dialog,11,  8, TRUE,  '  ~D~ate         Time', fldDATETIME);
      InsertField (Dialog, 0,  0, FALSE, '',  'i')^.Hide;
      InsertField (Dialog, 2, 11, FALSE, '~I~nteger: ',  'iii');
      InsertField (Dialog, 2, 13, FALSE, '~P~ointer: ',  ' HHHH:HHHH ');
      InsertField (Dialog, 2, 14, FALSE, '~V~alue:   ',  'RRR,RRR.ZZRR ~pts~ ');
      InsertField (Dialog, 0,  0, FALSE, '',  'B')^.Hide;

      R.Assign (0, 16, 10, 18);
      B := New (PButton, Init (R, 'O~K~', cmOK, bfDefault));
      B^.Options := B^.Options or ofCenterX;
      Insert (B);
      SelectNext (FALSE);
      SetData (BusyData [P^.CurrentRecord]);
      end;

    TrimDialog (Dialog);
    Control := DeskTop^.ExecView (Dialog);
    If (Control = cmOK) then
      begin
      { return record to table }
      Dialog^.GetData (BusyData [P^.CurrentRecord]);
      { redraw all windows that use BusyData }
      Message (DeskTop, evBroadcast, cmDMX_DrawData, @BusyData);
      end;
    Dispose (Dialog, Done);
    end;
end;


  { ══════════════════════════════════════════════════════════════════════ }


procedure InitializeData;
{ creates test data }
var  i,j  : integer;

    procedure InitAccount (ARecNum : integer;  AName : string);
    begin
      With Accounts [ARecNum] do
    begin
    Account    := AName;
    Debit    := Random (50000) * 0.9;
    Credit    := Random (50000) * 0.9;
    Status    := (Credit > Debit);
    end;
    end;

    procedure InitBusyRec (ARecNum : integer;  AName : string);
    var  i : integer;
    begin
      With BusyData [ARecNum] do
    begin
    Name    := AName;
    intfield0  := ARecNum;
    hextwo     := lo (ARecNum);
    If ARecNum < 26 then
      begin
      intfield1    := random (255);
      ptrfield    := pointer (random (MaxInt));
      realfield1    := random (200) * random (200) / succ (random (199));
      realfield2    := random (200) * random (200) / succ (random (199));
      DT.Year    := 1988 + random (4);
      DT.Month    := succ (random (12));
      DT.Day    := succ (random (28));
      DT.Hour    := random (24);
      DT.Min    := random (60);
      DT.Sec    := random (60);
      SSN [0]    := #9;
      For i := 1 to 9 do SSN [i] := chr (random (10) + 48);
      end;
    end;
    end;

    procedure InitPayroll (ARecNum : integer;  AName : string);
    begin
      With Payroll [ARecNum] do
    begin
    Employee :=  AName;
    If (ARecNum = 0) then ID := 44 else ID := Random (400);
    Earnings :=  Random (3000) + 4000.0;
    FICA     :=  Earnings * 0.075;
    FITW     :=  Earnings * 0.28;
    SITW     :=  Earnings * 0.05;
    end;
    end;

begin
  RandSeed := 31;
  fillchar (Accounts,  sizeof (Accounts),  0);
  fillchar (Payroll,   sizeof (Payroll),   0);
  fillchar (BusyData,  sizeof (BusyData),  0);

  InitAccount ( 0, 'ACME TOOL CO.');
  InitAccount ( 1, 'READING R. R.');
  InitAccount ( 2, 'EXXON CORP.');
  InitAccount ( 3, 'ELECTRIC CO.');
  InitAccount ( 4, 'B&O R. R.');
  InitAccount ( 5, 'NYNEX');

  InitBusyRec ( 0, 'Abigail Adams');
  InitBusyRec ( 1, 'Betty Boop');
  InitBusyRec ( 2, 'Cindy Crawford');
  InitBusyRec ( 3, 'Dana Delaney');
  InitBusyRec ( 4, 'Eve Easton');
  InitBusyRec ( 5, 'Farrah Fawcett');
  InitBusyRec ( 6, 'Ginger Grant');
  InitBusyRec ( 7, 'Holly Hunter');
  InitBusyRec ( 8, 'Ida Inman');
  InitBusyRec ( 9, 'Janet Jackson');
  InitBusyRec (10, 'Katie Kingfield');
  InitBusyRec (11, 'Lois Lane');
  InitBusyRec (12, 'Marilyn Monroe');
  InitBusyRec (13, 'Nichelle Nichols');
  InitBusyRec (14, 'Olive Oyl');
  InitBusyRec (15, 'Paula Prentiss');
  InitBusyRec (16, 'Quia Quinn');
  InitBusyRec (17, 'Rita Rudner');
  InitBusyRec (18, 'Samantha Stevens');
  InitBusyRec (19, 'Tina Turner');
  InitBusyRec (20, 'Ute Ueberroth');
  InitBusyRec (21, 'Vicky Vail');
  InitBusyRec (22, 'Wendy Wilson');
  InitBusyRec (23, 'Xuxa');
  InitBusyRec (24, 'Yara Yokomuro');
  InitBusyRec (25, 'Zelda Zimmerman');

  For i := 26 to MaxRecordNum do InitBusyRec (i, '');
  BusyData [0].SSN  := '';

  InitPayroll ( 0, 'Alex Trebek');
  InitPayroll ( 1, 'Pat Sajak');
  InitPayroll ( 2, 'Vanna White');
  InitPayroll ( 3, 'Merv Griffin');
end;


  { ══════════════════════════════════════════════════════════════════════ }

var  MyApp  : TMyApp;

Begin
  PrnOpt.Len  := 55;  { change from default value set in tvDMXREP.PAS }
  MyApp.Init;
  MyApp.Run;
  MyApp.Done;
End.