home *** CD-ROM | disk | FTP | other *** search
/ World of Shareware - Software Farm 2 / wosw_2.zip / wosw_2 / PASCAL / RODENT_3.ZIP / QPRODENT.PAS < prev    next >
Pascal/Delphi Source File  |  1989-12-16  |  3KB  |  123 lines
  1. PROGRAM qprodent;
  2.  
  3. { Demo program to show how to define a mouse graphics cursor.
  4.  
  5.   Written in Microsoft QuickPascal version 1.0.
  6.  
  7.   Hardware req'ts : CGA, EGA, or VGA
  8.                     Microsoft-compatible mouse}
  9.  
  10. USES MSGraph, Mouse;
  11.  
  12. { Define an hourglass-shaped mouse graphics cursor }
  13. TYPE MCursorType = ARRAY[0..31] OF Word;
  14. CONST MCursor : MCursorType =
  15.  
  16.   { Screen mask }
  17.  
  18.    ($0001,  { 0000000000000001 }
  19.     $0001,  { 0000000000000001 }
  20.     $8003,  { 1000000000000011 }
  21.     $C7C7,  { 1100011111000111 }
  22.     $E38F,  { 1110001110001111 }
  23.     $F11F,  { 1111000100011111 }
  24.     $F83F,  { 1111100000111111 }
  25.     $FC7F,  { 1111110001111111 }
  26.     $F83F,  { 1111100000111111 }
  27.     $F11F,  { 1111000100011111 }
  28.     $E38F,  { 1110001110001111 }
  29.     $C7C7,  { 1100011111000111 }
  30.     $8003,  { 1000000000000011 }
  31.     $0001,  { 0000000000000001 }
  32.     $0001,  { 0000000000000001 }
  33.     $0000,  { 0000000000000000 }
  34.  
  35.   { Cursor mask }
  36.  
  37.     $0000,  { 0000000000000000 }
  38.     $7FFC,  { 0111111111111100 }
  39.     $2008,  { 0010000000001000 }
  40.     $1010,  { 0001000000010000 }
  41.     $0820,  { 0000100000100000 }
  42.     $0440,  { 0000010001000000 }
  43.     $0280,  { 0000001010000000 }
  44.     $0100,  { 0000000100000000 }
  45.     $0280,  { 0000001010000000 }
  46.     $0440,  { 0000010001000000 }
  47.     $0820,  { 0000100000100000 }
  48.     $1010,  { 0001000000010000 }
  49.     $2008,  { 0010000000001000 }
  50.     $7FFC,  { 0111111111111100 }
  51.     $0000,  { 0000000000000000 }
  52.     $0000); { 0000000000000000 }
  53.  
  54. VAR
  55.     Buttons,                     { Number of mouse buttons }
  56.     MouseX, MouseY, MouseButton, { Mouse cursor loc and button info }
  57.     rightbutton,                 { Where to print mouse right button }
  58.     GrStat : Integer;            { Return status from _SetVideoMode }
  59.  
  60.     GotMouse : Boolean;
  61.  
  62. PROCEDURE ShowButton(Loc, Condition : Integer);
  63. BEGIN
  64.   _SetTextPosition(2, Loc);
  65.   IF (Condition = 0) THEN
  66.     write('   ')
  67.   ELSE
  68.     write('███');
  69. END;
  70.  
  71. BEGIN {main}
  72.   GrStat := _SetVideoMode(_HResBW);
  73.   IF (GrStat = 0) THEN
  74.     BEGIN
  75.     Writeln('This program requires a CGA or other color adapter.');
  76.     Halt(1);
  77.     END;
  78.   GotMouse := ms_init(buttons); { Initialize mouse and get # of buttons }
  79.   IF NOT GotMouse THEN
  80.     BEGIN
  81.     GrStat := _SetVideoMode(_DefaultMode);
  82.     Writeln('No mouse detected.');
  83.     Halt(1);
  84.     END;
  85.  
  86.   IF (Buttons = 3) THEN
  87.     RightButton := 42
  88.   ELSE
  89.     RightButton := 35;
  90.   Writeln('╔════╗                    ┌───┐  ┌───┐');
  91.   Writeln('║Quit║  x = xxx  y = yyy  │   │  │   │');
  92.   Writeln('╚════╝                    └───┘  └───┘');
  93.   IF (Buttons = 3) THEN
  94.     BEGIN
  95.     _SetTextPosition(1, RightButton - 1);
  96.     Write('┌───┐');
  97.     _SetTextPosition(2, RightButton - 1);
  98.     Write('│   │');
  99.     _SetTextPosition(3, RightButton - 1);
  100.     Write('└───┘');
  101.     END;
  102.  
  103.   ms_set_graphPointer(7, 7, @MCursor);
  104.   ms_show;
  105.  
  106.   { Main program loop }
  107.   REPEAT
  108.     ms_read(MouseX, MouseY, MouseButton);
  109.     _SetTextPosition(2, 13);
  110.     write(MouseX:3);
  111.     _SetTextPosition(2, 22);
  112.     write(MouseY:3);
  113.     ShowButton(28, MouseButton AND 1);
  114.     ShowButton(RightButton, MouseButton AND 2);
  115.     IF (Buttons = 3) THEN
  116.       ShowButton(35, MouseButton AND 4);
  117.   UNTIL ((MouseButton = 1) AND (MouseX < 48) AND (MouseY < 24));
  118.  
  119.   ms_hide;
  120.   GrStat := _SetVideoMode(_DefaultMode);
  121. END.
  122.  
  123.