高手请进

Question

下一个gifimage控件（其实是文件）

Answer 1

GifImage控件很好用!
如果是静态的,用下面的代码也可以!
TGIFGraphic = class(TBitmap)
public
  procedure LoadFromStream(Stream: TStream); override;
end;
const
  GIF_GLOBALCOLORTABLE = $80;
  GIF_COLORRESOLUTION = $70; 
  GIF_GLOBALCOLORTABLESORTED = $08; 
  GIF_COLORTABLESIZE = $07;
  GIF_LOCALCOLORTABLE = $80;
  GIF_INTERLACED = $40;
  GIF_LOCALCOLORTABLESORTED= $20;
  GIF_PLAINTEXT = $01;
  GIF_GRAPHICCONTROLEXTENSION = $F9;
  GIF_COMMENTEXTENSION = $FE;
  GIF_APPLICATIONEXTENSION = $FF;
  GIF_IMAGEDESCRIPTOR = Ord(',');
  GIF_EXTENSIONINTRODUCER = Ord('!');
  GIF_TRAILER = Ord(';');
type
  TGIFHeader = packed record
    Signature: array[0..2] of Char; 
    Version: array[0..2] of Char; 
  end;  TLogicalScreenDescriptor = packed record
    ScreenWidth: Word;
    ScreenHeight: Word;
    PackedFields,
    BackgroundColorIndex, 
    AspectRatio: Byte; 
  end;
  TImageDescriptor = packed record
    Left: Word;
    Top: Word;  
    Width: Word;
    Height: Word;
    PackedFields: Byte;
  end;
procedure TGIFGraphic.LoadFromStream(Stream: TStream);
var
  Header: TGIFHeader;
  ScreenDescriptor: TLogicalScreenDescriptor;
  ImageDescriptor: TImageDescriptor;
  LogPalette: TMaxLogPalette;
  I: Integer;
  BlockID: Byte;
  InitCodeSize: Byte;
  RawData,
  Run: PByte;
  TargetBuffer,
  TargetRun,
  Line: Pointer;
  Pass,
  Increment,
  Marker: Integer;
  Decoder: TDecoder;
begin
  Handle := 0;
  PixelFormat := pf8Bit;
  with Stream do
  begin
    ReadBuffer(Header, SizeOf(Header));
    if UpperCase(Header.Signature) <> 'GIF' then raise Exception.Create('Not a valid GIF file.');
    ReadBuffer(ScreenDescriptor, SizeOf(ScreenDescriptor));
    FillChar(LogPalette, SizeOf(LogPalette), 0);
    LogPalette.palVersion := $300;
    if (ScreenDescriptor.PackedFields and GIF_GLOBALCOLORTABLE) <> 0 then
    begin
      LogPalette.palNumEntries := 2 shl (ScreenDescriptor.PackedFields and GIF_COLORTABLESIZE);
      for I := 0 to LogPalette.palNumEntries - 1 do
      begin
        ReadBuffer(LogPalette.palPalEntry[I].peRed, 1);
        ReadBuffer(LogPalette.palPalEntry[I].peGreen, 1);
        ReadBuffer(LogPalette.palPalEntry[I].peBlue, 1);
      end;
      Palette := CreatePalette(PLogPalette(@LogPalette)^);
    end;
    repeat
      ReadBuffer(BlockID, 1);
      if BlockID = GIF_EXTENSIONINTRODUCER then
      begin
        repeat
          ReadBuffer(BlockID, 1);
        until BlockID = 0;
      end;
    until (BlockID = GIF_IMAGEDESCRIPTOR) or (BlockID = GIF_TRAILER);
    if BlockID = GIF_IMAGEDESCRIPTOR then
    begin
      ReadBuffer(ImageDescriptor, SizeOf(TImageDescriptor));
      Width := ImageDescriptor.Width;
      if Width = 0 then Width := ScreenDescriptor.ScreenWidth;
      Height := ImageDescriptor.Height;
      if Height = 0 then Height := ScreenDescriptor.ScreenHeight;
      if (ImageDescriptor.PackedFields and GIF_LOCALCOLORTABLE) <> 0 then
      begin
        LogPalette.palNumEntries := 2 shl (ImageDescriptor.PackedFields and GIF_COLORTABLESIZE);
        for I := 0 to LogPalette.palNumEntries - 1 do
        begin
          ReadBuffer(LogPalette.palPalEntry[I].peRed, 1);
          ReadBuffer(LogPalette.palPalEntry[I].peGreen, 1);
          ReadBuffer(LogPalette.palPalEntry[I].peBlue, 1);
        end;
        Palette := CreatePalette(PLogPalette(@LogPalette)^);
      end;
      ReadBuffer(InitCodeSize, 1);
      Marker := Position;
      Pass := 0;
      Increment := 0;
      repeat
        if Read(Increment, 1) = 0 then Break;
        Inc(Pass, Increment);
        Seek(Increment, soFromCurrent);
      until Increment = 0;
      GetMem(RawData, Pass);
      GetMem(TargetBuffer, Width * Height);
      Position := Marker;
      Increment := 0;
      Run := RawData;
      repeat
        if Read(Increment, 1) = 0 then Break;
        Read(Run^, Increment);
        Inc(Run, Increment);
      until Increment = 0;
      Decoder := TGIFLZW.Create;
      TGIFLZW(Decoder).InitialCodeSize := InitCodeSize;
      Run := RawData;
      Decoder.Decode(Pointer(Run), TargetBuffer, Pass, Width * Height);
      Decoder.Free;
      if (ImageDescriptor.PackedFields and GIF_INTERLACED) = 0 then
      begin
        TargetRun := TargetBuffer;
        for I := 0 to Height - 1 do
        begin
          Line := Scanline[I];
          Move(TargetRun^, Line^, Width);
          Inc(PByte(TargetRun), Width);
        end;
      end
      else
      begin
        TargetRun := TargetBuffer;
        for Pass := 0 to 3 do
        begin
          case Pass of
            0:
              begin
                I := 0;
                Increment := 8;
              end;
            1:
              begin
                I := 4;
                Increment := 8;
              end;
            2:
              begin
                I := 2;
                Increment := 4;
              end;
          else
            I := 1;
            Increment := 2;
          end;
          while I < Height do
          begin
            Line := Scanline[I];
            Move(TargetRun^, Line^, Width);
            Inc(PByte(TargetRun), Width);
            Inc(I, Increment);
          end;
        end;
      end;
      FreeMem(TargetBuffer);
      FreeMem(RawData);
    end;
  end;
end;
TPicture.RegisterFileFormat('gif', 'CompuServe images', TGIFGraphic);

Answer 2

這要用到第三方控件，如：（gifimage)

Answer 3

image.picture指向所用文件，应该可以吧：）