home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / vpbgib2.zip / DRAW.PAS < prev    next >
Pascal/Delphi Source File  |  1996-11-02  |  4KB  |  134 lines
  1. {█▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀█}
  2. {█                                                       █}
  3. {█      Virtual Pascal Examples. Version 1.10            █}
  4. {█      Graph/VP mouse input example                     █}
  5. {█      ─────────────────────────────────────────────────█}
  6. {█      Copyright (C) 1995-96 fPrint UK Ltd              █}
  7. {█                                                       █}
  8. {▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀}
  9.  
  10. program Draw;
  11.  
  12. uses
  13.   Use32,
  14. {$IFDEF TEXTMODE}
  15.   {$PMTYPE VIO}
  16.   Crt, Graph;
  17. {$ELSE}
  18.   {$PMTYPE PM}
  19.   DGraph;
  20. {$ENDIF}
  21.  
  22. const
  23.   EventTxt: Array[MouseEventT] of String
  24.    = ( 'mb1Click', 'mb1DblClick', 'mb1BeginDrag', 'mb1EndDrag', 'mb1Down', 'mb1Up',
  25.        'mb2Click', 'mb2DblClick', 'mb2BeginDrag', 'mb2EndDrag', 'mb2Down', 'mb2Up' );
  26.  
  27. procedure Drawing;
  28. var
  29.   x,y, LastX,LastY : Word;
  30.   Mx, My : Word;
  31.   StartX, StartY: Word;
  32.   NewX, NewY: Word;
  33.   Event: MouseEventT;
  34.   Mouse: Boolean;
  35.   Ch: Char;
  36.   Dragging: Boolean;
  37.   GotEvent: Boolean;
  38.   Color: Word;
  39.  
  40.   procedure DrawDragRect;
  41.   begin
  42.     SetColor( 15 );
  43.     SetWriteMode(XORPut);
  44.     NewX := Mx;
  45.     NewY := My;
  46.     {$IFDEF TEXTMODE}
  47.     Gotoxy( 1, WhereY );
  48.     Write( '   Dragging to ',Newx:10,Newy:10);
  49.     {$ENDIF}
  50.     Rectangle( StartX, StartY, Newx, Newy );
  51.     SetWriteMode(NormalPut);
  52.   end;
  53.  
  54. begin
  55.   Dragging := False;
  56.   repeat
  57.     if Dragging then
  58.       begin
  59.         GotEvent := ReadKeyOrMouse( 30, Mouse, Ch, Event, Mx, My );
  60.         DrawDragRect;
  61.         if not GotEvent then
  62.           // Get mouse position
  63.           GetMousePos( Mx, My );
  64.       end
  65.     else
  66.       GotEvent := ReadKeyOrMouse( -1, Mouse, Ch, Event, Mx, My );
  67.     if GotEvent then
  68.       if Mouse then
  69.         begin
  70.           {$IFDEF TEXTMODE}
  71.           if Dragging then
  72.             Writeln;
  73.           Writeln( EventTxt[Event]:15, Mx:10, My:10 );
  74.           {$ENDIF}
  75.           case Event of
  76.             mb1Click: begin
  77.               SetColor( 10 ); Circle( mx,my,20 );
  78.             end;
  79.             mb2Click: begin
  80.               SetColor( 13 ); FloodFill( mx,my, 15 );
  81.             end;
  82.             mb1BeginDrag, mb2BeginDrag: begin
  83.               StartX := Mx;   StartY := My;
  84.               Dragging := True;
  85.             end;
  86.             mb1EndDrag: begin
  87.               Dragging := False;
  88.               SetColor( Random(255) );
  89.               SetLineStyle( 0, 0, ThickWidth );
  90.               Ellipse( (Mx+StartX) div 2, (My+StartY) div 2, 0, 360,
  91.                        abs(Mx-StartX) div 2, abs(My-StartY) div 2 );
  92.               SetLineStyle( 0, 0, NormWidth );
  93.             end;
  94.             mb2EndDrag: begin
  95.               Dragging := False;
  96.               Color := Random(255);
  97.               SetColor( Color );
  98.               SetLineStyle( 0, 0, ThickWidth );
  99.               SetFillStyle(Random(12), Color);
  100.               FillEllipse( (Mx+StartX) div 2, (My+StartY) div 2,
  101.                        abs(Mx-StartX) div 2, abs(My-StartY) div 2 );
  102.               SetLineStyle( 0, 0, NormWidth );
  103.             end;
  104.           end;
  105.         end
  106.       else
  107.         begin
  108.           GetMousePos( x, y );
  109.           OutTextXY( x, y, Ch );
  110.         end;
  111.     if Dragging then
  112.       DrawDragRect;
  113.   until ( Ch = #27 );
  114. end;
  115.  
  116. begin
  117. //  AutoStartServer := False;
  118.   {$IFDEF TEXTMODE}
  119.   Writeln( 'BGI/VP mouse demo                 (C) fPrint UK Ltd 1996' );
  120.   Writeln;
  121.   Writeln( 'Try clicking with the mouse buttons and dragging');
  122.   Writeln( 'with both mb1 and mb2' );
  123.   {$ENDIF}
  124.   VPInitGraph( 500, 400, '' );
  125.   {$IFNDEF TEXTMODE}
  126.   SetTextJustify( CenterText, TopText );
  127.   OutTextXY( 250, 3, 'BGI/VP mouse demo         (C) fPrint UK Ltd 1996' );
  128.   {$ENDIF}
  129.  
  130.   Randomize;
  131.   Drawing;
  132.   CloseGraph;
  133. end.
  134.