home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / ansi / pasart / pas1art.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1994-04-30  |  9.5 KB  |  216 lines
  1. {
  2.         Turbo Pascal is a language which has had many faces.  Since
  3. Borland introduced it in 1982 it has been everything from a purely
  4. teaching language to the high power Turbo Pascal we know today.  But,
  5. the makers of Turbo Pascal have not forgotten its roots.  Today, Turbo
  6. Pascal can be used in writing the simplest application to the most
  7. complex high-speed parrallel processing network applications.
  8.  
  9.         The program below illustrates how easy it is to use Turbo Pascal
  10. to writing a seemingly complex application.  The code is for a program
  11. much like the popular TheDraw~.  This code took me less than 2 hours to
  12. write and is less that 170 lines of code.  With a few additions it could
  13. easily rival any of the popular ANSI Drawing programs... some even like
  14. TheDraw~ which have made their authors a pretty penny!
  15.  
  16. -----------> Beginning of Listing
  17. }
  18.  
  19. Program ANSIPic;   { The following code may be modified, changed and  }
  20.                    { used in any way you wish.  It may be distributed }
  21. Uses CRT;          { in whole or part and you do NOT have to credit   }
  22.                    { OctagonSoft or Ben Shoval for the code           }
  23. const
  24.   UpArrow   = #72; { These Constants are used to define cursor movements }
  25.   DnArrow   = #80;
  26.   RtArrow   = #77;
  27.   LtArrow   = #75;
  28.   ColorUp   = #73; { These are used to define the keys for changing colors }
  29.   ColorDn   = #81;
  30.   BkColorUp = #71;
  31.   BkColorDn = #79;
  32.   SetDMKey  = #50;
  33.   TRtCorner = #59; { These define the keys for drawing corners }
  34.   TLtCorner = #60;
  35.   BRtCorner = #61;
  36.   BLtCorner = #62;
  37.   ClrKey    = #46; { Key to Clear the Screen }
  38.  
  39. var
  40.   DrawColor : Byte; { Stores the foreground color }
  41.   BKColor   : Byte; { Stores the background color }
  42.   Ch        : Char;
  43.  
  44. Procedure Setup;
  45. Begin
  46.   TextMode(CO80);         { Use 80 by 25 Text Mode }
  47.   HighVideo;              { Use High Intensity Colors }
  48.   TextColor(White);       { Set the starting Foreground color to White }
  49.   DrawColor := White;     { Set the Foreground color variable }
  50.   TextBackground(Black);  { Set the starting Background color to Black }
  51.   BKColor := Black;       { Set the Background color variable }
  52.   ClrScr;                 { Clear the Screen }
  53.   GotoXY(1,1);            { The Following sets up the screen }
  54.   Write('PgUp/PgGn Sets Color - Home/End Sets Background Color - ');
  55.   Write('<ALT>M Toggles Drawing');
  56.   GotoXY(1,25);
  57.   Write('Status: ');
  58.   GotoXY(25,25);
  59.   Write('Cursor Position: ');
  60.   GotoXY(60,25);
  61.   Write('F1 ',#218,' F2 ',#191,' F3 ',#192,' F4 ',#217);
  62.   GotoXY(40,12);          { Put the cursor in the center of the screen }
  63. End;
  64.  
  65. Procedure Draw;
  66. Var
  67.   HiKey      : Boolean; { Set to TRUE is the keypressed is an Extended Key }
  68.   DrawMode   : Boolean; { Set to TRUE if in Drawing Mode }
  69.   PreX, PreY : Byte;    { Used to hold X and Y when they are being written }
  70. Begin
  71.   DrawMode := TRUE;     { Always start out in Drawing Mode }
  72.   Repeat                { Start of loop which exits with ESC or <ALT>X }
  73.  
  74.     PreX := WhereX;     { Get the current X pos }
  75.     PreY := WhereY;     { Get the current Y pos }
  76.     GotoXY(42,25);      { Go to 42,25 to write the current X and Y }
  77.     TextColor(White);   { Writing will be done with White on Black }
  78.     TextBackground(Black);
  79.     Write('(',+PreX,+',',+PreY,+')     '); { The spaces after then ) are needed }
  80.     GotoXY(9,25); { The Following write the Drawing Status }
  81.     if DrawMode = TRUE then Write('Drawing    ') { Spaces are needed }
  82.     else Write('Not Drawing');
  83.     GotoXY(PreX, PreY); { Go back to where you were on the screen }
  84.  
  85.     if DrawColor = BkColor then { Check that the foreground and background }
  86.       inc(DrawColor);           { colors are not the same                  }
  87.     TextColor(DrawColor);       { Set the Foreground color }
  88.     TextBackground(BKColor);    { Set the Background color }
  89.  
  90.     HiKey := False;             { Always assume that it is NOT a Hi Key }
  91.     Ch := Readkey;              { Read a key }
  92.     If Ch=#0 then               { If it is a Hi Key (#0 was returned first) }
  93.       Begin
  94.         Ch := Readkey;          { If we got here then it is a Hi Key }
  95.         HiKey := TRUE;          { Set HiKey to TRUE }
  96.       End;
  97.  
  98.     Case Ch Of
  99.       UpArrow   : Begin { Routine if the Up Arrow was pressed }
  100.                     GotoXY(WhereX,WhereY-1); { Move up a line }
  101.                     if WhereY = 1 then GotoXY(WhereX,2); { make sure we're }
  102.                     if DrawMode = True then              { not on 1st line }
  103.                       Begin  { We're here if we're in drawing mode }
  104.                         Write(#179);
  105.                         GotoXY(WhereX-1,WhereY); { Move the cursor onto the }
  106.                       End;                       { character which was drawn}
  107.                   End;
  108.       DnArrow   : Begin { Routine if the Down Arrow was pressed }
  109.                     GotoXY(WhereX,WhereY+1); { Move down a line }
  110.                     If WhereY = 25 then GotoXY(WhereX,24); { make sure we're }
  111.                     if DrawMode = True then                { not on 25th line}
  112.                       Begin
  113.                         Write(#179);
  114.                         GotoXY(WhereX-1,WhereY); { Move the cursor onto the }
  115.                       End;                       { character which was drawn}
  116.                   End;
  117.       RtArrow   : Begin { Routine if the Right Arrow was pressed }
  118.                     GotoXY(WhereX+1,WhereY); { Move to the right one position }
  119.                     if WhereX = 80 then GotoXY(79,WhereY); { make sure we're }
  120.                     if DrawMode = True then                { not in 79th spot}
  121.                       Begin
  122.                         Write(#196);
  123.                         GotoXY(WhereX-1,WhereY); { Move the cursor onto the }
  124.                       End;                       { character which was drawn}
  125.                   End;
  126.       LtArrow   : Begin { Routine if the Left Arrow was pressed }
  127.                     GotoXY(WhereX-1,WhereY); { Move to the left one position }
  128.                     if DrawMode = True then
  129.                       Begin
  130.                         Write(#196);
  131.                         GotoXY(WhereX-1,WhereY); { Move the cursor onto the }
  132.                       End;                       { character which was drawn}
  133.                   End;
  134.       ColorUp   : If DrawColor < 15 then inc(DrawColor) { Foreground colors }
  135.                   else DrawColor := 0;                  { are from 0 to 15  }
  136.       ColorDn   : If DrawColor > 0 then dec(DrawColor)
  137.                   else DrawColor := 15;
  138.       BkColorUp : if BkColor < 15 then inc(BkColor)     { Background colors }
  139.                   else BkColor := 0;                    { are from 0 to 7   }
  140.       BkColorDn : if BkColor > 0 then dec(BkColor)
  141.                   else BkColor := 15;
  142.       SetDMKey  : If HiKey = TRUE then { make sure we have a Hi Key }
  143.                     if DrawMode = TRUE then DrawMode := FALSE
  144.                     else DrawMode := TRUE;          { Toggle Draw Mode }
  145.       TRtCorner : if HiKey = TRUE then   { Routine to Draw Top Right Corner }
  146.                     begin
  147.                       write(#218);
  148.                       GotoXY(WhereX-1,WhereY);
  149.                      end;
  150.       TLtCorner : if HiKey = TRUE then   { Routine to Draw Top Left Corner  }
  151.                     begin
  152.                       write(#191);
  153.                       GotoXY(WhereX-1,WhereY);
  154.                     end;
  155.       BRtCorner : if HiKey = TRUE then { Routine to Draw Bottom Right Corner }
  156.                     begin
  157.                       write(#192);
  158.                       GotoXY(WhereX-1,WhereY);
  159.                     end;
  160.       BLtCorner : if HiKey = TRUE then { Routine to Draw Bottom Left Corner }
  161.                     begin
  162.                       write(#217);
  163.                       GotoXY(WhereX-1,WhereY);
  164.                     end;
  165.  
  166.       ClrKey    : if HiKey = TRUE then Setup; { Clear the Screen }
  167.       #32..#136 : If HiKey = FALSE then { Routine to write an ASCII }
  168.                     Begin               { character to the screen   }
  169.                       write(Ch);
  170.                       if WhereX=1 then
  171.                         GotoXY(80,WhereY-1);
  172.                     End;
  173.  
  174.      end;
  175.  
  176.   Until (Ch=#27) or ((Ch=#45) and (HiKey=TRUE)); { Until ESC or <ALT>X }
  177.  
  178.   Begin
  179.     ClrScr;
  180.     TextMode(LastMode);
  181.   End;
  182. End;
  183.  
  184. Begin
  185.   Setup;
  186.   Draw;
  187. End.
  188.  
  189. ------------> End of Listing
  190.  
  191.         The actual code is very simple and is explained at as move
  192. through it.  It start (as always) at the bottom 'Begin'.  Immediately
  193. the program moves to the setup procedure which puts it into 80 by 25
  194. Color Text Mode.  Then the screen is setup.  Next the program moves to
  195. the drawing routine.  Each key is read, processed, and the so on until
  196. the key read is either ESC or <ALT>X.  At it drops out of the loop and
  197. exits.  During the loop, the current cursor position, the Drawing Status
  198. and colors and updated and set.
  199.  
  200.         Obviously the program lacks any real on-line help, a save
  201. routine and the popular animation offered by TheDraw~ and other ANSI
  202. drawing programs.  Still, it shows how easily a seemily complex program
  203. can be written in just a few hours using Turbo Pascal.
  204.  
  205. If you have any problems/comments I can be contact at any of the following:
  206.  
  207.         Keep BBS      : 717-675-4068
  208.         Air Force BBS : 717-825-3899
  209.  
  210.         CompuServe at 70314,2321
  211.  
  212. That's all from here - Thanks for reading - Ben Shoval 10/19/91
  213.  
  214. ~ TheDraw is Copyright 1986,1987,1988,1989 by TheSoft Programming
  215.   Services and Ian E. Davis
  216.