home *** CD-ROM | disk | FTP | other *** search
/ Power Programming / powerprogramming1994.iso / progtool / pascal / qp_paint.arc / CMOUSE.PAS next >
Pascal/Delphi Source File  |  1989-05-22  |  17KB  |  359 lines

  1. {$B-,F-,I+,R+}
  2.  
  3. unit CMouse;
  4.  
  5. { Define TMouse - a class for accessing the mouse }
  6.  
  7. { Copyright 1989
  8.   Scott Bussinger
  9.   110 South 131st Street
  10.   Tacoma, WA  98444
  11.   (206)531-8944
  12.   Compuserve 72247,2671 }
  13.  
  14. interface
  15.  
  16. uses CObject,MSGraph;
  17.  
  18. type MouseButton = (Left,Right,Middle);
  19.      MouseCursor = (DefaultCursor,PenCursor,BucketCursor,HandCursor);
  20.      MouseStatus = (Idle,Pressed,Released,Held);
  21.  
  22. type TMouse = object(TObject)
  23.        fCurrentCursor: MouseCursor;              { Current style of mouse cursor }
  24.        fLastButtonStatus: word;                  { Button status at last call to Update }
  25.        fLastLocationX: integer;                  { Horizontal cursor location at last call to Update }
  26.        fLastLocationY: integer;                  { Vertical cursor location at last call to Update }
  27.        fMouseFactor: integer;                    { Horizontal scaling factor for current video mode }
  28.        fPreviousButtonStatus: word;              { Button status at second to last call to Update }
  29.        fTextCursorEnabled: boolean;              { True if the text cursor is enabled }
  30.        fTextCursorHeight: integer;               { Height of text cursor in pixels }
  31.        fVisible: boolean;                        { True if the mouse cursor is currently visible }
  32.  
  33.        function Init: boolean;                   { Initialize the mouse and return true if mouse present }
  34.        procedure DisableTextCursor;              { Disable the text cursor }
  35.        procedure EnableTextCursor;               { Enable the text cursor display }
  36.        function GetLocationX: integer;           { Returns last horizontal location }
  37.        function GetLocationY: integer;           { Returns last vertical location }
  38.        function GetButton(Button: MouseButton): MouseStatus; { Returns last status of a mouse button }
  39.        procedure Hide;                           { Turn mouse cursor off }
  40.        procedure SetCursor(NewCursor: MouseCursor); { Change to a new cursor shape }
  41.        procedure SetTextCursor(Height: integer); { Turn on the text cursor }
  42.        procedure Show;                           { Turn mouse cursor on }
  43.        procedure Update;                         { Update the currect mouse status }
  44.        end;
  45.  
  46. var Mouse: TMouse;
  47.  
  48. implementation
  49.  
  50. uses Dos,CWindow;
  51.  
  52. const Cursor: array[MouseCursor] of record
  53.         HotSpot: record
  54.           X: integer;
  55.           Y: integer
  56.           end;
  57.         ScreenMask: array[0..15] of word;
  58.         CursorMask: array[0..15] of word
  59.         end =
  60.          ((HotSpot:(X:0; Y:0);                   { Hot spot is tip of arrow }
  61.            ScreenMask:($3FFF,                    { 0011111111111111 } { DefaultCursor }
  62.                        $1FFF,                    { 0001111111111111 }
  63.                        $0FFF,                    { 0000111111111111 }
  64.                        $07FF,                    { 0000011111111111 }
  65.                        $03FF,                    { 0000001111111111 }
  66.                        $01FF,                    { 0000000111111111 }
  67.                        $00FF,                    { 0000000011111111 }
  68.                        $007F,                    { 0000000001111111 }
  69.                        $003F,                    { 0000000000111111 }
  70.                        $001F,                    { 0000000000011111 }
  71.                        $01FF,                    { 0000000111111111 }
  72.                        $10FF,                    { 0001000011111111 }
  73.                        $30FF,                    { 0011000011111111 }
  74.                        $F87F,                    { 1111100001111111 }
  75.                        $F87F,                    { 1111100001111111 }
  76.                        $FC3F);                   { 1111110000111111 }
  77.            CursorMask:($0000,                    { 0000000000000000 }
  78.                        $4000,                    { 0100000000000000 }
  79.                        $6000,                    { 0110000000000000 }
  80.                        $7000,                    { 0111000000000000 }
  81.                        $7800,                    { 0111100000000000 }
  82.                        $7C00,                    { 0111110000000000 }
  83.                        $7E00,                    { 0111111000000000 }
  84.                        $7F00,                    { 0111111100000000 }
  85.                        $7F80,                    { 0111111110000000 }
  86.                        $78C0,                    { 0111111111000000 }
  87.                        $7C00,                    { 0111110000000000 }
  88.                        $4600,                    { 0100011000000000 }
  89.                        $0600,                    { 0000011000000000 }
  90.                        $0300,                    { 0000001100000000 }
  91.                        $0300,                    { 0000001100000000 }
  92.                        $0180)),                  { 0000000110000000 }
  93.           (HotSpot:(X:1; Y:15);                  { Hot spot is just beyond tip of pen }
  94.            ScreenMask:($FFCF,                    { 1111111111001111 } { PenCursor}
  95.                        $FF87,                    { 1111111110000111 }
  96.                        $FF03,                    { 1111111100000011 }
  97.                        $FE01,                    { 1111111000000001 }
  98.                        $FC03,                    { 1111110000000011 }
  99.                        $F807,                    { 1111100000000111 }
  100.                        $F00F,                    { 1111000000001111 }
  101.                        $E01F,                    { 1110000000011111 }
  102.                        $C03F,                    { 1100000000111111 }
  103.                        $807F,                    { 1000000001111111 }
  104.                        $00FF,                    { 0000000011111111 }
  105.                        $01FF,                    { 0000000111111111 }
  106.                        $03FF,                    { 0000001111111111 }
  107.                        $07FF,                    { 0000011111111111 }
  108.                        $0FFF,                    { 0000111111111111 }
  109.                        $9FFF);                   { 1001111111111111 }
  110.            CursorMask:($0000,                    { 0000000000000000 }
  111.                        $0030,                    { 0000000000110000 }
  112.                        $0078,                    { 0000000001111000 }
  113.                        $009C,                    { 0000000010011100 }
  114.                        $01E8,                    { 0000000111101000 }
  115.                        $03F0,                    { 0000001111110000 }
  116.                        $07E0,                    { 0000011111100000 }
  117.                        $0FC0,                    { 0000111111000000 }
  118.                        $1F80,                    { 0001111110000000 }
  119.                        $2700,                    { 0010011100000000 }
  120.                        $7A00,                    { 0111101000000000 }
  121.                        $5C00,                    { 0101110000000000 }
  122.                        $4800,                    { 0100100000000000 }
  123.                        $5000,                    { 0101000000000000 }
  124.                        $6000,                    { 0110000000000000 }
  125.                        $0000)),                  { 0000000000000000 }
  126.           (HotSpot:(X:14; Y:14);                 { Hot spot is just beyond tip of pen }
  127.            ScreenMask:($FFCF,                    { 1111111111001111 } { BucketCursor }
  128.                        $FF87,                    { 1111111110000111 }
  129.                        $FE03,                    { 1111111000000011 }
  130.                        $F803,                    { 1111100000000011 }
  131.                        $E001,                    { 1110000000000001 }
  132.                        $C001,                    { 1100000000000001 }
  133.                        $8000,                    { 1000000000000000 }
  134.                        $0000,                    { 0000000000000000 }
  135.                        $0000,                    { 0000000000000000 }
  136.                        $8000,                    { 1000000000000000 }
  137.                        $8008,                    { 1000000000001000 }
  138.                        $8018,                    { 1000000000011000 }
  139.                        $C078,                    { 1100000001111000 }
  140.                        $C0F8,                    { 1100000011111000 }
  141.                        $C3F8,                    { 1100001111111000 }
  142.                        $E7F8);                   { 1110011111111000 }
  143.            CursorMask:($0000,                    { 0000000000000000 }
  144.                        $0030,                    { 0000000000110000 }
  145.                        $0048,                    { 0000000001001000 }
  146.                        $0188,                    { 0000000110001000 }
  147.                        $0604,                    { 0000011000000100 }
  148.                        $1804,                    { 0001100000000100 }
  149.                        $2002,                    { 0010000000000010 }
  150.                        $7FFE,                    { 0111111111111110 }
  151.                        $7FFA,                    { 0111111111111010 }
  152.                        $3FF2,                    { 0011111111110010 }
  153.                        $3FE2,                    { 0011111111100010 }
  154.                        $3F82,                    { 0011111110000010 }
  155.                        $1F02,                    { 0001111100000010 }
  156.                        $1C02,                    { 0001110000000010 }
  157.                        $1802,                    { 0001100000000010 }
  158.                        $0000)),                  { 0000000000000000 }
  159.           (HotSpot:(X:4; Y:0);                   { Hot spot is just beyond tip of pen }
  160.            ScreenMask:($F3FF,                    { 1111001111111111 } { HandCursor }
  161.                        $E1FF,                    { 1110000111111111 }
  162.                        $E1FF,                    { 1110000111111111 }
  163.                        $E1FF,                    { 1110000111111111 }
  164.                        $E001,                    { 1110000000000001 }
  165.                        $E000,                    { 1110000000000000 }
  166.                        $E000,                    { 1110000000000000 }
  167.                        $E000,                    { 1110000000000000 }
  168.                        $8000,                    { 1000000000000000 }
  169.                        $0000,                    { 0000000000000000 }
  170.                        $0000,                    { 0000000000000000 }
  171.                        $0000,                    { 0000000000000000 }
  172.                        $0000,                    { 0000000000000000 }
  173.                        $0000,                    { 0000000000000000 }
  174.                        $8001,                    { 1000000000000001 }
  175.                        $C003);                   { 1100000000000011 }
  176.            CursorMask:($0C00,                    { 0000110000000000 }
  177.                        $1200,                    { 0001001000000000 }
  178.                        $1200,                    { 0001001000000000 }
  179.                        $1200,                    { 0001001000000000 }
  180.                        $13FE,                    { 0001001111111110 }
  181.                        $1249,                    { 0001001001001001 }
  182.                        $1249,                    { 0001001001001001 }
  183.                        $1249,                    { 0001001001001001 }
  184.                        $7249,                    { 0111001001001001 }
  185.                        $9001,                    { 1001000000000001 }
  186.                        $9001,                    { 1001000000000001 }
  187.                        $9001,                    { 1001000000000001 }
  188.                        $8001,                    { 1000000000000001 }
  189.                        $8001,                    { 1000000000000001 }
  190.                        $4002,                    { 0100000000000010 }
  191.                        $3FFC)));                 { 0011111111111100 }
  192.  
  193. const CurrentTextCursorLineStyle: word = $FFFF;  { Line style for drawing text cursor }
  194.  
  195. procedure MouseCall(    AX: word;
  196.                     var MouseRegs: Registers);
  197.   { Execute a call to the mouse driver }
  198.   begin
  199.   MouseRegs.AX := AX;
  200.   Intr($33,MouseRegs)
  201.   end;
  202.  
  203. procedure XorTextCursor(Height: integer);
  204.   { Draw/Undraw the text cursor }
  205.   var SaveStatus: GraphicsStatus;
  206.   begin
  207.   CurrentCanvas.Activate;                        { Make sure the text cursor stays in the drawing window }
  208.   GetGraphicsStatus(SaveStatus);
  209.   _SetLineStyle(CurrentTextCursorLineStyle);
  210.   _SetWriteMode(_GXOR);
  211.   _SetColor(SystemWhite);
  212.   _LineTo(SaveStatus.Position.XCoord,SaveStatus.Position.YCoord+Height);
  213.   SetGraphicsStatus(SaveStatus)
  214.   end;
  215.  
  216. function TMouse.Init: boolean;
  217.   { Initialize the mouse and return true if mouse present }
  218.   var MouseRegs: Registers;
  219.       MouseVector: pointer;
  220.       VideoConfig: _VideoConfig;
  221.   begin
  222.   GetIntVec($33,MouseVector);
  223.   if MouseVector <> nil
  224.    then
  225.     begin
  226.     MouseCall(0,MouseRegs);
  227.     if MouseRegs.AX = $FFFF
  228.      then
  229.       begin
  230.       Init := true;
  231.  
  232.       _GetVideoConfig(VideoConfig);
  233.       if VideoConfig.NumXPixels <= 320           { Watch out for these odd modes with the mouse }
  234.        then
  235.         self.fMouseFactor := 1
  236.        else
  237.         self.fMouseFactor := 0;
  238.  
  239.       self.fVisible := false;
  240.       self.fCurrentCursor := PenCursor;          { So the next statement works correctly }
  241.       self.SetCursor(DefaultCursor);
  242.       self.fTextCursorHeight := 1;
  243.       self.fTextCursorEnabled := false;          { Text cursor is off initially }
  244.       self.Update
  245.       end
  246.      else
  247.       Init := false
  248.     end
  249.    else
  250.     Init := false
  251.   end;
  252.  
  253. procedure TMouse.DisableTextCursor;
  254.   { Turn off the text cursor }
  255.   begin
  256.   if self.fTextCursorEnabled then
  257.     begin
  258.     self.Hide;                                   { So the old cursor gets erased }
  259.     self.fTextCursorEnabled := false             { Don't display cursor anymore }
  260.     end
  261.   end;
  262.  
  263. procedure TMouse.EnableTextCursor;
  264.   { Turn on the text cursor }
  265.   begin
  266.   if not self.fTextCursorEnabled then
  267.     begin
  268.     self.Hide;
  269.     self.fTextCursorEnabled := true
  270.     end
  271.   end;
  272.  
  273. procedure TMouse.Hide;
  274.   { Turn mouse cursor off }
  275.   var MouseRegs: Registers;
  276.   begin
  277.   if self.fVisible then
  278.     begin
  279.     self.fVisible := false;
  280.     MouseCall(2,MouseRegs);
  281.     if self.fTextCursorEnabled then              { Draw the text cursor }
  282.       XorTextCursor(self.fTextCursorHeight)
  283.     end
  284.   end;
  285.  
  286. procedure TMouse.SetCursor(NewCursor: MouseCursor);
  287.   { Change to a new cursor shape }
  288.   var MouseRegs: Registers;
  289.   begin
  290.   if self.fCurrentCursor <> NewCursor then       { Don't flicker the screen if the cursor style didn't change }
  291.     begin
  292.     self.fCurrentCursor := NewCursor;
  293.     with MouseRegs do
  294.       begin
  295.       BX := word(Cursor[NewCursor].HotSpot.X);
  296.       CX := word(Cursor[NewCursor].HotSpot.Y);
  297.       DX := ofs(Cursor[NewCursor].ScreenMask);
  298.       ES := seg(Cursor[NewCursor].ScreenMask)
  299.       end;
  300.     MouseCall(9,MouseRegs)
  301.     end
  302.   end;
  303.  
  304. procedure TMouse.SetTextCursor(Height: integer);
  305.   { Set the height of the text cursor }
  306.   begin
  307.   self.fTextCursorHeight := Height
  308.   end;
  309.  
  310. procedure TMouse.Show;
  311.   { Turn mouse cursor on }
  312.   var MouseRegs: Registers;
  313.   begin
  314.   if not self.fVisible then
  315.     begin
  316.     self.fVisible := true;
  317.     if self.fTextCursorEnabled then
  318.       XorTextCursor(self.fTextCursorHeight);
  319.     MouseCall(1,MouseRegs)
  320.     end
  321.   end;
  322.  
  323. procedure TMouse.Update;
  324.   { Update the currect mouse status }
  325.   var MouseRegs: Registers;
  326.   begin
  327.   MouseCall(3,MouseRegs);
  328.   with MouseRegs do
  329.     begin
  330.     self.fPreviousButtonStatus := self.fLastButtonStatus;
  331.     self.fLastButtonStatus := BX;
  332.     self.fLastLocationX := CX shr self.fMouseFactor;
  333.     self.fLastLocationY := DX
  334.     end
  335.   end;
  336.  
  337. function TMouse.GetLocationX: integer;
  338.   { Returns last horizontal location }
  339.   begin
  340.   GetLocationX := self.fLastLocationX
  341.   end;
  342.  
  343. function TMouse.GetLocationY: integer;
  344.   { Returns last vertical location }
  345.   begin
  346.   GetLocationY := self.fLastLocationY
  347.   end;
  348.  
  349. function TMouse.GetButton(Button: MouseButton): MouseStatus;
  350.   { Returns last status of a button }
  351.   var ButtonMask: word;
  352.   begin
  353.   ButtonMask := $0001 shl ord(Button);
  354.   GetButton := MouseStatus(2 * byte((self.fPreviousButtonStatus and ButtonMask)<>0) +
  355.                                byte((self.fLastButtonStatus and ButtonMask)<>0))
  356.   end;
  357.  
  358. end.
  359.