// Ein animiertes GIF wird an einer bestimmten Stelle angehalten. Der
// Code gilt für GIFs, die in Dauerschleife laufen (bzw. noch nicht
// bis zu Ende durchgelaufen sind).

// Getestet mit RS 10.4 unter Win11
 
// uses Vcl.Imaging.GIFImg; 
 
var 
  Nochmal: Boolean = False; 
  Rend: TGIFRenderer; 
  Stop: Word = 0; 
  Gif: TGifimage; 
  Count: Integer; 
  Rct: TRect; 
 
procedure TForm1.Anzeige; 
begin 
  Label2.Caption := 'Aktuelles Bild: ' + IntToStr(succ(Rend.FrameIndex)); 
end; 
 
procedure TForm1.GifChange(Sender: TObject); 
begin 
  Rend.Draw(Image1.Canvas, Rct); 
  Anzeige; 
  if Stop = 0 then 
    exit; 
  dec(Stop); 
  if Stop = 1 then 
    Rend.StopAnimation; 
end; 
 
procedure TForm1.Button1Click(Sender: TObject); 
var 
  I: Integer; 
  Transparent: Boolean; 
begin 
  if OpenDialog1.execute then 
  begin 
    if Nochmal then 
    begin 
      Rend.StopAnimation; 
      Rend.Free; 
      Gif.OnChange := nil; 
    end 
    else 
      Gif := TGifimage.Create; 
    Nochmal := True; 
    Gif.LoadFromFile(OpenDialog1.FileName); 
    Transparent := Gif.Images[0].Transparent;
    Gif.OnChange := GifChange; 
    Rct := Rect(0, 0, Gif.Width, Gif.Height); 
    Rend := TGIFRenderer.Create(Gif); 
    Image1.Picture.Bitmap.SetSize(Gif.Width, Gif.Height); 
    with Image1.Canvas do 
      Fillrect(Cliprect); 
    Count := 0; 
    for I := 0 to Gif.Images.Count - 1 do 
      if not Gif.Images[I].Empty then 
        inc(Count); 
    Label1.Caption := 'Vorhandene Bilder: ' + IntToStr(Count); 
    Stop := 7; // beim 7. Bild stoppen; Zählung beginnt bei 1 
    { Stop := Count; // 1x Durchlauf } 
    { Stop := 3 * Count; // 3x Durchlauf } 
    { Stop := 0; // Dauerschleife } 
    { Stop := Count + 1; // springt am Ende zum 1. Bild } 
    Rend.Transparent := Transparent; 
    Image1.Transparent := Transparent; 
    Anzeige; 
    Rend.Animate := Stop <> 1; 
    Rend.Draw(Image1.Canvas, Rct); 
  end; 
end; 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  Image1.AutoSize := True; 
  Doublebuffered := True; 
  Nochmal := False; 
end; 
 
procedure TForm1.FormDestroy(Sender: TObject); 
begin 
  FreeAndNil(Rend); 
  FreeAndNil(Gif); 
end;
 
Zugriffe seit 6.9.2001 auf Delphi-Ecke