Bitmaps als Gif mit animation speichern

[tomkupitz]

Hallo Harry,

ich habe das so gelöst (schon etwas her):

Code:

function ConvertBitmapTo8Bit(bmp: TBitmap): TBitmap;
var jpg: TJpegImage;

begin
  if bmp<>nil then
  begin
    jpg:=TJpegImage.Create;
    jpg.CompressionQuality:=100; 
    jpg.Assign(bmp); 

    jpg.JPEGNeeded; 
    jpg.PixelFormat:=jf8bit; 
    jpg.DibNeeded; 

    result:=TBitmap.Create;
    result.PixelFormat:=pf8bit;
    result.Assign(jpg); 

    jpg.Free;
  end
  else
    result:=nil;
end;

//

procedure ExportGIF(FileName: string);
var Bitmap24Bit, Bitmap8Bit: TBitmap;

    i: Integer;

  function AddBitmap(GIF: TGIFImage; Source: TBitmap; Transparent: Boolean; Delay: Integer): TGIFFrame;
  var
    GCE: TGIFGraphicControlExtension;
    LoopExt: TGIFAppExtNSLoop;

  begin
    result:=GIF.Add(Source);

    if (GIF.Images.Count=1) then
    begin
      LoopExt:=TGIFAppExtNSLoop.Create(Result);
      LoopExt.Loops:=0; 
    end;

    GCE:=TGIFGraphicControlExtension.Create(result);
    GCE.Delay:=Round(Delay/10);

    if Transparent then
    begin
      GCE.Transparent:=True;
      GCE.TransparentColorIndex:=result.Pixels[0, result.Image.Height-1]
    end;
  end;

var
  GIF: TGIFImage;
  OptimizeOptions: TGIFOptimizeOptions;

begin
  GIF:=TGIFImage.Create;

  for i:=0 to BitmapCount-1 do
  begin
    Bitmap24Bit:=HoleBitmap(i);
    
    if Bitmap24Bit<>nil then
    begin    
      Bitmap8Bit:=ConvertBitmapTo8Bit(Bitmap24Bit);

      if Bitmap8Bit<>nil then
      begin
        AddBitmap(GIF, Bitmap8Bit, False, Round(1000/FramesPerSecond));
        Bitmap8Bit.Free;
      end;
      
      Bitmap24Bit.Free;
    end;
  end;

  GIF.OptimizeColorMap;

  OptimizeOptions := [];
  include(OptimizeOptions, ooMerge);
  include(OptimizeOptions, ooCrop);

  GIF.Optimize(OptimizeOptions, rmNone, dmNearest, 0);

  GIF.SaveToFile(FileName);
  GIF.Free;
end;

Beste Grüße