{***************************************************************}
{***               FVision Unit Version1.0                   ***}
{***                    蓝蚂蚁工作室                         ***}
{***************************************************************}
{***                 PIC图形文件支持单元                     ***}
{***************************************************************}
{$O+,F+,X+,I-,S-}
Unit FPic;
Interface
Uses
  Dos,Graph,FGraph,FView;

Const
  PicMaxImageBuf  = 32767;
  PicMaxBlock     = 15;
  stPicPic        = 0;
  stPicIcon       = 1;
  stPicImageGrp   = 2;

Type

  PPic=^TPic;
  TPic=object(TView)
   Fp:file;
   Result:Word;
   FileName:PathStr;
   Style:Byte;
   Index,Total,Width,Height:Integer;
   ImgPos:Longint;
   BSize,Yn:array[0..PicMaxBlock-1] of Word;
   ImgBuf:Pointer;
   IcName:array[0..31] of Char;
   constructor Init(AFileName:string;Intx,Inty:Integer;St:Byte;Ind:Integer);
   destructor Done;virtual;
   procedure MoveTo(x,y:Integer);virtual;
   procedure OpenFile;
   procedure Draw;virtual;
   procedure Paint;virtual;
   procedure Creat(x,y:Integer);
  end;

Implementation

constructor TPic.Init;
begin
  Inherited Init;
  FileName:=AFileName;
  Origin.x:=Intx;
  Origin.y:=Inty;
  Style:=St;
  Total:=0;
  if Style=stPicIcon then OpenFile;
end;

destructor TPic.Done;
begin
  case Style of
  stPicPic:{$i-}Close(Fp);{$i+}
  stPicIcon:if ImgBuf<>nil then FreeMem(ImgBuf,518);
  end;
  Inherited Done;
end;

procedure TPic.MoveTo;
begin
  Origin.x:=x;
  Origin.y:=y;
end;

procedure TPic.OpenFile;
var
  i:Integer;
  ID:Word;
begin
  IsValid:=False;
  Assign(Fp,FileName);
  {$i-}Reset(Fp,1);{$i+}
  if IOResult<>0 then Exit;
  case Style of
  stPicPic:begin
             BlockRead(Fp,Total,SizeOf(Total),Result);
             Height:=0;
             for i:=0 to Total-1 do
             begin
               BlockRead(Fp,BSize[i],SizeOf(BSize[0]),Result);
               BlockRead(Fp,Yn[i],SizeOf(Yn[0]),Result);
               Inc(Height,Yn[i]);
             end;
             Width:=(BSize[0]*2) div Yn[0];
             ImgPos:=FilePos(Fp);
           end;
  stPicIcon:begin
             BlockRead(Fp,IcName,SizeOf(IcName),Result);
             BlockRead(Fp,ID,SizeOf(ID),Result);
             if ID<>$0142 then Exit;
             GetMem(ImgBuf,518);
             BlockRead(Fp,ImgBuf^,518,Result);
             {$i-}Close(Fp);{$i+}
            end;
  end;
  IsValid:=True;
end;

procedure TPic.Draw;
var
  i,y:Integer;
begin
  if not IsValid then Exit;
  case Style of
  stPicPic:begin
             Seek(Fp,ImgPos);
             y:=Origin.y;
             for i:=0 to Total-1 do
             begin
               GetMem(ImgBuf,BSize[i]);
               BlockRead(Fp,ImgBuf^,BSize[i],Result);
               PutImage(Origin.x,y,ImgBuf^,COPYPUT);
               FreeMem(ImgBuf,BSize[i]);
               Inc(y,Yn[i]);
             end;
           end;
  stPicIcon:PutImage(Origin.x,Origin.y,ImgBuf^,COPYPUT);
  end;
end;

procedure TPic.Paint;
begin
  Draw;
end;

procedure TPic.Creat;
begin

end;

end.