矢印型 Form をこの位置に置いてクリックすると･･･予め設定した範囲を、指定した倍率で、図のように枠のない別窓に拡大表示します。 別窓を指定時間後に自動で閉じる設定も可能です。 （デフォルト設定では、幅640×高さ320ピクセル、倍率２倍で、2.5秒間表示後、自動で閉じます）
追記（20250715）
初期バージョンにあった不具合を解消しました。主な改善点は以下の通りです。
（１）矢印型 Form の画面上の位置に応じて、矢印の向きとキャプチャ範囲を自動設定します。 （２）矢印形状（方向）のリアルタイム描画で、より直感的なキャプチャ範囲設定を可能としました。 （３）キャプチャ画面を指定時間後に自動で閉じる機能を追加しました（0.5秒刻みで設定可）※。
※ 指定時間経過後に拡大表示画面が自動で閉じる機能はデフォルト ON になっています。
また、上記改善を行った後、マルチモニター環境で行ったテストにおいて、プログラムの設計時、設定 Form の Scaled プロパティの確認を怠り、これを「 True のまま」としたため（なぜ、そうなっているのか、わかりませんが、 Delphi では Form の Scaled プロパティはデフォルト True なのです）、設定 Form に配置した VCL コントロールの配置がモニタの解像度によっては乱れてしまうことを確認し、一旦公開を中止して当該箇所の不具合を修正し、再度公開しました。
プログラムにはバージョン番号の表記等は一切ありませんので、矢印型 Form を右クリックすると表示されるサブメニューから「設定」をクリックして選択し、表示される設定画面が正常でない場合は、当記事のダウンロードリンクより、最新版の KindLens.exe をダウンロードしていただけますよう、伏してお願い申し上げます。
PCの画面を拡大表示できるツールは Windows の拡大鏡をはじめとしてさまざまなものがありますが、各種設定変更の必要性がなく、単一の実行形式ファイルのダブルクリックで起動し、マウス操作（ドラッグ＆ドロップと左ボタンクリック）のみで画面の拡大表示を実現できる無料ツールはおそらくないのではないかと思います。
使い方は･･･
【初期バージョン】※ 現在、ダウンロードできません。
（１）矢印型の Form を拡大表示したい領域の右下へドラッグして移動します。 （２）ドロップした矢印型 Form 上をクリック（マウスの左ボタンを押し下げ）します。 （３）ドロップした位置の左上方向の画面が、拡大表示されます。
また、矢印型の Form は、常に最前面に表示されますので、動画等を全画面表示している場合でも問題なく動作します。拡大表示は矢印型の Form 上をクリックすることで実行されますので、動画アプリの操作と干渉することはありません（動画を流したまま、その一部の拡大表示が「静止画」として可能※です）。
※ 私のPC環境では、TEAMSで配信した動画や、YouTube の動画は静止画として拡大表示できましたが、PC環境や通信方法によっては動画を静止画として取得できない場合があるかもしれません。また、このプログラムは Microsoft 社の Windows11 で開発し、同 OS 上で動作確認を行っています。他社製 OS 上での動作は未確認ですので、間接的な方法やエミュレーション技術を利用されて本プログラムを Windows 以外の OS 上で実行される場合は、プログラムそのものが動作しない可能性があることに十分ご注意ください。
【プログラムの開発環境（ご参考まで）】
・デバイスの仕様
デバイス名 XXX
プロセッサ 11th Gen Intel(R) Core(TM) i7-1185G7 @ 3.00GHz (3.00 GHz)
実装 RAM 32.0 GB (31.7 GB 使用可能)
デバイス ID
プロダクト ID
システムの種類 64 ビット オペレーティング システム、x64 ベース プロセッサ
ペンとタッチ 10 タッチ ポイントでのペンとタッチのサポート
・Windowsの仕様
エディション Windows 11 Pro
バージョン 24H2
インストール日 2024/10/05
OS ビルド 26100.4652
エクスペリエンス Windows 機能エクスペリエンス パック 1000.26100.128.0
・開発環境
Embarcadero® Delphi 12.3 （バージョン 29.0.55362.2017）
Professional with Mobile
矢印の色に「白」を設定した場合は、矢印の輪郭を黒で描画して白背景の画面でも矢印 Form の位置がわかるように工夫してあります。ただし、白以外の淡色を指定した場合は、このような黒い輪郭の描画は行われません。くれぐれもご注意ください※。
色を「白」に設定した場合、矢印の輪郭が黒い線で描画されます。
※ もし、矢印 Form の色を白以外のごく薄い淡色に設定して、矢印型 Form の表示位置がわからなくなった場合は、タスクバーに表示されている KindLens のアイコンを右クリックして表示されるメニューから「ウィンドウを閉じる」を選択（クリック：マウスの左ボタン押し下げ）する方法で、プログラムを終了することができます。
設定状態を保存していない場合は、次回起動時には矢印型 Form の色は以前の状態に戻ると思いますが、ごく薄い淡色の設定状態を保存した場合は、KindLens.exe と同じ場所にある KindLens.ini を削除してから KindLens.exe を起動してください。矢印型 Form は初期設定の赤い状態で表示されます。その後、必要に応じて各種設定を変更してください。設定変更後、「保存」ボタンをクリックすれば、拡張子が ini のイニシャライズファイルが再作成され、新しい設定がこのファイルに保存されます。
プログラムの起動に成功すると、初期状態では赤い矢印型 Form がお使いの PC の画面中央に表示されますが、ダウンロード＆展開直後の最初の実行（プログラム起動）時には Windows の保護機能が働いて、次に示す Windows Defender SmartScreen による警告画面が表示されます。
また、このプログラムの動作には「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 を実行できました。
天候は晴れているが、出発時、瞬く星を見て予想した通り、強風が時折り吹いてくる。「吹き荒ぶ」のではなく、思い出したような吹き方の風だ。「吹き荒れてない」のは救いだが、ただ、その時折り吹く強風は一気に体温を奪って行くほどに冷たい。半袖の汗をよく通す速乾性の下着に、こちらもまた通気性に優れた長袖の行動着１枚では、到底、耐えられない。時間は惜しいがザックを降ろし、素早く F 社製のシェルジャケットを取り出して、身に纏う。
実は、この Blog の過去の記事で「失敗の記録」として掲載した手書き文字認識チャレンジの試行錯誤の記事を書いた当時、文字の認識に失敗した最大の原因は「正しく文字を切り出せなかった」ことにありました。今回、テストしたのは、たった３枚の画像ですが、いずれも問題なく文字が記入されている位置をプログラムは特定し、その正確な切り出しに成功しています。
次は、完成した学習モデルを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;
生成 AI なんてまだなかったあの頃･･･（知らないところで、それは･･･ ほぼ出来上がりつつあったのだろうけれど･･･。 そう、考えると同時期にレベルの差はあれど、まったく同じ研究をやったと言うことで、たまらなく誇らしいような、いや、それはただの偶然の一致で･･･ 一方は AI というカタチで見事にモノになり、僕のは無駄な努力で終わり･･･もし、プログラムが当時のまま、今後進化しないのであれば･･･ みたいな複雑な気持ちではありますが ）、いずれにしても、その時、僕は Google 先生を頼りに『 機械学習の真似事 』を行い、右も、左も、わからないまま、結局 keras や Lobe のお近づきになれたよーな･･･ なれなかったよーな･･･
import cv2
import pytesseract
import re
import os
# Tesseract-OCRのパス設定
pytesseract.pytesseract.tesseract_cmd = r"C:\Python39-32\Tesseract-OCR\tesseract.exe"
def preprocess_image(image_path):
""" 画像を前処理してOCRに適した状態にする """
# グレースケール化
image = cv2.imread(image_path, cv2.IMREAD_GRAYSCALE)
# 二値化
_, binary = cv2.threshold(image, 128, 255, cv2.THRESH_BINARY_INV + cv2.THRESH_OTSU)
return binary
def extract_katakana(image):
""" OCRでカタカナを認識する """
custom_oem_psm = "--oem 3 --psm 10 -l jpn"
text = pytesseract.image_to_string(image, config=custom_oem_psm)
# カタカナ1文字のみを抽出
# match = re.search(r'[アイウエオ]', text)
return match.group(0) if match else "N"
def process_images_in_folder(folder_path):
""" 指定フォルダ内のすべての画像を処理 """
image_extensions = (".png", ".jpg", ".jpeg", ".bmp", ".tif", ".tiff")
for filename in os.listdir(folder_path):
# 画像ファイルのみ処理
if filename.lower().endswith(image_extensions):
image_path = os.path.join(folder_path, filename)
processed_image = preprocess_image(image_path)
result = extract_katakana(processed_image)
print(f"{filename}: OCR結果 -> {result}")
if __name__ == "__main__":
# 画像が入っているフォルダのパス
folder_path = "Images_Tegaki\img1_a"
process_images_in_folder(folder_path)
結果は次の通り。
画像は、全部カタカナの「ア」なんだけどなー。 「N」はともかく、なんで「イ」があるのかなー？
全体の集計では･･･
正解率は 23.3 ％ ･･･
ただ、「ウ・エ・オ」はありませんでした。そこで･･･
match = re.search(r'[ア]', text)
「ア」１文字で勝負してみました。結果はまったく同じでありました！
よくよく考えれば、同じ文字認識アルゴリズムで「ア」を判定しているのですから、これは当然です。
64 bit バージョンの方は最新版が「最近の日付」でしたから、これより良い結果が得られる可能性があるような気がしますが、僕が使いたい 32 bit バージョンに限っての話をしていますので、この時点で手書き文字の認識に Tesseract-OCR の 32 bit バージョンを使用するか、否か、という問題は、はっきり「 否 」と答えが出ました。
過去の記事にも書きましたが、これは「手書き文字の認識（それも「ア」１文字）」に限った話であり、他のカタカナ文字については実験もしておりませんし、これを持って、Tesseract-OCR 32 bit バージョンの総合的な「手書き文字」を認識する性能を否定する意図はまったくありません。
C:\>cd Python39-32
C:\Python39-32>python -m pip install --upgrade pip
Requirement already satisfied: pip in c:\python39-32\lib\site-packages (22.3.1)
Collecting pip
Using cached pip-25.0.1-py3-none-any.whl (1.8 MB)
Installing collected packages: pip
Attempting uninstall: pip
Found existing installation: pip 22.3.1
Uninstalling pip-22.3.1:
Successfully uninstalled pip-22.3.1
WARNING: The scripts pip.exe, pip3.9.exe and pip3.exe are installed in 'C:\Python39-32\Scripts' which is not on PATH.
Consider adding this directory to PATH or, if you prefer to suppress this warning, use --no-warn-script-location.
Successfully installed pip-25.0.1
C:\Python39-32>python.exe -m pip install C:\Python39-32\scikit_learn-0.24.2-cp39-cp39-win32.whl
Processing c:\python39-32\scikit_learn-0.24.2-cp39-cp39-win32.whl
Requirement already satisfied: numpy>=1.13.3 in c:\python39-32\lib\site-packages (from scikit-learn==0.24.2) (1.21.5)
Collecting scipy>=0.19.1 (from scikit-learn==0.24.2)
Using cached scipy-1.13.1.tar.gz (57.2 MB)
Installing build dependencies ... done
Getting requirements to build wheel ... done
ERROR: Exception:
Traceback (most recent call last):
File "C:\Python39-32\lib\site-packages\pip\_internal\cli\base_command.py", line 106, in _run_wrapper
status = _inner_run()
File "C:\Python39-32\lib\site-packages\pip\_internal\cli\base_command.py", line 97, in _inner_run
return self.run(options, args)
File "C:\Python39-32\lib\site-packages\pip\_internal\cli\req_command.py", line 67, in wrapper
return func(self, options, args)
File "C:\Python39-32\lib\site-packages\pip\_internal\commands\install.py", line 386, in run
requirement_set = resolver.resolve(
File "C:\Python39-32\lib\site-packages\pip\_internal\resolution\resolvelib\resolver.py", line 95, in resolve
result = self._result = resolver.resolve(
File "C:\Python39-32\lib\site-packages\pip\_vendor\resolvelib\resolvers.py", line 546, in resolve
state = resolution.resolve(requirements, max_rounds=max_rounds)
File "C:\Python39-32\lib\site-packages\pip\_vendor\resolvelib\resolvers.py", line 427, in resolve
failure_causes = self._attempt_to_pin_criterion(name)
File "C:\Python39-32\lib\site-packages\pip\_vendor\resolvelib\resolvers.py", line 239, in _attempt_to_pin_criterion
criteria = self._get_updated_criteria(candidate)
File "C:\Python39-32\lib\site-packages\pip\_vendor\resolvelib\resolvers.py", line 230, in _get_updated_criteria
self._add_to_criteria(criteria, requirement, parent=candidate)
File "C:\Python39-32\lib\site-packages\pip\_vendor\resolvelib\resolvers.py", line 173, in _add_to_criteria
if not criterion.candidates:
File "C:\Python39-32\lib\site-packages\pip\_vendor\resolvelib\structs.py", line 156, in __bool__
return bool(self._sequence)
File "C:\Python39-32\lib\site-packages\pip\_internal\resolution\resolvelib\found_candidates.py", line 174, in __bool__
return any(self)
File "C:\Python39-32\lib\site-packages\pip\_internal\resolution\resolvelib\found_candidates.py", line 162, in <genexpr>
return (c for c in iterator if id(c) not in self._incompatible_ids)
File "C:\Python39-32\lib\site-packages\pip\_internal\resolution\resolvelib\found_candidates.py", line 53, in _iter_built
candidate = func()
File "C:\Python39-32\lib\site-packages\pip\_internal\resolution\resolvelib\factory.py", line 187, in _make_candidate_from_link
base: Optional[BaseCandidate] = self._make_base_candidate_from_link(
File "C:\Python39-32\lib\site-packages\pip\_internal\resolution\resolvelib\factory.py", line 233, in _make_base_candidate_from_link
self._link_candidate_cache[link] = LinkCandidate(
File "C:\Python39-32\lib\site-packages\pip\_internal\resolution\resolvelib\candidates.py", line 304, in __init__
super().__init__(
File "C:\Python39-32\lib\site-packages\pip\_internal\resolution\resolvelib\candidates.py", line 159, in __init__
self.dist = self._prepare()
File "C:\Python39-32\lib\site-packages\pip\_internal\resolution\resolvelib\candidates.py", line 236, in _prepare
dist = self._prepare_distribution()
File "C:\Python39-32\lib\site-packages\pip\_internal\resolution\resolvelib\candidates.py", line 315, in _prepare_distribution
return preparer.prepare_linked_requirement(self._ireq, parallel_builds=True)
File "C:\Python39-32\lib\site-packages\pip\_internal\operations\prepare.py", line 527, in prepare_linked_requirement
return self._prepare_linked_requirement(req, parallel_builds)
File "C:\Python39-32\lib\site-packages\pip\_internal\operations\prepare.py", line 642, in _prepare_linked_requirement
dist = _get_prepared_distribution(
File "C:\Python39-32\lib\site-packages\pip\_internal\operations\prepare.py", line 72, in _get_prepared_distribution
abstract_dist.prepare_distribution_metadata(
File "C:\Python39-32\lib\site-packages\pip\_internal\distributions\sdist.py", line 56, in prepare_distribution_metadata
self._install_build_reqs(finder)
File "C:\Python39-32\lib\site-packages\pip\_internal\distributions\sdist.py", line 126, in _install_build_reqs
build_reqs = self._get_build_requires_wheel()
File "C:\Python39-32\lib\site-packages\pip\_internal\distributions\sdist.py", line 103, in _get_build_requires_wheel
return backend.get_requires_for_build_wheel()
File "C:\Python39-32\lib\site-packages\pip\_internal\utils\misc.py", line 702, in get_requires_for_build_wheel
return super().get_requires_for_build_wheel(config_settings=cs)
File "C:\Python39-32\lib\site-packages\pip\_vendor\pyproject_hooks\_impl.py", line 196, in get_requires_for_build_wheel
return self._call_hook(
File "C:\Python39-32\lib\site-packages\pip\_vendor\pyproject_hooks\_impl.py", line 402, in _call_hook
raise BackendUnavailable(
pip._vendor.pyproject_hooks._impl.BackendUnavailable: Cannot import 'mesonpy'
そこで、観点別評価と評定を入力したファイル（ Excel Book の拡張子が xls, xlsx, xlsm いずれかのファイル）を任意のフォルダに入れ（もちろん、複数個入っていてもよい）、ここで紹介する「観点別評価と評定の整合性をチェックするプログラム」を起動、フォルダを選択するだけで、データのセル番地など、一切指定しなくても各々のファイルに入力された観点別評価と評定の整合性を全自動でチェック（整合性に問題がある場合、オプションで指定すれば観点別評価に基づいて評定を自動修正）してくれるプログラムを書いてみました。
チェック完了時、問題がなかった場合に表示される画面
実際に使ってもらい、「これはイイ！」と評価していただけましたので、ここでフリーソフトとして公開します。「 Excel Book に入力された観点別評価と評定の整合性をチェックするよい方法はないか？」と、悩んでいらっしゃる方にお使いいただけたら、何よりの幸いです。気がついた不具合はすべて解消してありますが、未発見のバグがまだどこかにあるかもしれません。このプログラムはあくまでも「素人」が、「趣味」で書いたものであり、思い込みや勘違いによる誤りを内包している可能性があります。大変、申し訳ないのですが、どうか、そこだけはご了承ください。
お手数をお掛けして申し訳ありませんが、信頼できる発行元になるために必要なデジタル署名を取得する費用等を考えますと、個人レベルで、その申請手続きを行うことは私の場合、無理と言わざるを得ません。開発に使用している IDE （ Delphi 12.3 ）のサブスクリプション費用の支払いだけは Object Pascal の発展を願う１ユーザーとしての気持ちからずっと続けていますが･･･。
なお、最初にアップロードした実行形式ファイルで「自動修正」を有効にした状態で設定を保存すると、次回起動時に Form が表示される前に自動修正を有効化する処理が行われてしまい、「無効/非表示ウィンドウにはフォーカスを設定できません。」というエラーメッセージが表示されてしまうバグがあることに気づき、「自動修正」を有効にした状態で設定を保存しても、次回起動時に Form の表示が完全に行われてから、自動修正を有効化する処理が実行されるように、プログラムを修正しました。
登山前日に降ったばかりのフカフカの新雪で、スノーシューを履いていても一歩踏み出すごとに足が数十センチは雪に潜り、スノーシュー無しで一緒に登ったアイゼン組のメンバーからは「二度と行きたくない山ナンバーワン（もちろん冗談。それくらいキツかったということ？）」との感想も出た中で、僕は筋肉痛すら出ず（先輩に勧められて食べたサラダチキンの効用も多分にあり？）。もちろん、先輩の修理により、見事復活した My スノーシューは、終日、外れる気配すらなし。
A3 サイズのシートも作成してみたのだが、A3 サイズだとインクジェット複合機を利用して印刷（輪転機での印刷はマークの濃度が濃くなり、誤判定が出やすくなることから非推奨･･･というか、ユーザーには禁止と案内している）する時間が B4 サイズのそれより明らかに遅くなる、スキャナーでの読み取り処理にも時間がかかる等、いろいろ問題があり、少々マークの文字は小さくなるが A 版に比べて何かとメリットが多い B 版の用紙を使うことに決定。
もちろん、国際的にはやはり A 版だと思うが、欧米文化圏で My マークシートリーダーが使われるシーンはさすがに想像できない。できないが、今年、いちばんの夢は英語バージョンを作成することだ。これは新年早々に思いつき、数学用シートの処理プログラムが完成したら、今年の次のチャレンジ・イベントはそれだと思っている。
procedure TFormMSReader.ProcDataRead(Sender: TObject);
var
// （略）
strMsg:string;
Ext1, Ext2: string;
Extension:string;
//jpg とjpeg が同一フォルダ内に混在していないことを確認する_20250302追加
function HasMixedExtensions(const FolderPath: string): Boolean;
var
SearchRec: TSearchRec;
JPGFound, JPEGFound: Boolean;
begin
JPGFound := False;
JPEGFound := False;
if FindFirst(FolderPath + '\*.jpg', faAnyFile, SearchRec) = 0 then
begin
JPGFound := True;
FindClose(SearchRec);
end;
if FindFirst(FolderPath + '\*.jpeg', faAnyFile, SearchRec) = 0 then
begin
JPEGFound := True;
FindClose(SearchRec);
end;
Result := JPGFound and JPEGFound;
end;
//ファイル名が連番であるかどうか、確認
function IsSequentialFileNames(const DirPath: String;
var Extension1, Extension2: String): Boolean;
var
FileList: TStringList;
FileNumbers: TList<Integer>;
i, j, numStart: Integer;
tempFileName, fileName, fileNum: string;
begin
//Falseで初期化
Result := False;
//指定されたディレクトリ内から、指定された拡張子のファイル名を抽出する
FileList := TStringList.Create;
FileNumbers := TList<Integer>.Create;
try
for j := 0 to 1 do
begin
//小文字に変換して拡張子を指定
case j of
0:Extension:= LowerCase(Extension1);
1:Extension:= LowerCase(Extension2);
end;
for tempFileName in TDirectory.GetFiles(DirPath, '*' + Extension) do
begin
// ファイル名からパスと拡張子を除去
fileName := TPath.GetFileNameWithoutExtension(tempFileName);
//数値部分を抽出
numStart := TRegEx.Match(fileName, '\d+$').Index;
if numStart <= 0 then
Exit; // 数値部分がない場合はFalseを返す
fileNum := Copy(fileName, numStart, Length(fileName) - numStart + 1);
if TryStrToInt(fileNum, i) then
FileNumbers.Add(i);
end;
//数値部分があるファイルのみ抽出し、比較する
if FileNumbers.Count > 0 then
begin
FileNumbers.Sort;
for i := 1 to FileNumbers.Count - 1 do
begin
if FileNumbers[i] <> FileNumbers[i - 1] + 1 then
Exit; //連番でない場合はFalseを返す
end;
Result := True; //連番である場合はTrueを返す
end;
end;
finally
FileList.Free;
FileNumbers.Free;
end;
end;
begin
//文字列型変数 Path に画像ファイルを入れたフォルダへのパスを指定する
//jpg とjpeg が同一フォルダ内に混在していないことを確認する_20250302追加
if HasMixedExtensions(Path) then
begin
strMsg:='jpg とjpeg の２種類の拡張子が混在しています。'+#13#10+
'拡張子はjpg か jpeg のどちらかに統一してください。'+#13#10+
'処理を中止します。';
Application.MessageBox(PChar(strMsg), PChar('エラー'), MB_ICONERROR);
Exit;
end else begin
//確認用
//strMsg:='拡張子の混在はありません！';
//Application.MessageBox(PChar(strMsg), PChar('エラー'), MB_ICONERROR);
end;
//画像ファイルを読み込む処理でファイル名が連番であるかどうか、確認する
try
Ext1:='jpg';
Ext2:='jpeg';
if IsSequentialFileNames(Path, Ext1, Ext2) then
begin
//確認用
//strMsg:='ファイル番号は連番です！';
//Application.MessageBox(PChar(strMsg), PChar('情報'), MB_ICONINFORMATION);
//Blog用に実験
//raise Exception.Create('T_T');
end else begin
strMsg:='ファイル番号が連番ではありません！';
Application.MessageBox(PChar(strMsg), PChar('エラー'), MB_ICONERROR);
Exit;
end;
except
on E: Exception do
begin
strMsg:='大変です。本物のエラーが発生しました: ' + E.Message;
Application.MessageBox(PChar(strMsg), PChar('エラー'), MB_ICONERROR);
end;
end;
end;
リンク先ページの中ほどに「Microsoft Windows」というタイトルがあり、「Click to download the PDFtk Server installer for Windows 10 and 11:」という説明の下に「Windows Download」があるので、これをクリックして「pdftk_server-2.02-win-setup.exe」（2025年２月９日現在）をダウンロードしてインストールしておく。
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
Vcl.Grids, Vcl.StdCtrls;
type
TForm1 = class(TForm)
StringGrid1: TStringGrid;
CheckBox1: TCheckBox;
procedure FormCreate(Sender: TObject);
procedure StringGrid1SelectCell(Sender: TObject; ACol, ARow: LongInt;
var CanSelect: Boolean);
procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: LongInt;
Rect: TRect; State: TGridDrawState);
procedure StringGrid1KeyPress(Sender: TObject; var Key: Char);
procedure StringGrid1SetEditText(Sender: TObject; ACol, ARow: LongInt;
const Value: string);
private
{ Private 宣言 }
//StringGridの列数を設定 -> FormCreate時に設定する
StrGrid1ColCount: Integer;
//Formの表示終了イベントを取得
procedure CMShowingChanged(var Msg:TMessage); message CM_SHOWINGCHANGED;
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.CMShowingChanged(var Msg: TMessage);
begin
inherited; {通常の CMShowingChagenedをまず実行}
if Visible then
begin
Update; {完全に描画}
//セットフォーカス
StringGrid1.Col:=1;
StringGrid1.Row:=1;
StringGrid1.SetFocus;
//セルの編集を開始（ユーザーのクリックを待つ場合はコメント化する）
StringGrid1.Options := StringGrid1.Options + [goEditing];
//カーソルが見えるようにする
StringGrid1.EditorMode:=True;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
i:integer;
begin
//列数
StrGrid1ColCount:=3;
StringGrid1.ColCount:=StrGrid1ColCount;
//FixedCols & FixedRows（固定列と固定行）を設定
StringGrid1.FixedCols:=1;
StringGrid1.FixedRows:=1;
StringGrid1.Rows[0].CommaText:='番号,連番,TF';
//FixedRows（固定行）に値をセット
for i:= 1 to StringGrid1.RowCount do
begin
StringGrid1.Rows[i].Append(IntToStr(i));
end;
end;
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: LongInt;
Rect: TRect; State: TGridDrawState);
begin
if StringGrid1.Cells[ACol,ARow]<>'' then
begin
//背景色を白に設定
StringGrid1.Canvas.Brush.Color:=clWhite;
//セルを塗りつぶす
StringGrid1.Canvas.FillRect(Rect);
//テキストを表示（中央寄せ）
DrawText(StringGrid1.Canvas.Handle,
PChar(StringGrid1.Cells[ACol,ARow]),
//[+1]は数値描画位置の調整のため
Length(StringGrid1.Cells[ACol,ARow])+1,Rect,
DT_CENTER or DT_VCENTER or DT_SINGLELINE);
end;
end;
procedure TForm1.StringGrid1KeyPress(Sender: TObject; var Key: Char);
begin
//[Enter]キーでコントロールを移動
if Ord(Key)=VK_RETURN then
begin
if ActiveControl is TStringGrid then
begin
if TStringGrid(ActiveControl).EditorMode then
begin
//VK_TABではカーソルがレコードの項目を右へ移動。
//ActiveControl.Perform(WM_KEYDOWN,VK_TAB,0);
//VK_DOWNにすると同じ項目の次のレコードへ移動。
ActiveControl.Perform(WM_KEYDOWN,VK_DOWN,0);
Key:=#0;
end;
end else begin
SelectNext(ActiveControl,True,True);
Key:=#0;
end;
end;
end;
列の編集の可否を制御したい場合は、以下のコードで実現可能。
procedure TForm1.StringGrid1SelectCell(Sender: TObject; ACol, ARow: LongInt;
var CanSelect: Boolean);
begin
//列の編集の可否
if (ACol=StrGrid1ColCount-1) then
begin
//セルの編集は不可
TStringGrid(Sender).Options:=TStringGrid(Sender).Options-[goEditing];
end else begin
//セルは編集可能
TStringGrid(Sender).Options:=TStringGrid(Sender).Options+[goEditing];
end;
end;
procedure TForm1.StringGrid1SetEditText(Sender: TObject; ACol, ARow: LongInt;
const Value: string);
var
NewValue: Integer;
procedure UpdateColumnData(StartRow, NewValue: Integer);
var
i: Integer;
begin
for i := StartRow + 1 to StringGrid1.RowCount - 1 do
StringGrid1.Cells[StrGrid1ColCount-2, i] := IntToStr(NewValue + 1);
end;
begin
//チェックボックスがチェックされていたら
if CheckBox1.Checked then
begin
//行を自動入力
if ACol = StrGrid1ColCount-2 then
begin
if TryStrToInt(Value, NewValue) then
begin
UpdateColumnData(ARow, NewValue);
end;
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
ColumnValues: TStringList;
i: Integer;
ErrorRows: TStringList;
ErrorMessage: string;
function IsSequential(Column: TStrings; out ErrorRows: TStringList): Boolean;
var
k, CurrentValue, ExpectedValue: Integer;
begin
Result := True; //初期状態で連番と仮定
ErrorRows.Clear;
if Column.Count = 0 then
Exit; //空の場合は連番とみなす
CurrentValue := StrToInt(Column[0]);
for k := 1 to Column.Count - 1 do
begin
//現在の値が同じであれば次の行へ
if StrToInt(Column[k]) = CurrentValue then
begin
Continue;
end else begin
//現在の値が変わった場合、期待される次の値は1増加
ExpectedValue := CurrentValue + 1;
//期待される次の値と一致しなければ連番ではない（同じ値のくり返しは許可する）
//if StrToInt(Column[k]) <> ExpectedValue then
if (StrToInt(Column[k]) = CurrentValue) or
(StrToInt(Column[k]) <> ExpectedValue) then
begin
Result := False;
//エラーの行番号を追加（1から始まるインデックスのため +1）
ErrorRows.Add(IntToStr(k + 1));
Exit;
end else begin
CurrentValue := ExpectedValue;
end;
end;
end;
end;
begin
//連番になっていることを確認
ColumnValues := TStringList.Create;
ErrorRows := TStringList.Create;
try
//StringGridの第1列（インデックス0）を取得
for i := 1 to StringGrid1.RowCount - 1 do
begin
ColumnValues.Add(StringGrid1.Cells[1, i]);
end;
if IsSequential(ColumnValues, ErrorRows) then
begin
ShowMessage('連番です'); //確認用
end else begin
//連番でない行がある場合のメッセージ
ErrorMessage := ErrorRows.CommaText + ' 行目が連番ではありません！';
Application.MessageBox(PChar(ErrorMessage), PChar('エラー'), MB_ICONSTOP);
StringGrid1.Col:=1;
StringGrid1.Row:=StrToInt(ErrorRows.CommaText);
StringGrid1.SetFocus;
Exit;
end;
finally
ColumnValues.Free;
ErrorRows.Free;
end;
end;
実行（F9）して、動作テスト。
10行目にわざと連番ではない値を入力して動作テスト
同じ値の繰り返しは許可するようにコーディングしたので、次のような場合は連番と判断する。
//期待される次の値と一致しなければ連番ではない（同じ値のくり返しは許可する）
//if StrToInt(Column[k]) <> ExpectedValue then
if (StrToInt(Column[k]) = CurrentValue) or
(StrToInt(Column[k]) <> ExpectedValue) then
begin
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: LongInt;
Rect: TRect; State: TGridDrawState);
var
Value: String;
CellColor: TColor;
ColorMap: TDictionary<String, TColor>;
function GetLightColor(BaseColor: TColor): TColor;
var
R, G, B: Byte;
pct: Double; //パーセントを指定する変数
begin
// RGB値を取得
R := GetRValue(ColorToRGB(BaseColor));
G := GetGValue(ColorToRGB(BaseColor));
B := GetBValue(ColorToRGB(BaseColor));
//薄い色に調整（50%白に近づける場合）
//R := (R + 255) div 2;
//G := (G + 255) div 2;
//B := (B + 255) div 2;
//80%白に近づける場合
//元のRGB値を20%だけ残し、残りの80%を白（255, 255, 255）に近づける
//R := Round(R * 0.2 + 255 * 0.8);
//G := Round(G * 0.2 + 255 * 0.8);
//B := Round(B * 0.2 + 255 * 0.8);
//薄い色に調整
pct:=StrToFloat('0.' + ComboBox1.Text);
R := Round(R * (1-pct) + 255 * pct);
G := Round(G * (1-pct) + 255 * pct);
B := Round(B * (1-pct) + 255 * pct);
Result := RGB(R, G, B);
end;
procedure AssignColorsToValues(ACol: Integer);
var
i: Integer;
Value: String;
BaseColors: TArray<TColor>; //動的配列として宣言（解放はDelphiにまかせる）
ColorIndex: Integer;
begin
ColorMap.Clear;
ColorIndex := 0;
BaseColors:=[clRed, clGreen, clBlue, clYellow, clAqua, clFuchsia];
for i := 1 to StringGrid1.RowCount - 1 do
begin
Value := StringGrid1.Cells[ACol, i];
if not ColorMap.ContainsKey(Value) then
begin
//色を薄く調整したものを登録
ColorMap.Add(Value, GetLightColor(BaseColors[ColorIndex mod Length(BaseColors)]));
Inc(ColorIndex);
end;
end;
end;
begin
//前掲のコードは、Gridの初期化も兼ねる
if StringGrid1.Cells[ACol,ARow]<>'' then
begin
//背景色を白に設定
StringGrid1.Canvas.Brush.Color:=clWhite;
//セルを塗りつぶす
StringGrid1.Canvas.FillRect(Rect);
//テキストを表示（中央寄せ）
DrawText(StringGrid1.Canvas.Handle,
PChar(StringGrid1.Cells[ACol,ARow]),
//[+1]は数値描画位置の調整のため
Length(StringGrid1.Cells[ACol,ARow])+1,Rect,
DT_CENTER or DT_VCENTER or DT_SINGLELINE);
end;
if ARow = 0 then Exit; //ヘッダー行はスキップ
ColorMap := TDictionary<String, TColor>.Create;
//色分け対象列を指定
AssignColorsToValues(1); //ColorMapをCreateしてから呼び出すこと！
try
if ACol = 1 then //対象列をチェック
begin
Value := StringGrid1.Cells[ACol, ARow];
if ColorMap.TryGetValue(Value, CellColor) then
begin
StringGrid1.Canvas.Brush.Color := CellColor;
StringGrid1.Canvas.FillRect(Rect);
//テキストを表示（中央寄せ）_[+1]は数値描画位置の調整のため
DrawText(StringGrid1.Canvas.Handle,
PChar(StringGrid1.Cells[ACol,ARow]),
Length(StringGrid1.Cells[ACol,ARow])+1,Rect,
DT_CENTER or DT_VCENTER or DT_SINGLELINE);
end;
end else begin
StringGrid1.Canvas.FillRect(Rect);
//テキストを表示（中央寄せ）_[+1]は数値描画位置の調整のため
DrawText(StringGrid1.Canvas.Handle,
PChar(StringGrid1.Cells[ACol,ARow]),
Length(StringGrid1.Cells[ACol,ARow])+1,Rect,
DT_CENTER or DT_VCENTER or DT_SINGLELINE);
end;
finally
ColorMap.Free;
end;
end;
さらに、FormCreate 手続きで ComboBox の選択肢の準備と初期化を行うように設定。
procedure TForm1.FormCreate(Sender: TObject);
var
i:integer;
begin
//前掲の通りなので略
//色の濃さを調節
for i := 1 to 99 do
begin
ComboBox1.Items.Add(IntToStr(i));
end;
//初期値を設定
ComboBox1.Text:='50';
end;
procedure TForm1.StringGrid1SelectCell(Sender: TObject; ACol, ARow: LongInt; var CanSelect: Boolean); begin //列の編集の可否 if (ACol=StrGrid1ColCount-1) then begin //セルの編集は不可 TStringGrid(Sender).Options:=TStringGrid(Sender).Options-[goEditing]; end else begin //セルは編集可能 TStringGrid(Sender).Options:=TStringGrid(Sender).Options+[goEditing]; end; end;
procedure TForm1.ToggleSGCell(ACol, ARow: Integer);
begin
//現在の値を切り替え
if StringGrid1.Cells[ACol, ARow] = '1' then
StringGrid1.Cells[ACol, ARow] := '0'
else
StringGrid1.Cells[ACol, ARow] := '1';
//再描画をトリガ（即座に変更を表示）
StringGrid1.Invalidate;
end;
UpdateColumnData のコードは、次の通り。
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);
//if (ACol = StrGrid1ColCount-1) and (ARow >= 0) then
//0行目（FixedRow）では動作しないように設定
if (ACol = StrGrid1ColCount-1) and (ARow > 0) then
//UpdateColumnData(ARow);
//引数にはCMS設定値が入る
UpdateColumnData(StrToInt(StringGrid1.Cells[StrGrid1ColCount-2, ARow]), True);
end;
TF列の任意のセルをクリックして、スペースキー押し下げで入力値を「０」に切り替える。
procedure TForm1.StringGrid1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
//スペースキーで０と１を切り替え
if (StringGrid1.Col = StrGrid1ColCount-1) and (StringGrid1.Row > 0) and (Key = VK_SPACE) then
begin
ToggleSGCell(StringGrid1.Col, StringGrid1.Row);
UpdateColumnData(StrToInt(StringGrid1.Cells[StrGrid1ColCount-2, StringGrid1.Row]), False);
Key := 0;
end;
end;
TF列をゼロで初期化するため、FormCreate 手続きの既存のコードに次のコードを追加。
//FixedRows（固定行）に値をセット
for i:= 1 to StringGrid1.RowCount do
begin
StringGrid1.Rows[i].Append(IntToStr(i));
//TF列をゼロで初期化
StringGrid1.Cells[2,i] := '0';
end;
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; //マークを入れる２次元の動的配列
sArr: array of array of Boolean; //採点結果を入れる２次元の動的配列
cms_mArr: TString2DArray; //マークの組み合わせを入れる２次元の動的配列
cms_cArr: TString1DArray; //正解の組み合わせを入れる１次元の動的配列
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;
//１問１答の通常採点用の配列を準備
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;
procedure TForm1.RestartApplication;
var
FileName: string;
StartupInfo: TStartupInfo;
ProcessInfo: TProcessInformation;
begin
FileName := ParamStr(0);
ZeroMemory(@StartupInfo, SizeOf(StartupInfo));
StartupInfo.cb := SizeOf(StartupInfo);
ZeroMemory(@ProcessInfo, SizeOf(ProcessInfo));
if CreateProcess(PChar(FileName), nil, nil, nil, False, 0, nil, nil, StartupInfo, ProcessInfo) then
begin
CloseHandle(ProcessInfo.hProcess);
CloseHandle(ProcessInfo.hThread);
end;
Application.Terminate;
end;
以上のように手続き・関数を準備して、FormCreate 時の設定。
procedure TForm1.FormCreate(Sender: TObject);
begin
//チェックボックスの状態をロード中に OnClick イベントがトリガーされるのを防止する
IsLoading:=False;
LoadCheckCMS_State(CheckCMS); //Checked プロパティを復元
if IsRestarting then
ClearRestartFlag; //再起動フラグをクリア
end;
最後に、いちばん肝心な CheckCMSClick 手続き。実際は、ここからすべてが始まる。
procedure TForm1.CheckCMSClick(Sender: TObject);
var
strMsg: string;
begin
//再起動状態でなければ実行
if not IsLoading then
begin
SaveCheckCMS_State(CheckCMS); //Checked プロパティを保存
//最初はコレでいいかと思ったんだけれど･･･あまりにも乱暴な気が。
//strMsg:='設定はプログラムの再起動後に有効になります。'+#13#10+
// 'OKで再起動します。';
//Application.MessageBox(PChar(strMsg), PChar('情報'), MB_ICONINFORMATION);
//RestartApplication;
//操作の取り消しができるように修正
strMsg:='設定はプログラムの再起動後に有効になります。'+#13#10+
'再起動してよろしいですか？';
if Application.MessageBox(PChar(strMsg), PChar('情報'), MB_YESNO or MB_ICONINFORMATION) = mrYes then
begin
//[はい]が選ばれた時
RestartApplication;
end else begin
//[いいえ]が選ばれた時
//メッセージを表示せず、チェックボックスの状態のみ変更
if CheckCMS.Checked then
begin
CheckCMS.OnClick := nil; //OnClickイベントを一時的に無効にする
CheckCMS.Checked := False;
CheckCMS.OnClick := CheckCMSClick; //OnClickイベントを再度設定
end else begin
CheckCMS.OnClick := nil; //OnClickイベントを一時的に無効にする
CheckCMS.Checked := True;
CheckCMS.OnClick := CheckCMSClick; //OnClickイベントを再度設定
end;
end;
end;
end;
ちなみに LLM は（今回、初めて知った！のですが）、自然言語処理（ Natural Language Processing ：NLP ）のタスク※に使用される大規模言語モデル（ Large Language Model ）の略で、膨大な量のテキストデータを使って訓練された人工知能のモデルを意味するそうです。
※ 自然言語処理のタスク：「コンピュータがヒトの言語を理解し、生成し、処理する上での特定の課題や目的」のこと。すなわち、文章の生成、分類、翻訳、応答、人名・地名・組織名等の特定の名称認識（ Named Entity Recognition：NER ）、音声認識、要約など、実に様々な「タスク」があるようです。
調べてみると実にたくさんの LLM があり、果たしてどのモデルを選べばよいのか（例えば、日本語が得意で、プログラミングに適したモデルはどれなのか？）がわからず、当初、たいへん困りましたが、いくつかの Web サイトの情報を参考に、ここでは「 Gemma 2 」と「 Llama-3-ELYZA-JP-8B 」をダウンロードして使ってみました。
いくつかの Web サイトを参照して、まず「Gemma（ジェマ）」という LLM を試してみようかと思いました。正直、専門的なことは「チンプンカンプン」で「まったくわからない」私ですが、様々なサイトで「高性能」と評価されていたこと、そして何より、インストールがとても簡単そうだったのがいちばんの理由です。
C:\Users\ユーザー名>ollama create elyza:jp8b -f Modelfile
Error: open C:\Users\ユーザー名\Modelfile: The system cannot find the file specified.
（ Modelfile が見えません･･･ あっ☆）
そこで次のようにしてカレントディレクトリを .ollama に変更。
C:\Users\ユーザー名>cd .ollama
もう一度、上記のモデル作成のコマンドを実行。
C:\Users\ユーザー名\.ollama>ollama create elyza:jp8b -f Modelfile
transferring model data 100%
using existing layer sha256:91553c45080b11d95be21bb67961c9a5d2ed7556275423efaaad6df54ba9beae
creating new layer sha256:8ab4849b038cf0abc5b1c9b8ee1443dca6b93a045c2272180d985126eb40bf6f
creating new layer sha256:c0aac7c7f00d8a81a8ef397cd78664957fbe0e09f87b08bc7afa8d627a8da87f
creating new layer sha256:bc526ae2132e2fc5e7ab4eef535720ce895c7a47429782231a33f62b0fa4401f
writing manifest
success
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
var
strMsg: string;
//Excelのプロセスが実行中であるか、どうかを調査する関数
function IsExcelRunning: Boolean;
var
Snapshot: THandle;
ProcessEntry: TProcessEntry32;
begin
Result := False;
Snapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
if Snapshot = INVALID_HANDLE_VALUE then Exit;
ProcessEntry.dwSize := SizeOf(TProcessEntry32);
if Process32First(Snapshot, ProcessEntry) then
begin
repeat
if SameText(ProcessEntry.szExeFile, 'EXCEL.EXE') then
begin
Result := True;
Break;
end;
until not Process32Next(Snapshot, ProcessEntry);
end;
CloseHandle(Snapshot);
end;
//プロセスのリストを取得し、特定のプロセスを終了する関数
function TerminateExcelProcesses: Boolean;
var
Snapshot: THandle;
ProcessEntry: TProcessEntry32;
ProcessHandle: THandle;
begin
Result := False;
Snapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
if Snapshot = INVALID_HANDLE_VALUE then Exit;
ProcessEntry.dwSize := SizeOf(TProcessEntry32);
if Process32First(Snapshot, ProcessEntry) then
begin
repeat
if SameText(ProcessEntry.szExeFile, 'EXCEL.EXE') then
begin
ProcessHandle := OpenProcess(PROCESS_TERMINATE, False, ProcessEntry.th32ProcessID);
if ProcessHandle <> 0 then
begin
if TerminateProcess(ProcessHandle, 0) then
begin
Result := True;
end;
CloseHandle(ProcessHandle);
end;
end;
until not Process32Next(Snapshot, ProcessEntry);
end;
CloseHandle(Snapshot);
end;
begin
if IsExcelRunning then
begin
//Excelのプロセスを終了させる
strMsg:='Excelのプロセスが実行中です。'+#13#10+#13#10+
'終了してもよろしいですか？';
if Application.MessageBox(PChar(strMsg), PChar('警告'), MB_YESNO or MB_ICONWARNING) = mrYes then
begin
//[はい]が選ばれた時
if TerminateExcelProcesses then
begin
strMsg:='Excelプロセスを終了しました。';
Application.MessageBox(PChar(strMsg), PChar('情報'), MB_ICONINFORMATION);
end else begin
strMsg:='実行中のExcelプロセスは見つかりませんでした。';
Application.MessageBox(PChar(strMsg), PChar('情報'), MB_ICONINFORMATION);
end;
end else begin
//[いいえ]が選ばれた時
strMsg:='Ctrl+Alt+Delキーを同時に押してタスクマネージャーを起動し、実行中の'+
'Excelのプロセスを必ず終了してください。';
Application.MessageBox(PChar(strMsg), PChar('情報'), MB_ICONINFORMATION);
end;
end else begin
strMsg:='Excelは実行されていません。';
Application.MessageBox(PChar(strMsg), PChar('情報'), MB_ICONINFORMATION);
end;
end;
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
//Excelのプロセスが実行中であるか、どうかを調査する関数
function IsExcelRunning: Boolean;
var
Snapshot: THandle;
ProcessEntry: TProcessEntry32;
begin
Result := False;
Snapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
if Snapshot = INVALID_HANDLE_VALUE then Exit;
ProcessEntry.dwSize := SizeOf(TProcessEntry32);
if Process32First(Snapshot, ProcessEntry) then
begin
repeat
if SameText(ProcessEntry.szExeFile, 'EXCEL.EXE') then
begin
Result := True;
Break;
end;
until not Process32Next(Snapshot, ProcessEntry);
end;
CloseHandle(Snapshot);
end;
//プロセスのリストを取得し、特定のプロセスを終了する関数
function TerminateExcelProcesses: Boolean;
var
Snapshot: THandle;
ProcessEntry: TProcessEntry32;
ProcessHandle: THandle;
begin
Result := False;
Snapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
if Snapshot = INVALID_HANDLE_VALUE then Exit;
ProcessEntry.dwSize := SizeOf(TProcessEntry32);
if Process32First(Snapshot, ProcessEntry) then
begin
repeat
if SameText(ProcessEntry.szExeFile, 'EXCEL.EXE') then
begin
ProcessHandle := OpenProcess(PROCESS_TERMINATE, False, ProcessEntry.th32ProcessID);
if ProcessHandle <> 0 then
begin
if TerminateProcess(ProcessHandle, 0) then
begin
Result := True;
end;
CloseHandle(ProcessHandle);
end;
end;
until not Process32Next(Snapshot, ProcessEntry);
end;
CloseHandle(Snapshot);
end;
begin
//Excelのプロセスが実行中である限りLoopさせ、完全にExcelのプロセスを終了させる。
While IsExcelRunning do
begin
TerminateExcelProcesses;
Application.ProcessMessages;
end;
end;
対策として、『選択肢番号の外枠の楕円「０」部分をはみ出さないようにマークする』よう注意を徹底することをお願いしたのですが、それだけでは根本的な解決とならないように感じ、マークとマークの間隔が狭いためにこの問題が起きていることは明白ですから、1設問について100選択肢に対応を維持しつつ、1列25行×4列で100設問まで対応という現在のマークシート構成を見直し（マーク間の幅を広げるため列数を減らし）、1列33行×3列で99設問まで対応可能というマークシートを作成しました。また、50分という試験時間を考えると80設問あれば十分というご意見も頂戴しましたので、1列30行×3列で90設問まで対応可能なマークシートや、1列25行×3列で75設問まで対応可能なマークシートを作成し、これらのマークシートを１つの Excel Book にまとめました。以下のリンクからダウンロードできます。
