矩形検出器

手書き答案をスキャナーで画像化して採点するソフトを書いた。概ね、思った通りにカタチになったが、解答欄の位置座標を取得するのに、解答欄の数だけ、その左上隅から右下隅へマウスでドラッグする作業を繰り返さなくてはならない。（もし、これが自動化できたら･･･） そう思って書いたのが、このプログラム。

１．矩形の検出方法
２．字数制限のある解答欄の作り方
３．GUIはDelphiで作成
４．矩形検出器の使い方
５．まとめ
６．お願いとお断り

１．矩形の検出方法

キーワードを『矩形　検出』にしてGoogle先生にお伺いをたてると、思った通りOpenCVを活用する方法がいくつもヒットする。しかも、そのほとんどすべてがPythonでの活用方法だ。Delphi用のOpenCVもあるようだけれど、次の理由から矩形の検出はPython用のOpenCVで行うことにした。

Pythonを使う利点は、まず、何と言っても、情報が豊富なことだ。マイ・プログラミング環境では、わからないことはすべてGoogle先生に教えてもらうしかないので、情報が入手しやすいことは、他のすべてに優先する。

（メインの開発環境がDelphiなのは、上記の内容と大いに矛盾しますが･･･）

さらに、手書き答案の採点ソフトより前に、マークシートリーダーを作った時、マーク欄の座標を得るために、やはりPythonとOpenCVのお世話になった。マークシートリーダーも、手書き答案の採点ソフトも、embeddable pythonに入れたOpenCVと一緒のフォルダに詰め込んでユーザーに配布しているから、Pythonを内包して使う環境は既に完成済み。PythonのスクリプトをDelphiのコードに埋め込んで、PythonForDelphiを使って実行する方法は勉強済みだから安心。Delphi用のOpenCVは、情報も少ないし、何よりその使い方がわからない･･･。

Setup Python4Delphi

Download Embeddable Python and Install the library

他人様に使っていただくプログラムはDelphiで書くけれど、自分専用のToolはPython環境を利用して作ることが多い。ちょっと特別なことをしたい時、Pythonはとても便利だ。いろいろ紆余曲折はあったけれど、現在はSDカードにWinPythonとAtomエディタを入れて持ち運べるPython環境を作っている。

そのSDカードに入れたPython環境で、いつものようにAtomを起動し、Web上にあったいくつものScriptをコピペして試してみる。

まず、OpenCVで「ハフ変換」なるものを利用する例だが、ハフ変換はノイズの除去で苦労しそうだ。ノイズの発生源が多数存在する解答用紙の矩形検出でパラメータを適切に設定することが果たしてできるだろうか？ 経験がない自分にはちょっと厳しそうだ。

次に、LSD（Line Segment Detectorの略とのこと）という直線検出器を試した。試した瞬間、（もう、これしかない！）と思うほど、これは凄かった。使い方も超カンタンで、LSDをこれでもか！とばかりに並べるだけ。

from pylsd.lsd import lsd
Mylines = lsd(picture)

【検出結果】

さらに驚くべきことに、こういう作業には付き物の引数も一切ない。つまり、パラメータを調整する必要など『ない』ということなのだろう･･･。ただ、LSDはそのライセンス形態がAGPLであると知り、使用を断念。MITやBSDでないと自分的にはやはり困る･･･。

最後に試したのが、OpenCVのfindContours関数。これを使うには前処理として、まず、画像をグレースケールに変換し、さらに白黒反転させて二値化しなければならない。

import cv2
import numpy as np
from PIL import Image

# Pillowで画像ファイルを開く（全角文字対応の確認用にファイル名は「ひらがな」）
pil_img = Image.open("./img/さんぷる.jpg")
# PillowからNumPyへ変換
img = np.array(pil_img)

# グレースケールに変換する
gray = cv2.cvtColor(img, cv2.COLOR_BGR2GRAY)

# 白黒を反転
gray = 255 - gray
# 2値化する
ret, bin_img = cv2.threshold(gray, 20, 255, cv2.THRESH_BINARY)

Pillowで画像ファイルを開いているのは、OpenCVのimread関数が日本語（全角文字）に対して拒絶反応を示すので、これを回避するため。もし、ファイル名とそこまでのPathに全角文字が含まれないという確実な保証があるなら、次のようにしてもいいようだ。これなら１行で済む。

# 8ビット1チャンネルのグレースケールとして画像を読み込む
img = cv2.imread("全角文字のないPathと画像ファイル名", cv2.IMREAD_GRAYSCALE) 

で、準備が出来たらfindContours関数を使って輪郭を検出する。

# すべての輪郭を同じ階層として取得する
contours, hierarchy = cv2.findContours(bin_img, cv2.RETR_LIST, cv2.CHAIN_APPROX_SIMPLE)

解答欄には、その性格上、小さな矩形が多く使われることが多いので、閾値以下の面積の矩形は削除する。※ 閾値は整数型の数値で指定する。

# 閾値以下の面積の矩形（小さい輪郭）は削除
contours = list(filter(lambda x: cv2.contourArea(x) > 閾値, contours))

よりスムーズに作業するためには、予め、小さな矩形を消去した機械読み取り用の解答欄（解答用紙）をヒト用の解答用紙のコピーから作成し、これを用いて解答欄座標を取得した方がよい（国語の縦書き解答用紙は、ワープロソフトではなく、表計算ソフトで作成する方法が業界では一般的らしいので、機械読み取り用の解答用紙はそれほど手間をかけなくても、カンタンに作成できる･･･はず）。

解答欄矩形をちゃんと認識できているか・どうかを確認するため、検出した輪郭を描画する。このPythonのスクリプトをDelphiのObject Pascalに埋め込んで実行する際は、ここが最大の「見せ場」になる。検出した矩形をグラブハンドル付きのラバーバンドで表示する方法は後述。

# 検出した輪郭を描画する
cv2.drawContours(img, contours, -1, color=(0, 0, 255), thickness=2)

最後に解答欄矩形の座標を取得する（これが最終的な目標）。取得した座標は、採点順になるよう、並べ替えて表示する（並べ替え方法は後述）。

# 矩形の座標を表示（左上の座標, 右下の座標）
for i in range(len(contours)):
    x, y, w, h = cv2.boundingRect(contours[i])
    print(str(x)+','+str(y)+','+str(x+w)+','+str(y+h))

数値より、画像（絵）で見た方がわかりやすいのは言うまでもない。

# 保存
cv2.imwrite('./img/lined.jpg', img)
# 画像を表示
cv2.imshow("Image", img)
# キー入力で終了
cv2.waitKey()

ここまでの Python Script をまとめて示せば、次の通り。

import cv2
import numpy as np
from PIL import Image

# Pillowで画像ファイルを開く
pil_img = Image.open("./img/さんぷる.jpg")
# PillowからNumPyへ変換
img = np.array(pil_img)

# グレースケールに変換する
gray = cv2.cvtColor(img, cv2.COLOR_BGR2GRAY)
# 白黒を反転
gray = 255 - gray
# 2値化する
ret, bin_img = cv2.threshold(gray, 20, 255, cv2.THRESH_BINARY)

# すべての輪郭を同じ階層として取得する
contours, hierarchy = cv2.findContours(bin_img, cv2.RETR_LIST, cv2.CHAIN_APPROX_SIMPLE)

# 閾値以下の面積の矩形（小さい輪郭）は削除
contours = list(filter(lambda x: cv2.contourArea(x) > 数値, contours))

# 検出した輪郭を描画する
cv2.drawContours(img, contours, -1, color=(0, 0, 255), thickness=2)

# 矩形の座標を表示（左上の座標, 右下の座標）
for i in range(len(contours)):
    x, y, w, h = cv2.boundingRect(contours[i])
    print(str(x)+','+str(y)+','+str(x+w)+','+str(y+h))

# 保存
cv2.imwrite('./img/lined.jpg', img)
# 画像を表示
cv2.imshow("Image", img)
# キー入力で終了
cv2.waitKey()

OpenCVのfindContours関数を使って検出した輪郭（＝解答欄の矩形）の例。
（解答用紙画像はLSDを試した時と同じものを使用）

解答用紙中の ■ や □ を検出しないよう、検出下限の閾値を設定したこともあり、期待した通りの満足できる結果が得られた。OpenCVのハフ変換や、LSDでは日本語に対する反応が見られたが、findContours関数は（適切な閾値を設定してあげれば）日本語に反応しないようだ。

答案の「答」には「口」、問にも「口」、漢字にはたくさんの矩形が使われている。適切な閾値を設定することで、誤認識を減らせることも理想的。

【実験してみた！】

閾値を「700」として、□ に対する反応を実験して確認した。結果は次の通り。

28ポイントの「□」から反応するが、40ポイントの「問」には無反応。通常使用される解答用紙であれば、フォントの大きさに制限を設ける必要性はなさそう。

もう少し細かい矩形を使った解答用紙で、閾値700で実験すると･･･

閾値1400までは･･･

閾値を1500にすると･･･

少し、細かい矩形を用いた解答用紙であれば、閾値1500くらいから試せば狙った通りに解答欄の座標だけを取得することができそうだ。

閾値に上限を設定すれば、さらに良い結果を得られるかも･･･と思ったが、数学の解答用紙には他の教科ではあり得ない巨大な矩形が普通に使用される。矩形を取得できなければ、検出器とは言えない。さらに、解答欄全体を一つの大きな矩形として認識してしまうのはプログラムの性格上、絶対に回避できないから、閾値の上限は設けずに、むしろ、不要な矩形の座標を削除しやすいプログラム（GUIを作成）を書けばいいと気づく。

さらに、ユーザーが矩形座標の編集（修正）を自由にできるようにプログラムを工夫すれば、理想的な矩形検出器ができるはず。

これでDelphiでGUIを作成する際の方向性も見えてきた。

２．字数制限のある解答欄の作り方

解答欄の矩形を検出する上で、大きなハードルになるだろうと予想していたのが『字数制限が設定された解答欄』。

上の解答用紙は、ヒト用の解答用紙の問題番号部分にあった小さな矩形を消去して、機械読み取り処理用に作成した解答用紙。この状態で矩形を検出（閾値1500）すると･･･

閾値を「3100」に設定して、ようやく･･･

閾値を大きく設定すれば、何とかなることは上の例でわかったが、閾値を大きくすれば当然必要な解答欄の座標を取得できなくなる可能性も生じてくるわけで･･･。

ところが別の国語用解答用紙を処理している際に、閾値を気にせずに字数制限のある解答欄を作成する良い方法があることを偶然発見。それは･･･

字数制限を設定したり、完全解答で正解としたい解答欄は内側の罫線を点線にする！

これなら問題２の（１）・（２）が作る大きな矩形の座標のみ削除すればOK！
点線を活用することで、一番大きな問題を難なくクリアできることが判明。
やったー☆

【embeddable Pythonのバージョンとインストールしたライブラリの一覧】

Python 3.9.9

Package Version
numpy 1.21.5
opencv-python 4.5.4.60
Pillow 9.3.0
pip 22.3.1
setuptools 60.1.0
wheel 0.37.1

３．GUIはDelphiで作成

取得した解答欄の座標を編集するGUIはDelphiで作成。最終的にはこうなった。

画面下の「操作」グループ内のVCLを左から右へ順にクリックして行けば、解答用紙画像から解答欄の矩形が取得・表示できる仕組み。

取得した解答欄矩形の座標は、画面右上に一覧形式で採点順に表示されるようにプログラミングした。

横書き答案が指定された場合は、ｙ座標の値が昇順になるよう並べ替え（ｙ座標が同じなら、ｘ座標でさらに昇順に並べ替え）。

縦書き答案が指定された場合は、ｘ座標の値が降順になるよう並べ替え（ｘ座標が同じなら、ｙ座標でさらに昇順に並べ替え）。

こうすれば、座標の並び方が「ほぼ採点する順番になる」はず。なお、並べ替えはカンマで区切った解答欄矩形の座標を入れたStringListを対象として実行（解答欄数は多くても100未満のはず･･･だから、並べ替えの速度はまったく考えていない）。そのアルゴリズムは次の通り。まず、グローバルに使う変数、ソート用のプロパティと関数を準備。

  private
    { Private 宣言 }
    x1,x2:integer;
    y1,y2:integer;
    //Pythonから送られたデータを保存する
    strAnsList:TStringList;

var
  Form1: TForm1;

type TSStyle = (ssText,ssInteger);
var
  //ソート用のプロパティ
  fAscending : Boolean;
  fIndex : Integer; //項目番号
  fStyle : TSStyle; //テキストか整数か

implementation

uses
  System.UITypes;

function GetCommaText(aStr:String; aIndex:Integer):string;
  var
    subList:TStringList;
begin
  subList := TStringList.Create;
  subList.Delimiter := ',';
  subList.DelimitedText := aStr;
  Result := subList.Strings[aIndex];
  subList.Free;
end;

function MyCustomSort(List: TStringList; Index1, Index2: Integer): Integer;
begin
  case fStyle of
    ssText:begin
      Result:=CompareText(GetCommaText(List.Strings[Index1],
      fIndex),
      GetCommaText(List.Strings[Index2],fIndex));
    end;
    ssInteger:begin
      //一重ソート
      //Result:=StrToInt(GetCommaText(List.Strings[Index1],fIndex))
      //          -StrToInt(GetCommaText(List.Strings[Index2],fIndex));
      //二重ソート
      Result:=StrToInt(GetCommaText(List.Strings[Index1],fIndex))
                -StrToInt(GetCommaText(List.Strings[Index2],fIndex));
      if Result=0 then
        //-1することで１番目の項目がソートキーになる
        Result:=StrToInt(GetCommaText(List.Strings[Index1],fIndex-1))  
                  -StrToInt(GetCommaText(List.Strings[Index2],fIndex-1));
      if fAscending then
      begin
        Result:=Result*-1;
      end else begin
        Result:=Result*1;
      end;
    end;
  else
    //これを入れておかないとコンパイラが警告を表示する
    Result:=0;
  end;
end;

で、「解答欄座標を取得」ボタンがクリックされたら、PythonForDelphiを通じてPythonのScriptを内部的に実行して座標を取得し、上記関数を呼び出して並べ替えを実行、結果をMemo2に表示する。

procedure TForm1.btnGetSquareClick(Sender: TObject);
var
  //PythonのScriptを入れる
  strScrList:TStringList;
  //Pythonから送られたデータを保存する -> グローバル変数化
  //strAnsList:TStringList;
  //Sort
  i:integer;
  strFileName:string;
  strList:TStringList;
begin
  //初期化
  Memo1.Clear;
  //Scriptを入れるStringList
  strScrList:=TStringList.Create;
  //結果を保存するStringList
  strAnsList:=TStringList.Create;

  try
    //Python Script
    strScrList.Add('import cv2');
    strScrList.Add('import numpy as np');
    //strScrList.Add('img = cv2.imread("./ProcData/sample2.jpg")');
    strScrList.Add('img = cv2.imread(r"./ProcData/'+ExtractFileName(StatusBar1.SimpleText)+'")');
    strScrList.Add('gray = cv2.cvtColor(img, cv2.COLOR_BGR2GRAY)');
    strScrList.Add('gray = 255 - gray');
    strScrList.Add('ret, bin_img = cv2.threshold(gray, 20, 255, cv2.THRESH_BINARY)');
    strScrList.Add('contours, hierarchy = cv2.findContours(bin_img, cv2.RETR_LIST, cv2.CHAIN_APPROX_SIMPLE)');
    strScrList.Add('contours = list(filter(lambda x: cv2.contourArea(x) > '+cmbThreshold.Text+', contours))');
    strScrList.Add('for i in range(len(contours)):');
    strScrList.Add('    im_con = img.copy()');
    strScrList.Add('    x, y, w, h = cv2.boundingRect(contours[i])');
    strScrList.Add('    var1.Value =str(x)+","+str(y)+","+str(x+w)+","+str(y+h)');
    //Scriptを表示
    Memo1.Lines.Assign(strScrList);
    //Execute
    PythonEngine1.ExecStrings(Memo1.Lines);
    //結果を表示
    Memo2.Lines.Assign(strAnsList);
  finally
    //StringListの解放
    strAnsList.Free;
    strScrList.Free;
  end;

  strFileName:=ExtractFilePath(StatusBar1.SimpleText)+'Temp.csv';
  Memo2.Lines.SaveToFile(strFileName);

  strList := TStringList.Create;
  try
    for i := 0 to Memo2.Lines.Count-1 do
    begin
      strList.Add(Memo2.Lines[i]);
    end;
    //fAscending := True; //昇順で
    fAscending := False;
    fIndex := 1; //２番目の項目を
    fStyle := ssInteger; //整数型でソート
    strList.CustomSort(MyCustomSort); //ソート
    //データ抽出
    Memo2.Clear;
    for i := 0 to strList.Count - 1 do
    begin
      //Memo2.Lines.Add(GetCommaText(strList.Strings[i],fIndex));
      Memo2.Lines.Add(strList[i]);
    end;
  finally
    strList.Free;
  end;

end;

上記のアルゴリズムは、次のWebサイトに紹介されていた情報を元に作成。
カンマ区切りのデータの並べ替えは初めて行った。採点順に座標を並べたかったので、プログラムコードをよく読んで、二重ソートになるよう工夫した。
貴重な情報を投稿してくださった方に心から感謝申し上げます。

[delphi-users:1175] カンマ区切りのデータの並べ替え

https://groups.google.com/g/delphi-users/c/Ck2mQXNFTvw

４．矩形検出器の使い方

ここまでの操作で解答欄の座標はすべて取得できたはずなので、不要な矩形のデータをいかに効率よく削除するかを主眼に、GUIの操作方法を考えた。

まず、取得できた座標データの先頭にセットフォーカスし、そのデータが示す矩形を赤いラバーバンドで囲んで表示する。ユーザーは、ラバーバンドで囲まれた矩形を見て、その要・不要を判断。

不要な矩形であった場合は、「編集」ボタンをクリック。不要なデータを自動で選択状態に設定。

手続きは次の通り。

procedure TForm1.BitBtn1Click(Sender: TObject);
var
  i:integer;
begin

  //行番号をLines[i]で取得
  i:=StrToInt(LBRow.Caption)-1;

  EditTF:= not EditTF;
  if EditTF then
  begin
    BitBtn1.Caption:='編集中';
    BitBtn1.Font.Color:=clRed;
    Memo2.ReadOnly:=False;
    btnSave.Enabled:=False;

    //i行目の文字全てを選択状態にしたい場合
    //先頭にカーソルをセット
    Memo2.SelStart:=Memo2.Perform(EM_LINEINDEX, i, 0);
    //全ての文字を選択
    Memo2.SelLength:=Length(WideString(Memo2.Lines[i]));
    //Memo2.Perform(WM_VSCROLL,SB_TOP,0); //先頭にスクロール

  end else begin

    BitBtn1.Caption:='編　集';
    BitBtn1.Font.Color:=clBlack;
    Memo2.ReadOnly:=True;
    Memo2.SelStart:=SendMessage(Memo2.Handle,EM_LineIndex,i,0);
    btnSave.Enabled:=True;
    Memo2Click(Sender);

  end;

  //SetFocus
  Memo2.SetFocus;

end;

Delete or Backspaceキーで不要なデータを削除すると同時に、Memoの行も削除する。で、ボタンを「編集」（＝意味的には「編集したい場合はクリックせよ」）に戻す。次のデータをラバーバンドで囲む。この一連の動作がすべて自動的に流れ作業で行われるように手続きを作成。

コードは次の通り。

procedure TForm1.Memo2KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
var
  LineNo:integer;
begin
  //現在、カーソルがある行を取得
  LineNo:=Memo2.Perform(EM_LINEFROMCHAR, UINT(-1), 0);
  //空欄なら行を削除
  if Memo2.Lines[LineNo]='' then
  begin
    Memo2.Lines.Delete(LineNo);
  end;
  //表示
  GetLinePos;
  if not EditTF then
  begin
    Memo2Click(Sender);
  end else begin
    BitBtn1Click(Sender);
  end;
end;

procedure TForm1.GetLinePos;
var
  CurPos,Line:Integer;
begin
  with Memo2 do
  begin
    CurPos:=SelStart;
    Line:=Perform(EM_LINEFROMCHAR, CurPos, 0);
    //LBRowは現在フォーカスがある行番号を表示するラベル
    LBRow.Caption:=Format('%d', [Line+1]);
    LBRow2.Left:=LBRow.Left+LBRow.Width;
    LBRow2.Caption:='行目';
  end;
end;

procedure TForm1.Memo2Click(Sender: TObject);
var
  i:integer;
  p1,p2:TPoint;

  function RemoveToken(var s:string;delimiter:string):string;
  var
    p:Integer;
  begin
    p:=Pos(delimiter,s);
    if p=0 then Result:=s
    else Result:=Copy(s,1,p-1);
    s:=Copy(s,Length(Result)+Length(delimiter)+1,Length(s));
  end;

  function GetTokenIndex(s:string;delimiter:string;index:Integer):string;
  var
    i:Integer;
  begin
    Result:='';
    for i:=0 to index do
      Result:=RemoveToken(s,delimiter);
  end;

begin

  if not EditTF then
  begin

    //座標を取得
    i:=Memo2.Perform(EM_LINEFROMCHAR, Memo2.SelStart, 0);

    //エラー対策
    if Memo2.Lines[i]='' then Exit;

    x1:=StrToInt(GetTokenIndex(Memo2.Lines[i],',',0));
    y1:=StrToInt(GetTokenIndex(Memo2.Lines[i],',',1));
    x2:=StrToInt(GetTokenIndex(Memo2.Lines[i],',',2));
    y2:=StrToInt(GetTokenIndex(Memo2.Lines[i],',',3));

    if Assigned(plImage1) then begin
      FreeAndNil(plImage1);
    end;

    //コンポーネントを生成し，イベントを定義し，位置を指定して画像を表示
    plImage1:=TplResizeImage.Create(Self);
    plImage1.Parent:=ScrollBox1;
    plImage1.TransEvent:=True;
    //クライアント座標をスクリーン座標へ変換
    //GetSystemMetrics(SM_CYCAPTION) -> タイトルバーの高さ
    //GetSystemMetrics(SM_CYFRAME) -> ウィンドウの枠幅
    p1.X:=x1-(GetSystemMetrics(SM_CYFRAME) div 2);
    p1.Y:=y1-GetSystemMetrics(SM_CYCAPTION)-(GetSystemMetrics(SM_CYFRAME) div 2);
    p2.X:=x2-(GetSystemMetrics(SM_CYFRAME) div 2);
    p2.Y:=y2-GetSystemMetrics(SM_CYCAPTION)-(GetSystemMetrics(SM_CYFRAME) div 2);
    p1:=Image1.ClientToScreen(p1);
    p2:=Image1.ClientToScreen(p2);
    plImage1.SetBounds(p1.X, p1.Y, p2.X-p1.X, p2.Y-p1.Y);

    //SelectedプロパティをTrueにするとラバーバンドとグラブハンドルが表示される
    plImage1.Selected := True;
    plImage1.BringToFront;

  end;

end;

ラバーバンドはMr.XRAYさんのWebサイトにあったplResizeImageを使わせていただいて作成。これまでにもどれだけ助けていただいたことか･･･。このような素晴らしい素材を提供し続けてくださっているMr.XRAYさんに今回も心から感謝申し上げます。

157_移動リサイズ可能な TImage   ラバーバンドとグラブハンドル

http://mrxray.on.coocan.jp/Delphi/plSamples/157_MoveResize_GrabHandle.htm

ラバーバンドで囲まれた矩形が必要な矩形であった場合は、下のMemo3へ「移動」ボタンをクリックしてデータを移す。で、次の矩形をラバーバンドで囲んで表示する。

この作業を順次繰り返すと、最終的に必要な矩形の座標のみがMemo3に移動。不要な矩形の座標はすべて削除されることになる。

最終的に過不足がないか・どうか、Memo3の先頭座標データをクリック、ラバーバンドで該当矩形を囲んで表示、下向きの矢印キーを次へ次へと押して、フォーカスを下の座標データへ移動、ラバーバンドを表示して確認、これを最後の座標データまで繰り返し。

必要な座標がすべて取得できていることを確認したら、「保存」ボタンをクリックして手書き答案採点ソフトが実行時に読み込む、様々な採点設定を記録するための iniファイルに解答欄の座標データを保存する。

【任意の範囲を指定したい場合】

複数の解答欄を抱き合わせて、完全解答で正解としたい場合などに対応するため、任意の範囲を矩形選択できるようにした。

画面中央左の追加ボタンをクリックすると、画面の中央にラバーバンドが表示される。これを任意の位置へドラッグする。

ボタンのCaptionは、自動で「取得」に変更。

任意の範囲をラバーバンドで囲んだら（＝範囲指定完了）、「取得」ボタンをクリック。取得された座標がボタンの右のEditに表示され、同時にクリップボードへ送られる。

Memo3上の「追加」ボタンをクリックすると、Memo3が編集可能になるので、採点順を確認して、適切な行に座標のデータを追加（クリップボードから貼り付けても、データを見ながら手動入力してもよい）。

ラバーバンドを使わなくても、解答欄の左上と右下を、それぞれポイントすればその座標をラベルに表示する機能も追加したので、上の図のように、Memo3を編集モードにして、座標を任意の行へ直接入力することも可能。

クライアント座標の取得と表示を行う手続きは、次の通り。

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  PtInput:TPoint;
begin
  //スクリーン座標を取得
  GetCursorPos(PtInput);
  //で、そのコントロールのクライアント領域に対するカーソルの座標を取得
  PtInput := Image1.ScreenToClient(PtInput);

  //補正する必要はない（確認済み）
  //表示
  Label2.Caption:=
    Format(' クライアント座標  '+'X : %d, Y : %d', [PtInput.X, PtInput.Y]);
end;

【矢印キーの押し下げを拾う】

最も難しかったのが、フォーカスが「どこにあるか」で矢印キーの挙動を制御すること。以前にStringGridのセルのフォーカスの移動を制限した時に学んだ内容が今回も役に立った。

Disable left and right arrow keys on StringGrid

今回は、Memoにフォーカスがある場合と、ラバーバンドにフォーカスがある場合、さらにラバーバンドにフォーカスがある場合のうち、Shiftキーと同時に矢印キーが押し下げられているのか（＝ラバーバンドの大きさの変更）、それとも矢印キーが単独で押し下げられているのか（＝ラバーバンドの表示位置の移動）、この３パターンを見分けてそれぞれにあった動作を行わせたいと考えた。最終的には次のコードで対応。

  private
    { Private 宣言 }

    //ある（矢印他）キーが押されたことを知る
    procedure AppMessage(var Msg: TMsg; var Handled: Boolean);

上のように手続きを宣言して、Shift＋Ctrl＋Cで手続きを生成。

procedure TForm1.AppMessage(var Msg: TMsg; var Handled: Boolean);
var
  StrText: string;
begin
  //何かキーが押し下げられたら
  if Msg.message = WM_KEYDOWN then
  begin
    try
      if ActiveControl is TMemo then
      begin
        //キー操作を「通常動作」にするおまじない
        case Msg.Message of
          WM_USER + $0500:
          Handled := True;
        end;
      end else begin
        //上位ビットが1ならShiftキーが押されている
        if GetKeyState(VK_SHIFT) and $8000 <> 0 then
        begin
          if plImage1.Visible then
          begin
            //右矢印キー
            if Msg.wParam=VK_RIGHT then
            begin
              plImage1.Width := plImage1.Width + 1;
              Msg.wParam:=0;
            end;
            //左矢印キー
            if Msg.wParam=VK_LEFT then
            begin
              plImage1.Width := plImage1.Width - 1;
              Msg.wParam:=0;
            end;
            //上矢印キー
            if Msg.wParam=VK_UP then
            begin
              plImage1.Height := plImage1.Height - 1;
              Msg.wParam:=0;
            end;
            //下矢印キー
            if Msg.wParam=VK_DOWN then
            begin
              plImage1.Height := plImage1.Height + 1;
              Msg.wParam:=0;
            end;
          end;
        end else begin
          //Shiftキーは押されていない
          //対象を限定（どちらでも動いた）
          //if TplResizeImage(ActiveControl).Visible then
          if plImage1.Visible then
          begin
            //右矢印キー
            if Msg.wParam=VK_RIGHT then
            begin
              plImage1.Left := plImage1.Left +1;
              Msg.wParam:=0;
            end;
            //左矢印キー
            if Msg.wParam=VK_LEFT then
            begin
              plImage1.Left := plImage1.Left -1;
              Msg.wParam:=0;
            end;
            //上矢印キー
            if Msg.wParam=VK_UP then
            begin
              plImage1.Top := plImage1.Top - 1;
              Msg.wParam:=0;
            end;
            //下矢印キー
            if Msg.wParam=VK_DOWN then
            begin
              plImage1.Top := plImage1.Top + 1;
              Msg.wParam:=0;
            end;
            //Deleteキー
            if Msg.wParam=VK_DELETE then
            begin
              //plImage1を解放
              if Assigned(plImage1) then begin
                FreeAndNil(plImage1);
              end;
              Msg.wParam:=0;
            end;
          end;
        end;
      end;
    except
      on E: Exception do
      begin
        StrText := E.ClassName + sLineBreak + E.Message;
        Application.MessageBox(PChar(StrText), '情報', MB_ICONINFORMATION);
      end;
    end;
  end;
end;

plImage1が生成されないうちに上の手続きが呼ばれると、当然、一般保護違反のエラーが発生するので、FormCreate時にplImage1を生成しておく。

procedure TForm1.FormCreate(Sender: TObject);
var
  //Python39-32へのPath
  AppDataDir:string;
  i:integer;
begin

  //メモリーリークがあれば検出
  ReportMemoryLeaksOnShutdown:=True;

  //有効にする（忘れないこと！）
  Application.OnMessage := AppMessage;

  //[Enter]でコントロールを移動させるために、Form上のコンポーネント
  //より先にFormがキーボードイベントを取得する。
  KeyPreview:=True;

  //コンポーネントを生成 -> インスタンス（実体）をつくる
  // = 一般保護違反エラーの防止
  //plImage1はグローバル変数として宣言しているから未定義の識別子エラーは発生しない
  //でも、Create（生成）してからでなければ使えない！
  plImage1:=TplResizeImage.Create(Self);

  //編集フラグ（編集中ではない）
  EditTF:=False;
  PlusTF:=False;
  Memo2.ReadOnly:=True;

  //StatusBar1の設定
  StatusBar1.SimplePanel:=True;

  //Formを最大化して表示(幅も最大化される)
  Form1.WindowState:=wsMaximized;

  //Embeddable Pythonの存在の有無を調査
  AppDataDir:=ExtractFilePath(Application.ExeName)+'Python39-32';
  if DirectoryExists(AppDataDir) then
  begin
    //フォルダが存在したときの処理    
    PythonEngine1.AutoLoad:=True;
    PythonEngine1.IO:=PythonGUIInputOutput1;
    PythonEngine1.DllPath:=AppDataDir;
    PythonEngine1.SetPythonHome(PythonEngine1.DllPath);
    PythonEngine1.LoadDll;
    //PythonDelphiVar1のOnSeDataイベントを利用する
    PythonDelphiVar1.Engine:=PythonEngine1;
    PythonDelphiVar1.VarName:=AnsiString('var1');  //プロパティで直接指定済み
    //初期化
    PythonEngine1.Py_Initialize;
  end else begin    
    PythonEngine1.AutoLoad:=False;
  end;

  //面積の閾値の選択肢を設定
  for i := 1 to 200 do
  begin
    cmbThreshold.Items.Add(IntToStr(i*100));
  end;

  //画面のちらつきを防止する
  DoubleBuffered := True;

end;

で、メモリーリーク発生の原因とならないよう、アプリの終了時に忘れずに解放。

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  //メモリーリークを防止する
  PythonEngine1.Py_Finalize;
  PythonDelphiVar1.Finalize;
  FreeAndNil(plImage1);
end;

５．まとめ

（１）矩形の検出は、OpenCVのfindContours関数を利用する。
（２）矩形の検出を回避するには「点線」を利用する。
（３）GUIはDelphiで作成し、必要な座標だけ保存できるように工夫。
（４）「フォーカスがどこにあるか」で矢印キーの動作を制御。
（５）コントロール生成のタイミングと確実な破棄にも注意する。

６．お願いとお断り

このサイトの内容を利用される場合は、自己責任でお願いします。記載した内容を利用した結果、利用者および第三者に損害が発生したとしても、このサイトの管理者は一切責任を負えません。予め、ご了承ください。