{***************************************************************}
{***               FVision Unit Version1.0                   ***}
{***                    蓝蚂蚁工作室                         ***}
{***************************************************************}
{***                      图标单元                           ***}
{***************************************************************}
Unit FIcon;
Interface
Uses
  Dos,Graph,FView;

Type
  ArrType=array[0..10000] of Byte;

  IconHeader=record
    IcoReserved1:Word;
    IcoResourceType:Word;
    IcoResourceCount:Word;
    IcoWidth:Byte;
    IcoHeight:Byte;
    IcoColorCount:Byte;
    IcoReserved2:Byte;
    IcoReserved3:Byte;
    IcoReserved4:Byte;
    IcoDIBSize:Longint;
    IcoDIBOffset:Longint;
  end;

  PIcon=^TIcon;
  TIcon=object(TView)
    Fp:File;
    Head:IconHeader;
    Result:Word;
    AndImg,XorImg:Pointer;
    BakSize:Word;
    constructor Init(Name:PathStr;x,y,Ind:Integer);
    destructor Done;virtual;
    procedure Paint;virtual;
    procedure LoadIcon;
  end;

Implementation
constructor TIcon.Init;
begin
  Inherited Init;
  Origin.x:=x;
  Origin.y:=y;
  AndImg:=nil;
  XorImg:=nil;
  Assign(Fp,Name);
  {$i-}Reset(Fp,1);{$i+}
  IsValid:=IOResult=0;
  if not IsValid then Exit;
  BlockRead(Fp,Head,SizeOf(Head),Result);
  IsValid:=IsValid and (Head.IcoResourceType=$0001)
           and (Head.IcoColorCount=$10)
           and (Head.IcoResourceCount>=Ind);
  {$i-}Seek(Fp,Head.IcoDIBOffset+(Ind-1)*Head.IcoWidth*Head.IcoHeight div 2);{$i+}
  if IoResult<>0 then IsValid:=False;
  if IsValid then LoadIcon;
  {$i-}Close(Fp);{$i+}
end;

destructor TIcon.Done;
begin
  FreeMem(AndImg,BakSize);
  FreeMem(XorImg,BakSize);
  Inherited Done;
end;

procedure TIcon.LoadIcon;
begin
  BakSize:=ImageSize(0,0,Head.IcoWidth-1,Head.IcoHeight-1);
  GetMem(AndImg,BakSize);
  GetMem(XorImg,BakSize);
  ArrType(AndImg^)[0]:=Head.IcoWidth;
  ArrType(AndImg^)[1]:=0;
  ArrType(AndImg^)[2]:=Head.IcoHeight;
  ArrType(AndImg^)[3]:=0;
  ArrType(XorImg^)[0]:=Head.IcoWidth;
  ArrType(XorImg^)[1]:=0;
  ArrType(XorImg^)[2]:=Head.IcoHeight;
  ArrType(XorImg^)[3]:=0;
  BlockRead(Fp,ArrType(XorImg^)[4],Head.IcoWidth*Head.IcoHeight div 2,Result);
end;

procedure TIcon.Paint;
begin
  PutImage(Origin.x,Origin.y,XorImg^,COPYPUT);
end;

end.