unit FPWriteGIF;
// Author: Udo Schmal (www.gocher.me)

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FPImage, FPReadGIF, FPWriteBMP,
  opbitmap, bmp, gifdecoder, gif, gifwrite;

type
  TBMPImage = class(TCanvasOPBitmap)
  private
    fDecoder: TBmpDecoder;
    fEncoder: TBmpEncoder;
    fUseRLE: Boolean;
  public
    constructor Create; override;
    procedure LoadFromStream(Stream: TStream); override;
  published
    property UseRLE: Boolean read fUseRLE write fUseRLE;
  end;

  TGIFImage = class(TCanvasOPBitmap)
  private
    fDecoder: TGifDecoder;
    fEncoder: TGif;
    fInterlaced: Boolean;
  public
    procedure SaveToStream(Stream: TStream); override;
  published
    property Interlaced: Boolean read fInterlaced write fInterlaced;
  end;

  TOPPicture = class(TPersistent)
  private
    fCurrentFormat: TCanvasOPBitmap;
    fCurrentSaveFormat: TCanvasOPBitmap;
  public
    destructor Destroy; override;
    procedure LoadFromStream(Stream: TStream);
    procedure SaveToStream(Stream: TStream);
  end;

  TFPWriterGIF = class(TFPCustomImageWriter)
  protected
    procedure InternalWrite(Str: TStream; Img: TFPCustomImage); override;
  public
    constructor Create; override;
    destructor Destroy; override;

  end;

implementation

destructor TOPPicture.Destroy;
begin
  if fCurrentFormat <> nil then FreeAndNil(fCurrentFormat);
  if fCurrentSaveFormat <> nil then FreeAndNil(fCurrentSaveFormat);
  inherited Destroy;
end;

procedure TOPPicture.LoadFromStream(Stream: TStream);
begin
  fCurrentFormat := TBMPImage.create;
  try
    Stream.Position := 0;
    fCurrentFormat.LoadFromStream(Stream);
  finally
//    FreeAndNil(fCurrentFormat);
  end;
end;

procedure TOPPicture.SaveToStream(Stream: TStream);
begin
  fCurrentSaveFormat := TGIFImage.create;
  fCurrentSaveFormat.Assign(fCurrentFormat);
  try
    Stream.Position := 0;
    fCurrentSaveFormat.SaveToStream(Stream);
  finally
    FreeAndNil(fCurrentSaveFormat);
  end;
end;

constructor TBMPImage.Create;
begin
  inherited;
  fUseRLE := True;
end;

procedure TBMPImage.LoadFromStream(Stream: TStream);
begin
  Stream.Position := 0;
  Clear;
  fDecoder := TBmpDecoder.Create;
  fDecoder.readImage(Stream, Self);
  fDecoder.free;
end;

procedure TGIFImage.SaveToStream(Stream: TStream);
begin
  if Empty then raise EPasBitMapError.Create('OPBitmap empty');
  PixelFormat := pf8bit;
  Stream.Position := 0;
  fEncoder := TGif.Create;
  fEncoder.AddBitmap(self);
  if Transparent then
    fEncoder.TransparentColor := Transparentcolor;
  fEncoder.Interlaced := fInterlaced;
  fEncoder.SaveToStream(Stream);
  fEncoder.free;
end;

procedure TFPWriterGIF.InternalWrite(Str: TStream; Img: TFPCustomImage);
var
  opbmp: TOPPicture;
  MemoryStream: TMemoryStream;
  Writer: TFPWriterBMP;
begin
  MemoryStream := TMemoryStream.Create;
  Writer := TFPWriterBMP.Create;
  Writer.BitsPerPixel := 32;
  opbmp := TOPPicture.create;

  Writer.ImageWrite(MemoryStream, TheImage);
  opbmp.LoadFromStream(MemoryStream);
  opbmp.SaveToStream(Str);

  opbmp.free;
  FreeAndNil(Writer);
  MemoryStream.Free;
end;

constructor TFPWriterGIF.create;
begin
  inherited;
end;

destructor TFPWriterGIF.destroy;
begin
  inherited;
end;

end.