home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / TURBO.ZIP / DRAW.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-09-16  |  5.1 KB  |  193 lines
  1. program draw;
  2. {$C-}
  3. var
  4.     Ch: Char;
  5.   Move: Char;
  6.    X,Y: Integer;
  7.   exit: boolean;
  8. screen: boolean;
  9.  clear: Char;
  10.  
  11. PROCEDURE get_char(X,Y:Integer); {get character to print}
  12.  
  13. begin
  14.   GotoXY(X,Y);
  15.   read(Kbd,Ch);
  16.   Write(Ch);
  17. end;
  18.  
  19. PROCEDURE Help; {Help Menu}
  20.  begin
  21.     ClrScr;
  22.     HighVideo;
  23.     writeln('             HELP MENU');
  24.     writeln;
  25.     LowVideo;
  26.     writeln('^ = Ctrl');
  27.     writeln('Make sure NumLock is in effect.');
  28.     writeln('Using Key Pad with arrows.');
  29.     writeln('Cursor movement as follows:');
  30.     writeln;
  31.     writeln('       7     9');
  32.     writeln('        \ ^ /');
  33.     writeln('      < - | - >');
  34.     writeln('        / V \');
  35.     writeln('       1     3');
  36.     writeln;
  37.     writeln('^H This Help Menu        | ^N New Output Character');
  38.     writeln('^B Clear Current Picture | ^Q Quit Program        ');
  39.     writeln('^S Change screen: HighVideo or LowVideo           ');
  40.     writeln('^G Delete Character Under Cursor                  ');
  41.     writeln('Letter within < > is default.                     ');
  42.     writeln('Shift + PrtSc : make hardcopy of screen           ');
  43.     writeln;
  44.     HighVideo;
  45.     write('Any Key To Draw...');
  46.     repeat until KeyPressed;
  47.     ClrScr;
  48. end;
  49.  
  50. begin
  51.   X := 40; Y := 12; exit := false; screen := true;
  52.   ClrScr;
  53.   get_char(X,Y);
  54.   repeat
  55.   GotoXY(X,Y);
  56.   if KeyPressed then
  57.   repeat
  58.   begin
  59.     repeat
  60.     Read(Kbd,Move);
  61.     case Move of
  62.       '8': begin
  63.              Y := Y-1;
  64.              GotoXY(X,Y);
  65.            end;
  66.       '2': begin
  67.              Y := Y+1;
  68.              GotoXY(X,Y);
  69.            end;
  70.       '4': begin
  71.             X := X-1;
  72.             GotoXY(X,Y);
  73.            end;
  74.       '6': begin
  75.             X := X+1;
  76.             GotoXY(X,Y);
  77.            end;
  78.        ^Q: begin
  79.             repeat
  80.             GotoXY(1,24);
  81.             write('End draw program <Y>: ');
  82.             read(Kbd,clear);
  83.             until Upcase(clear) in ['Y','N',^M];
  84.             if clear = ^M then clear := 'Y';
  85.             if Upcase(clear) = 'Y' then
  86.             begin
  87.              ClrScr;
  88.              exit := true;
  89.             end
  90.             else
  91.             begin
  92.              GotoXY(1,24);
  93.              write('                       ');
  94.              GotoXY(X,Y);
  95.             end;
  96.            end;
  97.        ^N: begin
  98.             get_char(X,Y);
  99.            end;
  100.        ^B: begin
  101.             repeat
  102.             GotoXY(1,24);
  103.             write('Clear current picture <Y>: ');
  104.             read(Kbd,clear);
  105.             until Upcase(clear) in ['Y','N',^M];
  106.             if clear = ^M then clear := 'Y';
  107.             if Upcase(clear) in ['Y'] then
  108.             begin
  109.               X := 40; Y := 12;
  110.               ClrScr;
  111.               GotoXY(X,Y);
  112.               write(Ch);
  113.             end
  114.             else
  115.              begin
  116.                GotoXY(1,24);
  117.                write('                             ');
  118.              end;
  119.            end;
  120.        ^H: begin
  121.             repeat
  122.             GotoXY(1,24);
  123.             write('Help menu <Y>: ');
  124.             read(Kbd,clear);
  125.             until Upcase(clear) in ['Y','N',^M];
  126.             if clear = ^M then clear := 'Y';
  127.             if Upcase(clear) = 'Y' then
  128.             begin
  129.              Help;
  130.              X := 40; Y := 12;
  131.              GotoXY(X,Y);
  132.             end
  133.             else
  134.               begin
  135.                GotoXY(1,24);
  136.                write('                ');
  137.                GotoXY(X,Y);
  138.               end;
  139.                          end;
  140.        ^S: begin
  141.             if screen = false then screen := true
  142.             else screen := false;
  143.             if screen = false then LowVideo
  144.             else HighVideo;
  145.            end;
  146.        ^G: begin
  147.             write(' ');
  148.             GotoXY(X,Y);
  149.            end;
  150.       '9': begin
  151.             if ((X<=78) and (Y>=2)) then begin
  152.               if Y>2 then X := X+1;
  153.               if X<=78 then Y := Y-1;
  154.               GotoXY(X,Y);
  155.             end;
  156.            end;
  157.       '1': begin
  158.             if ((X>=2) and (Y<=23)) then begin
  159.               if Y<23 then X := X-1;
  160.               if X>=2 then Y := Y+1;
  161.               GotoXY(X,Y);
  162.             end;
  163.            end;
  164.       '7': begin
  165.             if ((X>=2) and (Y>=2)) then begin
  166.               if Y>2 then X := X-1;
  167.               if X>=2 then Y := Y-1;
  168.               GotoXY(X,Y);
  169.             end;
  170.            end;
  171.       '3': begin
  172.             if ((X<=78) and (Y<=23)) then begin
  173.               if Y<23 then X := X+1;
  174.               if X<=78 then Y := Y+1;
  175.               GotoXY(X,Y);
  176.             end;
  177.            end;
  178.     end;
  179.     if Y<=2 then Y := 2;
  180.     if Y>=23 then Y := 23;
  181.     if X<=2 then X := 2;
  182.     if X>=78 then X := 78;
  183.     if move in ['1'..'4','6'..'9',^H,^S] then
  184.       begin
  185.        GotoXY(X,Y);
  186.        write(Ch);
  187.      end;
  188.     GotoXY(X,Y);
  189.   until move in ['8','2','4','6',^Q,^N,^B,^H,^S]
  190.  end;
  191.   until not KeyPressed;
  192.   until (exit = true)
  193. end.