swag/mouse/0039.pas at master · dominicusin/swag

This repository was archived by the owner on Oct 11, 2022. It is now read-only.
373 lines (332 loc) · 8.47 KB
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 ---}
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) 
-------+---------------
  Box=array [0..255] of byte; {16x16 box to capture 16x16 area}
  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);
  tmp1,tmp2:word;
    mov ax,0
    int 33h
    mov tmp1,ax
    mov tmp2,bx
  if tmp1=$FFFF then
    Installed:=true
    Installed:=false;
  Buttons:=tmp2;
Procedure MouseOn;Assembler;  
Procedure MouseOff;Assembler;
Procedure GetMouse(FileName:string);
  Mouse=array [1..32] of word;
  Installed,Good:boolean;
  Buttons:word;
  Save:Box;
  x,y:word;
  key:word;
  j,k:word;
  count:word;
  {Other Procedures I was too lazy to make Interfaces for...}
  Procedure NewMouse(M:mouse);
    s,o:word;
    s:=Seg(M);
    o:=Ofs(M);
      mov ax,9
      mov bx,0
      mov cx,0
      mov es,s
      mov dx,o
      int 33h
  function GetKey:word;assembler;
    mov ax,10h
    int 16h
  Function D2H(w:word):string;
    Hex:array [$0..$F] of char=
    '0123456789ABCDEF';
    tmp:string;
    tmp:=Hex[Hi(w) shr 4]+Hex[Hi(w) and $F]+
         Hex[Lo(w) shr 4]+Hex[Lo(w) and $F];
    D2H:=HexString+tmp;
  procedure GetBox(x,y:word;var B:Box);
    j,k:word;
    tmp:byte;
    for k:=0 to 15 do
      for j:=0 to 15 do
        B[j+(k*16)]:=mem[$A000:x+j+(320*(y+k))];
  procedure PutBox(x,y:word;B:Box;IsSaved:boolean);
    j,k:word;
    tmp:byte;
    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;
  ResetMouse(Installed,Buttons);
  {Check for good file name and installed mouse}
  assign(F,FileName);
  rewrite(F);
  Good:=(IOResult=0) and (FileName<>'') and Installed;
  if not Good then
    close(F);
  for j:=1 to 32 do
    M[j]:=$FFFF;
  count:=0;
  if Installed then
      NewMouse(M);
      MouseOn;
  GetBox(x,y,Save);
  PutBox(x,y,Capture,false);
    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}
                        M[j+1]:=M[j+1] OR (1 shl (15-k));
                        M[j+17]:=M[j+17] OR (1 shl (15-k));
                    15: {Color 15}
                        M[j+17]:=M[j+17] OR (1 shl (15-k));
                    else {Transparent}
                        M[j+1]:=M[j+1] OR (1 shl (15-k));
            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
                      write(F,D2H(M[j+4*(k-1)]));
                      if (j=4) and (k=8) then
                        {Do Nothing}
                        write(F,',');
                  writeln(F);
              writeln(F,');');
              writeln(F);
            end;
        end;
  until key=$011B; {Esc}
  if Installed then
    MouseOff;
  if Good then
    close(F);
  {Nothing Here}
{--- Cut Here ---}
Here's the DEMO Program!
{--- Cut Here ---}
{Demo Program for MCAP}
  count:word;
Function SomeColor:byte;
  tmp:byte;
  { 0 - Color 0
    1 - Translucent
   15 - Color 15 }
  tmp:=random(256);
  if (tmp mod 4=0) then
  else if odd(tmp) then
    tmp:=15
    tmp:=0;
  SomeColor:=tmp;
  randomize;
  asm mov ax,13h;int 10h;end; {Set 320x200x256c mode (13h)}
  count:=0;
    mem[$A000:count]:=0;
    inc(count);
  until count=(16*320);
    mem[$A000:count]:=15;
    inc(count);
  until count=(32*320);
    mem[$A000:count]:=1;
    inc(count);
  until count=(48*320);
    mem[$A000:count]:=5; {Transparent}
    inc(count);
  until count=(64*320);
    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)}
FilesExpand file tree

0039.pas

Latest commit

History

0039.pas

File metadata and controls
