Delphiでお手軽プログラミング

Delphiでお手軽プログラミングメニュー

Delphiで射影変換(Homography)により写真画像の台形や平行四辺形領域を長方形写真画像変換する


(参考)バイキュービック法(bicubic)で拡大縮小する
(参考)バイラテラルフィルタ(bilateral filter)で美肌に加工
(参考)ソーベルフィルタ(Sobel filter)で境界(エッジ)検出

射影変換の双一次補間式については以下URLを参照しました

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


作成するアプリの概要

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


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

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


画面デザイン



ソースコードの記述

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

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..65535] of TRGB;
  PRGBArr=^TRGBArr;
  TRGBArrArr=array[0..65535] 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)
「画像ファイルを開く」ボタンを押して、平行四辺形や台形の画像ファイルを選択します。


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

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




Copyright 2020 Mam