射影変換(ホモグラフィ変換)で画像の台形や平行四辺形領域を長方形変換 ~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) ); //■■■幅+マージン×2、高さ+マージン×2の中央に画像を転送■■■ 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)
「画像ファイルを開く」ボタンを押して、平行四辺形や台形の画像ファイルを選択します。
青い「操作ハンドル」をドラッグして、平行四辺形や台形の画像に合わせ、「射影変換を行う」ボタンを押すします。
右ペインに射影変換が完了したイメージが表示されます。
近接近傍法(ニアレストネイバー)なので射影変換後の画像はきれいではないです
(綺麗に射影変換するにはバイキュービック法等を使う必要があります)