home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TPMEMO.ZIP / MEMO.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-01-04  |  6.4 KB  |  225 lines
  1. {$S-,R-,V-,I-,B-}
  2. {$M 16384,16384,600000}
  3.  
  4. {*********************************************************}
  5. {*                    MEMO.PAS 1.0                       *}
  6. {*     An example program for Turbo Professional 5.0     *}
  7. {*        Copyright (c) TurboPower Software 1988.        *}
  8. {* Portions copyright (c) Sunny Hill Software 1985, 1986 *}
  9. {*     and used under license to TurboPower Software     *}
  10. {*                 All rights reserved.                  *}
  11. {*********************************************************}
  12.  
  13. program TpMemoTest;
  14.   {-Test program for TPMEMO}
  15.  
  16.   {$I TPDEFINE.INC}
  17.  
  18. uses
  19.   TpCrt,                     {Turbo Professional CRT unit}
  20.   TpString,                  {Turbo Professional string handling}
  21.   {$IFDEF UseMouse}
  22.   TpMouse,                   {Turbo Professional mouse routines}
  23.   {$ENDIF}
  24.   TpMemo;                    {memo field editor}
  25.  
  26. const
  27.   StatusA     : array[Boolean] of Byte = ($2F, $70);
  28.   ErrorA      : array[Boolean] of Byte = ($1F, $0F);
  29.   TextA       : array[Boolean] of Byte = ($1B, $07);
  30.   CtrlA       : array[Boolean] of Byte = ($1C, $0F);
  31.   MouseA      : array[Boolean] of Byte = ($4E, $70);
  32.   UserCmds    : array[1..1] of EMtype = (EMnone);
  33. var
  34.   I, FSize    : LongInt;
  35.   EMCB        : EMcontrolBlock;
  36.   Buffer      : Pointer;
  37.   BufSize     : Word;
  38.   BandW       : Boolean;
  39.   ExitCode    : EMtype;
  40.   FName       : string[79];
  41.  
  42.   procedure Abort(Msg : string);
  43.     {-Display an error message and halt}
  44.   begin
  45.     {$IFDEF UseMouse}
  46.     {hide the mouse cursor}
  47.     HideMouse;
  48.     {$ENDIF}
  49.  
  50.     ClrScr;
  51.     WriteLn(Msg);
  52.     Halt(1);
  53.   end;
  54.  
  55.   procedure ClearMessageLine;
  56.     {-Clear the message line}
  57.   begin
  58.     FastWrite(CharStr(' ', ScreenWidth), ErrorRow, 1, ErrorAttr);
  59.   end;
  60.  
  61.   procedure DisplayMessage(Msg : string);
  62.     {-Display a message at the top of the screen}
  63.   begin
  64.     ClearMessageLine;
  65.     FastWrite(Msg, ErrorRow, 1, ErrorAttr);
  66.     GotoXYabs(Length(Msg)+2, ErrorRow);
  67.   end;
  68.  
  69.   function YesNo(Msg : string) : Boolean;
  70.     {-Get a response to a yes/no question. Return True for Y, False for N}
  71.   var
  72.     ChWord : Word;
  73.     Ch : Char absolute ChWord;
  74.   begin
  75.     DisplayMessage(Msg);
  76.     repeat
  77.       ChWord := ReadKeyWord;
  78.       Ch := Upcase(Ch);
  79.     until (Ch = 'Y') or (Ch = 'N');
  80.     YesNo := (Ch = 'Y');
  81.     ClearMessageLine;
  82.   end;
  83.  
  84.   procedure SaveFile;
  85.     {-Save the file in the edit buffer}
  86.   const
  87.     MakeBackUp = True;
  88.   begin
  89.     DisplayMessage('Saving file...');
  90.     case SaveMemoFile(EMCB, FName, MakeBackup) of
  91.       mstOK :
  92.         {file was saved} ;
  93.       mstCreationError :
  94.         Abort('Error creating '+FName);
  95.       mstWriteError :
  96.         Abort('Error writing to '+FName);
  97.       mstCloseError :
  98.         Abort('Error closing '+FName);
  99.     end;
  100.     ClearMessageLine;
  101.   end;
  102.  
  103. begin
  104.   {allocate edit buffer}
  105.   I := MaxAvail;
  106.   if I > $FFF1 then
  107.     BufSize := $FFF1
  108.   else
  109.     BufSize := I;
  110.   GetMem(Buffer, BufSize);
  111.  
  112.   {get name of file to edit}
  113.   FName := ParamStr(1);
  114.   if Length(FName) = 0 then begin
  115.     Write('File to edit: ');
  116.     BufLen := 64;
  117.     ReadLn(FName);
  118.   end;
  119.  
  120.   {halt if no filename specified}
  121.   if Length(FName) = 0 then
  122.     Halt(0);
  123.  
  124.   {don't allow reading of partial files}
  125.   AllowTruncation := False;
  126.  
  127.   {open file}
  128.   case ReadMemoFile(Buffer^, BufSize, FName, FSize) of
  129.     mstOK :
  130.       {file read in OK} ;
  131.     mstInvalidName :
  132.       Abort(FName + ' is an invalid pathname');
  133.     mstNotFound :
  134.       {file not found, we'll create it later} ;
  135.     mstReadError :
  136.       Abort('Error reading '+FName);
  137.     mstTooLarge :
  138.       Abort(FName+' is too large to edit');
  139.     mstCloseError :
  140.       Abort('Error closing '+FName);
  141.   end;
  142.  
  143.   {use default status and error handlers}
  144.   MemoStatusPtr := @MemoStatus;
  145.   MemoErrorPtr := @MemoError;
  146.  
  147.   {set attribute for status and error lines}
  148.   BandW := (CurrentMode = 7) or (CurrentMode = 2);
  149.   StatusAttr := StatusA[BandW];
  150.   ErrorAttr := ErrorA[BandW];
  151.  
  152.   {$IFDEF UseMouse}
  153.   if MouseInstalled then begin
  154.     {use a red diamond for our mouse cursor}
  155.     SoftMouseCursor($0000, (MouseA[BandW] shl 8)+$04);
  156.     ShowMouse;
  157.  
  158.     {enable mouse support}
  159.     EnableMemoMouse;
  160.   end;
  161.   {$ENDIF}
  162.  
  163.   {EMuser0 = save file and continue: ^KS, F2}
  164.   if not AddMemoCommand(EMuser0, 2, Ord(^K), Ord(^S)) then {};
  165.   if not AddMemoCommand(EMuser0, 1, $3C00, 0) then {};
  166.  
  167.   {EMuser1 = save file and exit: ^KX, ^F2}
  168.   if not AddMemoCommand(EMuser1, 2, Ord(^K), Ord(^X)) then {};
  169.   if not AddMemoCommand(EMuser1, 1, $5F00, 0) then {};
  170.  
  171.   {EMuser2 = abandon file: ^KQ, AltF2}
  172.   if not AddMemoCommand(EMuser2, 2, Ord(^K), Ord(^Q)) then {};
  173.   if not AddMemoCommand(EMuser2, 1, $6900, 0) then {};
  174.  
  175.   {initialize the control block}
  176.   InitControlBlock(
  177.     EMCB,                    {control block}
  178.     1,                       {left column of edit window}
  179.     3,                       {top row of edit window}
  180.     ScreenWidth,             {right column of edit window}
  181.     ScreenHeight,            {bottom row of edit window}
  182.     TextA[BandW],            {attribute for normal text}
  183.     CtrlA[BandW],            {attribute for control characters}
  184.     True,                    {insert mode on?}
  185.     True,                    {auto-indent on?}
  186.     True,                    {word wrap on?}
  187.     8,                       {distance between tab stops}
  188.     0,                       {help index}
  189.     ScreenWidth-2,           {right margin}
  190.     MaxInt,                  {maximum number of lines}
  191.     BufSize,                 {size of edit buffer}
  192.     Buffer^);                {edit buffer}
  193.  
  194.   {clear the message line}
  195.   ClearMessageLine;
  196.  
  197.   repeat
  198.     {start editing}
  199.     ExitCode := EditMemo(EMCB, False, UserCmds);
  200.  
  201.     {process exit command}
  202.     case ExitCode of
  203.       EMuser0,               {save and continue}
  204.       EMuser1 :              {save and quit}
  205.         SaveFile;
  206.       EMquit,                {quit}
  207.       EMuser2 :              {abandon file}
  208.         if not EMCB.Modified then
  209.           ExitCode := EMquit
  210.           {file was modified--verify that user wants to quit}
  211.         else if YesNo('File modified. Quit anyway?') then
  212.             ExitCode := EMquit
  213.           else
  214.             ExitCode := EMnone;
  215.     end;
  216.   until (ExitCode = EMquit) or (ExitCode = EMuser1);
  217.  
  218.   {$IFDEF UseMouse}
  219.   {hide the mouse cursor}
  220.   HideMouse;
  221.   {$ENDIF}
  222.  
  223.   ClrScr;
  224. end.
  225.