TBitmap画像を任意の角度に回転したTBitmap画像を生成～Delphiソースコード集

TBitmap画像の回転を使用する為のファイルの準備

本ページの下部のソースコード（URotateImageユニット）をコピーして「URotateImage.pas」ファイルを作成し、プロジェクトフォルダ内に入れる必要があります。

プロジェクトの作成と画面設計

プロジェクトを新規作成（VCLアプリケーション）し、フォーム(Form1)にTButtonを1個、TEditを1個、TImageを２個を配置します。

Image1のPictureプロパティに、回転させたい画像を設定します。
Image1のPropotionalプロパティとStretchプロパティをTrueに設定します。
Image2のPropotionalプロパティとStretchプロパティをTrueに設定します。

すべて保存ボタンを押して、プロジェクトフォルダを作成し、ユニットとプロジェクトに名前を付けて保存します。
「URotateImage.pas」ファイルをプロジェクトフォルダに保存してください。

ソースコードの記述

TButton1をダブルクリックして、以下ソースコードを記述します。

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, 
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls,
  Vcl.Imaging.jpeg, System.Math,URotateImage;

type

  TForm1 = class(TForm)
    Image1: TImage;
    Image2: TImage;
    Button1: TButton;
    Edit1: TEdit;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;


var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var bmp1,bmp2:TBitmap;
begin
  bmp1:=TBitmap.Create;
  bmp2:=TBitmap.Create;
  try
    bmp1.Assign(Image1.Picture.Graphic);
    //バイキュービックを使用する場合は第３引数をTrueに設定します
    RotateBitmap(bmp1, bmp2, StrToFloatDef(Edit1.Text,0), False);
    Image2.Picture.Assign(bmp2);
  finally
    bmp1.Free;
    bmp2.Free;
  end;
end;

end.

実行する

実行ボタンを押して実行します。（デバッグ実行でもOK）

Edit1に「15」を入力します。
Button1をクリックするとImage1画像を時計回りに15度回転した画像がImage2に表示されます。

「URotateImage.pas」ファイルのソースコード

unit URotateImage;

interface
uses System.Types,System.Classes,Vcl.Graphics;

type
  TRRGB=record B,G,R:Extended;end;
  TRGB =record B,G,R:byte;end;
  TRGBArr=array[0..32767] of TRGB;
  PRGBArr=^TRGBArr;
  TRGBArrArr=array[0..32767] of PRGBArr;
  TMamRotateBitmapUseBicubic=(NotUseBicubic,UseBicubic);

{Src:回転元 Dest:回転後 Angle:0-360度 IsUseBicubic:バイキュービックの使用}
procedure RotateBitmap(Src,Dest:TBitmap;Angle:Single;IsUseBicubic:Boolean=False);


implementation

//バイキュービック4x4の距離による重み定数
Function MamBicubicWeight4x4(d:Single):Single;
const a:Single=-0.5; //シャープの強さ -0.5(弱) ～ -1.0(強)の値を与える
begin
  if d<0 then
  begin
    result:=0;
  end
  else if d<=1 then
    result:= (a+2)*d*d*d - (a+3)*d*d + 1
  else if d<=2 then
    result:= a*d*d*d - 5*a*d*d + 8*a*d - 4*a
  else
    result:=0;
end;

Function MamBicubic4x4(srgb:TRGBArrArr;sbmp:TBitmap;sx,sy:Single):TRGB;
var x,y,tsx,tsy:Integer;
    w:Single;
    m:array[0..3]of array[0..3]of Single;
    sum:Single;
    rrgb:TRRGB;
begin
  //カーネルの作成
  sum:=0;
  for y := 0 to 3 do
  begin
    for x := 0 to 3 do
    begin
      tsx:=trunc(sx)+x-1;
      tsy:=trunc(sy)+y-1;
      if (tsx>=0) and (tsx<=(sbmp.Width-1)) and
         (tsy>=0) and (tsy<=(sbmp.Height-1)) then
      begin
        w:=MamBicubicWeight4x4(
          sqrt((tsx-sx)*(tsx-sx)+(tsy-sy)*(tsy-sy))
        );
        m[x,y]:=w;
        sum:=sum+w;
      end
      else
      begin
        m[x,y]:=-256;//計算対象外
      end;
    end;
  end;
  rrgb.R:=0;
  rrgb.G:=0;
  rrgb.B:=0;
  for y := 0 to 3 do
  begin
    for x := 0 to 3 do
    begin
      tsx:=trunc(sx)+x-1;
      tsy:=trunc(sy)+y-1;
      //if (tsx>=0) and (tsx<=(sbmp.Width-1)) and
      //   (tsy>=0) and (tsy<=(sbmp.Height-1)) then
      if m[x,y]<>-256 then
      begin
        m[x,y]:=m[x,y]/sum;
        rrgb.R:=rrgb.R+srgb[tsy,tsx].R*m[x,y];
        rrgb.G:=rrgb.G+srgb[tsy,tsx].G*m[x,y];
        rrgb.B:=rrgb.B+srgb[tsy,tsx].B*m[x,y];
     end;
    end;
  end;
  if rrgb.R<0 then rrgb.R:=0;
  if rrgb.R>255 then rrgb.R:=255;
  if rrgb.G<0 then rrgb.G:=0;
  if rrgb.G>255 then rrgb.G:=255;
  if rrgb.B<0 then rrgb.B:=0;
  if rrgb.B>255 then rrgb.B:=255;

  result.R:=trunc(rrgb.R);
  result.G:=trunc(rrgb.G);
  result.B:=trunc(rrgb.B);
end;

{Src:回転元 Dest:右回りの回転角(度) Angle:0-360度}
procedure RotateBitmap(Src,Dest:TBitmap;Angle:Single;IsUseBicubic:Boolean=False);
var bmp:TBitmap;   //Srcをコピーしたビットマップ
    CosV,SinV:Single;
    scX,scY:Single;//元画像中心
    dcX,dcY:Single;//変換後画像中心
    exX,exY:Single;//変換後画像のxy座標を回転して元画像に変換した座標
    x,y:Integer;
    dRGB,sRGB:TRGBArrArr;//スキャンライン
begin
  if not Assigned(Src) then Exit;
  if not Assigned(Dest) then Dest:=TBitmap.Create;
  bmp:=TBitmap.Create;
  bmp.Assign(Src);
  bmp.PixelFormat:=pf24bit;
  dest.PixelFormat:=pf24bit;

  //時計回り方向で予めSin,Cosを計算しておく
  CosV:=Cos(-Angle*Pi/180);
  SinV:=Sin(-Angle*Pi/180);

  //変換後画像のサイズ計算
  //x'=x*cos(a)-y*sin(a)  y'=x*sin(a)+y*cos(a)
  Dest.Width :=Round(Abs(bmp.Width*CosV)+Abs(-bmp.Height*Sinv));
  Dest.Height:=Round(Abs(bmp.Width*SinV)+Abs(bmp.Height*CosV));

  //元画像の中心
  scX:=bmp.Width/2;
  scY:=bmp.Height/2;
  //変換後画像の中心
  dcX:=Dest.Width/2;
  dcY:=Dest.Height/2;

  //予め元画像のスキャンラインをすべて取得
  for y := 0 to bmp.Height-1 do
    sRGB[y]:=bmp.ScanLine[y];
  //予め変換後画像のスキャンラインをすべて取得
  for y := 0 to dest.Height-1 do
    dRGB[y]:=Dest.ScanLine[y];

  for y := 0 to Dest.Height-1 do
  begin
    for x := 0 to Dest.Width-1 do
    begin
      //変換後画像の座標(dx,dy)から元画像の座標(exX,exY)を計算
      //x'=x*cos(a)-y*sin(a)  y'=x*sin(a)+y*cos(a)
      exX:=((x-dcX)*CosV-(y-dcY)*SinV)+scX;
      exY:=((x-dcX)*SinV+(y-dcY)*CosV)+scY;
      //元画像座標が有効範囲である場合
      if(0<=exX)and(exX<bmp.Width)and(0<=exY)and(exY<bmp.Height)then
      begin
        if IsUseBicubic then
          dRGB[y,x]:=MamBicubic4x4(sRGB,bmp,exX,exY)
        else
          dRGB[y][x]:=sRGB[Trunc(exY)][Trunc(exX)];
      end
      else
      begin
        //元画像にない箇所については黒色とする
        dRGB[y][x].R := 0;
        dRGB[y][x].G := 0;
        dRGB[y][x].B := 0;
      end;
    end;
  end;
end;

end.