{***************************************************************}
{***               FVision Unit Version1.0                   ***}
{***                    蓝蚂蚁工作室                         ***}
{***************************************************************}
{***                  通用图象文件单元                       ***}
{***************************************************************}
{$F+,O+,X+,I-}
Unit FPicture;
Interface
Uses
  Dos,FDac,FView,FTool,FXmsDrv,FPhoto,FEvent,
  FControl,FMenu,FDialog;

Const
  cmSetTime      = 1450;
  cmInsertBmp    = 1451;
  cmInsertPcx    = 1452;
  cmInsertSerial = 1453;

Type
  PPicture=^TPicture;
  TPicture=object(TPhoto)
   Fp:File;
   Constructor Init(X,Y:Integer;St:Word;Ds:Byte);
   Procedure SetFileType(T:Byte);
   Procedure LoadFromFile(Name:PathStr);virtual;
   Function  SaveToFile(Name:PathStr):Boolean;virtual;
   Procedure LoadPcxFile(Name:PathStr);
   Procedure ReadPcxLine(Len:Integer);
   Function  SavePcxFile(Name:PathStr):Boolean;
   Procedure WritePcxLine(Len:Integer);
   Procedure LoadBmpFile(Name:PathStr);
   Procedure ReadBmpLine;
   Function  SaveBmpFile(Name:PathStr):Boolean;
   Procedure WriteBmpLine;
   Procedure LoadIcoFile(Name:PathStr);
   Procedure LoadGifFile(Name:PathStr);
   Function  SaveGifFile(Name:PathStr):Boolean;
   Procedure LoadFlcFile(Name:PathStr);
   Procedure ReadFlcDacChunk(ChType:Word;Len:Word);
  end;

  MovieType=record
   XmsHandle:Word;
   Width,Height:Integer;
  end;
  TMovieType=array[1..1] of MovieType;

  PMovie=^TMovie;
  TMovie=object(TPicture)
   MovieArr:^TMovieType;
   Number,MaxNumber,Frame:Integer;
   Constructor Init(R:TRect;MN:Integer);
   Destructor Done;virtual;
   Procedure Insert(Name:PathStr);
   Procedure SetFrame(Frm:Integer);
  end;

  PMovieWin=^TMovieWin;
  TMovieWin=object(TWindow)
   Movie:PMovie;
   Status:PStatusLine;
   Timer:PTimer;
   DltTime:Longint;
   Constructor Init;
   Procedure InitMenu;virtual;
   Procedure InsertFile(Ext:string);
   Procedure InsertSerial(Ext:string);
   Procedure SetTimer;
   Procedure HandleEvent(var Event:TEvent);virtual;
   Procedure RunPopupMenu(var Event:TEvent;T:TPoint);
  end;

Implementation
Const
  WinDac:array[0..47] of Char=
     #0#0#0#32#0#0#0#32#0#32#32#0#0#0#32#32#0#32#0#32#32#31#31#31+
     #47#47#47#63#0#0#0#63#0#63#63#0#0#0#63#63#0#63#0#63#63#63#63#63;

Const
  GifGlobalPaletteMask     = $80;
  GifGlobalColorResMask    = $70;
  GifGlobalColorSortMask   = $08;
  GifGlobalColorMask       = $07;
  GifLocalPaletteMask      = $80;
  GifLocalInterlaceMask    = $40;
  GifLocalColorSortMask    = $20;
  GifLocalColorMask        = $07;

Type
  PcxHeader=record
   PcxID:Byte;
   Version:Byte;
   RleEncoding:Byte;
   BitsPerPixel:Byte;
   x1,y1:Integer;
   x2,y2:Integer;
   HRes:Integer;
   VRes:Integer;
   Palette:array[0..47] of Byte;
   Reserved:Byte;
   ColorPlanes:Byte;
   BytesPerLine:Integer;
   PaletteType:Integer;
   UnUsed:array[0..57] of Byte;
  end;

  BmpHeader=record
   BmpID:Word;
   FileSize:Longint;
   Reserved:Longint;
   ImageOffset:Longint;
   HeaderSize:Longint;
   Width:Longint;
   Height:Longint;
   Planes:Word;
   BitsPerPixel:Word;
   EncodeType:Longint;
   ImageSize:Longint;
   XPixelPerMeter:Longint;
   YPixelPerMeter:Longint;
   ColorUsed:Longint;
   ColorImportant:Longint;
  end;

  BmpRgb=record
   Blue:Byte;
   Green:Byte;
   Red:Byte;
   Reserved:Byte;
  end;

  IcoHeader=record
   Reserved1:Word;
   ResourceType:Word;
   ResourceCount:Word;
   Width:Byte;
   Height:Byte;
   ColorCount:Word;
   Reserved2:Word;
   Reserved3:Word;
   DIBSize:Longint;
   DIBOffset:Longint;
  end;

  GifHeader=record
   GifID:array[0..5] of Char;
   Width:Integer;
   Height:Integer;
   GlobalFlag:Byte;
   BackGroundColor:Byte;
   PixelAspectRatio:Byte;
  end;

  GifImgDesc=record
   XStart,YStart:Integer;
   Width:Integer;
   Height:Integer;
   LocalFlag:Byte;
  end;

  FlcHeader=record
   Reserved1:array[0..7] of Byte;
   Width:Integer;
   Height:Integer;
   Reserved2:array[0..115] of Byte;
  end;

  FlcFrameHeader=record
   FrameSize:Longint;
   FrameIdentifier:Word;
   ChunkNumber:Word;
   Reserved:array[0..7] of Byte;
  end;

  FlcChunkHeader=record
   ChunkSize:Longint;
   ChunkType:Word;
  end;

Constructor TPicture.Init;
begin
  Inherited Init;
  MoveTo(X,Y);
  Style:=St;
  DacStyle:=Ds;
end;

Procedure TPicture.SetFileType;
begin
  PictureType:=T;
end;

Procedure TPicture.LoadFromFile;
var
  Dir: DirStr;
  N: NameStr;
  E: ExtStr;
begin
  FillChar(PixelNum,1024,0);
  Progress^.Loc:=0;
  if (Style and phProgress)<>0 then Progress^.Paint;
  FreePictureMem;
  Dac.GetDac(PhotoDac);
  FileName:=Name;
  FSplit(Name, Dir, N, E);
  UpcaseStr(E);
  if E='.PCX' then
    LoadPcxFile(Name)
  else if E='.BMP' then
    LoadBmpFile(Name)
  else if E='.GIF' then
    LoadGifFile(Name)
  else if E='.ICO' then
    LoadIcoFile(Name)
  else
  case PictureType of
  ptPcx:LoadPcxFile(Name);
  ptBmp:LoadBmpFile(Name);
  ptGif:LoadGifFile(Name);
  end;
  if (XmsHandle<>0) and ((Style and phAdaptSize)<>0) then
  begin
    AssignRect(ViewRec,0,0,Width-1,Height-1);
    SaveRec:=ViewRec;
  end else
    AssignRect(ViewRec,0,0,ViewRec.b.x-ViewRec.a.x,ViewRec.b.y-ViewRec.a.y);
  if (Style and phProgress)<>0 then Progress^.Hide;
end;

Function  TPicture.SaveToFile;
begin
  SaveToFile:=False;
  if Name='' then Exit;
  case PictureType of
  ptPcx:SaveToFile:=SavePcxFile(Name);
  ptBmp:SaveToFile:=SaveBmpFile(Name);
  ptGif:SaveToFile:=SaveGifFile(Name);
  end;
  FileName:=Name;
  ModifyFlag:=False;
end;

Procedure TPicture.LoadPcxFile;
var
  Result,TempAttr:Word;
  PcxHead:PcxHeader;
  TempDac:DacType;
  DacMark:Byte;
  i,j,k:Integer;
  TempData:array[0..MaxPicLine-1] of Byte;
begin
  if not IsValid then Exit;
  PictureType:=ptPcx;
  Assign(Fp,Name);
  GetFAttr(Fp,TempAttr);
  SetFAttr(Fp,Archive);
  Reset(Fp,1);
  if IOResult<>0 then Exit;
  BlockRead(Fp,PcxHead,SizeOf(PcxHeader),Result);
  if (PcxHead.PcxID<>10) or (PcxHead.RleEncoding<>1) then Exit;
  if not ((PcxHead.Version in [0,2..5]) and
          (PcxHead.BitsPerPixel in [1,2,4,8]) and
          (PcxHead.ColorPlanes in [1,4])) then Exit;
  Width:=PcxHead.x2-PcxHead.x1+1;
  Height:=PcxHead.y2-PcxHead.y1+1;
  BitsPerPixel:=PcxHead.BitsPerPixel*PcxHead.ColorPlanes;
  case BitsPerPixel of
  1,2,4:
    for i:=0 to (1 shl BitsPerPixel-1) do
    begin
      PhotoDac[32*3+i*3+1]:=PcxHead.Palette[i*3] shr 2;
      PhotoDac[32*3+i*3+2]:=PcxHead.Palette[i*3+1] shr 2;
      PhotoDac[32*3+i*3+3]:=PcxHead.Palette[i*3+2] shr 2;
    end;
  8:begin
      Seek(Fp,FileSize(Fp)-769);
      BlockRead(Fp,DacMark,1,Result);
      if DacMark=$0C then
      begin
        BlockRead(Fp,TempDac,Sizeof(DacType),Result);
        for i:=1 to 256*3 do
        TempDac[i]:=TempDac[i] shr 2;
      end;
    end;
  end;
  ConvertDac(TempDac);
  if ((Style and phNoMalloc)=0)or(XmsHandle=0) then
    MallocPictureMem(Width,Height);
  Seek(Fp,SizeOf(PcxHeader));
  if XmsHandle<>0 then
  for i:=0 to Height-1 do
  begin
    ReadPcxLine(PcxHead.BytesPerLine*PcxHead.ColorPlanes);
    FillChar(TempData,MaxPicLine,0);
    for j:=0 to PcxHead.ColorPlanes-1 do
    for k:=0 to Width-1 do
    case BitsPerPixel of
    1:TempData[k]:=DacIndex[(Line[k div 8] shr (7-(k mod 8))) and $01];
    4:TempData[k]:=DacIndex[TempData[k] or (((Line[j*PcxHead.BytesPerLine+(k div 8)]
                             shr (7-(k mod 8))) and $01) shl j)];
    8:TempData[k]:=DacIndex[Line[k]];
    end;
    MoveXms(Pointer(Longint(i)*Longint(Width)),XmsHandle,@TempData,0,Width+(Width mod 2));
    ViewProgress(i/Height);
  end;
  Close(Fp);
  SetFAttr(Fp,TempAttr);
end;

Procedure TPicture.ReadPcxLine;
var
  TempData:array[0..MaxPicLine-1] of Byte;
  ByteCount,RunCount,Dtl:Integer;
  TempPos:LongInt;
  Result:Word;
begin
  Dtl:=0;
  ByteCount:=0;
  TempPos:=FilePos(Fp);
  BlockRead(Fp,TempData,MaxPicLine,Result);
  while ByteCount<Len do
  begin
    if TempData[Dtl]>=$C0 then
    begin
      RunCount:=TempData[Dtl] and $3F;
      Inc(Dtl);
      FillChar(Line[ByteCount],RunCount,TempData[Dtl]);
      Inc(ByteCount,RunCount);
    end else
    begin
      Line[ByteCount]:=TempData[Dtl];
      Inc(ByteCount);
    end;
    Inc(Dtl);
  end;
  Seek(Fp,TempPos+Dtl);
end;

Function TPicture.SavePcxFile;
var
  Result:Word;
  PcxHead:PcxHeader;
  DacMark:Byte;
  i,j,k,TempLen:Integer;
  TempData:array[0..MaxPicLine-1] of Byte;
begin
  SavePcxFile:=False;
  if XmsHandle=0 then Exit;
  Assign(Fp,Name);
  ReWrite(Fp,1);
  if IOResult<>0 then Exit;
  PcxHead.PcxID:=$0A;
  PcxHead.Version:=5;
  PcxHead.RleEncoding:=1;
  PcxHead.x1:=SaveRec.a.x;
  PcxHead.y1:=SaveRec.a.y;
  PcxHead.x2:=SaveRec.b.x;
  PcxHead.y2:=SaveRec.b.y;
  PcxHead.HRes:=640;
  PcxHead.VRes:=480;
  PcxHead.Reserved:=0;
  PcxHead.PaletteType:=2;
  FillChar(PcxHead.UnUsed,58,0);
  case BitsPerPixel of
  1,2,4:PcxHead.ColorPlanes:=BitsPerPixel;
  8:PcxHead.ColorPlanes:=1;
  end;
  PcxHead.BitsPerPixel:=BitsPerPixel div PcxHead.ColorPlanes;
  PcxHead.BytesPerLine:=(PcxHead.BitsPerPixel*(SaveRec.b.x-SaveRec.a.x+1)-1) div 8+1;
  if BitsPerPixel<8 then
  for i:=0 to 15 do
  begin
    PcxHead.Palette[i*3]:=PhotoDac[32*3+i*3+1] shl 2;
    PcxHead.Palette[i*3+1]:=PhotoDac[32*3+i*3+2] shl 2;
    PcxHead.Palette[i*3+2]:=PhotoDac[32*3+i*3+3] shl 2;
  end;
  BlockWrite(Fp,PcxHead,SizeOf(PcxHeader),Result);
  TempLen:=SaveRec.b.x-SaveRec.a.x+1;
  if Odd(TempLen) then Inc(TempLen);
  for i:=SaveRec.a.y to SaveRec.b.y do
  begin
    MoveXms(@TempData,0,Pointer(Longint(i)*Longint(Width)+SaveRec.a.x),XmsHandle,TempLen);
    FillChar(Line,MaxPicLine,0);
    if BitsPerPixel<8 then
      for k:=0 to Width-1 do Dec(TempData[k],32);
    for j:=0 to PcxHead.ColorPlanes-1 do
    for k:=0 to Width-1 do
    case BitsPerPixel of
    1:Line[k div 8]:=Line[k div 8] or (TempData[k] shl (7-(k mod 8)));
    4:Line[j*PcxHead.BytesPerLine+k div 8]:=Line[j*PcxHead.BytesPerLine+k div 8]
           or (((TempData[k] shr j) and $01) shl (7-(k mod 8)));
    8:Line[k]:=TempData[k];
    end;
    WritePcxLine(PcxHead.BytesPerLine*PcxHead.ColorPlanes);
  end;
  if BitsPerPixel=8 then
  begin
    DacMark:=$0C;
    BlockWrite(Fp,DacMark,1,Result);
    for i:=0 to 767 do
    Line[i]:=PhotoDac[i+1] shl 2;
    BlockWrite(Fp,Line,Sizeof(DacType),Result);
  end;
  Close(Fp);
  SavePcxFile:=True;
end;

Procedure TPicture.WritePcxLine;
var
  TempData:array[0..MaxPicLine-1] of Byte;
  Data:Byte;
  ByteCount,RunCount,Dtl:Integer;
  Result:Word;
begin
  ByteCount:=0;
  Dtl:=0;
  while ByteCount<Len do
  begin
    Data:=Line[ByteCount];
    RunCount:=1;
    Inc(ByteCount);
    while (ByteCount<Len) and
          (Line[ByteCount]=Data) and (RunCount<$3F) do
    begin
      Inc(RunCount);
      Inc(ByteCount);
    end;
    if (RunCount>1)or(Data>=$C0) then
    begin
      TempData[Dtl]:=$C0 or RunCount;
      TempData[Dtl+1]:=Data;
      Inc(Dtl);
    end else
      TempData[Dtl]:=Data;
    Inc(Dtl);
  end;
  BlockWrite(Fp,TempData,Dtl,Result);
end;

Procedure TPicture.LoadBmpFile;
var
  Result,TempAttr:Word;
  BmpHead:BmpHeader;
  TempDac:DacType;
  BmpDac:array[0..255] of BmpRgb;
  i,TrueWid,ColorNum:Integer;
  DataPos:Longint;
begin
  if not IsValid then Exit;
  PictureType:=ptBmp;
  Assign(Fp,Name);
  GetFAttr(Fp,TempAttr);
  SetFAttr(Fp,Archive);
  Reset(Fp,1);
  if IOResult<>0 then Exit;
  BlockRead(Fp,BmpHead,SizeOf(BmpHeader),Result);
  if (BmpHead.BmpID<>$4D42) or (BmpHead.EncodeType<>0) or
     (not (BmpHead.BitsPerPixel in [1,4,8])) then Exit;
  Width:=BmpHead.Width;
  Height:=BmpHead.Height;
  BitsPerPixel:=BmpHead.BitsPerPixel;
  TrueWid:=(Width*BitsPerPixel) div 8;
  if (Width*BitsPerPixel) mod 32<>0 then
    TrueWid:=TrueWid+4-TrueWid mod 4;
  if BmpHead.ColorUsed=0 then
  begin
    if BitsPerPixel>8 then
      ColorNum:=0
    else
      ColorNum:=1 shl BitsPerPixel;
  end else
    ColorNum:=BmpHead.ColorUsed;
  if ColorNum>256 then ColorNum:=0;
  BlockRead(Fp,BmpDac,ColorNum*SizeOf(BmpRgb),Result);
  if ColorNum<256 then
  for i:=0 to ColorNum-1 do
  begin
    PhotoDac[32*3+i*3+1]:=BmpDac[i].Red shr 2;
    PhotoDac[32*3+i*3+2]:=BmpDac[i].Green shr 2;
    PhotoDac[32*3+i*3+3]:=BmpDac[i].Blue shr 2;
  end else
  for i:=0 to 255 do
  begin
    TempDac[i*3+1]:=BmpDac[i].Red shr 2;
    TempDac[i*3+2]:=BmpDac[i].Green shr 2;
    TempDac[i*3+3]:=BmpDac[i].Blue shr 2;
  end;
  ConvertDac(TempDac);
  if ((Style and phNoMalloc)=0)or(XmsHandle=0) then
    MallocPictureMem(Width,Height);
  DataPos:=Sizeof(BmpHeader)+ColorNum*SizeOf(BmpRgb);
  for i:=0 to Height-1 do
  begin
    Seek(Fp,DataPos+Longint(Height-i-1)*Longint(TrueWid));
    BlockRead(Fp,Line,TrueWid,Result);
    ReadBmpLine;
    MoveXms(Pointer(Longint(i)*Longint(Width)),XmsHandle,@Line,0,Width+Width mod 2);
    ViewProgress(i/Height);
  end;
  Close(Fp);
  SetFAttr(Fp,TempAttr);
end;

Procedure TPicture.ReadBmpLine;
var
  TempData:array[0..MaxPicLine-1] of Byte;
  i:Integer;
begin
  System.Move(Line,TempData,MaxPicLine);
  for i:=0 to Width-1 do
  begin
    case BitsPerPixel of
    1:Line[i]:=DacIndex[(TempData[i div 8] shr (7-(i mod 8))) and $01];
    4:Line[i]:=DacIndex[(TempData[i div 2] shr (4*((i+1) mod 2))) and $0F];
    8:Line[i]:=DacIndex[TempData[i]];
    end;
  end;
end;

Function TPicture.SaveBmpFile;
var
  Result:Word;
  BmpHead:BmpHeader;
  BmpDac:array[0..255] of BmpRgb;
  i,TrueWid,ColorNum,TempWid,TempHig:Integer;
begin
  SaveBmpFile:=False;
  if XmsHandle=0 then Exit;
  Assign(Fp,Name);
  ReWrite(Fp,1);
  if IOResult<>0 then Exit;
  ColorNum:=1 shl BitsPerPixel;
  TempWid:=SaveRec.b.x-SaveRec.a.x+1;
  TempHig:=SaveRec.b.y-SaveRec.a.y+1;
  TrueWid:=TempWid*BitsPerPixel div 8;
  if (TempWid*BitsPerPixel) mod 32<>0 then
    TrueWid:=TrueWid+4-TrueWid mod 4;
  BmpHead.BmpID:=$4D42;
  BmpHead.FileSize:=54+ColorNum*4+Longint(TrueWid)*Longint(TempHig);
  BmpHead.Reserved:=0;
  BmpHead.ImageOffset:=54+ColorNum*4;
  BmpHead.HeaderSize:=40;
  BmpHead.Width:=TempWid;
  BmpHead.Height:=TempHig;
  BmpHead.Planes:=1;
  BmpHead.BitsPerPixel:=BitsPerPixel;
  BmpHead.EncodeType:=0;
  BmpHead.ImageSize:=Longint(TrueWid)*Longint(TempHig);
  BmpHead.XPixelPerMeter:=640;
  BmpHead.YPixelPerMeter:=480;
  BmpHead.ColorUsed:=0;
  BmpHead.ColorImportant:=0;
  BlockWrite(Fp,BmpHead,SizeOf(BmpHeader),Result);
  if ColorNum<256 then
  for i:=0 to ColorNum-1 do
  begin
    BmpDac[i].Red:=PhotoDac[32*3+i*3+1] shl 2;
    BmpDac[i].Green:=PhotoDac[32*3+i*3+2] shl 2;
    BmpDac[i].Blue:=PhotoDac[32*3+i*3+3] shl 2;
    BmpDac[i].Reserved:=0;
  end else
  for i:=0 to 255 do
  begin
    BmpDac[i].Red:=PhotoDac[i*3+1] shl 2;
    BmpDac[i].Green:=PhotoDac[i*3+2] shl 2;
    BmpDac[i].Blue:=PhotoDac[i*3+3] shl 2;
    BmpDac[i].Reserved:=0;
  end;
  BlockWrite(Fp,BmpDac,ColorNum*SizeOf(BmpRgb),Result);
  for i:=SaveRec.b.y downto SaveRec.a.y do
  begin
    MoveXms(@Line,0,Pointer(Longint(i)*Longint(Width)+SaveRec.a.x),
                            XmsHandle,TempWid+(TempWid mod 2));
    WriteBmpLine;
    BlockWrite(Fp,Line,TrueWid,Result);
  end;
  Close(Fp);
  SaveBmpFile:=True;
end;

Procedure TPicture.WriteBmpLine;
var
  TempData:array[0..MaxPicLine-1] of Byte;
  i:Integer;
begin
  System.Move(Line,TempData,MaxPicLine);
  FillChar(Line,MaxPicLine,0);
  for i:=0 to SaveRec.b.x-SaveRec.a.x do
  begin
    case BitsPerPixel of
    1:Line[i div 8]:=Line[i div 8] or ((TempData[i]-32) shl (7-(i mod 8)));
    4:Line[i div 2]:=Line[i div 2] or ((TempData[i]-32) shl (4*((i+1) mod 2)));
    8:Line[i]:=TempData[i];
    end;
  end;
end;

Procedure TPicture.LoadIcoFile;
var
  Result,TempAttr:Word;
  IcoHead:IcoHeader;
  i,j,TrueWid,IcoSize:Integer;
begin
  if not IsValid then Exit;
  PictureType:=ptIco;
  Assign(Fp,Name);
  GetFAttr(Fp,TempAttr);
  SetFAttr(Fp,Archive);
  Reset(Fp,1);
  if IOResult<>0 then Exit;
  BlockRead(Fp,IcoHead,SizeOf(IcoHeader),Result);
  Width:=IcoHead.Width*3;
  Height:=IcoHead.Height;
  BitsPerPixel:=4;
  if IcoHead.ColorCount<16 then Exit;
  TrueWid:=(IcoHead.Width*BitsPerPixel) div 8;
  IcoSize:=(IcoHead.Width*BitsPerPixel*Height) div 8;
  System.Move(WinDac,PhotoDac[32*3+1],48);
  ConvertDac(PhotoDac);
  if ((Style and phNoMalloc)=0)or(XmsHandle=0) then
    MallocPictureMem(Width,Height);
  for i:=0 to Height-1 do
  begin
    Seek(Fp,126+Longint(Height-i-1)*Longint(TrueWid));
    BlockRead(Fp,Line[300],TrueWid,Result);
    Seek(Fp,126+IcoSize+Longint(Height-i-1)*Longint(TrueWid) div 4);
    BlockRead(Fp,Line[400],TrueWid div 4,Result);
    for j:=0 to IcoHead.Width-1 do
    begin
      if not Odd(j) then
        Line[j+IcoHead.Width]:=DacIndex[Line[300+j div 2] shr 4]
      else
        Line[j+IcoHead.Width]:=DacIndex[Line[300+j div 2] and $0F];
      Line[j+2*IcoHead.Width]:=0;
      if ((Line[400+j div 8] shr (7-(j mod 8))) and $01)<>0 then
        Line[j+2*IcoHead.Width]:=$FF;
      Line[j]:=Line[j+2*IcoHead.Width] and 7;
      Line[j]:=Line[j] xor Line[j+IcoHead.Width];
    end;
    MoveXms(Pointer(Longint(i)*Longint(Width)),XmsHandle,@Line,0,Width+Width mod 2);
    ViewProgress(i/Height);
  end;
  Close(Fp);
  SetFAttr(Fp,TempAttr);
end;

Procedure TPicture.LoadGifFile;
var
  Result,TempAttr:Word;
  GifHead:GifHeader;
  GifImg:GifImgDesc;
  GifDac:DacType;
  BlockSign:Char;
  CurrentX,CurrentY:Integer;
  ReadFlag,EndFlag:Boolean;
  BlockSize:Byte;
  ImageBlock:array[0..260] of Byte;
  i:Integer;

  Function GifReadCode:Byte;
  begin
    if ReadFlag and not EndFlag then
    begin
      BlockRead(Fp,BlockSize,1,Result);
      if BlockSize=0 then
      begin
        ReadFlag:=False;
        EndFlag:=True;
      end else
      begin
        BlockRead(Fp,ImageBlock[3],BlockSize,Result);
        ReadFlag:=False;
      end;
    end;
{    ByteOffset:=BitOffset shr 3;}


  end;

  Procedure GifWritePixel(Color:Byte);
  var
    TempWid:Longint;
  begin
    if CurrentY>=GifImg.Height then Exit;
    Line[CurrentX]:=Color;
    Inc(CurrentX);
    if CurrentX>=GifImg.Width then
    begin
      CurrentX:=0;
      TempWid:=GifImg.Width;
      if Odd(TempWid) then
      begin
        Inc(TempWid);
        MoveXms(@Line,0,Pointer(Longint(CurrentY)*Longint(Width)+GifImg.XStart),XmsHandle,TempWid);
      end;
      MoveXms(Pointer(Longint(CurrentY)*Longint(Width)+GifImg.XStart),XmsHandle,@Line,0,TempWid);
      Inc(CurrentY);
    end;
  end;

  Procedure GifReadImage;
  var
    Colors:Integer;
    InitCodeSize,CodeSize,Code,MaxCode,ClearCode,EOFCode,
    CurCode,OldCode,InCode,FirstFree,FreeCode,
    FinChar,BitMask,ReadMask,OutCount:Byte;
  begin
    BlockRead(Fp,GifImg,Sizeof(GifImgDesc),Result);
    if (GifImg.LocalFlag and GifLocalPaletteMask)<>0 then
    begin
      Colors:=1 shl (GifImg.LocalFlag and GifLocalColorMask)+1;
      BlockRead(Fp,PhotoDac,3*Colors,Result)
    end else if (GifHead.GlobalFlag and GifGlobalPaletteMask)<>0 then
    begin
      Colors:=1 shl (GifHead.GlobalFlag and GifGlobalColorMask)+1;
      System.Move(GifDac,PhotoDac,3*Colors);
    end;
    CurrentX:=0;
    CurrentY:=0;
    ReadFlag:=True;
    EndFlag:=False;

    BitMask:=Colors-1;
    BlockRead(Fp,CodeSize,1,Result);
    ClearCode:=1 shl CodeSize;
    EOFCode:=ClearCode+1;
    FreeCode:=ClearCode+2;
    FirstFree:=FreeCode;
    Inc(CodeSize);
    InitCodeSize:=CodeSize;
    MaxCode:=1 shl CodeSize;
    ReadMask:=MaxCode-1;
    BlockRead(Fp,Line,MaxPicLine,Result);


  end;

  Procedure GifReadExtension;
  var
    ExtLabel,ExtSize:Byte;
  begin
    BlockRead(Fp,ExtLabel,1,Result);
    case ExtLabel of
    $FE:while ExtLabel<>0 do
        BlockRead(Fp,ExtLabel,1,Result);
    $F9,$01,$FF:
        begin
          BlockRead(Fp,ExtSize,1,Result);
          BlockRead(Fp,Line,ExtSize,Result);
          while ExtLabel<>0 do
          BlockRead(Fp,ExtLabel,1,Result);
        end;
    end;
  end;

begin
  if not IsValid then Exit;
  PictureType:=ptGif;
  Assign(Fp,Name);
  GetFAttr(Fp,TempAttr);
  SetFAttr(Fp,Archive);
  Reset(Fp,1);
  if IOResult<>0 then Exit;
  BlockRead(Fp,GifHead,SizeOf(GifHeader),Result);
  if Pos('GIF',GifHead.GifID)=0 then Exit;
  Width:=GifHead.Width;
  Height:=GifHead.Height;
  BitsPerPixel:=(GifHead.GlobalFlag and GifGlobalColorResMask) shr 4+1;
  if ((Style and phNoMalloc)=0)or(XmsHandle=0) then
    MallocPictureMem(Width,Height);
  if (GifHead.GlobalFlag and GifGlobalPaletteMask)<>0 then
    BlockRead(Fp,GifDac,3*(1 shl (GifHead.GlobalFlag and GifGlobalColorMask)+1),Result);
  BlockRead(Fp,BlockSign,1,Result);
  while BlockSign<>';' do
  begin
    case BlockSign of
    ',':GifReadImage;
    '!':GifReadExtension;
    else Exit;
    end;
    BlockRead(Fp,BlockSign,1,Result);
  end;
  Close(Fp);
  SetFAttr(Fp,TempAttr);
end;

Function TPicture.SaveGifFile;
var
  Result:Word;
  GifHead:GifHeader;
  i:Integer;
begin
  SaveGifFile:=False;
  if XmsHandle=0 then Exit;
  Assign(Fp,Name);
  ReWrite(Fp,1);
  if IOResult<>0 then Exit;
  Close(Fp);
  SaveGifFile:=True;
end;

Procedure TPicture.LoadFlcFile;
var
  Result,TempAttr:Word;
  FlcHead:FlcHeader;
  FrameHead:FlcFrameHeader;
  i:Integer;
begin
  if not IsValid then Exit;
  PictureType:=ptFlc;
  Assign(Fp,Name);
  GetFAttr(Fp,TempAttr);
  SetFAttr(Fp,Archive);
  Reset(Fp,1);
  if IOResult<>0 then Exit;
  BlockRead(Fp,FlcHead,SizeOf(FlcHeader),Result);
  Width:=FlcHead.Width;
  Height:=FlcHead.Height;
  BitsPerPixel:=8;
  if ((Style and phNoMalloc)=0)or(XmsHandle=0) then
    MallocPictureMem(Width,Height);
  while not Eof(Fp) do
  begin
    BlockRead(Fp,FrameHead,SizeOf(FlcFrameHeader),Result);
    if FrameHead.FrameIdentifier=$F100 then
    begin
      Seek(Fp,FilePos(Fp)+FrameHead.FrameSize-SizeOf(FlcFrameHeader));
      BlockRead(Fp,FrameHead,SizeOf(FlcFrameHeader),Result);
    end;

  end;
  Close(Fp);
  SetFAttr(Fp,TempAttr);
end;

Procedure TPicture.ReadFlcDacChunk;
var
  TempDac:DacType;
  i,j,Color,P,Nb,Nc:Integer;
  Jump,Dlt:Byte;
  Result:Word;
begin
  if ChType=4 then Dlt:=2 else Dlt:=0;
  System.Move(PhotoDac,TempDac,768);
  BlockRead(Fp,Line,Len,Result);
  Color:=0;
  Nb:=Integer(Line[0]);
  P:=2;
  for i:=0 to Nb-1 do
  begin
    Jump:=Line[P];
    Inc(P);
    Inc(Color,Jump);
    Nc:=Line[P];
    Inc(P);
    if Nc=0 then Nc:=256;
    for j:=0 to 3*Nc-1 do Line[P+j]:=Line[P+j] shr Dlt;
    System.Move(Line[P],TempDac[Color*3],Nc*3);
    Inc(P,Nc*3);
    Inc(Color,Nc);
  end;
  ConvertDac(TempDac);
end;


Constructor TMovie.Init;
begin
  Inherited Init(0,0,phProgress,phAdaptDac);
  SetViewRec(R);
  MaxNumber:=MN;
  GetMem(MovieArr,SizeOf(MovieType)*MaxNumber);
  Number:=0;
  Frame:=0;
end;

Destructor TMovie.Done;
var
  i:Integer;
begin
  for i:=1 to Number do
  if MovieArr^[i].XmsHandle<>0 then
    FreeXms(MovieArr^[i].XmsHandle);
  FreeMem(MovieArr,SizeOf(MovieType)*MaxNumber);
  XmsHandle:=0;
  Inherited Done;
end;

Procedure TMovie.Insert;
begin
  if Number>=MaxNumber then Exit;
  if Number>0 then
  begin
    DacStyle:=phOtherDac;
    XmsHandle:=0;
  end;
  LoadFromFile(Name);
  Inc(Number);
  MovieArr^[Number].XmsHandle:=XmsHandle;
  MovieArr^[Number].Width:=Width;
  MovieArr^[Number].Height:=Height;
end;

Procedure TMovie.SetFrame;
begin
  if Frm>Number-1 then Exit;
  Frame:=Frm;
  XmsHandle:=MovieArr^[Frame+1].XmsHandle;
  Width:=MovieArr^[Frame+1].Width;
  Height:=MovieArr^[Frame+1].Height;
end;


Constructor TMovieWin.Init;
var
  R:TRect;
begin
  AssignRect(R,0,0,400,280);
  Inherited Init(R,'动画编辑器',True);
  Option:=Option or opResize;
  AssignRect(R,10,50,14+300,54+200);
  Insert(New(PShape,Init(gcBroad+gcHideMouse,R,0,0,$07,0,'')));
  AssignRect(R,0,0,300,200);
  Movie:=New(PMovie,Init(R,100));
  Movie^.MoveTo(12,52);
  Insert(Movie);
  AssignRect(R,5,256,380,278);
  Status:=New(PStatusLine,Init(R,0,#0));
  Insert(Status);
  Timer:=New(PTimer,Init(10));
  Timer^.StopTimer;
  Insert(Timer);
  DltTime:=10;
  Center;
end;

Procedure TMovieWin.InitMenu;
var
  T:TRect;
begin
  Inherited InitMenu;
  AssignRect(T,5,27,Broad.b.x-5,44);
  Insert(New(PMainMenu,Init(T,False,
   NewSubMenu('文件~F~',kbAltF,New(PMenu,Init(
     NewMenuItem('播放',kbNoKey,cmPlay,nil,
     NewMenuItem('停止',kbNoKey,cmStop,nil,
     NewMenuItem('插入     ~Ins~',kbIns,cmInsert,nil,
     NewMenuItem('',0,0,nil,
     NewMenuItem('关闭  ~Alt+F3~',kbAltF3,cmCloseWin,nil,nil))))))),
   NewSubMenu('帮助~H~',kbAltH,New(PMenu,Init(
     NewMenuItem('设置延迟时间',kbNoKey,cmSetTime,nil,
     NewMenuItem('关于',kbNoKey,cmAbout,nil,nil)))),nil)))));
end;

Procedure TMovieWin.InsertFile;
var
  Name:PathStr;
begin
  if not OpenFile(Name,'打开文件',Ext) then Exit;
  ChangePath(Name);
  Movie^.Insert(Name);
  Movie^.SetFrame(Movie^.Number-1);
  Movie^.Paint;
  Status^.Modify('Frame:'+IntStr(Movie^.Number)+#0+FName(Name)+#0);
end;

Procedure TMovieWin.InsertSerial;
var
  Name,TempStr:PathStr;
  i,Dot,Temp:Integer;
begin
  if not OpenFile(Name,'打开文件',Ext) then Exit;
  ChangePath(Name);
  Movie^.Insert(Name);
  Movie^.SetFrame(Movie^.Number-1);
  Movie^.Paint;
  Status^.Modify('Frame:'+IntStr(Movie^.Number)+#0+FName(Name)+#0);
  Dot:=Pos('.',Name);
  for i:=0 to 30 do
  begin
    Temp:=StrsInt(Copy(Name,Dot-3,3))+1;
    TempStr:=Copy(Name,1,Dot-4)+Int_Str(Temp,3)+Copy(Name,Dot,4);
    Name:=TempStr;
    if Exist_Fi(Name) then
    begin
      Movie^.Insert(Name);
      Movie^.SetFrame(Movie^.Number-1);
      Movie^.Paint;
      Status^.Modify('Frame:'+IntStr(Movie^.Number)+#0+FName(Name)+#0);
    end;
  end;
end;

Procedure TMovieWin.SetTimer;
var
  R:TRect;
  P:PWindow;
begin
  AssignRect(R, 0, 0, 260, 100);
  P:=New(PWindow,Init(R,'设置延迟时间',True));
  P^.Insert(New(PStaticText,Init(stNormal,20,45,'Time:',4)));
  P^.Insert(New(PDigInput,Init(65,45,@DltTime,12,ipBroad+ipDigital,dtLongint)));
  P^.Insert(New(PButton,Init(180, 40,240, 60,'确定',kbAltO,cmOk)));
  P^.Insert(New(PButton,Init(180, 70,240, 90,'放弃',kbAltC,cmCancel)));
  P^.Next;
  P^.Next;
  P^.Center;
  RunView(P,Event);
  if Event.Command=cmOk then Timer^.SetTime(DltTime);
end;

Procedure TMovieWin.HandleEvent;
Label Start;
begin
 Start:
  Inherited HandleEvent(Event);
  case Event.What of
  evMouseDown:if IsIn(Event.Where,Broad) and
                 (Event.Buttons=mbRightButton) then
              begin
                RunPopupMenu(Event,Event.Where);
                goto Start;
              end;
  evCommand:case Event.Command of
            cmSetTime:SetTimer;
            cmInsert:InsertFile('*.*');
            cmInsertBmp:InsertFile('*.BMP');
            cmInsertPcx:InsertFile('*.PCX');
            cmInsertSerial:InsertSerial('*.*');
            cmPlay:Timer^.Reset;
            cmStop:Timer^.StopTimer;
            cmTimer:if (Event.InfoPtr=Timer)and(Movie^.Number>0) then
                    begin
                      Movie^.SetFrame((Movie^.Frame+1) mod Movie^.Number);
                      Movie^.Paint;
                      Status^.Modify('Frame:'+IntStr(Movie^.Frame+1)+#0);
                      Timer^.Reset;
                    end else Exit;
            else Exit;
            end;
  else Exit;
  end;
  ClearEvent(Event);
end;

Procedure TMovieWin.RunPopupMenu;
var
  PopMenu:PMenu;
begin
  PopMenu:=New(PMenu,Init(
    NewMenuItem('插入BMP',0,cmInsertBmp,nil,
    NewMenuItem('插入PCX',0,cmInsertPcx,nil,
    NewMenuItem('插入序列',0,cmInsertSerial,nil,
    NewMenuItem('删除    ~Del~',kbDel,cmDelete,nil,nil))))));
  PopMenu^.Owner:=@Self;
  PopMenu^.MoveTo(T.X,T.Y);
  PopMenu^.Run(Event);
  Dispose(PopMenu);
end;


end.