画像の座標抽出をするには？ (ID:42031)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

確かに、Delphiのグラフィック系は参考になるサイトが少ないかと思います。
なるべくわかりやすいようにコメント盛りだくさんでサンプルを書いて見たので参考にして下さい。
わからない箇所があればまた答えます。

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Menus;

type
  TPixcelData=record
    Black:Boolean;   //色が黒
    Checked:Boolean; //チェックしたか
  end;
  PPixcelDataArray = ^TPixcelDataArray;
  TPixcelDataArray = array of array of TPixcelData;

TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    OpenDialog1: TOpenDialog;
    N1: TMenuItem;
    N2: TMenuItem;
    procedure N2Click(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
    fBmp:TBitmap;
    fPoint:array of TPoint;
  public
    { Public 宣言 }
    procedure Analize(aBmp:TBitmap);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure PixcelSearch(var Pixcel:TPixcelDataArray; x,y:Integer; var vx,vy,vc:Integer);
begin
  if (Pixcel[x,y].Black=True) and     //黒
     (Pixcel[x,y].Checked=False) then //未チェック
  begin
    Pixcel[x,y].Checked:=True; //チェック
    vx := vx + x;
    vy := vy + y;
    vc := vc + 1;
    //４方向へ検索
    PixcelSearch(Pixcel,x+1,y  ,vx,vy,vc);
    PixcelSearch(Pixcel,x-1,y  ,vx,vy,vc);
    PixcelSearch(Pixcel,x  ,y+1,vx,vy,vc);
    PixcelSearch(Pixcel,x  ,y-1,vx,vy,vc);
  end;
end;

procedure TForm1.Analize(aBmp: TBitmap);
var
  i,x,y: Integer;
  //画像のピクセルデータを格納する
  //True=黒  False=白  の２値
  //座標にアクセスはPixcel[x,y]
  Pixcel:TPixcelDataArray;
  //ビットマップの画像データへのポインタ
  p:PInteger; //32bit値なのでPIntegerを使用
  //ビットマップのカラー値 32bitビットマップの色は
  //32bit = 8bit:A,R,G,B
  bR,bG,bB:Byte;

//--------------------------------------------
  //黒い塊の重心を求めるアルゴリズム用
  vx,vy,vc:Integer;
const
  Threshold = 128; //白黒の閾値
begin
  //Pixcel配列の確保
  SetLength(Pixcel,aBmp.Width);
  for i := 0 to aBmp.Width-1 do
    SetLength(Pixcel[i],aBmp.Height);
  //その初期化
  for y := 0 to aBmp.Height-1 do
    for x := 0 to aBmp.Width-1 do
    begin
      Pixcel[x,y].Black:=False;
      Pixcel[x,y].Checked:=False;
    end;

//Pixcel配列にビットマップのグレー値を格納
  //32bitビットマップを用いてピクセルデータを抽出しています。
  //この方法は32bitビットマップでのみ可能です
  aBmp.PixelFormat := pf32bit;
  //ビットマップのデータ座標は逆順に配列されている
  p:=aBmp.ScanLine[aBmp.Height-1];
  for y := aBmp.Height-1 downto 0 do
    for x := 0 to aBmp.Width-1 do
    begin
      bR := GetRValue(p^);
      bG := GetGValue(p^);
      bB := GetBValue(p^);
      inc(p); //ポインタを32bitシフト
                            //グレー化     //閾値で比較
      Pixcel[x,y].Black := (((bR+bG+bB)/3)<Threshold);
    end;

//----------------------------------------------------------------------------
  //黒い塊の重心を求める
  //結果を格納する配列の初期化
  SetLength(fPoint,0);
  //順番に黒い点を探す
  for y := 0 to aBmp.Height-1 do
    for x := 0 to aBmp.Width-1 do
    begin
      //初期化
      vx := 0;
      vy := 0;
      vc := 0;
      //重心を求める
      PixcelSearch(Pixcel,x,y,vx,vy,vc);
      if vc > 0 then
      begin
        SetLength(fPoint,Length(fPoint)+1);
        fPoint[Length(fPoint)-1].X := Round(vx/vc);
        fPoint[Length(fPoint)-1].Y := Round(vy/vc);
      end;
    end;

Repaint; //再描画
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  fBmp:=TBitmap.Create;
end;

procedure TForm1.FormPaint(Sender: TObject);
var
  i: Integer;
begin
  Canvas.Draw(0,0,fBmp);
  Canvas.Brush.Color := clRed;
  Canvas.Pen.Color := clRed;
  for i := 0 to Length(fPoint)-1 do
    Canvas.Ellipse(fPoint[i].X - 2,
                   fPoint[i].Y - 2,
                   fPoint[i].X + 2,
                   fPoint[i].Y + 2
                   );
end;

//ファイルを開く
procedure TForm1.N2Click(Sender: TObject);
begin
  if OpenDialog1.Execute then
  begin
    fBmp.LoadFromFile(OpenDialog1.FileName);
    Analize(fBmp);
  end;
end;

end.

←解決時は質問者本人がここをチェックしてください。

戻る