home *** CD-ROM | disk | FTP | other *** search
/ World of Shareware - Software Farm 2 / wosw_2.zip / wosw_2 / PASCAL / RODENT_3.ZIP / TPRODENT.PAS < prev   
Pascal/Delphi Source File  |  1989-12-16  |  5KB  |  182 lines
  1. PROGRAM tprodent;
  2.  
  3. { Demo program to show how to define a mouse graphics cursor.
  4.  
  5.   Written in Borland Turbo Pascal version 5.0.
  6.  
  7.   Hardware req'ts : CGA, EGA, or VGA
  8.                     Microsoft-compatible mouse}
  9.  
  10. USES Dos, Graph;
  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.     OldX, OldY,                  { Save old X and Y }
  60.     GraphDriver, GraphMode : Integer;
  61.     GotMouse : Boolean;
  62.     Regs : Registers;
  63.     StrBuf : String[5];
  64.  
  65. PROCEDURE ms_hide;
  66. BEGIN
  67.   Regs.AX := 2;
  68.   Intr($33, Regs);
  69. END;
  70.  
  71. PROCEDURE ms_init(VAR Exists:Boolean; VAR Button:Integer);
  72. BEGIN
  73.   Regs.AX := 0;
  74.   Intr($33, Regs);
  75.   Exists := TRUE;
  76.   Button := Regs.BX;
  77.   IF (Regs.AX = 0) THEN
  78.     BEGIN
  79.     Exists := FALSE;
  80.     Button := 0;
  81.   END;
  82. END;
  83.  
  84. PROCEDURE ms_read(VAR x, y, b : Integer);
  85. BEGIN
  86.   Regs.AX := 3;
  87.   Intr($33, Regs);
  88.   x := Regs.CX;
  89.   y := Regs.DX;
  90.   b := Regs.BX;
  91. END;
  92.  
  93. PROCEDURE ms_set_graphPointer(HotX, HotY: Integer; VAR Pattern:MCursorType);
  94. BEGIN
  95.   Regs.AX := 9;    { Function 9 }
  96.   Regs.BX := HotX; { X-ordinate of hot spot }
  97.   Regs.CX := HotY; { Y-ordinate of hot spot }
  98.   Regs.DX := Ofs(Pattern);
  99.   Regs.ES := Seg(Pattern);
  100.   Intr($33, Regs);
  101. END;
  102.  
  103. PROCEDURE ms_show;
  104. BEGIN
  105.   Regs.AX := 1;
  106.   intr($33, Regs);
  107. END;
  108.  
  109. PROCEDURE ShowButton(Loc, Condition : Integer);
  110. BEGIN
  111.   IF (Condition = 0) THEN
  112.     SetFillStyle(EmptyFill, 1)
  113.   ELSE
  114.   SetFillStyle(SolidFill, 1);
  115.   Bar(Loc * 8 + 3, 8, (Loc + 2) * 8 + 3, 15);
  116. END;
  117.  
  118. BEGIN {main}
  119.   GraphDriver := CGA;
  120.   GraphMode := CGAHi;
  121.   InitGraph(GraphDriver, GraphMode, '');
  122.   GrStat := GraphResult;
  123.   IF (GrStat <> 0) THEN
  124.     BEGIN
  125.     Writeln('This program requires a CGA or other color adapter.');
  126.     Halt(1);
  127.     END;
  128.   ms_init(GotMouse, Buttons);
  129.   IF NOT GotMouse THEN
  130.     BEGIN
  131.     CloseGraph;
  132.     Writeln('No mouse detected.');
  133.     Halt(1);
  134.     END;
  135.  
  136.   IF (Buttons = 3) THEN
  137.     RightButton := 42
  138.   ELSE
  139.     RightButton := 35;
  140.   OutTextXY(0, 0, '╔════╗                     ┌───┐  ┌───┐');
  141.   OutTextXY(0, 8, '║Quit║  x = xxx  y = yyy   │   │  │   │');
  142.   OutTextXY(0,16, '╚════╝                     └───┘  └───┘');
  143.   IF (Buttons = 3) THEN
  144.     BEGIN
  145.     OutTextXY(RightButton * 8 - 8,  0, '┌───┐');
  146.     OutTextXY(RightButton * 8 - 8,  8, '│   │');
  147.     OutTextXY(RightButton * 8 - 8, 16, '└───┘');
  148.     END;
  149.  
  150.   ms_set_graphPointer(7, 7, MCursor);
  151.   ms_show;
  152.  
  153.   { Main program loop }
  154.   REPEAT
  155.     ms_read(MouseX, MouseY, MouseButton);
  156.     IF (MouseX <> OldX) THEN
  157.       BEGIN
  158.       OldX := MouseX;
  159.       Str(MouseX:3, StrBuf);
  160.       SetFillStyle(EmptyFill, 1);
  161.       Bar(12*8, 8, 14*8 + 7, 15);
  162.       OutTextXY(12*8, 8, StrBuf);
  163.       END;
  164.     IF (MouseY <> OldY) THEN
  165.       BEGIN
  166.       OldY := MouseY;
  167.       Str(MouseY:3, StrBuf);
  168.       SetFillStyle(EmptyFill, 1);
  169.       Bar(21*8, 8, 23*8 + 7, 15);
  170.       OutTextXY(21*8, 8, StrBuf);
  171.       END;
  172.     ShowButton(28, MouseButton AND 1);
  173.     ShowButton(RightButton, MouseButton AND 2);
  174.     IF (Buttons = 3) THEN
  175.       ShowButton(35, MouseButton AND 4);
  176.   UNTIL ((MouseButton = 1) AND (MouseX < 48) AND (MouseY < 24));
  177.  
  178.   ms_hide;
  179.   CloseGraph;
  180. END.
  181.  
  182.