Howdy, Stranger!

It looks like you're new here. If you want to get involved, click one of these buttons!

Categories

Welcome to the new platform of Programmer's Heaven! We apologize for the inconvenience caused, if you visited us from a broken link of the previous version. The main reason to move to a new platform is to provide more effective and collaborative experience to you all. Please feel free to experience the new platform and use its exciting features. Contact us for any issue that you need to get clarified. We are more than happy to help you.

NEW MOUSE UNIT

Phat NatPhat Nat Posts: 757Member
This unit (TP7) is NOT meant for animated backgrounds. It works well with stationary backgrounds in any VESA mode pretty much (640x400x8-bit &up)
Feel free to modify however you want. One point, it will throw off your clock, although Win XP & maybe others will keep the correct clock in windows.

Have Fun,
Phat Nat

PS - The next message contains a demo of how to use it. It assumes that you have the GRAPHICS unit I posted up here.

[code]
{$F+,S-,W-}
UNIT Mouse;
INTERFACE
USES Dos;

PROCEDURE ShowMouse;
PROCEDURE HideMouse;
PROCEDURE GetMouse(VAR MouseX, MouseY : Word; VAR MouseB : Byte);
PROCEDURE SetMouseCursor(X,Y : Word; Data : Pointer);
PROCEDURE SetDefaultMouseCursor;
PROCEDURE SetMouseScreen(MinX,MinY,MaxX,MaxY : Word);
FUNCTION GetPixel(X,Y : LongInt; Where : Word) : Byte;
PROCEDURE PutPixel(X,Y : LongInt;Color : Byte; Where : Word);
PROCEDURE SetColor(Color, R, G, B : Byte);

VAR
MouseButtons : Byte;
MouseX, MouseY : Word;

CONST
ScrWidth : Word = 320;
ScrHeight : Word = 200;
BPP : Byte = 8;

IMPLEMENTATION

TYPE
ModeInfoBlock = record
{ mandatory information }
ModeAttributes : Integer; { ; mode attributes }
WinAAttributes : Byte; { ; window A attributes }
WinBAttributes : Byte; { ; window B attributes }
WinGranularity : Integer; { ; window granularity }
WinSize : Integer; { ; window size }
WinASegment : Integer; { ; window A start segment }
WinBSegment : Integer; { ; window B start segment }
WinFuncPtr : LongInt; { ; pointer to windor function }
BytesPerScanLine : Integer; { ; bytes per scan line }
{ formerly optional information (now mandatory) }
XResolution : Integer; { ; horizontal resolution }
YResolution : Integer; { ; vertical resolution }
XCharSize : Byte; { ; character cell width }
YCharSize : Byte; { ; character cell height }
NumberOfPlanes : Byte; { ; number of memory planes }
BitsPerPixel : Byte; { ; bits per pixel }
NumberOfBanks : Byte; { ; number of banks }
MemoryModel : Byte; { ; memory model type }
BankSize : Byte; { ; bank size in kb }
NumberOfImagePages : Byte; { ; number of images }
Reserved : Byte; { 1 ; reserved for page function }
{ new Direct Color fields }
RedMaskSize : Byte; { ; size of direct color red mask in bits }
RedFieldPosition : Byte; { ; bit position of LSB of red mask }
GreenMaskSize : Byte; { ; size of direct color green mask in bits }
GreenFieldPosition : Byte; { ; bit position of LSB of green mask }
BlueMaskSize : Byte; { ; size of direct color blue mask in bits }
BlueFieldPosition : Byte; { ; bit position of LSB of blue mask }
RsvdMaskSize : Byte; { ; size of direct color reserved mask in bits }
DirectColorModeInfo : Byte; { ; Direct Color mode attributes }
BlockReserved : Array[0..215] Of Byte; { ; remainder of ModeInfoBlock }
End;
{ Max Cursor Size = 64x64, Max 4 Bytes/Pixel (32-bit) }
CursorSpace = Array[0..63*4,0..63*4] Of Byte;
CursorSpacePtr = ^CursorSpace;

VAR
Int1CSave : Pointer;
OldExit : Pointer;
ModeInfo : ModeInfoBlock;

CONST
{ countdown = 1193180/1200; { 1200 = 60Hz * 20 }
StandardCountdown = $0000; { 65536, 18.2/sec }
{ VideoCountdown = 994; { 994, 1200.38/sec }
{ VideoCountdown = 852; { 852, 1400.45/sec }
VideoCountdown = 8522; { 2*70Hz }
CX : Byte = 0;
CY : Byte = 0;
DefaultMouseX = 12;
DefaultMouseY = 18;
DefaultCursor : Array[0..DefaultMouseY-1,0..DefaultMouseX-1] Of Byte =
((000,255,255,255,255,255,255,255,255,255,255,255),
(000,000,255,255,255,255,255,255,255,255,255,255),
(000,001,000,255,255,255,255,255,255,255,255,255),
(000,001,001,000,255,255,255,255,255,255,255,255),
(000,001,002,001,000,255,255,255,255,255,255,255),
(000,001,002,002,001,000,255,255,255,255,255,255),
(000,001,002,003,002,001,000,255,255,255,255,255),
(000,001,002,003,003,002,001,000,255,255,255,255),
(000,001,002,003,003,003,000,001,000,255,255,255),
(000,001,002,003,003,000,255,255,255,255,255,255),
(000,001,000,000,003,000,255,255,255,255,255,255),
(000,000,255,255,000,003,000,255,255,255,255,255),
(000,255,255,255,000,003,000,255,255,255,255,255),
(255,255,255,255,255,000,003,000,255,255,255,255),
(255,255,255,255,255,000,003,000,255,255,255,255),
(255,255,255,255,255,255,000,003,000,255,255,255),
(255,255,255,255,255,255,000,003,000,255,255,255),
(255,255,255,255,255,255,255,000,255,255,255,255));

VAR
Saved : CursorSpacePtr;
SaveMX,
SaveMY : Word;
MouseOn : Boolean;
OldBank : Word;
Cursor : CursorSpacePtr;

PROCEDURE GetMouse(VAR MouseX, MouseY : Word; VAR MouseB : Byte); Assembler;
ASM
Mov Ax, $0003
Int $33
Les Di, MouseX { ES:DI = @MouseX }
Mov Es:[Di], Cx
Les Di, MouseY { ES:DI = @MouseY }
Mov Es:[Di], Dx
Les Di, MouseB { ES:DI = @MouseY }
Mov Es:[Di], Bl
End;

FUNCTION GetPixel(X,Y : LongInt; Where : Word) : Byte;
VAR Bank : Word;
Begin
Bank := (Y*ScrWidth+X) Shr 16;
If OldBank <> Bank Then
Begin
ASM
Mov Ax, $4f05
Xor Bh, Bh
Mov Dx, Bank
Int $10
END;
OldBank := Bank;
End;
GetPixel := Mem[Where:X+Y*ScrWidth-(Bank Shl 16)];
End;

PROCEDURE PutPixel(X,Y : LongInt;Color : Byte; Where : Word);
VAR Bank : Word;
Begin
Bank := (Y*ScrWidth+X) Shr 16;
If OldBank <> Bank Then
Begin
ASM
Mov Ax, $4f05
Xor Bh, Bh
Mov Dx, Bank
Int $10
END;
OldBank := Bank;
End;
Mem[Where:X+Y*ScrWidth-(Bank Shl 16)] := Color
End;

PROCEDURE DrawCursor;
VAR
X, Y : Byte;
Begin
If Not(MouseOn) Then Exit;
For Y := 0 to CY Do
For X := 0 to CX*(BPP SHR 3) Do
PutPixel(SaveMX+X,SaveMY+Y,Saved^[Y,X],$A000);
SaveMX := MouseX;
SaveMY := MouseY;
For Y := 0 to CY Do
Begin
For X := 0 to CX*(BPP SHR 3) Do
Begin
Saved^[Y,X] := GetPixel(SaveMX+X,SaveMY+Y,$A000);
If SaveMX+X < ScrWidth Then
If Cursor^[Y,X DIV (BPP SHR 3)] <> $FF Then
PutPixel(SaveMX+X,SaveMY+Y,Cursor^[Y,X DIV (BPP SHR 3)]+230,$A000);
End;
End;
End;

PROCEDURE CheckRefresh; Interrupt; Assembler;
ASM
Mov dx,3DAh
In al,dx
And al,08h
@l1:
In al,dx
And al,08h
Jnz @l1
@l2:
In al,dx
And al,08h
Jz @l2 { Wait for Vertical Retrace }
CALL DrawCursor
End;

PROCEDURE SetTimer(countdown : Word); Assembler;
ASM
cli
mov al,00110110b { bit 7,6 = (00) timer counter 0 }
{ bit 5,4 = (11) write LSB then MSB }
{ bit 3-1 = (011) generate square wave }
{ bit 0 = (0) binary counter }
out 43h,al { prep PIT, counter 0, square wave&init count }
jmp @Delay1 { JMP $+2 }
@Delay1:
mov cx,countdown { default is 0x0000 (65536) (18.2 per sec) }
{ interrupts when counter decrements to 0 }
mov al,cl { send LSB of timer count }
out 40h,al
jmp @Delay2 { JMP $+2 }
@Delay2:
mov al,ch { send MSB of timer count }
out 40h,al
jmp @Delay3 { JMP $+2 }
@Delay3:
sti
END;

PROCEDURE GetVideoInfo;
Begin
ASM
Mov Ax, $4F03
Int $10
Cmp Al, $4F
Jnz @Error
Cmp Ah, $00
Jnz @Error
Mov Ax, $4F01
Mov Cx, Bx
Mov DI, SEG ModeInfo
Mov ES, DI
Mov DI, OFFSET ModeInfo
Int $10
Jmp @End
@Error:
@End:
END;
ScrWidth := ModeInfo.XResolution;
ScrHeight := ModeInfo.YResolution;
BPP := ModeInfo.BitsPerPixel;
End;

PROCEDURE SetMouseScreen(MinX,MinY,MaxX,MaxY : Word); Assembler;
ASM
Mov Ax, $0007
Mov Cx, MinX
Mov Dx, MaxX
Mov ScrWidth, Dx
Int $33
Mov Ax, $0008
Mov Cx, MinY
Mov Dx, MaxY
Int $33
End;

PROCEDURE ShowMouse;
VAR
X, Y : Word;
Begin
If MouseOn Then Exit;
GetVideoInfo;
If CX = 0 Then SetDefaultMouseCursor;
SetMouseScreen(0,0,ScrWidth*BPP SHR 3,ScrHeight);
GetIntVec($1C,Int1CSave);
SetIntVec($1C,Addr(CheckRefresh));
GetMouse(MouseX,MouseY,MouseButtons);
For Y := 0 to CY Do
For X := 0 to CX*(BPP SHR 3) Do
Saved^[Y,X] := GetPixel(SaveMX+X,SaveMY+Y,$A000);
MouseOn := True;
End;

PROCEDURE HideMouse;
VAR
X, Y : Word;
Begin
If Not(MouseOn) Then Exit;
SetIntVec($01C,Int1CSave);
For Y := 0 to CY Do
For X := 0 to CX*(BPP SHR 3) Do
PutPixel(SaveMX+X,SaveMY+Y,Saved^[Y,X],$A000);
MouseOn := False;
End;

PROCEDURE SetMouseCursor(X,Y : Word; Data : Pointer);
VAR
MouseVisible : Boolean;
Begin
MouseVisible := MouseOn;
If MouseVisible Then HideMouse;
Cx := X-1; Cy := Y-1;
For Y := 0 to CY Do
For X := 0 to CX Do
Cursor^[Y,X] := Mem[Seg(Data^):Ofs(Data^)+Y*(CX+1)+X];
If MouseVisible Then ShowMouse;
End;

PROCEDURE SetDefaultMouseCursor;
Begin
SetMouseCursor(DefaultMouseX,DefaultMouseY,@DefaultCursor);
SetColor(230,0,0,0);
SetColor(231,43,43,43);
SetColor(232,53,53,53);
SetColor(233,63,63,63);
End;

PROCEDURE SetColor(Color, R, G, B : Byte); Assembler;
ASM
Mov Dx, 3c8h
Mov Al, Color
Out Dx, Al
Inc Dx
Mov Al, R
Out Dx, Al
Mov Al, G
Out Dx, Al
Mov Al, B
Out Dx, Al
END;

PROCEDURE MyExitProc;
Begin
ExitProc := OldExit;
HideMouse;
SetTimer(StandardCountdown);
Dispose(Cursor); Dispose(Saved);
End;

Begin
OldBank := 255;
ExitProc := @MyExitProc;
SetTimer(VideoCountdown);
New(Cursor); New(Saved);
End.
[/code]

Comments

  • Phat NatPhat Nat Posts: 757Member
    Here is a demo on how to use the MOUSE.TPU. It is assumed that you also have the GRAPHICS.TPU for it to work (for the SVGA modes, etc).

    *NOTE* You can load Pointers up to 64x64 in size, 16 colors. Colors are taken from the Palette starting at entry 230, and the following 16 colors up to 246.

    [code]
    USES Crt, Mouse, Graphics;
    CONST
    MyMouseX = 7;
    MyMouseY = 7;
    MyMouse : Array[0..MyMouseY-1,0..MyMouseX-1] Of Byte =
    (($FF,$FF,$FF,$00,$FF,$FF,$FF),
    ($FF,$FF,$FF,$00,$FF,$FF,$FF),
    ($FF,$FF,$00,$01,$00,$FF,$FF),
    ($00,$00,$01,$02,$01,$00,$00),
    ($FF,$FF,$00,$01,$00,$FF,$FF),
    ($FF,$FF,$FF,$00,$FF,$FF,$FF),
    ($FF,$FF,$FF,$00,$FF,$FF,$FF));
    VAR
    X,Y : Word;
    OldButton : Byte;
    Begin
    InitSVGA($101);
    { For X := 0 to 15 Do
    SetColor(230+X,(X*30) MOD 63,(X*40) MOD 63,(X*50) MOD 63);}
    For Y := 0 to ScrHeight-1 Do
    For X := 0 to ScrWidth-1 do
    PutPixel(X,Y,((X DIV (5-(BPP SHR 3)))*(Y DIV 5)) MOD(16)+15+(BPP SHR 3)*70,0,VGA);
    ShowMouse;
    repeat
    GetMouse(MouseX,MouseY,MouseButtons);
    X := Random(Mouse.ScrWidth);
    Y := Random(Mouse.ScrHeight);
    Case MouseButtons Of
    0 : If OldButton <> 0 Then Begin
    SetDefaultMouseCursor;
    OldButton := MouseButtons;
    End;
    1 : If OldButton <> 1 Then Begin
    SetMouseCursor(MyMouseX,MyMouseY,@MyMouse);
    OldButton := MouseButtons;
    End;
    End;
    Delay(10);
    until Keypressed;
    HideMouse;
    CloseGraphics;
    WriteLn(Mouse.ScrWidth);
    WriteLn(Mouse.ScrHeight);
    WriteLn(Mouse.BPP);
    End.
    [/code]
Sign In or Register to comment.