home *** CD-ROM | disk | FTP | other *** search
- Unit PC_Mouse ;
-
- Interface
-
- const
- ResetTheMouse = 0 ;
- ShowCurs = 1 ;
- HideCurs = 2 ;
- GetStat = 3 ;
- SetCurs = 4 ;
- GetButtonPress = 5 ;
- GetButtonRelease = 6 ;
- SetMinMaxHoriz = 7 ;
- SetMinMaxVert = 8 ;
- SetGraphicsCursor = 9 ;
- SetTextCursor = 10 ;
- ReadMouseMotion = 11 ;
- SetUserInput = 12 ;
- EmulateLightPenOn = 13 ;
- EmulateLightPenOff = 14 ;
- SetMickeyPixelRatio = 15 ;
- ProtectCursorPos = 16 ;
- SetLargeGraphCurs = 18 ;
- SetDoubleSpeedThresh = 19 ;
-
- Type
- MouseStrings = array[0..3] of string[19] ;
-
- Const
- MouseTypeText : MouseStrings = ('Unknown Mouse Type',
- 'Unknown Mouse Type',
- 'Microsoft Mouse',
- 'Mouse Systems Mouse') ;
- Var
- MouseType,
- M1,
- M2,
- M3,
- M4 : integer ;
-
- M5,
- CursPtr,
- AreaPtr : Pointer ;
-
- Cursor : Array[0..1,0..15] of word ;
-
- MousePresent : Boolean ;
-
- Procedure ChangeGraphicsCursor ;
- Procedure MakeScreenMask ;
- Procedure FlipLRCursor ;
- Procedure HourGlassCursor ;
- Procedure ClockCursor ;
- Procedure CircularCrossHairCursor ;
- Procedure CrossHairCursor ;
- Procedure CrossHair1Cursor ;
- Procedure CrossHair2Cursor ;
- Procedure CrossHair3Cursor ;
- Procedure DotCursor ;
- Procedure Arrow ;
- Procedure ArrowCursor ;
- Procedure RightArrowCursor ;
- Procedure ShowCursor ;
- Procedure ResetMouse ;
- Procedure InitGraphicsMouse ;
- Procedure GetMouseStat ;
- Procedure GetLButton ;
- Procedure GetRButton ;
- Procedure GetMButton ;
- Procedure PollMousePos ;
- Procedure PositionGraphicsCursor (HorizCursorPos,VertCursorPos:integer) ;
- Procedure PositionTextCursor (HorizCursorPos,VertCursorPos:integer) ;
- Procedure SetVerticalLimits (MinVert,MaxVert:integer) ;
- Procedure SetHorizontalLimits (MinHoriz,MaxHoriz:integer) ;
- Procedure HideCursor ;
- Procedure ProtectArea (AreaPtr:pointer) ;
- Procedure SetSoftCursor(ScreenMask, CursorMask:integer) ;
- Function LButtonPressed : boolean ;
- Function RButtonPressed : boolean;
- Function MButtonPressed : boolean;
-
- Implementation
-
- Uses DOS ;
-
- const
- LButton = 0 ;
- RButton = 1 ;
- MButton = 2 ;
-
- High = 5000 ;
- Med = 1000 ;
- Low = 500 ;
- VLow = 100 ;
-
-
- Procedure MouseTPL(var M1, M2, M3:integer; var M5:pointer); External ;
- {$L MOUSEM}
- Procedure MouseTP(var M1, M2, M3, M4:integer); External ;
- {$L MOUSE}
-
-
- Procedure ChangeGraphicsCursor ;
-
- begin
- M1 := SetGraphicsCursor ;
- M5 := CursPtr ;
- mousetpl(M1,M2,M3,M5) ;
- end ;
-
-
- Procedure MakeScreenMask ;
-
- Var
- i : byte ;
-
- begin
- for i := 0 to 15 do Cursor[0,i] := (Cursor[1,i] XOR $FFFF) ;
- end ;
-
-
- Procedure FlipLRCursor ;
-
- Var
- i : integer ;
-
- begin
- for i := 0 to 15 do begin
- Cursor[1,i] := ((Cursor[1,i] AND $8000) shr 14) OR
- ((Cursor[1,i] AND $4000) shr 12) OR
- ((Cursor[1,i] AND $2000) shr 10) OR
- ((Cursor[1,i] AND $1000) shr 8) OR
- ((Cursor[1,i] AND $0800) shr 6) OR
- ((Cursor[1,i] AND $0400) shr 4) OR
- ((Cursor[1,i] AND $0200) shr 2) OR
- (Cursor[1,i] AND $0100) OR
- ((Cursor[1,i] AND $0080) shl 2) OR
- ((Cursor[1,i] AND $0040) shl 4) OR
- ((Cursor[1,i] AND $0020) shl 6) OR
- ((Cursor[1,i] AND $0010) shl 8) OR
- ((Cursor[1,i] AND $0008) shl 10) OR
- ((Cursor[1,i] AND $0004) shl 12) OR
- ((Cursor[1,i] AND $0002) shl 14) OR
- (Cursor[1,i] AND $0001) ;
-
- Cursor[0,i] := ((Cursor[0,i] AND $8000) shr 14) OR
- ((Cursor[0,i] AND $4000) shr 12) OR
- ((Cursor[0,i] AND $2000) shr 10) OR
- ((Cursor[0,i] AND $1000) shr 8) OR
- ((Cursor[0,i] AND $0800) shr 6) OR
- ((Cursor[0,i] AND $0400) shr 4) OR
- ((Cursor[0,i] AND $0200) shr 2) OR
- (Cursor[0,i] AND $0100) OR
- ((Cursor[0,i] AND $0080) shl 2) OR
- ((Cursor[0,i] AND $0040) shl 4) OR
- ((Cursor[0,i] AND $0020) shl 6) OR
- ((Cursor[0,i] AND $0010) shl 8) OR
- ((Cursor[0,i] AND $0008) shl 10) OR
- ((Cursor[0,i] AND $0004) shl 12) OR
- ((Cursor[0,i] AND $0002) shl 14) OR
- (Cursor[0,i] AND $0001) ;
- end ;
- end ;
-
-
- Procedure HourGlassCursor ;
-
- begin
- Cursor[1, 0] := $FFFE ;
- Cursor[1, 1] := $4004 ;
- Cursor[1, 2] := $2008 ;
- Cursor[1, 3] := $2828 ;
- Cursor[1, 4] := $1450 ;
- Cursor[1, 5] := $0AA0 ;
- Cursor[1, 6] := $0540 ;
- Cursor[1, 7] := $0380 ;
- Cursor[1, 8] := $0540 ;
- Cursor[1, 9] := $08A0 ;
- Cursor[1,10] := $1110 ;
- Cursor[1,11] := $2088 ;
- Cursor[1,12] := $2088 ;
- Cursor[1,13] := $4AA4 ;
- Cursor[1,14] := $5554 ;
- Cursor[1,15] := $FFFE ;
-
- MakeScreenMask ;
-
- M2 := 7 ;
- M3 := 8 ;
- ChangeGraphicsCursor ;
- end ;
-
-
- Procedure ClockCursor ;
-
- begin
- Cursor[1, 0] := $07C0 ;
- Cursor[1, 1] := $07C0 ;
- Cursor[1, 2] := $0FE0 ;
- Cursor[1, 3] := $3938 ;
- Cursor[1, 4] := $610C ;
- Cursor[1, 5] := $610C ;
- Cursor[1, 6] := $C105 ;
- Cursor[1, 7] := $C107 ;
- Cursor[1, 8] := $C085 ;
- Cursor[1, 9] := $604C ;
- Cursor[1,10] := $6018 ;
- Cursor[1,11] := $3838 ;
- Cursor[1,12] := $0FE0 ;
- Cursor[1,13] := $07C0 ;
- Cursor[1,14] := $07C0 ;
- Cursor[1,15] := $0000 ;
-
- MakeScreenMask ;
-
- M2 := 7 ;
- M3 := 7 ;
- ChangeGraphicsCursor ;
- end ;
-
-
- Procedure CircularCrossHairCursor ;
-
- begin
- Cursor[1, 0] := $0FE0 ;
- Cursor[1, 1] := $3118 ;
- Cursor[1, 2] := $610C ;
- Cursor[1, 3] := $4106 ;
- Cursor[1, 4] := $C106 ;
- Cursor[1, 5] := $8102 ;
- Cursor[1, 6] := $8102 ;
- Cursor[1, 7] := $FEFE ;
- Cursor[1, 8] := $8102 ;
- Cursor[1, 9] := $8102 ;
- Cursor[1,10] := $C106 ;
- Cursor[1,11] := $4106 ;
- Cursor[1,12] := $610C ;
- Cursor[1,13] := $3118 ;
- Cursor[1,14] := $0FE0 ;
- Cursor[1,15] := $0000 ;
-
- MakeScreenMask ;
-
- M2 := 7 ;
- M3 := 7 ;
- ChangeGraphicsCursor ;
- end ;
-
-
- Procedure CrossHairCursor ;
-
- begin
- Cursor[1, 0] := $0100 ;
- Cursor[1, 1] := $0100 ;
- Cursor[1, 2] := $0100 ;
- Cursor[1, 3] := $0100 ;
- Cursor[1, 4] := $0100 ;
- Cursor[1, 5] := $0100 ;
- Cursor[1, 6] := $0100 ;
- Cursor[1, 7] := $0000 ;
- Cursor[1, 8] := $FC7F ;
- Cursor[1, 9] := $0000 ;
- Cursor[1,10] := $0100 ;
- Cursor[1,11] := $0100 ;
- Cursor[1,12] := $0100 ;
- Cursor[1,13] := $0100 ;
- Cursor[1,14] := $0100 ;
- Cursor[1,15] := $0100 ;
-
- MakeScreenMask ;
-
- M2 := 7 ;
- M3 := 8 ;
- ChangeGraphicsCursor ;
- end ;
-
-
- Procedure CrossHair1Cursor ;
-
- begin
- Cursor[1, 0] := $FFFE ;
- Cursor[1, 1] := $C006 ;
- Cursor[1, 2] := $A00A ;
- Cursor[1, 3] := $9012 ;
- Cursor[1, 4] := $8822 ;
- Cursor[1, 5] := $8442 ;
- Cursor[1, 6] := $8282 ;
- Cursor[1, 7] := $8002 ;
- Cursor[1, 8] := $8282 ;
- Cursor[1, 9] := $8442 ;
- Cursor[1,10] := $8822 ;
- Cursor[1,11] := $9012 ;
- Cursor[1,12] := $A00A ;
- Cursor[1,13] := $C006 ;
- Cursor[1,14] := $FFFE ;
- Cursor[1,15] := $0000 ;
-
- MakeScreenMask ;
-
- M2 := 7 ;
- M3 := 7 ;
- ChangeGraphicsCursor ;
- end ;
-
-
- Procedure CrossHair2Cursor ;
-
- begin
- Cursor[1, 0] := $FFFE ;
- Cursor[1, 1] := $C006 ;
- Cursor[1, 2] := $A00A ;
- Cursor[1, 3] := $9FF2 ;
- Cursor[1, 4] := $9832 ;
- Cursor[1, 5] := $9452 ;
- Cursor[1, 6] := $9292 ;
- Cursor[1, 7] := $9012 ;
- Cursor[1, 8] := $9292 ;
- Cursor[1, 9] := $9452 ;
- Cursor[1,10] := $9832 ;
- Cursor[1,11] := $9FF2 ;
- Cursor[1,12] := $A00A ;
- Cursor[1,13] := $C006 ;
- Cursor[1,14] := $FFFE ;
- Cursor[1,15] := $0000 ;
-
- MakeScreenMask ;
-
- M2 := 7 ;
- M3 := 7 ;
- ChangeGraphicsCursor ;
- end ;
-
-
- Procedure CrossHair3Cursor ;
-
- begin
- Cursor[1, 0] := $8002 ;
- Cursor[1, 1] := $4004 ;
- Cursor[1, 2] := $2008 ;
- Cursor[1, 3] := $1010 ;
- Cursor[1, 4] := $0820 ;
- Cursor[1, 5] := $0440 ;
- Cursor[1, 6] := $0000 ;
- Cursor[1, 7] := $0000 ;
- Cursor[1, 8] := $0000 ;
- Cursor[1, 9] := $0440 ;
- Cursor[1,10] := $0820 ;
- Cursor[1,11] := $1010 ;
- Cursor[1,12] := $2008 ;
- Cursor[1,13] := $4004 ;
- Cursor[1,14] := $8002 ;
- Cursor[1,15] := $0000 ;
-
- MakeScreenMask ;
-
- M2 := 7 ;
- M3 := 7 ;
- ChangeGraphicsCursor ;
- end ;
-
-
- Procedure DotCursor ;
-
- begin
- Cursor[1, 0] := $0000 ;
- Cursor[1, 1] := $0000 ;
- Cursor[1, 2] := $0000 ;
- Cursor[1, 3] := $0000 ;
- Cursor[1, 4] := $0000 ;
- Cursor[1, 5] := $0000 ;
- Cursor[1, 6] := $0000 ;
- Cursor[1, 7] := $0100 ;
- Cursor[1, 8] := $0000 ;
- Cursor[1, 9] := $0000 ;
- Cursor[1,10] := $0000 ;
- Cursor[1,11] := $0000 ;
- Cursor[1,12] := $0000 ;
- Cursor[1,13] := $0000 ;
- Cursor[1,14] := $0000 ;
- Cursor[1,15] := $0000 ;
-
- MakeScreenMask ;
-
- M2 := 7 ;
- M3 := 7 ;
- ChangeGraphicsCursor ;
- end ;
-
-
- Procedure Arrow ;
-
- begin
- Cursor[0, 0] := $9FFF ;
- Cursor[0, 1] := $8FFF ;
- Cursor[0, 2] := $87FF ;
- Cursor[0, 3] := $83FF ;
- Cursor[0, 4] := $81FF ;
- Cursor[0, 5] := $80FF ;
- Cursor[0, 6] := $807F ;
- Cursor[0, 7] := $803F ;
- Cursor[0, 8] := $801F ;
- Cursor[0, 9] := $800F ;
- Cursor[0,10] := $80FF ;
- Cursor[0,11] := $887F ;
- Cursor[0,12] := $987F ;
- Cursor[0,13] := $FC3F ;
- Cursor[0,14] := $FC3F ;
- Cursor[0,15] := $FEFF ;
-
- Cursor[1, 0] := $0000 ;
- Cursor[1, 1] := $2000 ;
- Cursor[1, 2] := $3000 ;
- Cursor[1, 3] := $3800 ;
- Cursor[1, 4] := $3C00 ;
- Cursor[1, 5] := $3E00 ;
- Cursor[1, 6] := $3F00 ;
- Cursor[1, 7] := $3F80 ;
- Cursor[1, 8] := $3FC0 ;
- Cursor[1, 9] := $3FE0 ;
- Cursor[1,10] := $3E00 ;
- Cursor[1,11] := $2300 ;
- Cursor[1,12] := $0300 ;
- Cursor[1,13] := $0180 ;
- Cursor[1,14] := $0180 ;
- Cursor[1,15] := $0000 ;
- end ;
-
-
- Procedure ArrowCursor ;
-
- begin
- Arrow ;
- M2 := 1 ;
- M3 := -1 ;
- ChangeGraphicsCursor ;
- end ;
-
-
- Procedure RightArrowCursor ;
-
- begin
- Arrow ;
- FlipLRCursor ;
- M2 := 13 ;
- M3 := -1 ;
- ChangeGraphicsCursor ;
- end ;
-
-
- Procedure ShowCursor ;
-
- begin
- M1 := ShowCurs ;
- M2 := 0 ;
- M3 := 0 ;
- M4 := 0 ;
- MouseTP(M1,M2,M3,M4) ;
- end ;
-
-
- Procedure ResetMouse ;
-
- begin
- M1 := ResetTheMouse ;
- M2 := 0 ;
- M3 := 0 ;
- M4 := 0 ;
- MouseTP(M1,M2,M3,M4) ;
-
- If (M1 = -1) then MousePresent := true
- else MousePresent := false ;
-
- Case M2 of
- 2 : MouseType := 2 ;
- 3 : MouseType := 3 ;
- else MouseType := 0 ;
- end ;
- end ;
-
-
- Procedure InitGraphicsMouse ;
-
- begin
- ResetMouse ;
- If MousePresent then begin
- CursPtr := Addr(Cursor) ;
- HourGlassCursor ;
- ShowCursor ;
- end ;
- end ;
-
-
- Procedure GetMouseStat ;
-
- begin
- M1 := GetStat ;
- M2 := 0 ;
- M3 := 0 ;
- M4 := 0 ;
- MouseTP(M1,M2,M3,M4) ;
- end ;
-
-
- Procedure GetLButton ;
-
- begin
- M1 := GetButtonPress ;
- M2 := LButton ;
- M3 := 0 ;
- M4 := 0 ;
- MouseTP(M1,M2,M3,M4) ;
- end ;
-
-
- Procedure GetRButton ;
-
- begin
- M1 := GetButtonPress ;
- M2 := RButton ;
- M3 := 0 ;
- M4 := 0 ;
- MouseTP(M1,M2,M3,M4) ;
- end ;
-
-
-
- Procedure GetMButton ;
-
- begin
- M1 := GetButtonPress ;
- M2 := MButton ;
- M3 := 0 ;
- M4 := 0 ;
- MouseTP(M1,M2,M3,M4) ;
- end ;
-
-
- Procedure PollMousePos ;
-
- begin
- M1 := ReadMouseMotion ;
- M2 := 0 ;
- M3 := 0 ;
- M4 := 0 ;
- MouseTP(M1,M2,M3,M4) ;
- end ;
-
-
- Procedure PositionGraphicsCursor (HorizCursorPos,VertCursorPos:integer) ;
-
- begin
- M1 := SetCurs ;
- M2 := 0 ;
- M3 := HorizCursorPos ;
- M4 := VertCursorPos ;
- MouseTP(M1,M2,M3,M4) ;
- end ;
-
-
- Procedure PositionTextCursor (HorizCursorPos,VertCursorPos:integer) ;
-
- begin
- M1 := SetCurs ;
- M2 := 0 ;
- M3 := HorizCursorPos*8 ;
- M4 := VertCursorPos*8 ;
- MouseTP(M1,M2,M3,M4) ;
- end ;
-
-
- Procedure SetVerticalLimits (MinVert,MaxVert:integer) ;
-
- begin
- M1 := SetMinMaxVert ;
- M2 := 0 ;
- M3 := MinVert*8 ;
- M4 := MaxVert*8 ;
- MouseTP(M1,M2,M3,M4) ;
- end ;
-
-
- Procedure SetHorizontalLimits (MinHoriz,MaxHoriz:integer) ;
-
- begin
- M1 := SetMinMaxHoriz ;
- M2 := 0 ;
- M3 := MinHoriz*8 ;
- M4 := MaxHoriz*8 ;
- MouseTP(M1,M2,M3,M4) ;
- end ;
-
-
- Procedure HideCursor ;
-
- begin
- M1 := HideCurs ;
- M2 := 0 ;
- M3 := 0 ;
- M4 := 0 ;
- MouseTP(M1,M2,M3,M4) ;
- end ;
-
-
- Procedure ProtectArea (AreaPtr:pointer) ;
-
- begin
- M1 := ProtectCursorPos ;
- M2 := 0 ;
- M3 := 0 ;
- M5 := AreaPtr ;
- MouseTPL(M1,M2,M3,M5) ;
- end ;
-
-
- Procedure SetSoftCursor(ScreenMask,CursorMask: integer) ;
-
- begin
- M1 := SetTextCursor ;
- M2 := 0 ;
- M3 := ScreenMask ;
- M4 := CursorMask ;
- MouseTP(M1,M2,M3,M4) ;
- end ;
-
-
- Function LButtonPressed : boolean ;
-
- begin
- LButtonPressed := False ;
- GetLButton ;
- If (M2 > 0) then LButtonPressed := true ;
- end;
-
-
- Function MButtonPressed : boolean ;
-
- begin
- MButtonPressed := False ;
- GetMButton ;
- If (M2 > 0) then MButtonPressed := true ;
- end;
-
-
- Function RButtonPressed : boolean ;
-
- begin
- RButtonPressed := False ;
- GetRButton ;
- If (M2 > 0) then RButtonPressed := true ;
- end;
-
- end.