procedure Tform14.MakeGIF (
name :
string);
var
GIF: TGIFImage;
Frame: TGIFFrame;
GCExt: TGIFGraphicControlExtension;
LoopExt: TGIFAppExtNSLoop;
pause : word;
added, FrameIndex: Integer;
begin
pause := form1.timer1.interval
div 10;
GIF := TGIFImage.Create;
added := 0;
FrameIndex := 0;
try
while frameindex < form1.listbox1.items.count
do
begin
// add frame to animated gif
if pos('
[X] ', form1.listbox1.items[frameindex]) = 1
then
begin
form1.loadimage(copy(form1.listbox1.items[frameindex], 5, 249), bmorg);
if added = 0
then
begin
Frame := GIF.Add(bmorg);
// Netscape Loop extension must be the first extension in the first frame!
LoopExt := TGIFAppExtNSLoop.Create(Frame);
LoopExt.Loops := 0;
// Number of loops (0 = forever)
// Add Graphic Control Extension
GCExt := TGIFGraphicControlExtension.Create(Frame);
GCExt.Delay := pause;
// Animation delay (30 = 300 mS)
end
else
begin
Frame := GIF.Add(bmorg);
GCExt := TGIFGraphicControlExtension.Create(Frame);
GCExt.Delay := pause;
end;
inc(added);
end;
inc(frameindex);
end;
if form14.rbSlideback.checked
then
// Animation rückwärts
begin
while added > 2
do
begin
dec(frameindex);
// add frame to animated gif
if pos('
[X] ', form1.listbox1.items[frameindex]) = 1
then
begin
form1.loadimage(copy(form1.listbox1.items[frameindex], 5, 249), bmorg);
Frame := GIF.Add(bmorg);
GCExt := TGIFGraphicControlExtension.Create(Frame);
GCExt.Delay := pause;
dec(added);
end;
end;
end;
GIF.OptimizeColorMap;
GIF.Optimize([ooMerge, ooCrop], rmNone, dmNearest, 0);
GIF.SaveToFile(currfolder +
name);
if (form1.istneu('
[_] ' +
name))
and (form1.istneu('
[X] ' +
name))
then form1.listbox1.items.insert(0, '
[_] ' +
name);
// GIF.LoadfromFile(currfolder + name); //macht keinen Unterschied
with form3
do // display gif on Form3
begin
// DoubleBuffered := true; //macht keinen Unterschied
image1.width := gif.width;
image1.height := gif.height;
Image1.Picture.Assign(gif);
(Image1.Picture.Graphic
as TGIFImage).Animate := True;
// (Image1.Picture.Graphic as TGIFImage).Animationspeed:= 100; //macht keinen Unterschied
Image1.Show;
end;
finally
GIF.Free;
end;
end;