
Mouse support unit
(* Author: Tao Yue
Date: May 11, 1996
Program History:
0.01 05/11/96 Basic mouse algorithm coded
0.02 05/11/96 Added procedure to reset registers; doesn't lock
up anymore
0.03 07/09/96 Removed the TestMouse procedures; instead, changed
the program into an include file for common use
by my future programs.
0.04 06/27/98 Made it into a self-contained, compilable unit.
Description:
Basic Mouse Functions for DOS
*** DO NOT USE THIS UNIT IN WINDOWS ***
*)
unit Mouse;
interface
uses
Dos;
type
ButtonType = (Left, Right, Both, None);
var
Params : Registers;
XRange,
YRange,
X,
Y : word;
Buttons : ButtonType;
procedure OpenMouse;
procedure CloseMouse;
procedure ShowMouse;
procedure HideMouse;
procedure GetMouseStatus (var X, Y : word; Buttons : ButtonType);
procedure SetRange (XRange, YRange : word);
procedure MoveMouse (var X, Y : word);
function InRange (X, Y, ULX, ULY, BRX, BRY : word) : Boolean;
(**************************************************************************)
implementation
procedure CallMouse (var Params : Registers);
(* Calls the mouse interrupt *)
begin
Intr ($33, Params)
end;
(**************************************************************************)
procedure ResetRegisters (var Params : Registers);
begin
Params.AX := 0;
Params.BX := 0;
Params.CX := 0;
Params.DX := 0;
Params.BP := 0;
Params.SI := 0;
Params.DI := 0;
Params.DS := 0;
Params.ES := 0
end;
(**************************************************************************)
procedure OpenMouse;
(* Initializes the mouse, saves the trouble of calling two procedures *)
begin
ResetRegisters (Params);
Params.AX := 0;
CallMouse (Params);
Params.AX := 1;
CallMouse (Params)
end;
(**************************************************************************)
procedure CloseMouse;
(* Deactivates the mouse in the program *)
begin
ResetRegisters (Params);
Params.AX := 0;
CallMouse (Params);
Params.AX := 2;
CallMouse (Params)
end;
(**************************************************************************)
procedure ShowMouse;
(* Shows the mouse cursor on the screen *)
begin
Params.AX := 1;
CallMouse (Params)
end;
(**************************************************************************)
procedure HideMouse;
(* Hides the mouse cursor on the screen *)
begin
Params.AX := 2;
CallMouse (Params)
end;
(**************************************************************************)
procedure GetCoords (var X, Y: word);
(* Gets the current coordinates of the mouse *)
begin
Params.AX := 3;
CallMouse (Params);
X := Params.CX;
Y := Params.DX
end;
(**************************************************************************)
procedure GetButtons (var Buttons : ButtonType);
(* Gets which mouse buttons are down *)
var
Number : word; (* A temporary number *)
begin
Params.AX := 3;
CallMouse (Params);
Number := Params.BX;
case Number of
1: Buttons := Left;
2: Buttons := Right;
3: Buttons := Both;
else Buttons := None;
end
end;
(**************************************************************************)
procedure GetMouseStatus (var X, Y : word; Buttons : ButtonType);
(* Get the status of the mouse *)
begin
GetCoords (X, Y);
GetButtons (Buttons)
end;
(**************************************************************************)
procedure SetRange (XRange, YRange : word);
(* Set the high extents of the mouse, useful if you want to get more or *)
(* less precise measurements from the mouse driver *)
begin
(* First set column range *)
Params.AX := 7;
Params.CX := 0;
Params.DX := XRange;
CallMouse (Params);
(* Then set row range *)
Params.AX := 8;
Params.CX := 0;
Params.DX := YRange;
CallMouse (Params);
end;
(**************************************************************************)
procedure MoveMouse (var X, Y : word);
(* Moves the mouse to a given location *)
begin
Params.AX := 5;
Params.CX := X;
Params.DX := Y;
CallMouse (Params)
end;
(**************************************************************************)
function InRange (X, Y, ULX, ULY, BRX, BRY : word) : Boolean;
(* Returns true if the coordinates given are in the range given *)
var
junk : Boolean; (* Temporary variable *)
begin
junk := false;
if (X > (ULX - 1)) and (X < (BRX + 1)) and
(Y > (ULY - 1)) and (Y < (ULY + 1)) then
junk := true;
InRange := junk
end;
(**************************************************************************)
end. (* of unit *)
taoyue@mit.edu
Copyright © 1997-2001 Tao Yue. All rights reserved.