home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / CMPLTPAS.ZIP / SCRIBBLE.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-09-02  |  3.8 KB  |  120 lines
  1. {--------------------------------------------------------------}
  2. {                         SCRIBBLE                             }
  3. {                                                              }
  4. {            Freehand graphics sketchpad program               }
  5. {                                                              }
  6. {                             by Jeff Duntemann                }
  7. {                             Turbo Pascal V5.0                }
  8. {                             Last update 9/2/88               }
  9. {                                                              }
  10. {                                                              }
  11. {     From: COMPLETE TURBO PASCAL 5.0  by Jeff Duntemann       }
  12. {    Scott, Foresman & Co., Inc. 1988   ISBN 0-673-38355-5     }
  13. {--------------------------------------------------------------}
  14.  
  15. PROGRAM Scribble;
  16.  
  17. USES DOS,Crt,Graph,Mouse,PullDown;
  18.  
  19. {$I DEMOMENU.DEF }  { This is a LARGE include file containing a }
  20.                     { sample menu array of type MenuDesc }
  21.  
  22.  
  23. VAR
  24.   GraphDriver : Integer;
  25.   GraphMode   : Integer;
  26.   ErrorCode   : Integer;
  27.   I           : Integer;
  28.   R           : Real;
  29.   M1,M2,M3,M4 : Word;
  30.   ReturnCode  : Word;
  31.   XText,YText : String;
  32.   Mule        : String;
  33.   PointerX,
  34.     PointerY  : Word;
  35.   Left,Center,
  36.     Right     : Boolean;
  37.   Amulet      : Boolean;   { True if amulet was clicked on within Menu }
  38.   Quit        : Boolean;
  39.   DuplicateCode : Byte;
  40.   ExitSave    : Pointer;
  41.  
  42. VAR
  43.   SavedColor : Word;
  44.   Palette : PaletteType;
  45.   Color   : Word;
  46.  
  47.  
  48. {$F+} PROCEDURE ReturnToTextMode; {$F-}
  49.  
  50. BEGIN
  51.   PointerOff;           { Turn off the mouse pointer }
  52.   CloseGraph;           { Go back to text mode }
  53.   ExitProc := ExitSave
  54. END;
  55.  
  56.  
  57. BEGIN
  58.   ExitSave := ExitProc;            { This ensures that we will ALWAYS     }
  59.   ExitProc := @ReturnToTextMode;   { re-enter text mode on return to DOS! }
  60.  
  61.   ClrScr;
  62.   { Check the menu structure to be sure all codes are unique: }
  63.   IF InvalidMenu(DemoMenu,DuplicateCode) THEN
  64.     BEGIN
  65.       Writeln('>>Halted for invalid menu: Duplicate code ',
  66.               DuplicateCode);
  67.       Halt(1)
  68.     END;
  69.  
  70.   GraphDriver := Detect;  { Let the BGI determine what board we're using }
  71.   DetectGraph(GraphDriver,GraphMode);
  72.   InitGraph(GraphDriver,GraphMode,'');
  73.   IF GraphResult <> 0 THEN
  74.     BEGIN
  75.       Writeln('>>Halted on graphics error: ',GraphErrorMsg(GraphResult));
  76.       Halt(2)
  77.     END;
  78.  
  79.   SetupMenu(DemoMenu);
  80.   PointerOn;
  81.  
  82.   SetColor(Yellow); Quit := False;
  83.   REPEAT
  84.     PollMouse(PointerX,PointerY,Left,Center,Right);
  85.     IF Left THEN
  86.       BEGIN
  87.         IF PointerY < 12 THEN { We're in the menu bar; call Menu: }
  88.           BEGIN
  89.             Menu(DemoMenu,ReturnCode,Amulet);
  90.             { Update graphics CP to reflect motion while in Menu: }
  91.             PollMouse(PointerX,PointerY,Left,Center,Right);
  92.             MoveTo(PointerX,PointerY);
  93.  
  94.             { This CASE..OF statement parses menu items and takes action }
  95.             IF ReturnCode <> 0 THEN
  96.               CASE ReturnCode OF
  97.                 25 : Quit := True;
  98.             { Here is where you parse out other codes returned from }
  99.             { procedure Menu.  Put a CASE selector for each valid   }
  100.             { code, and then implement some action for each CASE    }
  101.             { selector. }
  102.               END;  { CASE }
  103.           END
  104.         ELSE
  105.           IF (GetX <> PointerX) OR (GetY <> PointerY) THEN
  106.             BEGIN   { If we not in the menu bar, then we sketch: }
  107.               PointerOff;
  108.               LineTo(PointerX,PointerY);
  109.               PointerOn
  110.             END
  111.       END
  112.     ELSE MoveTo(PointerX,PointerY)
  113.   UNTIL KeyPressed OR Quit;
  114.  
  115.   { Note that CloseGraph is executed from the MAIN exit procedure! }
  116. END.
  117.  
  118.  
  119.  
  120.