home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 14 / CDACTUAL.iso / cdactual / demobin / share / program / Pascal / TVDMX.ZIP / FORMSHOP.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-04-02  |  21.5 KB  |  673 lines
  1.  
  2. {■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■}
  3. {                            }
  4. {    FORMSHOP  --Record Form Editing Demo        }
  5. {    tvDMX     --data editing project        }
  6. {                            }
  7. {    Copyright (c) 1993  Randolph Beck        }
  8. {                P.O. Box  56-0487        }
  9. {                Orlando, FL 32856        }
  10. {                CIS:  72361,753        }
  11. {                            }
  12. {■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■}
  13.  
  14. Program FORMSHOP;
  15.  
  16. {$M 16384,16384,655360}
  17. {$V-,X+,D+,B-,R- }
  18.  
  19. uses
  20.     Objects, Drivers, Views, Dialogs, Menus, App, MsgBox,
  21.     RSet, DmxGizma, tvDMX, tvGizma, DmxForms, tvDmxRep;
  22.  
  23. const                       
  24.     cmEditWin    =  101;
  25.     cmEditDlg    =  102;
  26.     cmRegForm    =  103;
  27.     cmPrint    =  104;
  28.  
  29.     hcDeskTop    = hcDragging + 1;
  30.     hcDialogs    = $4000;
  31.     hcMenus    = $8000;
  32.  
  33.     hcPrnOptions = hcDialogs + 100;
  34.     hcOKPrint     = hcPrnOptions + 10;
  35.     hcCanxPrint     = hcPrnOptions + 11;
  36.  
  37.     { help-context modifiers }
  38.     hcEnumField    = 1;
  39.     hcReadOnly    = 2;
  40.  
  41. type
  42.     PResponseRec    = ^TResponseRec;
  43.     TResponseRec    =  RECORD
  44.     Name,Co,Addr    : string [42];
  45.     City        : string [16];
  46.     State        : string [12];
  47.     Zip,Country    : string [16];
  48.     Years,Months    : word;
  49.     TPBP        : byte;
  50.     TPversion    : TREALNUM;
  51.     AnsiView,Blaise    : boolean;
  52.     BlaiseProd    : string [40];
  53.     OWL,Btrieve,PXE    : boolean;
  54.     PXEver        : TREALNUM;
  55.     DBFW        : boolean;
  56.     DBFWver        : TREALNUM;
  57.     Topaz,TPower    : boolean;
  58.     TPowerProd    : string [36];
  59.     Others        : array [0..4] of string [48];
  60.     end;
  61.  
  62.  
  63.     PDmxRecView      = ^TDmxRecView;
  64.     PDmxRecDlg      = ^TDmxRecDlg;
  65.     PDmxPrgrInfo  = ^TDmxPrgrInfo;
  66.  
  67.     TDmxRecView      =  OBJECT (TDmxForm)
  68.       procedure FieldText (var S : string;  var Color : word;
  69.                Field : pDMXfieldrec;  var DataRec );  VIRTUAL;
  70.       function  GetHelpCtx : word;  VIRTUAL;
  71.     end;
  72.  
  73.     TDmxRecDlg      =  OBJECT (TDmxDlgForm)
  74.       function  GetHelpCtx : word;  VIRTUAL;
  75.     end;
  76.  
  77.     TDmxPrgrInfo  =  OBJECT (TDmxRecView)
  78.       procedure HandleEvent (var Event : TEvent);  VIRTUAL;
  79.     end;
  80.  
  81.  
  82.     PMyStatusLine  = ^TMyStatusLine;
  83.     TMyStatusLine  =  OBJECT (TStatusLine)
  84.       function  Hint (AHelpCtx : word) : string;  VIRTUAL;
  85.     end;
  86.  
  87.  
  88.     TAppN    =  OBJECT (TAppPrn)
  89.     end;
  90.  
  91.     TMyApp    =  OBJECT (TAppN)
  92.       constructor Init;
  93.       procedure HandleEvent (var Event : TEvent);  VIRTUAL;
  94.       procedure InitMenuBar;  VIRTUAL;
  95.       procedure InitStatusLine;  VIRTUAL;
  96.       procedure EditRecord;
  97.       procedure EditDialog;
  98.       procedure RegistrationForm;
  99.     end;
  100.  
  101.  
  102. var
  103.     MainData    : array [0..2047] of byte;  { untyped data for form }
  104.     PrgrInfo    : TResponseRec;            { registration form }
  105.  
  106.  
  107.   { ══════════════════════════════════════════════════════════════════════ }
  108.  
  109.  
  110. function  HelpCtxNum (P : PDmxEditor) : word;
  111. begin
  112.   With P^ do
  113.     begin
  114.     If (State and sfDragging <> 0) then
  115.       HelpCtxNum := hcDragging
  116.     else
  117.     If (CurrentField^.access and accReadOnly <> 0) then
  118.       HelpCtxNum := HelpCtx + hcReadOnly
  119.     else
  120.     If (CurrentField^.typecode = fldENUM) then
  121.       HelpCtxNum := HelpCtx + hcEnumField
  122.     else
  123.       HelpCtxNum := HelpCtx;
  124.     end;
  125. end;
  126.  
  127.  
  128. procedure TDmxRecView.FieldText (var S : string; var Color : word;
  129.                  Field : pDMXfieldrec;  var DataRec );
  130. var  i : integer;
  131.      P : pchar;
  132. begin
  133.   If (upcase (Field^.typecode) in ['S','#','C','0']) and (Field^.fieldsize > 0) then
  134.     begin
  135.     P := @DataRec;
  136.     Inc (PtrRec (P).Ofs, Field^.datatab);
  137.     If (P^ = #0) or (Color > $3F) then For i := 1 to length (S) do
  138.       If (S [i] = ' ') and (Field^.template^[i] = #0) then S [i] := '_';
  139.     end;
  140. end;
  141.  
  142.  
  143. function  TDmxRecView.GetHelpCtx : word;
  144. begin
  145.   GetHelpCtx := HelpCtxNum (@Self);
  146. end;
  147.  
  148.  
  149. function  TDmxRecDlg.GetHelpCtx : word;
  150. begin
  151.   GetHelpCtx := HelpCtxNum (@Self);
  152. end;
  153.  
  154.  
  155.   { ══ TDmxPrgrInfo ══════════════════════════════════════════════════════ }
  156.  
  157.  
  158. procedure TDmxPrgrInfo.HandleEvent (var Event : TEvent);
  159. const Lines    : integer = 0;
  160. begin
  161.   { The first section of this code adjusts the action of the kbEnter key
  162.     for BOOLEAN fields with a accSpecA attribute.
  163.     (accSpecA is a programmer-defined code.)
  164.    }
  165.   With Event do
  166.     If (What = evCommand) and (Command = cmDMX_Enter) and
  167.        (CurrentField <> nil) and (CurrentField^.access and accSpecA <> 0) and
  168.        not Boolean (FieldData^)
  169.      then
  170.       Command := cmDMX_Down;
  171.  
  172.   TDmxRecView.HandleEvent (Event);
  173.  
  174.   { The remainder of this method modifies the print/output procedure to
  175.     leave several blank lines at the bottom of the page.  Note that the
  176.     cmPrint command is intercepted, and handled here instead of by the
  177.     main application view.
  178.    }
  179.   If (Event.What = evCommand) then
  180.     begin
  181.     If (Event.Command = cmPrint) then
  182.       begin
  183.       If (PrnSetOptions (hcPrnOptions,hcOKPrint,hcCanxPrint) = cmOK) then
  184.     If (PrnOpt.Len < 41) then
  185.       MessageBox ('Page length is too short.', nil, mfError or mfOKButton)
  186.      else
  187.       begin
  188.       Lines := PrnOpt.Len;
  189.       PrnOpt.Len := 41;
  190.       PrnCurrentDMX;
  191.       PrnOpt.Len := Lines;
  192.       end;
  193.       ClearEvent (Event);
  194.       end
  195.     else
  196.     If (Event.Command = cmPRN_EndPage) then
  197.       begin
  198.       With PDmxReport (Event.InfoPtr)^ do
  199.     begin
  200.     PrintLn ('');
  201.     PrintLn ('  Add any additional questions or comments...');
  202.     While (CurrentLine < Lines) do PrintLn ('');
  203.     end;
  204.       ClearEvent (Event);
  205.       end;
  206.     end;
  207. end;
  208.  
  209.  
  210.   { ══ TMyStatusLine ═════════════════════════════════════════════════════ }
  211.  
  212.  
  213. function  TMyStatusLine.Hint (AHelpCtx : word) : string;
  214. begin
  215.   Case AHelpCtx of
  216.     hcDragging:  Hint := #24#25#26#27' Move  Shift-'#24#25#26#27' Resize  '#17#196#217' Done  Esc Cancel';
  217.     hcReadOnly  + hcDesktop,
  218.     hcReadOnly  + hcDialogs:    Hint := '(Read-Only field)';
  219.     hcEnumField + hcDesktop,
  220.     hcEnumField + hcDialogs:    Hint := '(Use "+" or "-")';
  221.     hcPrnOptions:        Hint := 'Send output to printer';
  222.     hcPrnOptions+1:        Hint := 'Send output to file (press <Tab> to enter filename)';
  223.     hcPrnOptions+2:        Hint := 'Enter output file name';
  224.     hcPrnOptions+3:        Hint := 'Output unfiltered text';
  225.     hcPrnOptions+4:        Hint := 'Print record or line numbers';
  226.     hcPrnOptions+5:        Hint := 'LF code follows carriage return';
  227.     hcPrnOptions+6:        Hint := 'Wait before each new page';
  228.     hcPrnOptions+7:        Hint := 'Enter page length';
  229.     hcPrnOptions+8:        Hint := 'Enter page width';
  230.     hcOKPrint:            Hint := 'Accept these settings and start printing';
  231.     hcCanxPrint:        Hint := 'Close this dialog box and cancel print';
  232.    else                Hint := '';
  233.     end;
  234. end;
  235.  
  236.  
  237.   { ══ TMyApp ════════════════════════════════════════════════════════════ }
  238.  
  239.  
  240. constructor TMyApp.Init;
  241. begin
  242.   TAppN.Init;
  243.   MenuBar^.HelpCtx := hcMenus;
  244.   DeskTop^.HelpCtx := hcDeskTop;
  245. end;
  246.  
  247.  
  248. procedure TMyApp.HandleEvent (var Event : TEvent);
  249. begin
  250.   TAppN.HandleEvent (Event);
  251.   If Event.What = evCommand then
  252.     begin
  253.     Case Event.Command of
  254.       cmEditWin:    EditRecord;
  255.       cmEditDlg:    EditDialog;
  256.       cmRegForm:    RegistrationForm;
  257.       cmPrint:        PrnCurrentDMX;
  258.       cmPRN_SetOptions:    PrnSetOptions (hcPrnOptions,hcDialogs,hcDialogs);
  259.       cmPRN_NewPage:    PrnPageStart (Event);
  260.       cmPRN_EndPage:    PrnPageEnd (Event);
  261.      else        Exit;
  262.       end;
  263.     ClearEvent (Event);
  264.     end;
  265. end;
  266.  
  267.  
  268. procedure TMyApp.InitMenuBar;
  269. var  R : TRect;
  270. begin
  271.   GetExtent (R);
  272.   R.B.Y := R.A.Y + 1;
  273.   MenuBar := New (PMenuBar, Init (R, NewMenu (
  274.     NewSubMenu ('tv~DMX~', hcNoContext, NewMenu (
  275.       NewItem ('~O~pen',    'F3',   kbF3,   cmEditWin,    hcNoContext,
  276.       NewItem ('~D~ialog',  'F2',   kbF2,   cmEditDlg,    hcNoContext,
  277.       NewItem ('~R~eg form','F4',   kbF4,   cmRegForm,    hcNoContext,
  278.       NewLine (
  279.       NewSoundItem (hcNoContext,
  280.       NewVideoItem (hcNoContext,
  281.       NewLine (
  282.       NewItem ('e~X~it',  'Alt-X',  kbAltX,   cmQuit,    hcNoContext,
  283.       nil))))))))),
  284.     NewSubMenu ('~W~indow', hcNoContext, NewMenu (
  285.       NewItem ('~S~ize/Move', 'Ctrl-F5', kbCtrlF5, cmResize, hcNoContext,
  286.       NewItem ('~Z~oom',      'F5',  kbF5,    cmZoom,    hcNoContext,
  287.       NewItem ('~T~ile',      '',    kbNoKey, cmTile,    hcNoContext,
  288.       NewItem ('C~a~scade',   '',    kbNoKey, cmCascade, hcNoContext,
  289.       NewItem ('~N~ext',      'F6',  kbF6,    cmNext,    hcNoContext,
  290.       NewItem ('~P~revious', 'Shift-F6', kbShiftF6, cmPrev, hcNoContext,
  291.       NewItem ('~C~lose', 'Alt-F3',  kbAltF3, cmClose,   hcNoContext,
  292.       nil)))))))),
  293.     NewSubMenu ('~P~rint', hcNoContext, NewMenu (
  294.       NewItem ('~P~rint',  'F9',   kbF9,   cmPrint,    hcNoContext,
  295.       StdPrnMenuItems (hcNoContext,
  296.       nil))),
  297.     nil))))
  298.   ));
  299. end;
  300.  
  301.  
  302. procedure TMyApp.InitStatusLine;
  303. var  R: TRect;
  304. begin
  305.   GetExtent (R);
  306.   R.A.Y := R.B.Y - 1;
  307.   StatusLine := New (PMyStatusLine, Init (R,
  308.     NewStatusDef (hcNoContext, hcDragging,
  309.       NewStatusKey ('tvDMX', kbNoKey, cmMenu,
  310.       nil),
  311.     NewStatusDef (hcDeskTop, hcDialogs - 1,
  312.       NewStatusKey ('tv~DMX~  ',      kbNoKey, cmMenu,
  313.       NewStatusKey ('~F2~ Dialog',    kbF2,    cmEditDlg,
  314.       NewStatusKey ('~F5~ Zoom',      kbF5,    cmZoom,
  315.       NewStatusKey ('~F6~ Next',      kbF6,    cmNext,
  316.       NewStatusKey ('~F9~ Print',     kbF9,    cmPrint,
  317.       NewStatusKey ('~F10~ Menu',     kbF10,   cmMenu,
  318.       nil)))))),
  319.     NewStatusDef (hcDialogs, hcMenus - 1,
  320.       NewStatusKey ('tvDMX',          kbNoKey, cmMenu,
  321.       NewStatusKey ('~Esc~ Cancel',   kbEsc,   cmCancel,
  322.       nil)),
  323.     NewStatusDef (hcMenus, $FFFF,
  324.       NewStatusKey ('tv~DMX~  ',      kbNoKey, cmMenu,
  325.       nil),
  326.     nil))))
  327.   ));
  328. end;
  329.  
  330.  
  331. procedure TMyApp.EditRecord;
  332. { The labels are enclosed by tilde ('~') symbols, and
  333.   the '\' delimiter is used to separate text from literals. }
  334. var  R  : TRect;
  335.      A  : string;
  336.      W  : PWindow;
  337.      DMX  : PDmxRecView;
  338.      TT,Templates : PSItem;
  339.  
  340.     function  BlankYesNo : DmxIDstr;
  341.     begin
  342.       BlankYesNo := InitEnumField (TRUE, accNormal, 0,
  343.     NewSItem (' ???',
  344.     NewSItem (' Yes ',
  345.     NewSItem (' No',
  346.         nil))));
  347.     end;
  348.  
  349.     function  SavingsNowOrChecking : DmxIDstr;
  350.     begin
  351.       SavingsNowOrChecking := InitEnumField (TRUE, accNormal, 0,
  352.     NewSItem (' ???',
  353.     NewSItem (' Savings',
  354.     NewSItem (' NOW',
  355.     NewSItem (' Checking ',
  356.         nil)))));
  357.     end;
  358.  
  359.     function  PersonalInfo (ANext : PSItem) : PSItem;
  360.     begin
  361.       PersonalInfo :=
  362.     NewSItem (^A'~ PERSONAL INFORMATION~',
  363.     NewSItem ('~ ════════════════════~',
  364.     NewSItem ('',
  365.     NewSItem ('~ First Name        Middle            Last~',
  366.     NewSItem ( ' SSSSSSSSSSSSSSSS\ SSSSSSSSSSSSSSSS\ SSSSSSSSSSSSSSSSSSSS',
  367.     NewSItem ('',
  368.     NewSItem ('~ Home Address          City                 State  Zip code~',
  369.     NewSItem ( ' SSSSSSSSSSSSSSSSSSSS\ SSSSSSSSSSSSSSSSSSSS\SS\   \##### ####',
  370.     NewSItem ('~ Previous Address      City                 State  Zip code~',
  371.     NewSItem ( ' SSSSSSSSSSSSSSSSSSSS\ SSSSSSSSSSSSSSSSSSSS\SS\   \##### ####',
  372.     NewSItem ('',
  373.     NewSItem ('',
  374.     NewSItem ('~ Telephone  Home:~\(###) ###-####\~  Business:~\(###) ###-####',
  375.     NewSItem ('~ Social Security Number:~ \###-##-####\~  Date of Birth:~\' + fldDATE,
  376.     NewSItem ('~ Dependents:~\WW \~  U.S. Citizen:~' + BlankYesNo + '~  Resident:~' + BlankYesNo,
  377.         ANext)))))))))))))));
  378.     end;
  379.  
  380.     function  EmploymentInfo (ANext : PSItem) : PSItem;
  381.     begin
  382.       EmploymentInfo :=
  383.     NewSItem ('~ EMPLOYMENT INFORMATION~',
  384.     NewSItem ('~ ══════════════════════~',
  385.     NewSItem ('',
  386.     NewSItem ('~ Employer                            How long?~',
  387.     NewSItem ( ' SSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSS\WW '#0'~years  ~\WW '^U#11#0'~months~',
  388.     NewSItem ('~ Address               City                 State  Zip code~',
  389.     NewSItem ( ' SSSSSSSSSSSSSSSSSSSS\ SSSSSSSSSSSSSSSSSSSS\SS\   \##### ####',
  390.     NewSItem ('',
  391.     NewSItem ('~ Occupation:~\ SSSSSSSSSSSSSSSS\~   Annual gross salary:~\($r,rrr,rrr)',
  392.     NewSItem ('~ Other income:~\($r,rrr,rrr)\~   Source:~\SSSSSSSSSSSSSSSSSSSS',
  393.     NewSItem ('',
  394.     NewSItem ('~ Former Employer                     How long?~',
  395.     NewSItem ( ' SSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSS\WW '#0'~years  ~\WW '#0'~months~',
  396.     NewSItem ('~ Address               City                 State  Zip code~',
  397.     NewSItem ( ' SSSSSSSSSSSSSSSSSSSS\ SSSSSSSSSSSSSSSSSSSS\SS\   \##### ####',
  398.         ANext)))))))))))))));
  399.     end;
  400.  
  401.     function  FinancialInfo (ANext : PSItem) : PSItem;
  402.     begin
  403.       FinancialInfo :=
  404.     NewSItem ('~ FINANCIAL INFORMATION~',
  405.     NewSItem ('~ ═════════════════════~',
  406.     NewSItem ('',
  407.     NewSItem ('~ Credit Card     Account Number       Credit Card     Account Number~',
  408.     NewSItem ( ' SSSSSSSSSSSSSS\\####-####-####-####\ SSSSSSSSSSSSSS\\####-####-####-####',
  409.     NewSItem ('~ Other Credit             Account Number~',
  410.     NewSItem ( ' SSSSSSSSSSSSSSSSSSSSSSSS\SSSSSSSSSSSSSSSSSSSSSSSS',
  411.     NewSItem ('~ Bank/Financial Institution    City             Acc Number    Type~',
  412.     NewSItem ( ' SSSSSSSSSSSSSSSSSSSSSSSSSSSS\ SSSSSSSSSSSSSSSS\SSSSSSSSSSSS\' + SavingsNowOrChecking,
  413.     NewSItem ( ' SSSSSSSSSSSSSSSSSSSSSSSSSSSS\ SSSSSSSSSSSSSSSS\SSSSSSSSSSSS\' + SavingsNowOrChecking,
  414.     NewSItem ('',
  415.     NewSItem ('~ Check if you have any of the following:~',
  416.     NewSItem ('~ IRA: ~'#0'[X]\~ CD: ~'#0'[X]\~ Money Mkt Acc: ~'#0'[X]\~ Stocks/Bonds: ~'#0'[X]',
  417.         ANext)))))))))))));
  418.     end;
  419.  
  420.     function  JointAccountInfo (ANext : PSItem) : PSItem;
  421.     begin
  422.       JointAccountInfo :=
  423.     NewSItem ('~ JOINT ACCOUNT INFORMATION~',
  424.     NewSItem ('~ ═════════════════════════~',
  425.     NewSItem ('',
  426.     NewSItem ('~ First Name        Middle            Last~',
  427.     NewSItem ( ' SSSSSSSSSSSSSSSS\ SSSSSSSSSSSSSSSS\ SSSSSSSSSSSSSSSSSSSS',
  428.     NewSItem ('',
  429.     NewSItem ('~ Home Address          City                 State  Zip code~',
  430.     NewSItem ( ' SSSSSSSSSSSSSSSSSSSS\ SSSSSSSSSSSSSSSSSSSS\SS\   \##### ####',
  431.     NewSItem ('~ Telephone  Home:~\(###) ###-####\~  Business:~\(###) ###-####',
  432.     NewSItem ('~ Social Security Number:~ \###-##-####\~  Date of Birth:~\' + fldDATE,
  433.     NewSItem ('',
  434.     NewSItem ('~ Employer                            How long?~',
  435.     NewSItem ( ' SSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSS\WW '#0'~years  ~\WW '#0'~months~',
  436.     NewSItem ('~ Address               City                 State  Zip code~',
  437.     NewSItem ( ' SSSSSSSSSSSSSSSSSSSS\ SSSSSSSSSSSSSSSSSSSS\SS\   \##### ####',
  438.     NewSItem ('',
  439.     NewSItem ('~ Occupation:~\ SSSSSSSSSSSSSSSS\~   Annual gross salary:~\($r,rrr,rrr)',
  440.     NewSItem ('~ Other income:~\($r,rrr,rrr)\~   Source:~\SSSSSSSSSSSSSSSSSSSS',
  441.         ANext))))))))))))))))));
  442.     end;
  443.  
  444. begin
  445.   Templates :=
  446.     PersonalInfo (
  447.     NewSItem ('',
  448.     NewSItem ('',
  449.     NewSItem ('',
  450.     NewSItem ('',
  451.     EmploymentInfo (
  452.     NewSItem ('',
  453.     NewSItem ('',
  454.     NewSItem ('',
  455.     NewSItem ('',
  456.     FinancialInfo (
  457.     NewSItem ('',
  458.     NewSItem ('',
  459.     NewSItem ('',
  460.     NewSItem ('',
  461.     JointAccountInfo (
  462.     NewSItem ('',
  463.         nil)))))))))))))))));
  464.  
  465.   AssignWinRect (R, 0,0);  { assign window dimensions }
  466.   New (W, Init (R, 'EDIT RECORD', wnNextAvail));
  467.   With W^ do
  468.     begin
  469.     Options := Options or ofTileable; { must be tileable for AssignWinRect }
  470.     GetExtent (R);          { create new rectangle for editor object }
  471.     R.Grow (-1,-1);                  { shrink -1 to avoid borders }
  472.     New (DMX,
  473.       Init (Templates,                   { template list }
  474.         FALSE,                 { normal keyboard control }
  475.         MainData,                     { record data }
  476.         R,                    { view's rectangle }
  477.         nil,nil,
  478.         W^.StandardScrollBar (sbHandleKeyboard or sbHorizontal),
  479.         W^.StandardScrollBar (sbHandleKeyboard or sbVertical)
  480.         )
  481.     );
  482.     DMX^.Options := DMX^.Options or ofFramed;
  483.     DMX^.HelpCtx := hcDesktop;
  484.     Insert (DMX);
  485.     end;
  486.   DeskTop^.Insert (ValidView (W));
  487.  
  488.   DisposeSItems (Templates);  { not needed after initialization }
  489.  
  490. end;
  491.  
  492.  
  493. procedure TMyApp.EditDialog;
  494. var  R,R2 : TRect;
  495.      A      : string;
  496.      D      : PDialog;
  497.      DMX  : PDmxRecDlg;
  498.      Templates : PSItem;
  499. begin
  500.     { The string literals are enclosed by tilde ('~') symbols, and
  501.       the '\' delimiter is used to separate fields from the literals. }
  502.   Templates :=
  503.     NewSItem (^A'B'^H,  { hidden BYTE field }
  504.     NewSItem ('~    Name~',
  505.     NewSItem ( '   \ssssssssssssssssssssssssssssss',
  506.     NewSItem ('',
  507.     NewSItem ('~    SSN:    ~\###-##-####',
  508.     NewSItem ('',
  509.     NewSItem ('~    Balance:~\($rrr,rrr.zz)',
  510.     NewSItem ('',
  511.     NewSItem ('~      Date: ~\' + fldDATE,
  512.     NewSItem ('~      Time: ~\' + fldTIME,
  513.     NewSItem ('',
  514.     NewSItem ('~      <A>   ~\iiiii '^R^S'\~ (skip field)~',
  515.     NewSItem ('~      [B]   ~\iiiii ',
  516.     NewSItem ('',
  517.     NewSItem ('~    Pointer:~\HHHH:HHHH',
  518.     NewSItem ('~    Value:  ~\RRR,RRR.ZZRR ~pts~',
  519.     NewSItem ('',
  520.     NewSItem ('~       RO:  ~\ HH '^R,
  521.     NewSItem ('',
  522.           nil)))))))))))))))))));
  523.  
  524.   R.Assign (0,0, 40,18);
  525.   New (D, Init (R, 'Busy Record'));
  526.   With D^ do
  527.     begin
  528.     Options := Options or ofCentered;
  529.     HelpCtx := hcDialogs;
  530.     GetExtent (R);          { create new rectangle for editor object }
  531.     R.Grow (-1,-1);                  { shrink -1 to avoid borders }
  532.     R.B.Y := R.A.Y + 12;
  533.     New (DMX,
  534.       Init (Templates,                   { template list }
  535.         R,                    { view's rectangle }
  536.         nil,                   { no H-ScrollBar needed }
  537.         D^.StandardScrollBar (sbHandleKeyboard or sbVertical)
  538.         )
  539.     );
  540.     DMX^.Options := DMX^.Options or ofFramed;
  541.     DMX^.HelpCtx := hcDialogs;
  542.     Insert (DMX);
  543.     R.Assign ((Size.X shr 1) - 11, Size.Y-3, (Size.X shr 1) - 1, Size.Y-1);
  544.     Insert (New (PButton, Init (R, 'O~K~', cmOK, bfDefault)));
  545.     R.Assign ((Size.X shr 1) + 1, Size.Y-3, (Size.X shr 1) + 11, Size.Y-1);
  546.     Insert (New (PButton, Init (R, 'Cancel', cmCancel, bfNormal)));
  547.     SelectNext (FALSE);
  548.     end;
  549.   DeskTop^.ExecView (D);
  550.   DisposeSItems (Templates);
  551. end;
  552.  
  553.  
  554. procedure TMyApp.RegistrationForm;
  555. { The labels are enclosed by tilde ('~') symbols, and
  556.   the '\' delimiter is used to separate text from literals. }
  557. const
  558.      fldBOOL    = '[X]' + ^C+char(accSpecA);
  559. var  R  : TRect;
  560.      A  : string;
  561.      W  : PWindow;
  562.      DMX  : PDmxPrgrInfo;
  563.      TT,Templates : PSItem;
  564.  
  565.     function  BorlandOrTurbo : DmxIDstr;
  566.     begin
  567.       BorlandOrTurbo := InitEnumField (TRUE, accNormal, 0,
  568.     NewSItem (' Turbo Pascal',
  569.     NewSItem ('Borland Pascal',
  570.         nil)));
  571.     end;
  572.  
  573.     function  ProgrammerInfo (ANext : PSItem) : PSItem;
  574.     begin
  575.       ProgrammerInfo :=
  576.     NewSItem (^A,
  577.     NewSItem ('~  If you have a printer:  Please take a few moments to complete',
  578.     NewSItem ('~  as much of this form as possible.  (Registered users can upgrade',
  579.     NewSItem ('~  to this version free, and should not register again.)',
  580.     NewSItem ('',
  581.     NewSItem ('',
  582.     NewSItem ('~      Name   ~\ ssssssssssssssssssssssssssssssssssssssssss',
  583.     NewSItem ('~      Company~\ ssssssssssssssssssssssssssssssssssssssssss',
  584.     NewSItem ('~      Address~\ SSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSS',
  585.     NewSItem ('~      City   ~\ SSSSSSSSSSSSSSSS\~ State/Prov.~\SSSSSSSSSSSS',
  586.     NewSItem ('~             ~\ SSSSSSSSSSSSSSSS',
  587.     NewSItem ('~             ~\ SSSSSSSSSSSSSSSS',
  588.     NewSItem ('',
  589.     NewSItem ('',
  590.     NewSItem ('~  How long have you been using Turbo Vision?~\WW '^U#5#0'~years ~\WW '^U#11#0'~months~',
  591.     NewSItem ('',
  592.     NewSItem ('~  Which version of ~' + BorlandOrTurbo + '~ are you using?~\RR.ZR',
  593.     NewSItem ('',
  594.     NewSItem ('~  List any programming tools/add-ins that you use:~',
  595.     NewSItem ('~    ~\'+fldBOOL+'\~ AnsiView~',
  596.     NewSItem ('~    ~\'+fldBOOL+'\~ Blaise:~\ssssssssssssssssssssssssssssssssssssssss',
  597.     NewSItem ('~    ~\'+fldBOOL+'\~ Borland/Turbo Pascal Object Windows Library~',
  598.     NewSItem ('~    ~\'+fldBOOL+'\~ Btrieve~',
  599.     NewSItem ('~    ~\'+fldBOOL+'\~ Paradox Engine ver~\R.ZR',
  600.     NewSItem ('~    ~\'+fldBOOL+'\~ Paradox Engine with Database Framework ver~\R.ZR',
  601.     NewSItem ('~    ~\'+fldBOOL+'\~ Topaz~',
  602.     NewSItem ('~    ~\'+fldBOOL+'\~ TurboPower:~\ssssssssssssssssssssssssssssssssssss',
  603.     NewSItem ('',
  604.     NewSItem ('~    Others:~\ssssssssssssssssssssssssssssssssssssssssssssssss',
  605.     NewSItem ('~           ~\ssssssssssssssssssssssssssssssssssssssssssssssss',
  606.     NewSItem ('~           ~\ssssssssssssssssssssssssssssssssssssssssssssssss',
  607.     NewSItem ('',
  608.     NewSItem ('~  Print this form and send it with $20 registration fee to:~',
  609.     NewSItem ('',
  610.     NewSItem ('~                 Randolph Beck~',
  611.     NewSItem ('~                 tvDMX Registration (2.1)~',
  612.     NewSItem ('~                 P.O. Box  56-0487~',
  613.     NewSItem ('~                 Orlando, FL  32856-0487~',
  614.     NewSItem ('',
  615.         nil)))))))))))))))))))))))))))))))))))))));
  616.     end;
  617.  
  618. begin
  619.   Templates := ProgrammerInfo (nil);
  620.  
  621.   AssignWinRect (R, 0,0);  { assign window dimensions }
  622.   New (W, Init (R, 'USER RESPONSE FORM', wnNextAvail));
  623.   With W^ do
  624.     begin
  625.     Options := Options or ofTileable; { must be tileable for AssignWinRect }
  626.     GetExtent (R);          { create new rectangle for editor object }
  627.     R.Grow (-1,-1);                  { shrink -1 to avoid borders }
  628.     New (DMX,
  629.      Init (Templates,                   { template list }
  630.         TRUE,                   { alternate key control }
  631.         PrgrInfo,                     { record data }
  632.         R,                    { view's rectangle }
  633.         nil,nil,
  634.         StandardScrollBar (sbHandleKeyboard or sbHorizontal),
  635.         StandardScrollBar (sbHandleKeyboard or sbVertical)
  636.         )
  637.     );
  638.     DMX^.Options := DMX^.Options or ofFramed;
  639.     DMX^.HelpCtx := hcDesktop;
  640.     Insert (DMX);
  641.     end;
  642.   DeskTop^.Insert (ValidView (W));
  643.  
  644.   DisposeSItems (Templates);  { not needed after initialization }
  645.  
  646. end;
  647.  
  648.  
  649.   { ══════════════════════════════════════════════════════════════════════ }
  650.  
  651. var  MyApp: TMyApp;
  652.  
  653. Begin
  654.   { modify default printing options }
  655.   PrnOpt.Options := PrnOpt.Options and not repLineNums; { no line numbers }
  656.   PrnOpt.Len     :=  55;                { rows per page }
  657.   PrnOpt.Wid     := 132;                { maximum page width }
  658.  
  659.   FillChar (MainData, sizeof (MainData), 0);
  660.   FillChar (PrgrInfo, sizeof (PrgrInfo), 0);
  661.  
  662.   {$IFDEF VER60 }
  663.   PrgrInfo.TPversion := 6.0;
  664.   {$ENDIF }
  665.   {$IFDEF VER70 }
  666.   PrgrInfo.TPversion := 7.0;
  667.   {$ENDIF }
  668.  
  669.   MyApp.Init;
  670.   MyApp.Run;
  671.   MyApp.Done;
  672. End.
  673.