home *** CD-ROM | disk | FTP | other *** search
- Unit EgaMouse;
-
- {*******************************************************************}
- {* *}
- {* EgaMouse - EGA Mouse Unit *}
- {* *}
- {* version 1.0, 02/02/88 *}
- {* by Eduardo Martins 73300,267 *}
- {* *}
- {* based on Mouse4 *}
- {* version .9, 11/20/87 *}
- {* by Richard Sadowsky 74017,1670 *}
- {* *}
- {* thanks to John Sierasky for helping me out *}
- {* with function CursorShape (mouse function 9) *}
- {* *}
- {* released to the public domain *}
- {* *}
- {*******************************************************************}
-
- Interface
-
- Uses DOS;
-
- type
- MaskType = array[0..1, 0..15] of word;
-
- const
- LEFTPRESS = 2;
- LEFTREL = 4;
- RIGHTPRESS = 8;
- RIGHTREL = 16;
-
- Standard = 1;
- PointingHand = 2;
- HourGlass = 3;
- DiagCross = 4;
- CheckMark = 5;
-
-
- Hand: MaskType =
- (($E1FF,$E1FF,$E1FF,$E1FF,$E000,$E000,$E000,$0000, { Screen Mask }
- $0000,$0000,$0000,$0000,$0000,$0000,$0000,$0000),
-
- ($1E00,$1200,$1200,$1200,$13FF,$1249,$1249,$F249, { Cursor Mask }
- $9001,$9001,$9001,$8001,$8001,$8001,$8001,$FFFF));
-
- Hour: MaskType =
- (($0000,$0000,$0000,$0000,$8001,$C003,$E007,$F00F,
- $E007,$C003,$8001,$0000,$0000,$0000,$0000,$FFFF),
-
- ($0000,$7FFE,$6006,$300C,$1818,$0C30,$0660,$03C0,
- $0660,$0C30,$1998,$33CC,$67E6,$7FFE,$0000,$0000));
-
- Stand: MaskType =
- (($3FFF,$1FFF,$0FFF,$07FF,$03FF,$01FF,$00FF,$007F,
- $003F,$001F,$01FF,$10FF,$30FF,$F87F,$F87F,$FC7F),
-
- ($0000,$4000,$6000,$7000,$7800,$7C00,$7E00,$7F00,
- $7F80,$7C00,$6C00,$4600,$0600,$0300,$0300,$0000));
-
- DiagC: MaskType =
- (($07E0,$0180,$0000,$C003,$F00F,$C003,$0000,$0180,
- $07E0,$FFFF,$FFFF,$FFFF,$FFFF,$FFFF,$FFFF,$FFFF),
-
- ($0000,$700E,$1C38,$0660,$03C0,$0660,$1C38,$700E,
- $0000,$0000,$0000,$0000,$0000,$0000,$0000,$0000));
-
- Check: MaskType =
- (($FFF0,$FFE0,$FFC0,$FF03,$0607,$000F,$001F,$C03F,
- $F07F,$FFFF,$FFFF,$FFFF,$FFFF,$FFFF,$FFFF,$FFFF),
-
- ($0000,$0006,$000C,$0018,$0030,$0060,$70C0,$1D80,
- $0700,$0000,$0000,$0000,$0000,$0000,$0000,$0000));
-
-
-
- var
- Mouse_Reg : Registers;
- Mouse_Installed : Boolean;
- Mouse_Error : Word;
- Mask : MaskType;
-
- function InitMouse : Word;
- { Function 0 - Initialize mouse software and hardware }
-
- procedure ShowMouse;
- { function 1 - show mouse cursor }
-
- procedure HideMouse;
- { function 2 - hide mouse cursor }
-
- function MousePosition(var MouseX,MouseY : Word) : Word;
- { function 3 - return mouse position and button status }
- { X and Y values scaled for 640 x 350 EGA mode }
-
- procedure SetMousePosition(mousex, mousey: Word);
- { function 4 - sets mouse position }
- { X and Y values scaled for 640 x 350 EGA mode }
-
- function MousePress(button: Word;
- var count, lastx, lasty: Word): Word;
- { function 5 - gets button press information }
- { X and Y values scaled for 640 x 350 EGA mode }
-
- function MouseRelease(button: Word;
- var count, lastx, lasty: Word): Word;
- { function 6 - gets button release information }
- { X and Y values scaled for 640 x 350 EGA mode }
-
- procedure SetMouseXY(x1,y1,x2,y2: Word);
- { functions 7 and 8 - sets min/max values for horizontal/vertical }
- { X and Y values scaled for 640 x 350 EGA mode }
-
- procedure RestoreMouseXY;
- { functions 7 and 8 - restores min/max values for CGA screen }
-
- procedure CursorShape(Shape: integer);
- { function 9 - sets the graphics cursor shape }
-
- procedure SetPixeltoMickey(Horiz,Verti : Word);
- { function 15 - sets the mickey to pixel ratio }
-
-
- implementation
-
- function InitMouse : Word;
- { Function 0 - Initialize mouse software and hardware }
-
- begin
- with Mouse_Reg do
- Ax := 0;
- Intr($33,Mouse_Reg);
- InitMouse := Mouse_Reg.Ax;
- end;
-
- procedure ShowMouse;
- { function 1 - show mouse cursor }
-
- begin
- Mouse_Reg.Ax := 1;
- Intr($33,Mouse_Reg);
- end;
-
- procedure HideMouse;
- { function 2 - hide mouse cursor }
-
- begin
- Mouse_Reg.AX := 2;
- Intr($33,Mouse_Reg);
- end;
-
- function MousePosition(var MouseX,MouseY : Word) : Word;
- { function 3 - return mouse position and button status }
- { X and Y values scaled for 640 x 350 EGA mode }
-
- begin
- Mouse_Reg.Ax := 3;
- Intr($33,Mouse_Reg);
- with Mouse_Reg do begin
- MouseX := Succ(Cx);
- MouseY := Succ(Dx);
- MousePosition := Bx;
- end;
- end;
-
- procedure SetMousePosition(mousex, mousey: Word);
- { function 4 - sets mouse position }
- { X and Y values scaled for 640 x 350 EGA mode }
-
- begin
- Mouse_Reg.ax:=4;
- Mouse_Reg.cx:=Pred(mousex);
- Mouse_Reg.dx:=Pred(mousey);
- intr($33,Mouse_Reg);
- end;
-
- function MousePress(button: Word;
- var count, lastx, lasty: Word): Word;
- { function 5 - gets button press information }
- { X and Y values scaled for 640 x 350 EGA mode }
-
- begin
- Mouse_Reg.ax:=5;
- Mouse_Reg.bx:=button;
- intr($33,Mouse_Reg);;
- mousepress:=Mouse_Reg.ax;
- count:=Mouse_Reg.bx;
- lastx:=Succ(Mouse_Reg.cx );
- lasty:=Succ(Mouse_Reg.dx );
- end;
-
- function MouseRelease(button: Word;
- var count, lastx, lasty: Word): Word;
- { function 6 - gets button release information }
- { X and Y values scaled for 640 x 350 EGA mode }
-
- begin
- Mouse_Reg.ax:=6;
- Mouse_Reg.bx:=button;
- intr($33,Mouse_Reg);;
- mouserelease:=Mouse_Reg.ax;
- count:=Mouse_Reg.bx;
- lastx := Succ(Mouse_Reg.cx );
- lasty := Succ(Mouse_Reg.dx );
- end;
-
- procedure SetMouseXY(x1,y1,x2,y2: Word);
- { functions 7 and 8 - sets min/max values for horizontal/vertical }
- { X and Y values scaled for 640 x 350 EGA mode }
-
- begin
- Mouse_Reg.ax:=7;
- Mouse_Reg.cx:=Pred(x1);
- Mouse_Reg.dx:=Pred(x2);
- intr($33,Mouse_Reg);
- Mouse_Reg.ax:=8;
- Mouse_Reg.cx:=Pred(y1);
- Mouse_Reg.dx:=Pred(y2);
- intr($33,Mouse_Reg);
- end;
-
- procedure RestoreMouseXY;
- { functions 7 and 8 - restores min/max values for EGA screen }
-
- begin
- Mouse_Reg.ax:=7;
- Mouse_Reg.cx:=0;
- Mouse_Reg.dx:=639;
- intr($33,Mouse_Reg);
- Mouse_Reg.ax:=8;
- Mouse_Reg.cx:=0;
- Mouse_Reg.dx:=349;
- intr($33,Mouse_Reg);
- end;
-
-
- procedure CursorShape(Shape:integer);
- { function 9 - sets the graphics cursor shape }
-
-
- begin
-
- case Shape of
- 1: Mask := Stand;
- 2: Mask := Hand;
- 3: Mask := Hour;
- 4: Mask := DiagC;
- 5: Mask := Check
- end;
-
-
- with Mouse_Reg do
- begin
- AX := 9;
- BX := 0;
- CX := 0;
- ES := Seg(Mask);
- DX := Ofs(Mask);
- Intr($33, Mouse_Reg);
- end;
- end;
-
-
- procedure SetPixeltoMickey(Horiz,Verti : Word);
- { function 15 - sets the mickey to pixel ratio }
-
- begin
- with Mouse_Reg do begin
- Ax := 15;
- Cx := Horiz;
- Dx := Verti;
- end;
- Intr($33,Mouse_Reg)
- end;
-
- begin
- Mouse_Error := InitMouse;
- Mouse_Installed := Mouse_Error = 65535;
- end.