射影変換(ホモグラフィ変換)で画像の台形や平行四辺形領域を長方形変換 ～Delphiソースコード集

射影変換(ホモグラフィ変換)で画像の台形や平行四辺形領域を長方形変換 ～Delphiソースコード集

射影変換（ホモグラフィ変換）で台形や平行四辺形領域の画像を長方形に変換します。
射影変換の双一次補間式については以下URLを参照しました

http://aows.jp/imgprc/material/04/

作成するアプリの概要

長方形にしたい画像ファイルを左ペインに開き、操作ハンドルをドラッグして画像範囲を選択し、射影変換を行って長方形に変換した右ペイン画像を生成します。

Delphiを起動してプロジェクトの新規作成を行う

IDEを起動し「ファイル」⇒「新規作成」⇒「Windows VCL アプリケーション -Delphi」をクリックする

画面デザイン

• フォームに「TOpenDialog」をドラッグ＆ドロップする
• TPanelをドラッグ＆ドロップし、「Align」プロパティを「alTop」に設定する
• Panel1に、TButtonを2つドラッグ＆ドロップする
• フォームに「TScrollBox」をドラッグ＆ドロップし、「Align」プロパティを「alLeft」に設定する
• ScrollBox1に「TImage」をドラッグ＆ドロップする
• フォームに、「TSplitter」をドラッグ＆ドロップする
• フォームに「TScrollBox」をドラッグ＆ドロップし、「Align」プロパティを「alClient」に設定する
• ScrollBox2に「TImage」をドラッグ＆ドロップする

ソースコードの記述

以下ソースコードを記述する。
適宜「すべて保存」ボタンを押してファイルを保存します。

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.Pngimage, Vcl.Imaging.jpeg
  ,System.Math ;

type
  TFourPoint=array[0..3] of TPoint;

  TForm1 = class(TForm)
    ScrollBox1: TScrollBox;
    ScrollBox2: TScrollBox;
    OpenDialog1: TOpenDialog;
    Panel1: TPanel;
    Image1: TImage;
    Image2: TImage;
    Button1: TButton;
    Button2: TButton;
    Splitter1: TSplitter;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
  private
    { Private 宣言 }
    //操作ハンドル（ラバーバンド）の4隅の座標
    pta:TFourPoint;
    //ドラッグ中の操作ハンドル（ラバーバンド）の4隅の座標
    tmp_pta:TFourPoint;
    //読み込んだ画像
    mBmp:TBitmap;
    //マウスドラッグ開始直後のマウス座標
    MousePoint:TPoint;
    //操作ハンドル4隅のどれをドラッグ中か一時保存する
    MousePointNum:Integer;
    //操作ハンドルを渡すと画像と操作ハンドルとラバーバンドを表示する
    procedure DrawImage(fp:TFourPoint);
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;
const
  //画像の周りに16ピクセルのマージンを設定する
  //  操作ハンドルが左上等の隅っこでも切れることなく表示する為に
  //  画像ファイルを開くと上下左右16ピクセル大き目の画像を生成する
  ImgMargin:Integer=16;
  //操作ハンドルのドラッグマージン
  ControlHandleMargin:Integer=8;
implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
// 画像ファイルを開く
var png:TPngImage;
    jpg:TJPEGImage;
    bmp:TBitmap;
    ext:String;
begin
  Image1.Left:=0;
  Image1.Top:=0;
  if not OpenDialog1.Execute then exit;

  ext:=LowerCase(ExtractFileExt(OpenDialog1.FileName));
  if ext='.png' then
  begin
    png:=TPngImage.Create;
    try
      png.LoadFromFile(OpenDialog1.FileName);
      mBmp.Assign(png);
    finally
      png.Free;
    end;
  end
  else if (ext='.jpg') or (ext='.jpeg') then
  begin
    jpg:=TJPEGImage.Create;
    try
      jpg.LoadFromFile(OpenDialog1.FileName);
      mBmp.Assign(jpg);
    finally
      jpg.Free;
    end;
  end
  else
  begin
    bmp:=TBitmap.Create;
    try
      bmp.LoadFromFile(OpenDialog1.FileName);
      mBmp.Assign(bmp);
    finally
      bmp.Free;
    end;
  end;
  mBmp.PixelFormat:=TPixelFormat.pf24bit;
  Image1.Width:=mBmp.Width+ImgMargin*2;
  Image1.Height:=mBmp.Height+ImgMargin*2;
  Image1.Picture.Bitmap.PixelFormat:=TPixelFormat.pf24bit;
  Image1.Picture.Bitmap.Width:=Image1.Width;
  Image1.Picture.Bitmap.Height:=Image1.Height;

  pta[0].X:=0+ImgMargin;
  pta[0].Y:=0+ImgMargin;
  pta[1].X:=mBmp.Width-1+ImgMargin;
  pta[1].Y:=0+ImgMargin;
  pta[2].X:=mBmp.Width-1+ImgMargin;
  pta[2].Y:=mBmp.Height-1+ImgMargin;
  pta[3].X:=0+ImgMargin;
  pta[3].Y:=mBmp.Height-1+ImgMargin;
  DrawImage(pta);
end;

procedure TForm1.Button2Click(Sender: TObject);
//射影変換を行う
type
  TRGB =record B,G,R:byte; end;
  PRGB=^TRGB;
  TRGBArr=array[0..32767] of TRGB;
  PRGBArr=^TRGBArr;
  TRGBArrArr=array[0..32767] of PRGBArr;
var tmp:TFourPoint;
    i,x,y,xx,yy:Integer;
    a0,b0,a1,b1,c1,a2,b2,c2:Extended;
    rgb:PRGB;
    rgb_arr:TRGBArrArr;
    w1,w2,h1,h2:Integer;
    wrate,hrate:Extended;
    ImgWidth,ImgHeight:Integer;
begin
  for i := 0 to High(pta) do
  begin
    tmp[i].X:=pta[i].X-ImgMargin;
    tmp[i].Y:=pta[i].Y-ImgMargin;
  end;

  //変換後の幅と高さは与えるようですが、強引に計算処理により自動設定する
  w1:=Abs(tmp[1].X-tmp[0].X);
  w2:=Abs(tmp[2].X-tmp[3].X);
  h1:=Abs(tmp[3].Y-tmp[0].Y);
  h2:=Abs(tmp[2].Y-tmp[1].Y);
  if w1 > w2 then wrate:=Sqrt(w1/w2)
  else wrate:= Sqrt(w2/w1);
  if h1 > h2 then hrate:=Sqrt(h1/h2)
  else hrate:= Sqrt(h2/h1);

  ImgWidth:=round(Abs((w1+w2)/2)*hrate);
  ImgHeight:=round(Abs((h1+h2)/2)*wrate);


  Image2.Width:=ImgWidth+1;
  Image2.Height:=ImgHeight+1;
  Image2.Picture.Bitmap.Width:=ImgWidth+1;
  Image2.Picture.Bitmap.Height:=ImgHeight+1;
  Image2.Picture.Bitmap.PixelFormat:=TPixelFormat.pf24bit;

  a0:=(
        (tmp[1].X+tmp[3].X-tmp[0].X-tmp[2].X)*(tmp[2].Y-tmp[3].Y)-
        (tmp[1].Y+tmp[3].Y-tmp[0].Y-tmp[2].Y)*(tmp[2].X-tmp[3].X)
      )/
      (ImgWidth*
        (
          (tmp[2].X-tmp[1].X)*(tmp[2].Y-tmp[3].Y)-
          (tmp[2].Y-tmp[1].Y)*(tmp[2].X-tmp[3].X)
        )
      );
  b0:=(
        (tmp[1].X+tmp[3].X-tmp[0].X-tmp[2].X)*(tmp[2].Y-tmp[1].Y)-
        (tmp[1].Y+tmp[3].Y-tmp[0].Y-tmp[2].Y)*(tmp[2].X-tmp[1].X)
      )/
      (ImgHeight*
        (
          (tmp[2].X-tmp[3].X)*(tmp[2].Y-tmp[1].Y)-
          (tmp[2].Y-tmp[3].Y)*(tmp[2].X-tmp[1].X)
        )
      );
  a1:=a0*tmp[1].X+(tmp[1].X-tmp[0].X)/ImgWidth;
  b1:=b0*tmp[3].X+(tmp[3].X-tmp[0].X)/ImgHeight;
  c1:=tmp[0].X;
  a2:=a0*tmp[1].Y+(tmp[1].Y-tmp[0].Y)/ImgWidth;
  b2:=b0*tmp[3].Y+(tmp[3].Y-tmp[0].Y)/ImgHeight;
  c2:=tmp[0].Y;

  //Pixelsプロパティを使うと処理が遅い
  { for y := 0 to ImgHeight do
  begin
    for x := 0 to ImgWidth do
    begin
      xx:=Round((a1*x+b1*y+c1)/(a0*x+b0*y+1));
      yy:=Round((a2*x+b2*y+c2)/(a0*x+b0*y+1));
      Image2.Picture.Bitmap.Canvas.Pixels[x,y]:=
        mBmp.Canvas.Pixels[xx,yy];
    end;
  end; }

  //ScanLineプロパティを使うと処理が高速
  for y := 0 to mBmp.Height-1 do
    rgb_arr[y]:=mBmp.ScanLine[y];
  for y := 0 to ImgHeight do
  begin
    rgb:=Image2.Picture.Bitmap.ScanLine[y];
    for x := 0 to ImgWidth do
    begin
      xx:=Round((a1*x+b1*y+c1)/(a0*x+b0*y+1));
      yy:=Round((a2*x+b2*y+c2)/(a0*x+b0*y+1));
      rgb^:=rgb_arr[yy][xx];
      inc(rgb);
    end;
  end;
  Image2.Invalidate;
end;

procedure TForm1.DrawImage(fp: TFourPoint);
var i:Integer;
    PenStyle:Cardinal;
    LogBrush:TLogBrush;
    pen:HPEN;
    OldPen:HPEN;
begin
  //■■■全体を白色に塗りつぶす■■■
  Image1.Picture.Bitmap.Canvas.Brush.Color:=RGB($ff,$ff,$ff);
  Image1.Picture.Bitmap.Canvas.Brush.Style:=TBrushStyle.bsSolid;
  Image1.Picture.Bitmap.Canvas.FillRect(
    Rect(0,0,Image1.Width,Image1.Height)
  );

  //■■■幅＋マージン×２、高さ＋マージン×２の中央に画像を転送■■■
  Image1.Picture.Bitmap.Canvas.Draw(ImgMargin,ImgMargin,mBmp);

  //■■■ラバーバンドの表示■■■
  //ブラシを透明にする
  Image1.Picture.Bitmap.Canvas.Brush.Style:=TBrushStyle.bsClear;
  //既存のコスメティックペンを保存
  OldPen:=Image1.Picture.Bitmap.Canvas.Pen.Handle;
  //ジオメトリックペンの作成
  LogBrush.lbStyle:=BS_SOLID;
  LogBrush.lbColor:=RGB($0,$cc,$cc);
  LogBrush.lbHatch:=0;
  PenStyle:=PS_GEOMETRIC+PS_DASH+PS_ENDCAP_ROUND+PS_JOIN_ROUND;
  pen:=ExtCreatePen(PenStyle,3,LogBrush,0,nil);
  //作成したジオメトリックペンを使用できるよう設定
  Image1.Picture.Bitmap.Canvas.Pen.Handle:=pen;
  //操作ハンドルに対するラバーバンドを表示
  Image1.Picture.Bitmap.Canvas.Polygon(fp);
  //既存のコスメティックペンに戻す
  Image1.Picture.Bitmap.Canvas.Pen.Handle:=OldPen;
  //作成したジオメトリックペンの破棄
  DeleteObject(pen);

  //■■■操作ハンドルの表示■■■
  //ブラシを塗りつぶしする
  Image1.Picture.Bitmap.Canvas.Brush.Style:=TBrushStyle.bsSolid;
  Image1.Picture.Bitmap.Canvas.Brush.Color:=RGB($0,$ff,$ff);
  Image1.Picture.Bitmap.Canvas.Pen.Style:=TPenStyle.psClear;
  for i := 0 to High(fp) do
  begin
    Image1.Picture.Bitmap.Canvas.Ellipse(
      fp[i].X-ControlHandleMargin, fp[i].Y-ControlHandleMargin,
      fp[i].X+ControlHandleMargin, fp[i].Y+ControlHandleMargin
    );
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Image1.Left:=0;
  Image1.Top:=0;
  Image1.Proportional:=True;
  Image1.Stretch:=True;
  Image2.Left:=ImgMargin;
  Image2.Top:=ImgMargin;
  Image2.Proportional:=True;
  Image2.Stretch:=True;
  Button1.Caption:='画像ファイルを開く';
  Button2.Caption:='射影変換を行う';
  OpenDialog1.Title:='画像ファイルを開く';;
  OpenDialog1.Filter:='画像ファイル|*.jpg;*.png;*.bmp';
  mBmp:=TBitmap.Create;
  MousePointNum:=-1;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  mBmp.Free;
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var i:Integer;
begin
  for i := 0 to High(pta) do
  begin
    if (pta[i].X > (X-ControlHandleMargin)) and
       (pta[i].X < (X+ControlHandleMargin)) and
       (pta[i].Y > (Y-ControlHandleMargin)) and
       (pta[i].Y < (Y+ControlHandleMargin)) then
    begin
      MousePointNum:=i;
      MousePoint.X:=X;
      MousePoint.Y:=Y;
      tmp_pta:=pta;
      break;
    end;
  end;
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var tmp:TPoint;
begin
  if MousePointNum=-1 then Exit;
  tmp.X:=pta[MousePointNum].X+(X-MousePoint.X);
  tmp.Y:=pta[MousePointNum].Y+(Y-MousePoint.Y);

  if (tmp.X < ImgMargin) then tmp.X:=ImgMargin;
  if (tmp.Y < ImgMargin) then tmp.Y:=ImgMargin;
  if (tmp.X > (mBmp.Width+ImgMargin-1)) then tmp.X:=mBmp.Width+ImgMargin-1;
  if (tmp.Y > (mBmp.Height+ImgMargin-1)) then tmp.Y:=mBmp.Height+ImgMargin-1;

  tmp_pta:=pta;
  tmp_pta[MousePointNum].X:=tmp.X;
  tmp_pta[MousePointNum].Y:=tmp.Y;
  DrawImage(tmp_pta);
end;
procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if MousePointNum <> -1 then
  begin
    MousePointNum:=-1;
    pta:=tmp_pta;
  end;
end;

end.

実行する

実行ボタンを押して実行します。（デバッグ実行でもOK）
「画像ファイルを開く」ボタンを押して、平行四辺形や台形の画像ファイルを選択します。

青い「操作ハンドル」をドラッグして、平行四辺形や台形の画像に合わせ、「射影変換を行う」ボタンを押すします。
右ペインに射影変換が完了したイメージが表示されます。

近接近傍法（ニアレストネイバー）なので射影変換後の画像はきれいではないです
（綺麗に射影変換するにはバイキュービック法等を使う必要があります）