Category : Pascal Source Code
Archive   : OOPMOU_B.ZIP
Filename : MOUSEUNI.PAS

{$I mouseuni.inc}

const
MOUSE_DRIVER_INTERRUPT = $33;
var
mouse_exists : boolean;
mouse_visible : boolean;
mouse_buttons : integer;
Registers : DOS.Registers;

{ --------------------------------------------------------------------- }

procedure CallMouse(MouseFunction : integer);
begin
Registers.AX := MouseFunction;
intr (MOUSE_DRIVER_INTERRUPT, Registers);
end; { CallMouse }

{ --------------------------------------------------------------------- }

function mouse_object.Exists : boolean;
{ check if a mouse driver is currently loaded }
begin
Exists := mouse_exists;
end;

{ --------------------------------------------------------------------- }

function mouse_object.NumberOfButtons : integer;
{ returns the number of available buttons on the mouse }
begin
NumberOfButtons := mouse_buttons;
end;

{ --------------------------------------------------------------------- }

procedure mouse_object.Reset;
{ reset the mouse driver to its defaults }
begin
CallMouse(0);
Mouse_Exists := Registers.AX <> 0;
end; { Reset }

{ --------------------------------------------------------------------- }

procedure mouse_object.Show;
{ Makes the mouse cursor visible. }
begin
if mouse_visible then exit;
CallMouse(1);
mouse_visible := true;
end;

{ --------------------------------------------------------------------- }

procedure mouse_object.Hide;
{ Makes mouse cursor invisible. Movement and button activity are }
{ still tracked. }
begin
if not mouse_visible then exit;
CallMouse(2);
mouse_visible := false;
end;

{ --------------------------------------------------------------------- }

procedure mouse_object.GetStatus(var status, row, column : integer);
{ Gets mouse cursor position and button status. }
begin
CallMouse (3);
with Registers do begin
column := CX;
row := DX;
status := BX;
end;
end; { GetPosition }

{ --------------------------------------------------------------------- }

procedure mouse_object.MoveTo(new_row, new_column : integer);
{ Move mouse cursor to new position }
begin
with Registers do begin
CX := new_column;
DX := new_row;
end;
CallMouse(4);
end;

{ --------------------------------------------------------------------- }

procedure mouse_object.Pressed(button : integer; var result : boolean; var count, row, column : integer);
{ Gets pressed info about named button: current status (up/down), }
{ times pressed since last call, position at most recent press. }
{ Resets count and position info. Button 0 is left, 1 is right on }
{ Microsoft mouse. }
begin
with Registers do begin
BX := button - 1;
CallMouse(5);
case button of
1 : result := AX and $01 <> 0;
2 : result := AX and $02 <> 0;
3 : result := AX and $04 <> 0;
end; { case }
count := BX;
column := CX;
row := DX;
end; { with }
end;

{ --------------------------------------------------------------------- }

procedure mouse_object.Released(button : integer; var result : boolean; var count, row, column : integer);
{ Gets released info about named button: current status (up/down), }
{ times released since last call, position at most recent press. }
{ Resets count and position info. Button 0 is left, 1 is right on }
{ Microsoft mouse. }
begin
with Registers do begin
BX := button - 1;
CallMouse(6);
case button of
1 : result := AX and $01 <> 0;
2 : result := AX and $02 <> 0;
3 : result := AX and $04 <> 0;
end; { case }
count := BX;
column := CX;
row := DX;
end; { with }
end;

{ --------------------------------------------------------------------- }

procedure mouse_object.ColRange(horizontal_min, horizontal_max : integer);
{ Sets min and max horizontal range for mouse cursor. Moves }
{ cursor inside range if outside when called. Swaps values if }
{ min and max are reversed. }
begin
with Registers do begin
CX := horizontal_min;
DX := horizontal_max;
end; { with }
CallMouse(7);
end;

{ --------------------------------------------------------------------- }

procedure mouse_object.RowRange(vertical_min, vertical_max : integer);
{ Sets min and max vertical range for mouse cursor. Moves }
{ cursor inside range if outside when called. Swaps values if }
{ min and max are reversed. }
begin
with Registers do begin
CX := vertical_min;
DX := vertical_max;
end; { with }
CallMouse(8);
end;

{ --------------------------------------------------------------------- }

procedure mouse_object.GraphCursor(hHot, vHot : integer; mask_segment, mask_offset : word);
{ Sets graphic cursor shape }
begin
with Registers do begin
BX := hHot;
CX := vHot;
DX := mask_offset;
ES := mask_segment;
end;
CallMouse(9);
end;

{ --------------------------------------------------------------------- }

procedure mouse_object.TextCursor(cursor_type : integer; arg1, arg2 : word);
{ Sets text cursor type, where 0 = software and 1 = hardware) }
{ For software cursor, arg1 and arg2 are the screen and cursor }
{ masks. For hardware cursor, arg1 and arg2 specify scan line }
{ start/stop i.e. cursor shape. }
begin
with Registers do begin
BX := cursor_type;
CX := arg1;
DX := arg2;
end;
CallMouse(10);
end;

{ --------------------------------------------------------------------- }

procedure mouse_object.Motion(var horizontal_count, vertical_count : integer);
{ Reports net motion of cursor since last call to this function }
begin
CallMouse(11);
with Registers do begin
horizontal_count := CX;
vertical_count := DX;
end;
end;

{ --------------------------------------------------------------------- }

procedure mouse_object.InstallTask(mask, task_segment, task_offset : word);
{ Installs a user-defined task to be executed upon one or more }
{ mouse events specified by mask. }
begin
with Registers do begin
CX := mask;
DX := task_offset;
ES := task_segment;
end;
CallMouse(12);
end;

{ --------------------------------------------------------------------- }

procedure mouse_object.LightPenOn;
{ Turns on light pen emulation. This is the default condition. }
begin
CallMouse(13);
end;

{ --------------------------------------------------------------------- }

procedure mouse_object.LightPenOff;
{ Turns off light pen emulation. }
begin
CallMouse(14);
end;

{ --------------------------------------------------------------------- }

procedure mouse_object.Ratio(horizontal, vertical : integer);
{ Sets mickey-to-pixel ratio, where ratio is R/8. Default is 16 }
{ for vertical, 8 for horizontal }
begin
with Registers do begin
CX := horizontal;
DX := vertical;
end;
CallMouse(15);
end;

{ --------------------------------------------------------------------- }

procedure mouse_object.ConditionOff(x1, y1, x2, y2 : integer);
{ This function hides the mouse if it is in the region when this }
{ function is called. Afterwards your program must call Show to show }
{ the cursor again. }
begin
if not mouse_visible then exit;
with Registers do begin
SI := x2; { lower x screen coordinates }
DI := y2; { lower y screen coordinates }
CX := x1; { upper x screen coordinates }
DX := y1; { upper y screen coordinates }
end;
CallMouse(16);
mouse_visible := false;
end;

{ --------------------------------------------------------------------- }

procedure mouse_object.SetThreshold(x : integer);
{ Set the threshold speed for doubling the cursor's movements }
begin
Registers.DX := x;
CallMouse(19);
end;


{ --------------------------------------------------------------------- }

var ExitSave: pointer; { Previous exit procedure }

{$F+} procedure ExitHandler; {$F-}
begin
ExitProc := ExitSave; { Chain to other exit procedures }
CallMouse(0);
end;

{ --------------------------------------------------------------------- }

begin
ExitSave := ExitProc;
ExitProc := @ExitHandler; { Install our exit procedure }
CallMouse(0);
mouse_exists := Registers.AX <> 0;
mouse_visible := false;
mouse_buttons := Registers.BX;
end.