[Back to MOUSE SWAG index]  [Back to Main SWAG index]  [Original]


unit Mouse;

interface

uses
	Dos,
	Crt;

const
	LeftButton   = 1;
	MiddleButton = 4;
	RightButton  = 2;
	NoButton     = 0;

procedure ShowMouse;
procedure HideMouse;
function  ButtonStatus : Byte;
procedure WhereMouse (var X, Y : Byte);
procedure MoveMouse (X, Y : Byte);
procedure ConfineMouse (X1, Y1, X2, Y2 : Byte);
procedure DefineMouse (MC, CC : Char; MA, CA : Byte);
procedure ObscureMouse (X1, Y1, X2, Y2 : Byte);
procedure SetMouseSpeed (DX, DY : Integer);
procedure MouseMovement (var DX, DY : Integer);
procedure ResetMouse;
function  MouseExists : Boolean;
function  MouseHidden : Boolean;

implementation

var
	MouseInstalled : Boolean;
	Buttons : Byte;
	Hidden : Boolean;

function MouseExists : Boolean;
begin
	MouseExists := MouseInstalled;
end;

procedure ShowMouse;
var Reg : Registers;
begin
	if MouseInstalled
	then begin
		if Hidden
		then begin
			Reg.AX := $0001;
			Intr ($33, Reg);
		end;
		Hidden := False;
	end;
end;

procedure HideMouse;
var Reg : Registers;
begin
	if MouseInstalled
	then begin
		if not Hidden
		then begin
			Reg.AX := $0002;
			Intr ($33, Reg);
		end;
		Hidden := True;
	end;
end;

function ButtonStatus : Byte;
var Reg : Registers;
begin
	ButtonStatus := 0;
	if MouseInstalled
	then begin
		Reg.AX := $0003;
		Intr ($33, Reg);
		ButtonStatus := Reg.BX;
	end;
end;

procedure WhereMouse (var X, Y : Byte);
var Reg : Registers;
begin
	X := 0;
	Y := 0;
	if MouseInstalled
	then begin
		Reg.AX := $0003;
		Intr ($33, Reg);
		X := (Reg.CX div 8) + 1;
		Y := (Reg.DX div 8) + 1;
	end;
end;

procedure MoveMouse (X, Y : Byte);
var Reg : Registers;
begin
	if MouseInstalled
	then begin
		Reg.AX := $0004;
		Reg.CX := X * 8 - 1;
		Reg.DX := Y * 8 - 1;
		Intr ($33, Reg);
	end;
end;

procedure ConfineMouse (X1, Y1, X2, Y2 : Byte);
var Reg : Registers;
begin
	if MouseInstalled
	then begin
		Reg.AX := $0007;
		Reg.CX := (X1 - 1) * 8;
		Reg.DX := (X2 - 1) * 8;
		Intr ($33, Reg);
		Reg.AX := $0008;
		Reg.CX := (Y1 - 1) * 8;
		Reg.DX := (Y2 - 1) * 8;
		Intr ($33, Reg);
	end;
end;

procedure DefineMouse (MC, CC : Char; MA, CA : Byte);
type
	Convert = record
		case Integer of
			0 : (C, A : Byte);
			1 : (I : Word);
		end;
var
	Converter : Convert;
	Msk, Csr : Word;
	Reg : Registers;
begin
	if MouseInstalled
	then begin
		Converter.C := Ord (MC);
		Converter.A := MA;
		Msk := Converter.I;
		Converter.C := Ord (CC);
		Converter.A :=CA;
		Csr := Converter.I;
		Reg.AX := $000A;
		Reg.BX := $0000;
		Reg.CX := Msk;
		Reg.DX := Csr;
		Intr ($33, Reg);
	end;
end;

procedure ObscureMouse (X1, Y1, X2, Y2 : Byte);
var Reg : Registers;
begin
	if MouseInstalled
	then begin
		Reg.AX := $0010;
		Reg.CX := X1 * 8 - 1;
		Reg.DX := Y1 * 8 - 1;
		Reg.SI := X2 * 8 - 1;
		Reg.DI := Y2 * 8 - 1;
		Intr ($33, Reg);
		Hidden := True;
	end;
end;

procedure SetMouseSpeed (DX, DY : Integer);
var Reg : Registers;
begin
	if MouseInstalled
	then begin
		Reg.AX := $000F;
		Reg.CX := DX;
		Reg.DX := DY;
		Intr ($33, Reg);
	end;
end;

procedure MouseMovement (var DX, DY : Integer);
var Reg : Registers;
begin
	DX := 0;
	DY := 0;
	if MouseInstalled
	then begin
		Reg.AX := $000B;
		Intr ($33, Reg);
		DX := Reg.CX;
		DY := Reg.DX;
	end;
end;

procedure ResetMouse;
begin
	DefineMouse (#255, #0, 255, 127);
	ConfineMouse (1, 1, 80, 25);
	SetMouseSpeed (8, 16);
	MoveMouse (1, 1);
end;

procedure InitMouse;
var Reg : Registers;
begin
	Reg.AX := $0000;
	Intr ($33, Reg);
	if (Reg.AX = $0000)
		then MouseInstalled := False
		else begin
			MouseInstalled := True;
			Buttons := 1;
			case Reg.BX of
				$FFFF : Buttons := 2;
				$0000 : Buttons := 1;
				$0003 : Buttons := 3;
			end;
			DefineMouse (#255, #0, 255, 127);
			ConfineMouse (1, 1, 80, 25);
			SetMouseSpeed (8, 16);
		end;
end;

function MouseHidden : Boolean;
begin
	MouseHidden := Hidden;
end;

begin
	InitMouse;
	Hidden := True;
	ShowMouse;
	Hidden := True;
	ShowMouse;
end.


Here is a sample program using the unit:

program MouseTest;

uses
	Crt,
	Mouse;

var
	BX, BY : Byte;
	TheX, TheY : Integer;
	Stuff : string;

begin
	ShowMouse;
	repeat
		WhereMouse (BX, BY);
		TheX := BX;
		TheY := BY;
		GotoXY (TheX, TheY);
		if ButtonStatus = 1
		then begin
			Readln (Stuff);
		end;
	until ButtonStatus = 2;
	HideMouse;
end.

[Back to MOUSE SWAG index]  [Back to Main SWAG index]  [Original]