Bitpmap画像ファイルからJPEG,PNG,ICO.GIFファイルに変換 ～Delphiソースコード集

• ホーム
• Delphiでお手軽プログラミング
• Bitpmap画像ファイルからJPEG,PNG,ICO.GIFファイルに変換 ～Delphiソースコード集

Bitpmap画像ファイルからJPEG,PNG,ICO.GIFファイルに変換 ～Delphiソースコード集

jpegファイルの作成、透過型PNGファイルの作成、透過型ICONファイルの作成、透過型アニメーションGIFファイルを作成する

TBitmapから.jpg(TJpegImage)ファイルに変換する

uses //Vcl.Graphics,
     Vcl.Imaging.jpeg;

procedure TForm1.Button1Click(Sender: TObject);
var bmp:TBitmap;
    jpg:TJpegImage;
begin
  bmp:=TBitmap.Create;
  jpg:=TJPEGImage.Create;
  try
    //Bitmapを塗ったり線を引いたりする
    bmp.width:=64;
    bmp.Height:=64;
    bmp.Canvas.Brush.Color:=clRed;
    bmp.Canvas.FillRect(Rect(10,10,20,20));
    bmp.Canvas.Pen.Color:=clBlack;
    bmp.Canvas.MoveTo(4,4);
    bmp.Canvas.LineTo(60,60);

    //Bitmap画像をjpgに適用する
    jpg.Assign(bmp);
    //JPEGの圧縮品質を80に設定する(1～100まで指定可能)
    jpg.CompressionQuality:=80;
    //JPEG圧縮する
    jpg.Compress;
    //JPEGファイルに保存する
    jpg.SaveToFile('test.jpg');
  finally
    bmp.Free;
    jpg.Free;
  end;
end;

TBitmapから透過型.png(TPngImage)ファイルに変換する

uses //Vcl.Graphics,
     Vcl.Imaging.pngimage;

procedure TForm1.Button2Click(Sender: TObject);
var bmp:TBitmap;
    png:TPngImage;
begin
  bmp:=TBitmap.Create;
  png:=TPngImage.Create;
  try
    //Bitmapに適当に塗ったり線を引いたりする
    bmp.width:=64;
    bmp.Height:=64;
    bmp.Canvas.Brush.Color:=clWhite;
    bmp.Canvas.FillRect(Rect(0,0,bmp.width,bmp.Height));
    bmp.Canvas.Brush.Color:=clRed;
    bmp.Canvas.FillRect(Rect(10,10,20,20));
    bmp.Canvas.Pen.Color:=clBlack;
    bmp.Canvas.MoveTo(4,4);
    bmp.Canvas.LineTo(60,60);
    //白色を透明に設定する
    bmp.TransparentColor:=clWhite;
    bmp.Transparent:=True;

    //Bitmap画像をpngに適用する（透過型PNGになる）
    png.Assign(bmp);
    //PNGファイルに保存する
    png.SaveToFile('test.png');
  finally
    bmp.Free;
    png.Free;
  end;
end;

TBitmapから透過型.ico(TIcon)ファイルに変換する

//uses Vcl.Graphics;

procedure TForm1.Button3Click(Sender: TObject);
var bmp:TBitmap;
    maskBmp:TBitmap;
    ico:TIcon;
    IconInfo:TIconInfo;
begin
  bmp:=TBitmap.Create;
  maskBmp:=TBitmap.Create;
  ico:=TIcon.Create;
  try
    //Bitmapに適当に塗ったり線を引いたりする
    bmp.width:=64;
    bmp.Height:=64;
    bmp.Canvas.Brush.Color:=clWhite;
    bmp.Canvas.FillRect(Rect(0,0,bmp.width,bmp.Height));
    bmp.Canvas.Brush.Color:=clRed;
    bmp.Canvas.FillRect(Rect(10,10,20,20));
    bmp.Canvas.Pen.Color:=clBlack;
    bmp.Canvas.MoveTo(4,4);
    bmp.Canvas.LineTo(60,60);

    maskBmp.Assign(bmp);
    //左下の色を透過色とする場合
    //maskBmp.Mask(maskBmp.Canvas.Pixels[0,mbmp.Height-1]);
    //白色を透過色とする場合
    maskBmp.Mask($FFFFFF);

    IconInfo.fIcon:=true;
    IconInfo.xHotspot:=0;
    IconInfo.yHotspot:=0;
    IconInfo.hbmMask:=maskBmp.Handle;
    IconInfo.hbmColor:=bmp.Handle;
    ico.Handle:=CreateIconIndirect(IconInfo);
    ico.SaveToFile('test.ico');
  finally
    bmp.Free;
    maskBmp.Free;
    ico.Free;
  end;
end;

TBitmapから透過型アニメーション.gif(TGIFImage)ファイルに変換する

uses //Vcl.Graphics,
     VCL.Imaging.GIFImg;

procedure TForm1.Button4Click(Sender: TObject);
var bmp:TBitmap;
    gif:TGIFImage;
    gifFrame:TGIFFrame;
    gifGCE:TGIFGraphicControlExtension;
    i:Integer;
    TransparentColor:TColor;
begin
  //透過色
  transparentColor:=$FEFEFE;
  bmp:=TBitmap.Create;
  gif:=TGIFImage.Create;
  try
    bmp.width:=64;
    bmp.Height:=64;
    for i := 0 to 7 do
    begin
      //Bitmapを適当に塗ったり線を引いたりする
      bmp.Canvas.Brush.Color:=TransparentColor;
      bmp.Canvas.FillRect(Rect(0,0,64,64));
      bmp.Canvas.Brush.Color:=clRed;
      bmp.Canvas.FillRect(Rect(i*8,i*8,(i+1)*8,(i+1)*8));
      bmp.Canvas.Pen.Color:=clBlack;
      bmp.Canvas.Pen.Width:=2;
      bmp.Canvas.MoveTo(0,i*8+1);
      bmp.Canvas.LineTo(63,i*8+1);

      gifFrame:=gif.Add(bmp);
      //ループ再生に設定する
      if i=0 then
        TGIFAppExtNSLoop.Create(gifFrame).Loops:=0;
      gif.OptimizeColorMap;
      gifGCE:=TGIFGraphicControlExtension.Create(gifFrame);
      gifGCE.TransparentColor:=TransparentColor;
      gifGCE.Transparent:=True;
      gifGCE.Disposal:=dmBackground;
      gifGCE.Delay:=10;  // 1/100秒単位なので0.1秒/フレーム設定
    end;

    //最適化
    gif.Optimize(
      [TGIFOptimizeOption.ooCrop,
       TGIFOptimizeOption.ooMerge,
       TGIFOptimizeOption.ooCleanup,
       TGIFOptimizeOption.ooColorMap],
      TColorReduction.rmQuantize,
      TDitherMode.dmNearest
    );
    gif.SaveToFile('test.gif');
  finally
    bmp.free;
    gif.Free;
  end;
end;

アニメーション.gif(TGIFImage)ファイルから各フレームをBitmapファイルに取り出す

uses //Vcl.Graphics,
     VCL.Imaging.GIFImg;

procedure TForm1.Button5Click(Sender: TObject);
var gif:TGifImage;
    i:Integer;
    bmp:TBitmap;
    gr:TGIFRenderer;
begin
  gif:=TGIFImage.Create;
  bmp:=TBitmap.Create;
  try
    gif.LoadFromFile('test.gif');
    bmp.Width:=gif.Width;
    bmp.Height:=gif.Height;
    gr:=TGIFRenderer.Create(gif);
    try
      for i := 0 to gif.Images.Count-1 do
      begin
        if not gif.Images[i].Empty then
        begin
          gr.Draw(bmp.Canvas,bmp.Canvas.ClipRect);
          gr.NextFrame;
          bmp.SaveToFile(Format('%2.2d',[i])+'.bmp');
        end;
      end;
    finally
      gr.Free;
    end;
  finally
    bmp.Free;
    gif.Free;
  end;
end;