5

GIF 画像のフレームを抽出したい。以下のコードは機能しますが、必要なものではありません。抽出したフレームを一連のビットマップに保持する必要があります。

procedure TForm1.Button2Click(Sender: TObject);
var
  GIF: TGIFImage;
  Bitmap: TBitmap;
  I: Integer;
  GR: TGIFRenderer;
  R: TRect;
begin
  GIF := TGIFImage.Create;
  TRY
    GIF.LoadFromFile('c:\1.gif');
    Bitmap := TBitmap.Create;       <------------ one single object, reused
    Bitmap.SetSize(GIF.Width, GIF.Height);
    GR := TGIFRenderer.Create(GIF);
    try
      for I := 0 to GIF.Images.Count - 1 do
       begin    
         GR.Draw(Bitmap.Canvas, Bitmap.Canvas.ClipRect);

         Self.Canvas.Draw(0, 0, Bitmap);

         GR.NextFrame;
       end;
    finally
      GR.Free;
    end;
  finally
    GIF.Free;
    //Bitmap.Free;
  end;
end;

そのため、フレームごとにビットマップを動的に作成します。しかし、これはうまくいきません。すべてのビットマップで同じ/最初のフレームのみが表示されます!

procedure TForm1.Button2Click(Sender: TObject);
var
  GIF: TGIFImage;
  Bitmap: TBitmap;
  I: Integer;
  GR: TGIFRenderer;
  R: TRect;
begin
  GIF := TGIFImage.Create;
  TRY
    GIF.LoadFromFile('c:\1.gif');
    GR := TGIFRenderer.Create(GIF);
    try
      for I := 0 to GIF.Images.Count - 1 do
       begin
         Bitmap := TBitmap.Create;       <----- multiple bitmaps, one for each frame
         Bitmap.SetSize(GIF.Width, GIF.Height);

         GR.Draw(Bitmap.Canvas, Bitmap.Canvas.ClipRect);

         Self.Canvas.Draw(0, 0, Bitmap);

         GR.NextFrame;
       end;
    finally
      GR.Free;
    end;

    {TODO: store bitmaps in a TObjectList for later use 
    List.Add(Bitmap);  }     
  finally
    GIF.Free;
  end;
end;

上記のコードの何が問題になっていますか? TGIFRenderer はフレーム間の違いだけを描画するのでしょうか?

TLama/jachguate の更新:

TLama は、ビットマップを解放していないため、コードが機能しないと言っています。ビットマップを解放したくありません。後で必要になります。ここにいくつかの（デモグレードの）コードがあります。 

VAR List: TObjectList;    {used and freed somwhere else}

procedure TForm1.Button2Click(Sender: TObject);
var
  GIF: TGIFImage;
  UniqueBMP: TBitmap;
  I: Integer;
  GR: TGIFRenderer;
  R: TRect;
begin
  List:= TObjectList.Create;
  GIF := TGIFImage.Create;
  TRY
    GIF.LoadFromFile('c:\1.gif');

    GR := TGIFRenderer.Create(GIF);
    try
      for I := 0 to GIF.Images.Count - 1 do
       begin
         UniqueBMP := TBitmap.Create;
         UniqueBMP.SetSize(GIF.Width, GIF.Height);

         if GIF.Images[I].Empty then Break;

         GR.Draw(UniqueBMP.Canvas, UniqueBMP.Canvas.ClipRect);

         Self.Canvas.Draw(0, 0, UniqueBMP);
         Sleep(50);

         List.Add(UniqueBMP);

         GR.NextFrame;
       end;
    finally
      GR.Free;
    end;
  finally
    GIF.Free;
  end;
end;


procedure TForm1.btnFreeClick(Sender: TObject);
begin 
  FreeAndNil(List);
end;
4

2 に答える 2

9

はTCustomGIFRenderer.Draw、レンダリングするキャンバスをチェックします。前回のレンダリングで記憶したものと異なる場合 (フレームごとに新しいビットマップを作成しているため異なる場合)、TCustomGIFRenderer.Resetメソッドが呼び出され、その名前が示すように、フレーム インデックスが 0 にリセットされます。そのため、常に最初のフレームだけがレンダリングされます。

于 2013-02-28T17:47:25.283 に答える
3

TLama のソリューションに基づく作業コード (私の投稿ではなく彼の投稿に投票してください):

procedure TForm1.Button2Click(Sender: TObject);
var
  GIF: TGIFImage;
  TempBMP, UniqueBMP: TBitmap;
  I: Integer;
  GR: TGIFRenderer;
  R: TRect;
begin
  GIF := TGIFImage.Create;
  TRY
    GIF.LoadFromFile('c:\1.gif');

    TempBMP := TBitmap.Create;       <------- SOLUTION
    TempBMP.SetSize(GIF.Width, GIF.Height);

    GR := TGIFRenderer.Create(GIF);
    try
      for I := 0 to GIF.Images.Count - 1 do
       begin
         UniqueBMP := TBitmap.Create;      <------- SOLUTION
         UniqueBMP.SetSize(GIF.Width, GIF.Height);

         if GIF.Images[I].Empty then Break;

         GR.Draw(TempBMP.Canvas, TempBMP.Canvas.ClipRect);

         UniqueBMP.Assign(TempBMP);                <------- SOLUTION
         Self.Canvas.Draw(0, 0, UniqueBMP);
         Sleep(50);

         GR.NextFrame;
       end;
    finally
      GR.Free;
    end;
  finally
    GIF.Free;
    TempBMP.Free;
  end;
end;
于 2013-02-28T16:57:30.897 に答える