home *** CD-ROM | disk | FTP | other *** search
/ Vectronix 2 / VECTRONIX2.iso / FILES_01 / HISPEED2.LZH / GEMDEMO / GRAF.PAS < prev    next >
Pascal/Delphi Source File  |  1991-07-02  |  6KB  |  146 lines
  1. {-------------------------------------------------------------------------
  2.                 HighSpeed Pascal GEM-interface demo program
  3.  
  4.                                 GRAF DEMO
  5.  
  6.                       Copyright (c) 1990 by D-House I
  7.                             All rights reserved
  8.  
  9.                       Programmed by Martin Eskildsen
  10. -------------------------------------------------------------------------}
  11. {$R-,S-,D+}
  12.  
  13. program Graf_Demo;
  14.  
  15. uses GemInterface, GemDecl, GemAES, GemVDI;
  16.  
  17. const
  18.   MinWidth      = 0;            { smallest width of rubber box  }
  19.   MinHeight     = 0;            { smallest height of rubber box }
  20.  
  21. var
  22.   mouseButton   : integer;      { mouse button state            }
  23.   mouseX        : integer;      { mouse X pos                   }
  24.   mouseY        : integer;      { mouse Y pos                   }
  25.   KbdState      : integer;      { kbd CTRL, SHIFT, ALT state    }
  26.   endW          : integer;      { end width of rubber box       }
  27.   endH          : integer;      { end height of rubber box      }
  28.  
  29. { Set up our own mouse shape }
  30. procedure SetOurOwnMouse;
  31. var
  32.   shape : Array_37;             { structure holding the mouse shape     }
  33. begin
  34.   shape[ 0] := 0;                            { hot spot = (0, 0)        }
  35.   shape[ 1] := 0;
  36.   shape[ 2] := 1;                            { must be so!              }
  37.   shape[ 3] := Black;                        { use black for mouse      }
  38.   shape[ 4] := Black;                        { use black for mask       }
  39.   shape[ 5] := Binary('00000000 00000000');  { mouse shape :            }
  40.   shape[ 6] := Binary('01110111 00011100');  { you can change it        }
  41.   shape[ 7] := Binary('00100010 00001000');  { yourself if you want     }
  42.   shape[ 8] := Binary('00100010 00001000');  { 1 = set pixel ;          }
  43.   shape[ 9] := Binary('00100010 00001000');  { 0 = clear pixel          }
  44.   shape[10] := Binary('00100010 00001000');
  45.   shape[11] := Binary('00100010 00001000');
  46.   shape[12] := Binary('00111110 00001000');
  47.   shape[13] := Binary('00100010 00001000');
  48.   shape[14] := Binary('00100010 00001000');
  49.   shape[15] := Binary('00100010 00001000');
  50.   shape[16] := Binary('00100010 00001000');
  51.   shape[17] := Binary('00100010 00001000');
  52.   shape[18] := Binary('00100010 00001000');
  53.   shape[19] := Binary('01110111 00011100');
  54.   shape[20] := Binary('00000000 00000000');
  55.  
  56.   shape[21] := Binary('00000000 00000000');  { the mask : }
  57.   shape[22] := Binary('00000000 00000000');
  58.   shape[23] := Binary('00000000 00000000');
  59.   shape[24] := Binary('00000000 00000000');
  60.   shape[25] := Binary('00000000 00000000');
  61.   shape[26] := Binary('00000000 00000000');
  62.   shape[27] := Binary('00000000 00000000');
  63.   shape[28] := Binary('00000000 00000000');
  64.   shape[29] := Binary('00000000 00000000');
  65.   shape[30] := Binary('00000000 00000000');
  66.   shape[31] := Binary('00000000 00000000');
  67.   shape[32] := Binary('00000000 00000000');
  68.   shape[33] := Binary('00000000 00000000');
  69.   shape[34] := Binary('00000000 00000000');
  70.   shape[35] := Binary('00000000 00000000');
  71.   shape[36] := Binary('00000000 00000000');
  72.  
  73.   graf_mouse(USER_DEF, @shape)                  { set the shape!        }
  74. end;
  75.  
  76. procedure WaitForLeftButton;
  77. begin
  78.   repeat
  79.     graf_mkstate(mouseX, mouseY, mouseButton, KbdState)
  80.   until mouseButton = 1
  81. end;
  82.  
  83. { Move (drag) a rectangle within another rectangle }
  84. procedure MoveRectangle;
  85. var
  86.   x, y : integer;       { moved rectangle's end x,y }
  87. begin
  88.   OpenOutputWindow;
  89.   Inform('Press left mouse button :');
  90.   graf_mouse(M_ON, NIL);
  91.   WaitForLeftButton;
  92.   graf_mouse(M_OFF, NIL);
  93.   Inform('Move the small rectangle :');
  94.   graf_mouse(M_ON, NIL);
  95.   with OutputWindow do
  96.     graf_dragbox(50, 20,                          { small rect w, h       }
  97.                  MouseX, MouseY,                  { start x, y            }
  98.                  wX, wY,                          { big rect x, y         }
  99.                  wW, wH,                          { big rect w, h         }
  100.                  x, y);                           { small's end x, y      }
  101.   graf_mouse(M_OFF, NIL);
  102.   CloseOutputWindow
  103. end;
  104.  
  105. begin { main }
  106.   if Init_Gem then begin
  107.     Message('Welcome to the Graf library demonstration!');
  108.     Message('You know the growing box?');
  109.     graf_growbox( MinX + (MaxW - 20) div 2,     { start x        }
  110.                   MinY + (MaxH - 20) div 2,     { start y        }
  111.                   40, 40,                       { start w, h     }
  112.                   MinX, MinY, MaxW, MaxH );     { end x, y, w, h }
  113.  
  114.     Message('We can shrink it too...');
  115.     graf_shrinkbox( MinX + (MaxW - 20) div 2, MinY + (MaxH - 20) div 2, 40, 40,
  116.                     MinX, MinY, MaxW, MaxH );
  117.     { note that the parameter order is the same as graf_growbox }
  118.  
  119.     Message('and move boxes around the screen fastly...');
  120.     graf_movebox(30, 30,                        { w, h          }
  121.                  MinX, MinY,                    { start x,y     }
  122.                  MaxX - 50, MaxY - 50);         { end x,y       }
  123.  
  124.     Message('We can change the appearance of the mouse...');
  125.     graf_mouse(POINT_HAND, NIL);
  126.  
  127.     Message('and set our own...');
  128.     SetOurOwnMouse;
  129.  
  130.     Message('but we like the familiar arrow more, don''t we?');
  131.     graf_mouse(ARROW, NIL);
  132.  
  133.     Inform('Let''s do a rubber box :');
  134.     graf_mouse(M_ON, NIL);              { turn mouse on         }
  135.     WaitForLeftButton;
  136.     graf_rubbox(mouseX, mouseY, MinWidth, MinHeight, endW, endH);
  137.     graf_mouse(M_OFF, NIL);             { turn mouse off        }
  138.  
  139.     MoveRectangle;
  140.  
  141.     Message('That''s all folks!');
  142.  
  143.     Exit_Gem
  144.   end
  145. end.
  146.