{**********************************************}
{   TeeChart GIF Export format                 }
{   Copyright (c) 2000-2020 by Steema Software }
{**********************************************}
unit TeeGIF;
{$I TeeDefs.inc}

interface

Uses {$IFNDEF LINUX}
     Windows,
     {$ENDIF}
     Classes,
     Graphics, Forms, Controls, StdCtrls, ExtCtrls,
     {$IFDEF D9}
     Types,
     {$ENDIF}

     {$IFDEF D105}
     GIFImg,    // <-- New (2007) GIFImage unit, included in Delphi2007 and up.
     {$ELSE}
     GIFImage,  // <-- "old" GIFImage unit
     {$ENDIF}

     TeeProcs, TeeExport, TeCanvas, TeEngine, TeeAnimate, ComCtrls;

type
  TTeeGIFOptions = class(TForm)
    RGCompression: TRadioGroup;
    Label1: TLabel;
    CBDither: TComboFlat;
    Label2: TLabel;
    CBReduction: TComboFlat;
    CBAnim: TComboFlat;
    Label3: TLabel;
    CBOptimize: TCheckBox;
    CBLoop: TCheckBox;
    ProgressBar1: TProgressBar;
    procedure FormShow(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    IFormat : TTeeExportFormat;
  public
    { Public declarations }
  end;

  TGIFExportFormat=class(TTeeExportFormat)
  private
    FAnim : TTeeCustomAnimation;
    FAnimate : TTeeAnimate;
    FOptimize : Boolean;

    IGIF     : TGIFImage;
    IOnFrame : TNotifyEvent;
    IOnStop  : TNotifyEvent;

    procedure AnimateFrame(Sender:TObject);
    procedure AnimateStop(Sender:TObject);

    Procedure CheckProperties;
  protected
    FProperties : TTeeGIFOptions;
    Procedure DoCopyToClipboard; override;
  public
    procedure CreateAnimatedGIF(const AGIF:TGIFImage);

    function Description:String; override;
    function FileExtension:String; override;
    class function FileFilter:String; override;
    function GraphicClass:TGraphicClass; override;
    Function GIF:TGIFImage;
    Function Options(Check:Boolean=True):TForm; override;
    Procedure SaveToStream(Stream:TStream); override;

    property Animate:TTeeAnimate read FAnimate write FAnimate;
    property Animation:TTeeCustomAnimation read FAnim write FAnim;
    property OptimizeColors:Boolean read FOptimize write FOptimize;
  end;

implementation

{$IFNDEF LCL}
{$ELSE}
{$R *.lfm}
{$ENDIF}
{$R *.DFM}

Uses
  Clipbrd, SysUtils,
  TeeConst, TeeAnimations;

const
  GIFImageDefaultDitherMode:TDitherMode=TDitherMode(0);

function TGIFExportFormat.Description:String;
begin
  result:=TeeMsg_AsGIF;
end;

class function TGIFExportFormat.FileFilter:String;
begin
  result:=TeeMsg_GIFFilter;
end;

function TGIFExportFormat.FileExtension:String;
begin
  result:='gif'; // Do not localize
end;

procedure TGIFExportFormat.AnimateFrame(Sender:TObject);

  procedure UpdateProgress;
  var tmpAnim : TTeeAnimate;
  begin
    tmpAnim:=FAnimate;

    if not Assigned(tmpAnim) then
       if Assigned(FAnim) then
          if FAnim is TTeeAnimationTool then
             tmpAnim:=TTeeAnimationTool(FAnim).Animate;

    if Assigned(tmpAnim) then
    begin
      FProperties.ProgressBar1.Position:=Round(100.0*tmpAnim.CurrentFrame/(tmpAnim.EndFrame+1));
      Application.ProcessMessages;
    end;
  end;

  // From Anders Melander demo:
  procedure CheckExtensions(const AFrame:{$IFDEF D105}TGIFFrame{$ELSE}TGIFSubImage{$ENDIF});
  var
    //GCE: TGIFGraphicControlExtension;
    LoopExt: TGIFAppExtNSLoop;
  begin
    // Netscape Loop extension must be the first extension in the first frame!
    if TTeeAnimate(Sender).Loop and (IGIF.Images.Count=1) then
    begin
      LoopExt:=TGIFAppExtNSLoop.Create(AFrame);
      LoopExt.Loops:=0; // Number of loops (0 = forever)
    end;

    (*
    // Add Graphic Control Extension
    GCE:=TGIFGraphicControlExtension.Create(AFrame);
    GCE.Delay:=0; // Animation delay (30 = 300 mS)

    if Transparent then
    begin
      GCE.Transparent := True;
      GCE.TransparentColorIndex := TransparentIndex(Result);
    end;
    *)
  end;

  procedure AddFrame;
  var tmp : TBitmap;
      tmpFrame : {$IFDEF D105}TGIFFrame{$ELSE}TGIFSubImage{$ENDIF};
  begin
    tmp:=GetBitmap;
    try
      {$IFDEF D105}
      tmpFrame:=IGIF.Add(tmp);
      {$ELSE}
      tmpFrame:=IGIF.Images[IGIF.Add(tmp)];
      {$ENDIF};

      tmpFrame.ColorMap.Optimized:=OptimizeColors;
      CheckExtensions(tmpFrame);
    finally
      tmp.Free;
    end;
  end;

begin
  AddFrame;

  if Assigned(FProperties) and (FProperties.Parent<>nil) then
     UpdateProgress;

  if Assigned(IOnFrame) then
     IOnFrame(Sender);
end;

procedure TGIFExportFormat.AnimateStop(Sender:TObject);
begin
  if Assigned(IOnStop) then
     IOnStop(Sender);
end;

type
  TAnimateAccess=class(TTeeAnimate);

procedure TGIFExportFormat.CreateAnimatedGIF(const AGIF:TGIFImage);
var tmp : TTeeAnimate;
    tmpShowing,
    Old : Boolean;
begin
  IGIF:=AGIF;

  IGIF.Clear;

  tmp:=Animate;

  if not Assigned(tmp) then
     if Animation is TTeeAnimationTool then
        tmp:=TTeeAnimationTool(Animation).Animate;

  if Assigned(tmp) then
  begin
    IOnFrame:=tmp.OnFrame;
    IOnStop:=tmp.OnStop;

    tmp.OnFrame:=AnimateFrame;
    tmp.OnStop:=AnimateStop;

    Old:=tmp.Loop;
    tmp.Loop:=False;
    TAnimateAccess(tmp).PlayByFrames:=True;

    try
      tmpShowing:=Assigned(FProperties) and (FProperties.Parent<>nil);

      if tmpShowing then
      begin
        FProperties.ProgressBar1.Position:=0;
        FProperties.ProgressBar1.Visible:=True;
        Application.ProcessMessages;
      end;

      try
        tmp.Play(True,Assigned(FAnimate) or tmpShowing);
      finally
        if tmp.Playing then
           tmp.Stop;

        if tmpShowing then
           FProperties.ProgressBar1.Visible:=False;
      end;

    finally
      TAnimateAccess(tmp).PlayByFrames:=False;

      tmp.OnFrame:=IOnFrame;
      tmp.OnStop:=IOnStop;
      tmp.Loop:=Old;
    end;
  end;
end;

Function TGIFExportFormat.GIF:TGIFImage;
var tmpBitmap : TBitmap;
    tmp       : TObject;
begin
  CheckProperties;
  CheckSize;

  result:=TGIFImage.Create;

  with result do
  begin
    {$IFNDEF D105}  // Not included in D2007

    // See: http://www.unisys.com/about__unisys/lzw
    Compression:=TGIFCompression(FProperties.RGCompression.ItemIndex);

    {$ENDIF}

    DitherMode:=TDitherMode(FProperties.CBDither.ItemIndex);
    ColorReduction:=TColorReduction(FProperties.CBReduction.ItemIndex);

    if (not Assigned(FAnim)) and (FProperties.CBAnim.ItemIndex>-1) then
    begin
      tmp:=FProperties.CBAnim.Items.Objects[FProperties.CBAnim.ItemIndex];

      if tmp is TTeeAnimate then
         FAnimate:=TTeeAnimate(tmp)
      else
         FAnim:=TTeeAnimationTool(tmp);
    end;

    if Assigned(FAnim) or Assigned(FAnimate) then
       CreateAnimatedGIF(result)
    else
    begin
      // Static single frame GIF
      tmpBitmap:=GetBitmap;
      try
        Assign(tmpBitmap);
      finally
        tmpBitmap.Free;
      end;
    end;

    if FProperties.CBOptimize.Checked then
       result.OptimizeColorMap;
  end;
end;

Procedure TGIFExportFormat.CheckProperties;
begin
  if not Assigned(FProperties) then
  begin
    FProperties:=TTeeGIFOptions.Create(nil);
    FProperties.IFormat:=Self;

    FProperties.FormShow(Self);
  end;
end;

Function TGIFExportFormat.Options(Check:Boolean=True):TForm;
begin
  if Check then CheckProperties;
  result:=FProperties;
end;

procedure TGIFExportFormat.DoCopyToClipboard;
var tmp : TGIFImage;
begin
  tmp:=GIF;
  try
    Clipboard.Assign(tmp);
  finally
    tmp.Free;
  end;
end;

procedure TGIFExportFormat.SaveToStream(Stream:TStream);
begin
  With GIF do
  try
    SaveToStream(Stream);
  finally
    Free;
  end;
end;

procedure TTeeGIFOptions.FormShow(Sender: TObject);

  procedure AddAnimations(const AOwner:TComponent);
  var t : Integer;
      tmp : TTeeAnimate;
  begin
    if AOwner <> nil then
      for t:=0 to AOwner.ComponentCount-1 do
          if AOwner.Components[t] is TTeeAnimate then
          begin
            tmp:=TTeeAnimate(AOwner.Components[t]);

            CBAnim.Items.AddObject(tmp.Name,tmp);
          end;
  end;

var tmpAnim : TChartAnimations;
    t       : Integer;
begin
  CBDither.ItemIndex:=Ord(GIFImageDefaultDitherMode);
  CBReduction.ItemIndex:=Ord(rmQuantizeWindows);

  {$IFNDEF D105}  // Not included in D2007

  // GIF LZW Unisys Patent expiration dates:
  // http://www.unisys.com/about__unisys/lzw
  RGCompression.ItemIndex:=Ord(GIFImageDefaultCompression);

  {$ENDIF}

  CBAnim.Clear;
  CBAnim.Enabled:=False;

  if Assigned(IFormat) then
  begin
    CBOptimize.Checked:=(IFormat as TGIFExportFormat).OptimizeColors;

    if Assigned(IFormat.Panel) then
    begin
      if IFormat.Panel is TCustomAxisPanel then
      begin
        tmpAnim:=TCustomAxisPanel(IFormat.Panel).Animations;

        for t:=0 to tmpAnim.Count-1 do
            CBAnim.Items.AddObject(tmpAnim[t].Title,tmpAnim[t]);
      end;

      AddAnimations(IFormat.Panel.Owner);
    end;

    CBAnim.ItemIndex:=CBAnim.Items.IndexOfObject((IFormat as TGIFExportFormat).Animation);
    CBAnim.Enabled:=True;
  end;
end;

procedure TTeeGIFOptions.FormCreate(Sender: TObject);
begin
  Align:=alClient;
end;

function TGIFExportFormat.GraphicClass: TGraphicClass;
begin
  result:=TGIFImage;
end;

initialization
  RegisterTeeExportFormat(TGIFExportFormat);
finalization
  UnRegisterTeeExportFormat(TGIFExportFormat);
end.
