[Back to MOUSE SWAG index] [Back to Main SWAG index] [Original]
{
Here's a program (unit) I just wrote that has a few nifty
applications. It captures a 16x16 area on the mode 13h screen and
converts the coordinates to a "mouse" array. Please note that there
is a demo program included. You may modify the programs if you wish.
Please e-mail me if you have any comments or questions...
One great application is loading a graphics file and then capturing
the mouse of the screen. It's good for changing the mouse cursor to
anything you can print (i.e. text, pictures). Remember, 16x16 isn't a
great deal to work with...
Here's the UNIT... the DEMO PROGRAM follows...
{--- Cut Here ---}
UNIT MCAP;
{
Well, I hope some of you find this somewhat useful...
Feel free to modify the code and such...
E-mail questions or comments to samiel@fastlane.net
Visit http://www.fastlane.net/~samiel
See the demo program...
Code is not optimized (though I tried a little)
Author is not responsible for any damages incurred
Try not to move the Capture box over the mouse...
Capture box outline also included in making 16x16 mouse...
Load a mouse driver!
<ESC> exits!
CAPTURES MOUSE FROM THE 320x200x256c SCREEN (MODE 0x13)
-------+---------------
Color | ID
-------+---------------
0 | Make Color 0
-------+---------------
15 | Make Color 15
-------+---------------
1 | Translucent (Opposite color shows)
-------+---------------
Other | Transparent (All other colors are transparent)
-------+---------------
}
INTERFACE
TYPE
Box=array [0..255] of byte; {16x16 box to capture 16x16 area}
CONST
HexString='$'; {Add to the beginning of the hex number (i.e. '0x')}
Z=255; {Box outline color}
Capture:Box= {Define 16x16 capture box}
(Z, 0,0, Z,Z, 0,0, Z,Z, 0,0, Z,Z, 0,0, Z,
0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,
0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,
Z, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, Z,
Z, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, Z,
0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,
0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,
Z, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, Z,
Z, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, Z,
0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,
0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,
Z, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, Z,
Z, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, Z,
0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,
0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,
Z, 0,0, Z,Z, 0,0, Z,Z, 0,0, Z,Z, 0,0, Z);
Procedure ResetMouse(var Installed:boolean;var Buttons:word);
Procedure MouseOn;
Procedure MouseOff;
Procedure GetMouse(FileName:string);
IMPLEMENTATION
Procedure ResetMouse(var Installed:boolean;var Buttons:word);
Var
tmp1,tmp2:word;
Begin
asm
mov ax,0
int 33h
mov tmp1,ax
mov tmp2,bx
end;
if tmp1=$FFFF then
Installed:=true
else
Installed:=false;
Buttons:=tmp2;
End;
Procedure MouseOn;Assembler;
Asm
mov ax,1
int 33h
End;
Procedure MouseOff;Assembler;
Asm
mov ax,2
int 33h
End;
Procedure GetMouse(FileName:string);
Type
Mouse=array [1..32] of word;
Var
Installed,Good:boolean;
Buttons:word;
F:Text;
Save:Box;
x,y:word;
key:word;
j,k:word;
M:Mouse;
count:word;
{Other Procedures I was too lazy to make Interfaces for...}
Procedure NewMouse(M:mouse);
var
s,o:word;
begin
s:=Seg(M);
o:=Ofs(M);
asm
mov ax,9
mov bx,0
mov cx,0
mov es,s
mov dx,o
int 33h
end;
end;
function GetKey:word;assembler;
asm
mov ax,10h
int 16h
end;
Function D2H(w:word):string;
Const
Hex:array [$0..$F] of char=
'0123456789ABCDEF';
Var
tmp:string;
Begin
tmp:=Hex[Hi(w) shr 4]+Hex[Hi(w) and $F]+
Hex[Lo(w) shr 4]+Hex[Lo(w) and $F];
D2H:=HexString+tmp;
End;
procedure GetBox(x,y:word;var B:Box);
var
j,k:word;
tmp:byte;
begin
for k:=0 to 15 do
for j:=0 to 15 do
B[j+(k*16)]:=mem[$A000:x+j+(320*(y+k))];
end;
procedure PutBox(x,y:word;B:Box;IsSaved:boolean);
var
j,k:word;
tmp:byte;
begin
for k:=0 to 15 do
for j:=0 to 15 do
begin
tmp:=B[j+16*k];
if (tmp<>0) or IsSaved then
mem[$A000:x+j+(320*(y+k))]:=tmp;
end;
end;
Begin
ResetMouse(Installed,Buttons);
{Check for good file name and installed mouse}
{$I-}
assign(F,FileName);
rewrite(F);
Good:=(IOResult=0) and (FileName<>'') and Installed;
if not Good then
close(F);
{$I+}
for j:=1 to 32 do
M[j]:=$FFFF;
x:=0;
y:=0;
count:=0;
if Installed then
begin
NewMouse(M);
MouseOn;
end;
GetBox(x,y,Save);
PutBox(x,y,Capture,false);
repeat
key:=GetKey;
case key of
$4800,$1177,$1157: {Up, w, W}
if y>0 then
begin
PutBox(x,y,Save,true);
dec(y);
GetBox(x,y,Save);
PutBox(x,y,Capture,false);
end;
$5000,$1F73,$1F53: {Down, s, S}
if y<199 then
begin
PutBox(x,y,Save,true);
inc(y);
GetBox(x,y,Save);
PutBox(x,y,Capture,false);
end;
$4B00,$1E61,$1E41: {Left, a, A}
if x>0 then
begin
PutBox(x,y,Save,true);
dec(x);
GetBox(x,y,Save);
PutBox(x,y,Capture,false);
end;
$4D00,$2064,$2044: {Right, d, D}
if x<319 then
begin
PutBox(x,y,Save,true);
inc(x);
GetBox(x,y,Save);
PutBox(x,y,Capture,false);
end;
$1C0D: {Enter}
begin
for j:=1 to 32 do
M[j]:=0;
for j:=0 to 15 do
begin
for k:=0 to 15 do
begin
case Save[k+j*16] of
0: {Leave as is, color 0}
;
1: {Translucent}
begin
M[j+1]:=M[j+1] OR (1 shl (15-k));
M[j+17]:=M[j+17] OR (1 shl (15-k));
end;
15: {Color 15}
begin
M[j+17]:=M[j+17] OR (1 shl (15-k));
end;
else {Transparent}
begin
M[j+1]:=M[j+1] OR (1 shl (15-k));
end;
end;
end;
end;
if Installed then
begin
ResetMouse(Installed,Buttons);
NewMouse(M);
MouseOn;
end;
if Good then
begin
inc(count);
writeln(F,'{ Capture #',count:1,'}');
writeln(F,'(');
for k:=1 to 8 do
begin
for j:=1 to 4 do
begin
write(F,D2H(M[j+4*(k-1)]));
if (j=4) and (k=8) then
{Do Nothing}
else
write(F,',');
end;
writeln(F);
end;
writeln(F,');');
writeln(F);
end;
end;
end;
until key=$011B; {Esc}
if Installed then
MouseOff;
if Good then
close(F);
End;
BEGIN
{Nothing Here}
END.
{--- Cut Here ---}
Here's the DEMO Program!
{--- Cut Here ---}
{Demo Program for MCAP}
USES
MCAP;
VAR
count:word;
Function SomeColor:byte;
Var
tmp:byte;
Begin
{ 0 - Color 0
1 - Translucent
15 - Color 15 }
tmp:=random(256);
if (tmp mod 4=0) then
tmp:=1
else if odd(tmp) then
tmp:=15
else
tmp:=0;
SomeColor:=tmp;
End;
BEGIN
randomize;
asm mov ax,13h;int 10h;end; {Set 320x200x256c mode (13h)}
count:=0;
repeat
mem[$A000:count]:=0;
inc(count);
until count=(16*320);
repeat
mem[$A000:count]:=15;
inc(count);
until count=(32*320);
repeat
mem[$A000:count]:=1;
inc(count);
until count=(48*320);
repeat
mem[$A000:count]:=5; {Transparent}
inc(count);
until count=(64*320);
repeat
mem[$A000:count]:=SomeColor;
inc(count);
until count=(200*320);
GetMouse('mouse.dat');
asm mov ax,3h;int 10h;end; {Set 80x25 text mode (3h)}
END.
[Back to MOUSE SWAG index] [Back to Main SWAG index] [Original]