unit dvbMakeGif;
{$mode ObjFPC}{$H+}
interface
uses
Classes, SysUtils, BGRABitmap, BGRABitmapTypes, BGRAAnimatedGif;
type
TMakeGif = class
private
iWidth, iHeight, iLoopCount, iDelay: integer;
FileNames: TStringList;
public
constructor Create; overload;
procedure SaveGif(Filename: string);
procedure AddFile(Filename: string);
procedure FreeObj;
property LoopCount: integer read iLoopCount write iLoopCount;
property ImageWidth: integer read iWidth write iWidth;
property ImageHeight: integer read iHeight write iHeight;
property Delay: integer read iDelay write iDelay;
end;
implementation
constructor TMakeGif.Create;
begin
FileNames := TStringList.Create;
end;
procedure TMakeGif.AddFile(Filename: string);
begin
//Add bitmap file to string list
if FileExists(Filename) then
begin
//Only add files that are found
FileNames.Add(Filename);
end;
end;
procedure TMakeGif.SaveGif(Filename: string);
var
gif: TBGRAAnimatedGif;
bmp: TBGRABitmap;
X: integer;
begin
//Works with 256 color bitmaps
gif := TBGRAAnimatedGif.Create;
try
//Set loop count how mnay times it plays
gif.LoopCount := LoopCount;
//Set the gif image width and height
gif.SetSize(ImageWidth, ImageHeight);
gif.OptimizeFrames;
for X := 0 to Filenames.Count - 1 do
begin
//Get bitmap from filename
bmp := TBGRABitmap.Create(Filenames[X]);
try
//Add bitmap as gif frame and add delay in milliseconds
gif.AddFullFrame(bmp, Delay);
finally
//Free bmp obj
bmp.Free;
end;
end;
//Save the gif file.
gif.SaveToFile(Filename);
finally
//Free gif obj
gif.Free;
end;
end;
procedure TMakeGif.FreeObj;
begin
//Clear and destroy the string list
FreeAndNil(FileNames);
end;
end.
Recent
