Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/OOP-TP55.ZIP/MOUSE.PAS

Pascal/Delphi Source File | 1990-02-26 | 4.5 KB | 224 lines

unit Mouse; { Listing 7-1 }

{ this file should be saved and compiled as MOUSE.PAS }

interface

uses Dos;

procedure MouseCoords( var x,y : integer );
function MouseLPressed : boolean;
function MouseRPressed : boolean;
function MouseLReleased : boolean;
function MouseRReleased : boolean;
function MouseInit : Boolean;
procedure MouseShow;
procedure MouseHide;
procedure MouseSetPosition( x,y : integer );
procedure MouseGetBPressInfo( var Status, Count : integer;
                                       Button : integer );
procedure MouseGetBRelInfo( var Status, Count : integer;
                                       Button : integer );
procedure MouseSetHMinMax( Min, Max : integer );
procedure MouseSetVMinMax( Min, Max : integer );
procedure MouseReset;


implementation
var
   i : integer;

procedure MouseReset;
var R : Registers;
{ AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags : word }
begin
     R.AX := $21;
     R.BX := 0;
     R.CX := 0;
     R.DX := 0;
     R.SI := 0;
     R.DI := 0;
     R.DS := 0;
     R.ES := 0;
     Intr( $33, R );
end;

function MouseLPressed : boolean ;
var Status,Count : integer;
begin
     MouseGetBPressInfo( Status, Count, 0 );
     if (Status AND $1)=$1 then
        MouseLPressed := true
     else
        MouseLPressed := false;
end;

function MouseLReleased : boolean ;
var Status,Count : integer;
begin
     MouseGetBRelInfo( Status, Count, 0 );
     if (((Status AND $1) = 0) AND (Count > 0)) then
        MouseLReleased := true
     else
        MouseLReleased := false;
end;

function MouseRPressed : boolean ;
var Status,Count : integer;
begin
     MouseGetBPressInfo( Status, Count, 1 );
     if (Status AND $2) = 2 then
        MouseRPressed := true
     else
        MouseRPressed := false;
end;

function MouseRReleased : boolean ;
var Status,Count : integer;
begin
     MouseGetBRelInfo( Status, Count, 1 );
     if (((Status AND $2) = 0) AND (Count > 0)) then
        MouseRReleased := true
     else
        MouseRReleased := false;
end;

function MouseInit : Boolean;
var R : Registers;
{ AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags : word }
begin
     R.AX := 0;
     R.BX := 0;
     R.CX := 0;
     R.DX := 0;
     R.SI := 0;
     R.DI := 0;
     R.DS := 0;
     R.ES := 0;
     Intr( $33, R );
     if R.AX <> 0 then MouseInit := true else MouseInit := false;
end;

procedure MouseShow;
var R : Registers;
begin
     R.AX := 1;
     R.BX := 0;
     R.CX := 0;
     R.DX := 0;
     R.SI := 0;
     R.DI := 0;
     R.DS := 0;
     R.ES := 0;
     Intr( $33, R );
end;

procedure MouseHide;
var R : Registers;
begin
     R.AX := 2;
     R.BX := 0;
     R.CX := 0;
     R.DX := 0;
     R.SI := 0;
     R.DI := 0;
     R.DS := 0;
     R.ES := 0;
     Intr( $33, R );
end;

procedure MouseCoords( var x,y : integer );
var R : Registers;
begin
     R.AX := 3;
     R.BX := 0;
     R.CX := 0;
     R.DX := 0;
     R.SI := 0;
     R.DI := 0;
     R.DS := 0;
     R.ES := 0;
     Intr( $33, R );
     x := R.CX;
     y := R.DX;
end;

procedure MouseSetPosition( x,y : integer );
var R : Registers;
begin
     R.AX := 4;
     R.BX := 0;
     R.CX := x;
     R.DX := y;
     R.SI := 0;
     R.DI := 0;
     R.DS := 0;
     R.ES := 0;
     Intr( $33, R );
end;

procedure MouseGetBPressInfo( var Status, Count : integer;
                                       Button : integer );
var R : Registers;
begin
     R.AX := 5;
     R.BX := Button;
     R.CX := 0;
     R.DX := 0;
     R.SI := 0;
     R.DI := 0;
     R.DS := 0;
     R.ES := 0;
     Intr( $33, R );
     Status := R.AX;
     Count := R.BX;
end;

procedure MouseGetBRelInfo( var Status, Count : integer;
                                       Button : integer );
var R : Registers;
begin
     R.AX := 6;
     R.BX := Button;
     R.CX := 0;
     R.DX := 0;
     R.SI := 0;
     R.DI := 0;
     R.DS := 0;
     R.ES := 0;
     Intr( $33, R );
     Status := R.AX;
     Count := R.BX;
end;


procedure MouseSetHMinMax( Min, Max : integer );
var R : Registers;
begin
     R.AX := 7;
     R.BX := 0;
     R.CX := Min;
     R.DX := Max;
     R.SI := 0;
     R.DI := 0;
     R.DS := 0;
     R.ES := 0;
     Intr( $33, R );
end;

procedure MouseSetVMinMax( Min, Max : integer );
var R : Registers;
begin
     R.AX := 8;
     R.BX := 0;
     R.CX := Min;
     R.DX := Max;
     R.SI := 0;
     R.DI := 0;
     R.DS := 0;
     R.ES := 0;
     Intr( $33, R );
end;

end.