home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
World of Shareware - Software Farm 2
/
wosw_2.zip
/
wosw_2
/
PASCAL
/
BUTTEST.ZIP
/
MOUSE.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-01-26
|
9KB
|
328 lines
{MOUSE.PAS creates MOUSE.TPU Unit}
{From the book "OBJECT ORIENTED PROGRAMMING IN TURBO PASCAL 5.5"}
Unit Mouse;
Interface
Uses
Cursors; {Contains Type GCursor = record and other cursors}
{Really contains all of the cursors, must have }
{to compile and use this unit. Edit out the }
{cursors from CURSORS.PAS and recompile if there }
{are some you don't want to include in you }
{application. Will save some space in code... }
Type
Position = record
btnStat,
opCount,
Xpos,Ypos : integer;
end; {record}
Const
ButtonL = 0;
ButtonR = 1;
ButtonM = 2;
Software = 0;
Hardware = 1;
Type
GenMouse = object
X,Y : integer;
Visible : boolean;
Function TestMouse : boolean;
Procedure SetAccel(Threshold : integer);
Procedure Show(Option : boolean);
Procedure GetPosition(var BtnStatus,Xpos,Ypos : integer);
Procedure QueryBtnDn(Button : integer;var mouse : position);
Procedure QueryBtnUp(Button : integer;var mouse : position);
Procedure ReadMove(var XMove,YMove : integer);
Procedure Reset(var Status : boolean;var BtnCount : integer);
Procedure SetRatio(HorPix,VerPix : integer);
Procedure SetLimits(XPosMin,YPosMin,XPosMax,YPosMax : integer);
Procedure SetPosition(XPos,YPos : integer);
end; {object}
GraphicMouse = object(GenMouse)
Procedure Initialize;
Procedure ConditionalHide(Left,Top,Right,Bottom : integer);
Procedure SetCursor(Cursor : GCursor);
end; {object}
TextMouse = object(GenMouse)
Procedure Initialize;
Procedure SetCursor(Ctype,C1,C2 : word);
end; {object}
GraphicLightPen = object(GraphicMouse)
Procedure LightPen(Option : boolean);
end; {object}
TextLightPen = object(TextMouse)
Procedure LightPen(Option : boolean);
end; {object}
{=========================================================================}
Implementation
Uses
Crt,Graph,Dos;
Var
Regs : registers;
{*************************************************************************}
Function Lower(N1,N2 : integer) : integer;
Begin
if N1 < N2 then
Lower := N1
else
Lower := N2;
End;
{*************************************************************************}
Function Upper(N1,N2 : integer) : integer;
Begin
if N1 > N2 then
Upper := N1
else
Upper := N2;
End;
{*************************************************************************}
Function GenMouse.TestMouse : boolean;
Const
Iret = 207;
Var
dOff,dSeg : integer;
Begin
dOff := MemW[0000:0204];
dSeg := MemW[0000:0206];
if ((dSeg = 0) or (dOff = 0)) then
TestMouse := False
else
TestMouse := Mem[dSeg:dOff] <> Iret;
End;
{*************************************************************************}
Procedure GenMouse.Reset(var Status : boolean; var BtnCount : integer);
Begin
Regs.AX := $00; {Reset to default conditions}
intr($33,Regs);
Status := Regs.AX <> 0; {Mouse Present}
BtnCount := Regs.BX; {Button Count}
End;
{*************************************************************************}
Procedure GenMouse.SetAccel(Threshold : integer);
Begin
Regs.AX := $13;
Regs.DX := Threshold;
Intr($33,Regs);
End;
{*************************************************************************}
Procedure GenMouse.Show(Option : boolean);
Begin
if Option and not Visible then
begin
Regs.AX := $01; {Show mouse cursor}
Visible := True;
Intr($33,Regs);
end
else
if Visible and not Option then
begin
Regs.AX := $02; {Hide mouse cursor}
Visible := False;
Intr($33,Regs);
end;
End;
{*************************************************************************}
Procedure GenMouse.GetPosition(var BtnStatus,Xpos,Ypos : integer);
Begin
Regs.AX := $03;
Intr($33,Regs);
BtnStatus := Regs.BX;
Xpos := Regs.CX;
Ypos := Regs.DX;
End;
{*************************************************************************}
Procedure GenMouse.SetPosition(Xpos,Ypos : integer);
Begin
Regs.AX := $04;
Regs.CX := Xpos;
Regs.DX := Ypos;
Intr($33,Regs);
End;
{*************************************************************************}
Procedure GenMouse.SetRatio(HorPix,VerPix : integer);
Begin
Regs.AX := $0F;
Regs.CX := HorPix; {horizonal mickeys/pixel}
Regs.DX := VerPix; {vertical mickeys/pixel}
Intr($33,Regs);
End;
{*************************************************************************}
Procedure GenMouse.QueryBtnDn(Button : integer;var Mouse : position);
Begin
Regs.AX := $05;
Regs.BX := Button;
Intr($33,Regs);
Mouse.BtnStat := Regs.AX;
Mouse.OpCount := Regs.BX;
Mouse.Xpos := Regs.CX;
Mouse.Ypos := Regs.DX;
End;
{*************************************************************************}
Procedure GenMouse.QueryBtnUp(Button : integer;var Mouse : position);
Begin
Regs.AX := $06;
Regs.BX := Button;
Intr($33,Regs);
Mouse.BtnStat := Regs.AX;
Mouse.OpCount := Regs.BX;
Mouse.Xpos := Regs.CX;
Mouse.Ypos := Regs.DX;
End;
{*************************************************************************}
Procedure GenMouse.SetLimits(XPosMin,YPosMin,XPosMax,YPosMax : integer);
Begin
Regs.AX := $07; {horizonal limits}
Regs.CX := Lower(XPosMin,XPosMax);
Regs.DX := Upper(XPosMin,XPosMax);
Intr($33,Regs);
Regs.AX := $08; {vertical limits}
Regs.CX := Lower(YPosMin,YPosMax);
Regs.DX := Upper(YPosMin,YPosMax);
Intr($33,Regs);
End;
{*************************************************************************}
Procedure GenMouse.ReadMove(var XMove,YMove : integer);
Begin
Regs.AX := $0B;
Intr($33,Regs);
XMove := Regs.CX;
YMove := Regs.DX;
End;
{*************************************************************************}
{=======================================}
{Implementation methods for GraphicMouse}
{=======================================}
Procedure GraphicMouse.SetCursor(Cursor : GCursor);
Begin
Regs.AX := $09;
Regs.BX := Cursor.HotX;
Regs.CX := Cursor.HotY;
Regs.DX := Ofs(Cursor.ScreenMask);
Regs.ES := Seg(Cursor.ScreenMask);
Intr($33,Regs);
End;
{*************************************************************************}
Procedure GraphicMouse.ConditionalHide(Left,Top,Right,Bottom : integer);
Begin
Regs.AX := $0A;
Regs.CX := Left;
Regs.DX := Top;
Regs.SI := Right;
Regs.DI := Bottom;
Intr($33,Regs);
End;
{*************************************************************************}
Procedure GraphicMouse.Initialize;
Begin
Visible := False;
SetLimits(0,0,GetMaxX,GetMaxY);
SetCursor(Arrow);
SetPosition(GetMaxX div 2,GetMaxY div 2);
Show(True);
End;
{*************************************************************************}
{====================================}
{Implementation methods for TextMouse}
{====================================}
Procedure TextMouse.Initialize;
Begin
Visible := False;
SetLimits(Lo(WindMin)*8,Hi(WindMin)*8,Lo(WindMax)*8,Hi(WindMax)*8);
SetCursor(Hardware,6,7);
SetPosition(0,0);
Show(True);
End;
{*************************************************************************}
Procedure TextMouse.SetCursor(CType,C1,C2 : word);
Begin
Regs.AX := $0A; {function 10h}
Regs.BX := CType; {0=software,1=hardware}
Regs.CX := C1; {screen mask or scan start line}
Regs.DX := C2; {screen mask or scan stop line}
Intr($33,Regs);
End;
{*************************************************************************}
{===================================}
{Implementation methods for LightPen}
{===================================}
Procedure TextLightPen.LightPen(Option : boolean);
Begin
if Option then
Regs.AX := $0D
else
Regs.AX := $0E;
Intr($33,Regs);
End;
{*************************************************************************}
Procedure GraphicLightPen.LightPen(Option : boolean);
Begin
if Option then
Regs.AX := $0D
else
Regs.AX := $0E;
Intr($33,Regs);
End;
{*************************************************************************}
BEGIN
END.