home *** CD-ROM | disk | FTP | other *** search
/ World of Shareware - Software Farm 2 / wosw_2.zip / wosw_2 / PASCAL / GWEDIT.ZIP / GWEDIT.PAS < prev    next >
Pascal/Delphi Source File  |  1989-03-16  |  13KB  |  460 lines
  1.  
  2. {Line editor and keyboard input routines}
  3. {Inputs a line similar to Readln, but for graphics}
  4. {released to the public domain 3/16/89 by author Michael Day}
  5. {for mouse support, enable the mouse unit in the uses statement}
  6. {and uncomment the mouse statements in GCKeyBoxFlash}
  7.  
  8. unit GwEdit;
  9.  
  10. interface
  11.  
  12. uses
  13.    Dos,
  14.    crt,       {<- you can use crt, or your own favorite crt unit}
  15.    KeyCodes,          {only needed for "KeyPressed" and "ReadKey"}
  16.    AreaWr,
  17.    GwCurse,
  18. {   Mouse, }
  19.    GStart;
  20.  
  21. const
  22.   {- the following controls how ReadString operates -}
  23.   ForceUpper:boolean = false;    {force chars to uppercase?}
  24.   InsertDefault:boolean = true;  {default to insert mode?}
  25.   ClearFirstChar:boolean = true; {clr string if 1st char entered is ASCII}
  26.   EscapeRestore:boolean = false; {restore old data when escape pressed}
  27.  
  28.  
  29. var GwChar:char;        {char/scan code for last keyboard entry}
  30.     TfddChar:char;
  31.  
  32. {-------------------------------------------------------------------------}
  33. {Passes a string to be edited to the function and waits for an exit char}
  34. {and exit char is any char that is not a part of the edit sequence.}
  35. {The exit char is passed back to the caller as the function result.}
  36. {X,Y defines where on the screen the text field is located. 'Wide' }
  37. {specifies how wide in characters the field is. 'CPos' is the starting}
  38. {position of the cursor. If 'Edit' is false, then the string is not
  39. {editable the function just waits for a non-edit character to return}
  40. {to the caller. This is useful for database fields where a field needs}
  41. {to be displayed but editing needs to be inhibited. 'Color' sets the}
  42. {drawing color of the text field. 'S' is the string that is passed.}
  43.  
  44. function GwRead(X,Y,Wide,CPos:integer;
  45.                 Edit:boolean;
  46.                 Color:ColorRec;
  47.                 var S:string):char;
  48.  
  49. procedure AssignGwCrt(var F:Text;
  50.                       X,Y,Wide,CPos:integer;
  51.                       Edit:boolean;
  52.                       Color:ColorRec;
  53.                       var S:string);
  54.  
  55. { *********************************************************************** }
  56.  
  57. implementation
  58.  
  59. {-flash graphic cursor until key pressed -}
  60. procedure GCKeyBoxFlash(var Ch:char);
  61. var X,Y:word;
  62. begin
  63.   while not(KeyPressed) { and not(MouseClick) } do
  64.     GcursorFlash;
  65.   GcursorOff;
  66.   if KeyPressed then
  67.   begin
  68.     Ch := ReadKey;
  69.     if (Ch = #0) and KeyPressed then
  70.       Ch := char(byte(ReadKey) or $80);
  71.   end
  72.   else
  73.   begin
  74. {    Ch := char(256 - byte(Mouse_Click_Button)); }
  75.   end;
  76. end;
  77.  
  78.  
  79. {- Get a string -}
  80. function GwRead(X,Y,Wide,CPos:integer;
  81.                 Edit:boolean;
  82.                 Color:ColorRec;
  83.                 var S:string):char;
  84. var
  85.     Ch : char absolute GwChar;
  86.     St : string;
  87.     StLen : byte absolute St;
  88.     Sp : byte;
  89.     DelEnd : byte;
  90.     MaxLen : integer;
  91.     Inserting : boolean;
  92.     FirstChar : boolean;
  93.     Done : boolean;
  94.     Area : rect;
  95.  
  96.   {- Toggle between insert and overtype mode}
  97.   procedure ToggleInsertMode;
  98.   begin
  99.      if Edit then
  100.      begin
  101.        Inserting := not(Inserting);  {toggle insert flag}
  102.        if Inserting then
  103.           GcursorType(BlockGcursor)    {use block cursor if inserting}
  104.        else
  105.           GcursorType(NormalGcursor);
  106.      end
  107.      else
  108.      begin
  109.         GcursorType(HiddenGcursor);   {if Edit disabled don't show cursor}
  110.      end;
  111.   end;
  112.  
  113.   {- Restore default string -}
  114.   procedure GwDefault;
  115.   begin
  116.     St := S;
  117.     if StLen > MaxLen then StLen := MaxLen;
  118.     Sp := CPos;
  119.   end;
  120.  
  121.   {-Draw the string -}
  122.   procedure DrawString;
  123.   begin
  124.     FillChar(St[Succ(StLen)], MaxLen-StLen, ' '); {Pad with blanks}
  125.     AreaWrite(St,Area,Color);
  126.   end;
  127.  
  128. {-- procedure ReadString --}
  129. begin
  130.     SetRect(Area,X,Y,X+(Wide*BoxTextWidth),Y+BoxTextHeight);
  131.     SetGcursorPos(Area,Wide,1,Color,MaxLen);
  132.     if MaxLen > Wide then MaxLen := Wide;
  133.     GwDefault;
  134.     GwRead := #0;
  135.     FirstChar := True;
  136.  
  137.     {- default to insert mode on if InsertDefault is true -}
  138.     Inserting := not(InsertDefault);
  139.     ToggleInsertMode;
  140.  
  141.     DrawString;
  142.  
  143.     {- Loop reading keys -}
  144.     Done := False;
  145.     repeat
  146.       {- position cursor and wait for input -}
  147.       if Sp > MaxLen then Sp := MaxLen;
  148.       if Sp < 1 then Sp := 1;
  149.       SetGcursorPos(Area,Wide,Sp,Color,MaxLen);
  150.       if MaxLen > Wide then MaxLen := Wide;
  151.       GCKeyBoxFlash(GwChar);
  152.       if ForceUpper then Ch := Upcase(Ch);
  153.       GwRead := GwChar;
  154.  
  155.       {- if first key is a character, clear the input string -}
  156.       if ClearFirstChar and FirstChar and Edit then
  157.       begin
  158.         FirstChar := False;
  159.         if (GwChar > #31) and (GwChar < #127) then
  160.         begin
  161.           StLen := 0;
  162.           Sp := 1;
  163.           DrawString;
  164.         end;
  165.       end;
  166.  
  167.       case GwChar of
  168.  
  169.         #32..#126:             {A character to enter in the string}
  170.           begin
  171.             if Edit then
  172.             begin
  173.               if not(Inserting) or (Sp > StLen) then
  174.               begin
  175.                 if Sp > StLen then StLen := Sp;  {overtype mode}
  176.                 St[Sp] := Ch;
  177.                 AreaCharWrite(St[Sp],Area,Color,Sp,Wide);
  178.                 Inc(Sp);
  179.               end
  180.               else
  181.               begin
  182.                 if StLen < MaxLen then   {insert mode}
  183.                 begin
  184.                   Insert(Ch, St, Sp);
  185.                   DrawString;
  186.                   Inc(Sp);
  187.                 end;
  188.               end;
  189.             end;
  190.          end;
  191.  
  192.         RetKey :            {Accept current string and quit}
  193.           Done := True;
  194.  
  195.         EscKey :             {Restore default string and quit}
  196.           begin
  197.             if EscapeRestore then GwDefault;
  198.             Done := True;
  199.           end;
  200.  
  201.         HomeKey :             {Cursor to begin of line}
  202.           Sp := 1;
  203.  
  204.         EndKey :              {Cursor to end of line}
  205.           Sp := Succ(StLen);
  206.  
  207.         CtrlEnd :           {Delete from cursor to end of line}
  208.           begin
  209.             if Edit then
  210.             begin
  211.               St := Copy(St, 1, Pred(Sp));
  212.               DrawString;
  213.             end;
  214.           end;
  215.  
  216.         CtrlHome :           {Delete from beginning of line to the cursor}
  217.           begin
  218.             if Edit then
  219.             begin
  220.               Delete(St, 1, Pred(Sp));
  221.               Sp := 1;
  222.               DrawString;
  223.             end;
  224.           end;
  225.  
  226.         GwDelLine :          {Delete entire line}
  227.           begin
  228.             if Edit then
  229.             begin
  230.               StLen := 0;
  231.               Sp := 1;
  232.               DrawString;
  233.             end;
  234.           end;
  235.  
  236.         GwRestore :          {Restore default and continue}
  237.           begin
  238.             GwDefault;
  239.             DrawString;
  240.           end;
  241.  
  242.         GwLeft,LeftArrow :             {Cursor left by one character}
  243.           if Sp > 1 then Dec(Sp);
  244.  
  245.         GwRight,RightArrow :            {Cursor right by one character}
  246.           if Sp <= StLen then Inc(Sp);
  247.  
  248.         GwWordLeft,CtrlLeft :         {Cursor left one word}
  249.           if Sp > 1 then
  250.           begin
  251.             Dec(Sp);
  252.             while (Sp >= 1) and ((Sp > StLen) or (St[Sp] = ' ')) do Dec(Sp);
  253.             while (Sp >= 1) and (St[Sp] <> ' ') do Dec(Sp);
  254.             Inc(Sp);
  255.           end;
  256.  
  257.         GwWordRight,CtrlRight :        {Cursor right one word}
  258.           if Sp <= StLen then
  259.           begin
  260.             Inc(Sp);
  261.             while (Sp <= StLen) and (St[Sp] <> ' ') do Inc(Sp);
  262.             while (Sp <= StLen) and (St[Sp] = ' ') do Inc(Sp);
  263.           end;
  264.  
  265.         GwDelChar,DelKey :              {Delete current character}
  266.           begin
  267.             if Edit then
  268.             begin
  269.               if Sp < StLen then
  270.               begin
  271.                 Delete(St, Sp, 1);
  272.                 DrawString;
  273.               end
  274.               else
  275.               begin
  276.                 if Sp = StLen then
  277.                 begin
  278.                   St[Sp] := ' ';
  279.                   AreaCharWrite(St[Sp],Area,Color,Sp,Wide);
  280.                   StLen := pred(Sp);
  281.                 end;
  282.               end;
  283.             end;
  284.           end;
  285.  
  286.         BackSpace,GwRub :             {Backspace one character}
  287.           if Sp > 1 then
  288.           begin
  289.             Dec(Sp);
  290.             if Edit then
  291.             begin
  292.               if Sp = StLen then
  293.               begin
  294.                 St[Sp] := ' ';
  295.                 AreaCharWrite(St[Sp],Area,Color,Sp,Wide);
  296.                 StLen := pred(Sp);
  297.               end
  298.               else
  299.               begin
  300.                 Delete(St, Sp, 1);
  301.                 DrawString;
  302.               end;
  303.             end;
  304.           end;
  305.  
  306.         GwDelWord :          {Delete word to right of cursor}
  307.           if (Sp <= StLen) and Edit then
  308.           begin
  309.             DelEnd := Sp;
  310.             while (St[DelEnd] <> ' ') and (DelEnd <= StLen) do Inc(DelEnd);
  311.             while (St[DelEnd] = ' ') and (DelEnd <= StLen) do Inc(DelEnd);
  312.             Delete(St, Sp, DelEnd-Sp);
  313.             DrawString;
  314.           end;
  315.  
  316.         InsKey :              {Toggle insert mode}
  317.           if Edit then
  318.             ToggleInsertMode;
  319.  
  320.         else             {Accept current string and quit}
  321.           begin
  322.             Done := True;
  323.           end;
  324.       end; {case}
  325.  
  326.     until Done;
  327.  
  328.     DrawString;               {redraw the string one last time}
  329.     S := St;                  {update return string}
  330. end;
  331.  
  332.  
  333.  
  334.  
  335.  
  336. { -********************************************************************** -}
  337. {                                                                          }
  338. {-  The following are the procedures which allows GwEdit to use a TFDD    -}
  339. {                                                                          }
  340. { -********************************************************************** -}
  341.  
  342.  
  343. type TfddGwRec = record
  344.        GwX,GwY : integer;
  345.        GwWide  : byte;
  346.        GwCPos  : byte;
  347.        GwEdit  : boolean;
  348.        GwColor : ColorRec;
  349.        GwSPtr  : ^String;
  350.        Unused  : byte;
  351.      end;
  352.  
  353. {limit value to text buffer size-2 }
  354. function TLimit(Value:integer):byte;
  355. begin
  356.   if Value > 126 then TLimit := 126
  357.   else
  358.     if Value < 1 then TLimit := 1
  359.     else
  360.       TLimit := Value;
  361. end;
  362.  
  363.  
  364.  
  365. {$F+}   { force fall calls for TFDD }
  366.  
  367. {++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  368. {-- Ignore this function call --}
  369. function TfddIgnore(var F:TextRec):integer;
  370. begin
  371.    TfddIgnore := 0;
  372. end;
  373.  
  374. {- write string to screen using Gw params -}
  375. function TfddGwWrite(var F:TextRec):integer;
  376. var Area:rect;
  377. begin
  378.    with F,TfddGwRec(UserData) do
  379.    begin
  380.      move(BufPtr^,GwSPtr^[1],BufPos);
  381.      GwSPtr^[0] := char(BufPos);
  382.      SetRect(Area,GwX,GwY,GwX+(GwWide*BoxTextWidth),GwY+BoxTextHeight);
  383.      AreaWrite(GwSPtr^,Area,GwColor);
  384.      BufPos := 0;
  385.    end;
  386.    TfddGwWrite := 0;
  387. end;
  388.  
  389. {- write string to screen and wait for editing to be complete -}
  390. function TfddGwRead(var F:TextRec):integer;
  391. begin
  392.    with F,TfddGwRec(UserData) do
  393.    begin
  394.      TfddChar := GwRead(GwX,GwY,GwWide,GwCPos,GwEdit,GwColor,GwSPtr^);
  395.      if GwSPtr^[0] > #0 then
  396.        move(GwSPtr^[1],BufPtr^,TLimit(integer(GwSPtr^[0])));
  397.      BufPtr^[integer(GwSPtr^[0])] := #13;
  398.      BufPtr^[succ(integer(GwSPtr^[0]))] := #10;
  399.      BufEnd := integer(GwSPtr^[0])+2;
  400.      BufPos := 0;
  401.    end;
  402.    TfddGwRead := 0;
  403. end;
  404.  
  405. {- Open the screen for Gw read/write -}
  406. function TfddGwOpen(var F:TextRec):integer;
  407. begin
  408.   with F do
  409.   begin
  410.     if Mode=fmInput then
  411.     begin
  412.       FlushFunc := @TfddIgnore;
  413.       InOutFunc := @TfddGwRead;
  414.     end
  415.     else
  416.     begin
  417.       Mode := fmOutput;
  418.       InOutFunc := @TfddGwWrite;
  419.       FlushFunc := @TfddGwWrite;
  420.     end;
  421.     CloseFunc := @TfddIgnore;
  422.     TfddGwOpen := 0;
  423.   end;
  424. end;
  425.  
  426. {$F-}  { finished with the local TFDD so return world to normal }
  427.  
  428. procedure AssignGwCrt(var F:Text;
  429.                       X,Y,Wide,CPos:integer;
  430.                       Edit:boolean;
  431.                       Color:ColorRec;
  432.                       var S:string);
  433.  
  434. begin
  435.    with TextRec(F) do
  436.    begin
  437.      Handle := $FFFF;
  438.      Mode := fmClosed;
  439.      BufSize := SizeOf(Buffer);
  440.      BufPtr := @Buffer;
  441.      OpenFunc := @TfddGwOpen;
  442.      CloseFunc := @TfddIgnore;
  443.      Name[0] := #0;
  444.  
  445.      TfddGwRec(UserData).GwX := X;
  446.      TfddGwRec(UserData).GwY := Y;
  447.      TfddGwRec(UserData).GwWide := TLimit(Wide);
  448.      TfddGwRec(UserData).GwCPos := TLimit(CPos);
  449.      TfddGwRec(UserData).GwEdit := Edit;
  450.      TfddGwRec(UserData).GwColor := Color;
  451.      TfddGwRec(UserData).GwSPtr := @S;
  452.  
  453.    end;
  454. end;
  455.  
  456. { ********************************************************************** }
  457.  
  458. end.
  459.  
  460.