{MOUSE.PAS creates MOUSE.TPU Unit} {From the book "OBJECT ORIENTED PROGRAMMING IN TURBO PASCAL 5.5"} Unit Mouse; Interface Type GCursor = record ScreenMask, CursorMask : array[0..15] of word; hotX,hotY : integer; end; {record} {================================} {Graphics Cursors are predefined } {for use with GraphicMouse } {================================} Const {The graphics cursors are defined as constants } HAMMER : GCursor = {As in the hammer of THOR, my favorite} (ScreenMask : ($8003,$0001,$0001,$1831, $1011,$0001,$0001,$8003, $F83F,$F83F,$F83F,$F83F, $F83F,$F83F,$F83F,$F83F); CursorMask : ($0000,$3FF8,$4284,$4104, $4284,$4444,$3FF8,$0380, $0380,$0380,$0380,$0380, $0380,$0380,$0380,$0000); HotX : $0007; HotY : $0003); ARROW : GCursor = {Your run-of-the-mill Graphics Arrow cursor} (ScreenMask : ($1FFF,$0FFF,$07FF,$03FF, $01FF,$00FF,$007F,$003F, $001F,$003F,$01FF,$01FF, $E0FF,$F0FF,$F8FF,$F8FF); CursorMask : ($0000,$4000,$6000,$7000, $7800,$7C00,$7E00,$7F00, $7F80,$7C00,$4C00,$0600, $0600,$0300,$0400,$0000); HotX : $0001; HotY : $0001); CHECK : GCursor = {A check-mark cursor} (ScreenMask : ($FFF0,$FFE0,$FFC0,$FF81, $FF03,$0607,$000F,$001F, $803F,$C07F,$E0FF,$F1FF, $FFFF,$FFFF,$FFFF,$FFFF); CursorMask : ($0000,$0006,$000C,$0018, $0030,$0060,$70C0,$3980, $1F00,$0E00,$0400,$0000, $0000,$0000,$0000,$0000); HotX : $0005; HotY : $0010); CROSS : GCursor = {A circle with center cross cursor} (ScreenMask : ($F01F,$E00F,$C007,$8003, $0441,$0C61,$0381,$0381, $0381,$0C61,$0441,$8003, $C007,$E00F,$F01F,$FFFF); CursorMask : ($0000,$07C0,$0920,$1110, $2108,$4004,$4004,$783C, $4004,$4004,$2108,$1110, $0920,$07C0,$0000,$0000); HotX : $0007; HotY : $0007); GLOVE : GCursor = {The hand with pointing finger cursor} (ScreenMask : ($F3FF,$E1FF,$E1FF,$E1FF, $E1FF,$E049,$E000,$8000, $0000,$0000,$07FC,$07F8, $9FF9,$8FF1,$C003,$E007); CursorMask : ($0C00,$1200,$1200,$1200, $1200,$13B6,$1249,$7249, $9249,$9001,$9001,$8001, $4002,$4002,$2004,$1FF8); HotX : $0004; HotY : $0000); IBEAM : GCursor = {Your normal text entering I shaped cursor} (ScreenMask : ($F3FF,$E1FF,$E1FF,$E1FF, $E1FF,$E049,$E000,$8000, $0000,$0000,$07FC,$07F8, $9FF9,$8FF1,$C003,$E007); CursorMask : ($0C30,$0240,$0180,$0180, $0180,$0180,$0180,$0180, $0180,$0180,$0180,$0180, $0180,$0180,$0240,$0C30); HotX : $0007; HotY : $0007); KKG : GCursor = {KKG symbol, a little sorority stuff} (ScreenMask : ($FFFF,$1040,$1040,$0000, $0000,$0000,$0411,$0411, $0001,$0001,$0001,$1041, $1041,$1041,$FFFF,$FFFF ); CursorMask : ($0000,$0000,$4517,$4515, $4925,$5144,$6184,$6184, $5144,$4924,$4514,$4514, $4514,$0000,$0000,$0000 ); HotX : $0007; HotY : $0005); SMILEY : GCursor = {a Smiley face for you!} (ScreenMask : ($C003,$8001,$07E0,$0000, $0000,$0000,$0000,$0000, $0000,$0000,$0000,$8001, $C003,$C003,$E007,$F81F ); CursorMask : ($0FF0,$1008,$2004,$4002, $4E72,$4A52,$4E72,$4002, $4992,$581A,$2424,$13C8, $1008,$0C30,$03C0,$0000 ); HotX : $0007; HotY : $0005); XOUT : GCursor = {a BIG X marks the spot} (ScreenMask : ($1FF8,$0FF0,$07E0,$03C0, $8181,$C003,$E007,$F00F, $F81F,$F00F,$E007,$C003, $8181,$03C0,$07E0,$0FF0 ); CursorMask : ($8001,$C003,$6006,$300C, $1818,$0C30,$0660,$03C0, $0180,$03C0,$0660,$0C30, $1818,$300C,$6006,$C003 ); HotX : $0007; HotY : $0008); SWORD : GCursor = {For the D&D buffs...} (ScreenMask : ($F83F,$F83F,$F83F,$F83F, $F83F,$F83F,$F83F,$F83F, $8003,$8003,$8003,$8003, $8003,$F83F,$F01F,$F01F ); CursorMask : ($0100,$0380,$0380,$0380, $0380,$0380,$0380,$0380, $0380,$3398,$3398,$3FF8, $0380,$0380,$0380,$07C0 ); HotX : $0007; HotY : $0000); 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.