同梱のマークシートメーカーは PDF ファイルの出力に Skia を使用しています。Skia のライセンスは MIT ライセンスです。このライセンスの詳細につきましては、マークシートメーカーのフォルダに同梱した Skia4Delphi_and_Skia_LICENSE.txt をご覧ください。マークシートメーカーの使い方の詳細については、当 Blog の過去記事をご参照ください。
とにかく、これまでの矩形検出プログラムで解答欄矩形の座標を検出して、採点する順番になるように並び替える際、横書き答案であれば「 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)
横書き答案で、ブロックの指定が2以上である場合がありますので、この処理を for ループの中に埋め込んでいます。また、この横書きでブロックの指定が2以上である答案の場合には、2ブロック目に検出した座標の値のx座標を一律補正するような処理も 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
//最初に1回だけ設定を実行するための確認フラグ
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 は、画面の中央に表示されました!
できたー☆
予定した(と言うか、気がついた)修正作業は、全部、無事完了しました!
どなた様も、お待ちになってないことと思いますが・・・
8.ダウンロードのご案内
今回、全面的に不具合を修正しました、この「解答欄矩形の座標を検出するプログラム」と、先日この Blog でご紹介した「自動採点機能みたいなモノを搭載した手書き答案の採点補助プログラム(こちらも様々に内在していた不具合を修正し、Version 3.1.0 としました)」及び「マークシートリーダー」、「採点結果通知表並びに成績一覧表作成プログラム」他を1つにまとめた zip ファイルを下記リンク先からダウンロードすることができます。
AV は「初めて見る未知の DLL」をロードしようとした時に、ファイル全体をディスクから読み込み、サンドボックス(外部と隔離された仮想環境:ITやセキュリティの分野では、主に怪しいプログラムを安全に試すための実験室として使われる)や、クラウドサービスに投げて解析(インターネット接続が出来ない環境である場合には、一定時間のタイムアウトを設け、その後ローカル判定にフォールバックする:なのでインターネット接続環境がないPCで実行してもいつまでもフリーズしたような状態が続くわけではない → 待機時間は Windows Defender の場合、既定で数秒~数十秒程度)し、ハッシュをキャッシュに登録という処理を行うため、この「初回スキャン」が終わるまで、DLL ロードは OS レベルでブロックされてしまい、アプリケーション側から見ると フリーズ、すなわち「固まった」ようにしか見えない状態になるわけです。一度、このスキャンを通過すれば「このファイルは安全」とキャッシュされるので、以後は高速にロードできるようになります。
自動採点の初回実行時のみ PC がフリーズしたようになり、2回目以降は何の問題もなかったかのように動作するのは、このスキャンが実行されている証拠だと思われます(このスキャンが実行されていることを直接確認する方法はないようです: AV が検査状態を外部に直接公開すると、逆にマルウェアに悪用される可能性が高まるため)。
さらに「実行形式ファイルを別の場所にコピーすると再びフリーズする」のは、 AV によっては ファイルパスや場所ごとにキャッシュが分かれるためです(同じファイルでもデスクトップに置いたら「未知扱い」になる)。
procedure TFormCollaboration.FormCreate(Sender: TObject);
var
・・・ 省略 ・・・
begin
//embPythonの存在の有無を調査(条件コンパイル)
{$IFDEF WIN32}
//32bit環境での処理
AppDataDir:=ExtractFilePath(Application.ExeName)+'Python39-32';
{$ELSE}
//64bit環境での処理
AppDataDir:=ExtractFilePath(Application.ExeName)+'Python39-64';
{$ENDIF}
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;
//Splashフォームを表示
theSplashForm:=TSplashForm.Create(Application);
try
theSplashForm.Show;
theSplashForm.Refresh;
theSplashForm.TimeLabel.Caption :=
'ライブラリをロード中...(スキャンにより数分かかる場合があります)';
theSplashForm.Update;
Sleep(1500);
LoadAllPythonModules; //Pythonのモジュールを読み込み
theSplashForm.TimeLabel.Caption := '準備が整いました!';
theSplashForm.Update;
Sleep(500);
FadeOutForm(theSplashForm);
theSplashForm.Close;
finally
theSplashForm.Free;
end;
・・・ 省略 ・・・
end;
上記コードを実行した結果、初回起動時、私の環境では約2分5秒間 PC が待機状態になりました。また、自動採点機能の初回使用時は、私の環境では 15 秒間待機状態が続きました。2回目のアプリケーション起動時、自動採点実行時は、いずれも待機時間は大幅に短縮され、ほとんど気にならないレベル(個人差はあると思いますが)になりました。
(2)について
(1)ではユーザーへの案内が「’ライブラリをロード中…(スキャンにより数分かかる場合があります)’」のみとなってしまい、処理の経過状況がうまく伝わらない可能性があると考え、当初、別スレッドで AV スキャンを監視し、UI (theSplashForm.TimeLabel.Caption)に進捗状況を表示できないかと考えました。そこで、.pyd ファイル(=Python モジュール)のロードと同時に監視を自動で開始し、スキャンが収束するまで待機するユーティリティ関数を作成してみたのですが、PC の環境によりインストールされている AV は異なっていて当然ですので、この AV プロセスをどうすれば確実に取得できるかという部分が、まず大きな問題となりました。
type
TAVInfo = record
Name: string;
Path: string;
end;
function DetectAVProcesses: TArray<TAVInfo>;
implementation
const
AVCandidates: array[0..4] of TAVInfo = (
(Name: 'MsMpEng'; Path: '') //動的に取得する
);
function GetProcessPath(const ProcName: string): string;
var
Snapshot: THandle;
ProcEntry: TProcessEntry32;
hProcess: THandle;
PathBuffer: array[0..MAX_PATH - 1] of Char;
begin
Result := '';
Snapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
if Snapshot = INVALID_HANDLE_VALUE then Exit;
ProcEntry.dwSize := SizeOf(TProcessEntry32);
if Process32First(Snapshot, ProcEntry) then
begin
repeat
if SameText(ProcEntry.szExeFile, ProcName + '.exe') then
begin
hProcess := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False, ProcEntry.th32ProcessID);
if hProcess <> 0 then
begin
if GetModuleFileNameEx(hProcess, 0, PathBuffer, Length(PathBuffer)) > 0 then
Result := PathBuffer;
CloseHandle(hProcess);
end;
Break;
end;
until not Process32Next(Snapshot, ProcEntry);
end;
CloseHandle(Snapshot);
end;
function DetectAVProcesses: TArray<TAVInfo>;
var
i: Integer;
L: TList<TAVInfo>;
Path: string;
Info: TAVInfo;
begin
L := TList<TAVInfo>.Create;
try
for i := Low(AVCandidates) to High(AVCandidates) do
begin
Path := GetProcessPath(AVCandidates[i].Name);
if Path <> '' then
begin
Info := AVCandidates[i];
Info.Path := Path;
L.Add(Info);
end;
end;
Result := L.ToArray;
finally
L.Free;
end;
end;
私が動作確認した際には経験しなかった現象なので、具体的に「ナニを・どうすると・それが起きるのか」が当初まったくわからず、はたして不具合を解消できるかどうか、大いに不安でしたが、年齢層で言うとかなり高めの方からの不具合の報告であったことを念頭に置き、得点の「入力」、採点結果の「書込」、採点対象答案の「移動」あたりのボタンクリックに関する問題なのではないかと推測して、不具合の再現を図ったところ、予想が的中し、「書込」ボタンを連打すると PC がフリーズしてプログラムが落ちることを確認しました。
procedure TForm1.DoSaveData;
var
i:integer;
begin
if FIsSaving then Exit; // 多重実行防止
FIsSaving := True;
・・・ 省略 ・・・
end;
なお、自動採点機能もどきを搭載した Version 3 の修正作業を行っているうちに、私の周囲では、旧版の Version 2 の方が手に馴染むと、そちらを使い続けてくださっている方が複数いることを思い出し、Version 3 に行ったものと同等の修正(今回の修正に加えて、高 DPI 環境下でのスケーリング問題への対応や、メモリーリークを防止するため、設定画面が表示されている際には「閉じる」ボタンを無効化する処理等)を Version 2 にも同様に施して、Version 3 側を「 AC_Reader_AutoGrading.exe 」、Version 2 側を「 AC_Reader_NoneAutoGrading.exe 」として、上記リンクからダウンロードできる「 デジタル採点 All in One.zip 」に同梱しました。
自動採点機能もどきを搭載した Version 3 は、初回起動時に必ず実行される Windows Defender や McAfee などの Anti-Virus Software : AV による『未知バイナリの初回スキャン』の対象ファイルが多いため、実行環境を別ディレクトリに移動した際等、必ずこの処理が走り、長い待機状態が発生します。自動採点機能が不要の場合は、それがなく、『未知バイナリの初回スキャン』の対象ファイルが少ない「 AC_Reader_NoneAutoGrading.exe 」をお試しいただいた方がいいかもしれません。
AI に確認したところ、『多くのAVは、過去にスキャン済みのファイル情報をキャッシュしており、安全と判断したファイルはスキャン対象から外すようにしているが、そのキャッシュには有効期限があるため、検査後一定時間が経過すると「再評価が必要」と判断され、再スキャンが実行される』とのことです(私の環境下では、たとえディレクトリ構成を変えていない場合でも、前回起動時からひと月ほど経過?していたりするとプログラム起動時に待機状態が長く続く現象を確認しました。なので、間違いなくキャッシュには有効期限があるようです)。この他にも『スケジュールされた定期スキャン』や『アイドル時スキャン( ScanOnlyIfIdle )』の実行時、さらに『ウイルス定義ファイル更新後に再評価対象とされた場合』等にも再スキャンされる可能性があるとのことです。安全のためには仕方のないこととは言え、もう少しスキャン時間が短くなるとありがたいのですが・・・。
(追記_20250924 ここまで)
また、このプログラムの動作には「Microsoft Visual C ++ ランタイムライブラリ」のインストールが必要です。お使いのPCに「Microsoft Visual C ++ ランタイムライブラリ」が入っていない場合は、下記 Web サイトから「VisualCppRedist_AIO_x86_x64.exe」をダウンロードし、ダウンロードしたプログラムを管理者権限で実行し、動作に必要なライブラリをPCにインストールしてください。なお、インストール時には Windows のユーザーアカウント制御(UAC) が起動し、管理者用のID とパスワードの入力を求められます。インストールでは、exe の名称からわかるように 32 ビット版と 64 ビット版それぞれの VC++ランタイムライブラリがお使いの PC にセットアップされます。なお、インストール後は(僕のPC環境では)再起動なしで、そのまますぐに AC_Reader.exe を実行できました。
ダウンロードした zip ファイルを展開すれば、すぐにお試しいただけるよう、次に紹介する採点サンプルデータを同梱してあります。記事の説明を参照しながら、操作していただけますよう、お願い申し上げます。
この記事の冒頭にも書きましたが、プログラムの動作には「Microsoft Visual C ++ ランタイムライブラリ」のインストールが必要です。お使いのPCに「Microsoft Visual C ++ ランタイムライブラリ」が入っていない場合は、下記 Web サイトから「VisualCppRedist_AIO_x86_x64.exe」をダウンロードし、ダウンロードしたプログラムを管理者権限で実行し、動作に必要なライブラリをPCにインストールしてください。なお、インストール時には Windows のユーザーアカウント制御(UAC) が起動し、管理者用のID とパスワードの入力を求められます。インストールでは、exe の名称からわかるように 32 ビット版と 64 ビット版それぞれの VC++ランタイムライブラリがお使いの PC にセットアップされます。なお、インストール後は(僕のPC環境では)再起動なしで、そのまますぐに AC_Reader.exe を実行できました。
実は、この Blog の過去の記事で「失敗の記録」として掲載した手書き文字認識チャレンジの試行錯誤の記事を書いた当時、文字の認識に失敗した最大の原因は「正しく文字を切り出せなかった」ことにありました。今回、テストしたのは、たった3枚の画像ですが、いずれも問題なく文字が記入されている位置をプログラムは特定し、その正確な切り出しに成功しています。
次は、完成した学習モデルをDelphiから使えるようにすれば OK なのですが、この作業は毎回「写経」を行っているような気持ちを感じる作業です。・・・と、言う僕自身、写経の経験は皆無ですが・・・ この業界で一般的に使用される「写経」的意味合いと、ここでのそれは異なり、感覚的にはむしろ「修行」に近いものです。
次のコードを見ていただければ、なぜ「修行」なのか、ご理解いただけると思います。
procedure TFormCollaboration.btnAutoClick(Sender: TObject);
var
strScrList:TStringList;
strAnsList:TStringList;
j:integer;
intCols:integer;
results: TArray<string>;
s: string;
begin
// ・・・ 略 ・・・
try
//Scriptを入れるStringList
strScrList:=TStringList.Create;
//手書き文字の認識結果
strAnsList:=TStringList.Create;
try
strScrList.Add('import cv2');
strScrList.Add('import numpy as np');
strScrList.Add('import os');
strScrList.Add('from glob import glob');
strScrList.Add('import re');
strScrList.Add('from skimage.feature import hog');
strScrList.Add('import joblib');
//カタカナラベル
if (cmbAL.Text = 'ア') or (cmbAL.Text = 'イ') or (cmbAL.Text = 'ウ') or (cmbAL.Text = 'エ') or (cmbAL.Text = 'オ') then
begin
strScrList.Add('CATEGORIES = ["ア", "イ", "ウ", "エ", "オ"]');
end;
//○×ラベル
if (cmbAL.Text = '○') or (cmbAL.Text = '×') then
begin
strScrList.Add('CATEGORIES = ["○", "×"]');
end;
//HOG特徴量抽出
strScrList.Add('def extract_hog_features(img):');
strScrList.Add(' features = hog(img, orientations=9, pixels_per_cell=(4, 4), cells_per_block=(2, 2), block_norm="L2-Hys")');
strScrList.Add(' return features');
//UTF-8 パス対応の画像読み込み
strScrList.Add('def imread_utf8(path):');
strScrList.Add(' stream = np.fromfile(path, dtype=np.uint8)');
strScrList.Add(' return cv2.imdecode(stream, cv2.IMREAD_COLOR)');
//傾き補正
strScrList.Add('def deskew(img):');
strScrList.Add(' m = cv2.moments(img)');
strScrList.Add(' if abs(m["mu02"]) < 1e-2:');
strScrList.Add(' return img.copy()');
strScrList.Add(' skew = m["mu11"] / m["mu02"]');
strScrList.Add(' M = np.float32([[1, skew, -0.5 * 28 * skew], [0, 1, 0]])');
strScrList.Add(' return cv2.warpAffine(img, M, (28, 28), flags=cv2.WARP_INVERSE_MAP, borderValue=255)');
//ファイル名から数値を抽出(crop_Img12.png → 12)
strScrList.Add('def extract_number(path):');
strScrList.Add(' filename = os.path.basename(path)');
strScrList.Add(' match = re.search(r"crop_Img(\d+)", filename)');
strScrList.Add(' return int(match.group(1)) if match else float("inf")');
//文字認識処理
strScrList.Add('def predict_character(img, model):');
strScrList.Add(' hog_features = extract_hog_features(img)');
strScrList.Add(' label = model.predict([hog_features])[0]');
strScrList.Add(' return CATEGORIES[label]');
//モデル読み込み
//カタカナラベル
if (cmbAL.Text = 'ア') or (cmbAL.Text = 'イ') or (cmbAL.Text = 'ウ') or (cmbAL.Text = 'エ') or (cmbAL.Text = 'オ') then
begin
strScrList.Add('model_path = r".\Python39-32\katakana_hog_svm_model.pkl"');
end;
//○×ラベル
if (cmbAL.Text = '○') or (cmbAL.Text = '×') then
begin
strScrList.Add('model_path = r".\Python39-32\mb_hog_svm_model.pkl"');
end;
strScrList.Add('if not os.path.exists(model_path):');
strScrList.Add(' raise FileNotFoundError(f"モデルファイルが見つかりません: {model_path}")');
strScrList.Add('model = joblib.load(model_path)');
//入力・出力フォルダ
//strScrList.Add('base_path = r".\imgAuto\src"');
strScrList.Add('input_folder = r".\imgAuto\src"');
//strScrList.Add('folder_path = os.path.join(base_path, CORRECT_LABEL)');
strScrList.Add('output_folder = os.path.join(input_folder, "'+ cmbAL.Text +'")');
strScrList.Add('os.makedirs(output_folder, exist_ok=True)');
//対象画像を取得
strScrList.Add('image_extensions = ["*.jpg", "*.jpeg", "*.png"]');
strScrList.Add('image_files = []');
strScrList.Add('for ext in image_extensions:');
strScrList.Add(' image_files.extend(glob(os.path.join(input_folder, ext)))');
strScrList.Add('image_files.sort(key=extract_number)');
strScrList.Add('results = []');
strScrList.Add('index = 1');
strScrList.Add('for image_path in image_files:');
strScrList.Add(' image = imread_utf8(image_path)');
strScrList.Add(' if image is None:');
strScrList.Add(' print(f"読み込めない画像: {image_path}")');
strScrList.Add(' continue');
strScrList.Add(' h, w = image.shape[:2]');
strScrList.Add(' gray_for_line = cv2.cvtColor(image, cv2.COLOR_BGR2GRAY)');
strScrList.Add(' edges = cv2.Canny(gray_for_line, 50, 150, apertureSize=3)');
strScrList.Add(' raw_lines = cv2.HoughLinesP(edges, 1, np.pi / 180, threshold=100, minLineLength=min(w, h) // 3, maxLineGap=10)');
strScrList.Add(' filtered_lines = []');
strScrList.Add(' if raw_lines is not None:');
strScrList.Add(' for line in raw_lines:');
strScrList.Add(' x1, y1, x2, y2 = line[0]');
strScrList.Add(' angle = abs(np.arctan2(y2 - y1, x2 - x1) * 180 / np.pi)');
strScrList.Add(' length = np.hypot(x2 - x1, y2 - y1)');
strScrList.Add(' if (angle < 10 or angle > 170) and length < w // 2:');
strScrList.Add(' continue');
strScrList.Add(' filtered_lines.append([[x1, y1, x2, y2]])');
strScrList.Add(' if filtered_lines:');
strScrList.Add(' for line in filtered_lines:');
strScrList.Add(' x1, y1, x2, y2 = line[0]');
strScrList.Add(' if abs(x2 - x1) < 10 or abs(y2 - y1) < 10:');
strScrList.Add(' cv2.line(image, (x1, y1), (x2, y2), (255, 255, 255), thickness=3)');
strScrList.Add(' if w > h:');
strScrList.Add(' offset = w // 4');
strScrList.Add(' cropped = image[:, offset:w - offset]');
strScrList.Add(' else:');
strScrList.Add(' offset = h // 4');
strScrList.Add(' cropped = image[offset:h - offset, :]');
strScrList.Add(' gray = cv2.cvtColor(cropped, cv2.COLOR_BGR2GRAY)');
strScrList.Add(' _, thresh = cv2.threshold(gray, 200, 255, cv2.THRESH_BINARY_INV)');
strScrList.Add(' kernel = cv2.getStructuringElement(cv2.MORPH_RECT, (10, 10))');
strScrList.Add(' dilated = cv2.dilate(thresh, kernel, iterations=1)');
strScrList.Add(' contours, _ = cv2.findContours(dilated, cv2.RETR_EXTERNAL, cv2.CHAIN_APPROX_SIMPLE)');
strScrList.Add(' if contours:');
strScrList.Add(' all_points = np.vstack(contours)');
strScrList.Add(' x, y, w_box, h_box = cv2.boundingRect(all_points)');
//strScrList.Add(' padding = 20');
strScrList.Add(' padding = 5');
strScrList.Add(' if w > h:');
strScrList.Add(' x += offset');
strScrList.Add(' else:');
strScrList.Add(' y += offset');
strScrList.Add(' x1 = max(0, x - padding)');
strScrList.Add(' y1 = max(0, y - padding)');
strScrList.Add(' x2 = min(w, x + w_box + padding)');
strScrList.Add(' y2 = min(h, y + h_box + padding)');
strScrList.Add(' trimmed = image[y1:y2, x1:x2]');
strScrList.Add(' trimmed_gray = cv2.cvtColor(trimmed, cv2.COLOR_BGR2GRAY)');
strScrList.Add(' trimmed_blur = cv2.GaussianBlur(trimmed_gray, (3, 3), 0)');
strScrList.Add(' h_trim, w_trim = trimmed_blur.shape[:2]');
strScrList.Add(' scale = 20.0 / max(h_trim, w_trim)');
strScrList.Add(' new_w = int(w_trim * scale)');
strScrList.Add(' new_h = int(h_trim * scale)');
strScrList.Add(' resized = cv2.resize(trimmed_blur, (new_w, new_h), interpolation=cv2.INTER_AREA)');
strScrList.Add(' canvas = np.full((28, 28), 255, dtype=np.uint8)');
strScrList.Add(' x_offset = (28 - new_w) // 2');
strScrList.Add(' y_offset = (28 - new_h) // 2');
strScrList.Add(' canvas[y_offset:y_offset + new_h, x_offset:x_offset + new_w] = resized');
strScrList.Add(' deskewed = deskew(canvas)');
strScrList.Add(' M = cv2.moments(deskewed)');
strScrList.Add(' if M["m00"] != 0:');
strScrList.Add(' cx = int(M["m10"] / M["m00"])');
strScrList.Add(' cy = int(M["m01"] / M["m00"])');
strScrList.Add(' shift_x = 14 - cx');
strScrList.Add(' shift_y = 14 - cy');
strScrList.Add(' trans_mat = np.float32([[1, 0, shift_x], [0, 1, shift_y]])');
strScrList.Add(' deskewed = cv2.warpAffine(deskewed, trans_mat, (28, 28), borderValue=255)');
strScrList.Add(' canvas = deskewed');
strScrList.Add(' predicted_char = predict_character(canvas, model)');
strScrList.Add(' results.append(str(predicted_char))');
strScrList.Add(' else:');
strScrList.Add(' results.append("")');
strScrList.Add(' canvas = np.full((28, 28), 255, dtype=np.uint8)');
strScrList.Add(' save_path = os.path.join(output_folder, f"{index:04d}.png")');
strScrList.Add(' is_success, encoded_img = cv2.imencode(".png", canvas)');
strScrList.Add(' if is_success:');
strScrList.Add(' encoded_img.tofile(save_path)');
strScrList.Add(' index += 1');
strScrList.Add('var1.Value = ";".join(results)');
try
PythonEngine1.ExecStrings(strScrList);
except
on E: Exception do
begin
ShowMessage('Pythonスクリプトの実行中にエラーが発生しました: ' + E.Message);
Exit;
end;
end;
strAnsList.Clear;
if Assigned(PythonDelphiVar1) then
begin
s := PythonDelphiVar1.ValueAsString;
if s <> '' then
begin
results := SplitString(s, ';');
for s in results do
strAnsList.Add(s);
end else begin
ShowMessage('sは空欄!');
end;
end else begin
ShowMessage('PythonDelphiVar1 が未定義です');
end;
if Assigned(PythonDelphiVar1) then
begin
for j := 0 to strAnsList.Count - 1 do
begin
if cmbAL.Text = strAnsList[j] then
StringGrid1.Cells[intCols,j+1] := cmbRendo.Text
else
StringGrid1.Cells[intCols,j+1] := '0';
end;
end else begin
ShowMessage('PythonDelphiVar1 が未定義です');
Exit;
end;
finally
//StringListの解放
strScrList.Free;
strAnsList.Free;
end;
// ・・・ 略 ・・・
end;
strAnsList.Clear;
if Assigned(PythonDelphiVar1) then
begin
s := PythonDelphiVar1.ValueAsString;
if s <> '' then
begin
results := SplitString(s, ';');
for s in results do
strAnsList.Add(s);
end else begin
ShowMessage('sは空欄!');
end;
end else begin
ShowMessage('PythonDelphiVar1 が未定義です');
end;
if Assigned(PythonDelphiVar1) then
begin
for j := 0 to strAnsList.Count - 1 do
begin
if cmbAL.Text = strAnsList[j] then
StringGrid1.Cells[intCols,j+1] := cmbRendo.Text //得点を指定
else
StringGrid1.Cells[intCols,j+1] := '0';
end;
end else begin
ShowMessage('PythonDelphiVar1 が未定義です');
Exit;
end;
そこで、観点別評価と評定を入力したファイル( Excel Book の拡張子が xls, xlsx, xlsm いずれかのファイル)を任意のフォルダに入れ(もちろん、複数個入っていてもよい)、ここで紹介する「観点別評価と評定の整合性をチェックするプログラム」を起動、フォルダを選択するだけで、データのセル番地など、一切指定しなくても各々のファイルに入力された観点別評価と評定の整合性を全自動でチェック(整合性に問題がある場合、オプションで指定すれば観点別評価に基づいて評定を自動修正)してくれるプログラムを書いてみました。
チェック完了時、問題がなかった場合に表示される画面
実際に使ってもらい、「これはイイ!」と評価していただけましたので、ここでフリーソフトとして公開します。「 Excel Book に入力された観点別評価と評定の整合性をチェックするよい方法はないか?」と、悩んでいらっしゃる方にお使いいただけたら、何よりの幸いです。気がついた不具合はすべて解消してありますが、未発見のバグがまだどこかにあるかもしれません。このプログラムはあくまでも「素人」が、「趣味」で書いたものであり、思い込みや勘違いによる誤りを内包している可能性があります。大変、申し訳ないのですが、どうか、そこだけはご了承ください。
お手数をお掛けして申し訳ありませんが、信頼できる発行元になるために必要なデジタル署名を取得する費用等を考えますと、個人レベルで、その申請手続きを行うことは私の場合、無理と言わざるを得ません。開発に使用している IDE ( Delphi 12.3 )のサブスクリプション費用の支払いだけは Object Pascal の発展を願う1ユーザーとしての気持ちからずっと続けていますが・・・。
なお、最初にアップロードした実行形式ファイルで「自動修正」を有効にした状態で設定を保存すると、次回起動時に Form が表示される前に自動修正を有効化する処理が行われてしまい、「無効/非表示ウィンドウにはフォーカスを設定できません。」というエラーメッセージが表示されてしまうバグがあることに気づき、「自動修正」を有効にした状態で設定を保存しても、次回起動時に Form の表示が完全に行われてから、自動修正を有効化する処理が実行されるように、プログラムを修正しました。
A3 サイズのシートも作成してみたのだが、A3 サイズだとインクジェット複合機を利用して印刷(輪転機での印刷はマークの濃度が濃くなり、誤判定が出やすくなることから非推奨・・・というか、ユーザーには禁止と案内している)する時間が B4 サイズのそれより明らかに遅くなる、スキャナーでの読み取り処理にも時間がかかる等、いろいろ問題があり、少々マークの文字は小さくなるが A 版に比べて何かとメリットが多い B 版の用紙を使うことに決定。
もちろん、国際的にはやはり A 版だと思うが、欧米文化圏で My マークシートリーダーが使われるシーンはさすがに想像できない。できないが、今年、いちばんの夢は英語バージョンを作成することだ。これは新年早々に思いつき、数学用シートの処理プログラムが完成したら、今年の次のチャレンジ・イベントはそれだと思っている。
Combination Matching System -> 組み合わせの「一致性」に基づく評価。 Combination Marking System -> 採点(marking)を強調。教育や試験で使える表現。 Composite Marking System -> 要素を統合してスコアを出す評価システム。
いずれも頭文字を組み合わせると CMS になる。 自分的には、マークシートの採点だから Combination Marking System かな?
それから「順不同」を英語で言うと、No Particular Order だから、こちらは略して NPO だ。
procedure TForm1.UpdateColumnData(Value: Integer; IsChecked: Boolean);
var
i: Integer;
NewValue: string;
begin
if IsChecked then
begin
NewValue := '1';
end else begin
NewValue := '0';
end;
for i := 1 to StringGrid1.RowCount - 1 do
begin
if StrToInt(StringGrid1.Cells[StrGrid1ColCount-2, i]) = Value then
begin
StringGrid1.Cells[StrGrid1ColCount-1, i] := NewValue;
end;
end;
end;
procedure TForm1.StringGrid1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
ACol, ARow: Integer;
begin
//マウスでクリックして、指を離したときのイベント
StringGrid1.MouseToCell(X, Y, ACol, ARow);
if (ACol = StrGrid1ColCount-1) and (ARow >= 0) then
//引数にはCMS設定値が入る
UpdateColumnData(StrToInt(StringGrid1.Cells[StrGrid1ColCount-2, ARow]), True);
end;
private
procedure UpdateColumnData(Value: Integer; IsChecked: Boolean);
procedure TForm1.UpdateColumnData(Value: Integer; IsChecked: Boolean);
var
i: Integer;
NewValue: string;
begin
if IsChecked then
begin
NewValue := '1';
end else begin
NewValue := '0';
end;
for i := 1 to StringGrid1.RowCount - 1 do
begin
if StrToInt(StringGrid1.Cells[StrGrid1ColCount-2, i]) = Value then
begin
StringGrid1.Cells[StrGrid1ColCount-1, i] := NewValue;
end;
end;
//再描画をトリガ(即座に変更を表示)
StringGrid1.Invalidate;
end;
procedure TForm1.StringGrid1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
ACol, ARow: Integer;
begin
//マウスでクリックして、指を離したとき実行
StringGrid1.MouseToCell(X, Y, ACol, ARow);
//0行目(FixedRow)では動作しないように設定
if (ACol = StrGrid1ColCount-1) and (ARow > 0) then
//UpdateColumnData(ARow);
//引数にはCMS設定値が入る
UpdateColumnData(StrToInt(StringGrid1.Cells[StrGrid1ColCount-2, ARow]), True);
end;
type
//動的配列の宣言(配列要素の並べ替え他)
TString2DArray = array of array of string;
TString1DArray = array of string;
TString2DBoolArray = array of array of Boolean;
procedure TForm1.TM(Sender: TObject);
var
intQ: Integer //設問数
intCMS: Integer; //組み合わせ採点数
pArr: array of Integer; //配点を入れる動的配列
cArr: array of Integer; //正解を入れる動的配列
kArr: array of Integer; //観点別評価の区分を入れる動的配列
c4_Arr: array of Integer; //CMS設定番号を入れる動的配列
c5_Arr: array of Integer; //NPO設定番号を入れる動的配列
mArr: array of array of Integer; //マークを入れる2次元の動的配列
sArr: array of array of Boolean; //採点結果を入れる2次元の動的配列
cms_mArr: TString2DArray; //マークの組み合わせを入れる2次元の動的配列
cms_cArr: TString1DArray; //正解の組み合わせを入れる1次元の動的配列
cms_sArr: TString2DBoolArray; //採点結果をTrue or Falseで保存
cms_jArr: array of Boolean; //順不同採点の実施の有無をTrue or Falseで保存
プログラムコードは、
//注意:コードは一部の抜粋(重要な部分のみ)であり、これだけでは動作しません。
//一部の変数は、説明用の文字列で代替しています。
var
//マークを取得_20250228訂正
function GenerateDynamicArray: TArray<string>;
var
i,j: UInt64; #jを追加
CurrentValue, NextValue: string;
ResultArray: TArray<string>;
TempStr: string;
begin
TempStr := '';
j:=0; #初期化
for i := 1 to StringGrid1.RowCount - 2 do
begin
CurrentValue := StringGrid1.Cells[4, i];
NextValue := StringGrid1.Cells[4, i + 1];
if CurrentValue = NextValue then
begin
TempStr := TempStr + IntToStr(mArr[i-1,'答案画像の番号']);
end else begin
TempStr := TempStr + IntToStr(mArr[i-1,'答案画像の番号']);
ResultArray := ResultArray + [TempStr];
TempStr := '';
end;
j:=i; #値を取得
end;
//最後の要素を追加_20250228訂正
//TempStr := TempStr + StringGrid1.Cells[0, StringGrid1.RowCount - 1];
TempStr := TempStr + IntToStr(mArr[j, '答案画像の番号']);
ResultArray := ResultArray + [TempStr];
Result := ResultArray;
end;
//正解を取得
function GenerateDynamicArray2: TArray<string>;
var
i: UInt64;
CurrentValue, NextValue: string;
ResultArray: TArray<string>;
TempStr: string;
begin
TempStr := '';
for i := 1 to StringGrid1.RowCount - 2 do
begin
CurrentValue := StringGrid1.Cells[4, i];
NextValue := StringGrid1.Cells[4, i + 1];
if CurrentValue = NextValue then
begin
//正解を取得
TempStr := TempStr + StringGrid1.Cells[1, i];
end else begin
//正解を取得
TempStr := TempStr + StringGrid1.Cells[1, i];
ResultArray := ResultArray + [TempStr];
TempStr := '';
end;
end;
//最後の要素を追加_20250228訂正
//TempStr := TempStr + StringGrid1.Cells[0, StringGrid1.RowCount - 1];
TempStr := TempStr + StringGrid1.Cells[1, StringGrid1.RowCount - 1];
ResultArray := ResultArray + [TempStr];
Result := ResultArray;
end;
//配列要素の並べ替え
procedure SortStringWithZeroPriority(var Str: string);
var
CharArray: array of Char;
i, j: Integer;
Temp: Char;
begin
// 文字列を文字配列に変換
SetLength(CharArray, Length(Str));
for i := 1 to Length(Str) do
CharArray[i - 1] := Str[i];
// 昇順にソート (バブルソートを使用)
for i := Low(CharArray) to High(CharArray) - 1 do
for j := i + 1 to High(CharArray) do
begin
if (CharArray[j] = '0') or (CharArray[i] > CharArray[j]) then
begin
Temp := CharArray[i];
CharArray[i] := CharArray[j];
CharArray[j] := Temp;
end;
end;
// ソートされた文字配列を元の文字列に戻す
Str := '';
for i := Low(CharArray) to High(CharArray) do
Str := Str + CharArray[i];
end;
begin
//設問数を取得
intQ:=StringGrid1.RowCount-1;
//組み合わせ採点数を取得する -> 組み合わせ採点数は、最終行の値
intCMS:=StrToInt(StringGrid1.Cells[4,intQ]);
//動的配列を生成
SetLength(cArr, intQ); //正解(Correct answer)
SetLength(pArr, intQ); //配点(Point allocation)
SetLength(kArr, intQ); //観点別評価の区分
SetLength(c4_Arr, intQ); //組み合わせ採点の区分
SetLength(c5_Arr, intQ); //順不同採点の区分
//正解・配点・観点別評価の区分を配列に取得
for i := 1 to intQ do
begin
if StringGrid1.Cells[2,i]<>'' then
begin
cArr[i-1]:=StrToInt(StringGrid1.Cells[1,i]);
pArr[i-1]:=StrToInt(StringGrid1.Cells[2,i]);
kArr[i-1]:=StrToInt(StringGrid1.Cells[3,i]);
c4_Arr[i-1]:=StrToInt(StringGrid1.Cells[4,i]);
c5_Arr[i-1]:=StrToInt(StringGrid1.Cells[5,i]);
end else begin
pArr[i-1]:=0;
end;
end;
//1問1答の通常採点用の配列を準備
SetLength(mArr, intQ, ListBox1.Items.Count); //マーク読み取り結果
SetLength(sArr, intQ, ListBox1.Items.Count); //採点結果
//組み合わせ採点用の配列を準備
SetLength(cms_mArr, intCMS, ListBox1.Items.Count); //マーク読み取り結果の組み合わせ
SetLength(cms_cArr, intCMS); //正解読み取り結果の組み合わせ
SetLength(cms_sArr, intCMS, ListBox1.Items.Count); //組み合わせの採点結果
SetLength(cms_jArr, intCMS); //順不同採点実施の有無
//まず全てのデータを取得する
//マークを配列に取得・採点結果の初期化(False)
for i := 1 to ListBox1.Items.Count do //答案枚数分Loopする
begin
for j := 1 to intQ do //設問数分Loopする
begin
if strGrid.Cells[j,i]<>'' then
begin
//空欄(999)も、ダブルマーク(99)もそのまま取得する
mArr[j-1][i-1]:=StrToInt(strGrid.Cells[j,i]);
//デフォルトFalseで初期化
sArr[j-1][i-1]:=False;
end else begin
mArr[j-1][i-1]:=999; //Gridが空欄であればマークは空欄として扱う
sArr[j-1][i-1]:=False;
end;
end;
end;
//組み合わせ採点用の動的配列にデータをセットする
for i := 1 to ListBox1.Items.Count do //答案枚数分Loopする
begin
//マークを配列に取得・採点結果の初期化(False)
DynamicArray := GenerateDynamicArray;
for j := 0 to intCMS-1 do
begin
if strGrid.Cells[j,i]<>'' then
begin
cms_mArr[j][i-1]:=DynamicArray[j];
end else begin
mArr[j-1][i-1]:=999; //Gridが空欄であればマークは空欄として扱う
sArr[j-1][i-1]:=False;
end;
end;
//正解を配列に取得・採点結果の初期化(False)
DynamicArray := GenerateDynamicArray2;
for j := 0 to intCMS-1 do
begin
if strGrid.Cells[j,i]<>'' then
begin
cms_cArr[j]:=DynamicArray[j];
end else begin
mArr[j-1][i-1]:=999; //Gridが空欄であればマークは空欄として扱う
sArr[j-1][i-1]:=False;
end;
end;
end;
//答案枚数分Loop
for i := 1 to ListBox1.Items.Count do
begin
//組み合わせ採点数分Loop
for j := 0 to intCMS-1 do
begin
//もし、マークが正解と等しかったら
if cms_mArr[j][i-1]=cms_cArr[j] then
begin
cms_sArr[j][i-1]:=True;
end else begin
cms_sArr[j][i-1]:=False;
end;
end;
end;
var
CurrentCMSValue: UInt64;
//配列要素の並べ替え
procedure SortStringWithZeroPriority(var Str: string);
var
CharArray: array of Char;
i, j: Integer;
Temp: Char;
begin
// 文字列を文字配列に変換
SetLength(CharArray, Length(Str));
for i := 1 to Length(Str) do
CharArray[i - 1] := Str[i];
// 昇順にソート (バブルソート)
for i := Low(CharArray) to High(CharArray) - 1 do
for j := i + 1 to High(CharArray) do
begin
if (CharArray[j] = '0') or (CharArray[i] > CharArray[j]) then
begin
Temp := CharArray[i];
CharArray[i] := CharArray[j];
CharArray[j] := Temp;
end;
end;
//ソートされた文字配列を元の文字列に戻す
Str := '';
for i := Low(CharArray) to High(CharArray) do
Str := Str + CharArray[i];
end;
begin
//組み合わせ採点用の動的配列にデータをセットする
for i := 1 to ListBox1.Items.Count do //答案枚数分Loopする
begin
・・・
end;
//順不同採点のフラグを設定
for i := 1 to StringGrid1.RowCount-1 do
begin
if StringGrid1.Cells[2, i] <> '0' then
begin
CurrentCMSValue := StrToInt(StringGrid1.Cells[4, i]);
case StrToInt(StringGrid1.Cells[5, i]) of
0:begin
cms_jArr[CurrentCMSValue-1]:= False;
end;
1:begin
cms_jArr[CurrentCMSValue-1]:= True;
end;
end;
end;
end;
//答案枚数分Loop
for i := 1 to ListBox1.Items.Count do
begin
//組み合わせ採点数分Loop
for j := 0 to intCMS-1 do
begin
//順不同採点を実施する場合の処理
if cms_jArr[j] then
begin
//マーク並べ替え
SortStringWithZeroPriority(cms_mArr[j][i-1]);
//正解並べ替え
SortStringWithZeroPriority(cms_cArr[j]);
end;
//もし、マークが正解と等しかったら
if cms_mArr[j][i-1]=cms_cArr[j] then
begin
//採点結果をTrue
cms_sArr[j][i-1]:=True;
end else begin
cms_sArr[j][i-1]:=False;
end;
end;
end;
end;
アプリケーション(特に手書き答案の採点補助プログラム: AC_Reader.exe )の初回起動時、Anti-Virus Software による『未知バイナリの初回スキャン』が OS 側で実行されます。このため、初回起動時に限り、2~3分程度(私の環境での実測値は2分5秒) PC が待機状態になります。また、自動採点機能の初回使用時にも十数秒程度(私の環境での実測値は15秒)の待機状態が発生します。
この現象は初回起動時(自動採点は初回実行時)にのみ発生し、同じディレクトリ(=フォルダ階層)からの2回目以降の起動・実行時は、初期化に必要な時間は大幅に短縮されます。初回起動・実行時に発生する待機状態はプログラムの不具合ではありませんので、ご安心ください。OS 側のスキャンが完了するまで、何もしないでお待ちいただけますようお願い申し上げます。このことについては、この Blog の別の記事に詳しい説明があります。こちらの記事をご参照ください。
2025年8月25日更新版に含まれている「手書き答案採点補助プログラム AC_Reader Version 3.1.0 )には自動採点機能が新しく追加で搭載されています。プログラムのダウンロード&展開後、初めてこの自動採点機能を実行する際に、Windows Defender や McAfee などの Anti-Virus Software : AV による『未知バイナリの初回スキャン』が行われるようです。このため2~3分間程度 PC は待機状態になります(2回目以降はスムース?に動作します)。また、実行形式ファイルの PC 内での位置が変わった場合にも AV によっては再度『未知バイナリの初回スキャン』が行われ、初回同様の待機状態となる場合があります。このことについては、この Blog の別の記事に詳しい説明があります。下記リンク先の記事をご参照ください。
私が動作確認した際には経験しなかった現象なので、具体的に「ナニを・どうすると・それが起きるのか」が当初まったくわからず、はたして不具合を解消できるかどうか、大いに不安でしたが、年齢層で言うとかなり高めの方からの不具合の報告であったことを念頭に置き、得点の「入力」、採点結果の「書込」、採点対象答案の「移動」あたりのボタンクリックに関する問題なのではないかと推測して、不具合の再現を図ったところ、予想が的中し、「書込」ボタンを連打すると PC がフリーズしてプログラムが落ちることを確認しました。
procedure TForm1.DoSaveData;
var
i:integer;
begin
if FIsSaving then Exit; // 多重実行防止
FIsSaving := True;
・・・ 省略 ・・・
end;
なお、自動採点機能もどきを搭載した Version 3 の修正作業を行っているうちに、私の周囲では、旧版の Version 2 の方が手に馴染むと、そちらを使い続けてくださっている方が複数いることを思い出し、Version 3 に行ったものと同等の修正(今回の修正に加えて、高 DPI 環境下でのスケーリング問題への対応や、メモリーリークを防止するため、設定画面が表示されている際には「閉じる」ボタンを無効化する処理等)を Version 2 にも同様に施して、Version 3 側を「 AC_Reader_AutoGrading.exe 」、Version 2 側を「 AC_Reader_NoneAutoGrading.exe 」として、上記リンクからダウンロードできる「 デジタル採点 All in One.zip 」に同梱しました。
自動採点機能もどきを搭載した Version 3 は、初回起動時に必ず実行される Windows Defender や McAfee などの Anti-Virus Software : AV による『未知バイナリの初回スキャン』の対象ファイルが多いため、実行環境を別ディレクトリに移動した際等、必ずこの処理が走り、長い待機状態が発生します。自動採点機能が不要の場合は、それがなく、『未知バイナリの初回スキャン』の対象ファイルが少ない「 AC_Reader_NoneAutoGrading.exe 」をお試しいただいた方がいいかもしれません。
AI に確認したところ、『多くのAVは、過去にスキャン済みのファイル情報をキャッシュしており、安全と判断したファイルはスキャン対象から外すようにしているが、そのキャッシュには有効期限があるため、検査後一定時間が経過すると「再評価が必要」と判断され、再スキャンが実行される』とのことです(私の環境下では、たとえディレクトリ構成を変えていない場合でも、前回起動時からひと月ほど経過?していたりするとプログラム起動時に待機状態が長く続く現象を確認しました。なので、間違いなくキャッシュには有効期限があるようです)。この他にも『スケジュールされた定期スキャン』や『アイドル時スキャン( ScanOnlyIfIdle )』の実行時、さらに『ウイルス定義ファイル更新後に再評価対象とされた場合』等にも再スキャンされる可能性があるとのことです。安全のためには仕方のないこととは言え、もう少しスキャン時間が短くなるとありがたいのですが・・・。
対策として、『選択肢番号の外枠の楕円「0」部分をはみ出さないようにマークする』よう注意を徹底することをお願いしたのですが、それだけでは根本的な解決とならないように感じ、マークとマークの間隔が狭いためにこの問題が起きていることは明白ですから、1設問について100選択肢に対応を維持しつつ、1列25行×4列で100設問まで対応という現在のマークシート構成を見直し(マーク間の幅を広げるため列数を減らし)、1列33行×3列で99設問まで対応可能というマークシートを作成しました。また、50分という試験時間を考えると80設問あれば十分というご意見も頂戴しましたので、1列30行×3列で90設問まで対応可能なマークシートや、1列25行×3列で75設問まで対応可能なマークシートを作成し、これらのマークシートを1つの Excel Book にまとめました。以下のリンクからダウンロードできます。
対策として、『選択肢番号の外枠の楕円「0」部分をはみ出さないようにマークする』よう注意を徹底することをお願いしたのですが、それだけでは根本的な解決とならないように感じ、マークとマークの間隔が狭いためにこの問題が起きていることは明白ですから、1設問について100選択肢に対応を維持しつつ、1列25行×4列で100設問まで対応という現在のマークシート構成を見直し(マーク間の幅を広げるため列数を減らし)、1列33行×3列で99設問まで対応可能というマークシートを作成しました。また、50分という試験時間を考えると80設問あれば十分というご意見も頂戴しましたので、1列30行×3列で90設問まで対応可能なマークシートや、1列25行×3列で75設問まで対応可能なマークシートを作成し、これらのマークシートを1つの Excel Book にまとめました。以下のリンクからダウンロードできます。
1列あたりの行数・全列数・選択肢の形式と選択肢数を「行・列・選択肢」順に並べています。 R は Row (=行)、すなわち1列 25 行より成ること、 C は Column (=列)、すなわち4列あること、 D は Double 型、すなわち複数マーク対応で、1行あたりの選択肢数は 19 個。 (ここが S の場合は Single 型、複数マーク不可)
Word や Excel で作成したマークシートを、同じインクジェットプリンタで印刷して使用しているので、試験を実施する度にテンプレートを登録する必要はないはずなのですが、筆者はなんとなく不安で、毎回新しくテンプレートを登録し直して作業しています・・・
対策として、『選択肢番号の外枠の楕円「0」部分をはみ出さないようにマークする』よう注意を徹底することをお願いしたのですが、それだけでは根本的な解決とならないように感じ、マークとマークの間隔が狭いためにこの問題が起きていることは明白ですから、1設問について100選択肢に対応を維持しつつ、1列25行×4列で100設問まで対応という現在のマークシート構成を見直し(マーク間の幅を広げるため列数を減らし)、1列33行×3列で99設問まで対応可能というマークシートを作成しました。また、50分という試験時間を考えると80設問あれば十分というご意見も頂戴しましたので、1列30行×3列で90設問まで対応可能なマークシートや、1列25行×3列で75設問まで対応可能なマークシートを作成し、これらのマークシートを1つの Excel Book にまとめました。以下のリンクからダウンロードできます。
これまでのマークシートは Word で作成していたので、今回も Word を利用。・・・と言うか、本当は印刷設定の自由度が大きい Excel を使いたいのだが、Excel で縦楕円の丸囲み数字を上手に作成する方法がわからない。そこで縦楕円の丸囲み数字が簡単に作成できる Word を利用した・・・というのが正直なところ。
ちなみに Word で縦楕円の丸囲み数字(=「囲い文字」というらしい)を作成する方法は・・・
Word なら、Font は「メイリオ」を選択(フォントサイズを大きくしない場合)、丸囲みしたい数字を半角で入力、入力した数字をマウスでドラッグして選択してから、フォントリボンの「囲い文字」アイコンをクリックすると・・・
//複数マークの読み取り方法
if (Copy(strMS_Type,10,2)='19') and (chk_MultipleMarks.Checked) then
begin
//選択肢数が19で、複数マーク許可であった場合
StrList.Add(' var1.Value = str(res)');
end else begin
//複数マークは不許可であった場合
StrList.Add(' var1.Value = "99"');
end;
Python側で読み取った値をDelphi側で処理する部分も変更(一部を抜粋)。
//選択肢の始まりは「ゼロ」
if (Copy(strMS_Type,10,2)='19') and (chk_MultipleMarks.Checked) then
begin
//複数マークに対応
//strAnsList[intSG_k]の文字数を調査
strCount:=ElementToCharLen(strAnsList[intSG_k],Length(strAnsList[intSG_k]));
//チェック内容は、以下の通り
{
文字数が2文字の場合、末尾の1文字を取得する
10 -> 0
11 -> 1
19 -> 9
末尾1文字がマークした選択肢の番号になる
文字数が5文字の場合、
1 10 -> 2文字目が1、末尾2文字が10 -> 10
2 11 -> 2文字目が2、末尾2文字が11 -> 21
3 12 -> 2文字目が3、末尾2文字が12 -> 32
(2文字目×10)+(末尾2文字 - 10)がマークした選択肢の番号になる
}
case strCount of
2:begin
//2文字の場合は、末尾1文字が選択した選択肢の番号
StringGrid1.Cells[intSG_Col,intSG_Row]:=RightStr(strAnsList[intSG_k],1);
end;
3:begin
//空欄と判定された場合
if strAnsList[intSG_k]='999' then
begin
StringGrid1.Cells[intSG_Col,intSG_Row]:=strAnsList[intSG_k];
end;
end;
5:begin
//(2文字目×10)+(末尾2文字 - 10)がマークした選択肢の番号
StringGrid1.Cells[intSG_Col,intSG_Row]:=IntToStr(
(StrToInt(Copy(strAnsList[intSG_k],2,1)) * 10) +
(StrToInt(RightStr(strAnsList[intSG_k],2))) - 10);
end;
end;
end else begin
//1行につき選択肢数分Loopする_複数選択肢に対応(New)_20240614
if (Copy(strMS_Type,10,2)='19') and (chk_MultipleMarks.Checked) then
begin
//複数選択可能な場合_選択肢の数だけLoopする
for p := 0 to intCol-1 do
begin
//対象値pが平均値の3倍より大きいか、どうかでマークありと判定
if AryVal[p]>dblAvg * intKeisu then
begin
//マークありとした判定の数を記録
q:=q+1;
//マークした番号(記号)を記録
//intMark:=p+1;
//10の位(0-8)
case p of
0:strMark_A:='1';
1:strMark_A:='2';
2:strMark_A:='3';
3:strMark_A:='4';
4:strMark_A:='5';
5:strMark_A:='6';
6:strMark_A:='7';
7:strMark_A:='8';
8:strMark_A:='9';
end;
//1の位
case p of
9:strMark_B:='0';
10:strMark_B:='1';
11:strMark_B:='2';
12:strMark_B:='3';
13:strMark_B:='4';
14:strMark_B:='5';
15:strMark_B:='6';
16:strMark_B:='7';
17:strMark_B:='8';
18:strMark_B:='9';
end;
end;
end;
//Loop終了時にマーク数を判定
if q=0 then
begin
//マークした番号がない場合
iArr[i,Rep]:=999;
end else begin
//マークした番号があり、それが一の位である場合
if (q=1) and (strMark_A='') then
begin
//マーク数が1、かつ十の位が空欄であったら
iArr[i,Rep]:=StrToInt(strMark_B);
end else begin
//マーク数は1だが、それが十の位であったら
iArr[i,Rep]:=100;
end;
if (q=2) and (strMark_A<>'') and (strMark_B<>'') then
begin
//マーク数が2、かつ十の位と一の位がともに空欄でなかったら
strMark:=strMark_A+strMark_B;
iArr[i,Rep]:=StrToInt(strMark);
end;
if q>2 then
begin
//トリプル以上のマーク数を見分けるフラグは100
iArr[i,Rep]:=100;
end;
end;
end else begin
//選択肢の始まりは「ゼロ」(1の位を基準)
if (Copy(strMS_Type,10,2)='19') and (chk_MultipleMarks.Checked) then
begin
//strAnsList[intSG_k]の文字数を調査
strCount:=ElementToCharLen(strAnsList[intSG_k],Length(strAnsList[intSG_k]));
//チェック内容は、以下の通り
{
文字数が2文字の場合、末尾の1文字を取得する
10 -> 0
11 -> 1
19 -> 9
末尾1文字がマークした選択肢の番号になる
文字数が5文字の場合、
1 10 -> 2文字目が1、末尾2文字が10 -> 10
2 11 -> 2文字目が2、末尾2文字が11 -> 21
3 12 -> 2文字目が3、末尾2文字が12 -> 32
(2文字目×10)+(末尾2文字 - 10)がマークした選択肢の番号になる
}
case strCount of
1:begin
if StrToInt(strAnsList[intSG_k])<10 then
begin
StringGrid1.Cells[intSG_Col,intSG_Row]:='100';
end;
end;
2:begin
//2文字の場合は、末尾1文字が選択した選択肢の番号
StringGrid1.Cells[intSG_Col,intSG_Row]:=RightStr(strAnsList[intSG_k],1);
end;
3:begin
//空欄と判定された場合
if strAnsList[intSG_k]='999' then
begin
StringGrid1.Cells[intSG_Col,intSG_Row]:=strAnsList[intSG_k];
end;
//3文字と判定された場合、十の位の1~9のダブルマークの場合、
//2文字目は必ず半角の空欄になる
if Copy(strAnsList[intSG_k],2,1)=' ' then
begin
StringGrid1.Cells[intSG_Col,intSG_Row]:='999';
end;
end;
5:begin
//文字列の置き換え(先頭2文字を抽出&半角スペースを削除する)
strData:=StringReplace(Copy(strAnsList[intSG_k],1,2),
' ', '', [rfReplaceAll, rfIgnoreCase]);
//Case 5で先頭2文字が10である場合はダブル以上のマークあり
if StrToInt(strData) > 9 then
begin
StringGrid1.Cells[intSG_Col,intSG_Row]:='999';
end else begin
//2文字目が半角スペースでなければ処理可能
if Copy(strAnsList[intSG_k],2,1)=' ' then
begin
StringGrid1.Cells[intSG_Col,intSG_Row]:='999';
end else begin
//(2文字目×10)+(末尾2文字 - 10)がマークした選択肢の番号
StringGrid1.Cells[intSG_Col,intSG_Row]:=IntToStr(
(StrToInt(Copy(strAnsList[intSG_k],2,1)) * 10) +
(StrToInt(RightStr(strAnsList[intSG_k],2))) - 10);
end;
end;
end;
6..99:begin
StringGrid1.Cells[intSG_Col,intSG_Row]:='999';
end;
end;
end else begin
//複数選択を許可しないマークシートの処理
end;
end;
この際、読み取りエラーをすべて「999」で処理すれば、これまでの経験から、読み取り結果のチェックプログラムは確実に「空欄」=「999」位置を教えてくれるし、もし、それが本当に「空欄」である場合は、人が見ればそれは一目瞭然、もし、それが空欄でない場合は、それを見た「人」に、マークの有無 or 空欄 or その他複数マークの判断を委ねればいい。そしてもし、「人」が見て、マークが正しければプログラムの判定結果を正しく修正、そうでなく、マークが「空欄でない」・「必要数以上にマークされていた」場合は、そのまま「空欄として処理(999)」してもらえば、採点結果には一切影響を与えないはずだ。
また、派生版であるため、プログラムには Excel Book に読み取り結果を出力する機能がありますが、大語群に対応した採点結果通知作成用の Excel ファイルは、Zipファイルを展開後、 eFile フォルダ内にあるテンプレートから生成できる Excel ファイルをマクロ有効な Excel Book として保存し、これを元にご自身で作成していただく必要があります。※ Zip ファイルに添付した Excel Book は、大語群マークシートに対応しておりません。
当Blogで紹介してきた自作のデジタル採点プログラムを一つにまとめました。次のリンク先にその紹介とダウンロードリンクがあります。この記事で紹介している手書き答案のデジタル採点プログラムAC_Reader Version 2.1.1 と、AC_Reader Version 2.1.1 に自動採点機能を追加で搭載した Version 3.1.1 がプログラムセットに同梱されています。
2025年8月25日更新版に含まれている「手書き答案採点補助プログラム AC_Reader Version 3.1.0 )には自動採点機能が新しく追加で搭載されています。プログラムのダウンロード&展開後、初めてこの自動採点機能を実行する際に、Windows Defender や McAfee などの Anti-Virus Software : AV による『未知バイナリの初回スキャン』が行われるようです。このため2~3分間程度 PC は待機状態になります(2回目以降はスムース?に動作します)。また、実行形式ファイルの PC 内での位置が変わった場合にも AV によっては再度『未知バイナリの初回スキャン』が行われ、初回同様の待機状態となる場合があります。このことについては、この Blog の別の記事に詳しい説明があります。下記リンク先の記事をご参照ください。
上記リンク先でダウンロードできる「デジタル採点 All in One !」は、ここからダウンロードできる教科「情報」用マークシートも同梱しています。「デジタル採点 All in One !」には、マークシートリーダーの他、マークの読み取りを高速化するPython環境、手書き答案の採点プログラム、受験者に採点結果を通知する個票及び成績一覧表の作成プログラム、実際の採点現場で要請に応じて作成した各種のマークシート等を同梱しています。何の保証もサポートもありませんし、「All 自己責任でお願いします」という制約はありますが、すべて無料でお使いいただけます。
お使いのPCで、Visual C++ ランタイム ライブラリのインストール状況を確認するには、[スタート] ボタンを右クリックし、「ファイル名を指定して実行」をクリックして、appwiz.cpl と入力して[Enter]を押します。Python環境を組み込んだ MS_Reader が動作する環境であれば、システムにインストールされている Microsoft Visual C++ ランタイム ライブラリが以下のように表示されるはずです。
現在、私のシステム(Windows 11 Pro 23H2)にインストールされているC++ランタイムライブラリの一覧。 もちろん、このシステムでPython環境を組み込んだマークシートリーダーが正常に動作しています。
エラーを解決するには、Visual C++ランタイムライブラリをインストールすればいいわけですが、上の例のように Visual C++ ランタイムはたくさんあるので、手動でひとつひとつダウンロードしてインストールするより、Visual C++ ランタイムインストーラーを使って全ての Visual C++ ランタイムを一括インストールする方が簡単です。
システムをリカバリする前は、次のようにして Visual C++ ランタイムをインストールしていました。
【ご注意願います!】
ここで紹介する方法で Visual C++ ランタイムをインストールする場合、他のプログラムの実行環境との整合性は、一切保証できません。また、最悪の場合、Windowsが起動しなくなるトラブルが発生することも十分に考えられます。インストール作業の全てが自己責任であることを十分ご理解の上、重大な問題が発生した場合は元の環境に戻せるよう、システムのバックアップを取る・現在の設定をメモに記録する等、不具合の発生に備え、必要かつ十分な準備を整えた上で、Visual C++ ランタイムのインストールを行ってください。
以下のサイトから「Visual C++ v56.exe」をダウンロードしてインストール(私の環境にインストールする分には、なんの問題も起きませんでした。もちろん、マークシートリーダーも問題なく起動し、安定動作しました)。
ここから先は、上記のインストーラーを用いて Visual C++ ランタイムをインストールした際、私が実際に経験したトラブル?です(最終的にインストールは成功しました)。
お決まりのUAC起動後(PCの設定によっては)管理者ID 及びパスワードの入力が求められますが、これを入力すると、そのままPCがフリーズしたような状態になり、数分待機しても進展が見られないので、いったん作業を Ctrl+Alt+Delete でキャンセルし、再度、「Visual C++ v56.exe」を起動して Visual C++ ランタイムのインストール作業を実行、今度はトラブルなくインストールに成功する事例です。これは「ある特定のAD環境下にあるPCのすべてに共通して見られた」現象です。現在もその原因はわかりませんが、ご参考まで。
この初期化を「するか・しないか」で、MS_Reader 起動後、初めてマークを「読む」ボタンをクリックした際のプログラムの挙動がまるで違ったものになります。初期化を行った場合は、ごくスムーズにマーク読み取りが始まるのに対し、行わなかった場合は PC が一瞬フリーズしたような状態になり、その後、息を吹き返すかのようにマークの読み取りが始まります。
Python Engine の初期化コードです。
AppDataDir:=ExtractFilePath(Application.ExeName)+'Python39-32';
if DirectoryExists(AppDataDir) then
begin
//フォルダが存在したときの処理
CheckPython.Enabled:=True;
CheckPython.Checked:=True;
PythonEngine1.AutoLoad:=True;
PythonEngine1.IO:=PythonGUIInputOutput1;
PythonEngine1.DllPath:=AppDataDir;
PythonEngine1.SetPythonHome(PythonEngine1.DllPath);
PythonEngine1.LoadDll;
PythonDelphiVar1.Engine:=PythonEngine1;
PythonDelphiVar1.VarName:=AnsiString('var1');
PythonEngine1.Py_Initialize;
//イニシャライズされたことを記憶
P4D_ini:=True;
end else begin
CheckPython.Checked:=False;
CheckPython.Enabled:=False;
PythonEngine1.AutoLoad:=False;
P4D_ini:=False;
end;
(どこに問題があるのでしょうか?)
PC によっては、この Python Engine の初期化に非常に長い時間を要することがあるようです(エラーメッセージは出ません。この沈黙の時間が終わった後、プログラムは問題なく動作します)。偶然、ある PC でこの現象に巡り合い、あわてて時間を計ってみたところ、その PC では初期化に4分必要でした! なぜ、このような現象が発生するのか、その理由がわからないのですが、「そのようなことがある」ことだけは経験的に明らかですので、ここに書いておくことにしました。
Excel Book への読み取り結果の書き出しは、自分用に(あれば便利かなー☆)と思って作成したものです。ですので、式の入ったセルを保護する等、第三者が使うことへの配慮は何一つ行っていません。セルに入力された式やVBAの内容をご自身でメンテナンスできる方なら、お使いいだけるかな? という程度のシロモノです。
添付した Excel Book はこれまでに何度も「実際に使用して動作に誤りがないことを確認済み」ですが、誤って式を削除したりした場合は(当然ですが)意図した通りに動作しません。ですので、こちらも動作保証は一切ありません。ご使用はあくまでも自己責任でお願いします。この Excel Book に対しても、このプログラムの使用要件にあります免責事項がそのまま適用されますことを申し添えます。
以下、試験実施前に行っておくとよい採点準備作業です。
eFile フォルダに「一般用マークと手書き併用採点シート.xltm」というマクロ有効テンプレートがあります。これをダブルクリックすると「一般用マークと手書き併用採点シート1.xlsx」という名前で新しい Excel Book が作られます。拡張子に注意してください。「.xlsx」です。このままでは期待通りに動作しませんので、適切な名前を付け、拡張子を「.xlsm」(マクロが有効な Excel Book )に変更して eFile フォルダ(必ずこのフォルダに保存してください!)に保存します。
ここでは test.xlsm という名前で保存したことにして説明を続けます。
「コンテンツの有効化」をクリックしてマクロが実行できるようにしてください。
【インターネットからダウンロードしたマクロ有効 Excel Book の取り扱い】
いつからこうなったのか、わかりませんが、インターネットからダウンロードした拡張子 xlsm の Excel Book をダブルクリックして開くと、次のメッセージが表示されるようになりました。
「編集を有効にする」をクリックすると・・・マクロを動かすことができません!
こうなった時は、いったん Book を閉じて、その Excel ファイルを右クリックして表示されるサブメニューのプロパティをクリックして、全般タブのいちばん下にある「セキュリティ:」の「許可する」にチェックします(チェックする=マクロの実行をご自身の責任で行うことになります。どうか、ご注意ください)。
Excel Book を利用して採点する場合、大変重要な注意事項があります。それは欠席者がいた場合の処理です。該当試験に欠席者がいる場合は、その欠席者の出席番号位置に未使用のマークシートを挿入し、シートが確実に出席番号順に並んでいることを確認してから、スキャナーでスキャンしてください。 ※ 可能であれば、この用途専用に未使用のマークシートを複数枚、最初から手元に準備しておくとよいと思います。
Excel へデータを書き込む際は、上記注意事項を必ずお守りください。この注意を忘れて Excel が起動したまま、Excel Book への書き込みを実行すると最悪の場合、Excel のプロセスが幽霊のように残り、これを終了することが出来なくなって、復旧するには、システムの再起動しかない状態になります。未保存の重要なデータがあるような場合、当然そのデータは失われます。Excel Book へのデータ書き込み時は、Excel が起動していないことを(タスクバーに眠っている Excel Book がないことも含めて)十分確認した上で、書き込み作業を行ってください。
【書き出し処理】
マークシートを読み取り後、読み取り結果のチェックまで完了したら、Excel Book への読み取り結果の書き出しが可能となります。次のようにマークシートリーダーを操作してください。
ファイル名がなぜ「Scanner_A.xlsm」になったかというと、マークシートの読み取り元フォルダとして選択したのが、ProcData\Scanner_A であったためです。プログラムは、マークシートの読み取り元フォルダの名称をそのまま、原本「test.xlsm」をコピーして生成する読み取り結果書き込み先 Excel Book の名称として利用します。