fmgifimg.pas

Delphi direct support for GIF files

unit FmGifImg;
{ Exports main form for test program for TGifImage

 2 Aug 97: - added possibility to load bmp files and save gif files
   Aug 97: - added some functionality for easy choosing of test bmp files
             and gif files and timing the bmp to gif conversion
12 Feb 98: - added reading of file list and walking through it
             with first..last buttons
13 Feb 98: - finally got all (most?) images to load and display ok
}

interface

uses
  WinProcs, WinTypes, Messages, SysUtils, Classes, Graphics,
  Controls, Forms, Dialogs, StdCtrls, ExtCtrls, Menus, Spin,
  GifDecl,         { Imports CheckType }
  GifImgs;         { Imports TGifImage }

type
  TForm1 = class(TForm)
    OpenDialog: TOpenDialog;
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    Open1: TMenuItem;
    Animation1: TMenuItem;
    On1: TMenuItem;
    Off1: TMenuItem;
    Slower1: TMenuItem;
    Once1: TMenuItem;
    SaveDialog: TSaveDialog;
    Saveas1: TMenuItem;
    Faster1: TMenuItem;
    Read1: TMenuItem;
    Next1: TMenuItem;
    Panel1: TPanel;
    PathEdit: TEdit;
    FirstButton: TButton;
    PrevButton: TButton;
    LastButton: TButton;
    NextButton: TButton;
    ReadFileListButton: TButton;
    FilesComboBox: TComboBox;
    procedure Open1Click(Sender: TObject);
    procedure On1Click(Sender: TObject);
    procedure Off1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Slower1Click(Sender: TObject);
    procedure Once1Click(Sender: TObject);
    procedure Saveas1Click(Sender: TObject);
    procedure Faster1Click(Sender: TObject);
    procedure Read1Click(Sender: TObject);
    procedure Next1Click(Sender: TObject);
    procedure ReadFileListButtonClick(Sender: TObject);
    procedure FirstButtonClick(Sender: TObject);
    procedure NextButtonClick(Sender: TObject);
    procedure PrevButtonClick(Sender: TObject);
    procedure LastButtonClick(Sender: TObject);
    procedure FilesComboBoxChange(Sender: TObject);
  private
    { Private declarations }
{$ifndef Installed}
    GifImage1: TGifImage;
{$endif Installed}
    procedure LoadGif;
    procedure SaveTimed(fname: String; var seconds: Double);
  public
    { Public declarations }
  end; { TForm1 }

var
  Form1: TForm1;

implementation

{$R *.DFM}

const
  fname1 = 'd:\Project\Delphi\Gif\Images\lambjump.gif';
  {fname1 = 'd:\Project\Delphi\Gif\Images\babekiss.gif';}
  {fname1 = 'd:\Project\Delphi\Gif\Images\95week51.gif';}
  {fname1 = 'd:\Project\Delphi\Gif\Images\1377.gif';}
  {fname2 = 'd:\Project\Delphi\Gif\Images\2.bmp';
  {fname1 = 'd:\Project\Delphi\Gif\Images\bmp_bw.bmp';
  fname2 = 'd:\Project\Delphi\Gif\Images\bmp_256.bmp';
  fname3 = 'd:\Project\Delphi\Gif\Images\bmp_trc.bmp';}
  {SaveFilename = 'd:\temp\test.gif';}

procedure TForm1.LoadGif;
begin { TForm1.LoadGif }
  GifImage1.Animating := False;
  GifImage1.LoadFromGifFile(PathEdit.Text + FilesComboBox.Items[FilesComboBox.ItemIndex]);
  GifImage1.Animating := True;
end;  { TForm1.LoadGif }

procedure TForm1.SaveTimed(fname: String; var seconds: Double);
var
  StartTime, EndTime: TDateTime;
begin { TForm1.SaveTimed }
  StartTime := Time;
  GifImage1.SaveToFile(fname);
  EndTime := Time;
  seconds := (EndTime-StartTime)*86400;
end;  { TForm1.SaveTimed }

(***** event handlers *****)

procedure TForm1.FormCreate(Sender: TObject);
{var TestImagesPath: String;}
begin { TForm1.FormCreate }
{$ifndef Installed}
  GifImage1 := TGifImage.Create(Self);
  GifImage1.Parent := Self;
  GifImage1.Left := 0;
  GifImage1.Top := Panel1.Height+1;
  GifImage1.AutoSize := True;
{$endif Installed}
  OpenDialog.FilterIndex := 1;
end;  { TForm1.FormCreate }

procedure TForm1.Read1Click(Sender: TObject);
begin { TForm1.Read1Click }
  GifImage1.LoadFromGifFile(fname1);
end;  { TForm1.Read1Click }

procedure TForm1.Open1Click(Sender: TObject);
begin { TForm1.Open1Click }
  if OpenDialog.Execute
  then begin
    case CheckType(OpenDialog.Filename) of
      GIF: begin
        GifImage1.LoadFromGifFile(OpenDialog.Filename);
        OpenDialog.Filename := '*.gif';
        On1.Checked := False;
        Off1.Checked := True;
      end;
      BMP: begin
        GifImage1.LoadFromBmpFile(OpenDialog.Filename);
        OpenDialog.Filename := '*.bmp'
      end;
      else ShowMessage(OpenDialog.Filename + ' not recognized as a '+
                       'valid gif or bmp file' )
    end; { case }
  end;
end;  { TForm1.Open1Click }

procedure TForm1.Saveas1Click(Sender: TObject);
var
  sec: Double;
  csec: Integer;
begin { TForm1.Saveas1Click }
  if SaveDialog.Execute
  then begin
    SaveTimed(SaveDialog.Filename, Sec);
    csec := Round(sec*100);
    ShowMessage('Saving took '+ IntToStr(csec)+ ' centiseconds')
  end;
end;  { TForm1.Saveas1Click }

procedure TForm1.On1Click(Sender: TObject);
begin { TForm1.On1Click }
  GifImage1.Animating := True;
  On1.Checked := True;
  Off1.Checked := False;
end;  { TForm1.On1Click }

procedure TForm1.Off1Click(Sender: TObject);
begin { TForm1.Off1Click }
  GifImage1.Animating := False;
  On1.Checked := False;
  Off1.Checked := True;
end;  { TForm1.Off1Click }

procedure TForm1.Slower1Click(Sender: TObject);
begin { TForm1.Slower1Click }
  GifImage1.Slower;
end;  { TForm1.Slower1Click }

procedure TForm1.Faster1Click(Sender: TObject);
begin { TForm1.Faster1Click }
  GifImage1.Faster;
end;  { TForm1.Faster1Click }

procedure TForm1.Once1Click(Sender: TObject);
begin { TForm1.Once1Click }
  GifImage1.AnimateOnce;
end;  { TForm1.Once1Click }

procedure TForm1.Next1Click(Sender: TObject);
begin { TForm1.Next1Click }
  GifImage1.NextImage;
end;  { TForm1.Next1Click }

procedure TForm1.ReadFileListButtonClick(Sender: TObject);
var
  p: String;
  Result: Integer;
  F: TSearchRec;
begin { TForm1.ReadFileListButtonClick }
  p := PathEdit.Text;
  Result := FindFirst(p+'*.gif', faAnyFile, F);
  while Result = 0
  do begin
    if F.Attr <> faDirectory
    then FilesComboBox.Items.Add(F.Name);
    Result := FindNext(F);
  end;
  FindClose(F);
  FilesComboBox.ItemIndex := 0;
end;  { TForm1.ReadFileListButtonClick }

procedure TForm1.FirstButtonClick(Sender: TObject);
begin { TForm1.FirstButtonClick }
  FilesComboBox.ItemIndex := 0;
  LoadGif;
end;  { TForm1.FirstButtonClick }

procedure TForm1.PrevButtonClick(Sender: TObject);
begin { TForm1.PrevButtonClick }
  FilesComboBox.ItemIndex := FilesComboBox.ItemIndex - 1;
  LoadGif;
end;  { TForm1.PrevButtonClick }

procedure TForm1.NextButtonClick(Sender: TObject);
begin { TForm1.NextButtonClick }
  FilesComboBox.ItemIndex := FilesComboBox.ItemIndex + 1;
  LoadGif;
end;  { TForm1.NextButtonClick }

procedure TForm1.LastButtonClick(Sender: TObject);
begin { TForm1.LastButtonClick }
  FilesComboBox.ItemIndex := FilesComboBox.Items.Count-1;
  LoadGif;
end;  { TForm1.LastButtonClick }

procedure TForm1.FilesComboBoxChange(Sender: TObject);
begin { TForm1.FilesComboBoxChange }
  LoadGif;
end;  { TForm1.FilesComboBoxChange }

end.