home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / OPBONUS.ZIP / WFIELD.LZH / WFIELD1.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-04-04  |  6.5 KB  |  247 lines
  1. {$V-}
  2.  
  3. (*
  4.  
  5.    WFIELD1
  6.    -------
  7.    This program is an example of a Memo window embedded within a data entry
  8.    screen. Points worth noting:
  9.  
  10.      1) MemoCommands.AddCommand is used to make <CtrlEnter> an exit command
  11.         (ccUser0) for the memo window. The post-edit routine for the entry
  12.         screen then remaps ccUser0 to ccNextField. (Memo.Process doesn't
  13.         consider ccNextField to be an exit command.)
  14.  
  15.      2) By turning off the efAllowEscape option before calling AddWindowField,
  16.         we tell OPENTRY to treat the ccQuit command (<Esc>) as equivalent
  17.         to ccNextField when it is issued within the DirList.
  18.  
  19.      3) If UseAdjustableWindows is defined, the child window does not have to
  20.         be positioned correctly at the time it is instantiated; it just needs
  21.         to be the right width and height. OPENTRY will move it into position
  22.         if necessary. If UseAdjustableWIndows is not defined, it *must* be
  23.         positioned correctly, because OPENTRY has no way to move it.
  24.  
  25.      4) The wNoCoversBuffer option is used for the Memo field to limit memory
  26.         usage.
  27.  
  28. *)
  29.  
  30. program WFIELD1;
  31.  
  32. {$I OPDEFINE.INC}
  33.  
  34. uses
  35.   Dos,
  36.   OpInline,
  37.   OpString,
  38.   OpRoot,
  39.   OpCrt,
  40.   {$IFDEF UseMouse}
  41.   OpMouse,
  42.   {$ENDIF}
  43.   OpAbsFld,
  44.   OpCmd,
  45.   OpField,
  46.   OpFrame,
  47.   OpWindow,
  48.   OpSelect,
  49.   OpEntry,
  50.   OpMemo;
  51.  
  52.   {$IFDEF UseMouse}
  53. const
  54.   MouseChar  : Char = #04;
  55.   {$ENDIF}
  56.  
  57. {Color set used by entry screen}
  58. const
  59.   EsColors : ColorSet = (
  60.     TextColor       : $1E; TextMono        : $0F;
  61.     CtrlColor       : $1E; CtrlMono        : $0F;
  62.     FrameColor      : $13; FrameMono       : $0F;
  63.     HeaderColor     : $3F; HeaderMono      : $70;
  64.     ShadowColor     : $08; ShadowMono      : $08;
  65.     HighlightColor  : $4F; HighlightMono   : $70;
  66.     PromptColor     : $1F; PromptMono      : $07;
  67.     SelPromptColor  : $1F; SelPromptMono   : $07;
  68.     ProPromptColor  : $17; ProPromptMono   : $07;
  69.     FieldColor      : $1E; FieldMono       : $0F;
  70.     SelFieldColor   : $31; SelFieldMono    : $70;
  71.     ProFieldColor   : $17; ProFieldMono    : $07;
  72.     ScrollBarColor  : $13; ScrollBarMono   : $07;
  73.     SliderColor     : $13; SliderMono      : $0F;
  74.     HotSpotColor    : $30; HotSpotMono     : $70;
  75.     BlockColor      : $3E; BlockMono       : $0F;
  76.     MarkerColor     : $3F; MarkerMono      : $70;
  77.     DelimColor      : $1E; DelimMono       : $0F;
  78.     SelDelimColor   : $31; SelDelimMono    : $0F;
  79.     ProDelimColor   : $1E; ProDelimMono    : $0F;
  80.     SelItemColor    : $3E; SelItemMono     : $70;
  81.     ProItemColor    : $17; ProItemMono     : $07;
  82.     HighItemColor   : $1F; HighItemMono    : $0F;
  83.     AltItemColor    : $1F; AltItemMono     : $0F;
  84.     AltSelItemColor : $3F; AltSelItemMono  : $70;
  85.     FlexAHelpColor  : $1F; FlexAHelpMono   : $0F;
  86.     FlexBHelpColor  : $1F; FlexBHelpMono   : $0F;
  87.     FlexCHelpColor  : $1B; FlexCHelpMono   : $70;
  88.     UnselXrefColor  : $1E; UnselXrefMono   : $09;
  89.     SelXrefColor    : $3F; SelXrefMono     : $70;
  90.     MouseColor      : $4F; MouseMono       : $70
  91.   );
  92.  
  93. {Entry field constants}
  94. const
  95.   idName                 = 0;
  96.   idAddress              = 1;
  97.   idCity                 = 2;
  98.   idPhone                = 3;
  99.   idMemo                 = 4;
  100.  
  101. type
  102.   UserRecord =
  103.     record
  104.       Name                 : string[25];
  105.       Address              : string[25];
  106.       City                 : string[25];
  107.       Phone                : string[14];
  108.       MemoField            : array[1..4096] of Char;
  109.     end;
  110. var
  111.   ES     : EntryScreen;
  112.   M      : Memo;
  113.   UR     : UserRecord;
  114.   Status : Word;
  115.  
  116. {$F+}
  117. procedure PostEdit(ESP : EntryScreenPtr);
  118.   {-Called just after a field has been edited}
  119. begin
  120.   with ESP^ do
  121.     if GetCurrentID = idMemo then
  122.       if GetLastCommand = ccUser0 then
  123.         SetLastCommand(ccNextField);
  124. end;
  125. {$F-}
  126.  
  127. function InitEntryScreen : Word;
  128.   {-Initialize entry screen generated by MAKESCRN}
  129. const
  130.   Frame1 = '┌└┐┘──││';
  131.   WinOptions = wBordered+wClear+wUserContents;
  132. begin
  133.   with ES do begin
  134.     if not InitCustom(7, 5, 72, 20, EsColors, WinOptions) then begin
  135.       InitEntryScreen := InitStatus;
  136.       Exit;
  137.     end;
  138.  
  139.     wFrame.SetFrameType(Frame1);
  140.     SetWrapMode(WrapAtEdges);
  141.  
  142.     SetPostEditProc(PostEdit);
  143.  
  144.     wFrame.AddSpanHeader('├', '─', '┤', 5, frTT);
  145.     wFrame.AddCustomHeader(' Notes ', frTL, 5, 5,
  146.                            EsColors.PromptColor, EsColors.PromptMono);
  147.  
  148.   {idName:}
  149.     AddStringField(
  150.       'Name', 1, 7,
  151.       CharStr('x', 25), 1, 13, 25,
  152.       1, UR.Name);
  153.  
  154.   {idAddress:}
  155.     AddStringField(
  156.       'Address', 2, 4,
  157.       CharStr('x', 25), 2, 13, 25,
  158.       2, UR.Address);
  159.  
  160.   {idAddress:}
  161.     AddStringField(
  162.       'City', 3, 7,
  163.       CharStr('x', 25), 3, 13, 25,
  164.       2, UR.City);
  165.  
  166.   {idPhone:}
  167.     AddStringField(
  168.       'Phone', 4, 6,
  169.       '(999) 999-9999', 4, 13, 14,
  170.       3, UR.Phone);
  171.  
  172.   {idMemo:}
  173.     esFieldOptionsOff(efAllowEscape);
  174.     AddWindowField(
  175.       '', 6, 2,
  176.       6, 2,
  177.       4, M);
  178.  
  179.     InitEntryScreen := GetLastError;
  180.   end;
  181. end;
  182.  
  183. begin
  184.   {initialize user record}
  185.   FillChar(UR, SizeOf(UR), 0);
  186.   FillChar(UR.MemoField, SizeOf(UR.MemoField), ^Z);
  187.  
  188.   {make <CtrlEnter> an exit command}
  189.   MemoCommands.AddCommand(ccUser0, 1, Ord(^J), 0);
  190.  
  191.   {initialize memo field editor}
  192.   if not M.InitCustom(
  193.     {$IFDEF UseAdjustableWindows}
  194.     1, 1, 64, 11,     {let OPENTRY move it into position}
  195.     {$ELSE}
  196.     8, 10, 71, 20,
  197.     {$ENDIF}
  198.     EsColors, DefWindowOptions or wNoCoversBuffer, 4096, @UR.MemoField) then
  199.       Status := InitStatus
  200.   else
  201.     Status := 0;
  202.   if Status <> 0 then begin
  203.     WriteLn('Error initializing memo field: ', Status);
  204.     Halt(1);
  205.   end;
  206.  
  207.   {initialize entry screen}
  208.   Status := InitEntryScreen;
  209.   if Status <> 0 then begin
  210.     WriteLn('Error initializing entry screen: ', Status);
  211.     Halt(1);
  212.   end;
  213.  
  214.   {clear the screen}
  215.   TextChar := #178;
  216.   TextAttr := 7;
  217.   ClrScr;
  218.  
  219.   {$IFDEF UseMouse}
  220.   if MouseInstalled then
  221.     with EsColors do begin
  222.       {activate mouse cursor}
  223.       SoftMouseCursor($0000, (ColorMono(MouseColor, MouseMono) shl 8)+
  224.                              Byte(MouseChar));
  225.       ShowMouse;
  226.       {enable mouse support}
  227.       EntryCommands.cpOptionsOn(cpEnableMouse);
  228.       MemoCommands.cpOptionsOn(cpEnableMouse);
  229.     end;
  230.   {$ENDIF}
  231.  
  232.   ES.Process;
  233.  
  234.   ES.Erase;
  235.  
  236.   {$IFDEF UseMouse}
  237.   HideMouse;
  238.   {$ENDIF}
  239.  
  240.   {show exit command}
  241.   ClrScr;
  242.   WriteLn('Exit command = ', ES.GetLastCommand);
  243.  
  244.   {dispose of the parent *and* its children}
  245.   ES.Done;
  246. end.
  247.