SKAMOUSE.PAS
9.6 KB
b3f4d75a57d3561a…
{
>> Empathy mouse routines!
::
>> Implemented and stuff on 10/24/98 by skaboy!
}
unit skamouse;
interface uses crt, dos;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
const
eNoButton = 0;
eLeftButton = 1;
eRightButton = 2;
eBothButton = 3;
eMiddleButton = 4;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
function eMouseButton(str : string) : boolean;
procedure eClearMouse;
function eReadKey : string;
procedure eShowMouse;
procedure eHideMouse;
function eButtonStatus : Byte;
procedure eWhereMouse (var X, Y : Byte);
function eWhereMouseX : byte;
function eWhereMouseY : byte;
procedure eMoveMouse (X, Y : Byte);
procedure eConfineMouse (X1, Y1, X2, Y2 : Byte);
procedure eDefineMouse (MC, CC : Char; MA, CA : Byte);
procedure eObscureMouse (X1, Y1, X2, Y2 : Byte);
procedure eSetMouseSpeed (DX, DY : Integer);
procedure eMouseMovement (var DX, DY : Integer);
procedure eResetMouse;
function eMouseExists : Boolean;
function eMouseHidden : Boolean;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
var eMouseUsed : boolean;
implementation
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
var
eMouseInstalled : Boolean;
eButtons : Byte;
eHidden : Boolean;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
Function eMouseButton(str : string) : boolean;
begin
if (eMouseUsed=false) then eMouseButton := false else
begin
if (pos('B',str)>0) then eMouseButton := true else
if (pos('Q',str)>0) then eMouseButton := true else
eMouseButton := false;
end;
end;
{:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
Procedure eClearMouse;
var eKillString : string[4];
eContinue : boolean;
begin
eKillString := eReadKey;
while (eMouseButton(eKillString)=true) do
eKillString := eReadKey;
end;
{:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
Function eReadKey : string;
var eChar : char;
eTmpS : string;
eMPos : array[1..2] of integer;
Procedure eAddChar(count : byte; ch : char);
var x : byte;
begin
if (eButtonStatus<>3) then if (count>1) then count := 1;
for x := 1 to count do eTmpS := eTmpS+ch;
end;
begin
eMouseUsed := false;
if (keyPressed=true) then eReadKey := readKey else
begin
eMouseMovement(eMPos[1],eMPos[2]);
if (eMPos[1]<>0) or (eMPos[2]<>0) then
begin
eMouseUsed := true;
eTmpS := '';
if (eMPos[1]<-1) and (abs(eMPos[1])>abs(eMPos[2])) then eAddChar(abs(eMPos[1]),'4') else { left }
if (eMPos[1]>1) and (abs(eMPos[1])>abs(eMPos[2])) then eAddChar(abs(eMPos[1]),'6') else { right }
if (eMPos[2]<-1) and (abs(eMPos[2])>abs(eMPos[1])) then eAddChar(abs(eMPos[2]),'8') else { up }
if (eMPos[2]>1) and (abs(eMPos[2])>abs(eMPos[1])) then eAddChar(abs(eMPos[2]),'2'); { down }
eReadKey := eTmpS;
end else if (eButtonStatus=1) then
begin
eMouseUsed := true;
eReadKey := 'B'
end else if (eButtonStatus=2) then
begin
eMouseUsed := true;
eReadKey := 'Q';
end else
eReadKey := 'none';
end;
end;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
function eMouseExists : Boolean;
begin
eMouseExists := eMouseInstalled;
end;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
procedure eShowMouse;
var Reg : Registers;
begin
if eMouseInstalled
then begin
if eHidden
then begin
Reg.AX := $0001;
Intr ($33, Reg);
end;
eHidden := False;
end;
end;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
procedure eHideMouse;
var Reg : Registers;
begin
if eMouseInstalled
then begin
if not eHidden
then begin
Reg.AX := $0002;
Intr ($33, Reg);
end;
eHidden := True;
end;
end;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
function eButtonStatus : Byte;
var Reg : Registers;
begin
eButtonStatus := 0;
if eMouseInstalled
then begin
Reg.AX := $0003;
Intr ($33, Reg);
eButtonStatus := Reg.BX;
end;
end;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
procedure eWhereMouse (var X, Y : Byte);
var Reg : Registers;
begin
X := 0;
Y := 0;
if eMouseInstalled
then begin
Reg.AX := $0003;
Intr ($33, Reg);
X := (Reg.CX div 8) + 1;
Y := (Reg.DX div 8) + 1;
end;
end;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
function eWhereMouseX : byte;
var x,y : byte;
begin
eWhereMouse(x,y);
eWhereMouseX := x;
end;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
function eWhereMouseY : byte;
var x,y : byte;
begin
eWhereMouse(x,y);
eWhereMouseY := y;
end;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
procedure eMoveMouse (X, Y : Byte);
var Reg : Registers;
begin
if eMouseInstalled
then begin
Reg.AX := $0004;
Reg.CX := X * 8 - 1;
Reg.DX := Y * 8 - 1;
Intr ($33, Reg);
end;
end;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
procedure eConfineMouse (X1, Y1, X2, Y2 : Byte);
var Reg : Registers;
begin
if eMouseInstalled
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 eDefineMouse (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 eMouseInstalled
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 eObscureMouse (X1, Y1, X2, Y2 : Byte);
var Reg : Registers;
begin
if eMouseInstalled
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);
eHidden := True;
end;
end;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
procedure eSetMouseSpeed (DX, DY : Integer);
var Reg : Registers;
begin
if eMouseInstalled
then begin
Reg.AX := $000F;
Reg.CX := DX;
Reg.DX := DY;
Intr ($33, Reg);
end;
end;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
procedure eMouseMovement (var DX, DY : Integer);
var Reg : Registers;
begin
DX := 0;
DY := 0;
if eMouseInstalled
then begin
Reg.AX := $000B;
Intr ($33, Reg);
DX := Reg.CX;
DY := Reg.DX;
eHideMOuse;
end;
end;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
procedure eResetMouse;
begin
eDefineMouse (#255, #0, 255, 127);
eConfineMouse (1, 1, 80, 25);
eSetMouseSpeed (8, 16);
eMoveMouse (1, 1);
end;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
procedure eInitMouse;
var Reg : Registers;
begin
Reg.AX := $0000;
Intr ($33, Reg);
if (Reg.AX = $0000)
then eMouseInstalled := False
else begin
eMouseInstalled := True;
eButtons := 1;
case Reg.BX of
$FFFF : eButtons := 2;
$0000 : eButtons := 1;
$0003 : eButtons := 3;
end;
eDefineMouse (#255, #0, 255, 127);
eConfineMouse (1, 1, 80, 25);
eSetMouseSpeed (8, 16);
end;
end;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
function eMouseHidden : Boolean;
begin
eMouseHidden := eHidden;
end;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
begin
eInitMouse;
eHidden := True;
eShowMouse;
eHidden := True;
eShowMouse;
end.