home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 31 / CDASC_31_1996_juillet_aout.iso / internet / rnr214.zip / TECHNIXM.ZIP / SCRIBBLE.PAS < prev   
Pascal/Delphi Source File  |  1987-12-13  |  6KB  |  175 lines
  1. Program Scribble;
  2.  
  3.    { A simple utility for drawing with the mouse in graphics mode }
  4.  
  5. USES mouse, graph;
  6.  
  7. {$I gmouscur.inc}
  8.  
  9. CONST  EventMask = $55;       { Any button released, or mouse moved }
  10.        Menu      =  20;                       { bottom of menu area }
  11.        HelpTop   = 185;                          { top of help area }
  12.        Box1      = 160;                { right end of each menu box }
  13.        Box2      = 320;
  14.        Box3      = 480;
  15.        HelpMsg1  = 'Click any button on Scribble to begin drawing';
  16.        HelpMsg2  = 'Hold down left button to draw';
  17.  
  18. VAR    theMouse : resetRec;
  19.        mouses   : locRec;
  20. { --------------------------- }
  21.  
  22. PROCEDURE MenuBox (x1, x2 : INTEGER; Item : STRING);
  23.  
  24.     { Create a menu box between indicated x's at top of screen }
  25.  
  26. BEGIN
  27.   SetViewPort (x1+1, 1, x2-1, menu-1, FALSE);  { local to help area }
  28.   ClearViewPort;
  29.   OutTextXY (50, 7, item);                           { display text }
  30.   SetViewPort (0, 0, GetMaxX, HelpTop, FALSE);  { drawing work area }
  31. END;
  32. { --------------------------- }
  33.  
  34. PROCEDURE Help (Message : STRING);
  35.  
  36.     { Display help message at bottom of screen }
  37.  
  38. VAR    x : INTEGER;
  39.  
  40. BEGIN
  41.   X := (GetMaxX - TextWidth (message)) DIV 2;       { For centering }
  42.   SetViewPort (1, helpTop+1, 638, GetMaxY - 1, FALSE);
  43.   ClearViewPort;
  44.   OutTextXY (x, 3, message);                   { write help message }
  45.   SetViewPort (0, menu, 639, HelpTop, FALSE);   { drawing work area }
  46. END;
  47. { --------------------------- }
  48.  
  49. FUNCTION SetUpScreen : BOOLEAN;
  50.  
  51.     { Prepare screen, return TRUE if done, FALSE if can't }
  52.  
  53. VAR    driver, mode : INTEGER;
  54.  
  55. BEGIN
  56.   Driver := CGA;                              { use CGA hi-res mode }
  57.   Mode   := CGAhi;
  58.   InitGraph (driver, mode, '\TP');              { set graphics mode }
  59.   IF GraphResult = grOK THEN                     { if successful... }
  60.     BEGIN
  61.       SetColor (1);                                    { initialize }
  62.       SetTextStyle (DefaultFont, HorizDir, 1);
  63.       MenuBox (0, box1, 'Scribble');              { make menu boxes }
  64.       Rectangle (0, 0, box1, menu);
  65.       MenuBox (box1, box2, ' Clear');
  66.       Rectangle (box1, 0, box2, menu);
  67.       MenuBox (box2, box3, '  Quit');
  68.       Rectangle (box2, 0, box3, menu);
  69.       Rectangle (box3, 0, 639, menu);               { box for meter }
  70.       Rectangle (0, HelpTop, 639, GetMaxY);          { box for help }
  71.       Help (HelpMsg1);                       { initial help message }
  72.       SetUpScreen := TRUE;                             { successful }
  73.     END
  74.   ELSE
  75.     SetUpScreen := FALSE;                            { unsuccessful }
  76. END;
  77. { --------------------------- }
  78.  
  79. PROCEDURE UpdateMeter (x, y : INTEGER);
  80.  
  81.   { Update mouse position meter in upper right corner of display }
  82.  
  83. VAR    Position : STRING [8];
  84.        Number   : STRING [3];
  85.  
  86. BEGIN
  87.   Str (x : 3, number);                 { convert position to string }
  88.   Position := number;
  89.   Str (y : 3, number);
  90.   Position := position + ', ' + number;
  91.   MenuBox (box3, 639, position);                       { display it }
  92. END;
  93. { --------------------------- }
  94.  
  95. PROCEDURE Work;
  96.  
  97.     { Draw with mouse until user clicks on Quit selection }
  98.  
  99. VAR    thru : BOOLEAN;
  100.  
  101. BEGIN
  102.   Thru := FALSE;
  103.   REPEAT
  104.     TheEvents.flag := 0;                         { clear event flag }
  105.     REPEAT UNTIL theEvents.flag <> 0;        { wait for mouse event }
  106.     CASE theEvents.flag OF
  107.       $0001: BEGIN                                { mouse has moved }
  108.                IF ((theEvents.row > menu) AND
  109.                    (theEvents.row < HelpTop)) THEN   { in work area }
  110.                  IF theEvents.button = 1 THEN BEGIN { and left down }
  111.                    mHide;
  112.                    PutPixel (theEvents.col, theEvents.row, 1); {draw}
  113.                    mShow;
  114.                  END;
  115.                UpdateMeter (theEvents.col, theEvents.row); { update }
  116.              END;
  117.       $0004,
  118.       $0010,
  119.       $0040: BEGIN                            { any button released }
  120.                IF theEvents.row < menu THEN       { if in menu area }
  121.                  IF theEvents.col < box1 THEN           { Scribble? }
  122.                    BEGIN
  123.                      WITH cross DO
  124.                        mGraphCursor (hotX, hotY, seg (image^),
  125.                                      ofs (image^));
  126.                      Help (HelpMsg2);
  127.                    END
  128.                  ELSE
  129.                    IF theEvents.col < box2 THEN            { Clear? }
  130.                      BEGIN
  131.                        mHide;
  132.                        SetViewPort (0, menu+1, GetMaxX,
  133.                                     helpTop-1, TRUE);
  134.                        ClearViewPort;
  135.                        mShow;
  136.                        WITH hand DO
  137.                          mGraphCursor (hotX, hotY, seg (image^),
  138.                                        ofs (image^));
  139.                        Help (HelpMsg1);
  140.                      END
  141.                    ELSE
  142.                      IF theEvents.col < box3 THEN           { Quit? }
  143.                        thru := true;
  144.              END;  { of outer IF }
  145.     END;  { of CASE }
  146.   UNTIL thru;
  147. END;
  148. { --------------------------- }
  149.  
  150. BEGIN
  151.   InitGCurs;                             { Initialize cursor images }
  152.   mReset (theMouse);                             { Initialize mouse }
  153.   IF theMouse.exists THEN
  154.     BEGIN
  155.       theEvents.flag := 0;
  156.       IF SetUpScreen THEN                  { if in graphics mode... }
  157.         BEGIN
  158.           mInstTask (EventMask, seg (EventHandler),
  159.                      ofs (EventHandler));         { install handler }
  160.           WITH hand DO                         { show pointing hand }
  161.             mGraphCursor (hotX, hotY, seg (image^), ofs (image^));
  162.           mShow;
  163.           mPos (mouses);                       { Get mouse position }
  164.           UpdateMeter (mouses.column, mouses.row);
  165.           Work;                          { do what the program does }
  166.           mReset (theMouse);                  { shut down the mouse }
  167.           CloseGraph;                           { back to text mode }
  168.         END
  169.       ELSE
  170.         WRITELN ('Graphics mode not available. Program ended.');
  171.     END
  172.   ELSE
  173.     WRITELN ('Mouse not active. Program ended.');
  174. END.
  175.