{***************************************************************}
{***               FVision Unit Version1.0                   ***}
{***                    蓝蚂蚁工作室                         ***}
{***************************************************************}
{***                      鼠标单元                           ***}
{***************************************************************}
{$O+,F+,X+,I-,S-}
Unit FMouse;
Interface
Type
   Position=record
      BtnStatus,
      OpCount:Byte;
      XPos,YPos:Integer;
   end;
   GCursor=record
      ScreenMask,
      CursorMask:array[0..15] of Word;
      Hotx,Hoty:Integer;
   end;

const
   UseMouse:Boolean=True;
   MouseGood:Boolean=False;

const
  ARROW:GCursor=      { 缺省 }
    (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,$0300,$0000);
    HOTX:$0000;HOTY:$0000);
  CRRARR:GCursor=      { 十字形 }
    (ScreenMask  :($FFFF,$FFFF,$FEFF,$FC7F,
                   $FEFF,$FEFF,$FEFF,$DEF7,
                   $8003,$DEF7,$FEFF,$FEFF,
                   $FEFF,$FC7F,$FEFF,$FFFF);
    CursorMask:   ($0000,$0100,$0380,$0FE0,
                   $0380,$2388,$2388,$7FFC,
                   $FFFE,$7FFC,$2388,$2388,
                   $0380,$0FE0,$0380,$0100);
    HOTX:$0007;HOTY:$0008);
  CHECK:GCursor=      { 对号形 }
    (ScreenMask  :($FFF0,$FFE0,$FFC0,$FF81,
                   $FF03,$0607,$000F,$001F,
                   $803F,$C07E,$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=      { 有叉丝的圆形}
    (ScreenMask  :($FF01,$E00F,$C007,$8003,
                   $0441,$0C61,$0381,$0381,
                   $0381,$0C61,$0441,$8003,
                   $C007,$E00F,$F01F,$FFFF);
    CursorMask:   ($0000,$07C0,$0920,$1110,
                   $2108,$4104,$4004,$7C7C,
                   $4104,$4004,$2108,$1110,
                   $0920,$07C0,$0000,$0000);
    HOTX:$0007;HOTY:$0007);
  GLOVE:GCursor=      { 手指形}
    (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=      { ｉ字形}
    (ScreenMask  :($E10F,$E00F,$F83F,$FC7F,
                   $FC7F,$FC7F,$FC7F,$FC7F,
                   $FC7F,$FC7F,$FC7F,$FC7F,
                   $FC7F,$F83F,$E00F,$E10F);
    CursorMask:   ($0000,$0C60,$0280,$0100,
                   $1000,$0100,$0100,$0100,
                   $0100,$0100,$0100,$0100,
                   $0100,$0280,$0C60,$0000);
    HOTX:$0007;HOTY:$0007);

function TestMouse:Boolean;
function ResetMouse:Boolean;
procedure SetAccel(Threshold:Integer);
procedure ShowMouse;
procedure HideMouse;
procedure MoveMouse;
procedure GetPosition(var BtnStatus:Byte;var XPos,YPos:Integer);
procedure QueryBtndn(Button:Byte;var Mouse:Position);
procedure QueryBtnup(Button:Byte;var Mouse:Position);
procedure ReadMove(var XMove,YMove:Integer);
procedure SetRatio(HorPix,VerPix:Integer);
procedure SetLimits(XPosMin,YPosMin,XPosMax,YPosMax:Integer);
procedure SetPosition(XPos,YPos:Integer);
procedure InitializeMouse;
procedure SetCursor(Cur:GCursor);
Implementation
Uses
  Graph,Dos,FGraph;

var
  Regs:Registers;
  MouseX,MouseY:Integer;
  Visible:Boolean;
  GroundImg:array[0..299] of Byte;
  CurSor:GCurSor;

Procedure PutBackGround;
begin
  PutImage(MouseX-CurSor.HotX,MouseY-CurSor.HotY,GroundImg,COPYPUT);
end;

procedure GetBackGround;
var
  X:Integer;
begin
  X:=MouseX-CurSor.HotX+15;
  if X>GetMaxx then X:=GetMaxx;
  GetImage(MouseX-CurSor.HotX,MouseY-CurSor.HotY,X,MouseY-CurSor.HotY+15,GroundImg);
end;

procedure DrawCursorSvga;
var
  j,X2,Dlt:Integer;
begin
  Dlt:=0;
  X2:=MouseX-CurSor.HotX+15;
  if X2>GetMaxx then
  begin
    Dlt:=X2-GetMaxx;
    X2:=GetMaxx;
  end;
  SetWriteMode(0);
  SetColor(0);
  for j:=0 to 15 do
  begin
    SetLineStyle(USERBITLN,(not CurSor.ScreenMask[j]) shr Dlt,NORMWIDTH);
    Line(X2,MouseY-CurSor.HotY+j,MouseX-CurSor.HotX,MouseY-CurSor.HotY+j);
  end;
  SetColor(15);
  for j:=0 to 15 do
  begin
    SetLineStyle(USERBITLN,CurSor.CursorMask[j] shr Dlt,NORMWIDTH);
    Line(X2,MouseY-CurSor.HotY+j,MouseX-CurSor.HotX,MouseY-CurSor.HotY+j);
  end;
  SetLineStyle(0,0,1);
end;

procedure MoveMouse;
begin
  if not Visible then Exit;
  PutBackGround;
  Regs.AX:=$03;
  Intr($33,Regs);
  MouseX:=Regs.CX;
  MouseY:=Regs.DX;
  GetBackGround;
  DrawCursorSvga;
end;

function 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;

function ResetMouse:Boolean;  {重置鼠标为确省状态}
begin
  Regs.AX:=$00;
  Intr($33,Regs);
  ResetMouse:=Regs.AX<>0;
end;

procedure SetAccel(Threshold:Integer);  {设置速度极限}
begin
  Regs.AX:=$13;
  Regs.DX:=Threshold;
  Intr($33,Regs);
end;

procedure ShowMouse;
begin
  if MouseGood and (not Visible) then
  begin
    if Color256Flag then
    begin
      Regs.AX:=$03;
      Intr($33,Regs);
      MouseX:=Regs.CX;
      MouseY:=Regs.DX;
      GetBackGround;
      DrawCurSorSvga;
    end;
    Regs.AX:=$01;
    Visible:=True;
    Intr($33,Regs);
  end;
end;

procedure HideMouse;
begin
  if MouseGood and Visible then
  begin
    if Color256Flag then PutBackGround;
    Regs.AX:=$02;
    Visible:=False;
    Intr($33,Regs);
  end;
end;

procedure GetPosition(var BtnStatus:Byte;var XPos,YPos:Integer); {取得位置和按钮状态}
begin
  Regs.AX:=$03;
  Intr($33,Regs);
  BtnStatus:=Regs.BL;
  XPos     :=Regs.CX;
  YPos     :=Regs.DX;
end;

procedure SetPosition(XPos,YPos:Integer);      {设置位置}
begin
  Regs.AX:=$04;
  Regs.CX:=XPos;
  Regs.DX:=YPos;
  Intr($33,Regs);
end;

procedure SetRatio(HorPix,VerPix:Integer);     {移动8个像素所需步数}
begin
  Regs.AX:=$0F;
  Regs.CX:=HorPix;
  Regs.DX:=VerPix;
  Intr($33,Regs);
end;

procedure QueryBtndn(Button:Byte;var Mouse:Position); {按下次数和最后一次座标}
begin
  Regs.AX:=$05;
  Regs.BL:=Button;
  Intr($33,Regs);
  Mouse.BtnStatus:=Regs.AX;
  Mouse.OpCount  :=Regs.BX;
  Mouse.XPos     :=Regs.CX;
  Mouse.YPos     :=Regs.DX;
end;

procedure QueryBtnup(Button:Byte;var Mouse:Position);
begin
  Regs.AX:=$06;
  Regs.BL:=Button;
  Intr($33,Regs);
  Mouse.BtnStatus:=Regs.AX;
  Mouse.OpCount  :=Regs.BX;
  Mouse.XPos     :=Regs.CX;
  Mouse.YPos     :=Regs.DX;
end;

procedure SetLimits(XPosMin,YPosMin,XPosMax,YPosMax:Integer); {设置极限}
begin
  Regs.AX:=$07;
  Regs.CX:=XPosMin;
  Regs.DX:=XPosMax;
  Intr($33,Regs);
  Regs.AX:=$08;
  Regs.CX:=YPosMin;
  Regs.DX:=YPosMax;
  Intr($33,Regs);
end;

procedure ReadMove(var XMove,YMove:Integer); {移动步数}
begin
  Regs.AX:=$0B;
  Intr($33,Regs);
  XMove:=Regs.CX;
  YMove:=Regs.DX;
end;

procedure SetCursor(Cur:GCursor); {鼠标形状}
begin
  HideMouse;
  Regs.AX:=$09;
  Regs.BX:=Cur.HotX;
  Regs.CX:=Cur.HotY;
  Regs.DX:=Ofs(Cur.ScreenMask);
  Regs.ES:=Seg(Cur.ScreenMask);
  Intr($33,Regs);
  CurSor:=Cur;
  ShowMouse;
end;

procedure InitializeMouse;
begin
  if not UseMouse then Exit;
  MouseGood:=TestMouse;
  ResetMouse;
  Visible:=False;
  SetLimits(0,0,GetMaxx,GetMaxy);
  SetCursor(Arrow);
  SetPosition(GetMaxx div 2,GetMaxy div 2);
  ShowMouse;
end;

end.