home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Chestnut's Multimedia Mania
/
MM_MANIA.ISO
/
graphics
/
paintoop
/
cmouse.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1989-11-16
|
17KB
|
364 lines
{$B-,F-,I+,R+}
unit CMouse;
{ Define TMouse - a class for accessing the mouse }
{ Copyright 1989
Scott Bussinger
110 South 131st Street
Tacoma, WA 98444
(206)531-8944
Compuserve 72247,2671 }
interface
uses Graph,CObject;
type MouseButton = (Left,Right,Middle);
MouseCursor = (DefaultCursor,PenCursor,BucketCursor,HandCursor);
MouseStatus = (Idle,Pressed,Released,Held);
type TMouse = object(TObject)
fCurrentCursor: MouseCursor; { Current style of mouse cursor }
fLastButtonStatus: word; { Button status at last call to Update }
fLastLocationX: integer; { Horizontal cursor location at last call to Update }
fLastLocationY: integer; { Vertical cursor location at last call to Update }
fMouseFactor: integer; { Horizontal scaling factor for current video mode }
fMousePresent: boolean; { True if a mouse is present }
fPreviousButtonStatus: word; { Button status at second to last call to Update }
fTextCursorEnabled: boolean; { True if the text cursor is enabled }
fTextCursorHeight: integer; { Height of text cursor in pixels }
fVisible: boolean; { True if the mouse cursor is currently visible }
constructor Init; { Initialize the mouse }
procedure DisableTextCursor; { Disable the text cursor }
procedure EnableTextCursor; { Enable the text cursor display }
function GetLocationX: integer; { Returns last horizontal location }
function GetLocationY: integer; { Returns last vertical location }
function GetButton(Button: MouseButton): MouseStatus; { Returns last status of a mouse button }
procedure Hide; { Turn mouse cursor off }
function Present: boolean; { Return true if mouse is present }
procedure SetCursor(NewCursor: MouseCursor); { Change to a new cursor shape }
procedure SetTextCursor(Height: integer); { Turn on the text cursor }
procedure Show; { Turn mouse cursor on }
procedure Update; { Update the currect mouse status }
end;
var Mouse: TMouse;
implementation
uses Dos,CWindow;
const Cursor: array[MouseCursor] of record
HotSpot: record
X: integer;
Y: integer
end;
ScreenMask: array[0..15] of word;
CursorMask: array[0..15] of word
end =
((HotSpot:(X:0; Y:0); { Hot spot is tip of arrow }
ScreenMask:($3FFF, { 0011111111111111 } { DefaultCursor }
$1FFF, { 0001111111111111 }
$0FFF, { 0000111111111111 }
$07FF, { 0000011111111111 }
$03FF, { 0000001111111111 }
$01FF, { 0000000111111111 }
$00FF, { 0000000011111111 }
$007F, { 0000000001111111 }
$003F, { 0000000000111111 }
$001F, { 0000000000011111 }
$01FF, { 0000000111111111 }
$10FF, { 0001000011111111 }
$30FF, { 0011000011111111 }
$F87F, { 1111100001111111 }
$F87F, { 1111100001111111 }
$FC3F); { 1111110000111111 }
CursorMask:($0000, { 0000000000000000 }
$4000, { 0100000000000000 }
$6000, { 0110000000000000 }
$7000, { 0111000000000000 }
$7800, { 0111100000000000 }
$7C00, { 0111110000000000 }
$7E00, { 0111111000000000 }
$7F00, { 0111111100000000 }
$7F80, { 0111111110000000 }
$78C0, { 0111111111000000 }
$7C00, { 0111110000000000 }
$4600, { 0100011000000000 }
$0600, { 0000011000000000 }
$0300, { 0000001100000000 }
$0300, { 0000001100000000 }
$0180)), { 0000000110000000 }
(HotSpot:(X:1; Y:15); { Hot spot is just beyond tip of pen }
ScreenMask:($FFCF, { 1111111111001111 } { PenCursor}
$FF87, { 1111111110000111 }
$FF03, { 1111111100000011 }
$FE01, { 1111111000000001 }
$FC03, { 1111110000000011 }
$F807, { 1111100000000111 }
$F00F, { 1111000000001111 }
$E01F, { 1110000000011111 }
$C03F, { 1100000000111111 }
$807F, { 1000000001111111 }
$00FF, { 0000000011111111 }
$01FF, { 0000000111111111 }
$03FF, { 0000001111111111 }
$07FF, { 0000011111111111 }
$0FFF, { 0000111111111111 }
$9FFF); { 1001111111111111 }
CursorMask:($0000, { 0000000000000000 }
$0030, { 0000000000110000 }
$0078, { 0000000001111000 }
$009C, { 0000000010011100 }
$01E8, { 0000000111101000 }
$03F0, { 0000001111110000 }
$07E0, { 0000011111100000 }
$0FC0, { 0000111111000000 }
$1F80, { 0001111110000000 }
$2700, { 0010011100000000 }
$7A00, { 0111101000000000 }
$5C00, { 0101110000000000 }
$4800, { 0100100000000000 }
$5000, { 0101000000000000 }
$6000, { 0110000000000000 }
$0000)), { 0000000000000000 }
(HotSpot:(X:14; Y:14); { Hot spot is just beyond tip of pen }
ScreenMask:($FFCF, { 1111111111001111 } { BucketCursor }
$FF87, { 1111111110000111 }
$FE03, { 1111111000000011 }
$F803, { 1111100000000011 }
$E001, { 1110000000000001 }
$C001, { 1100000000000001 }
$8000, { 1000000000000000 }
$0000, { 0000000000000000 }
$0000, { 0000000000000000 }
$8000, { 1000000000000000 }
$8008, { 1000000000001000 }
$8018, { 1000000000011000 }
$C078, { 1100000001111000 }
$C0F8, { 1100000011111000 }
$C3F8, { 1100001111111000 }
$E7F8); { 1110011111111000 }
CursorMask:($0000, { 0000000000000000 }
$0030, { 0000000000110000 }
$0048, { 0000000001001000 }
$0188, { 0000000110001000 }
$0604, { 0000011000000100 }
$1804, { 0001100000000100 }
$2002, { 0010000000000010 }
$7FFE, { 0111111111111110 }
$7FFA, { 0111111111111010 }
$3FF2, { 0011111111110010 }
$3FE2, { 0011111111100010 }
$3F82, { 0011111110000010 }
$1F02, { 0001111100000010 }
$1C02, { 0001110000000010 }
$1802, { 0001100000000010 }
$0000)), { 0000000000000000 }
(HotSpot:(X:4; Y:0); { Hot spot is just beyond tip of pen }
ScreenMask:($F3FF, { 1111001111111111 } { HandCursor }
$E1FF, { 1110000111111111 }
$E1FF, { 1110000111111111 }
$E1FF, { 1110000111111111 }
$E001, { 1110000000000001 }
$E000, { 1110000000000000 }
$E000, { 1110000000000000 }
$E000, { 1110000000000000 }
$8000, { 1000000000000000 }
$0000, { 0000000000000000 }
$0000, { 0000000000000000 }
$0000, { 0000000000000000 }
$0000, { 0000000000000000 }
$0000, { 0000000000000000 }
$8001, { 1000000000000001 }
$C003); { 1100000000000011 }
CursorMask:($0C00, { 0000110000000000 }
$1200, { 0001001000000000 }
$1200, { 0001001000000000 }
$1200, { 0001001000000000 }
$13FE, { 0001001111111110 }
$1249, { 0001001001001001 }
$1249, { 0001001001001001 }
$1249, { 0001001001001001 }
$7249, { 0111001001001001 }
$9001, { 1001000000000001 }
$9001, { 1001000000000001 }
$9001, { 1001000000000001 }
$8001, { 1000000000000001 }
$8001, { 1000000000000001 }
$4002, { 0100000000000010 }
$3FFC))); { 0011111111111100 }
const CurrentTextCursorLineStyle: word = $FFFF; { Line style for drawing text cursor }
procedure MouseCall( AX: word;
var MouseRegs: Registers);
{ Execute a call to the mouse driver }
begin
MouseRegs.AX := AX;
Intr($33,MouseRegs)
end;
procedure XorTextCursor(Height: integer);
{ Draw/Undraw the text cursor }
var SaveStatus: GraphicsStatus;
begin
CurrentCanvas^.Activate; { Make sure the text cursor stays in the drawing window }
GetGraphicsStatus(SaveStatus);
SetLineStyle(UserBitLn,CurrentTextCursorLineStyle,NormWidth);
ChangeWriteMode(XorPut);
ChangeColor(SystemWhite);
LineTo(SaveStatus.XCoord,SaveStatus.YCoord+Height);
SetGraphicsStatus(SaveStatus)
end;
constructor TMouse.Init;
{ Initialize the mouse }
var MouseRegs: Registers;
MouseVector: pointer;
begin
GetIntVec($33,MouseVector);
if MouseVector <> nil
then
begin
MouseCall(0,MouseRegs);
if MouseRegs.AX = $FFFF
then
begin
fMousePresent := true;
if GetMaxX < 320 { Watch out for these odd modes with the mouse }
then
fMouseFactor := 1
else
fMouseFactor := 0;
fVisible := false;
fCurrentCursor := PenCursor; { So the next statement works correctly }
SetCursor(DefaultCursor);
fTextCursorHeight := 1;
fTextCursorEnabled := false; { Text cursor is off initially }
Update
end
else
fMousePresent := false
end
else
fMousePresent := false
end;
procedure TMouse.DisableTextCursor;
{ Turn off the text cursor }
begin
if fTextCursorEnabled then
begin
Hide; { So the old cursor gets erased }
fTextCursorEnabled := false { Don't display cursor anymore }
end
end;
procedure TMouse.EnableTextCursor;
{ Turn on the text cursor }
begin
if not fTextCursorEnabled then
begin
Hide;
fTextCursorEnabled := true
end
end;
procedure TMouse.Hide;
{ Turn mouse cursor off }
var MouseRegs: Registers;
begin
if fVisible then
begin
fVisible := false;
MouseCall(2,MouseRegs);
if fTextCursorEnabled then { Draw the text cursor }
XorTextCursor(fTextCursorHeight)
end
end;
function TMouse.Present: boolean;
{ Return true if mouse is present }
begin
Present := fMousePresent
end;
procedure TMouse.SetCursor(NewCursor: MouseCursor);
{ Change to a new cursor shape }
var MouseRegs: Registers;
begin
if fCurrentCursor <> NewCursor then { Don't flicker the screen if the cursor style didn't change }
begin
fCurrentCursor := NewCursor;
with MouseRegs do
begin
BX := word(Cursor[NewCursor].HotSpot.X);
CX := word(Cursor[NewCursor].HotSpot.Y);
DX := ofs(Cursor[NewCursor].ScreenMask);
ES := seg(Cursor[NewCursor].ScreenMask)
end;
MouseCall(9,MouseRegs)
end
end;
procedure TMouse.SetTextCursor(Height: integer);
{ Set the height of the text cursor }
begin
fTextCursorHeight := Height
end;
procedure TMouse.Show;
{ Turn mouse cursor on }
var MouseRegs: Registers;
begin
if not fVisible then
begin
fVisible := true;
if fTextCursorEnabled then
XorTextCursor(fTextCursorHeight);
MouseCall(1,MouseRegs)
end
end;
procedure TMouse.Update;
{ Update the currect mouse status }
var MouseRegs: Registers;
begin
MouseCall(3,MouseRegs);
with MouseRegs do
begin
fPreviousButtonStatus := fLastButtonStatus;
fLastButtonStatus := BX;
fLastLocationX := CX shr fMouseFactor;
fLastLocationY := DX
end
end;
function TMouse.GetLocationX: integer;
{ Returns last horizontal location }
begin
GetLocationX := fLastLocationX
end;
function TMouse.GetLocationY: integer;
{ Returns last vertical location }
begin
GetLocationY := fLastLocationY
end;
function TMouse.GetButton(Button: MouseButton): MouseStatus;
{ Returns last status of a button }
var ButtonMask: word;
begin
ButtonMask := $0001 shl ord(Button);
GetButton := MouseStatus(2 * byte((fPreviousButtonStatus and ButtonMask)<>0) +
byte((fLastButtonStatus and ButtonMask)<>0))
end;
end.
