赤い枠囲み部分をクリック（ショートカットを利用するなら Ctrl + Shift + X を実行）して、検索バーを表示し、Japanese Language pack と入力するだけで自動的に検索が実行され、表示された検索結果の上のほうにある Japanese Language Pack for VS Code をクリックすると、その右側に Install ボタンが表示されるので、こちらをクリックしてインストールを実行します。
下記の不具合は、５月２９日現在、修正し、解消されています。マークシート側で「配点」を１回クリックして Check を ON にして採点データを読み込んでいただければ、マークシートの採点結果と手書き答案の採点結果の両方を表示した採点結果通知シートが印刷できると思います。ご迷惑をおかけした皆さま、誠に申し訳ありませんでした。
一般的に使用されている複合機のスキャナーでスキャンした PDF ファイルは、Jpeg 画像のコンテナのような形式で作成されていることが多いと聞き、MS_Reader V3 には、そのような PDF ファイルであった場合、Jpeg 画像を抽出する機能も搭載しましたが、様々なスキャナーで作成されたPDF ファイルを入手し、必要十分な動作テストを行うことは私の環境では不可能でありますので、この PDF ファイルから Jpeg 画像を抽出しての処理は、その可否をご確認の上、可の場合でも必要十分な動作テストを実施後にご利用ください。
なお、筆者の職場にあります E 社製複合機のスキャナーで解像度 200 dpi、カラー、PDF を指定して読み込んだデータを用いた動作検証を行い、プログラムが意図した通りに動作することを確認しましたことを申し添えます。
一般的に使用されている複合機のスキャナーでスキャンした PDF ファイルは、Jpeg 画像のコンテナのような形式で作成されていることが多いと聞き、MS_Reader V3 には、そのような PDF ファイルであった場合、Jpeg 画像を抽出する機能も搭載しましたが、様々なスキャナーで作成されたPDF ファイルを入手し、必要十分な動作テストを行うことは私の環境では不可能でありますので、この PDF ファイルから Jpeg 画像を抽出しての処理は、その可否をご確認の上、可の場合でも必要十分な動作テストを実施後にご利用ください。
なお、筆者の職場にあります E 社製複合機のスキャナーで解像度 200 dpi、カラー、PDF を指定して読み込んだデータを用いた動作検証を行い、プログラムが意図した通りに動作することを確認しましたことを申し添えます。
Windows の OpenCV は Visual C++ でビルドされており、そのビルドに使われた特定バージョンのVisual C++ ランタイム DLL がシステムフォルダに存在しない場合、OpenCV が起動できないため、vcredist でその DLL を所定の場所にインストールする必要があります。
同梱のマークシートメーカーは PDF ファイルの出力に Skia を使用しています。Skia のライセンスは MIT ライセンスです。このライセンスの詳細につきましては、マークシートメーカーのフォルダに同梱した Skia4Delphi_and_Skia_LICENSE.txt をご覧ください。マークシートメーカーの使い方の詳細については、当 Blog の過去記事をご参照ください。
AI にコードを書いてもらって、それを試してみる時など、「絶対に動く」保証などどこにもありませんから「現在、不満を抱えつつも or 不備を内包しつつも、捨てるに捨てられない procedure / function はとりあえずコメント化」して、その上か下に（私は下ですが） AI が書いてくれたコードを貼り付けて試す･･･みたいなことを、どなた様も普通におこなっていらっしゃる今日この頃のではないかと思うのですが、その際問題になるのがコメント化の方法です。Delphi のコメント化の場合、もちろん使用するのは、それが１行、２行なら // で、それが複数行にわたる場合は皆さま { } だと思うのですが、
タイトル名でマークシート設定を管理（ INI ファイルに保存＆呼び出し）しますので、教科 or 科目の名称、考査の時期、日付等を入れておくと管理しやすいのではないかと思います。Edit コントロールへ入力すると同時にマークシートの描画も更新されます。入力確定後、再度 Enter キー押し下げで、次のコントロールへフォーカスが移動します。
新しく作成中のマークシートリーダーでも、もちろん、この大語群対応マークシートが読めるようにしてありますが、まだ実際の試験で使用して問題がないかどうかの確認を行っていませんので、現時点での公開はできませんが、この Blog で過去に公開してきたマークシートリーダーより、読み取り速度は比較にならないくらい高速化することに成功しています。設定によりますが、輪郭検出を最初の１枚のみに限定した場合で、私の PC では、１秒間に約47,500マークを読み取り可能です。
設定の保存ボタンをクリックすると、現在表示されているマークシートの設定が exe と同じ場所に自動的に作成される INI ファイル内に「タイトル名をセクション名として」保存されます。次回、プログラムを起動する際、プログラムは自動的に INI ファイル内のセクション名を取得して、タイトルを表示する ComboBox の選択肢に設定します。
セクションの削除と、画面の表示は、『連動しない仕様』としてある点にご注意願います。
例えば、「情報Ⅰ」と「情報Ⅱ」の２種類のマークシート設定があり、「情報Ⅱ」を表示している状態で「情報Ⅱ」のセクションを INI ファイルから削除したとします。
上のリンク先『ダウンロードとプロダクト キー』へ行き、表示される画面の左側の『Developer Tools』に『Visual Studio 2022』（リンク）をクリック。
表示されたページの中ほどに「Visual C++ Redistributable for Visual Studio 2022」があるので、その右側の ComboBox みたいな部分で x64 を x86 に変更して『ダウンロード』ボタンをクリック。
「Visual C++ Redistributable for Visual Studio 2022」は「VC_redist.x86.exe」で保存されました。これをインストールすると、2015 以降のランタイム（2015, 2017, 2019, 2022）は統合されているため、「Visual C++ 2015 Redistributable」も含まれてインストールされるようです。
private
{ Private 宣言 }
FBitmap: TBitmap;
// Rubber band
FRubberBandActive: Boolean;
・・・（省略）・・・
function ScreenToImagePoint(X, Y: Integer): TPoint;
で、次のように記述。
function TForm1.ScreenToImagePoint(X, Y: Integer): TPoint;
begin
Result.X := Round(X / FZoom);
Result.Y := Round(Y / FZoom);
end;
次は、PointInRectInclusive 関数を作成。まず宣言して、
private
{ Private 宣言 }
・・・（省略）・・・
function ScreenToImagePoint(X, Y: Integer): TPoint;
function PointInRectInclusive(const R: TRect; const P: TPoint): Boolean;
Shift＋Ctrl＋C して、次のように記述する。
function TForm1.PointInRectInclusive(const R: TRect; const P: TPoint): Boolean;
begin
Result :=
(P.X >= R.Left) and (P.X <= R.Right) and
(P.Y >= R.Top) and (P.Y <= R.Bottom);
end;
function TForm1.GetHandleAtPosImg(const P: TPoint): THandlePos;
const
HSIZE = 8;
var
cx: Integer;
begin
Result := hpNone;
// Top
cx := (FRubberRect.Left + FRubberRect.Right) div 2;
if Abs(P.Y - FRubberRect.Top) <= HSIZE then
begin
if Abs(P.X - FRubberRect.Left) <= HSIZE then Exit(hpLeftTop);
if Abs(P.X - FRubberRect.Right) <= HSIZE then Exit(hpRightTop);
if Abs(P.X - cx) <= HSIZE then Exit(hpTop);
end;
// Bottom
if Abs(P.Y - FRubberRect.Bottom) <= HSIZE then
begin
if Abs(P.X - FRubberRect.Left) <= HSIZE then Exit(hpLeftBottom);
if Abs(P.X - FRubberRect.Right) <= HSIZE then Exit(hpRightBottom);
if Abs(P.X - cx) <= HSIZE then Exit(hpBottom);
end;
//Left /Right
if Abs(P.X - FRubberRect.Left) <= HSIZE then Exit(hpLeft);
if Abs(P.X - FRubberRect.Right) <= HSIZE then Exit(hpRight);
end;
次は、CursorFromHandle 関数を宣言。
private
{ Private 宣言 }
・・・（省略）・・・
function CursorFromHandle(H: THandlePos): TCursor;
こちらも Shift＋Ctrl＋C して、次のように記述する。
function TForm1.CursorFromHandle(H: THandlePos): TCursor;
begin
case H of
hpLeft, hpRight:
Result := crSizeWE;
hpTop, hpBottom:
Result := crSizeNS;
hpLeftTop, hpRightBottom:
Result := crSizeNWSE;
hpRightTop, hpLeftBottom:
Result := crSizeNESW;
else
Result := crDefault;
end;
end;
procedure TForm1.UpdateRubberCursor;
begin
if FRubberBandActive then
PaintBox1.Cursor := crCross
else
PaintBox1.Cursor := crDefault;
end;
次は、PaintBox の OnMouseMove 手続きを作成。
オブジェクトインスペクタの OnMouseMove をダブルクリックする。
こちらは、次のように記述する。
procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
curImg: TPoint;
screenPt: TPoint;
dx, dy: Integer;
H: THandlePos;
begin
if not FRubberBandActive then Exit;
curImg := ScreenToImagePoint(X, Y);
//ドラッグ中のみ自動スクロール
if FDragging then
begin
screenPt := PaintBox1.ClientToScreen(Point(X, Y));
AutoScrollIfNeededFromScreen(screenPt);
end;
//矢印キーの形状をより適切に
if not FDragging then
begin
if FHasRubber and PointInRectInclusive(FRubberRect, curImg) then
begin
H := GetHandleAtPosImg(curImg);
if H <> hpNone then
PaintBox1.Cursor := CursorFromHandle(H)
else
PaintBox1.Cursor := crSizeAll; //内部＝移動
end
else
PaintBox1.Cursor := crCross; //ラバーバンド描画モード
Exit;
end;
dx := curImg.X - FStartPointImg.X;
dy := curImg.Y - FStartPointImg.Y;
if FModeMoveSize then
begin
FRubberRect.Offset(dx, dy);
end
else
begin
case FDragHandle of
hpLeftTop:
begin
FRubberRect.Left := curImg.X;
FRubberRect.Top := curImg.Y;
end;
hpTop:
FRubberRect.Top := curImg.Y;
hpRightTop:
begin
FRubberRect.Right := curImg.X;
FRubberRect.Top := curImg.Y;
end;
hpRight:
FRubberRect.Right := curImg.X;
hpRightBottom:
begin
FRubberRect.Right := curImg.X;
FRubberRect.Bottom := curImg.Y;
end;
hpBottom:
FRubberRect.Bottom := curImg.Y;
hpLeftBottom:
begin
FRubberRect.Left := curImg.X;
FRubberRect.Bottom := curImg.Y;
end;
hpLeft:
FRubberRect.Left := curImg.X;
hpNone:
begin
FRubberRect.Right := curImg.X;
FRubberRect.Bottom := curImg.Y;
end;
end;
end;
FStartPointImg := curImg;
NormalizeRect(FRubberRect);
//画像エリアを超えないよう制限
if FRubberRect.Left < 0 then FRubberRect.Left := 0;
if FRubberRect.Top < 0 then FRubberRect.Top := 0;
if FRubberRect.Right > FBitmap.Width then FRubberRect.Right := FBitmap.Width;
if FRubberRect.Bottom > FBitmap.Height then FRubberRect.Bottom := FBitmap.Height;
PaintBox1.Invalidate;
end;
procedure TForm1.EnsureRubberVisible;
var
R: TRect;
p: TPoint;
begin
R := ImageToScreenRect(FRubberRect);
p := PaintBox1.ClientToScreen(Point(R.Left, R.Top));
AutoScrollIfNeededFromScreen(p);
end;
procedure TForm1.UpdateRubberInfo(const Prefix: string);
var
R: TRect;
begin
if not FHasRubber then Exit;
R := FRubberRect;
if Memo1.Lines.Count = 0 then
Memo1.Lines.Add('')
else
Memo1.Lines[Memo1.Lines.Count - 1] := ''; //最終行を書き換える
Memo1.Lines[Memo1.Lines.Count - 1] :=
Format('%sL:%d T:%d W:%d H:%d',
[Prefix, R.Left, R.Top, R.Right - R.Left, R.Bottom - R.Top]);
end;
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if not (FRubberBandActive and FHasRubber) then Exit;
case Key of
VK_LEFT:
if ssShift in Shift then Dec(FRubberRect.Right)
else FRubberRect.Offset(-1, 0);
VK_RIGHT:
if ssShift in Shift then Inc(FRubberRect.Right)
else FRubberRect.Offset(1, 0);
VK_UP:
if ssShift in Shift then Dec(FRubberRect.Bottom)
else FRubberRect.Offset(0, -1);
VK_DOWN:
if ssShift in Shift then Inc(FRubberRect.Bottom)
else FRubberRect.Offset(0, 1);
end;
NormalizeRect(FRubberRect);
PaintBox1.Invalidate;
//ラバーバンドの座標を取得
UpdateRubberInfo('Key ');
end;
現在、Image1上に描画されているラバーバンドの座標を取得するコードです。 ごく一般的な記述では 3-a の座標形式だと思いますが、実際の運用では解答欄の矩形座標を取得し、これを保存する際、印刷やスキャン時のズレの問題を解消するため、画像上の特徴点からの距離で座標を記録するようにしていますので、3-b はその例となっています。
AI と会話しない日がなくなって久しいです。彼（彼女？）は時々間違えることもあるけれど、その間違いを見抜く力さえあれば、Google 先生とあわせて活用することで、調べものにかかる時間と手間を大いに軽減できて、すーぱー Goooooooooooooooooooooood!!← アボガドロ数的感情表現のつもり。
動作テストを重ねるうちに、削除対象文字としてこの TRichEdit に指定した絵文字の数が激増し、それでも（おかしいなー！）と思いつつ都度『新発見絵文字』を気持ち半分喜びながら毎日追加しておりましたが、日々増え行く絵文字列が２行目の折り返しを間近に控えた頃、ようやく『 AI が使用する絵文字の種類は限定されてるに違いない』という自身の強い思い込みが『完全な誤り』であることに気づき（かつ、TRichEdit は絵文字に完全対応ではないみたいな話を AI から聞いたこともあり）、個別にいちいち指定する方式から一括削除する方式に仕様を変更したという、微笑ましくもどこか悲しい、ごく私らしい個人的なエピソードもあります。
「マークダウン表記を平文にする」をチェックした場合は、Form のキャプション（タイトル）が『MarkdownRemover』と表示されますが、チェックを外すと Form のキャプション（タイトル）が『CharSweeper』と変化するのは、用途に応じた必要な機能の提供という部分へのこだわりをタイトル的に表現したものです。名前が変わるプログラムなんて私は見たことがありませんが･･･
AI とチャットした際、その会話内容は AI の方で勝手に保存してくれますが（ただ、過去のチャットの「特定部分」を探すのがエライ面倒なことも多々あり、やはり、自分にとって『走召！』重要な情報は別に保存しておきたいなー！みたいな気が･･･私はしますし）、会話の特定部分を資料的に印刷等して活用したい場合は、どうしてもプレーンテキストでないと困る場合が･･･自分的には･･･ほとんどですと言うか、はっきり言って全部です。
それより何より、Pandoc はライセンスが GPLv2 or later ですので、法的な問題をきちんとクリアしないと Pandoc を利用したアプリケーションはもちろん公開できません。これが最大の理由で、Pandoc の利用を今回はあきらめることにしました。（個人的にはもちろん！試用してみました。デフォルト設定のまま動かしてみたのですが、コードブロックの変換部分で、インデントの処理に独自ルールが適用されるようで、変換結果のプログラミングコードをコピペする際にちょっと困るかもと思いましたが、その他は期待通りに動作しました）
//削除対象として検索する絵文字の範囲
if not (
(code >= $1F600) and (code <= $1F64F) or // 顔文字
(code >= $1F300) and (code <= $1F5FF) or // 天気・場所・物
(code >= $1F680) and (code <= $1F6FF) or // 乗り物・地図
(code >= $2600) and (code <= $26FF) or // 記号
(code >= $2700) and (code <= $27BF) or // その他記号
(code >= $FE00) and (code <= $FE0F) or // 表示スタイル
(code >= $1F900) and (code <= $1F9FF) or // 拡張絵文字
(code >= $1FA70) and (code <= $1FAFF) // Emoji 13以降
) then
このプログラムでは、開始時に音量設定が０でなければ自動消音し、終了時に開始時の音量設定を復元しています。なぜ、そのようにしたかというと、周囲に人がいるような環境では Beep 音が鳴らない方がよいと思ったからです。「入力ミス」などがあった際にユーザーに対して注意喚起するような目的で使われるこの音ですが、一人で PC を使用していてもメッセージが表示された際などに鳴ると結構（私は）気になります。
//Ctrl+Cで選択範囲をクリップボードへ送る
if plImage1.Visible then
begin
//Ctrl + C（Shiftを含まない）のみ許可
if (Key = Ord('C')) and (ssCtrl in Shift) and not (ssShift in Shift) then
begin
//plResizeImage の「クリップボードへ送る」を実行
if Assigned(plImage1.MenuClipboardRef) then
begin
plImage1.MenuClipboardRef.Click;
end;
//ショートカットキーを他に伝播させない
Key := 0;
end;
end;
これで Ctrl + C で、ラバーバンドで囲んだ範囲を、クリップボードへ画像データとして送信できるようになりました。
とにかく、これまでの矩形検出プログラムで解答欄矩形の座標を検出して、採点する順番になるように並び替える際、横書き答案であれば「 Y 座標の値が小さいものから順に、左から右へ並べ替える」アルゴリズムを採用しているため、解答用紙の画像が左へ傾いていると、座標原点 0,0 が左上であるため、右側の解答欄ほど Y 座標の値が小さくなり、検出した座標を並び替える際に「上から下へ」の順番はなんとか守れても、「左から右へ」が「右から左へ」と、「一部の解答欄座標の並びが逆転」してしまうわけです。
以下は、Delphi に埋め込んで使用している「横書き答案の解答欄座標を検出して、採点順に並べ替える」 Python Script です（ダウンロードしていただいた Zip ファイルのサイズが大きいのも、展開に時間がかかるのも、Python 用の OpenCV をバックグラウンドで動作させているためです）。
import cv2
import numpy as np
def imread_unicode(path):
with open(path, "rb") as f:
data = f.read()
img_array = np.frombuffer(data, np.uint8)
return cv2.imdecode(img_array, cv2.IMREAD_COLOR)
def deskew_image(gray):
edges = cv2.Canny(gray, 50, 150, apertureSize=3)
lines = cv2.HoughLines(edges, 1, np.pi / 180, 150)
if lines is None:
return gray
horizontal_angles = []
for rho, theta in lines[:, 0]:
angle_deg = (theta * 180 / np.pi)
if (angle_deg < 10) or (angle_deg > 170):
adjusted_angle = angle_deg if angle_deg < 90 else angle_deg - 180
horizontal_angles.append(adjusted_angle)
if len(horizontal_angles) < 5:
return gray
mean_angle = np.mean(horizontal_angles)
if abs(mean_angle) < 0.3:
return gray
(h, w) = gray.shape
center = (w // 2, h // 2)
M = cv2.getRotationMatrix2D(center, mean_angle, 1.0)
rotated = cv2.warpAffine(gray, M, (w, h), flags=cv2.INTER_LINEAR, borderValue=255)
return rotated
def detect_inner_boxes(image_path):
img_color = imread_unicode(image_path)
if img_color is None:
raise FileNotFoundError(f"画像が見つかりません: {image_path}")
img_gray = cv2.cvtColor(img_color, cv2.COLOR_BGR2GRAY)
thresh = cv2.adaptiveThreshold(
img_gray, 255,
cv2.ADAPTIVE_THRESH_GAUSSIAN_C,
cv2.THRESH_BINARY_INV,
15, 10
)
contours, _ = cv2.findContours(thresh, cv2.RETR_TREE, cv2.CHAIN_APPROX_SIMPLE)
boxes = []
for cnt in contours:
x, y, w, h = cv2.boundingRect(cnt)
if w > ' + cmbThreshold.Text + ' and h > ' + cmbThreshold.Text + ':
boxes.append((x, y, w, h))
inner_boxes = []
for i, box in enumerate(boxes):
x1, y1, w1, h1 = box
rect1 = (x1, y1, x1 + w1, y1 + h1)
contains_other = False
for j, other in enumerate(boxes):
if i == j:
continue
x2, y2, w2, h2 = other
rect2 = (x2, y2, x2 + w2, y2 + h2)
if rect1[0] <= rect2[0] and rect1[1] <= rect2[1] and rect1[2] >= rect2[2] and rect1[3] >= rect2[3]:
contains_other = True
break
if not contains_other:
inner_boxes.append(box)
if not inner_boxes:
return []
y_tolerance = max(5, int(np.median([h for (_,_,_,h) in inner_boxes]) * 0.5))
inner_boxes.sort(key=lambda b: b[1])
sorted_boxes = []
current_row = []
current_y = None
for b in inner_boxes:
x, y, w, h = b
if current_y is None:
current_y = y
current_row.append(b)
elif abs(y - current_y) <= y_tolerance:
current_row.append(b)
else:
current_row.sort(key=lambda b: b[0])
sorted_boxes.extend(current_row)
current_row = [b]
current_y = y
if current_row:
current_row.sort(key=lambda b: b[0])
sorted_boxes.extend(current_row)
inner_boxes = sorted_boxes
for idx, (x, y, w, h) in enumerate(inner_boxes, start=1):
var1.Value = str(x) + "," + str(y) + "," + str(x + w) + "," + str(y + h)
return inner_boxes
if __name__ == "__main__":
image_path = r"' + 'CutImage0' + IntToStr(i) + '.jpg' + '"
boxes = detect_inner_boxes(image_path)
横書き答案で、ブロックの指定が２以上である場合がありますので、この処理を for ループの中に埋め込んでいます。また、この横書きでブロックの指定が２以上である答案の場合には、２ブロック目に検出した座標の値のｘ座標を一律補正するような処理も Delphi 側で必要ですが、核心部分はなんと言っても、上のスクリプトです。思えば、ここに至るまで、はや幾年月･･･
TplResizeImage = class(TImage)
private
FSelected : Boolean;
･･･
if FSelected then begin
Screen.Cursor := crSizeAll;
end else begin
Screen.Cursor := crDefault;
end;
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if Key in [VK_LEFT, VK_RIGHT, VK_UP, VK_DOWN] then
Screen.Cursor := crDefault;
end;
さらに、より確実に動作するよう OnKeyUp イベントにも同じ処理を記述します。
procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
if Key in [VK_LEFT, VK_RIGHT, VK_UP, VK_DOWN] then
Screen.Cursor := crDefault;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
KeyPreview:=True;
end;
これで完璧かと思いましたが、Application.OnMessage を使ってグローバルに押されたキーを監視し、矢印キーが押された場合にはマウスのカーソルをデフォルトに戻す処理も追加しておくことにしました。こちらは構造的な意味でも、保守性を高める意味でも Form のメンバーとして記述します。こうしておけば、何年か経って今日の作業内容を完全に忘れてしまった場合でも、Private 宣言部分を参照すれば、何を設定したのかがわかり、メンテナンスしやすいコードにすることができます。
私は、そのような意味から、手続きだけでなく関数も Form のメンバーとして記述するようにしています。むかしは何でもかんでも Form のメンバーにしていたのですが、この Blog を書くようになってから、他から呼び出す必要のない手続きや関数は、「ネストされた手続き（Nested Procedure）」 または 「ネストされた関数（Nested Function）」 として記述することも多くなりました。コードを読むのと、（ Blog の記事用に）コピペするのが楽だからというのが、その主な理由です。
type
TForm1 = class(TForm)
...
private
//Application.OnMessage を使ったグローバルキー監視
procedure AppMessageHandler(var Msg: TMsg; var Handled: Boolean);
end;
で、Shift + Ctrl + C で手続きを作成し、実装します。
procedure TForm1.AppMessageHandler(var Msg: TMsg; var Handled: Boolean);
begin
case Msg.message of
WM_KEYDOWN, WM_KEYUP:
case Msg.wParam of
VK_LEFT, VK_RIGHT, VK_UP, VK_DOWN:
Screen.Cursor := crDefault;
end;
end;
end;
最後に、FormCreate で登録しました。
procedure TForm1.FormCreate(Sender: TObject);
begin
Application.OnMessage := AppMessageHandler;
end;
これで Form がアクティブ（フォーカスがある）な時も、非アクティブ（フォーカスがない）な時も、常にマウスのカーソルをリセットできるようになったはずです。
余談ですが、このマウスカーソルの形状も含めて画面のハードコピーを取るのはどうしたらいいものかと、今回、少し悩んでしまいました。Windows11の機能のみで行うなら、拡大鏡を固定（？）にして PrintScreen を実行すれば出来るみたいなことを AI が言ってましたが、せっかく Delphi があるんだし、ヒマもあったので、マウスカーソルの形状も含めて画面のハードコピーを取るプログラムを自分で書いてしまいました。後日、機会がありましたら、この Blog でご紹介したいと思います。
こちらの問題も修正しようかとも思いましたが、このプログラムを実行する場合、画面は最大化して作業するのが最も効率がよく、何か他の画面と並べて作業する必要性もないので、Form は常に最大化して表示する設定とし、通常 Form の右上にある最大化及び最小化ボタンは表示しないようにプログラムを変更しました。
また、通常の場合、最大化状態で Form のタイトルバーをクリックしてアクティブにし、そのままタイトルバーをドラッグ＆ドロップすると Window 内の任意の位置へ、設計時の大きさになった Form を移動できますが、上記の理由から、この時やはりラバーバンド位置が解答欄矩形からズレます。これを防止するため、Form のタイトルバーをクリックしてドラッグ＆ドロップする機能は無効化しました。
この Form の設定に使用したコードは、以下の通りです。
private
//最初に１回だけ設定を実行するための確認フラグ
F_FormActivated: Boolean;
//タイトルバーは残したまま「最大化解除できない」ように設定
procedure WMSysCommand(var Msg: TWMSysCommand); message WM_SYSCOMMAND;
procedure WMNCLButtonDown(var Msg: TWMNCLButtonDown); message WM_NCLBUTTONDOWN;
procedure TForm1.FormCreate(Sender: TObject);
begin
//Formの最大化ボタン及びドラッグ＆ドロップを制御（禁止）する
F_FormActivated := False;
//最大化して表示する
Form1.WindowState := wsMaximized;
//ここで実行するとFormがタスクバーを覆い隠してしまう -> FormActiveで実行する
//BorderIcons := [biSystemMenu, biMinimize];
end;
procedure TForm1.FormActivate(Sender: TObject);
begin
if not F_FormActivated then
begin
BorderIcons := [biSystemMenu];
F_FormActivated := True;
end;
end;
procedure TForm1.WMNCLButtonDown(var Msg: TWMNCLButtonDown);
begin
if Msg.HitTest = HTCAPTION then
Exit; // タイトルバーをドラッグしても動かせない
inherited;
end;
procedure TForm1.WMSysCommand(var Msg: TWMSysCommand);
begin
// 「元に戻す」「サイズ変更」を禁止
if (Msg.CmdType = SC_RESTORE) or (Msg.CmdType = SC_SIZE) then
begin
Exit;
end;
inherited;
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;
//画像内座標
p1 := Point(x1, y1);
p2 := Point(x2, y2);
//クライアント座標 -> スクリーン座標（Image1基準）
p1 := Image1.ClientToScreen(p1);
p2 := Image1.ClientToScreen(p2);
//スクリーン座標 -> フォームのクライアント座標（Form基準）
p1 := Form1.ScreenToClient(p1);
p2 := Form1.ScreenToClient(p2);
//ラバーバンドの座標を設定（フォームのクライアント座標で配置）
plImage1.SetBounds(p1.X, p1.Y, p2.X - p1.X, p2.Y - p1.Y);
//SelectedプロパティをTrueにするとラバーバンドとグラブハンドルが表示される
plImage1.Selected := True;
plImage1.BringToFront;
end;
end;
詳しいことはわかりませんが、この表示位置は私の方で何かした覚えがありませんので、おそらく OS 側で決めているのではないか･･･と思うのですが、やはり、これは何とかしたいところです。
私は普段は「1366×768」サイズに設定したモニターを使ってプログラムを書いています。職場ではもっと高解像度のモニターを与えられていますが、もともと大きさ的に限界のあるノート PC のモニターに必要以上の解像度設定は不要だと思います。若い方ならいざ知らず、年寄りには小さな画面＆高解像度のモニター環境は厳しすぎる気がします。
で、通常状態に戻ったときに Form を中央に表示する AdjustFormPosition 手続きは･･･
procedure TForm1.AdjustFormPosition;
var
WorkArea: TRect;
begin
//フォームが属しているモニタのワークエリアを取得（マルチモニタ対応）
WorkArea := Monitor.WorkareaRect;
//横方向の調整
if Width < (WorkArea.Right - WorkArea.Left) then
Left := WorkArea.Left + ((WorkArea.Right - WorkArea.Left) - Width) div 2
else
//はみ出す場合は左端に寄せる
Left := WorkArea.Left;
//縦方向の調整
if Height < (WorkArea.Bottom - WorkArea.Top) then
Top := WorkArea.Top + ((WorkArea.Bottom - WorkArea.Top) - Height) div 2
else
//はみ出す場合は上端に寄せる
Top := WorkArea.Top;
end;
FormCreate 時に、Form の状態を取得しておきます。
procedure TForm1.FormCreate(Sender: TObject);
begin
//「最大化->元に戻す」で画面の中央に表示
FPrevWindowState := WindowState;
procedure TForm1.FormResize(Sender: TObject);
var
//for 高さの調整
MemoHight, btnHight:integer;
begin
//VCLの高さを調整
･･･ 省略 ･･･
//「最大化->元に戻す」で画面の中央に表示
//ユーザーが普通にフォームをドラッグして幅や高さを変えた場合を除外
if (FPrevWindowState = wsMaximized) and (WindowState = wsNormal) then
AdjustFormPosition;
FPrevWindowState := WindowState; //最新の状態を保存
end;
実行して、非最大化時の動作を確認します。
Form は、画面の中央に表示されました！
できたー☆
予定した（と言うか、気がついた）修正作業は、全部、無事完了しました！
どなた様も、お待ちになってないことと思いますが･･･
８．ダウンロードのご案内
今回、全面的に不具合を修正しました、この「解答欄矩形の座標を検出するプログラム」と、先日この Blog でご紹介した「自動採点機能みたいなモノを搭載した手書き答案の採点補助プログラム（こちらも様々に内在していた不具合を修正し、Version 3.1.0 としました）」及び「マークシートリーダー」、「採点結果通知表並びに成績一覧表作成プログラム」他を１つにまとめた zip ファイルを下記リンク先からダウンロードすることができます。
