投稿者「サイト管理者」のアーカイブ

デジタル採点 手書き フリー で検索したら、その後

前回の記事を書いてから、scikit-learn を使った機械学習による手書きカタカナ文字「ア・イ・ウ・エ・オ」及び記号「○・×」の認識用学習モデル作成について、さらに勉強しました☆

今回は、その記録と、今後の抱負です。

【もくじ】

1.さらに勉強した理由
2.HOGを知る
3.気分は「写経」
4.今後の抱負
5.まとめ
6.お願いとお断り

1.さらに勉強した理由

なぜ、さらに勉強したかというと、前回の記事では、画像のピクセル値をそのまま利用する Flattening という特徴量抽出の手法を用いて学習モデルを作成したのですが、前回の記事にある通り、既知の(=学習に利用した)カタカナ文字については、アイウエオ各文字ともに 98 %正しく判定できたという好結果に力を得て、Delphi で GUI を作成した手書き答案の採点補助プログラムから、Python の文字認識スクリプトを実行できるよう、新しくプログラムを書いて実験してみた結果、期待に反して1回も見たことのない新規の文字については、正しく判定できないことがあるように思いmした。特に「オ」は全滅・・・

以下、かるーくやってみた実験の結果です。

多少の傾きはOK?

「ア」はふたつとも読めた・・・

文字の記入位置は影響なし?

記入位置の探索も、上手く行えてるようです・・・

なぜ、読めない? この「ウ」は読んで欲しかった・・・

ふたつめの「ウ」の方が、典型的な「ウ」により近い? 気がするけど・・・

「エ」は判定しやすい?

「エ」は得意なのかな・・・

この「オ」が見分けられないとは・・・ T_T


この「オ」の認識結果を見て、正直、これはダメだと思いました。また、失敗です。T_T

ちなみに「○・×」は・・・

なにか書いてあれば・・・「○」だと思ってる・・・
(空欄を識別しているのは、うれしい限りですが)


「○ or ×」認識テストの結果は、「オ」の場合よりさらにダメです。まぁ上の「オ」の場合の「ア」についても確信を持って見分けて「×」を付けているのか、どうか、この結果を見てだいぶ怪しくなってきました。(果たして、あの「オ」や「ア」をどう読んだのか・・・、それを確認する気力も失せました・・・)

さらに、お見せしたくないのが、「×」が正解ラベルの場合です。

もうダメです。T_T

THE END.
その想いで胸がいっぱいに!

実装が超シンプルで、かつ高速で軽量、文字画像のピクセル値(28×28)をそのまま利用する Flattening という手法では、これが限界なのでしょうか?

学習用データをさらに増やせば、もっと良い結果が得られるのではないか・・・ とも考えましたが、手元にその学習用データがありません。新規に学習用データを集めるには莫大な手間と時間が必要です。

ただ・・・失敗の中でも唯一救いに感じたのは、2年前の文字認識チャレンジでどうしてもクリア出来なかった解答欄中の文字が書かれている位置を正しく認識することに成功し、意図した通りに文字画像を取得出来ていることです。

No,1の「イ」は解答欄の左側に記入されていますが・・・
No,1の「イ」も正しく切り出せています


プログラムはその記入位置を正確に見つけ出し、28×28の矩形画像への切り出しに成功しています。

実は、この Blog の過去の記事で「失敗の記録」として掲載した手書き文字認識チャレンジの試行錯誤の記事を書いた当時、文字の認識に失敗した最大の原因は「正しく文字を切り出せなかった」ことにありました。今回、テストしたのは、たった3枚の画像ですが、いずれも問題なく文字が記入されている位置をプログラムは特定し、その正確な切り出しに成功しています。

切り出した画像の縦横比が、元の画像と変化していることに、画像を見て気づきました!
ここは出来れば改善したいところです。


2年前の僕の技術では、例えば「ア」について、文字を構成する線がすべて繋がっている場合は「ア」という文字1文字だと正しく認識できても、「つ」部分と「ノ」部分が離れている場合は、「ア」ではなく「つ」と「ノ」に分解して認識してしまうミスをどうしても防げなかったのです。今回のチャレンジでは、この問題を無事クリアできました。

2年前の僕の技術では、3つめの「ア」は「つ」と「ノ」になってしまいましたが・・・
今回のプログラムは、ちゃんと「ア」として切り出しています。
ただ、やはり縦横比が・・・気になりますので、ここは何とかします!


さらに、解答欄から切り出した文字の位置が切り出し画像の中央にあることも、長い間ずっと・・・ この胸に思い描いた夢の通りです。

文字の縦横比は変わっていますが、文字位置の特定には何の問題もなく、成功しています☆
さらに、解答欄左にある(5)のような解答欄の番号を無視することにも成功しています☆☆
2年前にどうしてもクリア出来なかった複数の問題を、今回はすべてクリア出来ました☆☆☆

総合的な意味では今回も失敗でしたが、自分にとって、前回、クリア出来なかった幾つもの問題を解決できたことは、本当に大きな前進でした。だから、総合的には失敗でも、☆5つが完全な成功だとしたら、自分的には ☆☆☆ です。

また、今回、Flattening による学習モデル作成方法を学ぶことで、Python に 32 ビット環境の scikit-learn ライブラリを導入する手法を完全に理解できました。機械学習そのものが現在 64 ビット環境へ移行しつつある中で、32 ビット環境の最後の輝きを、今、僕は目の当たりにしている・・・ そんな気がしてなりませんでした。

2.HOGを知る

Flattening の欠点に気づいたのは、Python 環境で作成した学習モデルを Delphi の Object Pascal から操作できるようにプログラミングを終えた段階(上の画像は、その段階での試行の様子)だったので、・・・結果的に Delphi 側の最も重要なプログラムを最初から組み直すことにはなりましたが・・・ ここで僕は、エッジや輪郭の方向に強く、ノイズの影響も受けにくい HOG(Histogram of Oriented Gradients)という特徴量を抽出する手法があることを知ります。HOG を勉強してみたところ、こちらの手法の方が画像のピクセル値のそのまま利用するFlattening より、文字の識別精度が高いのではないかと思えてきました。

そこで HOG を用いて文字の特徴量を抽出して学習モデルを作成するスクリプトを書きました。最初に、ごく基本的なコードを書き、そこに必要な様々な処理を追加して行く方法で一歩一歩確実に進んだ結果、文字の認識能力が Flattening 特徴量抽出手法を使ったそれよりは高いのではないか?と、確かに思える学習モデルを作成することができました。HOG 特徴量抽出手法を使った学習モデルは、Delphi に組み込む前に、Python スクリプトを使って行った試行で、上の「オ」を2つともサラっと認識してくれたのです!

試行の様子がこちらです。

解答用紙から切り出した解答欄の矩形画像


さらに解答欄の中の文字部分を探索して、切り抜いて・・・

解答欄から切り出した28×28ピクセルの矩形画像
(新しいプログラムではファイル名のIndexは1始まりにしました)


Delphi に埋め込む前に、Python 用のスクリプトで読んでみます・・・

やった! ちゃんと読めた!! 「オ」だけじゃなく「ア」も正しく読めています!!!


以下、HOG特徴量抽出手法を適用した学習モデル作成に必要な、学習用の文字データを作成するために使用したスクリプトです(使用を推奨するものではありません。あくまでもご参考まで)。

このスクリプトは、輪郭検出と文字切り出し、周囲パディングを均一化して、文字を画像の中心に配置、GaussianBlurによるノイズ除去、傾き補正、28×28ピクセルに正規化して保存・・・と言った機能を備えています。万一、コピペして試される場合は PATH をご自身の環境に合わせて変更してください。

import cv2
import numpy as np
import os
from glob import glob
import re

# UTF-8 パス対応の画像読み込み
def imread_utf8(path):
    stream = np.fromfile(path, dtype=np.uint8)
    return cv2.imdecode(stream, cv2.IMREAD_COLOR)

# 傾き補正(修正: warpAffine に補間法と白背景を明示)
def deskew(img):
    m = cv2.moments(img)
    if abs(m['mu02']) < 1e-2:
        return img.copy()
    skew = m['mu11'] / m['mu02']
    M = np.float32([[1, skew, -0.5 * 28 * skew], [0, 1, 0]])
    return cv2.warpAffine(img, M, (28, 28), flags=cv2.INTER_NEAREST | cv2.WARP_INVERSE_MAP, borderValue=255)

# ファイル名から数値を抽出(img12.png → 12)
def extract_number(path):
    filename = os.path.basename(path)
    match = re.search(r'img(\d+)', filename)
    return int(match.group(1)) if match else float("inf")

# 入力・出力フォルダ(パスに全角文字が含まれていてもOK)
input_folder = r"C:\Python39-32\Images_tegaki\aiueo\ア"
output_folder = os.path.join(input_folder, "Trimed")
os.makedirs(output_folder, exist_ok=True)

# 対象画像拡張子
image_extensions = ['*.jpg', '*.jpeg', '*.png']
image_files = []
for ext in image_extensions:
    image_files.extend(glob(os.path.join(input_folder, ext)))

# 並べ替え(img番号順)
image_files.sort(key=extract_number)

index = 1
for image_path in image_files:
    image = imread_utf8(image_path)
    if image is None:
        print(f"読み込めない画像: {image_path}")
        continue

    h, w = image.shape[:2]
    gray_for_line = cv2.cvtColor(image, cv2.COLOR_BGR2GRAY)
    edges = cv2.Canny(gray_for_line, 50, 150, apertureSize=3)

    raw_lines = cv2.HoughLinesP(edges, 1, np.pi / 180, threshold=100,
                                minLineLength=min(w, h) // 3, maxLineGap=10)
    filtered_lines = []
    if raw_lines is not None:
        for line in raw_lines:
            x1, y1, x2, y2 = line[0]
            angle = abs(np.arctan2(y2 - y1, x2 - x1) * 180 / np.pi)
            length = np.hypot(x2 - x1, y2 - y1)
            if (angle < 10 or angle > 170) and length < w // 2:
                continue
            filtered_lines.append([[x1, y1, x2, y2]])

    if filtered_lines:
        for line in filtered_lines:
            x1, y1, x2, y2 = line[0]
            if abs(x2 - x1) < 10 or abs(y2 - y1) < 10:
                cv2.line(image, (x1, y1), (x2, y2), (255, 255, 255), thickness=3)

    if w > h:
        offset = w // 4
        cropped = image[:, offset:w - offset]
    else:
        offset = h // 4
        cropped = image[offset:h - offset, :]

    gray = cv2.cvtColor(cropped, cv2.COLOR_BGR2GRAY)
    _, thresh = cv2.threshold(gray, 200, 255, cv2.THRESH_BINARY_INV)

    kernel = cv2.getStructuringElement(cv2.MORPH_RECT, (10, 10))
    dilated = cv2.dilate(thresh, kernel, iterations=1)
    contours, _ = cv2.findContours(dilated, cv2.RETR_EXTERNAL, cv2.CHAIN_APPROX_SIMPLE)

    if contours:
        all_points = np.vstack(contours)
        x, y, w_box, h_box = cv2.boundingRect(all_points)
        padding = 20  # この値は、切り抜き画像を確認しつつ、適宜調整してください。
        if w > h:
            x += offset
        else:
            y += offset

        x1 = max(0, x - padding)
        y1 = max(0, y - padding)
        x2 = min(w, x + w_box + padding)
        y2 = min(h, y + h_box + padding)

        trimmed = image[y1:y2, x1:x2]
        trimmed_gray = cv2.cvtColor(trimmed, cv2.COLOR_BGR2GRAY)
        trimmed_blur = cv2.GaussianBlur(trimmed_gray, (3, 3), 0)

        h_trim, w_trim = trimmed_blur.shape[:2]
        scale = 20.0 / max(h_trim, w_trim)
        new_w = int(w_trim * scale)
        new_h = int(h_trim * scale)
        # resized = cv2.resize(trimmed_blur, (new_w, new_h), interpolation=cv2.INTER_AREA)
        resized = cv2.resize(trimmed_blur, (new_w, new_h), interpolation=cv2.INTER_NEAREST)

        canvas = np.full((28, 28), 255, dtype=np.uint8)
        x_offset = (28 - new_w) // 2
        y_offset = (28 - new_h) // 2
        canvas[y_offset:y_offset + new_h, x_offset:x_offset + new_w] = resized        

        deskewed = deskew(canvas)

        # モーメントで中心を合わせる(修正: warpAffine に補間法と白背景を明示)
        M = cv2.moments(deskewed)
        if M['m00'] != 0:
            cx = int(M['m10'] / M['m00'])
            cy = int(M['m01'] / M['m00'])
            shift_x = 14 - cx
            shift_y = 14 - cy
            trans_mat = np.float32([[1, 0, shift_x], [0, 1, shift_y]])
            deskewed = cv2.warpAffine(deskewed, trans_mat, (28, 28), flags=cv2.INTER_NEAREST, borderValue=255)

        canvas = deskewed
    else:
        print(f"文字が検出されませんでした: {os.path.basename(image_path)}")
        canvas = np.full((28, 28), 255, dtype=np.uint8)

    # 保存(全角パスにも対応)
    save_path = os.path.join(output_folder, f"{index:04d}.png")
    is_success, encoded_img = cv2.imencode('.png', canvas)
    if is_success:
        encoded_img.tofile(save_path)
        print(f"{save_path} を保存しました。")
    else:
        print(f"{save_path} の保存に失敗しました。")

    index += 1

print("すべての画像の処理が完了しました。")


上のスクリプトで 28×28 ピクセルに整形して保存した大量の学習用データ画像を、次のスクリプトで処理して学習モデルを生成します。こちらについても、万一、コピペして試される場合は PATH をご自身の環境に合わせて変更してください(こちらも使用を推奨するものではありません。あくまでもご参考まで)。

import cv2
import numpy as np
from sklearn import svm
from sklearn.model_selection import train_test_split
import os
import joblib  # モデルの保存と読み込みに使用
from skimage.feature import hog
from sklearn.svm import SVC

# カタカナのクラス
CATEGORIES = ["ア", "イ", "ウ", "エ", "オ"]

# Pathの中の日本語に対応
def imread(filename, flags=cv2.IMREAD_GRAYSCALE, dtype=np.uint8):
    try:
        n = np.fromfile(filename, dtype)
        img = cv2.imdecode(n, flags)
        return img
    except Exception as e:
        print(e)
        return None

# HOG特徴量を抽出する関数
def extract_hog_features(img):
    # 画像はすでに28x28の想定
    features = hog(img,
                   orientations=9,
                   pixels_per_cell=(4, 4),
                   cells_per_block=(2, 2),
                   block_norm='L2-Hys')
    return features

# データセットの準備(28x28 の手書きカタカナ画像)
def load_images_from_folder(folder, categories):
    images = []
    labels = []
    for label, category in enumerate(categories):
        path = os.path.join(folder, category)
        print(f"Processing category: {category}, Path: {path}")

        if not os.path.exists(path):
            print(f"Warning: Path does not exist: {path}")
            continue

        for file in os.listdir(path):
            if file.lower().endswith(('.png', '.jpg', '.jpeg')):
                file_path = os.path.join(path, file)
                try:
                    img = imread(file_path)
                    if img is not None:
                        img = cv2.resize(img, (28, 28))
                        hog_features = extract_hog_features(img)
                        images.append(hog_features)
                        labels.append(label)
                    else:
                        print(f"Failed to load image: {file_path}")
                except Exception as e:
                    print(f"Error loading {file_path}: {e}")
            else:
                print(f"Skipping non-image file: {file}")
    print(f"Loaded {len(images)} images")
    return np.array(images), np.array(labels)

# データ読み込み
X, y = load_images_from_folder(r"C:\Python39-32\Images_tegaki\aiueo\Trimed", CATEGORIES)

if len(X) == 0:
    raise ValueError("No images loaded. Please check the image files and paths.")

# 学習とテストの分割
X_train, X_test, y_train, y_test = train_test_split(X, y, test_size=0.2, random_state=42)

# SVM モデルの作成と学習
model = svm.SVC(kernel='linear')
model.fit(X_train, y_train)

# モデルを保存する
joblib.dump(model, 'katakana_hog_svm_model.pkl')
print("Model saved as 'katakana_hog_svm_model.pkl'")

# 予測用前処理(HOG版)
def preprocess_image(image_path):
    img = imread(image_path)
    h, w = img.shape

    size = max(h, w)
    square_img = np.full((size, size), 255, dtype=np.uint8)
    x_offset = (size - w) // 2
    y_offset = (size - h) // 2
    square_img[y_offset:y_offset + h, x_offset:x_offset + w] = img

    img_resized = cv2.resize(square_img, (28, 28))
    hog_features = extract_hog_features(img_resized)
    return hog_features

def predict_character(image_path):
    img = preprocess_image(image_path)
    model = joblib.load('katakana_hog_svm_model.pkl')
    label = model.predict([img])[0]
    return CATEGORIES[label]

# テスト画像の認識(テスト用の画像は実行中のスクリプトと同じフォルダに用意・保存する)
for image_path in [
    "katakana_sample_a.jpg",
    "katakana_sample_i.jpg",
    "katakana_sample_u.jpg",
    "katakana_sample_e.jpg",
    "katakana_sample_o.jpg"
]:
    result = predict_character(image_path)
    print(f"{os.path.basename(image_path)} の認識結果: {result}")

テストに使用した画像は、次の通りです。文字の太さはテスト用に変化のあるものを選びました。

katakana_sample_a.jpg
katakana_sample_i.jpg
katakana_sample_u.jpg
katakana_sample_e.jpg
katakana_sample_o.jpg

上記、学習モデルを作成するスクリプトの実行結果です。

幸先よし。満足できる結果を得ることができました!

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;

エンエンと続く strScrList.Add( ) そう! ここに Python のスクリプトの1行1行をコピペして行くのです。20 行目くらいから、だんだん、まぶたが重くなり・・・、50 行目まで到達する頃には、意識が朦朧としてきて・・・、残り数行という段階で、ほぼ涅槃の境地に・・・

「涅槃」とは、「一切の煩悩から解脱した、不生不滅の高い境地」であり、「煩悩の火が消え、人間が持っている本能から解放され、心の安らぎを得た状態のこと」をいうのだそうです。

失礼しました。間違えました。僕のは単に眠くなり、もう何も考えられない状態になっただけです。

何はともあれ、いずれにしてもそのいちばん心が「無」になった状態で、最大の難関が待ち受けています。それは何かというと、Python側からDelphi側への判定結果の受け渡しの手続きの記述です。

元々の Python 側でのスクリプトは・・・

        predicted_char = predict_character(canvas, model)
        print(f"{os.path.basename(image_path)} → 認識結果: {predicted_char}")
    else:
        print(f"{os.path.basename(image_path)} → 文字が検出されませんでした。")

ここを、次のように書き換えます。※ results リストは予め空になるよう初期化しておきます。

      strScrList.Add('        predicted_char = predict_character(canvas, model)');
      strScrList.Add('        results.append(str(predicted_char))');
      strScrList.Add('    else:');
      strScrList.Add('        results.append("")');

最後に Delphi 側へ、プレゼント☆

      strScrList.Add('var1.Value = ";".join(results)');

で、Delphi 側では、results に保存されている認識結果を StringList で受け取って、StringGrid に得点を表示します。

      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;

もちろん、PATH も、exe のある階層が起点となるように修正して・・・

      //入力・出力フォルダ (cmbAL = ComboBox Answer Label)
      strScrList.Add('input_folder = r".\imgAuto\src"');
      strScrList.Add('output_folder = os.path.join(input_folder, "'+ cmbAL.Text +'")');
      strScrList.Add('os.makedirs(output_folder, exist_ok=True)');

こうして、なんとか、エラーを出さずに、プログラムが「動く」状態にまで仕上げました。

追記_20250421

ふと思ったのですが、Form に非表示の TMemo を1つおいて、そこに Python のスクリプトをコピペして、必要な部分のみ上記のように変更すれば、

もっとラクできたかな・・・

みたいな気が。

でも、「修行」には「修行」で、また、

別の意味と価値がある

ような・・・ 気も。

ただ、このプログラムの・・・ 究極の目的は、採点者が単に「ラクする」ためだけの・・・ 採点環境を実現することにある・・・ という事実。

いや、それは「ヒトと機械との美しき協働」の穿った見方。

こんな相反する「矛盾」を、感じるのは作者である僕だけ?

まぁ、全部をまとめて言えば・・・

人生は必ず ± 0になる
ということでしょうか?

なお、Python4Delphi の設定と使い方の詳細は、次の過去記事をご参照ください。

早速、冒頭に紹介したのと同じデータを読んで、動作確認。

Delphiへのスクリプト移植前に試行していたので、
あまりドキドキせずに「自動」ボタンをクリックすることができました!

ボタンの Caption は「自動」より、「実行」の方がよかったかな・・・?

記入位置も、多少の傾きも、問題なくクリアできました。


気になっていた切り出し画像の縦横比も・・・

縦横比が変化しないようにスクリプトを修正できました!

前回は、正しく読めなかった「ウ」も、この通り読めています。

やった! やった!!

長かった・・・ けれど、ここまで来ることができました☆
あきらめなくて、よかった・・・

「エ」も余裕?でクリア

イイ感じというか、エエ感じというか・・・

そして、Flattening 特徴量抽出で作成した学習モデルでは読めなかった「オ」・・・ ですが、

やったー!!!

HOG特徴量抽出で作成した学習モデルは、しっかり読んでくれました!

もちろん、「○・×」判定も・・・ 余裕でOK!
(何が余裕なのかは、僕自身、わかってないですが)

最初に正解ラベル「○」の場合、

自分的には、HOGで作った学習モデルへの「信頼感」みたいなモノが生まれてきました☆


次に、正解ラベル「×」の場合、

100% 正解しました!


これなら販売できそうです。
まぁ買ってくれる人は、
いないと思いますが・・・ *(^_^)*♪

4.今後の抱負

テストとは、とても言えないような、ほんとうに取り急ぎの採点試行結果ですので、これだけを持って公開してOK!とは、とても思えません。実際の採点現場で性能を確認できたら、自作のデジタル採点ソフト AC_Reader のバージョンアップ版として、この blog の未来記事で公開したいと思います。

5.まとめ

手書き文字認識に scikit-learn を使って成功するためには・・・

(1)特徴量抽出前の学習データ作成を丁寧に行い、機械学習しやすい環境を整える。
(2)学習データが同じである場合、Flattening より HOG 特徴量抽出の方が良い結果を出せた。
(3)誤りがあれば必ず修正し、成功するまで、絶対にあきらめないこと。

6.お願いとお断り

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

デジタル採点 手書き フリー で検索したら

久しぶりに、上のキーワードで Google 検索して、びっくり しました。
なんと! 検索結果の・・・ いちばん上に! ・・・ 僕のプログラムが、表示されてる・・・

(⊙_⊙)

正直。うれしいより先に

やばい!

・・・と、思いました。

( 何ページ目くらいに表示されるのかなー☆ )

本当に、それが、これまでに何度も、何回も繰り返した、僕の blog を Google 検索する時の想い。

( 誰か、見てくれないかなー。読んでもらえたら、うれしいなー☆ )

だから、3ページ目くらいに記事があると、「うん。うん。」って、安心してた・・・。

blog を書くこと自体が、自分の存在確認の行為に他ならないのだけれど・・・

これは本当に思い上がりとか、謙遜とか、そのどちらでもなく・・・

普通に考えて・・・

僕の blog とプログラムが
Google の検索結果で
トップに表示されるわけがない。

どう考えても、それが僕のいる世界の「本当」・・・のはず、なのに ・・・
突然! 目の前に表示された「画面」という現実を、それでもなお、信じられない気持ちで、眺めつつ。

夢なら覚めないでほしい

そう思ったのも、また、事実です。

この2年間の日々は、色々な意味で、ほんとうに、本当に、苦しかった・・・。

人の立場の違いは、その評価をも、真逆に変える。

あの日、拍手で歓迎されたプログラムが、ただのゴミ以下になる・・・

僕は、そのほんとうを・・・ 確かに、この目で、見ました。

失意のどん底にある僕を支えてくださった多くの方々に、心から感謝申し上げます。

だから、Google 先生の、僕の blog とプログラムへの評価は、世の中が僕の夢を応援してくれている証明のように思えて、「やばい」と思ったのは本当ですが、やはり、とても、うれしかったのです。

で、問題は「やばい」と感じた理由・・・ そう、今回の記事を書く きっかけ です。

2年前、同僚の要請に応えるかたちで、手書き答案をスキャンして得た画像から個々の解答欄画像を切り出して一括採点し、採点記号その他を付加して元の画像に書き戻すデジタル採点プログラムの最初のバージョンを書き、「表形式」の解答欄を読み取って処理するので「Answer Column Reader = AC_Reader」と名付けたのですが・・・

その時点で、プロの書いたデジタル採点システムにあって、僕のプログラムにないもの・・・

そう「○・×」、「ア・イ・ウ・エ・オ」、「A・B・C」、「1・2・3」みたいな記号・文字または数字1字の解答であれば自動採点できる機能を僕のプログラムにも搭載したいと、僕はごく自然な流れで考えたのです。

当時、年末・年始の休暇を含めて、ほぼ2か月間、手書き文字の認識に没頭した記憶があります。

その記録は当 blog の過去記事にある通りです。

いずれも、他人様の実験結果を、ただ真似しただけの、読むに値しない記事ですが・・・

生成 AI なんてまだなかったあの頃・・・(知らないところで、それは・・・ ほぼ出来上がりつつあったのだろうけれど・・・。 そう、考えると同時期にレベルの差はあれど、まったく同じ研究をやったと言うことで、たまらなく誇らしいような、いや、それはただの偶然の一致で・・・ 一方は AI というカタチで見事にモノになり、僕のは無駄な努力で終わり・・・もし、プログラムが当時のまま、今後進化しないのであれば・・・ みたいな複雑な気持ちではありますが )、いずれにしても、その時、僕は Google 先生を頼りに『 機械学習の真似事 』を行い、右も、左も、わからないまま、結局 keras や Lobe のお近づきになれたよーな・・・ なれなかったよーな・・・

日々を過ごしたことだけは、事実。( 2022年、春 )

で、結論だけ言うと、お遊び程度に使える自動採点機能を搭載したプログラムが書けました。・・・ただ、書けたことは書けたのですが、使用したライブラリが TensorFlow で、これには 32 ビット版がなく、仕方がないからプログラムは無理して 64 ビット化して作成。

その結果、 AC_Reader に同梱して使うその他のプログラム( My マークシートリーダー = MS_Reader.exe 等)が 32 ビット版であること、つまり、内部で共通に呼び出して使っている Embeddable Python も 32 ビット版であることから、 AC_Reader と My マークシートリーダーとが共存するには Embeddable Python を共用しなければならないというところが大問題に。結局、64 ビット版の AC_Reader は使用を断念。版を 32 ビットに戻すと同時に、64 ビット版の AC_Reader に搭載した自動採点機能は、32 ビット版で泣く泣く削除。

あれから2年間。AC_Reader は、ほぼ、放置状態。

(表計算ソフトを使わずに、成績一覧表を出力できるようにする等、採点に伴う作業を軽減できるよう、付属的なプログラムを新たに作成すると言った、おまけ的な面で多少の改善は加えましたが、手書き答案の採点という、本業面での進化は、よく使う機能を集めてフローティングパネル化した程度)

そう、せっかく Google 先生が評価してくれたのに、プログラム本体が2年間まったく進化していないことが、心から「やばい」と感じた理由なのです。

苦しかった、この2年間を、その理由にしてはいけないのですが・・・

それでも、僕を支えてくださった方々の要望には、何としても応えたいという思いがあり・・・

必死の思いで、過去記事「組み合わせ採点を実現したい!」に書いた内容を組み込んだ答案返却用答案(?)を作成・印刷する新しいプログラムを書き、採点現場での実地テストを無事終え、そちらを「ReportCard_2025」として公開すべく、準備を進めていたのですが、先に書いた検索結果を目の当たりにして、こちらをいったん中止。

AC_Reader を2年ぶりに進化させることに決めました。
内容はもちろん、自動採点機能の搭載です。

【もくじ】

1.32ビット版で自動採点機能を搭載できないか?
2.Tesseract-OCR を使う
3.scikit_learnを使う
 (1) Embeddable Python へのインストール
 (2) 学習モデルを作成して認識テスト
4.とんでもない認識結果に驚愕する
5.まとめ
6.お願いとお断り

1.32ビット版で自動採点機能を搭載できないか?

Delphi もバージョン 12.3 では「 RAD Studio 12 ( 64-bit Initial Release ) 」がついに登場。機械学習の現場でも 64 ビット化はさらに加速しつつあり、今更、32 ビットにこだわる必要などないと自分でも思うし、64ビット化の流れに反対する気持ちなどまったくないが・・・

ただ、これまでに書いてきたプログラムをすべて64ビット化するのは大変だし、その前に、32 ビット版に今すぐできる改良があるなら、それを行えば、より良いものをユーザーに提供できる可能性が 32 ビット版のプログラムにも、まだ残されている気が・・・

「 より良いもの 」・・・ それこそが 32 ビット版 AC_Reader への自動採点機能の搭載だと思いました。

あれから2年経過して、手書き文字認識や機械学習のプログラム自体も相当進化しているのではないかと考え、まず、思い出したのは Tesseract-OCR です。

2.Tesseract-OCR を使う

他にも思い出せるモノはたくさんあったんだけど、機械学習系は手書き文字の認識の前に、大量のデータを集めてトレーニングして・・・ といった学習(の手間)が必要なので、そういった手間のいらないところから搭載の可否を探ろうと思ったわけです。「寄らば大樹の陰・・・」みたいな。

手書き文字でない、既存の TrueType 日本語フォントに対してなら、Tesseract-OCR がどれほど素晴らしい性能を発揮するか、それは2年前に目の当たりにしています。ただ、残念ながら、手書き文字の認識といった部分では、2年前はお世辞にも良好とは言えなかったと記憶しています。

早速、最新版(?)をダウンロード( tesseract-ocr-w32-setup-v5.3.0.20221214.exe :これより新しい 32 bit版は探せなかった)して、実験してみました。日付が、ちょっと古いのが気になりましたが。もしかして、2年前もコレで実験した? みたいな感が・・・。

手書き文字は、次のような実験用サンプルを700個(すべて「ア」の画像)ほど用意。

一緒に暮らしている人が書いた「ア」


実験に使った Python スクリプトは、コレ!
画像から抽出する文字は「アイウエオ」の中の1字。画像が「ア」であると判定すれば「ア」を出力、「アイウエオ」のいずれでもない(=判定不能である)場合は「N」を出力する。

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)

「ア」1文字で勝負してみました。結果はまったく同じでありました!

よくよく考えれば、同じ文字認識アルゴリズムで「ア」を判定しているのですから、これは当然です。

64 bit バージョンの方は最新版が「最近の日付」でしたから、これより良い結果が得られる可能性があるような気がしますが、僕が使いたい 32 bit バージョンに限っての話をしていますので、この時点で手書き文字の認識に Tesseract-OCR の 32 bit バージョンを使用するか、否か、という問題は、はっきり「 否 」と答えが出ました。

過去の記事にも書きましたが、これは「手書き文字の認識(それも「ア」1文字)」に限った話であり、他のカタカナ文字については実験もしておりませんし、これを持って、Tesseract-OCR 32 bit バージョンの総合的な「手書き文字」を認識する性能を否定する意図はまったくありません。

日本語 TrueType フォントの書体であれば、Tesseract-OCR は十分実用的な精度で文書をテキスト化してくれる素晴らしいプログラムです!!

3.scikit_learnを使う

(1) Embeddable Python へのインストール

次に思い出したのが keras だったのですが、2年前の実験における手書きカタカナ文字「アイウエオ」の認識率は 95 ~ 97 %程度(文字によって差がある)で、これ以上はどう頑張ってもダメだった記憶が同時に蘇り・・・

AI に聞いてみると、「 keras も進化してます!」とのことでしたが、ここで、ふと、思い立ち、

「 32 bit で動作するプログラムで、手書き文字認識が可能な Python で動作するオープンソースの機械学習ライブラリは何?」と尋ねてみると・・・

scikit-learn です!

・・・との答えがトップに表示されました。

( scikit-learn ・・・ )

scikit-learn は2年前にも試していません。名前は聴いたことがあったような気がしますが・・・

AI の説明には、心揺さぶられるような文言が並び!!!

曰く、軽量で依存が少ない。
曰く、古いマシンでも動作しやすい。

さらに・・・

「SVM(サポートベクターマシン)などでの文字認識は、軽量で精度も悪くないです。」

とのこと。

サポートベクターマシンってのが、よくわからなかったので、さらに質問して見ると・・・

「サポートベクターマシン(SVM:Support Vector Machine)」は、分類や回帰に使える機械学習のアルゴリズムの一種で、scikit-learn が得意なことは、「はっきりと分けられる2つのクラス分類」であるとのこと。まさに「手書き文字認識」のためにあるようなライブラリ。何で2年前、scikit-learn を試さなかったのか・・・。後悔先に立たず。試さなかった事実は事実。それは認めるしかない。でも、今、僕は、まだ、生きていて、あの頃は読めなかった AI のアドバイスを、今、読んでる・・・

「他のライブラリにほぼ依存せず、古いPCでも動き、軽量で、精度も悪くない。」

だんだん、だんだん、AI の言うことを信じて、動かしてみたい気になってきました☆

※ ちなみに「回帰」もわからなかったので調べて見ると、「 回帰(Regression)」は、予測したい結果が “数値” のときに使う機械学習の手法であるとのこと。「分類(Classification)とセットでよく出てくる」言葉なんだそうです。確かに、どこかで何度も目にしたことがあるような・・・。今、僕がやりたいのは「分類(Classification)」の方ですが、大変、勉強になりました!!

とりあえず、scikit-learn を入手して、それをインストールしなければ話は始まらない。

scikit-learn をインストールする予定の Embeddable Python を入れた Python39-32 フォルダをデジタル採点関係のプログラムを保存しているフォルダから、C:¥へコピーする。

ちなみに Python39-32 の 39 は Python のバージョン、32 は 32 bit 版という意味です。

なんでそんなことをしたかというと、Pathを短くするため。Python関連のプログラムをいじる時は、コマンドプロンプトで作業するのでPathが出来るだけ短い方が作業しやすい。

そうしておいて、AI の力を借りて、scikit-learn の 32 bit 版を探します。(実際にはここでかなりの時間を loss しているのですが)その結果わかったことは「通常の pip install scikit-learn でのインストールは 32ビット環境では失敗することが多い」ということ。なので、より確実にインストール可能なWindows用ホイールファイル(=拡張子が whl のファイル)を探すことにしました。

【参考】Windows用ホイールファイル(.whl)
Pythonで使用されるパッケージ形式のひとつ。Pythonのライブラリやモジュールを効率的にインストールできるファイルで、次の特徴がある。

・事前にビルドされたパッケージなので、必要なコードや依存関係がすべて含まれている。
・ソースコードをビルドする必要がないため、Windows 環境でのインストールが簡単になる。
・pip でインストールできる。
 例: pip install scikit_learn-0.24.2-cp39-cp39-win32.whl

予想通り、世の中は 64 bit 版へ移行しつつあり、scikit-learn の 32 bit 版の最新版は「2021年4月28日」の日付がある「scikit_learn-0.24.2-cp39-cp39-win32.whl」のようです(違うかもしれません)。

以下、実際に僕が行ったインストール作業の様子です。

cp39 だから Python3.9.X に対応しており、win32 だから 32 bit 対応版であることがわかる。検索したらいちばん上に「 Pypl 」の「 scikit-learn 0.24.2 」が表示された。リンクをたどって、https://pypi.org/project/scikit-learn/0.24.2/ へ行き、さらにページの左側にある「ファイルをダウンロード」をクリックしてダウンロードページへ行き、Built Distributions の上から2番目に目的の「scikit_learn-0.24.2-cp39-cp39-win32.whl」を発見。これをダウンロードして、Python39-32 フォルダへコピーする。

コマンドプロンプトを起動していちばん最初に行うことは、この場合、pip のアップデートだ。Embeddable Python に Numpy や OpenCV をインストールした時、Embeddable Python で pip を使う方法の詳細なメモを残しておいたので、それを見ながら作業する。

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

僕のはもう設定してあるから、次の作業は不要だけれど、必要な方がいるかもしれないので参考までに書くと・・・ まずは、Embeddable Python で pip を使えるようにする方法。

デフォルトの python.exe では import site が無効になっているため、外部ライブラリをインポートできない。

解決策: python._pth を編集する
    python._pth(python.exe と同じフォルダにある)を開く
    #import site のコメントアウトを解除(# を削除)

# python36.zip
# ./DLLs
# ./Lib
# ./Lib/site-packages
import site  # ← コメントアウトを外す
# Uncomment to run site.main() automatically

さらに、pip を有効化するために次の作業も行う。

pip は Embeddable Python には入っていないので、次の方法で pip を使えるようにする。

(1) get-pip.py をダウンロード
    get-pip.py を 公式サイト(https://bootstrap.pypa.io/get-pip.py)からダウンロード
    C:\Python39-32(僕の場合) に配置

(2) pip をインストール
C:\Python39-32\python.exe get-pip.py

(3) pip でライブラリをインストール
C:\Python39-32\python.exe -m pip install requests

あと、環境変数を設定するには・・・

set PYTHONHOME=C:\Python39-32
set PYTHONPATH=C:\Python39-32\Lib
C:\Python-Embed\python.exe XXX.py  # <-Pythonスクリプトの実行

ここまで行えば、pip が使えるので、ダウンロードした scikit_learn-0.24.2-cp39-cp39-win32.whl のインストールが可能になる。

後で Python スクリプトも実行するので、環境変数の設定も行いつつ・・・

C:\Python39-32>set PYTHONHOME=C:\Python39-32
C:\Python39-32>set PYTHONPATH=C:\Python39-32\Lib
C:\Python39-32>set PYTHONPATH=C:\Python39-32\Scripts  # <-効いてない気がするが・・・

ただ、ここでいきなり scikit_learn をインストールしようとすると失敗する。

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'

最初に コレ を見たときは マジ 泣きたくなった・・・ T_T

いろいろ調べて見ると、どうやら最後に出てくる MesonPy に原因があるらしい。scikit_learn と同時にインストールされる scipy には mesonpy というビルドツールが必要で、それが 32ビット環境では動作しないことがエラーの原因とのこと。どうやら MesonPy は 32 bit 版に対応していないようだ。じゃあ、どうするかと言うと、最初に scipy を単体でインストールする。

次のサイトにアクセスし、Python 3.9 (32bit) 対応の scipy の .whl をダウンロードする。

https://www.lfd.uci.edu/~gohlke/pythonlibs/#scipy

上のサイトに「scipy-1.9.0-cp39-cp39-win32.whl」があったので、これをダウンロードして、Python39-32 フォルダへコピーする。で、pip を使ってインストールする。

C:\Python39-32>python.exe -m pip install C:\Python39-32\scipy-1.9.0-cp39-cp39-win32.whl
Processing c:\python39-32\scipy-1.9.0-cp39-cp39-win32.whl
Requirement already satisfied: numpy<1.25.0,>=1.18.5 in c:\python39-32\lib\site-packages (from scipy==1.9.0) (1.21.5)
Installing collected packages: scipy
Successfully installed scipy-1.9.0

次に scikit_learn をインストールする。

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)
Requirement already satisfied: scipy>=0.19.1 in c:\python39-32\lib\site-packages (from scikit-learn==0.24.2) (1.9.0)
Collecting joblib>=0.11 (from scikit-learn==0.24.2)
  Downloading joblib-1.4.2-py3-none-any.whl.metadata (5.4 kB)
Collecting threadpoolctl>=2.0.0 (from scikit-learn==0.24.2)
  Downloading threadpoolctl-3.6.0-py3-none-any.whl.metadata (13 kB)
Downloading joblib-1.4.2-py3-none-any.whl (301 kB)
Downloading threadpoolctl-3.6.0-py3-none-any.whl (18 kB)
Installing collected packages: threadpoolctl, joblib, scikit-learn
Successfully installed joblib-1.4.2 scikit-learn-0.24.2 threadpoolctl-3.6.0

ちょっとたいへんだったけど、これでなんとか、scikit_learn の 32 bit 版が Embeddable Python にインストールできた!!( Python39-32 フォルダのサイズが 335 MB になっちゃったけど、これだけはもうどうにもならない。ちなみに Tesseract-OCR を入れた場合は、その倍くらいになった!)

(2) 学習モデルを作成して認識テスト

2年前の手書きカタカナ文字認識チャレンジで使った手書きカタカナ文字の画像ファイルは、壊れたノートパソコンから取り外した SSD を専用ケースに入れて作った外付け SSD ドライブに保存してある。

その SSD ドライブ内を検索し、テストで使えそうな画像ファイルを探すと、ア・イ・ウ・エ・オの各文字がほぼ 700 字ずつ、フォルダに分類されて保存されているのを見つけることができた。

( あった。コレだ )

記憶では「水増し」して 3000 文字くらいずつ集めたフォルダもあったはずだが、文字数が増えれば増えるほどコピーに時間がかかる。それに、いきなり 3000 文字を機械学習させて結果が失敗だったら、その後、打つ手がなくなる・・・。だから、とりあえず、この 700 字でテストしてみようと考えた。

2年前は手書きカタカナ文字の収集や整理に膨大な時間を要したが、今回は「それがない」から、何の苦労もなく仕事はスイスイ進む。

scikit_learn の学習モデルを作成するスクリプトに合うよう、画像ファイルを入れたフォルダを準備して学習モデルを作成する。そのスクリプトがコレです。

import cv2
import numpy as np
from sklearn import svm
from sklearn.model_selection import train_test_split
import os
import joblib  # モデルの保存と読み込みに使用

from sklearn.svm import SVC  # SVMにクラスの重みを追加することで、少数派クラスに対して重みを高く設定

# カタカナのクラス(修正: 「ア」を追加)
CATEGORIES = ["ア", "イ", "ウ", "エ", "オ"]

# Pathの中の日本語に対応
def imread(filename, flags=cv2.IMREAD_GRAYSCALE, dtype=np.uint8):
    try:
        n = np.fromfile(filename, dtype)
        img = cv2.imdecode(n, flags)
        return img
    except Exception as e:
        print(e)
        return None

# データセットの準備(28x28 の手書きカタカナ画像)
def load_images_from_folder(folder, categories):
    images = []
    labels = []
    for label, category in enumerate(categories):
        path = os.path.join(folder, category)  # パスの結合方法を修正
        print(f"Processing category: {category}, Path: {path}")  # デバッグ用に出力

        # ディレクトリが存在するか確認
        if not os.path.exists(path):
            print(f"Warning: Path does not exist: {path}")
            continue

        for file in os.listdir(path):
            # ファイルが画像であるかどうかを拡張子でチェック
            if file.lower().endswith(('.png', '.jpg', '.jpeg')):
                file_path = os.path.join(path, file)
                # print(f"Trying to load file: {file_path}")  # 読み込みファイルのパスを表示
                try:
                    # カタカナを含むパスが問題ないかを確認
                    # img = cv2.imread(file_path, cv2.IMREAD_GRAYSCALE)
                    img = imread(file_path)
                    if img is not None:
                        img = cv2.resize(img, (28, 28))
                        images.append(img.flatten())  # 1次元化
                        labels.append(label)
                    else:
                        print(f"Failed to load image: {file_path}")
                except Exception as e:
                    print(f"Error loading {file_path}: {e}")
            else:
                print(f"Skipping non-image file: {file}")
    print(f"Loaded {len(images)} images")
    return np.array(images), np.array(labels)

# データ読み込み
X, y = load_images_from_folder(r"C:\Python39-32\Images_tegaki\img_28", CATEGORIES)
X = X / 255.0  # 正規化

# データがロードされていない場合にエラーを出す
if len(X) == 0:
    raise ValueError("No images loaded. Please check the image files and paths.")

# 学習とテストの分割
X_train, X_test, y_train, y_test = train_test_split(X, y, test_size=0.2, random_state=42)

# SVM モデルの作成と学習
model = svm.SVC(kernel='linear')
model.fit(X_train, y_train)

# SVM モデルの作成と学習(クラスの重みを設定する)
# class_weights = {0: 1, 1: 2, 2: 2, 3: 1, 4: 1}  # イとウの重みを増やす
# model = SVC(kernel='linear', class_weight=class_weights)
# model.fit(X_train, y_train)

# モデルを保存する
joblib.dump(model, 'katakana_svm_model.pkl')
print("Model saved as 'katakana_svm_model.pkl'")

# 予測関数
def preprocess_image(image_path):
    img = imread(image_path)
    h, w = img.shape

    # 正方形になるように余白を追加
    size = max(h, w)
    square_img = np.full((size, size), 255, dtype=np.uint8)  # 背景を白に
    x_offset = (size - w) // 2
    y_offset = (size - h) // 2
    square_img[y_offset:y_offset + h, x_offset:x_offset + w] = img

    # 28x28 にリサイズ
    img_resized = cv2.resize(square_img, (28, 28))
    return img_resized.flatten() / 255.0

def predict_character(image_path):
    img = preprocess_image(image_path)
    model = joblib.load('katakana_svm_model.pkl')  # 学習したモデルをロード
    label = model.predict([img])[0]
    return CATEGORIES[label]

# テスト画像の認識ア
image_path = "katakana_sample_A.jpg"
result = predict_character(image_path)
print(f"認識結果: {result}")

# テスト画像の認識イ
image_path = "katakana_sample_I.jpg"
result = predict_character(image_path)
print(f"認識結果: {result}")

# テスト画像の認識ウ
image_path = "katakana_sample_U.jpg"
result = predict_character(image_path)
print(f"認識結果: {result}")

# テスト画像の認識エ
image_path = "katakana_sample_E.jpg"
result = predict_character(image_path)
print(f"認識結果: {result}")

# テスト画像の認識オ
image_path = "katakana_sample_O.jpg"
result = predict_character(image_path)
print(f"認識結果: {result}")

このスクリプトで学習モデルを作成し、最後に別に用意したテスト画像を認識させてみた。

「ア・イ・オ」は、いっしょに暮らしている人が、
「エ・ウ」は、僕が書いた手書きカタカナ文字。

結果は、とても不思議なことに「ア・エ・オ」は正しく読み取るのだが、「イ・ウ」を間違えてしまって、なんだか Python に混乱が生じているような感じ。

そこで行ったことが学習する際の重み付けの変更。その跡が上のスクリプトの赤字となっている。

で、重み付けを変更して(イ・ウの重みを増加させて)新たに学習モデルを作成し、テストしてみるが結果は第1回目と同様。「ア・エ・オ」は正しく読み取るのだが、「イ・ウ」を間違えてしまう。

何気なく「アイウエオ」の各文字を保存したフォルダを開けて見て、ようやく原因が判明。なんと「ウ」のフォルダ内に「ウ」はなく、「イ」が溢れかえって・・・

つまり、コピーする際、僕が間違えて・・・

うぎゃ!Zoräth ✷ fel∅, ∞’ka selenïv! ⧖ Trål’xon que!

(T▽T;) やっちまったぁ!!

手書きカタカナ文字を正しく分類し直して、再度、機械学習を実行し、学習モデルを作成。

今度は・・・

やった! やった!!

4.とんでもない認識結果に驚愕する

次に、学習用に使った「アイウエオ」各 700 文字で読み取りテストをやってみる。できれば、学習用に使ってない文字がよかったんだけど、残念ながらそれはないので、学習用素材でテストを強行。

各文字の認識率は、次の通り。

まず、「ア」


次、「イ」


次、「ウ」


次、「エ」


次、「オ」


事前に学習に使ってるから、ある意味「不正行為」と言えなくもないんだけど・・・

これなら手書き文字認識に
十分、使えるのでは
ないでしょうか?

さぁ AC_Reader の改造だ!

5.まとめ

・scikit-learn で作成した学習モデルは、宝物になりそうだ☆☆☆

6.お願いとお断り

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

観点別評価と評定の整合性をチェックする

高等学校における現行の教育課程では、3つの観点それぞれについて、A・B・Cで評価し、トリプルA(AAA)ならば評定は「5」というような成績評価を行っています。ほとんどの現場では、表計算ソフトを使って観点別評価を点数化し、その合計に応じて評定を自動的に計算する仕組みを導入しているのではないか? と思いますが、そうだとしても成績の最終的なチェックは絶対に必要。

そこで、観点別評価と評定を入力したファイル( Excel Book の拡張子が xls, xlsx, xlsm いずれかのファイル)を任意のフォルダに入れ(もちろん、複数個入っていてもよい)、ここで紹介する「観点別評価と評定の整合性をチェックするプログラム」を起動、フォルダを選択するだけで、データのセル番地など、一切指定しなくても各々のファイルに入力された観点別評価と評定の整合性を全自動でチェック(整合性に問題がある場合、オプションで指定すれば観点別評価に基づいて評定を自動修正)してくれるプログラムを書いてみました。

チェック完了時、問題がなかった場合に表示される画面


実際に使ってもらい、「これはイイ!」と評価していただけましたので、ここでフリーソフトとして公開します。「 Excel Book に入力された観点別評価と評定の整合性をチェックするよい方法はないか?」と、悩んでいらっしゃる方にお使いいただけたら、何よりの幸いです。気がついた不具合はすべて解消してありますが、未発見のバグがまだどこかにあるかもしれません。このプログラムはあくまでも「素人」が、「趣味」で書いたものであり、思い込みや勘違いによる誤りを内包している可能性があります。大変、申し訳ないのですが、どうか、そこだけはご了承ください。

【もくじ】

1.観点別評価から評定への変換基準
2.ワークシートへのデータ入力方法
3.プログラムの使い方とダウンロード方法
4.まとめ
5.お願いとお断り

1.観点別評価から評定への変換基準

観点別評価から評定への変換基準は、次の通りです。

Aは6点、Bは4点、Cは1点に変換、その合計値が18ならば評定5、そうでない場合はその合計値が13点以上ならば評定4、そうでない場合はその合計値が9点以上ならば評定3、そうでない場合はその合計値が6点以上ならば評定2、そうでない場合は(合計値が3点ならば)評定1とする変換基準に基づいて、このプログラムは動作します。

観点別評価から評定を計算するのではなく、あくまでも、既存の成績データの整合性をチェックするプログラムであることに、どうか、ご留意ください。

【観点別評価と評定】
AAA ・・・ 5
ABA, BAA, AAB ・・・ 4
AAC, ACA, CAA ・・・ 4
ABB, BAB, BBA ・・・ 4
ABC, ACB, BAC, BCA, CAB, CBA ・・・ 3
BBB ・・・ 3
BBC, BCB, CBB ・・・ 3
ACC, CAC, CCA ・・・ 2
BCC, CBC, CCB ・・・ 2
CCC ・・・ 1

2.ワークシートへのデータ入力方法

次の2つのパターンに対応。

StringGridを2つ並べて作成したUI


「まとめて入力」を選択した場合は、観点別評価がまとめて一つのセルに入力されているファイルをチェックし、「分けて入力」を選択した場合は、観点別評価がそれぞれ独立したセルに入力されているファイルをチェックします。

いずれの場合も観点別評価が文字列または文字データとして入力されたセルの「真」に右隣りのセルに「評定」の数値データが入力されていることが、プログラムが正常に動作するための必須条件。

プログラム完成後にセルに埋め込んだ計算式が表示する値であっても、上の動作条件を満たす形でデータが並んでいれば、プログラムは正しく動作することを一応確認しました、が・・・

評定を計算式で表示しているのであれば、こんなチェック・プログラムはいらないか、と・・・。

【重要な注意】

このプログラムは、任意の行のセルに入力された、文字列(または文字)の観点別評価と「真」に隣り合う列に、数値で入力されている評定がある箇所を見つけ、その整合性をチェックするものとして開発。

プログラムが正しく動作する入力例:

評価は文字列か文字、評定は数値(いずれも計算式が表示する値ではないという前提)

次の場合は動作しません!
ワークシートのセルに設定された計算式がある場合は、それを破壊します。

プログラムが正しく動作しない(どころかデータの破壊が生じる)入力例:

列が非表示に設定されている


上の例のように、観点別評価と評定の入力セルの間に「非表示に設定された列」があり、その非表示に設定された列に観点別評価のA・B・Cを数値に変換する式が組まれているような場合、非表示の列があるため、見た目には観点別評価と評定が隣り合うセルにあるように見えても、プログラムは期待通りに動作しません。このようなファイルを自動修正機能を使用してチェックした場合、非表示の列内のセルに設定された計算式は確実に破壊され、失われます。くれぐれもご注意ください。

前述の通り、このように式で結果を表示している場合は、チェックする必要性などない気が・・・しますが、どうしてもチェックしたい場合は、ファイルのバックアップを取り、ワークシート全体を値複写で上書きしてから、不要な列を削除すれば、チェック可能に。

プログラムは、観点別評価が入力されているセルを自動的に探し、その「真」に右隣りに存在するセルに入力されている数値が期待されたものであるか・どうかをチェックするだけで、この並びに従わないその他のセルに入力されたデータ・計算式はすべて無視して動作します。

問題は、(私の)想定外の(プログラムが)無視できない「何か」に引っかかってしまった際の挙動ですが、重要な部分は try 文を使用して、何かあればエラーメッセージを表示するようにプログラミングしてあります。なので、プログラムがフリーズするようなことは、起きないはずです。

また、観点別評価が入力されていると判定されたセルの「真」に右隣りのセルに、(評定の入力がない)空白セルがあった場合は、エラーメッセージを表示します。動作確認作業を進める中で、そのことの必要性に気づき、プログラムに必要な修正を加えました。もちろん、空白セルの自動修正も可能です。ただし、観点別評価が不足している(3観点分がそろっていない)場合には、プログラムはそのようなセルをチェック対象としません。もちろん、エラーメッセージも表示されません。使用にあたっては、この点にも十分ご注意ください。

3.プログラムの使い方とダウンロード方法

チェックしたいファイルを任意のフォルダに保存します。

拡張子は3種類に対応


上のように、チェックしたいファイルを保存したフォルダ内にその他のフォルダやファイルがあっても問題なく動作します。

チェック・プログラムのアイコンをダブルクリックしてプログラムを起動します。


最初に、チェックしたいファイルの拡張子を選択します。

xls, xlsx, xlsm 3種類のファイルに対応


次に、観点別評価の入力形式を選択します。

観点別評価の入力方法の選択肢は、直感的に選べるよう工夫したつもり・・・


次に、調査対象のファイルを入れたフォルダが exe と同じ場所にあれば「 EXE 位置」、そうでない場所にある場合は「指定なし」をクリックしてください。


次に、調査対象とするワークシートの番号を指定します。


Excelのワークシートコレクションのインデックス番号は「0」始まりではなく、「1」始まりであることに注意してください。1枚目のワークシートとは、次の図の「 Sheet1 」を意味します。このプログラムではワークシートの名称ではなく、その位置でチェック対象のシートを決めています。ですので、ワークシートの名称は問いません。


より詳細な案内表示や、評定の自動修正機能を使用したい場合は、チェックボックスにチェックを入れてください。デフォルトで「案内」は True、「自動修正」は False に設定してあります。


上で述べたように、「自動修正」は最悪の場合、ワークシートのセルに設定された計算式を破壊する可能性があるので、取扱いには十分注意する必要があります。いろいろ考えた末、やはりここはパスワードを入力しないと自動修正機能が有効にならないようにするのが万一の事故を防止するには最善と判断しました。なので、「自動修正」にチェックするとパスワード入力を求める自家製 InputQuery が表示されます。


次のパスワードを入力して、OKをクリックしてください。
最後に半角の「 ! 」がついています。コピペする際、お忘れにならないよう、ご注意願います。

Evaluate-Fix2025!

正しいパスワードが入力されていれば、次のメッセージが表示されるので、

ものすごく、読みにくいとは思いますが・・・

よくよくよくよくよく
お読みいただき、
ご理解・ご了承いただけた場合のみ

「はい」をクリックしてください。万一にも、不安を感じた場合は「いいえ」を選んだ方が賢明です。

【参考】

ちなみに、「自動修正」にチェックが入っていなければ、ファイルは読み取り専用で開くようにして、不測の事故を防止しています。

  if cbAutoWrite.Checked then
  begin
    //ファイルを書込み可能な状態で開く
    Workbook := ExcelApp.Workbooks.Open(ListBox1.Items[i], EmptyParam, False, EmptyParam,
    EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, 
    EmptyParam, EmptyParam, False);
  end else begin
    //ファイルを読み取り専用で開くことで、編集のためにロックされることを防ぐことができる
    Workbook := ExcelApp.Workbooks.Open(ListBox1.Items[i], ReadOnly := True);
  end;

「はい」をクリックすると、案内のメッセージが表示されます。


準備が全て整ったら、「チェック開始」ボタンをクリックしてください。最初にチェックするファイルを保存したフォルダをクリックして選択し、OKをクリックします。チェックは自動的に始まります。

成績ファイルを保存したフォルダを選択


チェックが完了すると、次のメッセージが表示されます。それまでお待ちください。実測したわけではありませんがチェックするデータがワークシート1枚あたり1000セットあると、PCの性能にもよりますが 30 秒以上かかると思います。


なお、チェック中は、プログラム画面の下方にプログレスバーが表示され、緑の帯が作業の進行状況を示してくれます。

実際に、ある現場で使用しているプロが作成した業務用ファイルに対して実行してみた例。
1学年7クラス規模の場合、約400行 × 約80列程度のチェック範囲となっている。


チェックの結果、問題がなかった場合は「評価と評定の整合性に問題はありませんでした。」と表示されてチェック終了です。


整合性に問題があるデータを見つけた際は、その行・列位置を次のように表示します。

RはRow(行)、CはCol(列)を意味します。
(本番で、こんなに間違いがあることは、まず『ない』と思いますが・・・)


最も上の例で言えば「セル R2C3 」は、第2行目の第3列のセルのデータに問題があることを意味し、プログラムは、その問題の内容を右の( )内に表示します。この場合は、「6」というあり得ない評定値が入力されていたことが問題の原因であることを示しています。

「自動修正」を有効化してチェックした場合は、次のように修正後の評定も表示されます。

自動修正を有効化した場合は、保存する時間も必要なので動作速度が若干低下します。


これで、成績の付け間違いは完全に撲滅できると思ったのですが(確かに実際に撲滅できましたが)、現場でこのプログラムが発見したデータの誤りの中には、「評定が正しく、観点別評価の方が間違い」だった例がありました。ですので、整合性の問題を発見した際には、誤りが「観点別評価」にあるのか、それとも「評定」にあるのかを個別にチェックする必要があるようです。

なお、設定は ini ファイルに保存し、次回起動時に復元することができます。作者が勝手に設定した値になりますが、諸設定を初期化することもできます。

初期化を実行するには、「ロックの解除」が必要

【プログラムのダウンロード】

ダウンロード要件に同意していただける場合のみ、ダウンロードできます。

ダウンロード後、zip ファイルを展開していただき、ABC_Cheker.exe をダブルクリックしてプログラムを起動してください。同梱の TestData フォルダ内にテスト用データを入力済みのファイルがありますので、このファイルを利用してプログラムの動作をご確認ください。

なお、プログラムの初回起動時には、Windowsのセキュリティ機能であるSmartScreenにより「WindowsによってPCが保護されました」というメッセージが表示されると思います。

初回実行時に表示される警告画面


悪意のあるプログラムではありませんので、「詳細情報」をクリックすると表示される次の画面で「実行」を選択(クリック)し、プログラムを起動してください。2回目の実行からは、この警告画面は表示されなくなるはずです。

「実行」をクリックしてプログラムを起動します。


お手数をお掛けして申し訳ありませんが、信頼できる発行元になるために必要なデジタル署名を取得する費用等を考えますと、個人レベルで、その申請手続きを行うことは私の場合、無理と言わざるを得ません。開発に使用している IDE ( Delphi 12.3 )のサブスクリプション費用の支払いだけは Object Pascal の発展を願う1ユーザーとしての気持ちからずっと続けていますが・・・。

なお、最初にアップロードした実行形式ファイルで「自動修正」を有効にした状態で設定を保存すると、次回起動時に Form が表示される前に自動修正を有効化する処理が行われてしまい、「無効/非表示ウィンドウにはフォーカスを設定できません。」というエラーメッセージが表示されてしまうバグがあることに気づき、「自動修正」を有効にした状態で設定を保存しても、次回起動時に Form の表示が完全に行われてから、自動修正を有効化する処理が実行されるように、プログラムを修正しました。

ただ、「自動修正」を常に有効化した状態で起動すると、毎回パスワードを入力する InputQuery が表示されることになってしまいます。そういう「仕様」ですので、これは仕方がありませんが、起動と同時にパスワードの入力を求められますので、ちょっとびっくりします。ですので、危険を防止する意味からも「自動修正」機能を常に有効化しておく設定での運用は避けた方がよろしいかと思います。

4.まとめ

・新教育課程の観点別評価と評定の整合性をチェックするプログラムができました。
・高等学校用です。
・無料でお使いいたけますが、サポート等は一切ありません。
・ヘルプファイルもありません(ここでの説明がすべてです)。
・作者が未発見の(大いなる)不具合がある可能性があります。

5.お願いとお断り

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

TSL205の修理

スノーシューの先端の、登山靴の爪先を固定する部品が、前回の山行で壊れてしまった。

雪の上に落ちた欠片を拾ってきた。
僕に修理できるとは思えなかったけれど、壊れた欠片を山のゴミにするわけにはいかない・・・


写真では3つに分断されたように見えるが、実は右側の部品のベルトを通す部分も破損していて、実際は4つに分断される形で壊れている。

この部品がなくても、靴の爪先を固定するベルトはまったく問題なく機能するので、ベルトと靴の摩擦で靴が早く傷むかな?・・・という心配以外には、何の問題もないような気もしたが。

Web 上に、このことに関して何か情報はないか・・・と検索してみると、これと同じ「部品が破損して、要修理状態ですが・・・」という但し書き付きで販売されている中古の TSL205 を複数発見。

プラスチック樹脂の経年劣化で、遅かれ、早かれ、この問題は必ず生じるのだろうな・・・ と、ひとり納得する。

「最新型に買い替える」という手も、もちろん「あり」だが、新品の価格は2万数千円。毎日使用するならともかく、年に数回使うか、どうか、という「遊び道具(ただし、命にかかわる)」に、今、それだけのお金を支払う気にはなれない。

壊れたのは右足側だけで、左足側は現在のところ、何の問題もないし・・・

それに、いろんな最新型を見てみると、登山靴の固定方法がより一層便利な方向へ、一見「進化」しているように見えるのだけれど、( もし、山で、壊れたら・・・ 現場でリペアできる? )みたいな視点で考えると、ちょっと怖くなるような商品が大多数・・・。

山の先輩から教わった、いちばん、信頼できる靴の固定方法は「ベルトで締め付ける」タイプ。
単純で、簡単で、万一、不具合が生じても、現場で修理できるカタチがベスト。

このいちばん単純な固定方法であっても、氷点下の環境で、締め付けベルトが凍結&結氷し、手指もかじかんで、自由な運動がままならない状況では、脱着にとてつもなく苦労したりするのだ。

これは実際に、僕が雪山で経験して得た教訓。だから、いい加減な妥協は、絶対にできない。
何かを結ぶ・固定するには「紐・ベルトがいちばん良い」という先輩の言葉を、僕は心から信じる。

修理と言うか、とりあえず、(上の写真の通り)壊れた部品だけ外して、登山靴の爪先を固定するベルトはまったく問題なく使用できるから、そのまま使おうか・・・と思っていたら・・・

スノーシューが壊れた山行を共にした、僕の大好きな先輩が・・・ 後日、やってきて・・・

これは、壊れていない方(左足用)のスノーシュー


手持ちの細引きと100均で購入してきたベルトで、壊れた僕のスノーシューを修理してくださった・・・。

「あのスノーシュー、ある?」って、先輩が言うから、「はい、あります。」って返事して、先輩に壊れたスノーシューを手渡したら・・・、その10分後。

先輩は、細引きとベルトでプラスチック樹脂の代替部品を作成


まるで、これがオリジナル状態かと思うほどの出来栄え・・・


実際に登山靴を装着してみたところ・・・

純正より、先輩が修理した右足側の方が・・・ 精悍に感じる!


先輩曰く。

「ベルトと紐が、いちばん確実なんだ。」

「擦り切れたら、予備と交換するだけで、直る。」

「だから・・・ これは、もう片方が壊れた時の分な・・・」

そう言って、予備の細引きとベルトを、僕に渡してくださった・・・。

さらに・・・

「 電車にも乗るし、ザックにそのまま付けて歩くわけにもいかんだろう 」と・・・

先輩は、スノーシューを入れるバッグとザックに付けるためのベルトも用意してくださっていた・・・


ただ、ただ、先輩に感謝。

うれしくて、雪山へは、この状態のまま持って行った!


先輩から借りたトレッキングポール2本を左手に束ねて持ち、右手にスノーシューを入れたバッグをぶら下げて、ザックを背負い、嬉々として僕は先輩と雪山へ・・・。

その日、山はフカフカの新雪に覆われていた。
はるかに北アルプスを望む

思えば・・・

もう、何十年も登っていなかった山に、「 一緒に登ろう! 」って誘ってくれたのも、この人だった。

「お近づきのしるしに・・・」って、先輩がプレゼントしてくれたメスティンで、先輩からもらったパエリアのもとを入れ、ドキドキしながら庭で炊飯して食べたごはんは、涙がこぼれるほど美味しかった。

「時間を見て、引き返せ」ってアドバイスをもらった山行では、日本でいちばん高い山を間近に見て大興奮。あまりのうれしさに時の経過を忘れ、無理な登山を強行。登頂は果たしたものの、下山途中でグリコーゲンが尽き、たどり着いたテント場では疲労困憊のため、空腹であるにも関わらず、食事すら摂れない状態に・・・。そのことを帰りの電車から先輩に報告したメールは、僕の山行の復活の証だ。

いつも、こんな僕のことを、先輩は気にかけてくれて・・・

ネットで「 これは、きみのアイゼン 」って勝手に決めて、勝手に購入して、本当は高価な良い品を格安で譲ってくれたり・・・

僕がルートを間違えた時も、いち早く、その誤りに気づき、谷底に降りてはいけない理由や、その怖さを実地に諭し・・・、雪に覆われた川の渡り方を、僕に教え・・・「こっちだ。」って、先輩の言う通りの方向へ進んで正しいルートに戻れたことも・・・。

また、ある山行では、悪化する天候を予測。登頂を断念して引き返す「勇気」の大切さを、教わり・・・

山での食事の際は、いつも食後の紅茶やコーヒーを皆に。

そして、ここ、いちばんのシーンで、ザイルを肩に断崖に立つ、その姿は・・・ 数万の敵を睥睨して一歩も引かない、古代ローマの戦士のようにも、見えた・・・。

スノーシューの修理後、テストを兼ねて先輩と登った山のひとコマ


修理したスノーシューは、実際に、20~30cmほどの新雪に覆われたこの雪山で丸一日使用。修理してくれた先輩と一緒に、標高差約1000mを登って降りた。行動中に、締め付けベルトはもちろん凍結し(左右とも)、山頂で昼食を作る際の脱着にはそれなりに苦労したが、行動そのものには「何の問題もなし」。

登山前日に降ったばかりのフカフカの新雪で、スノーシューを履いていても一歩踏み出すごとに足が数十センチは雪に潜り、スノーシュー無しで一緒に登ったアイゼン組のメンバーからは「二度と行きたくない山ナンバーワン(もちろん冗談。それくらいキツかったということ?)」との感想も出た中で、僕は筋肉痛すら出ず(先輩に勧められて食べたサラダチキンの効用も多分にあり?)。もちろん、先輩の修理により、見事復活した My スノーシューは、終日、外れる気配すらなし。

左右のトレッキングポールの刺さり方から、フカフカの新雪であることが伝わるでしょうか?
先輩が貸してくれたトレッキングポールのバスケットは、もちろん雪山用の大きいタイプ。


もちろん、締め付けベルトは、カチン・コチンに凍った・・・ が、1日で登って降りるというハードな山行をスノーシューはしっかりサポート。

今や、積雪期の山行に、なくてはならないアイテムとなった My Snowshoe.

ただ、ひとつだけ、妙に気になったことがあって・・・。

僕らのクライミング・リーダーである先輩は、なんと・・・

スノーシューを持ってない!

僕にスノーシューの購入を勧め、破損した際には、こんなにも素晴らしい修理を施してくれた先輩は、なぜ、スノーシューを履かないのか?

先輩曰く。

オレ、一度も履いたことない。

そこだけは、謎。

謎だが、そこがまた、先輩の不思議な魅力であることに、間違いはなく。

破損した TSL205 の修理で困っていらっしゃる方に、この記事が少しでも参考になれば、それは何よりの喜びです。*(^_^)*♪

【お願いとお断り】

このサイトの内容を利用される場合は、自己責任でお願いします。記載した内容を利用した結果、利用者および第三者に損害が発生したとしても、このサイトの管理者は一切責任を負えません。予め、ご了承ください。特に、登山用品は自らの命を預けるものです。そのメンテナンスについては、自己の責任のもと、常に万全を期す必要があります。今回、記載した記事は、自己流の修理を奨励・推奨するものでは決してありません。

【追記】

登攀する際は、TSL205 の後部のロック(留め金)を解除して、太い針金状の部品(ヒールリフターと言うらしい)を前に倒し、かかとの位置を上げることで、足の負担がかなり軽減される。

ヒールリフターを使用しない状態
ヒールリフターを使用する状態


いちばん最初にヒールリフターを試した際は、ストッパーでしっかり固定された可動部のあまりの固さに、この太い針金状の金属部品を無理して持ち上げるとスノーシューが壊れるのではないか? と、かなり心配したが、慎重にゆっくり持ち上げれば大丈夫のようだ。

実際、登りでヒールリフターを使用してみたが、使用していない状態よりも、使用した方がはるかにラクに登れた。ご参考まで。

雪と、空と、僕と・・・

心に決めたタイムリミットまで、あと 20 分。
胸に思い描いた、ピークが ・・・ ついに、見えた。

画面中央やや右に見える丘が目標のピーク。

その右上の白点は「月」


そうだ・・・。あの頂きに立ちたくて、僕はここへ来た。
高度にして・・・あと 100 m ・・・ と、ほんの少し・・・ の ・・・ はずだ。

高度計の示度は、2300 m。


補正していないから、正確な値ではないが、真の高度に近い値であることは間違いない。

天候は 快晴。
風力 0。

リミットと決めた時まで・・・残り 20 分。

残り 20 分の距離にしては、少しだけ、遠すぎる・・・気がする・・・
せめて・・・、あと、30分。 あれば・・・

ただ、幸いなことに足元の雪は・・・ 固く、しまっている。
スノーシューの力を借りれば、潜るようなことはない。

スノーシューは、TSL 205。 僕の誕生日と同じナンバー。


おそらく、この辺りが森林限界だ。
もしかしたら、視界が広がったことで、そう感じるのかも・・・ しれないが。

今は、とにかく、前へ、前へ、進む。
トレッキングポールの有難みを痛いほど、感じる。
普段、平地を歩くときは、その必要性など感じないが、斜面を登攀する際は、いつの間にか、なくてはならないアイテムになったトレッキングポール。

今日使っているのは、先輩に借りた雪面用のバスケットの大きいタイプだ。
だから体重をかけても、ポールが雪面に潜るようなことはない。

腕の力を使い、言わば 4WD 的に運動できることで、足の負担は相当に軽くなる。

ザック サク・・・

ザック サク・・・

ザック サク・・・

雪を踏みしめる音と、トレッキングポールが雪面を刺す音が交互に響く。

登りが少し急になり、呼吸も次第に荒くなる。
歩幅を小さくして、低い階段を登るように細目にステップを切って進む。

汗が目に沁みて痛い。

( この斜面を越えたら、ザックからタオルを出そう )

そう思いながら登ること、しばし。
ようやく、急な斜面を超える。

ザックを雪面に降ろし、上部のポケットからタオルを取り出して、汗を拭く。
背に心地よい冷気を感じるが、それはザックを降ろした今、この瞬間だけだろう・・・。

気温はわからないが、ザックのハーネスに付けたペットボトルの水の冷たさがそれを教えてくれる。
滴り落ちる汗に反して、それは凍り付くように冷たい。

荒くなった呼吸を、少しでも落ちつけたくて、
乾きを感じないままに、ひとくち、ふたくち、みくち、
ペットボトルを傾ける。

時計を見る。
心に決めたリミットまで、まだ数分ある。

自らに、問う。
行くか、戻るか ・・・を。

今、ここにいるのは僕だけだ。

歩みを止めた瞬間に、感じた ・・・ 恐ろしいくらいの「静寂」
雪が、空が、すべての音を吸い込んで ・・・ 聴覚から得られるものが・・・ 何もない。

遥かに、北アルプスが見える・・・
初めて、白馬岳の山頂に立った時、僕はまだ・・・16歳だった・・・


ほんとうに、なにも・・・ なんにも、聴こえない・・・。
風がないと、山はこんなにも・・・ 恐ろしいくらいに、静か・・・ なのか。

振り返り、もう一度、目指すピークを見る。
雪と、空と、僕と・・・

ピーク。

そうだ。胸に、思い描いた、約束の場所。

( ・・・ )

周囲の木立には、吹雪の爪痕が残されている。
昨夜の風の形、そのままに。

大丈夫。
この先、数時間、天候の急変は まず ない。

ならば・・・

( 行くぞ! )

決心した 僕は・・・
ピークへの新しい一歩を、踏み出した。


時計が、心に決めたリミットを告げている・・・
でも、ピークは、もう、すぐそこ だ。

( 登ったら、日没までに、高低差約 1000m を駆け降りる力だけ残っていれば、大丈夫。)

そう思いつつ、足元を見ると・・・
右足に履いたスノーシューの、靴のつま先を覆うプラスチック部品が壊れている。
だがスノーシューの結束バンドは、靴の爪先をしっかり捉えている。

( 大丈夫。外れはしない。 )

そう自分に言い聞かせ、雪を踏みしめる。

あぁ・・・ 遠く、月だけが、僕を見てる・・・
あと、もう少し・・・だ。

ここまで登っても、月まではまだ 38 万kmもある。しかし、頂きまでは・・・ あと10mだ。

約束の場所からは、美しすぎる風景が、見えた・・・

「あれが白馬だ」
そう、思うと、もう言葉が・・・何も、出てこない。


見える全てを、胸に刻む。

ただ・・・

登ったら、降りなきゃいけない。
それが、山との約束だ。

登ったら・・・ その想いを噛みしめている時間は、いつも、余りにも、短い。

陽は傾き、すでに時は心に決めたリミットを過ぎている。
これから日没までに 1000m 以上、降りねばならない。

( もう少しだけ、ここにいたい・・・ )

それが、ほんとうの気持ちだが・・・。
でも、もう時間がない。

もし、日が暮れたら、ライトはあっても、樹々に結ばれたルートを示すピンクのリボンを見つけるのは至難の業だ。どんなことがあっても、自己責任で日没までに人の住む世界へ降りなければならない。

ピークを示す山頂標識の上に誰かが置いたスノーマンに無言で別れを告げ、
僕は下りの一歩を踏み出した。

遥かなる麓へ・・・。

刻々と迫る日没。麓を見れば、山陰の雪は、白銀から、うす青く、その暗さを増しつつある。
気持ちは駆けているのだが、斜面を転がるように下降する僕は、実際はどう見えただろう・・・?

正直、下りが苦手だ。
これまでの山行で、そのことを嫌と言うほど思い知らされるシーンが何度もあった。

バレーボールなど、足の屈伸を繰り返すスポーツを過去に経験した人は、鍛えに鍛えたその足のバネを生かして、ほんとうに軽やかに、まるで舞うように山を駆け降りて行く。

( 無理だ。追いつけない。待ってくれないか・・・ )

そう感じたことは、1度や2度ではない。実際、下山のタイムリミットが決まっている、つまり、帰りの電車やバスの発車時刻が「絶対に遅れてはならないリミット」として下山予定時刻に組み込まれている場合など、心底、泣きたい気持ちを味わった山行もあった。

ただ、この差は普通のトレーニングでは、そう簡単には埋まらない。
なので僕は、グループで登山した際の下山では、いちばん遅い人の後ろを定位置に決めて、グループの最後尾を歩き、自分だけが遅れて全体の行動に迷惑をかけることがないようにしてきた。

でも、今日の山行は違う。
日没を別にすれば、下山予定時刻のリミットもない。

このように、気持ちがラクだったせいなのかもしれないが・・・。
今日の僕は、降りに、降りた。

日没が近くなり、気温がさらに下がったためか、木陰に入ると染み入るような寒さを感じる。
若干、風も出てきたようだ。正面から吹いてくるから・・・ 風向きは、西風か・・・

雪面はさらに固く締まり、スノーシューから登りの時とは明らかに異なる感覚が伝わってくる。それは「ザクッ」ではなく、「バリッ」・・・と、その表面を割るような感覚だ。

一方、日当たりのよい場所は雪がクサっていて、スノーシューが大きく滑り、何度か転んで雪まみれになる・・・ が、しかし、樹林帯の中などでは雪は程よく締まっていて、そのような心配はなく、いつもなら躊躇するような急斜面も、そのすべてをジャンプを繰り返すようにして通過する。

それは、正直、降りたって言うより、
落ちたって感覚だった・・・。

そして、麓に日没が訪れた頃・・・

空はまだ明るいが、地上には夕闇が迫る


僕は、目標地点まで、無事、下山することができた。

「人は、なぜ、山に登るのか・・・?」

ふと、そう思い、答えを探せなくて、苦笑する。

答えは・・・、人、それぞれでいい。

僕に限って言えば、答えはなくても いい。


振り返れば、空に、その白さを増した月が見えた。

月が微笑んでくれた、気がした・・・

38 万km 彼方で。

僕は、いつまでも、きっと・・・ この景色を忘れないだろう・・・。

もしか、したら・・・

それが、僕が山に登る「理由」かな?

僕に限って言えば・・・

うん・・・。

答えなど、なくても いい のだ けれど・・・

僕を包む、すべてに・・・

そう・・・。

答えなど・・・

何一つ、なくても いい のだ けれど・・・。

10より大きいマークを使うマークシートの作り方

以前、文書作成ソフト( Word )や表計算ソフト( Excel )を使用してオリジナルのマークシートを作成する我流も我流、はたしてこんなんでいいのか? まぁ、実際に使えるから、いいか・・・みたいな記事をいくつか書いた。

書いた本人が言うのだから間違いないであろう、過去のいい加減な記事の数々・・・


で、今回はナニをしたかと言うと、数学用マークシート処理プログラムの改良版を作成するにあたり、マークシートそのものも改良(と本人は思っている)し、プログラムもあらかたできた(と本人は思っている)ので、「実際の試験でテストしたいなー」と思ったわけですが・・・

「実際の試験でテストする」って言い方もヘンですが。

「実際のテストで試験する」って言っても、やっぱりヘンですが。

・逆もまた真なり? どっちもヘン

 まぁ、なんでもイイです。

いきなり数学の先生に「試しに使ってみてください」というお願いをするのもナンだし・・・

万一どころか、使って初めて気づく
バグ満載のプログラムであることは「間違いない」自信だけはあり・・・

( なら 自分で、こっそり )

プログラムのテストを決行することに決めました。


決めたのはいいんですが、使用するマークシートが問題で、数学用途のシートは個人的な問題から使用できないため、マークが「 -(マイナス記号)から始まり、dで終わる」数学用のシートではなく、それと見た目が同じ(大問番号や設問記号及び枠の大きさが同じ)で、ただマークのみ「1から始まり16で終わる」カタチに変更したマークシートを作成し、これで新しい採点処理プログラムをテストしようと思ったワケです。

しかーし、ここで大問題が二つ発生!

大問題その1:
・私の技量では表計算ソフトで、10以上のマークが作成できない!

大問題その2:
・文書作成ソフトで、マークシートを修正する方法を全部忘れた!!

その1は純粋に技術的な問題で、「今後の学び & 創意工夫」により改善が見込めるからまだイイとしても、あろうことか、その2は青天の霹靂・悲惨の極み・驚天動地・寝耳に水・予期せぬ不意打ち などなど、日本語ではいろいろな表現が可能だが、まぁ最も適切なのは「痛恨の一事」か・・・

なんで全部忘れるの オレ?

ってか、修正方法をもともと知りませんでした☆ ぎゃはは

・・・というわけで、たとえこのように七転八倒と運命づけられた人生であっても、まだあきらめる気がしない(ここにメモしておけば、また忘れても必ず思い出せる & 万一にも同じ志を抱く、どなた様かのお役に立てれば・・・それこそ幸い的な思いもあり)、今回のテーマは「10より大きいマークを使うマークシートの作り方」です。

【もくじ】

1.(私には)表計算ソフトで10以上のマークが作れない!
2.マークの修正方法を全部忘れてることに気づく
3.イチから出直します
4.まとめ
5.お願いとお断り

1.(私には)表計算ソフトで10以上のマークが作れない!

自身が最も多用するのは、1ブロックが 25 行で、1設問あたり8選択肢、合計4ブロックの全 100 問対応の A4 横置き型マークシート。(My 用途では、実はコレでほんとに十分なのですが・・・)

25行、8選択肢、4ブロック、100問対応のマークシート


あれもしたい、これもしたい、みたいな、欲に目が眩んで、というか、思いつくままにマーク読み取りプログラムの機能を拡張したくなり、このシートを元にして作成した発展形の一つである数学用は、1ブロックが 25 行で、1設問あたり 16 選択肢、合計3ブロックの全 75 問対応の A4 横置き型マークシート。1枚で大問3個しか設定できないので、2枚を組み合わせて採点することで大問6個に対応。

選択肢は、-・±・0~9・a・b・c・d の16個(文書作成ソフトで作成)。
実は、マークとマークの間隔が狭いところ等を直したいって、ずっと思っていた。


現在、この数学用マークシートを改良して、B4 縦置きの用紙にB5横置きを縦に2枚並べて印刷し、半分に折りたたんだ状態で試験を実施、シート回収後、マークの読み取りと採点処理を実行できるプログラムを書いている。

この新しいプログラムをテストするにあたり、いろいろ直したかったところが満載だった数学用マークシートそのものも改良したくなり、反省点を元に作成したのがコレ(図は設計時の画面)。

表計算ソフトで作成。選択肢の数は16個で旧版と同じ。

反省点とは何かというと、

(1)マーク読み取り範囲の設定方法がわかりにくかった(と思う)ので、まず、これを改良。

旧版では、マーク読み取り範囲の設定時、利用可能な枠線がなかった!

旧版では、左上の「|」マークを目印に読み取り枠を設定した。

赤枠で囲んだ範囲がマークの読み取り範囲


新版は、枠線があるので、読み取り範囲の設定が少しはラクになった?
同時に、マークの間隔もより広めに設定し、受験者が多少大きめに塗りつぶしても誤判定が出にくく改良(したつもり・・・テストしていないので、現時点では効果のほどは?)。

きちんとした枠線を設け、マークの間隔を広くした!


なので、読み取り範囲の設定は、枠線を利用して実行できるようになった。


(2)1ブロックあたりの行数を 25 → 30 行に増やした。 これで大問1個について、30 設問の設定が可能になった。

ア・カ・サ・タ・ナ・ハ行で1ブロック30行
つまり、大問1個について、30設問を設定可能とした。


(3)旧版の A3 縦( A4 横置き×2)ではなく、B4 縦( B5 横置き×2)へ用紙サイズを変更した。

B4縦にB5のマークシート2枚を配置

A3 サイズのシートも作成してみたのだが、A3 サイズだとインクジェット複合機を利用して印刷(輪転機での印刷はマークの濃度が濃くなり、誤判定が出やすくなることから非推奨・・・というか、ユーザーには禁止と案内している)する時間が B4 サイズのそれより明らかに遅くなる、スキャナーでの読み取り処理にも時間がかかる等、いろいろ問題があり、少々マークの文字は小さくなるが A 版に比べて何かとメリットが多い B 版の用紙を使うことに決定。

もちろん、国際的にはやはり A 版だと思うが、欧米文化圏で My マークシートリーダーが使われるシーンはさすがに想像できない。できないが、今年、いちばんの夢は英語バージョンを作成することだ。これは新年早々に思いつき、数学用シートの処理プログラムが完成したら、今年の次のチャレンジ・イベントはそれだと思っている。

で、話を本題へ。

この表計算ソフトで作成した数学用マークシートのマークを「1」から「16」に変更しようとしたのだが、どうがんばってもそれが出来ない!

実際のシーンを再現。

表計算ソフトを起動して、全行・全列のセルの高さと大きさを適当なサイズに設定し、挿入 ⇨ 図形から楕円を1つ、セル内ちょうどおさまるように描画、このオブジェクトを右クリックして表示されるサブメニューから、「テキストの編集」を選択(クリック)して半角数字で「1」を入力。オブジェクトの色は灰色に設定する。


次にマークのオブジェクトが入っているセルを選択し、オートフィルの機能を使って右へドラッグしてコピーする。

とりあえず16個、コピーした。

ここまでは、実にイイ感じ♪

左から2つめのマークの数字部分をクリックして編集状態にし、半角数字の「2」を入力。


これを3、4、5、・・・、9まで繰り返して、10を作成すると・・・

「9」まではイイ感じだが☆ 10で問題が発生。

おい、ちょっと待て・・・

「0」は「1」の下じゃなくて、「1」の横に表示して欲しいんだけど・・・


しかも、フォーカスを外すと・・・

ヘイ バカターレ!
8、9、1じゃないよー!!

楕円のオブジェクトの幅を変えるわけにはいかないから、フォントサイズを小さくして修正。

ハイ
不採用決定。(T_T)

このまま、あきらめるのはどーしてもイヤだったので、ジタバタしてみることにする。
どーせ、他にすることないし。実はあったかもだけど、したくないし・・・

しばし、沈思黙考

(-_-)zzZ

寝るなー!!

オブジェクトの中に数字を描画するのがイケナイのかと思ひ・・・、楕円オブジェクトは「塗りつぶしなし」に設定して、テキストはセルに直接入力してみる。

半角数字をセルに入力


ちょっと、微妙に違和感がないこともないが、なんとか使えるかな・・・という程度にはなったか?
2桁数字の方が、なんとなく、下がって見える・・・ 色も濃い?(同じ灰色でも面積の関係か?)


試しに、印刷プレビューしてみると・・・

2桁数字のインパクトが強すぎ!!

(塗りつぶし面積も、実用的にはもっと狭い方が好ましい)


こんなマークシートでは、存在感の薄い「1」~「9」にマークするには、余程の勇気が必要です!

ハイ
不採用決定。(T_T)

上の例なんてまだ良いほうで、実際には、もっとイロイロやってみたが、使えないマークシートをひたすら量産する結果に。(元々ない)知恵の限りを尽くしても、状況は改善する兆しすらなく・・・

少なくても現在の私の技能では、表計算ソフトを用いて「実際に使いたいと感じるレベルの品質」を維持した「10以上の数値を表示するマークを作成することは不可能」と悟ったのであった。

2.マークの修正方法を全部忘れてることに気づく

まだ、すべてが終わったわけではない。そうだ。文書作成ソフトを使って再チャレンジする方法が残されている。以前、教科「情報」用のゼロ始まりのマークシートを作ったじゃないか。あの時は特に問題なく、0、1、2、・・・、14、15まで計16個の丸囲み数字を作成できたはずだ。

そう思い、保存してあった教科「情報」用のファイルを開き、それを改良しようとしたのだが・・・

手も、足も、出ないとはこのことか・・・

ヤバイ!

いじれない!!

修正方法、全部、忘れた!!!

・・・ってか、よく考えたら、もともと知らない。
コレ、作り直した方が早くね??? みたいな・・・

3.イチから出直します

既存のファイルはいじれそうにない。・・・となれば、残された道はただひとつ。

白紙状態から全部書く!
それしかない!!

あの日、近所の国道を爆走していた緑色の大型トラックの運転席の後ろに力いっぱい掲げられた看板にも、「イチから出直します!」って、確かに書いてあった。・・・あの時、感動で魂が震えたな・・・

実際、ナニがあったのか、わかりませんが・・・

My ふぇーばりっと Car の運転席から思わず叫んでました☆

運転手さん、がんばって!!

・・・ということで 走召 有名な!あの文書作成ソフトを起動し、新規作成で用紙を「 B5 横置き」に設定。余白は最小値(My環境では 0.3 mm)にする(行数・列数共に詰め込みたくて、この設定にしています。実際のシーンではもう少し余裕マージンを取り、あまり攻めすぎない方が良いと思います)。

「レイアウト」タブをクリックして、「ページ設定」リボンの中の「段組み」アイコンをクリックし、表示されるサブメニューから「3段」を選択する。

とりあえず段組は3段を指定


これだけだと何も表示がなく、段組みの状況がわかりにくいので、再度同じ操作を行い、今度はいちばん下の「段組みの詳細設定」をクリック。

「境界線を引く」をチェックしてOK


画面に境界線が描かれる(最終的に消しますが・・・)。


「タイトル・大問番号・OpenCV用のマーカー画像」を1~3行目に入力。

■■■ はマークシートのマーク位置を決定する指標として利用する


4行目にカーソルを置き、「挿入」タブをクリックして「表」リボンの「表」をクリックして表示される「表の挿入」の枠をドラッグして1行×7列の表を挿入する。

画面はこんな感じ


画面右下の「ズーム」のスライダーを右へドラッグし、画面の拡大率を大きくして・・・


表内の任意の場所をクリックすると表示される「表の移動ハンドル」をクリックすると、表全体が選択されるので、「テーブルレイアウト」タブをクリックして表示される「配置」リボンの「中央揃え」をクリックする。これで表への入力値はすべて中央揃えで表示される。


表の例えば一番右のセルを右クリックして、表示されるサブメニューから「挿入」をクリック、さらに表示されるサブメニューの「右に列を挿入」をクリック。表の列が1つ増えるので、Ctrl+Y を繰り返し実行して表の列数を 17 列にする。

上の操作を1回行ったら、Ctrl+Y で直前の操作を繰り返し実行できる


画面はこんな感じになる。


いちばん左のセルに半角カタカナの「ア」を入力し、左から2番目のセルに丸囲みの1(= ① )を入力する。以降、セルを右へ移動しながら順次丸囲みの数字を 16 まで入力する。

My 環境では、みんな右へ寄った形で表示される・・・


【注意:解答欄の番号・記号について】

「ア」としたのは、自作のマークシートリーダーで使用している数学用シートの流用型として使用するため。数学用とマークシートでは、大問1の ア 、イ 、ウ 、・・・、大問2の ア 、イ 、ウ 、・・・、大問3の ア 、イ 、ウ 、・・・、これで解答用紙 A 面(第1面:1枚目)が終了、続けて B 面(第2面:2枚目)へ移動し、大問4の ア 、イ 、ウ 、・・・、大問5の ア 、イ 、ウ 、・・・、大問6の ア 、イ 、ウ 、・・・ のように設問を設定している。

もちろん、ここは「1」から連番で作成しても構わないのだが、自分的には「2枚1セットで使用する予定の数学用マークシートの採点処理を行う新しいプログラムが、実際の採点現場で正しく動くことを確認する」ために今回は行動しているので、採点プログラムのデータ入力欄との整合性等も考えると、シートの変更点は解答欄のマークのみに留めたかったので、この仕様とした。

ちなみに動作テストを予定している新しい採点処理プログラムの採点データ等の入力画面は、こんな感じ。数学用途の採点の場合、設問の欄は数値の連番ではなく、解答用紙に合わせてカタカナ表記としている。ここが数値の連番だと、正解他のデータが入力しづらい。CMS は「組み合わせ採点」、NPO は「順不同採点」の実施の有無を見分けるフラグ(ここが1ならば順不同採点「有」)として利用する。特に「組み合わせ採点」は、数学用途では必須の機能なので、ここを念入りにテストしたいと考えた。

組み合わせ採点を実施(=CMS列の番号が同じ行)する場合、
配点は組み合わせ採点を実施する範囲内の任意の1行に入力し、他は0を入力。
かつ、組み合わせ採点を実施する範囲の観点別評価の種類は必ず一致させる。

解答を要しない(=使用しない)解答欄を見分けるフラグは「-1」としている。


表の任意のセルを再びクリックし、表の左上に表示される「表の移動ハンドル」をクリックして、表全体を選択。「テーブルレイアウト」タブをクリックして、「配置」リボンの「セルの配置」をクリック、表示される「表のオプション」ダイアログの「既定のセルの余白」の左と右の値を0(ゼロ)に設定して OK 。

この設定方法は、これまで知らなかった!

あれこれ、設定を弄り倒す中で、先日、偶然発見 *(^_^)*♪


表はこうなる。

イイ感じ


次に表の ① ~ ⑯ セルをドラッグして選択し、


「ホーム」タブをクリックし、「段落」リボンの「拡張書式」をクリック、表示されるサブメニューの「文字の拡大/縮小」をクリック、さらに表示されるサブメニューの「66%」をクリックする。


表はこうなる。

さらにイイ感じ

気分は Good! Goooder!! Goooodest!!!

あとは不要な罫線を消し、罫線とフォントの色をごく薄い灰色に設定するのみ。

ここは可能な限り薄い灰色に設定したい


罫線の色を変更するには、表全体を選択して、表中で右クリック。表示されるサブメニューから「表のプロパティ」を選択(クリック)。


表のプロパティが表示されたら、「罫線と網かけ」をクリック。


「色」と「線の太さ」を変更して、「プレビュー」の必要箇所をクリックしてOK。


表はこうなる。


今度は、もう一度表を全選択し、選択範囲内で右クリックして表のプロパティをもう一度表示し、「罫線と網かけ」をクリックして、線の色を「白」に設定、表内の縦罫線を表示しない設定にする。

最後に「ア」のセルのみ選択して、上と同様の操作を実行し、「ア」の右に灰色・ 0.25 ポイントの太さで縦罫線を引く。最終的な画面はこうなる。

コレを作りたかった☆

あとは、この1行を全選択し、選択範囲内で右クリック、表示されたサブメニューの「挿入」をクリックして、さらに表示されるサブメニューの「下に行を挿入」を選択(クリック)。


結果は、こうなる。


追加した行に1行目の内容をコピーしてもよいし、Ctrl+Y で直前の操作を繰り返して必要な行数分、行を作成してもよい。とにかく、行を増やして、そこに1行目のマークを貼り付けて行く。罫線は消えたら消えたで最後にまとめて設定すればよい。

もし、行数が足りない場合は・・・

「ノ」が欲しい とか「ハ行」も欲しい場合がある


Ctrl+A でオブジェクトを全て選択して、選択範囲内で右クリックし、下の図の赤い枠で囲んだ部分のチェックをすべて外して OK をクリックすると、行の高さが小さくなる(はず)。

赤枠内のチェックを全て外す。


次に表のみ、上から下までドラッグ等して選択し、選択範囲内で右クリックして表のプロパティを表示して、「行」タブをクリック。高さを「固定値」として、最適な数値を入力してOKをクリックして行の高さを修正する。

【注意】

理由は定かでないが、この方法で行の高さを「修正できる」場合と、「出来ない」場合があった。


他にも、表のみ全選択するところは同じだが、「テーブルレイアウト」タブの「セルのサイズ」リボンの「高さ」でも同じことができる(こともある?)。


【注意】

理由は定かでないが、やはり、この方法で行の高さを「修正できる」場合と、「出来ない」場合があった。出来ない場合は、Ctrl+Z(元に戻す)で、修正できる場合の直後のところまで戻して実行すると変更が適用された。原因は私にはわからない。

最終的に、1設問あたりの選択肢数は 16 個、1ブロック 30 行、全3ブロックの B5 横置きのマークシートが完成。

このブログ用に作成した参考作品
(実用化するには ■■■ の位置調整が必要)


上の図は、「レイアウト」タブをクリックして、「ページ設定」リボンの「段組み」をクリックして表示されるサブメニューから「段組みの詳細設定」をクリックしてダイアログを表示し、「境界線を引く」のチェックを OFF にした状態の印刷プレビュー。

冷静になって考えると、ヒトはわずかながらでも、進歩し続ける生き物らしい。
以前、出来なかったことが、今は、できるようになった。

きっと、「イチから出直します」トラックの運転手さんのお陰です。

ほんとに、こころから、ありがとう!!

ここには掲載できないけれど、あの日撮った、爆走トラックの写真。

生涯、宝物にします!

4.まとめ

(1)表計算ソフトでは、10 以上の数値を表示するマークの制作は(私には)難しい。
(2)文書作成ソフトなら、比較的簡単に10 以上の数値を表示するマークが(私にも)作成可能。
(3)文書作成ソフトの行の高さの修正は、出来る場合と出来ない場合があった。理由は不明。
(4)イチから出直すことも、より良い人生を歩むためには必要になることがあるカモです☆
(5)大型トラックの看板からは深い学びを得ることがあります。

5.お願いとお断り

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

ファイル名が連番であることを確認したい!

自作のマークシートリーダーでは、Windows 用の OpenCV に加え、Python 用の OpenCV も利用して、マークの読み取りを高速化している。

この Python 用の OpenCV を動かすには Python4Delphi(P4D) が必要だ。P4D 使用時はプログラムの仕様として、読み取り対象のマークシート画像ファイル名の末尾は「数値化したら連番として読み取れる半角3桁の数字」でなければならない(例:X_001.jpgなど、MS_Reader.exe Version 1.1.5 から)。

そのことを、つい忘れて実行すると・・・

【コンパイル済みの exe を実行した場合】

最初に表示されるエラーメッセージ


さらに、

2つめのエラーメッセージ


OKをクリックすると、もう一度、

3つめのエラーメッセージ


んで・・・

4つめのエラーメッセージ


泣きたい気持ち T_T で OK をクリックすると・・・

メモリーリークまで発生・・・

うわーん T_T

【実行(F9)では?】

エラーメッセージの形式こそ、違え・・・

泣きたい気持ちは、同じではありませんか。みなさん・・・


ファイル名が「プログラムの仕様と異なっている」ために起きるエラーであるという、言わば「確実に発生を予見できるエラー」なのに、

どうして今まで、
何とかしようと思わなかったのか?

以前から、なんとなく、気づいてはいたけれど・・・

オレはもしかして、
自分で思ってる以上に
バカ
なんじゃないか?

あらためて、そう思ったのであります。みなさん・・・

そこで、この 犯罪に近い プログラムの挙動をなんとかするべく、ようやくと言いますか、今更ではありますが立ち上がり・・・ 悪戦苦闘すること幾年月(実際、半日くらいです)。なので、今回は、このふと思い立ったちいさな夢を実現するまでの お読みいただく価値などまったくない 苦闘の成果の記録です。

【もくじ】

1.そして、悲劇は繰り返される
2.連鎖の終止符は?
3.まとめ
4.お願いとお断り

1.そして、悲劇は繰り返される

人間は、いろいろなことを忘れる生き物です。

むかーし、サーフィンに夢中だった頃、台風の海で大波と一緒に落ちてきたサーフボードが脳天を直撃。溺れて、死ななかったのはよかったけれど、とにかく砂浜までなんとか生還後、確かに見覚えのある風景を感じはするし、自分の名前も、家の住所も思い出せるのに、「僕のおうちまでの帰り道がどうしても思い出せません!」みたいな・・・。うぎゃー

( この道、見覚えだけはあるんだけどなー。はたして、おうちは右だっけ? 左だっけ? )

( 家の玄関の風景も覚えてるんだけどなー。そこへの行き方がまったくわかりましぇん T_T )

あの時はやばかった・・・ まぁ、あの時ほど、困るわけではないが、それでも半年に2回くらい、My マークシートリーダーを使っていて、ファイル名の命名規則をド忘れし、今回、冒頭で紹介したエラーメッセージをくり返し登場させてしまう・・・。

その都度、あわてふためき、もう二度とするまいと固く心に誓い、反省し、失敗の原因の記録まで書き、クラウドにはそのバックアップまでとり、それでも、七転び八起きではなく、七転八倒を身上とするかのごとき私は、果てしない後悔の輪廻、そう苦しみと迷いの連鎖の中で、なお、その悲劇を執拗なまでに繰り返してきたのであった。

そもそも、X_01A.jpg、X_01B.jpg みたいな、連番と紛らわしいファイル名を付けるプログラムを作ったのも、 なので、やはり、この負の連鎖は、自分自身に問題の深すぎる根っこが・・・

ぞーぉさん
ぞーぉさん
おーなかがデカいのね・・・

なんかちがう、みたいな・・・

ファイル名が連番でなければ読めないマークシートリーダーであるとわかっているのに、しかも、作ったのが他ならぬ自分自身であるにも関わらず、なぜか、「 X-01A.jpg, X-01B.jpg, x-02A.jpg, X-02B.jpg ・・・」のような、準連番的な?名前の付いたファイルだと、つい安心して、P4D モードで(しつこいようですが、作者である私自身が) マークの読み取りを実行してしまう・・・ T_T

その場合、プログラムの仕様だから当然のごとく、読み取りエラーが発生し・・・

このエラー、なに?

・・・みたいな・・・、決まって毎回、「驚きと焦り」の方が先走って脳内を占拠、「エラーの真の原因=ファイル名が連番でないこと」に、作者である自分自身がなかなか気づかない・・・

だから、バカだと、さっき

さすがに最近はそんなことはないが、以前はコレでさんざん悩んだこともあったのです・・・みなさん。

その My マークシートリーダーで、数学の解答用紙を読み取り、別プログラムで処理(受験者に返却する答案や資料を作成)する方向で、現在、既存のプログラムを改良しているのですが・・・

とある休日の朝、シャワーを浴びながら、なぜか、ふと

(そうだ。この際、アレも何とかしておこう)

と、ようやく思い立ったのです。みなさん。

アレとは、もちろん、P4D 使用時に「ファイル名が連番でないとエラーになること」であります。みなさん。

エラーになって(なぜか?毎回のようにその真の原因を忘れ)あわてふためく前に、予め、読み取り指定フォルダ内の拡張子を小文字に変換すると「jpg」or 「jpeg」になるファイルだけ抽出して、そのファイル名の末尾3桁の半角数字が完全に連番であるか・どうかを調べ、もし、問題がある場合はユーザーに通知して、エラーを未然に防止する、そんなプログラムは・・・ ぎゃはは、Delphi さえあれば、わーらっちゃうくらいカンタンに・・・

すぐ出来る・・・ )

そう軽く考えて、朝から始めた「ファイル名が完全に連番であることを確認する関数」作りに、なんと半日以上、費やしてしまったのであります。みなさん。

たぁーくさんサンプルがあると思ってあちこち調べてみたが(私が調べた範囲では)、Web上にその方法を解説している資料も、サンプル・プログラムも、ついに見つけることができなかったのであります。みなさん。

( もしかして・・・ そんな関数作りは「カンタンすぎる」から、サンプルがないのかなー? )

・・・などと思いつつ、でも、実際にそれを書くとなると、誰も話題にしてないって・・・ なんで? いや、それにしちゃ、なんだかんだ、結構・・・ それなりに難しいぞ、と半日ほど、あーでもない・こーでもないをくり返して・・・ なんとか、自分の環境では、期待通りに動作するものが書けたので、もしかしたら、将来、同じことを実現したくて悩んでおられる方の参考になるかも?しれないと思い、ここに書いておくことにしたわけであります。みなさん。

まず、どなたの役にも立たないカモ・・・ですが。とりあえず、核心部分は、次の通り。

implementation

uses
  //  (略)
  System.RegularExpressions,
  Generics.Collections;

  //System.RegularExpressionsはP4D使用時にファイル名が連番であるかどうかを確認するために追加
  //Generics.Collectionsは上と同じ目的でTListを使うために追加

上記ライブラリを2つ、uses しておいて、プログラム全体で使いまわすわけではないので、Formのメンバーにせず、マークシート画像ファイルを読みだす手続き内から呼び出して使う形で次の関数を記述。

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 の2種類の拡張子が混在しています。'+#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;

なんで、こんなイイことに今まで気づかなかったのか???

だから、バカだと、さっき

*(^_^)*♪

2.連鎖の終止符は?

任意のフォルダに連番でないファイル名を付けたマークシート画像を入れてテスト。

五十音的には「連番」と言えるのだろうか?


MS_Reader.exe を起動して、プログラムが期待通りに動作するか、確認。

読み込む画像が入ったフォルダとして、上の「連番じゃない画像フォルダ」を指定し、画像ファイルを読み込もうとすると・・・

やった! やった!!


MS_Reader.exe が、この世に誕生して5年(くらいかな?)。
ようやく、悲しみの連鎖に終止符が打たれたのであります。みなさん。

あとは、正真正銘のエラーが発生しないことを祈るのみであります。みなさん。

こっちのエラーは、マジでやばい >_<

これだけは見たくないのであります。
みなさん。

でも、よく考えたら(考えなくても)
エラーの連鎖を断ち切るためのメッセージが、

エラーメッセージだった

・・・ということは、

連鎖が断ち切れてるどころか、
これは、むしろ、立派な連鎖ではないでしょうか。みなさん。

私は、
ここに、運命を感じたのであります。
みなさん。

僕のじんせいはー *(^_^)*♪

3.まとめ

一部、変数の宣言が足りないカモですが、フォルダを開く処理まで入れた一連のプログラムコードは、次の通りです。

procedure TFormMSReader.ProcDataRead(Sender: TObject);
const
  //ディレクトリ(フォルダ)の存在を確認 -> なければ作成する
  DataPath='ProcData';
var
  iStartFolder: string;
  iDirectories: TArray<string>;
  Path: string;
  SearchPattern: string;
  Option: TSearchOption;
  FileNames:TStringDynArray;
  FileName:string;
  strFN, strCheckFolder:string;
  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

  try

    //読み込むファイルの存在するフォルダを選択

    //Win10のフォルダ選択Dialogを使用する
    iStartFolder := ExpandFileName('.\ProcData');
    if SelectDirectory(iStartFolder, iDirectories,
      [sdHidePinnedPlaces, sdNoDereferenceLinks, sdForceShowHidden,
      sdAllowMultiselect], 'フォルダを選択してください', 'Folder', 'Ok') then
    begin

      //カーソルを待機状態に設定
      Screen.Cursor := crHourGlass;

      //読み込むデータのあるフォルダへのPathを取得
      Path:=iDirectories[0];

      //jpg とjpeg が同一フォルダ内に混在していないことを確認する_20250302追加
      if HasMixedExtensions(Path) then
      begin
        strMsg:='jpg とjpeg の2種類の拡張子が混在しています。'+#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;
  finally
    Screen.Cursor := crDefault;
  end;

end;

4.お願いとお断り

今回掲載したプログラムは、拡張子が jpg と jpeg の画像が同一フォルダ内に混在していないことを正常動作の前提にしています。この点には十分、ご注意・ご留意いただけますよう、お願い申し上げます。

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

Python4Delphiが突然、実行できなくなった!

これまで自作のデジタル採点プログラムを使った数学のテストの採点処理は、マークシートの読み取り結果を、表計算ソフトのワークシートに出力する方法で、その最終的な処理を行ってきた。

2024年の年末から、2025年の年始にかけての休暇を利用し、これまで書いてきたデジタル採点プログラムの機能を拡張して、表計算ソフトを使わなくても大問6個までの数学のテストであれば、観点別評価にも対応した合計点の計算や、返却用答案の印刷、得点の平均点・最高点・最低点などの情報を含んだ成績一覧表の自動作成と印刷がひとつのプログラムから実行できるように改良。休暇中にある程度のところまで完成させることができた。

だが、休暇が終わると様々な仕事が次から次に舞い込んで、「あともう少しで完成」・・・というところで作業は完全にストップ。そのまま、ほぼ一月半、デジタル採点関連のプログラム作りは休止状態に。

途中、もちろん休日は何日もあったが、スキーに行ったり、徒歩で神社仏閣を巡る旅(行程24km)に参加したり、冬の山に登ったり、いろいろ楽しく遊んでしまって。

2025年2月22日(土)からの3連休で残りの作業を行って、ずっと気になっていたプログラムの改良を完成させるべく、21日(金)の朝、一月半ぶりにデジタル採点のプロジェクトに触ってみたら、あろうことか、実行(F9)すると「 Python4Delphi 関連のファイルが見つからない」エラーが発生。

これまで、思い出せないくらい何度も繰り返してきた、まったく思いもしなかったところでいきなり転ぶ「いつものパターン」に・・・またハマってしまった・・・内心、そんな気がしてならなかったが、今回も何とか自力で解決。もしかしたら、この記事が同じ悲劇に見舞われた方の目にとまることがあるかもしれないと思い、万一にでもお力添えできれば・・・と。これは、そのトラブルの解決方法のメモです。

【もくじ】

1.プロジェクトが実行(F9)できなくなった!
2.Definition.Inc ファイルも見つからない!
3.GetItパッケージマネージャの内容がヘン!
4.まとめ
5.お願いとお断り

1.プロジェクトが実行(F9)できなくなった!

テストの受験者に採点結果を通知する個票を作成するプログラムのプロジェクトファイルを開き、実行(F9)すると、「 Python4Delphi 関連の非ビジュアルコンポーネントが見つからない」エラーが発生。

(1ヶ月前までは普通に動いていたのに・・・。なんで?)

明日からの3連休で、このプログラムを完成させようと思って作業の準備を始めた矢先、まったく予期しないエラーの発生に、ほんとに心が折れそうになる・・・。

試しにマークシートリーダーや手書き答案の採点プログラムの方も確認してみると、実行(F9)できない状況はほぼ同じ。たとえば、マークシートリーダーのプログラムだとコードの先頭でエラーになり、具体的には・・・

unit UnitXXX;

{$WARN UNIT_PLATFORM OFF}
{$WARN SYMBOL_PLATFORM OFF}
{$WARN SYMBOL_DEPRECATED OFF}

{$I Definition.Inc}  // <- ここでエラーになる。

interface

「[dcc32 致命的エラー] UnitXXX.pas(7): F1026 ファイル ‘Definition.Inc’ が見つかりません。」という、今までさんざん実行(F9)して来て、1回も見たことのないメッセージが表示される。

だいたい、この {$I Definition.Inc} の1行が「なぜ、ここにあるのか」すら、思い出せない。(コレ、いつ・なんのために、誰が書いた?)みたいな疑問が浮かび・・・。でも、自分以外の誰かがこれを書くことはあり得ないので、書いたのは間違いなく自分なのだが、いつ・なんのために、書いたのか、それがどうしても思い出せない。

こういう場合に備えて、当たり前のように思うことでも、なるべくコメントとしてソース内に残し、コードを読み直す必要が生じた時に、行っている処理の内容を確実に思い出せるようにプログラムを書いてきたつもりなのだが、頼りとするはずの・・・そのコメントが見当たらない。

( なんでスルーしちゃったのかなぁ )

仕方がないから、Definition.Inc ファイルを検索してみる。が、少なくともプロジェクトファイルを入れたフォルダ内にはない。バックアップの方も検索してみたが、やはりそちらにもない。しばし考えた後、もしかしたら、Delphiと僕のこれまでのすべてを記録してある Tips ファイルの中に Definition.Inc なる文字列があるかと思い、早速、検索してみると、Python4Delphi の library demodll 関連の資料の中にそれを発見。

(やっぱり Python4Delphi 関連のファイルだったんだ・・・)

つまり、今までは、どこかに「Definition.Inc ファイルがあった」から、このエラーは発生しなかった。でも、今は、どこにも「それがない」から(多分)このエラーは起きている。

(なぜ、無くなったんだ?)

とりあえず、Cドライブ全体をくまなく探してみることにした。

2.Definition.Inc ファイルも見つからない!

Windows キーを押しながら、R キーを押して「ファイル名を指定して実行」の入力画面を出し、そこに「cmd」と入力して Enter キーを押し下げ、コマンドプロンプトを表示。次のコマンドを入力する。

dir C:\ /s /b | findstr /i "Definition.Inc"

こうすると、エクスプローラーの検索よりも速く、正確に検索対象ファイルの有無を知ることができるらしい。

もっとも実行する前から結果はわかっていたが。

( やっぱり、ない! )

3.GetItパッケージマネージャの内容がヘン!

Python4Delphi の非ビジュアルコンポーネントは Form の上に見えているが、それらの実際の動作に必要な「ヘッダファイルやライブラリ関連の情報が失われた」ためにエラーが起きているのではないか・・・と。ようやくここで、朧気ながらエラーの原因らしきものが見えてきた。

試しに GetItパッケージマネージャを開いて Python4Delphi のインストール状況を確認してみる。すると、なんと Python4Delphi が「未インストール」状態になっていた!

実際の画面がこちら。

間違いなくインストールしてあったはずなのに・・・


ちなみにインストールされている状態であれば、このように表示される。

これが正しくインストールされた状態


ここまで来れば、出来のよろしくない僕の頭でも十分、状況が理解できた。2025年1月上旬までは、確かに、PCのどこかに存在していたはずの「Definition.Inc」が、いや、それだけでなく Python4Delphi 関連の設定情報のすべてが「ごっそり削除」されるような事件が「つい最近起きた」に違いないと・・・。

僕はすぐに思い出した。10日ほど前のことだったか・・・。確実にオフに設定しておいたはずの OneDrive のデスクトップとの同期がいつの間にか ON に変更されていることに気づき、同期の設定を手動で OFF にして、デスクトップの表示をローカルPCのそれに修正した「あの時」事件は起きたに違いない。

いつ OneDrive のデスクトップとの同期が ON に変更されたのか、それはわからないが、例えば 24H2 へのアップデート時等にそのような形への設定変更が自動的に(と言うか、勝手に)行われ、連動してPython4Delphi 関連の PATH 等の設定情報も OneDrive 側に自動的に修正された(?)

そのことに気づかないまま、僕は PC を使い続け、同期が ON になっていることに気づいた時点で、同期の設定を手動で OFF にした。そこから見えてくることは(これはあくまでも推測だけど)・・・

・24H2 へのアップデート時に、Python4Delphi の一部の設定ファイルやライブラリが OneDrive フォルダ側に移動した?

・Delphi の GetIt パッケージマネージャに記録されている、インストール済みのパッケージのパス情報もOneDrive 側を参照するように自動的に調整された?( or 最初から OneDrive 側だった?)

・OneDrive との同期を手動で OFF に変更したため、Python4Delphi のファイルが移動・消失したのと同じ状態になり、これを Delphi の GetIt パッケージマネージャは「未インストール」と判断した?

とにかく、Python4Delphi が「未インストール」状態になっているのは事実。ならば、再インストールするしかない!

もう迷うことはない。(これで直る)その確信を持ってインストールボタンをクリックする。もちろん、インストールは何の問題もなく順調に終了。

先ほどと同様にコマンドプロンプトを表示し、「Definition.Inc」を検索すると・・・

( あった!)

Definition.Inc をちゃんとCドライブ内に発見!


ローカルの Documents フォルダの中に、今、それがあるということは・・・。

( そうか! いつの間にか OneDrive の Documents を参照する設定になっていたんだ。)

( だから同期を OFF にして、Documents フォルダの内容を削除した際に・・・ PATH も消え・・・ )

エラーの真の原因を理解☆


何でこんなことになったのか? 自問自答して得た結論は・・・

それが、もしかして Windows11 の仕様???

24H2 にアップデートした際に、Documents フォルダやデスクトップへの PATH を確認すべきだった。

いや、後悔しても始まらない。
ここは前向きに、「今後、OS をアップデートした際は、PATH の設定を必ず確認する」ことにしよう!

新しい自分との約束が出来た☆


で、最終確認。

実行(F9)するとエラーが発生したプロジェクトファイルを次から次へ開き、今度は問題なく実行(F9)出来ることを確かめる。

すべて何事もなかったかのように実行(F9)できた!!

なおったー☆

4.まとめ

・OS をアップデートしたら Documents フォルダやデスクトップへの PATH を必ず確認する。

5.お願いとお断り

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

PDFファイルから任意のページを抽出してマージする

ある朝、職場の同僚から「様式(ページ構成)が同じPDFファイルが大量にあるんだが、2ページ目以降は不要なので、1ページ目だけを抽出して、1つのPDFファイルに結合・印刷できるようにしてもらえないか?」との依頼を受けた。

急な依頼だったので、とりあえず任意のフォルダに保存されているPDFファイルの1ページ目だけを抽出するバッチファイルを作って依頼者に渡し、なんとかその場を凌いだが・・・。

以前から Delphi でPDFファイルを操作する方法に関心があり、PDFを画像化するプログラムなどを書いてみたことがあったが、指定ページを抽出する方法や複数のPDFファイルを結合して1つにまとめる方法はわからないままだった。いい機会なのでちゃんと勉強してみることにした。これはその備忘録。

【もくじ】

1.使用するツール
2.指定ページを抽出
3.PDFファイルを結合
4.進捗状況も表示
5.まとめ
  エラー対策1・2を追記(20250211)
  プログラムコード
  PDFtkのインストールの有無を確認する方法を追記(20250218)
6.お願いとお断り

1.使用するツール

PDFファイルの抽出や結合を実行するために使用したのは「PDFtk Server」というコマンドラインから実行するツール。

PDF Labs
https://www.pdflabs.com/tools/pdftk-server/?form=MG0AV3

リンク先ページの中ほどに「Microsoft Windows」というタイトルがあり、「Click to download the PDFtk Server installer for Windows 10 and 11:」という説明の下に「Windows Download」があるので、これをクリックして「pdftk_server-2.02-win-setup.exe」(2025年2月9日現在)をダウンロードしてインストールしておく。

【インストール後、PATHの登録を必ず確認してください】

インストールしたら、システム環境変数のPATHに「pdftk.exe」までのパスが正しく登録されていることを必ず確認する。

「pdftk.exe」までのパスが正しく登録されていることを必ず確認してください。
(図は PDFtk の設定を変更せずにインストールした場合の設定です)


【重要な注意】

インストールした「pdftk.exe」までの PATH をシステム環境変数の PATH に登録せず、「プログラム内で文字列として指定」した場合、ここで紹介するプログラムコードは 動作しません!

2.指定ページを抽出

まず、GUIを作成。


exe のあるフォルダ内に src と dst という名称のフォルダも用意する。


指定ページを抽出する方法は、次の通り。

  private
    procedure ExtractPDFs(const InputDir, OutputDir: string; PageNum: Integer);

implementation

uses
  Winapi.ShellAPI, System.IOUtils;

{$R *.dfm}

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
var
  InputDir, OutputDir: string;
  strMsg: string;
begin
  if ComboBox1.Text = '' then
  begin
    strMsg := '抽出するページを指定してください';
    Application.MessageBox(PChar(strMsg), PChar('エラー'), MB_ICONSTOP);
    ComboBox1.SetFocus;
    Exit;
  end;

  InputDir := ExtractFilePath(Application.ExeName) + 'src\';
  OutputDir := ExtractFilePath(Application.ExeName) + 'dst\';

  //出力フォルダが存在しない場合は作成
  if not DirectoryExists(OutputDir) then
  begin
    ForceDirectories(OutputDir);
  end;

  ExtractPDFs(InputDir, OutputDir, StrToInt(ComboBox1.Text));
end;

procedure TForm1.ExtractPDFs(const InputDir, OutputDir: string;
  PageNum: Integer);
var
  SearchRec: TSearchRec;
  TempPDFs: TStringList;
  Command, TempPDF, ExtractedPDF, LogFile: string;
  strMsg: string;
  PDFtkPath: string;

  //コマンド実行関数(プロセス完了待ち)
  function ExecuteCommand(const Command: string): Boolean;
  var
    StartupInfo: TStartupInfo;
    ProcessInfo: TProcessInformation;
    //PDFtkのPATHはシステム環境変数に設定する(文字列で指定しないこと)
    CmdLine: array[0..MAX_PATH] of Char;
  begin
    FillChar(StartupInfo, SizeOf(TStartupInfo), 0);
    StartupInfo.cb := SizeOf(TStartupInfo);
    StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
    StartupInfo.wShowWindow := SW_HIDE;

    //PDFtkのPATHはシステム環境変数に設定する(文字列で指定しないこと)
    StrPCopy(CmdLine, Command);
    Result := CreateProcess(nil, CmdLine, nil, nil, False, CREATE_NO_WINDOW, nil, nil, StartupInfo, ProcessInfo);
    if Result then
    begin
      WaitForSingleObject(ProcessInfo.hProcess, INFINITE);
      CloseHandle(ProcessInfo.hProcess);
      CloseHandle(ProcessInfo.hThread);
    end;
  end;

begin

  //PDFtkのPATHはシステム環境変数に設定する(文字列で指定しないこと)
  //PDFtkPath := '"C:\Program Files (x86)\PDFtk Server\bin\pdftk.exe"';

  //pdftk.exe の PATH は、システム環境変数の PATH で設定する
  PDFtkPath := 'pdftk';

  //エラーがあった場合はLogファイルにエラー内容を出力する
  LogFile := IncludeTrailingPathDelimiter(OutputDir) + 'log.txt';

  TempPDFs := TStringList.Create;
  try
    //指定フォルダ内のすべての PDF を検索
    if FindFirst(IncludeTrailingPathDelimiter(InputDir) + '*.pdf', faAnyFile, SearchRec) = 0 then
    begin
      try
        repeat
          TempPDF := IncludeTrailingPathDelimiter(OutputDir) + 'temp_' +
            IntToStr(TempPDFs.Count) + '.pdf';

          //PDFtkをシステム環境変数のPathに正しく指定してある場合
          Command := Format('cmd.exe /c %s "%s" cat %d output "%s" 2>> "%s"',
            [PDFtkPath, IncludeTrailingPathDelimiter(InputDir) +
            SearchRec.Name, PageNum, TempPDF, LogFile]);

          //pdftk を実行して指定ページを抽出
          if ExecuteCommand(Command) then
          begin
            TempPDFs.Add(TempPDF);
          end;

        until FindNext(SearchRec) <> 0;
      finally
        FindClose(SearchRec);
      end;
    end;

    if TempPDFs.Count > 0 then
    begin
      ExtractedPDF := IncludeTrailingPathDelimiter(OutputDir) + 'filelist.txt';
      TempPDFs.SaveToFile(ExtractedPDF); // ファイルリストを保存
    end;

    //Information
    strMsg := '続けて結合も実行しますか?';
    if Application.MessageBox(PChar(strMsg), PChar('情報'), MB_YESNO or MB_ICONINFORMATION) = mrYes then
    begin
      //[はい]が選ばれた時
      Button2Click(Button1);
    end else begin
      //[いいえ]が選ばれた時
      strMsg:='抽出ページをマージする場合は結合ボタンをクリックしてください';
      Application.MessageBox(PChar(strMsg), PChar('情報'), MB_ICONINFORMATION);
    end;

  finally
    TempPDFs.Free;
  end;
end;

3.PDFファイルを結合

ページを抽出後、そのまま結合させることも当然考えたが、処理の確実性を最優先して、別々の手続きに分けて記述することにした。コードは次の通り。

  private
    procedure ExtractPDFs(const InputDir, OutputDir: string; PageNum: Integer);
    procedure MergePDFs;

implementation

uses
  Winapi.ShellAPI,
  System.IOUtils;

procedure TForm1.Button2Click(Sender: TObject);
var
  strMsg: string;
begin
  try
    MergePDFs;
    strMsg:='PDFの結合が完了しました!';
    Application.MessageBox(PChar(strMsg), PChar('情報'), MB_ICONINFORMATION);
  except
    on E: Exception do
    begin
      strMsg:='エラー: ' + E.Message;
      Application.MessageBox(PChar(strMsg), PChar('エラー'), MB_ICONERROR);
    end;
  end;
end;

procedure TForm1.MergePDFs;
var
  //ShellExecuteを使用
  //InputDir, OutputFile, Command: string;

  //CreateProcessを使用
  InputDir, OutputFile, Command, CmdLine: string;
  StartupInfo: TStartupInfo;
  ProcessInfo: TProcessInformation;
  strMsg: string;
begin

  //ShellExecuteを使用
  {
  InputDir := ExtractFilePath(Application.ExeName)+'dst\';
  OutputFile := InputDir + 'MergedOutput.pdf';
  //既存のファイルがあれば削除する
  if FileExists(OutputFile) then
  begin
    //削除
    DeleteFile(OutputFile);
  end;
  //pdftkコマンドの構築(すべてのPDFを結合)
  Command := Format('cmd /c pdftk "%s*.pdf" cat output "%s"', [InputDir, OutputFile]);
  //ShellExecuteでpdftkを実行
  ShellExecute(0, 'open', 'cmd.exe', PChar(Command), nil, SW_HIDE);
  }

  //CreateProcessを使用
  InputDir := IncludeTrailingPathDelimiter(ExtractFilePath(Application.ExeName)) + 'dst\';
  OutputFile := InputDir + 'MergedOutput.pdf';

  //既存のファイルがあれば削除する
  if FileExists(OutputFile) then
  begin
    //削除
    DeleteFile(OutputFile);
  end;

  //pdftkコマンドの構築(すべてのPDFを結合)
  Command := Format('pdftk "%s" cat output "%s"', [InputDir + '*.pdf', OutputFile]);

  //コマンドラインを `cmd.exe /c` でラップ
  CmdLine := Format('cmd.exe /c %s', [Command]);

  // `CreateProcess` の設定
  FillChar(StartupInfo, SizeOf(TStartupInfo), 0);
  StartupInfo.cb := SizeOf(TStartupInfo);
  StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
  StartupInfo.wShowWindow := SW_HIDE;

  if CreateProcess(nil, PChar(CmdLine), nil, nil, False, CREATE_NO_WINDOW, nil, nil, StartupInfo, ProcessInfo) then
  begin
    //プロセスが完了するのを待つ
    WaitForSingleObject(ProcessInfo.hProcess, INFINITE);
    //ハンドルを閉じる
    CloseHandle(ProcessInfo.hProcess);
    CloseHandle(ProcessInfo.hThread);
  end else begin
    strMsg:='PDFの結合に失敗しました。pdftkが正しくインストールされているか確認してください。';
    Application.MessageBox(PChar(strMsg), PChar('エラー'), MB_ICONERROR);
  end;

end;

4.進捗状況も表示

進捗状況も表示できるようにした。プログラムコードは「5.まとめ」の最後に掲載。
(Formに StatusBar と ProgressBar を1つずつ追加)

【実行時の画面】

ProgressBar は、StatusBar に埋め込んで表示する。

5.まとめ

テスト用にファイル名が半角数字「001~100」の100個のPDFファイルを作成して実行。半角数字のファイル名であれば、エラーなく実行できることを確認。
ただし、My環境では、ファイル名に「全角・半角・英数字・記号」が混在しているとエラーになりました。このエラーの発生原因の詳細が判明しましたら、後日追記します。

追記(20250211)

上記エラーの発生原因について調査した結果、PDFtk に渡す PATH に「半角スペース」が混じっているとエラーが発生することが判明。そこで、エラーの発生を防止するため、次の対策1・2を行った。

【対策1】

PDFtk に渡す PATH の文字列をダブルクオートで囲んでから渡すように修正。

  TempPDFs := TStringList.Create;
  try
    //指定フォルダ内のすべての PDF を検索
    if FindFirst(IncludeTrailingPathDelimiter(InputDir) + '*.pdf', faAnyFile, SearchRec) = 0 then
    begin
      try
        repeat
          TempPDF := IncludeTrailingPathDelimiter(OutputDir) + 'temp_' +
            IntToStr(TempPDFs.Count) + '.pdf';

          //PDFtkをシステム環境変数のPathに正しく指定してある場合
          //PDFファイル名に半角スペースが含まれていると
          //多数のファイルを処理する場合、確実にエラーが発生する
          {
          Command := Format('cmd.exe /c %s "%s" cat %d output "%s" 2>> "%s"',
            [PDFtkPath, IncludeTrailingPathDelimiter(InputDir) + SearchRec.Name,
            PageNum, TempPDF, LogFile]);
          }

          //PDFtkに渡すPATHをダブルクオートで囲んで渡すように修正
          Command := Format('cmd.exe /c %s "%s" cat %d output "%s" 2>> "%s"',
          [PDFtkPath, '"'+IncludeTrailingPathDelimiter(InputDir)+SearchRec.Name+'"',
          PageNum, TempPDF, LogFile]);

          //pdftk を実行して指定ページを抽出
          if ExecuteCommand(Command) then
          begin
            TempPDFs.Add(TempPDF);
            //省略
          end;

【対策2】

対策1を行った後もエラーが発生。PDFtk に渡す PATH をダブルクオートで囲んでもエラーの発生を防止することはできないようだ。そこで、「長いファイルパスや特殊文字を含むパスを 短縮形式(8.3形式) に変換することで問題を回避できるのでは・・・?」と考え、PATH を短縮形式(8.3形式) に変換してから PDFtk に渡すように修正。

procedure TForm1.ExtractPDFs(const InputDir, OutputDir: string;
  PageNum: Integer);
var
  SearchRec: TSearchRec;
  //略

  //指定フォルダ内にあるPDFファイルの数を取得
  function GetPDFFileCount(const FolderPath: string): Integer;
  var
    Files: TArray<string>;
  begin
    //略
  end;

  function GetShortPath(const LongPath: string): string;
  var
    ShortPath: array[0..MAX_PATH] of Char;
  begin
    if GetShortPathNameW(PChar(LongPath), ShortPath, MAX_PATH) > 0 then
      Result := ShortPath
    else
      Result := LongPath; // 失敗時はそのまま
  end;

  //8.3 名(短縮名)が使えるかどうか確認(C:\Program Files でチェック)
  function Is8dot3NameAvailable(const Path: string): Boolean;
  var
    ShortPath: array[0..MAX_PATH] of Char;
  begin
    FillChar(ShortPath, SizeOf(ShortPath), 0);
    if GetShortPathNameW(PChar(Path), ShortPath, MAX_PATH) > 0 then
      Result := StrComp(ShortPath, PChar(Path)) <> 0  // 短縮名が取得できたか
    else
      Result := False;
  end;

  //Cドライブの 8.3 名を有効に設定
  procedure Enable8dot3Name(DriveLetter: Char);
  var
    Command: string;
  begin
    //fsutil コマンドで 8.3 名を有効化
    Command := Format('fsutil 8dot3name set %s: 0', [DriveLetter]);
    if ShellExecute(0, 'runas', 'cmd.exe', PChar('/c ' + Command), nil, SW_HIDE) <= 32 then
    begin
      strMsg:='8.3 名の有効化に失敗しました。管理者権限で実行してください。';
      Application.MessageBox(PChar(strMsg), PChar('情報'), MB_ICONINFORMATION);
    end else begin
      strMsg:=Format('%s: ドライブの 8.3 名を有効にしました。', [DriveLetter]);
      Application.MessageBox(PChar(strMsg), PChar('情報'), MB_ICONINFORMATION);
    end;
  end;

  //システム全体の 8.3 名を有効化
  procedure Enable8dot3NameForAllDrives;
  var
    Command: string;
  begin
    //fsutil コマンドでシステム全体の 8.3 名を有効化
    Command := 'fsutil behavior set disable8dot3 0';
    if ShellExecute(0, 'runas', 'cmd.exe', PChar('/c ' + Command), nil, SW_HIDE) <= 32 then
    begin
      strMsg:='8.3 名の有効化に失敗しました。管理者権限で実行してください。';
      Application.MessageBox(PChar(strMsg), PChar('情報'), MB_ICONINFORMATION);
    end else begin
      strMsg:='すべてのドライブで 8.3 名を有効にしました。';
      Application.MessageBox(PChar(strMsg), PChar('情報'), MB_ICONINFORMATION);
    end;
  end;

begin

  //8.3 名(短縮名)が使えるかどうか確認(C:\Program Files でチェック)
  if Is8dot3NameAvailable('C:\Program Files') then
  begin
    if CheckBox1.Checked then
    begin
      strMsg:='8.3 名は有効です';
      Application.MessageBox(PChar(strMsg), PChar('情報'), MB_ICONINFORMATION);
    end;
  end else begin
    strMsg:='Windowsでは、長いファイルパスや特殊文字を含むパスを 短縮形式(8.3形式) に変換することで問題を回避できます。'+
      '現在、8.3 名(短縮名)は無効です。有効化しますか?';
    if Application.MessageBox(PChar(strMsg), PChar('情報'), MB_YESNO or MB_ICONINFORMATION) = mrYes then
    begin
      //[はい]が選ばれた時
      strMsg:='システム全体で有効化しますか?'+#13#10+#13#10+
        '「いいえ」を選択した場合、Cドライブのみ有効化されます。';
      if Application.MessageBox(PChar(strMsg), PChar('情報'), MB_YESNO or MB_ICONINFORMATION) = mrYes then
      begin
        Enable8dot3NameForAllDrives;
        //[はい]が選ばれた時
        strMsg:='8.3 名(短縮名)をシステム全体で有効化しました!';
        Application.MessageBox(PChar(strMsg), PChar('情報'), MB_ICONINFORMATION);
      end else begin
        //[いいえ]が選ばれた時
        Enable8dot3Name('C');
        strMsg:='Cドライブで、8.3 名(短縮名)を有効化しました!';
        Application.MessageBox(PChar(strMsg), PChar('情報'), MB_ICONINFORMATION);
      end;
    end else begin
      //[いいえ]が選ばれた時
      strMsg:='長いファイルパスや特殊文字を含むパスは使用できません。'+
        '注意してください。';
      Application.MessageBox(PChar(strMsg), PChar('情報'), MB_ICONINFORMATION);
    end;
  end;

  //略

  TempPDFs := TStringList.Create;
  try
    //指定フォルダ内のすべての PDF を検索
    if FindFirst(IncludeTrailingPathDelimiter(InputDir) + '*.pdf', faAnyFile, SearchRec) = 0 then
    begin
      try
        repeat
          TempPDF := IncludeTrailingPathDelimiter(OutputDir) + 'temp_' +
            IntToStr(TempPDFs.Count) + '.pdf';

          //PDFtkをシステム環境変数のPathに正しく指定してある場合
          //PDFファイル名に半角スペースが含まれていると
          //多数のファイルを処理する場合、確実にエラーが発生する
          {
          Command := Format('cmd.exe /c %s "%s" cat %d output "%s" 2>> "%s"',
            [PDFtkPath, IncludeTrailingPathDelimiter(InputDir) + SearchRec.Name,
            PageNum, TempPDF, LogFile]);
          }

          //PDFtkに渡すPATHをダブルクオートで囲んで渡すように修正
          //さらに短縮形式(8.3形式) に変換して渡すように修正
          Command := Format('cmd.exe /c %s "%s" cat %d output "%s" 2>> "%s"',
          [PDFtkPath, '"'+GetShortPath(IncludeTrailingPathDelimiter(InputDir)+SearchRec.Name)+'"',
          PageNum, TempPDF, LogFile]);

          //pdftk を実行して指定ページを抽出
          if ExecuteCommand(Command) then
          begin
            TempPDFs.Add(TempPDF);
            //省略
          end;

ただし、GetShortPathNameW は、ローカルファイルシステムの NTFS/FAT32 に保存されているファイルの短縮名を取得する API であり、UNC パスのような ネットワーク共有上のファイルには対応していない。そこで exe がローカルな環境で実行されていない場合は、Form の表示終了時にユーザーに警告してプログラムを終了するように修正。

Winapi.Shlwapi を uses することで、他の手続きで使用していた StrToInt 関数でエラーが発生。こちらはSystem.SysUtils.StrToInt のように参照先を明示してエラーを回避。

  private
    //Formの表示終了イベントを取得
    procedure CMShowingChanged(var Msg:TMessage); message CM_SHOWINGCHANGED;

implementation

uses
  Winapi.ShellAPI,
  System.IOUtils,
  Winapi.Shlwapi;

  //Shlwapiはexeの起動PATHの確認に使用
  //ShlwapiにもStrToInt関数があるので StrToInt関数は
  //System.SysUtils.StrToInt のように明示的に使用する

procedure TForm1.CMShowingChanged(var Msg: TMessage);
var
  strMsg:string;

  function IsUNCPath(const Path: string): Boolean;
  begin
    Result := PathIsUNC(PChar(Path));
  end;

  procedure CheckExePath;
  var
    ExePath: string;
  begin
    ExePath := ExtractFilePath(Application.ExeName);
    if IsUNCPath(ExePath) then
    begin
      strMsg:='EXE はネットワーク上の UNC パスで実行されています!'+#13#10+
        'プログラムが安定動作しない可能性があります。'+#13#10+
        'ローカル環境で実行してください。'+#13#10+
        '安全のため、プログラムを終了します。';
      Application.MessageBox(PChar(strMsg), PChar('情報'), MB_ICONINFORMATION);
      Close;
    end;
  end;
begin
  inherited;
  if Visible then
  begin
    Update;
    //実行PATHをチェック
    CheckExePath;
  end;
end;


GUI も修正。


上記対策を行った結果、(My環境では)半角スペースを含む PATH を PDFtk に渡してもエラーが発生することなく、すべてのファイルから指定ページを抽出・結合することができることを確認。

【プログラムコード】

作成の経過が後から見てわかるよう、古いコードをコメント化して残してあるなど、あちこちに冗長な部分があります。あくまでも参考まで。

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    GroupBox1: TGroupBox;
    Label_01: TLabel;
    Label_02: TLabel;
    Label_04: TLabel;
    ComboBox1: TComboBox;
    Label_03: TLabel;
    Button3: TButton;
    StatusBar1: TStatusBar;
    ProgressBar1: TProgressBar;
    CheckBox1: TCheckBox;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    procedure ExtractPDFs(const InputDir, OutputDir: string; PageNum: Integer);
    procedure MergePDFs;
    //Formの表示終了イベントを取得
    procedure CMShowingChanged(var Msg:TMessage); message CM_SHOWINGCHANGED;
  public
  end;

var
  Form1: TForm1;

implementation

uses
  Winapi.ShellAPI,
  System.IOUtils,
  Winapi.Shlwapi;

  //Shlwapiはexeの起動PATHの確認に使用
  //ShlwapiにもStrToInt関数があるので StrToInt関数は
  //System.SysUtils.StrToInt のように明示的に使用する

{$R *.dfm}

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
var
  InputDir, OutputDir: string;
  strMsg: string;
begin
  if ComboBox1.Text = '' then
  begin
    strMsg := '抽出するページを指定してください';
    Application.MessageBox(PChar(strMsg), PChar('エラー'), MB_ICONSTOP);
    ComboBox1.SetFocus;
    Exit;
  end;

  InputDir := ExtractFilePath(Application.ExeName) + 'src\';
  OutputDir := ExtractFilePath(Application.ExeName) + 'dst\';

  //出力フォルダが存在しない場合は作成
  if not DirectoryExists(OutputDir) then
  begin
    ForceDirectories(OutputDir);
  end;

  ExtractPDFs(InputDir, OutputDir, System.SysUtils.StrToInt(ComboBox1.Text));

end;

procedure TForm1.Button2Click(Sender: TObject);
var
  strMsg: string;
begin
  try
    MergePDFs;
    strMsg:='PDFの結合が完了しました!';
    Application.MessageBox(PChar(strMsg), PChar('情報'), MB_ICONINFORMATION);
  except
    on E: Exception do
    begin
      strMsg:='エラー: ' + E.Message;
      Application.MessageBox(PChar(strMsg), PChar('エラー'), MB_ICONERROR);
    end;
  end;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  Close;
end;

procedure TForm1.CMShowingChanged(var Msg: TMessage);
var
  strMsg:string;

  function IsUNCPath(const Path: string): Boolean;
  begin
    Result := PathIsUNC(PChar(Path));
  end;

  procedure CheckExePath;
  var
    ExePath: string;
  begin
    ExePath := ExtractFilePath(Application.ExeName);
    if IsUNCPath(ExePath) then
    begin
      strMsg:='EXE はネットワーク上の UNC パスで実行されています!'+#13#10+
        'プログラムが安定動作しない可能性があります。'+#13#10+
        'ローカル環境で実行してください。'+#13#10+
        '安全のため、プログラムを終了します。';
      Application.MessageBox(PChar(strMsg), PChar('情報'), MB_ICONINFORMATION);
      Close;
    end else begin
      //何もしない
      //strMsg:='EXE はローカルディスク上で実行されています。';
      //Application.MessageBox(PChar(strMsg), PChar('情報'), MB_ICONINFORMATION);
    end;
  end;
begin
  inherited; {通常の CMShowingChagenedをまず実行}
  if Visible then
  begin
    Update; {完全に描画}
    //ここにやりたいことを書いていく
    //実行PATHをチェック
    CheckExePath;
  end;
end;

procedure TForm1.ExtractPDFs(const InputDir, OutputDir: string;
  PageNum: Integer);
var
  SearchRec: TSearchRec;
  TempPDFs: TStringList;
  Command, TempPDF, ExtractedPDF, LogFile: string;
  strMsg: string;
  PDFtkPath: string;
  intNum, PDFCount: Integer;

  //指定フォルダ内にあるPDFファイルの数を取得
  function GetPDFFileCount(const FolderPath: string): Integer;
  var
    Files: TArray<string>;
  begin
    //Result := 0;
    if not DirectoryExists(FolderPath) then
      raise Exception.CreateFmt('Directory %s does not exist.', [FolderPath]);

    Files := TDirectory.GetFiles(FolderPath, '*.pdf', TSearchOption.soTopDirectoryOnly);
    Result := Length(Files);
  end;

  // コマンド実行関数(プロセス完了待ち)
  function ExecuteCommand(const Command: string): Boolean;
  var
    StartupInfo: TStartupInfo;
    ProcessInfo: TProcessInformation;
    //PDFtkのPATHはシステム環境変数に設定する(文字列で指定しないこと)
    CmdLine: array[0..MAX_PATH] of Char;
  begin
    FillChar(StartupInfo, SizeOf(TStartupInfo), 0);
    StartupInfo.cb := SizeOf(TStartupInfo);
    StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
    StartupInfo.wShowWindow := SW_HIDE;

    //PDFtkのPATHはシステム環境変数に設定する(文字列で指定しないこと)
    StrPCopy(CmdLine, Command);
    Result := CreateProcess(nil, CmdLine, nil, nil, False, CREATE_NO_WINDOW, nil, nil, StartupInfo, ProcessInfo);
    if Result then
    begin
      WaitForSingleObject(ProcessInfo.hProcess, INFINITE);
      CloseHandle(ProcessInfo.hProcess);
      CloseHandle(ProcessInfo.hThread);
    end;
  end;

  function GetShortPath(const LongPath: string): string;
  var
    ShortPath: array[0..MAX_PATH] of Char;
  begin
    //if GetShortPathName(PChar(LongPath), ShortPath, MAX_PATH) > 0 then
    if GetShortPathNameW(PChar(LongPath), ShortPath, MAX_PATH) > 0 then
      Result := ShortPath
    else
      Result := LongPath; // 失敗時はそのまま
  end;

  //8.3 名(短縮名)が使えるかどうか確認(C:\Program Files でチェック)
  function Is8dot3NameAvailable(const Path: string): Boolean;
  var
    ShortPath: array[0..MAX_PATH] of Char;
  begin
    FillChar(ShortPath, SizeOf(ShortPath), 0);
    //if GetShortPathName(PChar(Path), ShortPath, MAX_PATH) > 0 then
    if GetShortPathNameW(PChar(Path), ShortPath, MAX_PATH) > 0 then
      Result := StrComp(ShortPath, PChar(Path)) <> 0  // 短縮名が取得できたか
    else
      Result := False;
  end;

  //Cドライブの 8.3 名を有効に設定
  procedure Enable8dot3Name(DriveLetter: Char);
  var
    Command: string;
  begin
    //fsutil コマンドで 8.3 名を有効化
    Command := Format('fsutil 8dot3name set %s: 0', [DriveLetter]);
    if ShellExecute(0, 'runas', 'cmd.exe', PChar('/c ' + Command), nil, SW_HIDE) <= 32 then
    begin
      strMsg:='8.3 名の有効化に失敗しました。管理者権限で実行してください。';
      Application.MessageBox(PChar(strMsg), PChar('情報'), MB_ICONINFORMATION);
    end else begin
      strMsg:=Format('%s: ドライブの 8.3 名を有効にしました。', [DriveLetter]);
      Application.MessageBox(PChar(strMsg), PChar('情報'), MB_ICONINFORMATION);
    end;
  end;

  //システム全体の 8.3 名を有効化
  procedure Enable8dot3NameForAllDrives;
  var
    Command: string;
  begin
    //fsutil コマンドでシステム全体の 8.3 名を有効化
    Command := 'fsutil behavior set disable8dot3 0';
    if ShellExecute(0, 'runas', 'cmd.exe', PChar('/c ' + Command), nil, SW_HIDE) <= 32 then
    begin
      strMsg:='8.3 名の有効化に失敗しました。管理者権限で実行してください。';
      Application.MessageBox(PChar(strMsg), PChar('情報'), MB_ICONINFORMATION);
    end else begin
      strMsg:='すべてのドライブで 8.3 名を有効にしました。';
      Application.MessageBox(PChar(strMsg), PChar('情報'), MB_ICONINFORMATION);
    end;
  end;

begin

  //8.3 名(短縮名)が使えるかどうか確認(C:\Program Files でチェック)
  if Is8dot3NameAvailable('C:\Program Files') then
  begin
    if CheckBox1.Checked then
    begin
      strMsg:='8.3 名は有効です';
      Application.MessageBox(PChar(strMsg), PChar('情報'), MB_ICONINFORMATION);
    end;
  end else begin
    strMsg:='Windowsでは、長いファイルパスや特殊文字を含むパスを 短縮形式(8.3形式) に変換することで問題を回避できます。'+
      '現在、8.3 名(短縮名)は無効です。有効化しますか?';
    if Application.MessageBox(PChar(strMsg), PChar('情報'), MB_YESNO or MB_ICONINFORMATION) = mrYes then
    begin
      //[はい]が選ばれた時
      strMsg:='システム全体で有効化しますか?'+#13#10+#13#10+
        '「いいえ」を選択した場合、Cドライブのみ有効化されます。';
      if Application.MessageBox(PChar(strMsg), PChar('情報'), MB_YESNO or MB_ICONINFORMATION) = mrYes then
      begin
        Enable8dot3NameForAllDrives;
        //[はい]が選ばれた時
        strMsg:='8.3 名(短縮名)をシステム全体で有効化しました!';
        Application.MessageBox(PChar(strMsg), PChar('情報'), MB_ICONINFORMATION);
      end else begin
        //[いいえ]が選ばれた時
        Enable8dot3Name('C');
        strMsg:='Cドライブで、8.3 名(短縮名)を有効化しました!';
        Application.MessageBox(PChar(strMsg), PChar('情報'), MB_ICONINFORMATION);
      end;
    end else begin
      //[いいえ]が選ばれた時
      strMsg:='長いファイルパスや特殊文字を含むパスは使用できません。'+
        '注意してください。';
      Application.MessageBox(PChar(strMsg), PChar('情報'), MB_ICONINFORMATION);
    end;
  end;

  //ProgressBar
  ProgressBar1.Visible:=True;
  ProgressBar1.Min:=0;                    //最小値
  ProgressBar1.Position:=0;               //現在の値
  ProgressBar1.Step:=1;                   //増分値

  //カウンタ変数の初期化
  intNum:=0;

  //PDFtkのPATHはシステム環境変数に設定する(文字列で指定しないこと)
  //PDFtkPath := '"C:\Program Files (x86)\PDFtk Server\bin\pdftk.exe"';

  //pdftk.exe の PATH は、システム環境変数の PATH で設定する
  PDFtkPath := 'pdftk';

  //エラーがあった場合はLogファイルにエラー内容を出力する
  LogFile := IncludeTrailingPathDelimiter(OutputDir) + 'log.txt';

  //指定フォルダ内にあるPDFファイルの数を取得
  PDFCount := GetPDFFileCount(InputDir);

  //進捗状況の表示
  StatusBar1.SimpleText:='進捗状況:';
  ProgressBar1.Visible:=True;
  ProgressBar1.Max:=PDFCount;   //最大値

  TempPDFs := TStringList.Create;
  try
    //指定フォルダ内のすべての PDF を検索
    if FindFirst(IncludeTrailingPathDelimiter(InputDir) + '*.pdf', faAnyFile, SearchRec) = 0 then
    begin
      try
        repeat
          TempPDF := IncludeTrailingPathDelimiter(OutputDir) + 'temp_' +
            IntToStr(TempPDFs.Count) + '.pdf';

          //PDFtkをシステム環境変数のPathに正しく指定してある場合
          //PDFファイル名に半角スペースが含まれていると
          //多数のファイルを処理する場合、確実にエラーが発生する
          {
          Command := Format('cmd.exe /c %s "%s" cat %d output "%s" 2>> "%s"',
            [PDFtkPath, IncludeTrailingPathDelimiter(InputDir) + SearchRec.Name,
            PageNum, TempPDF, LogFile]);
          }

          //PDFtkに渡すPATHをダブルクオートで囲んで渡すように修正
          //さらに短縮形式(8.3形式) に変換して渡すように修正
          Command := Format('cmd.exe /c %s "%s" cat %d output "%s" 2>> "%s"',
          [PDFtkPath, '"' + GetShortPath(IncludeTrailingPathDelimiter(InputDir) + SearchRec.Name) + '"',
          PageNum, TempPDF, LogFile]);

          //ShowMessage('"' + IncludeTrailingPathDelimiter(InputDir) + SearchRec.Name + '"');

          //pdftk を実行して指定ページを抽出
          if ExecuteCommand(Command) then
          begin
            TempPDFs.Add(TempPDF);

            //ProgressBar
            intNum:=intNum+1;  // <- 記述を忘れないこと!
            //値を増やす時
            If ProgressBar1.Position < ProgressBar1.Max Then
            begin
              //目的の値より一つ大きくしてから、目的の値にする
              ProgressBar1.Position:=intNum+1;
              ProgressBar1.Position:=intNum;
            end else begin
              //最大値にする時
              //最大値を1つ増やしてから、元に戻す
              ProgressBar1.Max:=PDFCount+1;
              ProgressBar1.Position:=intNum+1;
              ProgressBar1.Max:=PDFCount;
              ProgressBar1.Position:=intNum;
            end;
            //処理の表示を止めないおまじない
            Application.ProcessMessages;

          end;

        until FindNext(SearchRec) <> 0;
      finally
        FindClose(SearchRec);
      end;
    end;

    //初期化
    ProgressBar1.Position:=0;

    if TempPDFs.Count > 0 then
    begin
      ExtractedPDF := IncludeTrailingPathDelimiter(OutputDir) + 'filelist.txt';
      TempPDFs.SaveToFile(ExtractedPDF); // ファイルリストを保存
    end;

    // Information_YesNo
    strMsg := '続けて結合も実行しますか?';
    if Application.MessageBox(PChar(strMsg), PChar('情報'), MB_YESNO or MB_ICONINFORMATION) = mrYes then
    begin
      //[はい]が選ばれた時
      Button2Click(Button1);
    end else begin
      //[いいえ]が選ばれた時
      strMsg:='抽出ページをマージする場合は結合ボタンをクリックしてください';
      Application.MessageBox(PChar(strMsg), PChar('情報'), MB_ICONINFORMATION);
    end;

  finally
    TempPDFs.Free;
    //進捗状況の表示
    StatusBar1.SimpleText:='';
    ProgressBar1.Visible:=False;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  i, w:integer;
begin
  //StatusBarの設定
  StatusBar1.SimplePanel:=True;
  //プログレスバーの初期化
  with ProgressBar1 do begin
    Parent  :=StatusBar1;
    Top     :=2;  //表示位置の調整
    w:= StatusBar1.Canvas.TextWidth('進捗状況:');
    Left    :=w;
    //Left    :=100;  //表示位置の調整
    Height  :=StatusBar1.Height-2;
    Width := StatusBar1.Width-20;
    Visible :=False;
  end;

  //抽出するページの選択肢を作成
  for i := 1 to 999 do
  begin
    ComboBox1.Items.Add(IntToStr(i));
  end;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  //Formを画面の中央に表示
  Left:=(Screen.Width-Width) div 2;
  Top:=(Screen.Height-Height) div 2;
end;

procedure TForm1.MergePDFs;
var
  //ShellExecuteを使用
  //InputDir, OutputFile, Command: string;

  //CreateProcessを使用
  InputDir, OutputFile, Command, CmdLine: string;
  StartupInfo: TStartupInfo;
  ProcessInfo: TProcessInformation;
  strMsg: string;
begin

  //ShellExecuteを使用
  {
  InputDir := ExtractFilePath(Application.ExeName)+'dst\';
  OutputFile := InputDir + 'MergedOutput.pdf';
  //既存のファイルがあれば削除する
  if FileExists(OutputFile) then
  begin
    //削除
    DeleteFile(OutputFile);
  end;
  //pdftkコマンドの構築(すべてのPDFを結合)
  Command := Format('cmd /c pdftk "%s*.pdf" cat output "%s"', [InputDir, OutputFile]);
  //ShellExecuteでpdftkを実行
  ShellExecute(0, 'open', 'cmd.exe', PChar(Command), nil, SW_HIDE);
  }

  //CreateProcessを使用
  InputDir := IncludeTrailingPathDelimiter(ExtractFilePath(Application.ExeName)) + 'dst\';
  OutputFile := InputDir + 'MergedOutput.pdf';

  //既存のファイルがあれば削除する
  if FileExists(OutputFile) then
  begin
    //削除
    DeleteFile(OutputFile);
  end;

  //pdftkコマンドの構築(すべてのPDFを結合)
  Command := Format('pdftk "%s" cat output "%s"', [InputDir + '*.pdf', OutputFile]);

  //コマンドラインを `cmd.exe /c` でラップ
  CmdLine := Format('cmd.exe /c %s', [Command]);

  // `CreateProcess` の設定
  FillChar(StartupInfo, SizeOf(TStartupInfo), 0);
  StartupInfo.cb := SizeOf(TStartupInfo);
  StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
  StartupInfo.wShowWindow := SW_HIDE;

  if CreateProcess(nil, PChar(CmdLine), nil, nil, False, CREATE_NO_WINDOW, nil, nil, StartupInfo, ProcessInfo) then
  begin
    //プロセスが完了するのを待つ
    WaitForSingleObject(ProcessInfo.hProcess, INFINITE);
    //ハンドルを閉じる
    CloseHandle(ProcessInfo.hProcess);
    CloseHandle(ProcessInfo.hThread);
  end else begin
    strMsg:='PDFの結合に失敗しました。pdftkが正しくインストールされているか確認してください。';
    Application.MessageBox(PChar(strMsg), PChar('エラー'), MB_ICONERROR);
  end;

end;

end.

追記(20250218)

システム環境変数に PDFtk への PATH が正しく設定されているか、どうかを調べる他に、もう一つ、PDFtk がインストールされているか、どうかを確認する方法も調べてみた。

コマンド・プロンプトを起動して、下記のように「pdftk –version」と入力し、Enter キーを押し下げると、PDFtkがインストールされていれば、次のように応答が返る。


このことを確認しておいて、プログラムを書き、実行するとエラーが発生。当初、なぜエラーになる(IsPDFtkInstalled 関数が False を返す)のか、わからなかったが、出力を確認したところ、ようやく原因が判明。出力は次の通り。

出力が「文字化け」している・・・


シェルの出力を UTF-8 として処理するよう、プログラムを修正。

AStream := TStringStream.Create('', TEncoding.UTF8);

で、ここに出力して・・・

AStream.WriteBuffer(ABuffer, ARead);

さらに StringList に入れて「小文字」にして、出力結果に ‘pdftk’ の文字列が含まれているか、どうかを確認。

AOutput := TStringList.Create;
AOutput.Text := AStream.DataString;

(略)

if Pos('pdftk', LowerCase(AOutput.Text)) > 0 then
begin
  Result := True;
end;

期待通りに動作することを、メッセージを表示して確認(確認後、このメッセージ表示部分はコメント化し、実際に実行する際はインストールされていない場合のみ、メッセージを表示する仕様とした)。

全体のコードは、次の通り。

  private
    //Formの表示終了イベントを取得
    procedure CMShowingChanged(var Msg:TMessage); message CM_SHOWINGCHANGED;

procedure TForm1.CMShowingChanged(var Msg: TMessage);
var
  strMsg:string;

  //PDFtkのインストールの有無を確認
  function IsPDFtkInstalled: Boolean;
  var
    AStartupInfo: TStartupInfo;
    AProcessInfo: TProcessInformation;
    ASecurityAttributes: TSecurityAttributes;
    ABuffer: array[0..1023] of Byte;
    ARead: Cardinal;
    AStdOutPipeRead, AStdOutPipeWrite: THandle;
    ACommand: String;
    AOutput: TStringList;
    AStream: TStringStream;
  begin
    Result := False;
    AOutput := TStringList.Create;
    AStream := TStringStream.Create('', TEncoding.UTF8);
    try
      FillChar(ASecurityAttributes, SizeOf(ASecurityAttributes), 0);
      ASecurityAttributes.nLength := SizeOf(ASecurityAttributes);
      ASecurityAttributes.bInheritHandle := True;

      CreatePipe(AStdOutPipeRead, AStdOutPipeWrite, @ASecurityAttributes, 0);
      try
        FillChar(AStartupInfo, SizeOf(AStartupInfo), 0);
        AStartupInfo.cb := SizeOf(AStartupInfo);
        AStartupInfo.hStdOutput := AStdOutPipeWrite;
        AStartupInfo.hStdError := AStdOutPipeWrite;
        AStartupInfo.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
        AStartupInfo.wShowWindow := SW_HIDE;

        ACommand := 'pdftk --version';
        if CreateProcess(nil, PChar('cmd.exe /C ' + ACommand), nil, nil, True, CREATE_NO_WINDOW, nil, nil, AStartupInfo, AProcessInfo) then
        try
          CloseHandle(AStdOutPipeWrite);
          while ReadFile(AStdOutPipeRead, ABuffer, SizeOf(ABuffer), ARead, nil) do
          begin
            if ARead = 0 then Break;
            AStream.WriteBuffer(ABuffer, ARead);
          end;
          AOutput.Text := AStream.DataString;
          WaitForSingleObject(AProcessInfo.hProcess, INFINITE);
        finally
          CloseHandle(AProcessInfo.hProcess);
          CloseHandle(AProcessInfo.hThread);
        end;
      finally
        CloseHandle(AStdOutPipeRead);
      end;

      if AOutput.Count > 0 then
      begin
        //確認用
        //strMsg:='PDFtk output: ' + AOutput.Text;
        //Application.MessageBox(PChar(strMsg), PChar('情報'), MB_ICONINFORMATION);
        if Pos('pdftk', LowerCase(AOutput.Text)) > 0 then
        begin
          Result := True;
        end;
      end else begin
        //No output from PDFtk command.
        strMsg:='PDFtk からの出力がありません。';
        Application.MessageBox(PChar(strMsg), PChar('情報'), MB_ICONINFORMATION);
      end;
    finally
      AOutput.Free;
      AStream.Free;
    end;
  end;

begin
  inherited; {通常の CMShowingChagenedをまず実行}
  if Visible then
  begin
    Update; {完全に描画}
    //PDFtkのインストールの有無を確認
    try
      if IsPDFtkInstalled then
      begin
        //確認用
        //strMsg:='PDFtk はインストールされています。';
        //Application.MessageBox(PChar(strMsg), PChar('情報'), MB_ICONINFORMATION);
      end else begin
        strMsg:='PDFtk はインストールされていません。'+#13#10+#13#10+
          'https://www.pdflabs.com/tools/pdftk-the-pdf-toolkit/'+#13#10+
          '上記Webサイトからダウンロード&インストールしてください。'+#13#10+#13#10+
          'プログラムを終了します。';
        Application.MessageBox(PChar(strMsg), PChar('情報'), MB_ICONINFORMATION);
        Close;
      end;
    except
      on E: Exception do begin
        strMsg:='エラー: ' + E.Message;
        Application.MessageBox(PChar(strMsg), PChar('エラー'), MB_ICONERROR);
      end;
    end;
  end;

end;


【注意のお願い】

追記(20250218)の「PDFtk のインストールを確認するプログラムコード」は、上記の「全体のプログラムコード」には含まれておりません。ご注意願います。

6.お願いとお断り

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

StringGridの自動入力・セルの色分け

組み合わせ採点を行うプログラムを書いた際、StringGridの列に連番を自動入力したり、セルの値が同じ範囲を自動的に色分け(背景色を変更)するプログラムを書いた。これは、その備忘録。

※ Grid の列への連番自動入力他、前回の記事と重複する部分があります。ご容赦ください。

【もくじ】

1.StringGridの基本設定(VCL)
2.列に連番を自動入力
3.連番であるかチェック
4.セルの値が同じ範囲を自動判別して背景色を変更
5.同じ値のセル範囲を自動取得してフラグ化
6.お願いとお断り

1.StringGridの基本設定(VCL)

Form に StringGrid をひとつだけ用意して、次のコードを準備する。


コードは、次の通り。

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;

2.列に連番を自動入力

「常に自動入力する」設定だと、同じ値の連続入力を許可して、それを何かのフラグ(例えば組み合わせ採点の組み合わせ設問設定フラグ)として利用するような場合、後で入力値の修正が必要になったとき大変なことになるので、より実用的にするなら CheckBox などを用意して、「チェックあり」の場合のみ動作するように設定する等の工夫が必須(だと思う)。

次は、チェックボックスのチェックの有無で動作をON・OFFする場合の例。

Form に CheckBox を1つ追加


コードは、次の通り。

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;


チェックボックスにチェックした際、Grid コントロールにセットフォーカスさせたければ、次のコードも追加する。

procedure TForm1.CheckBox1Click(Sender: TObject);
begin
  if CheckBox1.Checked then
  begin
    //セットフォーカス
    StringGrid1.Col:=1;
    StringGrid1.Row:=1;
    StringGrid1.SetFocus;
    //セルの編集を開始(ユーザーのクリックを待つ場合はコメント化する)
    StringGrid1.Options := StringGrid1.Options + [goEditing];
    //カーソルが見えるようにする
    StringGrid1.EditorMode:=True;
  end;
end;

実行(F9)時の動作は、次の通り(Enter キーを数回、押し下げ後の状態)。


CheckBox にチェックを入れて、1行1列目のセルをクリックしてEnterキーを押し下げる度にフォーカスが下へ移動し、連番が自動入力される。

同じ番号を入力したい場合は、手動で入力してEnterキーを押し下げ。
※ 入力値を組み合わせ採点を実行するフラグとして利用したかったため、このような仕様とした。

この例では、5行目の「5」は自動入力されるので、
6、7行目の「5」を手入力する。

3.連番であるかチェック

同じ値の繰り返しを許可した上で、入力された値が連番になっているかをチェックする。
FormにButtonを1つ追加して、ボタンをクリックした際にチェックを実行。

Form に Button を1つ追加。


コードは次の通り。

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

4.セルの値が同じ範囲を自動判別して背景色を変更

業務用のプログラムでは、上の図のように同じ値が繰り返し入力されているセルがたやすく見分けられるように工夫した方が好ましいと考え、セルの値が同じ範囲を自動判別して背景色を変更するコードを追加する。

まず、uses に System.Generics.Collections を動的配列要素のSortのために追加。

implementation

uses
  System.Generics.Collections;

{$R *.dfm}


次に、Gridコントロールの OnDrawCell 手続きに以下のコードを記述。

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;


連番で実行(F9)した場合、


同じ値を適当に入力してみた場合、

5.同じ値のセル範囲を自動取得してフラグ化

1.基本設定の最後で「列の編集の可否を制御したい場合は、以下のコードで実現可能」としたのは、実はTFフィールドをフラグとして利用したかったため。

具体的に何がしたかったかと言うと、TF列の任意のセルをクリックしたとき、その左の連番列の同じ値が入力されているセルを自動判別して、TF列の同じセル範囲にクリックで「1」を、スペース押し下げで「0」を自動(切り替え)入力するトグル的操作の実現。

実用上の目的は、連番列で同じ番号が入力されている(=同じ背景色)セルを処理上はセットにして扱うが、TF列に設定されている値が「1」であるセルと、「0」であるセルとで行う処理の内容を分けたいというもの。

つまり、連番列で同じ番号が入力されているセルは「組み合わせ」て採点し、さらにTF列の値が「1」であれば「順不同」で採点を行いたい場合のフラグとして利用できるようにしたかった。

そのための布石として、TF列の自由な編集を不可に設定。

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;

共通利用する手続きとして、次の手続きを追加(Shift+Ctrl+C で TForm1 のメンバとして作成)。

  private
    { Private 宣言 }

    //状態の切り替え
    procedure ToggleSGCell(ACol, ARow: Integer);
    procedure UpdateColumnData(Value: Integer; IsChecked: Boolean);


ToggleSGCell 手続きのコードは、次の通り。

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;

プログラムの仕様として、TF列の任意のセルをクリックしたら、連番列の値を調査して同じ値が連続して入力されているセル全てに「1」を入力したいので、OnMouseDown 手続きに次のコードを記述。

procedure TForm1.StringGrid1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  Col, Row: Integer;
begin
  //マウスクリックでセルの0と1を切り替え
  StringGrid1.MouseToCell(X, Y, Col, Row);
  if (Col = StrGrid1ColCount-1) and (Row > 0) then
    ToggleSGCell(Col, Row);
end;

で、OnMouseUp イベントで連番列の値を判定。同じ値の入力されているセル範囲を取得して、TF列の同じ行に「1」を自動入力する。

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列の任意のセルをクリックして、スペースキー押し下げで入力値を「0」に切り替える。

procedure TForm1.StringGrid1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  //スペースキーで0と1を切り替え
  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;


実行(F9)の動作は、次の通り。

TF列の任意のセル(5行目)をクリックした場合。


同じセルをクリックして選択後、スペースキー押し下げでゼロに切り替え。

6.お願いとお断り

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

組み合わせ採点を実現したい!

2024年11月27日(水)、ある高名な化学者の講演を聴いた。「研究を続けてきた中で、最も困難であったことは何か?」という問いに対し、彼は「実験の99%が失敗であったことだ。」と即答。

その言葉を反芻するうちに、表計算ソフトを使わなければ自分には実現不可能と信じ、
チャレンジする前からあきらめていた「組み合わせ採点」のことを思い出した。

「方向性さえ間違えなければ、失敗の山を築こうとも、いつか必ず成功する。大切なのは、その成功の瞬間を見逃さないことだ。」

僕は、化学者の言葉を、心から信じようと、思った。

表計算ソフトに頼らない「組み合わせ採点」。
Object Pascal だけで書く「組み合わせ採点」。
もしかしたら、僕にも書けるかもしれない・・・と、自分史上、初めて、本気で、そう思えた。

【もくじ】

1.情報処理手順
2.実装
(1)Gridコントロール
(2)組み合わせ採点
(3)順不同採点
3.お知らせ
4.お願いとお断り

1.情報処理手順

まず、最初に「組み合わせ採点」なるものの定義。

例えば、選択肢数が1設問につき8個あるマークシートを考える。そのとき、次のように

    設問1 設問2 設問3
マーク  1   2   3
正 解  1   2   3

設問1~3のマークと正解が完全に一致した場合に「正解」とする採点方法だ。

また、可能であれば、「組み合わせ & 順不同採点」も実現したい。それはつまり、

    設問1 設問2 設問3
マーク  1   2   3
マーク  1   3   2
マーク  2   1   3
マーク  2   3   1
マーク  3   1   2
マーク  3   2   1

このすべてが正解という採点方法、すなわち、解答の順番は不問にして、とにかく設問1~3の解答として1・2・3のいずれかがマークされていればよいというもの(実際の試験では、これまでは「正しいものを昇順に3つ選べ」というような問題文にしたり、正しい語句等を3つ組み合わせた解答の選択肢を用意する必要があったが、これが単に「正しいものを3つ選べ」という表現でよくなる)。

また、組み合わせ採点が設定可能な設問は、必ず連続で並んでいるものとする。
つまり、次のような設定は最初から考えない(設定不可)。

    設問1 設問2 設問3 設問4 設問5
マーク  2       3       4
正 解  2       3       4

「組み合わせ採点」を英語では、次のように表現するようだ。

Combination Matching System -> 組み合わせの「一致性」に基づく評価。
Combination Marking System -> 採点(marking)を強調。教育や試験で使える表現。
Composite Marking System -> 要素を統合してスコアを出す評価システム。

いずれも頭文字を組み合わせると CMS になる。
自分的には、マークシートの採点だから Combination Marking System かな?

それから「順不同」を英語で言うと、No Particular Order だから、こちらは略して NPO だ。

これから書くプログラムでは、この略称でそれぞれの採点方法を表現することにする。
(・・・と勝手に決める)

はたしてどうやったら組み合わせ採点のアルゴリズムを一般化できるか、考える。マークシートリーダーのプログラムを書いたときにも、ちらっと組み合わせ採点のことは脳裏をかすめたが、すぐに表計算ソフトを使ってなんとかすればいいやって・・・。

あのときは表計算ソフトのセルを Delphi で操作するプログラムを書いて、それで誤魔化してしまったんだ。表計算ソフトのファイルにADOで接続して、セルを結合させ、プログラムで作成した式を書き込んで、組み合わせ採点を行った。だから、ワークシートを改変されると、もう、それだけで動作しなかった。

純粋に Delphi だけで、組み合わせ採点を実現するのは、少なくても自分には無理だ・・・と、あのころの僕は、信じて疑わなかったから。

それなのに、なぜ、今は「それが出来る」と考えて、その実現に向かって歩こうとしているのか。

僕は以前より、よくなれたんだろうか・・・

それは おそらく 僕が決めることでは、ないだろう。

自作のプログラムの採点設定画面を見つめて、まず思ったことは、例えば設問1~3を組み合わせ採点するとしたら配点は、3つある配点入力セルの「いずれか1つ」に入力し、残りのセルにはゼロを入れてこれを採点結果印刷行などのフラグとして使う案(下図参照)。

自作の採点結果通知個票作成プログラムの画面

組み合わせ採点・順不同採点は出来ませんが、1問1答形式であれば使用できる(?)マークシートリーダーと手書き答案の採点プログラム、及び採点結果を受験者に通知する個票を作成するプログラムをセットにした zip ファイルを次のリンク先で無料で公開しています。


つまり、配点が「ゼロでない」場合のみ、採点結果通知個票に正解なら○(マル)、そうでなければ×(バツ)を印刷すればいい。

ここで気がついたのだけれど、組み合わせて採点して正解にする以上、観点別評価の区分はどうしても同じにする必要があるということ。これを設問毎に別々に設定可能とすると相当やっかいなことになりそうだ。

約束ごとをさらに1つ増やそう。
組み合わせ採点を設定した設問の観点別評価は観点1か、2のいずれかに統一する。

で、この他に、どの設問を組み合わせ採点とするのか、やはり明示的に示せた方がよい。グリッドコントロールの列を増やし、組み合わせ採点を行う設問には同じ番号を入力してもらうのはどうか?

そうすれば組み合わせ採点箇所は一目瞭然だ。・・・てか、組み合わせ採点をする箇所は何設問分あろうと採点箇所1個としてとらえ、組み合わせ採点をしない箇所も含めて、連番・昇順の通し番号を割り当て、プログラム実行時にその数だけ動的に配列を生成して、そこにマークされた選択肢の番号や正解の選択肢の番号をまとめて入れて・・・

「マーク配列」と「正解配列」を比較して、完全に一致したときのみ正解にすれば・・・

組み合わせ採点を実現できそうだ。

さらに、順不同採点を実行する場合は、例えば、それを実行しないフラグをゼロ、実行するフラグを1として、組合せ採点番号と一緒にこちらも明示的に設定してもらう。

実行時に、組み合わせ採点が設定されていて、かつ順不同採点の実行フラグが1なら、その組合せ採点番号のマーク配列と正解配列の要素をそれぞれ昇順ソート(もちろん、降順でもかまわないが)して比較・・・完全一致した場合だけ正解とすれば・・・

順不同採点も同時に実現できそうだ。

そう思って作成したのが、こちらのグリッドコントロール。

CMSフィールドが組み合わせ採点の番号、NPOフィールドが順不同採点の有無。


初見時、わけわかんない・・・かも。
自分自身、そう思ったが、今の自分にはこれ以上のアルゴリズムは考えられない。マニュアルを読まなくても直感的に使えるプログラムが最もよいプログラムだと信じているが、ここだけはマニュアルを読んでクリアしてもらうしかなさそうだ。

このプログラムを使ってくださる方が、この世にいたとして・・・の話だが。

NPOフィールドにはチェックボックスを埋め込むことも考えた、いや、埋め込んでみたのだが、イマイチその挙動が気に入らない。これはどうしても必要となったら再考することにして、今は組み合わせ採点の実現を最優先することにする。

アルゴリズムは出来た。
さぁ 実装だ。

2.実装

追記_20250105
実装のプログラムコードは、次の記事に略した部分のない詳細があります。

(1)Gridコントロール

最初はGridコントロールの CMS フィールドへの入力から。

ここは、どう考えても自動入力にすべきだろう・・・。設計上、絶対に連番になっていないといけないし、100設問あるような場合、すべてを手入力するのはどう考えても時間の無駄だ。そう思って書いたのが次のコード。

  private
    { Private 宣言 }
    //StringGridの列数を設定 -> FormCreate時に設定する
    StrGrid1ColCount: Integer;
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;


実行時の動作は、次の通り。
CMS フィールドの1行目のセルをクリックして選択し、Enter キーを押し下げして選択セルを下に移動させると連番が自動的に入力される。

Enter キー押し下げでCMS列のすべての行が自動入力される。


組み合わせ採点を設定したいセルのみ、手動入力する。例えば設問番号2~4を組み合わせ採点したい場合は、2行目は自動入力で2が入るので、3行目・4行目に手動入力で半角数字の 2 を入力する。

組み合わせ採点したいセルには同じ値を入力する。


使ってみて気づいたのだが、この入力方法には問題があって、微調整が効かない!
途中で設定の誤りに気がついて、訂正しようとすると、訂正箇所以下すべての設定が失われてしまう・・・

2行目を選択してEnter キーを押し下げで、すべての設定が消える!


これは、さすがにマズい。部分修正しても、既存の組み合わせ採点設定が消えないようにする必要がある。どうするか? しばし考えて CheckBox と Button を1つずつ追加。

CheckBox のキャプションには「Auto」、Buttonのキャプションには「HELP」を設定。


CMS フィールドの自動入力は、Auto にチェックが入っているときのみ動作するよう設定を変更。これで既存の設定が一瞬にして消える悲劇は防げる? もちろん、デフォルトはFalse!

で、HELP ボタンをクリックしたら、CMS・NPO 各フィールドの意味と設定方法を表示。

説明は、必要最小限にしたつもり・・・だが。


次は、NPO フィールドへの入力。

いちばん、かんたんな方法は何か? いろいろ考えた末、説明されなければ絶対わからないが、説明さえきちんと読んでもらえれば、多分、便利に使える方法を採用。

それはクリックされた NPO フィールドのセル位置に応じて、組み合わせ採点の範囲を自動的に取得し、クリックされたセルとその上下の( CMS フィールドに同じ組み合わせ採点番号が設定されている)セルすべてに 1 (順不同採点ありのフラグとして利用)を自動入力するというもの。

NPO フィールドの任意のセルをクリックすると、
組み合わせ採点設定されている範囲のセルすべてに1を自動入力。


コードは次の通り。

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;

解除は、解除したい組み合わせ採点範囲の任意のセル1つをクリック(選択)して、スペースキー押し下げ。これでクリックされたセルとその上下の( CMS フィールドに同じ組み合わせ採点番号が設定されている)セルすべてに 0(順不同採点なしのフラグとして利用)を自動入力。

NPO フィールドの任意のセルをクリックして選択し、
スペースキーを押し下げで、順不同採点設定を解除。


コードは、次の通り。

private
  procedure ToggleSGCell(ACol, ARow: Integer);

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;

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;

procedure TForm1.StringGrid1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  Col, Row: Integer;
begin
  //マウスクリックでGridのセルをトグル
  StringGrid1.MouseToCell(X, Y, Col, Row);
  if (Col = StrGrid1ColCount-1) and (Row > 0) then
    ToggleSGCell(Col, Row);
end;

これでフラグの準備が出来た。次は「組み合わせ採点」そのものの実装だ。

(2)組み合わせ採点

自作の採点結果通知個票作成プログラムでは、マークシートリーダーで読み取った解答用紙のマークの選択肢番号を記録した CSV ファイルを読み込み、その内容をGrid コントロールに表示している。

採点結果通知個票作成プログラム側で作成した、上記の正解データや観点別評価の種類、組み合わせ採点の有無、順不同採点の設定は、また別の CSV ファイルに保存している。

組み合わせ採点を行うには、その2つの CSV ファイルからデータを読み込み、組み合わせ採点設定に応じて、マークの状態と正解及び採点結果(True / False)を動的配列に格納する必要がある。なので、まず、それを準備する。

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;

実行(F9)結果は・・・

全問正解で処理した場合
全問不正解で処理した場合
(採点記号・観点別評価の区分に加えて、正解の選択肢を赤字で表示することも可能)


期待した通りに動作しているようだ。

うれしい・・・ことに間違いはないのだが、感極まるような喜びはない。正直なところ、あまりにも簡単に( 絶対! 出来ない )と思い込んでいたことができちゃったので( そんなもんか・・・ )みたいな。

(3)順不同採点

次は、順不同採点だ。アルゴリズムは出来ている。上で作成済みの「マークされた選択肢の番号を入れた動的配列の要素」と、「正解の選択肢の番号を入れた動的配列の要素」をそれぞれ昇順(別に降順でも構わないが)に並び替え、比較して一致した場合を正解として処理すればよい。

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;

実行(F9)時の画面は、次の通り。まず、順不同採点を行わない場合、

組み合わせ採点が有効で、順不同採点は無効として採点。
マークは「1・2・3」なので不正解になる。


順不同採点を行う場合、

組み合わせ採点・順不同採点ともに有効として採点。
マークが「1・2・3」でも正解になる。

3.お知らせ

今回紹介した組み合わせ採点機能を組み込んだ採点結果通知個票作成用のプログラムは、実際の試験で必要十分な動作検証を行い、後日、「ReportCard_2025.exe」として公開する予定です。

4.お願いとお断り

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

Checked プロパティのみ設定したい!

CheckBox がクリックされたら「メッセージを表示」して、ユーザーに「はい」・「いいえ」のいずれかを選択してもらう。

「はい」が選択された場合はプログラム自体を再起動。で、再起動後の FormCreate 時に当該 CheckBox の Checked プロパティをクリックされた(変更された)状態に設定。ただし、その際、メッセージは表示しない。

もし、「いいえ」が選択された場合は、CheckBox の Checked プロパティはチェック前の状態を維持、つまり、クリックを無効化する。もちろん、ここでもメッセージは出さずに、Checked プロパティのみ修正したい。

この動作を実現したくて、半日、ハマった。

【もくじ】

1.用意した手続きと関数
2.実行結果
3.お願いとお断り

1.用意した手続きと関数

なんとか、実現。完成したコードは以下の通り。

  private
    { Private 宣言 }

    //チェックボックスの状態をロード中に OnClick イベントがトリガーされるのを防止する
    IsLoading: Boolean;

    procedure SaveCheckCMS_State(CheckBox: TCheckBox);  //Checked プロパティを保存
    procedure LoadCheckCMS_State(CheckBox: TCheckBox);  //Checked プロパティを読込
    procedure ClearRestartFlag;  //再起動フラグをクリア
    function IsRestarting: Boolean;  
    procedure RestartApplication;


グローバル変数を一つ、手続きと関数を上のように準備。それから ini ファイルを使うので、System.IniFiles を uses に追加。

implementation

uses
  System.IniFiles;

Shift+Ctrl+C でそれぞれの手続きや関数を次のように作成。

まず、SaveCheckCMS_State 手続き。CheckCMS が CheckBox の名前。Checked プロパティの状態を保存する。ちなみに CMS は、組み合わせ採点(Combined Scoring Method)の略。

procedure TForm1.SaveCheckCMS_State(CheckBox: TCheckBox);
var
  IniFile: TIniFile;
begin
  IniFile := TIniFile.Create(ChangeFileExt(Application.ExeName, '.ini'));
  try
    IniFile.WriteBool('セクション', '組み合わせ採点', CheckCMS.Checked);
    IniFile.WriteBool('セクション', 'IsRestarting', True); //再起動フラグを設定
  finally
    IniFile.Free;
  end;
end;

次は LoadCheckCMS_State 手続き(保存した Checked プロパティの状態を読み込む)。

procedure TForm1.LoadCheckCMS_State(CheckBox: TCheckBox);
var
  IniFile: TIniFile;
begin
  IniFile := TIniFile.Create(ChangeFileExt(Application.ExeName, '.ini'));
  try
    IsLoading := True; // イベントを無効にするためのフラグを設定
    CheckCMS.Checked := IniFile.ReadBool('セクション', '組み合わせ採点', False);
  finally
    IsLoading := False; // フラグをリセット
    IniFile.Free;
  end;
end;

次は ClearRestartFlag 手続き( Checked プロパティの保存時に True に設定した再起動を知るフラグをクリアする)。

procedure TForm1.ClearRestartFlag;
var
  IniFile: TIniFile;
begin
  IniFile := TIniFile.Create(ChangeFileExt(Application.ExeName, '.ini'));
  try
    IniFile.WriteBool('セクション', 'IsRestarting', False);  //再起動フラグをクリア
  finally
    IniFile.Free;
  end;
end;

次は IsRestarting 関数( FormCreate 時に呼び出し)。

function TForm1.IsRestarting: Boolean;
var
  IniFile: TIniFile;
begin
  IniFile := TIniFile.Create(ChangeFileExt(Application.ExeName, '.ini'));
  try
    Result := IniFile.ReadBool('セクション', 'IsRestarting', False);
  finally
    IniFile.Free;
  end;
end;

次は RestartApplication 手続き。これを呼び出すことでプログラム自体を再起動する。

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;

2.実行結果

(1)プログラムを起動。フォームが表示される。

練習用なので、CheckBox をひとつだけ用意。
CheckBox の Checked プロパティはデフォルトでは False に設定している。


(2)CheckBoxをクリックすると、メッセージが表示されるので、「はい」をクリックする。


(3)自分自身を再起動。CheckBox の Checked プロパティは終了時の True 状態で起動するが、上記のメッセージは表示されない。 これが実現したかったことのひとつめ。

Checked プロパティは True でも、メッセージは表示されない。


(4)再度、CheckBox をクリック。Checked プロパティは False に変わり、CheckBox のチェックは外れた状態でメッセージが表示される。今度は「いいえ」をクリック。

今度は「いいえ」をクリックする。


(5)「いいえ」を選択したから再起動はしない。「再起動しない」から CheckBox の Checked プロパティは元の True であった状態を維持(= False から True へ修正)するが、メッセージは表示されない。これが実現したかったことのふたつめ。

「いいえ」が選択された場合は、CheckBox の Checked プロパティはチェック前の状態を維持。
(直前のクリックを無効化)

3.お願いとお断り

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

DelphiのSmart CodeInsightを使ってみました!

Delphi 12.2で利用できるようになったSmart CodeInsightが使えるようになるまでの設定方法です。
ローカルで LLM を実行できる Ollama の環境構築から(見様見真似で)やってみました。

【もくじ】

1.はじめに
2.Ollama のインストール
3.LLM モデルのダウンロード
(1)Gemma 2
(2)Llama-3-ELYZA-JP-8B
4.動作環境の設定
(1)Gemma 2
(2)Llama-3-ELYZA-JP-8B
5.DelphiのIDEのスマート支援機能を設定
6.DelphiのIDEのスマート支援機能を使う
7.まとめ
8.お願いとお断り

1.はじめに

ちなみに LLM は(今回、初めて知った!のですが)、自然言語処理( Natural Language Processing :NLP )のタスクに使用される大規模言語モデル( Large Language Model )の略で、膨大な量のテキストデータを使って訓練された人工知能のモデルを意味するそうです。

※ 自然言語処理のタスク:「コンピュータがヒトの言語を理解し、生成し、処理する上での特定の課題や目的」のこと。すなわち、文章の生成、分類、翻訳、応答、人名・地名・組織名等の特定の名称認識( Named Entity Recognition:NER )、音声認識、要約など、実に様々な「タスク」があるようです。

調べてみると実にたくさんの LLM があり、果たしてどのモデルを選べばよいのか(例えば、日本語が得意で、プログラミングに適したモデルはどれなのか?)がわからず、当初、たいへん困りましたが、いくつかの Web サイトの情報を参考に、ここでは「 Gemma 2 」と「 Llama-3-ELYZA-JP-8B 」をダウンロードして使ってみました。

コマンドを叩くだけで簡単にインストールできたのは「 Gemma 2 」、自分で Modelfile を作る必要があり、設定に少し勉強が必要だったのが「 Llama-3-ELYZA-JP-8B 」です。私のノート PC 環境(もちろん、GPU などという結構なモノは、ハナからついておりません!)で、「実用になるか・どうかは別」にして、単に「応答の速さだけを見た」場合、後者の方が体感的には「圧倒的に速かった」です。

【My デバイスの仕様】
プロセッサ 11th Gen Intel(R) Core(TM) i7-1185G7 @ 3.00GHz 3.00 GHz
実装 RAM 32.0 GB (31.7 GB 使用可能)
システムの種類 64 ビット オペレーティング システム、x64 ベース プロセッサ

2.Ollama のインストール

Delphi 12.2 Athens をインストールして、その新機能に関する記事を読んでいたら、「Smart CodeInsight: コーディングにAIのパワーを活用」という見出しがあり、そのリンク先の記事で、オンラインソリューションや、オフラインソリューションを使用して AI LLM をコーディングに活用できることを知りました。これが今回の事始めです。ドキドキ。

あっ! ちなみに Ollama は「オラマ」と読むようです。ほんとか・どうか、わかりませんが・・・

https://blogs.embarcadero.com/ja/announcing-the-availability-of-rad-studio-12-2-athens-ja/#Smart_CodeInsight_%E3%82%B3%E3%83%BC%E3%83%87%E3%82%A3%E3%83%B3%E3%82%B0%E3%81%ABAI%E3%81%AE%E3%83%91%E3%83%AF%E3%83%BC%E3%82%92%E6%B4%BB%E7%94%A8

Windows11 の 23H2 で Copilot に触れてから、生成AIにコーディングを助けてもらうことが断然多くなりました。もし、DelphiのIDE上で生成AIが利用できたら、どれほど快適にプログラムが書けることか、想像するだけでワクワクします。これまでGoogle先生に質問をくり返しながら、四苦八苦していたことが、まるで夢のよう・・・。

そう思いつつ、別の記事を参照して、追加の情報もGet。

https://blogs.embarcadero.com/ja/using-ai-llms-in-the-rad-studio-ide-with-smart-codeinsight-ja/

上の記事によれば、オンラインソリューションは基本的に全て有料とのこと。で、唯一、オフラインソリューションの Ollama だけが無料で使えるソリューションでした。

※ ソリューション:「問題解決方法、手段、対応策」

上記リンク先の記事からの引用です。

「アカウントと支払いに関して唯一の例外はOllamaで、Ollama はローカル (または任意のサーバー) にインストールでき、サービス料金を支払うことなくオフラインで使用できます。」

RAD Studio IDEで「AI LLM」と「Smart CodeInsight」を使用する より引用

・・・ということなので、迷うことなく Ollama に決めました。で、Ollama は、MacOS 版、Linux 版、Windows 版があるとのことで、Windows のユーザーである私はもちろん Windows 版をチョイス。

https://ollama.com/download

上記リンク先から( Windows 環境であれば Windows 版の ) Ollama をダウンロードしました。

特に意識しなくても、自動でWindows版が選択されていた気が・・・しますが、OS が Windows11 であればダウンロードフォルダに OllamaSetup.exe(version 0.3.14:2024/10/29 現在)が保存(663MB)されます。これをダブルクリックしてインストール。

インストール自体は、ただ待つだけ。何の問題もなく終了。

(設定で、何か変わったところはあるのかなー?)

・・・と思って、いちおう確認すると、環境変数のPathの最後に

C:\Users\ユーザー名\AppData\Local\Programs\Ollama

が追加されてました。変更は、はたして、これだけか?

ここでの表記は「Ollama」
「ollama」じゃなくて、「Ollama」が正しい表記なのだろうか?


とりあえず、コマンドプロンプトを起動し、次のコマンドを叩きます。

ollama -v

【実行結果】


大丈夫。ダウンロード & インストールは無事完了!

3.LLM モデルのダウンロード

Ollama のインストールが終了したら、Ollama を使って実行する LLM のモデルを入手しなければなりません。「 LLM 日本語 無料 おすすめ」等のキーワードで検索してみると、実にたくさんの LLM モデルがあることに気付きます。

( 百花繚乱・・・)

LLM は、まさに現在進行形で進化中、きっとお互いにしのぎを削っているような状況なのでしょう。

(1)Gemma 2

いくつかの Web サイトを参照して、まず「Gemma(ジェマ)」という LLM を試してみようかと思いました。正直、専門的なことは「チンプンカンプン」で「まったくわからない」私ですが、様々なサイトで「高性能」と評価されていたこと、そして何より、インストールがとても簡単そうだったのがいちばんの理由です。

スタートボタンの隣にある「検索」欄に「cmd」と入力してコマンドプロンプトを起動、んで、次のコマンドを叩くだけで Gemma2 モデルがダウンロードされて、ただちに起動しました。カンタン!

これ作ったひと、すごい! これ作ったひとみたいに、なりたいなー☆

ollama run gemma2
C:\Users\ユーザー名>ollama run gemma2
pulling manifest
pulling ff1d1fc78170... 100% ▕██████████████|略|██████████████▏ 5.4 GB
pulling 109037bec39c... 100% ▕██████████████|略|██████████████▏  136 B
pulling 097a36493f71... 100% ▕██████████████|略|██████████████▏ 8.4 KB
pulling 2490e7468436... 100% ▕██████████████|略|██████████████▏   65 B
pulling 10aa81da732e... 100% ▕██████████████|略|██████████████▏  487 B
verifying sha256 digest
writing manifest
success
>>> Send a message (/? for help)

いくつか質問してみましたが、英語での質問には英語で、日本語での質問には日本語で答えてくれました。さらにいちばん気になる Object Pascal に関する質問にも、よさげな返事を返してくれました。

(2)Llama-3-ELYZA-JP-8B

もうひとつ気になった LLM が「 Llama-3-ELYZA-JP-8B 」です。なぜ、気になったかというと・・・

・「日本語に特化している」という情報が得られたこと。
・「小さい、軽量、ローカルでの実行に適している」という記述が多数のサイトで見られたこと。
・「Code Llama」を含む「Llama3(ラマ3)」がベースになっていること。

これ以外にもたくさんの情報がありましたが、自分的にはこの3つだけでもう十分に魅力的だと感じました。特に、最後の「Code Llama」というプログラム作成を支援してくれる機能が含まれているという解説は「 Delphi を愛して十数年・・・これを試さずには死ねない!」と思うほど、強烈な輝きを放っていました。びゃかー!ってカンジです。あぁ目が眩む。

さて、肝心のダウンロードですが、次のサイトの情報に従って行いました。

「よーしパパ、Ollama で Llama-3-ELYZA-JP-8B 動かしちゃうぞー」

https://qiita.com/s3kzk/items/3cebb8d306fb46cabe9f

上記サイトの記事の作成者様に心から感謝申し上げます。

まず、上記サイトの案内にある通り、「 Hugging Face 」から、「Llama-3-ELYZA-JP-8B-q4_k_m.gguf」をダウンロードしました。

他にも、よくわからないファイルがたくさんあったけど、とにかく「Llama-3-ELYZA-JP-8B-q4_k_m.gguf」だけををダウンロード!

ファイルの大きさは 4.58 GBほどありました。

4.動作環境の設定

(1)Gemma 2

設定は必要ありませんでした。上の記事に書いた通り、コマンドプロンプトを起動して、

ollama run gemma2

これだけで Gemma2 が起動、使用できました。

(2)Llama-3-ELYZA-JP-8B

こちらのモデルは、Ollama で標準サポートされているモデルではない(2024年10月現在)ため、使用するには少し事前準備が必要でした。以下、見様見真似で行った準備作業の手順とその内容です。

・Modelfile という「拡張子のない」ファイルをメモ帳などのテキストエディタで作成する。
・ダウンロードした Llama-3-ELYZA-JP-8B-q4_k_m.gguf と Modelfile を任意の場所にコピーする。
・コマンドを実行して Modelfile から Ollama 用のモデルを作成する。

最初に行ったのは、Modelfile の作成です。Llama-3-ELYZA-JP-8B はその名前を見れば、Llama3 モデルの発展型(そう呼んでいいのかな?)であることが明らかですから、モデルの作成に使用するフォーマットは、Llama3 モデルのそれと同じになるように設定する必要があるとのこと。なので Modelfile はモデルのフォーマット方法を書いたものなんだと理解しました。

※ フォーマット:「モデルがどのようにデータを扱い、出力を生成するか」について、その形式や構造を決めたもので、モデルが入力を理解できるように、また、効率的にデータを処理できるようにするためのルールや方法が定義されている。

【作成した Modelfile 】

作成にあたって、複数のWebサイトにあっ たModelfile の例を調べましたが、Webサイトによって、下の例の最後の行:PARAMETER stop “<|reserved_special_token” 部分が「ない」などの違いがありました。ちなみにこれは、特定のトークン(単語、フレーズ、または文字)に到達した際に出力を停止するようにモデルに指示、つまり特定の条件で出力を停止させることで、予期せぬ長い出力を防ぐために設定するパラメータのようです。

FROM ./Llama-3-ELYZA-JP-8B-q4_k_m.gguf
TEMPLATE """{{ if .System }}<|start_header_id|>system<|end_header_id|>

{{ .System }}<|eot_id|>{{ end }}{{ if .Prompt }}<|start_header_id|>user<|end_header_id|>

{{ .Prompt }}<|eot_id|>{{ end }}<|start_header_id|>assistant<|end_header_id|>

{{ .Response }}<|eot_id|>"""
PARAMETER stop "<|start_header_id|>"
PARAMETER stop "<|end_header_id|>"
PARAMETER stop "<|eot_id|>"
PARAMETER stop "<|reserved_special_token"

次に作成した Modelfile と、ダウンロードした Llama-3-ELYZA-JP-8B-q4_k_m.gguf の保存先ですが、どこにしまったらいいのか、さっぱりわかりません。いろいろ調べてみると、この2つのファイルの保存場所は「任意のフォルダ」としているサイトが数多く見受けられました。これより、この2つのファイルは同じフォルダ内に置けば、それでいいのではないかと思えてきました。

そこで「任意のフォルダ」に保存することに決めたのですが、その場所が次の大きな問題です。出来れば、あとから思い出せるように、「どこに保存したか?」絶対忘れない場所がいいです。

で、思いついたのが Ollama のインストール先フォルダのルートに置けばいいのではないか? ということです。調べて見ると Ollama のインストール先は次の場所でした。

C:\Users\ユーザー名\.ollama

さらに、「モデルがどこに作成されるのか」を調べたら、次の場所に作成されるようでした。

C:\Users\ユーザー名\.ollama\models

以上のことから、作成した Modelfile と、ダウンロードした Llama-3-ELYZA-JP-8B-q4_k_m.gguf の2つのファイルを Ollama のインストール先フォルダのルートに保存し、このフォルダを作業ディレクトリにしてモデル作成のコマンドを叩けば上手く行く(= Llama-3-ELYZA-JP-8B のモデルの作成に成功する)のではないかと考え、次のように操作してみました。

まず、作成した Modelfile と、ダウンロードした Llama-3-ELYZA-JP-8B-q4_k_m.gguf の2つのファイルを C:\Users\ユーザー名\.ollama フォルダにコピペする。

「Modelfile」に拡張子はない!


次に、コマンドプロンプトを起動して、モデル作成のコマンドを実行して、Modelfile から Ollama のモデルを作成します。モデル作成のコマンドは、次の通りです。

ollama create elyza:jp8b -f Modelfile

この時、コマンドプロンプト起動直後の状態のまま、カレントディレクトリを .ollama に変更せずにモデル作成のコマンドを実行したらエラーが発生してしまいました。

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

おしまいに success と表示されたので、上手くいったようです。
モデルを実行するには、次のコマンドを入力すればよいとのこと。

ollama run elyza:jp8b

やってみました!

C:\Users\ユーザー名\.ollama>ollama run elyza:jp8b
>>> Send a message (/? for help)

Send a message とある部分に、次のように入力してみました。

>>> DelphiでTLabelのAlignmentにtaCenterを指定しても実行すると設定が反映されないことがあります。どうしたらLabelのキャプションを中央揃えにして表示できますか?

入力後、Enterキーを叩くと・・・

TLabelのAlignmentにtaCenterを指定した際、設定が反映されない場合があります。この問題は、LabelのParentComponentにContainerControlを使用することで解決します。

以下の手順で解決します:

1. LabelをContainerControl (例えばTPanelやTFrame) のChildにします。
2. ContainerControlのAlignmentプロパティにtaCenterを指定します。

上記の方法で、Labelのキャプションが中央揃えになります。

AI の回答の内容の良否は検証の要有りですが、それより、何より・・・

動きましたー☆

5.DelphiのIDEのスマート支援機能を設定

これがいちばんやりたかったことです。

Delphiを起動して、「ツール」→「オプション」の順にクリックします。


オプションのダイアログ(ユーザーに情報を提供したり、ユーザーから入力を受け取るための小さなウィンドウ。ダイアログボックスともいう)が表示されたら、左ペインの「IDE」の中にある「スマート支援機能」をクリックします。

IDEは、前回、開いた場所を記憶しているようです。
必要であれば、「IDE」→「スマート支援機能」の順にクリックしてください。


次のように設定します。


(1)スマート支援機能の下にある「 Enable AI Engine 」のチェックをONにします。
(2)「エディタのデフォルト AI 」のComboBox は選択肢から Ollama を選択します。
(3)「チャットウインドウのデフォルト AI 」も選択肢から Ollama を選択します。

私の環境では、CheckBox のキャプションは「 Enable AI Engine 」でしたが、
Web上で見たダイアログではそれが「AIエンジンの有効化」となっていました。
なぜなんでしょう?


続けてプラグインの部分も次のように設定します。


(1)最初に「 Ollama 」タブをクリックして選択します。
(2)有効にチェックします。
(3)BaseURL に「 http://localhost:11434 」と入力します。
(4)LLM のモデルが Llama-3-ELYZA-JP-8B 場合、モデルには「 elyza:jp8b 」と入力してください。

モデルの設定部分については、何と設定すればいいのか? 当初わからなくて困ったのですが、コマンドプロンプトで Llama-3-ELYZA-JP-8B を実行する時に入力するコマンドが

C:\Users\ユーザー名\.ollama>ollama run elyza:jp8b

であることから、モデルの設定は「 elyza:jp8b 」に違いない!と考え、実際その設定で動作しましたので、多分、これで OK なのではないかと・・・思われます。

入力が終わったら「保存」ボタンをクリックして、オプション設定のダイアログを閉じてください。

6.DelphiのIDEのスマート支援機能を使う

さっそく使ってみます。既存のプロジェクトファイルを開くか、新規にアプリケーションを作成して、コードエディタが表示された状態にします。

編集画面の余白部分を右クリックすると、次の図のようにポップアップメニューが表示されるので、そのいちばん上にある「 Smart CodeInsight 」をポイント(or クリック)します。すると、さらにサブメニューが表示されます。

全部! 試してみたい機能ばかり☆


AIチャットをクリックしてみました☆

Ollama>に質問を入力すればよさそうです!


質問してみました!


少し、待ち時間がありましたが、待ちくたびれるほどではありません。ちゃんと計ったわけではありませんが 30 秒くらいかなー? AI の返事が表示されました。

表示されたコードは Object Pascal ではありませんでした!


質問に「 Object Pascal で書いて!」という内容を追加して再チャレンジ。

すごーい! すごーい!!


ふと思い立って・・・ DelphiのIDEのコードエディタに「VB.NET」のコードを貼り付けて、

ムチャしてます・・・


コード全体を選択して、コードの変換を試してみます。

「Delphi に変換」をクリック


かなり待ち時間がありましたが・・・

結果が表示されるまで、上のような画面になります。


3分くらいかな? ちょっと長かったけど、無事、変換できました!

すごーい! すごーい!!


もし、わからないコードがあった時は・・・

わからないコードを選択して、「コードの説明」をクリック


すると・・・

すごーい! すごーい!!


感動!

7.まとめ

(1)Ollama をインストールすれば、ローカルな環境でも LLM を利用した生成 AI を使用できる。
(2)LLM は Ollama で標準サポートされているものなら、run するだけで使える。
(3)Ollama で標準サポートされていない LLM でも gguf ファイルから create して使用できる。
(4)Delphi のIDEのスマート支援機能で Ollama を指定すれば、無料でローカル LLM を使える。
(5)GPU がないPCでも(待ち時間はあるが)スマート支援機能は使えそうな気がする。

8.お願いとお断り

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

それは冷蔵庫のドアの警報音じゃなくて・・・

このところ、料理にハマっている・・・。自分の人生で、お湯を沸かす以外の目的でキッチンに立つことは絶対にないだろうと、これまでずっと思っていたし、実際、何十年もその通りだったのだ、けれど。

ふとしたことから、マニュアル通りにやれば、自分にも美味しい料理が作れることに気が付いてしまったのだ・・・。

それは、それですごく良かったことなんだけれど、今日、起きたトラブルは・・・

1.冷蔵庫のドアの汚れに気付く

そんなこんなで休日の昼食は、このところ、自分で作ることが多くなった。そのために調味料もそろえたし、調理用具も買った。まさか、こんな日がくるなんて思いもしなかったのだけれど、もうかれこれ3ヶ月くらい、休日は自分で作る昼食を続けている。

今日、いつもと違ったのは、冷蔵庫のドアが、いつの間にか、結構汚れていることに気が付いてしまったことだ。もちろん、気が付いた以上、掃除をしないわけにはいかない!

冷蔵庫のドアには、閉め忘れを防止するためのセンサーが付いているから、ドアを開けたまま掃除していると、当然、警報音が鳴る。

ピピッ ピピッ

もちろん、警報音は無視。エタノールを含んだウェットティッシュで、ひたすら汚れを落とす。

ピピッ ピピッ

( わかってるよー )

ピピッ ピピッ

やっと、きれいになった!
ドアを閉めて・・・ひと安心、これで、やっと昼食が作れる。

2.昼食を作り、食べて、片付けてたら・・・

水から、調味料まで、すべてレシピ通りに計量し、調理時間も最近は一家に1台はあるんじゃないか?みたいな、いわゆる「スマートスピーカー」とか「スマートアシスタント」と呼ばれる アレ! に正しく計測してもらう。計測中の自分自身の動きも毎回同じなので、ほとんど調理ロボットだ。

料理は何の問題もなく完成。一緒に暮らしている人にもおすそ分け。この上ないくらい、しあわせな休日のお昼ごはんTimeを過ごす。レシピを作り、公開してくださった方に、心から感謝!

食べたら今度は後片付けだ。自分で言うのもナンだけど、洗い物も別に苦にならない。調理器具がキレイになると、すごくうれしいし、乾燥させた後は一緒に暮らしている人が片付けてくれるので、とにかくキレイに洗えば、それでOK!

以前は食洗器を使っていたのだが、なんか調子が悪くなって、いつの間にか、使うのをやめてしまった・・・。あの頃は、食洗器に洗い物を並べるのが「食べる」以外の部分で、自分と料理との唯一の接点だったのだけれど。

(変われば、変わるもんだよなー)

そんなことを思いながら、お皿を洗っていると・・・

ピピッ ピピッ ピピッ ピピッ ピピッ・・・

間違いなく、警報音が聞こえる。背後にある冷蔵庫をじっと見つめる。見た目、ドアはきちんと全部しまっている。いちおう、全てのドアを手で押して確認。動くドアは「ない」。つまり、間違いなく、すべて完全に閉まっている。なのに、しばらくすると・・・

ピピッ ピピッ ピピッ ピピッ ピピッ・・・

冷蔵庫のドアについている操作パネルを適当にいじって見る。警告の表示は見当たらない。なのに、また、しばらくすると・・・

ピピッ ピピッ ピピッ ピピッ ピピッ・・・

どうやら、1分間隔で警報音が鳴るようだ。しかし、その原因がわからない・・・

もしかして、冷蔵庫のセンサーが壊れた?

そう思いたくなったのが、正直で、本当の気持ち。

(気持ちは本当ですが、メーカーさんの名誉のために一言。冷蔵庫に問題はありませんでした)

3.いっしょに暮している人に相談する

一緒に暮らしている人は、ある理由から一般ピープルよりも家電に強い(と思う)。だから、とりあえず言って見た。

「冷蔵庫のドア閉め忘れの警報音が鳴りやまないんだけど・・・」

たたたた(駆け出す音)、一緒に暮らしている人は、行動もとても素早い。自分自身は、その後ろ姿を見送ったあと、しばし、炭酸水で乾いた喉を潤す。んで、しばらくしてからキッチンへ降りてみると、どこにしまってあったのか、冷蔵庫の操作マニュアルが伝家の宝刀のように取り出され、広げられていて・・・

一緒に暮らしている人が、まるで大発見でもしたかのように断言。

「警報音が鳴るときは、こんな表示が出ると書いてあるけれど、表示が一切ない!」

冷蔵庫のディスプレイを見れば、それは明らか。
なんの表示もない。それなのに・・・

ピピッピピッピピッピピッピピッ・・・

1分経過するごとに、規則正しく、警報音は鳴り響く。

「原因不明。がんばったけれど、もぉ無理。」

「こうなったら、お客様相談室に電話しよう!」

さすが同居人。あきらめも潔い。言うが早いか、家電を持って、ピッポッパ。

4.原因判明

「少々、お尋ねしたいのですが・・・」

「はい、警報音が消えなくて・・・」

「冷蔵庫には、操作マニュアルにあるような表示が出なくて・・・」

「でも、警報音が・・・」

お客様相談センターの係員の方から、ここで何か、アドバイスがあったらしく・・・

「あっ、はい。ガスコンロですか? はい、あります。冷蔵庫の前です。」

「へっ」・「あっ!」

なんと警報音を出していたのは、ガスコンロの鍋無し検知機能だったのです!

調理の最終段階で、鍋の保温のため、ガスコンロの火力を最小にして、そのまま鍋を外して火を消し忘れ、その「ガスコンロを切らない」ままの状態で、そのこと自体を忘れて放置・・・

規定の15分が経過。コンロは安全装置が働いて、自動消火。ただ、着火レバーはONのままなので、冷蔵庫ではなく、冷蔵庫のそれに非常によく似た、ガスコンロの警報音が、鳴り続けることに。

でも、自分は、最初に聞こえたドア解放の警報音から、音源は冷蔵庫だと思い込んで。
それを伝え聞いた、一緒に暮らしている人も、音源は冷蔵庫だと思い込んで、いるから・・・

お互い、まさか、それがガスコンロの警報音だなんて、夢にも思わず・・・

冷蔵庫の、ひたすら平らなドアは、真向かいにあるガスコンロの警報音をよく反射する・・・

そう、まるで自分がそれを発しているかのように。

5.M社のお客様相談センターのスタッフの皆様へ、心から感謝申し上げます。

それにしても、凄いのは、一緒に暮らしている人の言葉を丁寧に聞き取って下さり、問題の真の原因にいち早く気が付いて教えてくださったM社のお客様相談センターのスタッフの皆様のご対応です。

ご対応から、拝察すると、おそらくは同じような事例が、過去に多々・・・

優しく、丁寧に、ご案内してくださっただけでなく、最後に「ご迷惑をお掛けして」とお詫びの言葉まで頂戴し。

M社の冷蔵庫は最高です!
購入してはや8年、ただの1度も不具合なく、日々、勤めを忠実に果たし、
期待通りの冷たさで、ありとあらゆる食材を冷やし続けてくれています。

壊れたなんて、疑って、ほんとうにごめんなさい。

6.まとめ

(1)ガスコンロの消し忘れ警報音は、冷蔵庫のドア閉め忘れの警報音によく似ている。
(2)キッチンで警報音が鳴り響いたら、冷蔵庫だけを疑ってはいけない。
(3)ガスコンロを使用したら、最後にレバーのOFFを必ず確認する。

プログラミングも、調理も、安全確認という最も重要な部分は、まったく同じでありました。そのことに思いを深くした、誠に貴重な経験でありました・・・が、もしも、もしも可能なら☆

「これは、冷蔵庫のドア閉め忘れの警報音です」とか、「これは、ガスコンロの鍋無し検知機能の警報音です」って、個別に案内してもらえると、まったく混乱せずに済んだので、最高に良かったかもですが。

そんな、わがままは、置いといて・・・

ガスコンロのレバーをOFFにし忘れても、自動的に消化するという、画期的な安全装置の開発者の方々にも、心から、心から、感謝です!

火事にならなくて、よかったー!!

Excelのプロセスを終了させる

プログラムがフリーズするなどして、実行中の Excel のプロセスが残ってしまうことがある。また、そうでなくても、例えば Delphi の Try ~Finally 文で、確実に Excel のオブジェクトを解放したつもりであるにもかかわらず、プログラムで読み書きした特定の Excel のファイルが「編集のため、ロックされています」と表示され、「読み取り専用」でしか開けなくなり、Ctrl+Alt+Del でタスクマネージャーを起動して確認すると、場合によっては5つも6つもExcelのプロセスが実行中であったり、する。

そこで Delphi で書いた Excel のファイルを操作するアプリケーションを終了する際に、実行中のプロセスが残らないようにする方法を考えてみた。

【もくじ】

1.確認メッセージを表示して終了させる
2.確認メッセージを表示せずに起動中の全てのプロセスを終了させる
3.お願いとお断り

1.確認メッセージを表示して終了させる

最初に書いてみたのがコレ!
Excel のプロセスが実行中であれば(残っていれば)、確認メッセージを表示して、プロセスを強制的に終了させる。ただし、このコードで終了できるプロセスは1つのみ。

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;

ただ、コレだと、もし、Excelのプロセスが実行中であった場合、アプリケーションの終了時に突然表示されるメッセージに、ユーザーが驚き、「はい」・「いいえ」のどちらを選べばいいのか、操作上の混乱が生じる可能性があるように思えてきた・・・。

それに、複数の Excel のプロセスが実行中であった場合、この方法では1つしか、終了できない。

そこで、ユーザーには何も知らせずに、もし実行中の Excel のプロセスがあれば、バックグラウンドですべてのプロセスを終了させるようにプログラムを修正。それが次の「確認メッセージを表示せずに起動中の全てのプロセスを終了させる」例。

2.確認メッセージを表示せずに起動中の全てのプロセスを終了させる

実行中の全ての Excel のプロセスを強制的に終了させる。ユーザーに対する確認メッセージは表示しない。

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;

これが、いちばんスマートかな?

3.お願いとお断り

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

デジタル採点 All in One !

これまでに書いてきたデジタル採点プログラムをひとつにまとめました!

手書き答案採点・マークシートリーダー・採点結果通知&成績一覧表の作成プログラム


「AC_Reader」は、手書き答案のデジタル採点に、「MS_Reader」は、マークシート形式の試験のデジタル採点に、それぞれ使用します。

「ReportCard_2024」は、「AC_Reader.exe」及び「MS_Reader.exe」と連携して動作するプログラムで、受験者へのデジタル採点の採点結果を通知する個票及び採点者用の成績一覧表を作成することが出来ます。

「デジタル採点 All in One! 」では、3通りのデジタル採点の実行と、受験者に採点結果を通知する個票及び成績一覧表の作成が可能です。その概要は次の通りです。

1.マークシートの読み取りとデジタル採点
2.手書き答案のデジタル採点(縦書き・横書き、両方の答案に対応)
3.マークシートと手書きを併用した試験のデジタル採点

ただ、プログラミングには素人である筆者が作成したプログラムですので、使いにくいのはもちろんのこと、未発見の不具合もまだきっとあると思います・・・が、掲載したプログラムはすべて「実際に採点の現場で使用」し、動作確認を行ったもので、その際に発見できた不具合はすべて修正してあります。したがって、筆者の想定する範囲内での運用であれば、確実に動作するはずですが、ご使用に際しては事前に必要十分な試行・動作確認を行っていただけますよう、心からお願い申し上げます。

掲載したプログラムは、何の保証もサポートもありませんが、すべて無料でお使いいただけます。ただし、ご使用に際しては、完全に自己責任での運用をお願いいたします。ここに記載した内容及びダウンロードしたプログラムを利用した結果、利用者および第三者に損害が発生したとしても、このサイトの管理者は一切責任を負えません。予め、ご了承ください。

プログラムは今後も改良し続け、掲載したプログラムは随時改良版に更新する予定です。
見た目も、内容も不出来なプログラムですが、万一にでも、使ってくださった方の採点業務のご負担の軽減に貢献できましたなら、私にとって、それは何よりの喜びです。

プログラムのダウンロード(ZIPファイル)

プログラムのダウンロード後、任意の場所に展開してください。

【心からのお詫び】

2025年3月29日に「観点別評価と評定の整合性をチェックする」という記事を公開した際、誤ってこちらのダウンロードリンク先のファイルを削除し、そこに「観点別評価と評定の整合性をチェックするプログラム:ABC_Checker.exe」を置いてしまいました。そのため、2025年3月29日午前5時すぎから、2025年4月1日午後6時頃まで「DigitalSaiten_All_in_One.zip」がダウンロードできない状況でありましたこと、心よりお詫び申し上げます。ほんとうに、こころから、ごめんなさいです。

【もくじの前書き】

今回の記事では、採点プログラムそれぞれについて、ダウンロードしていただいたZIPファイルを展開すればすぐに試せる簡単な試用方法をご紹介しています。

実際の試験においては、スキャナーを使用してマークシートや手書き答案の画像化処理を行ったり、専用プログラムを使用して、マークシートや手書き答案の解答欄の座標を取得する等、採点の事前準備作業が必要です。

ダウンロード後展開していただいたZIPファイル内のファイルやフォルダの構成及び以下の説明の内容は、それらの必要な事前準備作業を終えた段階以降の『実際の採点作業部分のみ』を手軽にお試しいただけるように作成してあります。それぞれ、説明の通りに操作していただけたら幸いです。

操作に際し、予期しないエラーが出た場合の対処方法や、実際の試験の採点に必要な事前準備作業の詳細は、以下の説明の中でご紹介する「過去記事のご案内」リンク先の各採点プログラムの取扱い説明記事をご参照ください

【もくじ】

1.マークシートの読み取り
2.手書き答案のデジタル採点
3.マークシートと手書きを併用した試験のデジタル採点
4.採点結果通知の作成
5.お願いとお断り

1.マークシートの読み取り

プログラムアイコン


【スクリーンショット】

マーク読み取り実行直後の画面


マークシートは、市販のものでなく、再生コピー用紙にインクジェットプリンタで印刷したものを使用します。輪転機で印刷するとマークが濃く印刷されてしまい、「複数マークあり」の誤判定が出やすくなります。ですので、マークシートの印刷には、インクジェットプリンタを使用してください。

シートの左上には特徴点(例:■■■)が必要です。プログラムはマーク読み取り時に、まずシート内の特徴点を探し、そこからの距離情報をもとに一つ一つのマークを切り出して塗りつぶし面積を計算、マークの有無を判定しています。

マークシートの画像は、複合機等のスキャナーで200dpiの解像度でスキャンして作成してください。解像度を大きくしても読み取り処理に必要な時間が大幅に増加するだけでメリットは何一つありません。

デジタル採点の現場で実際に使用した様々な形式のマークシートを添付しましたので、こちらを印刷してお試しください。オリジナルマークシートの作成方法は、添付したPDFファイル「01_マークシートリーダーご利用の手引き」の「7 マークシートの作り方」をご参照ください。

【添付したマークシート】

・1列25行×4列(100設問まで対応)、選択肢は1始まりで8選択肢(A4横R25C04S08)
・1列25行×3列(75設問まで対応)、選択肢は1始まりで10選択肢(A4横R25C03S10)
・1列25行×2列(50設問まで対応)、1始まりで8選択肢。右余白は手書きの解答欄に使用。
・1列25行×3列(大問3個に対応)、16選択肢の数学用(2枚1セットで大問6個に対応)
・1列25行×3列(75設問まで対応)、選択肢は0始まりで16選択肢の教科「情報」用
・1列25行×4列(100設問まで対応)、大語群(選択肢番号は0~99まで使用可能)マーク試験用


マークシートのサンプル①

一般的な塗りつぶす形式のマークシートです。実際の試験の現場で過去5年以上使用しています。読み取り精度が問題になったことは一度もありません。

塗りつぶすマークシート(Wordで作成)


マークシートのサンプル②

線でマークすれば、大語群を使用する試験で解答に要する時間を大幅に短縮できます。ちなみに、芯の太さ0.9mm、硬さ・濃さ2Bのシャープペンシルを使用してマークし、読み取りテストを行ったところ、読み取りパラメータの設定はデフォルト値のまま、すべてのマークを正しく読むことができました。

例:線で「35」をマーク(Excelで作成)


MS_Reader.exe の詳しい使い方は、当Blogの過去記事をご参照ください。
(プログラムを動かすために必要な諸設定についての情報も記載しています)

【過去記事のご案内】

重要 数学採点用途で使用される場合は、当Blogの過去記事「マークシートリーダーを数学用に設定」にあります使用方法を必ずご確認ください。


今回掲載したプログラムには、すぐにお試しいただけますよう、マークシート情報設定済みのサンプルを添付してあります。ファイルのダウンロード及び展開に時間がかかるデメリットはありますが、マーク読み取りを圧倒的に高速化するPython4Delphi(=P4D環境)も今回は、ダウンロードサイズと展開時間を顧みず、敢えて同梱しました。ですので、ここでご紹介する筆者作のマークシートリーダーは自動的にPython環境を使用する高速読み取りモードで起動します。

以下、Zipファイルのダウンロード後、ファイルを任意のフォルダに展開した後の、筆者作マークシートリーダーの試用方法です。

(1)MS_Reader を起動

MS_Reader.exe をダブルクリックして、MS_Reader を起動します。MSはもちろんマークシートの略ですが、筆者のイニシャルが M.S なので、それにもかけてあります。

ここで発生すると思われる不具合とエラーの解決方法は、当Blogの次の過去記事をご参照ください。


(2)マークシートの情報を記録したテンプレートを選択

画面左上のメニューの「2 テンプレート」をクリックすると表示されるサブメニューの「テンプレートの選択」をクリックします。


(3)リストボックスに表示された候補から「N_R25C04S08」をクリックして選択し、「決定」ボタンをクリックします。


ちなみに、テンプレート名の N は、解像度200dpiでスキャンした際の画像ファイルの大きさをノーマルと考えて画像サイズから自動で付けています。

その後ろのR、C、D、Sはそれぞれ次のような意味です。

RはRow、すなわち「行」です。R25なら1列あたり25行のマークシートを意味します。
CはCol、すなわち「列」です。C04なら4列で構成されたマークシートを意味します。
DはDouble、複数マーク可能なマークシートを意味(19選択肢のシートのみ設定可能)。
SはSingle & Select、複数マーク不可で、S08なら選択肢の数は8個のシートを意味します。


(4)表示されるメッセージを読んで、「はい」をクリックします。


(5)「Sample_Data_01_一般用」フォルダをクリックして選択し、「OK」をクリックします。

選択するのは「フォルダ」で、「ファイル」ではありません!


(6)正しくプログラムが動作していれば、画面は次のようになります。

バックグラウンドで動作するPython環境のOpenCVが特徴点画像(■■■)を探し出し、赤枠の矩形でそれを囲んで表示します。同時に、Delphi側のプログラムでテンプレートに記録したマークシートの座標情報を読み込み、最も左側の列の第1行目の選択肢欄を赤枠で囲んで表示します。これでマークシートの読み取り準備が出来ました!


(7)操作方法を案内するバルーンが表示されますので、その先にある「読む」ボタンをクリックしてください。プログラムがマークシートのマークを読み取り、結果をグリッドコントロール上に表示します。


筆者のPCでは、Python4Delphi(P4D)を利用した状態で、1枚100設問(800マーク)×3枚で合計2400マークを986ミリ秒で読み取り、結果を表示しました。1マーク2.43ミリ秒、1枚329ミリ秒で読み取っていますので、この形式(25行×4列・8選択肢)のマークシートを使用した場合、筆者の環境では平均的な1クラス分(40名)を約13.2秒で読むものと推測できますが、使用するPCの性能によりこの値は変化します。


(8)「Check!」ボタンをクリックして、読み取り結果をヒトの目でチェックします。次の例のように、読み取り結果の確認(修正)が必要と思われる箇所で赤枠を表示してチェックプログラムは一時停止します。

【空欄(マークなし)と判定した場合】

「空欄(マークなし)」と判定した場合、グリッドコントロール上には「999」と表示されます。
なお、「白紙(全マークが空欄)」のマークシートは読み飛ばす設定が可能です。


【複数マークありと判定した場合】

「複数マークあり」と判定した場合、グリッドコントロール上には「99」と表示されます。
マークの状況を確認し、必要な場合は読み取り結果を直接入力して修正します。


読み取り結果の確認・修正後、再度「Check!」ボタンをクリックすると、一時停止が解除され、チェックが続行されます。次のメッセージが表示されたら、読み取り結果のチェックは終了です。


(9)読み取り結果の書き出しを実行

マークの読み取り結果はCSV形式でファイルに出力できます。表計算ソフトを利用して読み取り結果を処理する場合はもちろんですが、筆者が作成した「ReportCard_2024.exe」を用いて、採点結果を受験者に通知する個票を作成する場合は、必ずここで読み取り結果をCSVファイルに書き出す作業を行ってください。

読み取り結果をCSVファイルに出力


同梱の「ReportCard_2024.exe」を用いて、採点結果通知を作成できます。こちらのプログラムの使用方法は後述します。


「ReportCard_2024.exe」を用いた採点結果通知の作成例です。

設問ごとに採点結果と観点別評価の区分及び正解マークを表示できます。
また、任意の位置に得点を表示できます。


(10)その他の機能

MS_Reader には、マーク読み取りに加え、読み取り結果の音声読み上げ機能や、チェックのスキップ機能など、筆者が必要と考えた機能を搭載してあります。使い方の詳細は、当Blogの過去記事(上のリンク先)にありますので、必要に応じてご参照ください。

2.手書き答案のデジタル採点

プログラムアイコン


【スクリーンショット】

横書き答案の採点実行時の画面
(添付した答案枚数3枚の採点サンプルを使用)


採点する答案は、横書き・縦書きを問いません。どちらの形式の答案でも採点可能です。また、複合機のスキャナーで読み取り可能な大きさであれば、解答用紙のサイズも問いません(ただし、採点する答案すべてのサイズと解答欄の形式は同じである必要があります)。前述のマークシートでは、解答用紙の左上に特徴点(■■■)が必要でしたが、こちらの手書き答案の採点補助プログラムでは必要ありません。

答案画像は複合機のスキャナー等を用いて、解像度200dpiでスキャンしたカラー画像を使用してください。解答欄矩形は、採点準備作業時に、別に作成した矩形検出プログラムを用いて解答用紙画像より検出・座標データを取得してiniファイルに保存します。手書き答案の採点プログラムは、この座標データをもとに解答欄矩形を答案画像から切り出して、切り出した解答欄を画面に並べて表示します。

解答用紙の解答欄を作成する際は、矩形検出されたくない部分を点線で作成していただく必要がありますが、これさえ守っていただければ、かなりスムーズに解答欄矩形の検出作業(座標データ化)が行えると思います。実際に採点に入るまでに必要な採点準備作業の詳細は、当Blogの過去記事をご参照ください。

解答欄の作成例:矩形検出されたくない部分の罫線は点線を使用します。
これにより設問番号を含んだ解答欄矩形の切り出しや、
字数を指定しての解答欄作成が可能になります。


【過去記事のご案内】


今回掲載したプログラムには、すぐにお試しいただけますよう、採点準備作業を行ってあるサンプルを添付してあります。以下、手書き答案採点補助プログラムの試用方法です。

(1)AC_Readerを起動

AC_Reader.exe をダブルクリックしてプログラムを起動します。AC は Answer Column(解答欄)の略です。プログラム起動時(初回)に次のメッセージが表示されます。

PCのボリューム設定値が0より大きい場合に表示されるメッセージです。

消音して作業できます。
(ボリューム設定値が0の場合は、表示されません)


採点作業内容の確認メッセージです。

必要に応じて「はい」・「いいえ」のいずれかをクリックします。


「いいえ」をクリックすると、次のメッセージが表示されますが、これは表計算ソフトを使用して採点結果通知を作成していた頃の名残りで、表計算ソフトを使用せずに採点結果通知の作成ができるようになった現在はどちらから採点を始めていただいても問題は生じません。


試用される場合、次のメッセージには「いいえ」を選択(クリック)してください。

添付した採点試行用のサンプルは「横書き」です。


初回起動時には複数のメッセージが表示されますが、次回起動時からこれを表示しない設定にすることができます。お好きな方のボタンをクリックしてください。


あらゆるケースを想定した場合、このようなメッセージも必要と判断しました・・・。
(確か、採点結果通知の個票作成プログラムで、合計点を計算するコードを書いていた際に「何か」問題が起きて、このメッセージを表示することにしたような記憶があります)


お断りしたように不出来なプログラムですので、こちらの注意も必ずお守りください。


同じく、こちらの注意も必ずお守りください。


採点方法のご案内です。複数のユーザーより、「前回の採点から2~3か月も経過すると忘れてしまう!」との指摘がありましたので起動時に採点方法を案内するメッセージを表示するようにしました。


このメッセージは、プログラムの画面右下にある「入力方法のご案内」ボタンをクリックすれば、いつでも表示することができます。


(2)既存の採点設定を選択

試用に際しては、筆者が設定・保存した採点設定をお使いください。
画面右上にある「採点作業」ボタンをクリックします。


次のメッセージが表示されますので、「はい」をクリックしてください。


採点設定ファイルの選択を促す案内バルーンが表示されます。
ComboBox右端の∨をクリックしてください。


表示された選択肢の「テスト採点.ini」をクリックして選択します。


(3)続けて採点したいクラス/講座の答案画像が保存されているフォルダを選択します。


上のメッセージの「OK」をクリックすると、フォルダの選択ダイアログが表示されます。

「Sample_Data_04_Markと横手書併用」フォルダをクリックして、「OK」をクリック


(4)採点を実行

最初にフローティング状態のパネルを適切な位置へ移動します。

フローティングパネルのタイトルバーをクリックして任意の位置へD&Dします。


点数を一括入力する場合は、「入力と確認」のComboBoxから入力したい値を選択して「入力」ボタンをクリックします。選択した値がすべての解答欄に設定されますが、入力値が「0」であれば×、そうでない場合は○と得点が表示されます。


個々の採点は、採点したい解答欄の中央付近をクリックして、採点方法の案内にあった方法で採点します。


(5)採点結果の保存

採点結果を答案画像に書き込むには、フローティングパネルの「書込」ボタンをクリックします。

重要 作業の状態は「書込」ボタンをクリックしたところまでが保存されます。「書込」ボタンをクリック後はいつでも終了できます。

重要 採点は何度でもやり直すことができます。


何設問目まで採点したかについては、答案画像を表示して確認できます。

「返却用答案を表示」にチェックを入れると、現在採点している答案画像が表示されます。


◀ボタンや▶ボタンをクリックして表示する答案を変更することができます。


(6)返却用答案及び成績一覧表の作成

手書き答案の採点プログラムには、単独で受験者に返却する答案の印刷や教科担任用の成績一覧表を作成する機能があったのですが、今回、新しく採点結果通知作成プログラムを作成しましたので、独自に返却用答案を作成する機能はCut(正確には非表示に)してあります。

今回、新しく作成した採点結果を通知する個票及び教科・科目担任用に成績一覧表を作成するプログラム「ReportCard_2024」は、「返却用答案&成績一覧作成」をクリックすると起動できます。


「ReportCard_2024」の使い方は、この後の説明をお読みください。

3.マークシートと手書きを併用した試験のデジタル採点

次のような解答用紙を用いて、マークシートと手書きを併用した試験を実施・採点することも可能です。


採点は、マークシート部分のマークの読み取りはMS_Readerで、手書き解答欄の採点はAC_Readerでそれぞれ行ってください。

MS_Readerを用いてマークの読み取りを行った後はCSVファイルに読み取り結果を出力、AC_Readerを用いて手書き答案の採点を行った後は採点結果を「書込み」ボタンをクリックして自動保存(保存先ファイル等を指定していただく必要はありません)していただければ、採点結果通知の作成準備も内部的に完了します。

どちらの採点を先に行うかについて、その作業順は問いませんが、マークシートの採点→手書き答案の採点という流れの方がプログラムが表示するメッセージの内容に矛盾を感じることなく作業できると思います。

採点終了後、次にご案内する採点結果通知を作成するプログラムで、それぞれの試験の合計得点を計算します。

4.採点結果通知の作成

プログラムアイコン

【スクリーンショット①】

受験者への採点結果通知の作成例


【スクリーンショット②】

採点者用の成績一覧表の作成例
氏名データは架空のものです。また、得点データが2件しかないのは添付した試用サンプルを用いて作成したためです。

ReportCard_2024の使い方

(1)起動

ReportCard_2024.exe をダブルクリックしてプログラムを起動します。PCのボリューム設定値が0でない場合は、Beep音を消音するかどうかを確認するメッセージが表示されます。


(2)採点作業を選択します。

ここでは併用タイプを選択しました。


(3)採点対象の答案画像を保存したフォルダを選択します。

「開く」ボタンをクリックします。


採点対象の答案画像を保存したフォルダを選択します。


(4)採点設定がある場合

既存の採点設定がGridコントロールに表示され、採点できる状態になります。

「実行」ボタンをクリックして採点を行ってください。


マークシートの採点の場合、形式の確認メッセージが表示されます。


マークシートの採点の場合、使用したテンプレートを指定します。


採点結果は次のように表示されます。

【マークシート部分①】

デフォルト設定では、左から「採点記号・配点・観点別評価の区分」がそれぞれ表示されます。


【マークシート部分②】

空欄もしくは誤りがある設問には正解の選択肢が数字で示されます(デフォルト設定を利用した場合)。


【手書き答案部分】

観点別評価の区分を表示することはできませんので、受験者に口頭で区分を説明する必要があります。

得点は下の例のように表示されます。得点の表示位置は任意の位置を選択・設定を保存できます。

手書き答案部分には「採点記号と得点」が表示されます。
(観点別評価の区分を表示することはできません)


(5)採点設定がない場合

次のメッセージが表示されます。内容をよく読んで「OK」をクリックしてください。


設問数を入力し、「入力完了」をチェックしてください。


操作方法を案内するメッセージが表示されます。


入力をクリックします。


デフォルトの配点を設定します。入力は半角数字で整数を入力し、「OK」をクリックしてください。


マークシート用の採点設定には「正解の選択肢の番号」・「配点」・「観点別評価の区分」をそれぞれ入力してください。また、手書き答案用の採点設定には「配点」・「観点別評価の区分」を入力してください。


採点設定を入力後、「保存」ボタンをクリックして、設定を保存してください。


採点設定の保存が完了すると、採点の「実行」ボタンがクリックできる状態になります。


(6)採点結果通知個票の印刷

「印刷」ボタンをクリックしてください。


出力先プリンタ・用紙・印刷の向きを指定して「OK」をクリックしてください。
元々の答案のサイズがA3やB4であっても、用紙サイズでA4を指定すれば縮小印刷されます。


答案すべてを印刷するか、個別に印刷するか、いずれかを指定してください。


「いいえ」(個別印刷を選択)を選んだ場合は、印刷したい答案の番号を指定してください。


印刷例です。


(7)成績一覧表の作成と印刷

成績一覧表の作成の「講座名票」ボタンをクリックします。


受験者の氏名等のデータを保存したCSVファイルを選択します。

予めsNameフォルダ内にクラス・講座の氏名データを所定の様式で作成・保存してください。


【参考:氏名データの様式】

クラス・出席番号は「半角」で入力、氏名・よみがな・性別は「全角」でそれぞれ入力し、CSV形式でsNameフォルダ内に保存してください。

フィールド名は入れないでください。
(添付したデータは架空のものです)


平均点を正しく計算するため、試験を欠席した受験者を計算対象から除く処理を行います。
「欠席者をチェック」のCheckBoxをチェックしてください。


得点の合計が「0」の受験者について、平均点の計算処理の対象とするか・しないかを指定します。「はい」をクリックした場合は、成績は「空欄」扱いとなり、平均点の計算対象からは除かれます。
「いいえ」をクリックした場合は、その受験者の得点合計は0点であったものとして平均点を計算します。


印刷プレビューを表示します。「PreView」ボタンをクリックしてください。


添付したファイルのデータはすべて架空のものです。

添付したサンプルデータが3件しなないため、このような表示となっています。


「印刷」ボタンをクリックして印刷します。「CSV出力」ボタンをクリックすれば、CSVファイルに出力することも可能です。表計算ソフトを利用した追加の処理にお役立てください。


CSVファイルのファイル名は自動的に設定されます。また、CSVファイルは処理対象の答案画像があるフォルダ内に出力されます。

「保存」ボタンをクリックしてください。


保存処理が完了すると、次のメッセージが表示されます。


「はい」をクリックした場合、エクスプローラーが起動し、保存先フォルダを開きます。
「いいえ」をクリックした場合は、CSVファイルの保存先を示すメッセージが表示されます。

「はい」をクリックした場合、エクスプローラーが起動し、保存先フォルダを開きます。

5.お願いとお断り

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

[dcc32 致命的エラー] F2039 ファイル ‘.\Win32\Release\project1.exe’ を作成できません


Delphiで「実行(F9)」すると、時々、コレが・・・

コンパイル結果の表示

さらに・・・

メッセージにも(泣)


原因は人それぞれなのかもしれませんが、私は以下の方法でこれを解決できました!

【これまでの解決方法】

既存の「xxx.exe」を手動で削除して、再度「実行(F9)」。
今までは、ずっとこの方法で対応。

【新しい解決方法】

「プロジェクト」ツールウィンドウの xxx.exe を右クリックして、


表示されるメニューの「クリーンアップ」をクリック。


「クリーンアップ」というタイトルの画面が表示され・・・


「成功」!


これで「実行(F9)」で、再び exe が生成されるようになりました。

【まとめ】

「実行(F9)」時に exe を作成できない場合は、プロジェクトツールウインドウの exe を右クリックして「クリーンアップ」を実行する。

【お願いとお断り】

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

StringGridのデータを印刷プレビューして印刷

Delphiで、どうしても書きたいプログラムがあった。
そのために絶対に越えなければならないハードルが、データの印刷プレビューと印刷だ。

正直、これは、ごく簡単に思えてならないことなんだけれど・・・
今まで何度もチャレンジして、そのたびに失敗してきた。。。

今回、ようやく、自分自身、納得の行くものが書けた。
これはその備忘録。

【もくじ】

1.印刷したいデータを準備
2.罫線も印刷する
3.CSVファイルをStringGridに表示する
4.印刷のコード
5.rect:TRectとしてはいけません!
6.印刷プレビューのコード
7.まとめ
8.お願いとお断り

1.印刷したいデータを準備

表計算ソフトを使って、印刷したいデータを作成し、CSV形式で保存する。
例えば、こんな感じ。

データはすべて架空のもの


書きたい印刷プログラムは、A4版・縦の用紙に収まる範囲の列数で、行数は1ページに最高50行を予定。ただし、データとして50行なので、フィールド名を入れれば1ページあたり51行となる。

CSVファイルの先頭には「フィールド名も保存」する。ただし、フィールド名があるのはファイルの先頭のみ。50行ごとに入れたりはしない。

自分の場合、印刷データが50行を超えることは、まず「ない」・・・のだが、冒頭で述べた「どうしても書きたいプログラム」の使用予定者の中にはそうでない方もいる。

なので、書きたいプログラムでは、データ数(=行数)がどんなに増えても、各ページの先頭行にはフィールド名を入れる仕様とする。これは譲れない自分との約束。

2.罫線も印刷する

これも、どうしても越えたいハードルのひとつ。フォントの大きさに関係なく、1行毎に罫線(=下線)を印刷する。もちろん、「罫線無し」の印刷も可能とするが、「罫線有り」の場合は1ページについて必ず51行分の罫線が引かれるのではなく、印刷する行数に合わせて罫線(=下線)を引くようにしたい。

今まで、これがどうしても「できなかった」。

だから、この壁は必ず乗り越える。これも譲れない自分との約束。


追記(20240901)

フォントの大きさは9ポイントに固定しました。

3.CSVファイルをStringGridに表示する

Delphiを起動。次の構造ペインに示すような形でVCLコントロールをForm上に配置。

最低限必要なVCLコントロール
AlignやVisibleなど、各プロパティは必要に応じて設定


Formは常に最大化して表示されるように設定。FormCreate手続きに次のコードを記述。

procedure TForm1.FormCreate(Sender: TObject);
begin
  //Formを最大化して表示(幅も最大化される)
  Form1.WindowState:=wsMaximized;
end;

この場合は、Form1が親だからこれでOKだが、子の場合は注意が必要。

どこに記述するか?
・自分自身が親Formの場合:FormCreateでOK!
・自分自身が子Formの場合:FormShowに書くこと(FormCreateに書くと一般保護違反のエラーが発生する)
・自分自身が子Formの場合にFormのWindowStateプロパティで直接指定しておいたらMy環境では何の問題もなく動作した。

また、Form1のScaledプロパティをFalseに設定することも忘れない。

これはどんなプログラムでも必ず最初に設定する


これをTrue にすると OS の DPI (ユーザが指定した DPI)によってフォームサイズやコントロールサイズが勝手に変更されてしまう。デフォルトでTrueなので注意が必要。Formを作成したら毎回忘れずに設定する。

で、exeがあるフォルダ以下の構成は次の通り。この階層構造をもとにしてPathを設定する。

ProcはProceed(処理済み)の略(のつもり)


StringGridに読み込むCSVファイルの置き場所は、「\sNameフォルダ」とする。

sNameフォルダ内にCSVファイルを用意する


これを読み込んでStringGridに表示する。OpenDialogをFormに追加する。

Form上に追加


読み込むCSVファイルのデータは次の通り。
(フィールド名が「ない」場合や、データに通し番号がなく、行番号を表示したい場合にも対応できるコードを含めて記述した。必要ない部分はコメントアウトしている)

今回使用するデータは「フィールド名・通し番号あり」


次のコードを記述。

procedure TForm1.Button1Click(Sender: TObject);
var
  //CSVファイルの読み込み
  CSVFileName: string;
  CsvFile:TextFile;
  CsvRowStr: string;
  i: Integer;
  strMsg: string;
  //列幅の調整
  iCOL: Integer;
  MaxColWidth: Integer;
  iROW: Integer;
  TmpColWidth: Integer;
begin

  //表示設定
  StringGrid1.Visible:=False;

  //列数
  StringGrid1.ColCount:=7;

  //OpenDialogのプロパティはExecuteする前に設定しておくこと
  With OpenDialog1 do begin
    //表示するファイルの種類をcsvに設定
    Filter:='CSVファイル(*.csv)|*.csv';
    //データの読込先フォルダを指定
    InitialDir:=ExtractFilePath(Application.ExeName)+'sName';
  end;

  //ダイアログ呼び出し
  if OpenDialog1.Execute then
  begin
    CsvFileName:=OpenDialog1.FileName;
    AssignFile(CsvFile, CsvFileName);
    Reset(CsvFile);
  end else begin
    strMsg:='ユーザーによる処理のキャンセル';
    Application.MessageBox(PChar(strMsg), PChar('情報'), MB_ICONINFORMATION);
    Exit;
  end;

  //フィールド名が必要なCSVファイルなら記述する
  //StringGrid1.Rows[0].CommaText:=
  //  '通し番号,氏名,よみがな,年齢,生年月日,性別,血液型';
  //Fixed Colが1列あって、そこに行番号を設定する場合
  //  ',通し番号,氏名,よみがな,年齢,生年月日,性別,血液型';

  //読込み開始行を指定(FixedRowがある場合 -> ない場合は[0]にする)
  i:=0;
  try
    while not EOF(CsvFile) do
    begin
      //CSVファイルを1行読み込み、その1行分を文字列として代入する。
      Readln(CsvFile, CsvRowStr);
      //グリッドの行数が読み込み行数より少なければ、グリッドの行数を追加する。
      if StringGrid1.RowCount <= i then StringGrid1.RowCount := i + 1;
      //グリッドの指定行目に読み込み行を代入
      //[0]列はFixedCol-> 行番号を設定したい場合
      //StringGrid1.Rows[i].CommaText:=IntToStr(i)+','+CsvRowStr;
      StringGrid1.Rows[i].CommaText:=CsvRowStr;
      i := i + 1;
    end;
  finally
    //行番号を設定した場合
    //StringGrid1.Cells[0,0]:='行番号';
    CloseFile(CsvFile);
  end;

  //列幅の自動調整
  for iCOL := 0 to StringGrid1.ColCount-1 do
  begin
    MaxColWidth := 0;
    for iROW := 0 to StringGrid1.RowCount-1 do
    begin
      TmpColWidth := Canvas.TextWidth(StringGrid1.Cells[iCOL,iROW]) + 10;
      if MaxColWidth < TmpColWidth then
        MaxColWidth := TmpColWidth;
    end;
    StringGrid1.ColWidths[iCOL] := MaxColWidth;
  end;

  //表示設定
  StringGrid1.Visible:=True;

end;

実行結果は次の通り。

文字コードはANSI(CP932、Shift_JIS が拡張されたもの?)


以下、データを読み込む上での注意のあれこれ。

まず、CSVファイルの文字コードがUTF-8だと・・・

たいへんなコトに・・・


また、氏名やよみがなの「姓と名の間にあるスペースが全角でなく、半角」だと・・・

このコードでは、半角スペースが区切り文字として認識されてしまう!


CSVファイルのデータ形式には、文字コードも含めて十分、注意する必要がある。

4.印刷のコード

正直に言うと、今回のチャレンジでは「印刷プレビュー」のプログラムの方を先に書いた。
自分自身の感覚に自信などあるわけないが、通常(?)の感覚からすれば「印刷プレビュー」⇨「印刷」という流れが自然であるような気がして、そうなったのだ。

そこで問題になったのがデータ数が多く、印刷(出力)が「複数ページ」となる場合、プレビューの2枚目、3枚目をどう表示するか? という部分。

先に述べた通り、2枚目以降の先頭行にも「フィールド名を表示」するという自分との約束もあったし・・・。この「ページ毎、先頭行にはフィールド名を表示する」処理の方法をいろいろ考え、試してみたが、どうにも上手く行かない。

これだ! と思える処理手順が思いつかないまま、1ページ目だけの表示であれば問題なくできるプログラムを作成。とりあえず、印刷プレビューは1ページ目だけ表示することで妥協して、(仮)印刷プレビュープログラムとしておき、複数ページの印刷に対応した印刷プログラムが完成したら、もう一度、夢見た通りの印刷プレビューとなるよう、ここに戻ってくることにする。

そうして様々な問題をひとつひとつ自分なりに丁寧にクリアして最終的に書き上げたのが、下に掲載した「印刷」のプログラムコード(データ全体の行数や列数は限定せず、汎用的に使える=再利用できるコードを目指したつもりだが、どうだろうか?)。

FormにPrinterSetupDialog、その他のVCLコントロールを追加。

PrinterSetupDialogの方が用紙サイズと印刷方向を選ぶには便利!


if PrinterSetupDialog1.Execute then ~で、呼び出したDialogの画面。

今回の用途なら、出力先のプリンタ・用紙・向きの指定が出来ればOK!
追加したVCLコントロールとそれらに設定した名称
設定した値と状態

Button2は「印刷プレビュー」機能を、Button3は「印刷」機能を、それぞれ割り当てる予定。
なので、Button3をダブルクリックして手続きを作成し、「印刷」プログラムのコードを入力。

implementation

uses
  System.Math,
  Vcl.Printers;
procedure TForm1.Button3Click(Sender: TObject);
var
  //用紙サイズ、縦置き・横置きの設定を知る(Charだと推奨されない警告が表示される->Stringに変更)
  //Device, Driver, Port: array[0..255] of Char;
  Device, Driver, Port: string;
  DeviceMode: THandle;
  DevMode: PDeviceMode;

  //StringGrid->CSVファイル名とそこまでのPathを入れる
  csvFN:string;

  StringList: TStringList;
  i, j, k, MaxWidth: Integer;
  Fields: TStringList;
  FieldWidths: array of Integer;
  ColMargin: Integer;
  MarginX, MarginY: Integer;
  intLoop: Integer;
  FontHeight: Integer;
  eNum: Integer;
  iPlus: Integer;
  myFieldElement: string;
  LowNum: Integer;
  HighNum: Integer;
  MyRect:TRect;
  //平均値・最高値・最低値 -> 汎用性を考えExtended ではなく、Double とした
  DSum: Double;
  DAvg: Double;
  MinValue, MaxValue: Double;
  intDenomin: Double;

  //StringGrid -> CSV File
  procedure SaveStringGridToCSV(StringGrid: TStringGrid; const FileName: string);
  var
    CSVFile: TextFile;
    Row, Col: Integer;
    Line: string;
  begin
    AssignFile(CSVFile, FileName);
    Rewrite(CSVFile);
    try
      for Row := 0 to StringGrid.RowCount - 1 do
      begin
        Line := '';
        for Col := 0 to StringGrid.ColCount - 1 do
        begin
          Line := Line + StringGrid.Cells[Col, Row];
          if Col < StringGrid.ColCount - 1 then
            Line := Line + ',';
        end;
        WriteLn(CSVFile, Line);
      end;
    finally
      CloseFile(CSVFile);
    end;
  end;

  // ビットマップ用印刷ルーチン
  procedure StretchDrawBitmap(Canvas:TCanvas;  // 描画先キャンバス
                              r : TRect;       // 描画先範囲
                              Bitmap:TBitmap); // ビットマップ
  const
    InfoSize = SizeOf(TBitmapInfoHeader) + 4 * 256;
  var
    OldMode   : integer;      // StretchModeの保存用
    pInfo     : PBitmapInfo;  // DIBヘッダ+カラーテーブルへのポインタ

    InfoData  : array[0..InfoSize-1] of Byte; // DIBヘッダ+カラーテーブル
    Image     : array of Byte;// DIBのピクセルデータ
    DC        : HDC;          // GetDIBits 用 Device Context
    OldPal    : HPALETTE;     // パレット保存用
  begin
    pInfo :=@InfoData;

    // 24 Bit DIB の領域を確保
    SetLength(Image, ((Bitmap.Width * 24 + 31) div 32) * 4 * Bitmap.Height);

    // DIB のBitmapInfoHeader を初期化
    with pInfo^.bmiHeader do begin
      biSize := SizeOf(TBitmapInfoHeader);
      biWidth := Bitmap.Width;     biHeight := Bitmap.Height;
      biPlanes := 1;               biBitCount := 24;
      biCompression := BI_RGB;
    end;

    // 24bpp DIB イメージを取得
    DC := GetDC(0);
    try
      OldPal := 0;
      if Bitmap.Palette <> 0 then
        OldPal := SelectPalette(DC, Bitmap.Palette, True);

      GetDIBits(DC, Bitmap.Handle, 0, Bitmap.Height,
                Image, pInfo^, DIB_RGB_COLORS);
      if OldPal <> 0 then SelectPalette(DC, OldPal, True);
    finally
      ReleaseDC(0, DC);
    end;

    // 拡大モードを カラー用に変更
    OldMode:=SetStretchBltMode(Canvas.Handle,COLORONCOLOR);

    // 描画!!
    StretchDIBits(Canvas.Handle,
                  r.Left,r.Top,r.Right-r.Left,r.Bottom-r.Top,
                  0,0,pInfo^.bmiHeader.biWidth,pInfo^.bmiHeader.biHeight,
                  Image,pInfo^,DIB_RGB_COLORS,SRCCOPY);
    // 拡大モードを元に戻す
    SetStretchBltMode(Canvas.Handle,OldMode);
  end;

  procedure GetMinMaxValues(StringGrid: TStringGrid; ColIndex: Integer; out MinValue, MaxValue: Double);
  var
    Row: Integer;
    Value: Double;
  begin
    if StringGrid.RowCount = 0 then
      raise Exception.Create('StringGridにデータがありません。');

    MinValue := MaxDouble;
    MaxValue := -MaxDouble;

    for Row := 1 to StringGrid.RowCount - 1 do
    begin
      if TryStrToFloat(StringGrid.Cells[ColIndex, Row], Value) then
      begin
        if Value < MinValue then
          MinValue := Value;
        if Value > MaxValue then
          MaxValue := Value;
      end;
    end;

    if MinValue = MaxDouble then
      raise Exception.Create('指定された列に数値データがありません。');
  end;

begin

  //複数回クリックを防止する
  Button3.Enabled:=False;

  //初期化
  Image1.Picture:=nil;
  Image2.Picture:=nil;
  Image1.Visible:=False;
  Image2.Visible:=False;

  //印刷設定(用紙・向き)後に印刷
  if PrinterSetupDialog1.Execute then
  begin

    //プリンタの設定を取得
    Printer.GetPrinter(Device, Driver, Port, DeviceMode);
    DevMode := GlobalLock(DeviceMode);
    try
      //用紙サイズをA4に設定
      DevMode^.dmPaperSize := DMPAPER_A4;
      //用紙方向を縦に設定
      DevMode^.dmOrientation := DMORIENT_PORTRAIT;
      //設定をプリンタに反映
      Printer.SetPrinter(Device, Driver, Port, DeviceMode);
    finally
      GlobalUnlock(DeviceMode);
    end;

    //プリンタの解像度を取得
    //DPI := GetDeviceCaps(Printer.Handle, LOGPIXELSX);
    //家庭用のEPSONのプリンタは360DPI
    //業務用のEPSONの複合機は、600DPI
    //FinePrintは、600DPI

    //A4サイズの用紙の寸法は210mm x 297mm。インチに換算:約8.27インチ x 11.69インチ
    //プリンタの解像度(DPI: Dots Per Inch)

    //100DPIの場合
    //幅: 8.27インチ × 100 DPI = 827ピクセル
    //高さ: 11.69インチ × 100 DPI = 1169ピクセル

    //200DPIの場合
    //幅: 8.27インチ × 200 DPI = 1654ピクセル
    //高さ: 11.69インチ × 200 DPI = 2338ピクセル

    //100DPIとして描画したものをStretchDrawする

    //TImageの初期設定
    Image1.Width := 827;
    Image1.Height := 1169;
    Image1.Picture.Bitmap.Width := 827;
    Image1.Picture.Bitmap.Height := 1169;

    //背景を塗りつぶす
    Image1.Picture.Bitmap.Canvas.Brush.Color := clWhite;
    MyRect:=Rect(0, 0, 827, 1169);
    Image1.Picture.Bitmap.Canvas.FillRect(MyRect);

    //使用するフォント(必ず等幅フォントを指定する)
    //数値の右揃え用に追加(20240820)
    Image1.Picture.Bitmap.Canvas.Font.Name:='Consolas';

    //フォントサイズ -> 実際にはComboBoxで指定・選択できるようにする
    Image1.Picture.Bitmap.Canvas.Font.Size:=11;

    //平均値を計算 -> 実際のプログラムではこのような計算も行っている
    {
    DSum:=0;
    for i := 1 to StringGrid1.RowCount do
    begin
      if StringGrid1.Cells[5,i] <> '' then
      begin
        DSum:= DSum + StrToInt(StringGrid1.Cells[5,i]);
      end;
    end;
    DAvg:= SimpleRoundTo(DSum / intDenomin, -2);

    //最高値及び最低値を計算
    GetMinMaxValues(StringGrid1, 5, MinValue, MaxValue);
    }

    //StringGrid -> CSV
    //実際のプログラムでは、sNameフォルダ内のCSVファイルを読み込み、
    //さらに幾つかフィールドを追加して新しいデータを追加している。
    //追加したデータを含めて印刷する仕様

    //実際のプログラムでは、LabelSaveFolderName.Captionは別手続きで取得・表示済み
    LabelSaveFolderName.Caption:='SampleData';

    //保存するフォルダへのPath
    csvFN:=IncludeTrailingPathDelimiter(ExtractFilePath(Application.ExeName))+
      'ProcData\'+LabelSaveFolderName.Caption+'\';

    //フォルダの存在を確認、なければ作成
    if not System.SysUtils.DirectoryExists(ExtractFileDir(csvFN)) then
    begin
      //フォルダ階層を作成
      System.SysUtils.ForceDirectories(ExtractFileDir(csvFN));
    end;

    csvFN:=IncludeTrailingPathDelimiter(ExtractFilePath(Application.ExeName))+
      'ProcData\'+LabelSaveFolderName.Caption+'\'+LabelSaveFolderName.Caption+'.csv';
    SaveStringGridToCSV(StringGrid1, csvFN);

    StringList:=TStringList.Create;
    Fields:=TStringList.Create;

    try

      //Create
      StringList.LoadFromFile(csvFN);
      //Create
      SetLength(FieldWidths, 0);

      //各フィールドの最大幅を計算
      for i := 0 to StringList.Count - 1 do
      begin
        Fields.CommaText := StringList[i];
        if Length(FieldWidths) < Fields.Count then
          SetLength(FieldWidths, Fields.Count);

        for j := 0 to Fields.Count - 1 do
        begin
          //MaxWidth := Printer.Canvas.TextWidth(Fields[j]);
          MaxWidth := Image1.Picture.Bitmap.Canvas.TextWidth(Fields[j]);
          if FieldWidths[j] < MaxWidth then
            FieldWidths[j] := MaxWidth;
        end;
      end;

      eNum:=StringList.Count div 50;

      //51,101,151,201,251,301,・・・,XX1番目にフィールド名を挿入しておく

      //0番目の要素をコピー
      myFieldElement:=StringList[0];
      //要素を挿入(追加)
      if eNum<>0 then
      begin
        for i := 1 to eNum do
        begin
          StringList.Insert((50*i)+1, myFieldElement);
        end;
      end;

      //ここから印刷Loop
      try

        for intLoop := 0 to eNum do
        begin

          //初期化(白紙にする)
          Image1.Picture.Bitmap.Canvas.Brush.Color := clWhite;
          MyRect:=Rect(0, 0, 827, 1169);
          Image1.Picture.Bitmap.Canvas.FillRect(MyRect);

          if intLoop=0 then
          begin
            Printer.BeginDoc;
          end else begin
            Printer.NewPage;
          end;

          //タイトルを描画
          Image1.Picture.Bitmap.Canvas.Font.Color:=clBlue;
          Image1.Picture.Bitmap.Canvas.TextOut(
            StrToInt(EditMarginX.Text), StrToInt(EditMarginY.Text)-30,
            LabelSaveFolderName.Caption);

          //タイトルを描画
          {
          Image1.Picture.Bitmap.Canvas.Font.Color := clBlue;
          Image1.Picture.Bitmap.Canvas.TextOut(
            StrToInt(EditMarginX.Text), StrToInt(EditMarginY.Text)-30,
            LabelSaveFolderName.Caption + ' 【平均値:'+FloatToStr(DAvg)+
            '、最高値:'+ FloatToStr(MaxValue)+
            '、最低値:'+ FloatToStr(MinValue)+'】');
          }

          Image1.Picture.Bitmap.Canvas.Font.Color:=clBlack;

          k:=0;
          MarginX:=StrToInt(EditMarginX.Text);
          MarginY:=StrToInt(EditMarginY.Text);
          ColMargin:=StrToInt(EditColMargin.Text);

          iPlus:=0;
          //次のcase文でelseを使って何らかの値が必ず代入されるようにしたので不要
          //LowNum:=0;
          //HighNum:=0;

          case intLoop of
            0:begin
              LowNum:=0;
              if StringList.Count > 50 then
              begin
                HighNum:=50;
              end else begin
                HighNum:=StringList.Count-1;
              end;
            end;
            {
            1:begin
              LowNum:=51;
              if StringList.Count > 100 then
              begin
                HighNum:=100;
              end else begin
                HighNum:=StringList.Count-1;
              end;
            end;
            2:begin
              LowNum:=101;
              if StringList.Count > 150 then
              begin
                HighNum:=150;
              end else begin
                HighNum:=StringList.Count-1;
              end;
            end;
            }
          else
            //一般化
            LowNum:=(intLoop*50)+1;
            if StringList.Count > (intLoop*50)+50 then
            begin
              HighNum:=(intLoop*50)+50;
            end else begin
              HighNum:=StringList.Count-1;
            end;
          end;

          for i := LowNum to HighNum do
          begin
            Fields.CommaText := StringList[i];
            for j := 0 to Fields.Count - 1 do
            begin
              //処理できる列数を無制限にする
              case j of
                0:k:=0;
              else
                k:=k+FieldWidths[j-1]+ColMargin;
              end;
              //フィールド名に「備考」を追加する
              if i=0 then
              begin
                if j=Fields.Count-1 then
                begin
                  Fields[j]:=Fields[j]+' 備考';
                end;
              end;

              //データを出力(数値の右揃え:なし)
              //Image1.Picture.Bitmap.Canvas.TextOut(MarginX+k,MarginY+(iPlus*20),Fields[j]);

              //データを出力(数値の右揃え:あり))
              //数値の右揃え用に追加(20240820
              if TryStrToInt(Fields[j], intValue) then
              begin
                //数値である -> 右揃えで出力する
                Image1.Picture.Bitmap.Canvas.TextOut(MarginX+k,MarginY+(iPlus*20),
                  Format('%3d', [strToInt(Fields[j])]));
              end else begin
                //数値でない -> 左揃えで出力する
                Image1.Picture.Bitmap.Canvas.TextOut(MarginX+k,MarginY+(iPlus*20),Fields[j]);
              end;

              //罫線を描画
              if cbLine.Checked then
              begin
                Image1.Picture.Bitmap.Canvas.Pen.Color:= clBlack;
                FontHeight:= -1 * Image1.Picture.Bitmap.Canvas.Font.Height;
                Image1.Picture.Bitmap.Canvas.MoveTo(MarginX+k, MarginY+(iPlus*20)+FontHeight+4);
                Image1.Picture.Bitmap.Canvas.LineTo(Image1.Picture.Bitmap.Width-50, MarginY+(iPlus*20)+FontHeight+4);
              end;
            end;
            inc(iPlus);
          end;

          //大きさを指定
          MyRect.Top:=0;
          MyRect.Left:=0;
          MyRect.Bottom:= Trunc((Printer.PageWidth / Image1.Picture.Width) * Image1.Picture.Height);
          MyRect.Right:= Printer.PageWidth;
          //ファイルを描画
          StretchDrawBitmap(Printer.Canvas, MyRect, Image1.Picture.Bitmap);
          Application.ProcessMessages;

        end;  //intLoop

      finally
        Printer.EndDoc;
      end;

    finally
      StringList.Free;
      Fields.Free;
      //複数回クリックを防止する
      Button3.Enabled:=True;
    end;

    //ファイルの完全削除
    DeleteFile(PChar(csvFN));

    //TImageの表示位置を指定
    ScrollBox1.VertScrollBar.Position:=0;
    ScrollBox1.HorzScrollBar.Position:=0;
    Image1.Top:=ScrollBox1.VertScrollBar.Position+14;
    Image1.Left:=ScrollBox1.HorzScrollBar.Position+14;

    //TImageの表示
    Image1.Visible:=True;  //印刷プレビューを実行しなければ不要

    Button2Click(Sender);  //印刷プレビューを表示する

  end else begin
    //キャンセルに対応
    Button2Click(Sender);  //印刷プレビューを表示する
  end;

end;

上のコードには、このサンプルでの処理には不要な部分や、(コードを一般化する前に場合分けして処理手順を考えた)冗長な部分も含まれている。自分のバカさを全世界にPRするようなものだが、計算処理を追加したり、コードを一般化する際の考え方の参考となるよう、敢えてそのまま残した。

そもそも、この記事を書こうと思ったきっかけは、DelphiのStringGridの内容を定型用紙に印刷するサンプルコードが(Web上に)あまりにも少ない気がしたこと。ただ、この例では、いったんCSVファイルにして保存したり、PrinterのCanvasではなくTImageのCanvasに描画したり、普通とは言い難い方法を行って印刷している気がするので、普通(?)の印刷方法を学びたい方にはまるで参考にならないかもですが、万一にでも、どなたかのお役に立てれば何よりの幸いです。

【実行結果】

まず、PrinterSetupDialogが表示されるので、A4・縦を選択する。

プリンター名に「FinePrint」とあるのはお気に入りのプリントユーティリティ
プレビュー的に印刷内容を確認したり、まとめ印刷を行ったり、縮小・両面設定で印刷枚数を減らしたり、とにかく使えるユーティリティ
FinePrintへ出力
FinePrintへの出力の印刷プレビュー部分を拡大


これで数値データを右寄せ表示できれば、大満足なんだけど・・・ 。

追記(20240819)

Format関数を使えば、数値データの右揃えが簡単に実現できることを忘れてた!

(最近は「データを保存する」プログラムばかり書いていて、「データを印刷する」プログラムはほとんど書いたことがないことにあらためて気づいた。

 例1:csv形式で保存 -> 表計算ソフトで読み込んで活用。
 例2:表計算ソフトのファイルにADO接続して、直接書き込み。
 例3:データベースにADO接続して、データを保存、必要な部分をクエリで抽出。みたいな・・・

遠い昔、VBでデータを縦・横罫線付きの一覧表形式で印刷するプログラムをさんざん書いていたのが夢のよう・・・。

てか、今回も最終的に印刷しているのは、プリンターのCanvasに描画した「絵」なんですが。)

「印刷プレビュー」及び「印刷」の手続きを次のように追加・修正。

1.手続きの冒頭で、「等幅フォントを忘れずに指定」する(追加)。

  //使用するフォント(必ず等幅フォントを指定する)
  Image1.Picture.Bitmap.Canvas.Font.Name:='Consolas';

  //フォントサイズ -> 実際にはComboBoxで指定・選択できるようにする
  Image1.Picture.Bitmap.Canvas.Font.Size:=11;

2.データ出力部分を次のように修正する。

  //データを出力
  //Image1.Picture.Bitmap.Canvas.TextOut(MarginX+k,MarginY+(iPlus*20),Fields[j]);

  //数値データは右揃えで出力する
  if TryStrToInt(Fields[j], intValue) then
  begin
    //数値である -> 右揃えで出力する
    Image1.Picture.Bitmap.Canvas.TextOut(MarginX+k,MarginY+(iPlus*20),
      Format('%3d', [strToInt(Fields[j])]));
  end else begin
    //数値でない -> 左揃えで出力する
    Image1.Picture.Bitmap.Canvas.TextOut(MarginX+k,MarginY+(iPlus*20),Fields[j]);
  end;

【実行結果】

通し番号(と年齢)が右揃えになった!

追記(20240819)ここまで

2ページ目以降も先頭行にフィールド名を表示

今までの自分には罫線付きでこのように表示することが、どうしてもできなかった・・・


先頭行にフィールド名を表示する部分は、いちばん悩んだところ。
最終的に変数eNum(LoopのEndNumber)から印刷に必要なページ数を取得し、StringListに格納した印刷データの0番目の要素をコピーして、これをStringListの51、101、151のように、eNumの現在の値( i * 50)+1番目に挿入して行く方法が計算的にも、処理的にも、いちばんラクなのではないか?・・・と考え、このアルゴリズムでプログラムを作成。

こうすれば1ページ目には要素0から50、2ページ目には要素51から100、3ページ目には101から150・・・のように印刷データの割り当てが決まり、プログラムも心もすっきり。0番目の要素(フィールド名)のコピーと所定の位置への挿入さえ行ってしまえば、あとは単純にLoopを廻すだけだ。

      eNum:=StringList.Count div 50;

      //51,101,151,201,251,301・・・番目にフィールド名を挿入

      //0番目の要素をコピー
      myFieldElement:=StringList[0];
      //要素を追加
      if eNum<>0 then
      begin
        for i := 1 to eNum do
        begin
          StringList.Insert((50*i)+1, myFieldElement);
        end;
      end;


最も重要なデータ出力部分は、生成AIに教えてもらった!
次のデータを出力するコードの(iPlus * 20)の部分は、自分では絶対に書けなかったと思う・・・。
ついに、と言うか、とうとう、わからない部分は生成AIに聞きながらプログラムが書ける、夢のような時代がやってきた!!

でも、頼りすぎは禁物。実際、今回もかなり痛い目にあった・・・。
その内容は、後述。

//データを出力
Image1.Picture.Bitmap.Canvas.TextOut(MarginX+k,MarginY+(iPlus*20),Fields[j]);

印刷枚数が1ページだけなら、変数はLoop変数の i がそのまま使えるのだが、複数枚印刷を実行する必要があるので、Loop用の変数 i とは別に iPlus という名前の変数(特に意味はない)を用意し、ページが切り替わる毎にゼロで初期化するように生成AIが教えてくれたプログラムを改良。

それから、これはあった方が親切かな? と考え、先頭行のフィールド名の最後に「備考」も追加。

Loopの様子をわかりやすくしたのが次のコード。
ページ内のデータ印刷作業で、i , j , k を使ってしまったので、いちばん大きな(外側の)ページを切り替えるLoopの変数名をどうするかで悩み l(エルの小文字)はちょっと・・・って感じがしたので、最終的に変数名はintLoopとした。

最終的に、TImageのBitmapに出力したものをPrinterのCanvasにコピーして印刷している。

for intLoop := 0 to eNum do
begin
  k:=0;
  iPlus:=0;
  for i := LowNum to HighNum do
  begin
    for j := 0 to Fields.Count - 1 do
    begin    
      //フィールド名に「備考」を追加する
      if i=0 then
      begin
        if j=Fields.Count-1 then
        begin
          Fields[j]:=Fields[j]+' 備考';
        end;
      end;
      //データを出力
      Image1.Picture.Bitmap.Canvas.TextOut(MarginX+k,MarginY+(iPlus*20),Fields[j]);
    end;
    inc(iPlus);
  end; 

  //大きさを指定
  MyRect.Top:=0;
  MyRect.Left:=0;
  MyRect.Bottom:= Trunc((Printer.PageWidth / Image1.Picture.Width) * Image1.Picture.Height);
  MyRect.Right:= Printer.PageWidth;
  //ファイルを描画
  StretchDrawBitmap(Printer.Canvas, MyRect, Image1.Picture.Bitmap);
  Application.ProcessMessages;

end;  //intLoopの終わり


実は、ここでひと悶着あって・・・

5.rect:TRectとしてはいけません!

実際には、最初に1ページ目だけを表示できる「印刷プレビュー」のプログラムを書き、それを元にして「印刷」プログラムを書いたのだが、いつもの通り、というか、お決まりの「解決策がまったくわからずにトホーに暮れる」・・・ 後から考えれば(理由がわかってみれば)実に「なぁーんだ。そんなコトか」みたいな、でも、それがわかるまでは七転八倒の苦しみとなるイベントに今回も遭遇。

毎回、これが楽しみでプログラムを書いている、そんな気がしないでもないが。

今回のそれは・・・ナニかというと、

「印刷プレビュー」の手続き内では「何の問題もなかった」次のコードだが、

procedure TForm1.Button2Click(Sender: TObject);
begin

  ・・・じんせい、イロイロ・・・

  //背景を塗りつぶす
  Image1.Picture.Bitmap.Canvas.Brush.Color := clWhite;
  Image1.Picture.Bitmap.Canvas.FillRect(rect(0, 0, 827, 1169)); 

  ・・・タコは、イボイボ・・・

end;

これを「印刷」手続き内に複写して、「印刷プレビュー」手続きにはないPrinterのCanvasへの描画コードを追加するなど、あちこちいじっていたら、いつの間にか・・・

エラーの!マークが付いてる(問題が起きた状況を再現)


構造ペインには・・・


『はぁ?』

だって行末にちゃんとセミコロンあるし・・・みたいな感じ。
・・・てか、なんで、こっちの手続きだけ、エラーになるの???

この時点で、早朝2時頃から連続15時間くらいPCと向かい合っていたため、精神的にはもうフラフラの状態。もちろん、エラーの原因は、まったくわからない。

まったく同じプログラムコードが、あっちの手続きではOK! こっちの手続きではダメな理由は、いったい何なんだろう???

この後も、しばらく、がんばって考えたんだけど、原因はさっぱりわからず、


Delphiを再起動したら直るかなー?

もちろん、直るわけもなく・・・。


もしかして、PCを再起動したら直るかなー??

もちろん、再起動してもエラーは消えない。


万策尽きた感じで、とりあえず、いけない水に手を伸ばし・・・ 心は折れたまま、遥かなる夢の国へ。

翌朝、ってか、午前0時前に目覚めたから、日付はまだ今日だけど・・・
とりあえず、すっきりした頭で問題に再挑戦。ようやくエラーの原因が判明。

ほんとに偶然発見したのだけれど、エラーにならない「印刷プレビュー」の手続きでは・・・

このRectはSystem.TypesのRect関数・・・


これに対し、エラーになる「印刷」の手続きでは・・・

このrectはvar宣言したTRect型の変数・・・

あー!!
わかったー☆☆☆ みたいな

1ページ目だけ表示可能な最初に書いた「印刷プレビュー」の手続きをそっくり「印刷」手続きに複写して、「印刷プレビュー」の手続きには「存在しなかった」プリンタのCanvasへの描画コードを追加したのだが・・・ その時、var宣言部でTRect型の変数rectを宣言していたのだ。

これが追加したPrinterのCanvasへ描画するプログラムの主要部分。

procedure TForm1.btnPrintASheetClick(Sender: TObject);
var
  i, j: Integer;
  strMsg: string;
  PrintALL: Boolean;
  intLoopNum: Integer;
  rect:TRect;
  StrCaption:String;
  StrPrompt:String;
  StrValue1, StrValue2:String;
  Chr : array [0..255]  of  char;

  // ビットマップ用印刷ルーチン
  procedure StretchDrawBitmap(Canvas:TCanvas;  // 描画先キャンバス
                              r : TRect;       // 描画先範囲
                              Bitmap:TBitmap); // ビットマップ
  ・・・省略・・・

begin
  if PrinterSetupDialog1.Execute then
  begin

    //背景を塗りつぶす
    Image1.Picture.Bitmap.Canvas.Brush.Color := clWhite;
    Image1.Picture.Bitmap.Canvas.FillRect(rect(0, 0, 827, 1169));  //エラーになる部分

    //Info
    strMsg:='全員分印刷しますか?'+#13#10+'(個別印刷は「いいえ」)';
    if Application.MessageBox(PChar(strMsg), PChar('情報'), MB_YESNO or MB_ICONINFORMATION) = mrYes then
    begin
      PrintALL:=True;
    end else begin
      PrintALL:=False;
    end;

    //全部印刷
    if PrintAll then
    begin
      //先頭のデータを表示
      btnFirstClick(Sender);
      for i := 1 to ListBox1.Items.Count do
      begin
        //まず現在のImageを印刷
        with Printer do
        begin
          if i=1 then
          begin
            BeginDoc;
          end else begin
            NewPage;
          end;
          //大きさを指定
          rect.Top:=0;
          rect.Left:= 0;
          rect.Bottom:= Trunc(( PageWidth / Image1.Picture.Width) * Image1.Picture.Height);
          rect.Right:= PageWidth;
          //TImageのBitmapをPrinterのCanvasに描画
          StretchDrawBitmap(Printer.Canvas, rect, Image1.Picture.Bitmap);
          
          if i=ListBox1.Items.Count then
          begin
            EndDoc;
          end;
        end;

        //次を表示
        btnNextClick(Sender);
      end;

      ・・・

だから、結果的に(当然だが)「印刷」手続き内ではコードで意図したSystem.TypesのRect関数は呼ばれずに、「rect」と記述するとそれはvar宣言したrect変数の方を意味(参照)することになって・・・

これはエラーになって当然。Delphiさん、あなたはやっぱり正しかった。

ちなみに、Delphiは大文字・小文字を区別しないから、R でも r でも問題は起きない。問題の根源であるvar宣言部のrect変数の名前を変え、次のようにコードを書き直せば・・・

☆エラーは消えました☆

System.TypesのRect関数と名前が衝突しないように、変数名をMyRectに変える
もしくはSystem.Types.pasのRect関数を明示的に指定する


(試してみたい方は、次のコードをコピペしてください。)

procedure TForm1.Button4Click(Sender: TObject);
var
  MyRect:TRect;
begin

  //背景を塗りつぶす
  Image1.Picture.Bitmap.Canvas.Brush.Color := clWhite;

  //解決方法その1
  MyRect:=rect(0, 0, 827, 1169);
  Image1.Picture.Bitmap.Canvas.FillRect(MyRect);

  //解決方法その2
  Image1.Picture.Bitmap.Canvas.FillRect(System.Types.Rect(0, 0, 827, 1169));

end;

【まとめ】

関数名として使われているような語句をそのまんま変数名として利用するのはNo Good! であります。

6.印刷プレビューのコード

そういう訳で、「印刷」手続きのコードが完成し、問題も解決したので、この完成したコードを「印刷プレビュー」に流用することにした。

基本的に、「印刷」手続きのコードからBeginDocとNewPage、それからEndDocを消し、PrinterのCanvasに描画してる部分をコメントアウトして、1ページ目以降を表示する方法を追加すればOKのはずだ・・・。そう考えて書いたのが次のコード。

procedure TForm1.Button2Click(Sender: TObject);
var
  //用紙サイズ、縦置き・横置きの設定を知る(Charだと推奨されない警告が表示される->Stringに変更)
  //Device, Driver, Port: array[0..255] of Char;
  Device, Driver, Port: string;
  DeviceMode: THandle;
  DevMode: PDeviceMode;

  //StringGrid->CSVファイル名とそこまでのPathを入れる
  csvFN:string;

  StringList: TStringList;
  i, j, k, MaxWidth: Integer;
  Fields: TStringList;
  FieldWidths: array of Integer;
  ColMargin: Integer;
  MarginX, MarginY: Integer;
  intLoop: Integer;
  FontHeight: Integer;
  eNum: Integer;
  iPlus: Integer;
  myFieldElement: string;
  LowNum: Integer;
  HighNum: Integer;
  MyRect:TRect;
  //平均値・最高値・最低値
  //DSum: Double;
  //DAvg: Double;
  //MinValue, MaxValue: Double;

  //StringGrid -> CSV File
  procedure SaveStringGridToCSV(StringGrid: TStringGrid; const FileName: string);
  var
    CSVFile: TextFile;
    Row, Col: Integer;
    Line: string;
  begin
    AssignFile(CSVFile, FileName);
    Rewrite(CSVFile);
    try
      for Row := 0 to StringGrid.RowCount - 1 do
      begin
        Line := '';
        for Col := 0 to StringGrid.ColCount - 1 do
        begin
          Line := Line + StringGrid.Cells[Col, Row];
          if Col < StringGrid.ColCount - 1 then
            Line := Line + ',';
        end;
        WriteLn(CSVFile, Line);
      end;
    finally
      CloseFile(CSVFile);
    end;
  end;

  procedure GetMinMaxValues(StringGrid: TStringGrid; ColIndex: Integer; out MinValue, MaxValue: Double);
  var
    Row: Integer;
    Value: Double;
  begin
    if StringGrid.RowCount = 0 then
      raise Exception.Create('StringGridにデータがありません。');

    MinValue := MaxDouble;
    MaxValue := -MaxDouble;

    for Row := 1 to StringGrid.RowCount - 1 do
    begin
      if TryStrToFloat(StringGrid.Cells[ColIndex, Row], Value) then
      begin
        if Value < MinValue then
          MinValue := Value;
        if Value > MaxValue then
          MaxValue := Value;
      end;
    end;

    if MinValue = MaxDouble then
      raise Exception.Create('指定された列に数値データがありません。');
  end;

  //Image1のBitmapをImage2の指定位置へ複写する
  procedure CopyBitmapToImage(Image1, Image2: TImage; DestX, DestY: Integer);
  var
    SrcRect, DestRect: TRect;
  begin
    // ソースの矩形を設定
    SrcRect := Rect(0, 0, Image1.Picture.Bitmap.Width, Image1.Picture.Bitmap.Height);
    // 目的地の矩形を設定
    DestRect := Rect(DestX, DestY, 
      DestX + Image1.Picture.Bitmap.Width, DestY + Image1.Picture.Bitmap.Height);
    // Image2のCanvasにImage1のBitmapを複写
    Image2.Picture.Bitmap.Canvas.CopyRect(DestRect, Image1.Picture.Bitmap.Canvas, SrcRect);

    //追加(20240820)
    //ページ区切り線を表示するコードを追加
    //ペンの色を青に設定
    Image2.Picture.Bitmap.Canvas.Pen.Color := clGray;
    //ページ区切り線の太さ
    Image2.Picture.Bitmap.Canvas.Pen.Width:=3;
    //ペンのスタイルを点線に設定
    //Image1.Canvas.Pen.Style := psDot;
    Image1.Canvas.Pen.Style := psSolid;
    //線を引く
    Image2.Canvas.MoveTo(0, DestY + Image1.Picture.Bitmap.Height); // 線の開始位置
    Image2.Canvas.LineTo(Image2.Picture.Bitmap.Width, 
      DestY + Image1.Picture.Bitmap.Height); // 線の終了位置
    //ページ区切り線の太さを元に戻す
    Image2.Picture.Bitmap.Canvas.Pen.Width:=1;
    //ペンの色を黒に設定
    Image2.Picture.Bitmap.Canvas.Pen.Color := clBlack;
    //ペンのスタイルを直線に戻す
    //Image1.Canvas.Pen.Style := psSolid;
  end;

begin

  //複数回クリックを防止する
  Button2.Enabled:=False;

  //初期化
  Image1.Picture:=nil;

  //印刷設定(用紙・向き)後に印刷

  //プリンタの設定を取得
  Printer.GetPrinter(Device, Driver, Port, DeviceMode);
  DevMode := GlobalLock(DeviceMode);
  try
    //用紙サイズをA4に設定
    DevMode^.dmPaperSize := DMPAPER_A4;
    //用紙方向を縦に設定
    DevMode^.dmOrientation := DMORIENT_PORTRAIT;
    //設定をプリンタに反映
    Printer.SetPrinter(Device, Driver, Port, DeviceMode);
  finally
    GlobalUnlock(DeviceMode);
  end;

  //TImageの初期設定
  Image1.Width := 827;
  Image1.Height := 1169;
  Image1.Picture.Bitmap.Width := 827;
  Image1.Picture.Bitmap.Height := 1169;

  //背景を塗りつぶす
  Image1.Picture.Bitmap.Canvas.Brush.Color := clWhite;
  MyRect:=Rect(0, 0, 827, 1169);
  Image1.Picture.Bitmap.Canvas.FillRect(MyRect);

  //使用するフォント(必ず等幅フォントを指定する)
  //数値の右揃え用に追加(20240820)
  Image1.Picture.Bitmap.Canvas.Font.Name:='Consolas';

  //フォントサイズ
  Image1.Picture.Bitmap.Canvas.Font.Size:=11;
  //フォントサイズ <- 要らなかった!
  //Image2.Picture.Bitmap.Canvas.Font.Size:=11;

  //平均値を計算  intDenominはグローバル変数として宣言
  {
  DSum:=0;
  for i := 1 to StringGrid1.RowCount do
  begin
    if StringGrid1.Cells[5,i] <> '' then
    begin
      DSum:= DSum + StrToInt(StringGrid1.Cells[5,i]);
    end;
  end;
  DAvg:= SimpleRoundTo(DSum / intDenomin, -2);

  //最高値及び最低値を計算
  GetMinMaxValues(StringGrid1, 5, MinValue, MaxValue);

  //タイトルを描画
  Image1.Picture.Bitmap.Canvas.Font.Color := clBlue;
  Image1.Picture.Bitmap.Canvas.TextOut(
    StrToInt(EditMarginX.Text), StrToInt(EditMarginY.Text)-30, LabelKoza.Caption);

  //フォント色を変更
  Image1.Picture.Bitmap.Canvas.Font.Color := clBlack;
  }

  //Grid -> CSV
    //実際のプログラムでは、sNameフォルダ内のCSVファイルを読み込み、
    //さらに幾つかフィールドを追加して新しいデータを入力している。
    //印刷では、この新しく入力されたデータを含めて印刷している

    //実際のプログラムでは、LabelSaveFolderName.Captionは別手続きで取得・表示済み
    LabelSaveFolderName.Caption:='SampleData';

    //保存するフォルダへのPath
    csvFN:=IncludeTrailingPathDelimiter(ExtractFilePath(Application.ExeName))+
      'ProcData\'+LabelSaveFolderName.Caption+'\';

    //フォルダの存在を確認、なければ作成
    if not System.SysUtils.DirectoryExists(ExtractFileDir(csvFN)) then
    begin
      //フォルダ階層を作成
      System.SysUtils.ForceDirectories(ExtractFileDir(csvFN));
    end;

    csvFN:=IncludeTrailingPathDelimiter(ExtractFilePath(Application.ExeName))+
      'ProcData\'+LabelSaveFolderName.Caption+'\'+LabelSaveFolderName.Caption+'.csv';
    SaveStringGridToCSV(StringGrid1, csvFN);

  StringList:=TStringList.Create;
  Fields:=TStringList.Create;

  try

    //Create
    StringList.LoadFromFile(csvFN);
    //Create
    SetLength(FieldWidths, 0);

    //各フィールドの最大幅を計算
    for i := 0 to StringList.Count - 1 do
    begin
      Fields.CommaText := StringList[i];
      if Length(FieldWidths) < Fields.Count then
        SetLength(FieldWidths, Fields.Count);

      for j := 0 to Fields.Count - 1 do
      begin
        //MaxWidth := Printer.Canvas.TextWidth(Fields[j]);
        MaxWidth := Image1.Picture.Bitmap.Canvas.TextWidth(Fields[j]);
        if FieldWidths[j] < MaxWidth then
          FieldWidths[j] := MaxWidth;
      end;
    end;

    eNum:=StringList.Count div 50;

    //PreView用TImageの初期設定
    Image2.Width := 827;
    case eNum of
      0:Image2.Height := 1169;
    else
      Image2.Height := 1169 * (eNum + 1);
    end;
    Image2.Picture.Bitmap.Width := 827;
    case eNum of
      0:Image2.Picture.Bitmap.Height := 1169;
    else
      Image2.Picture.Bitmap.Height := 1169 * (eNum + 1);
    end;    

    //背景を塗りつぶす
    Image2.Picture.Bitmap.Canvas.Brush.Color := clWhite;
    case eNum of
      0:MyRect:=Rect(0, 0, 827, 1169);
    else
      MyRect:=Rect(0, 0, 827, 1169 * (eNum + 1));
    end;
    Image2.Picture.Bitmap.Canvas.FillRect(MyRect);

    //51,101,151,201,251,301,・・・,XX1番目にフィールド名を挿入しておく

    //0番目の要素をコピー
    myFieldElement:=StringList[0];
    //要素を挿入(追加)
    if eNum<>0 then
    begin
      for i := 1 to eNum do
      begin
        StringList.Insert((50*i)+1, myFieldElement);
      end;
    end;

    //ここから印刷Loop
    try

      for intLoop := 0 to eNum do
      begin

        //初期化(白紙にする)
        Image1.Picture.Bitmap.Canvas.Brush.Color := clWhite;
        MyRect:=Rect(0, 0, 827, 1169);
        Image1.Picture.Bitmap.Canvas.FillRect(MyRect);
        {
        //印刷プレビューだから不要
        if intLoop=0 then
        begin
          Printer.BeginDoc;
        end else begin
          Printer.NewPage;
        end;
        }

        //タイトルを描画
        Image1.Picture.Bitmap.Canvas.Font.Color:=clBlue;
        Image1.Picture.Bitmap.Canvas.TextOut(
          StrToInt(EditMarginX.Text), StrToInt(EditMarginY.Text)-30,
          LabelSaveFolderName.Caption);

        //タイトルを描画(計算が必要な場合の例)
        {
        Image1.Picture.Bitmap.Canvas.Font.Color := clBlue;
        Image1.Picture.Bitmap.Canvas.TextOut(
          StrToInt(EditMarginX.Text), StrToInt(EditMarginY.Text)-30,
          LabelKoza.Caption + ' 【平均値:'+FloatToStr(DAvg)+
          '、最高値:'+ FloatToStr(MaxValue)+
          '、最低値:'+ FloatToStr(MinValue)+'】');
        }

        Image1.Picture.Bitmap.Canvas.Font.Color:=clBlack;

        //水平方向の各フィールドの印字開始位置決定用変数を初期化
        k:=0;

        //水平方向の印字開始位置
        MarginX:=StrToInt(EditMarginX.Text);
        //垂直方向の印字開始位置
        MarginY:=StrToInt(EditMarginY.Text);
        //列(フィールド)と列の(余白的な)間隔
        ColMargin:=StrToInt(EditColMargin.Text);

        //ページが変わったら初期化する
        iPlus:=0;

        case intLoop of
          0:begin
            LowNum:=0;
            if StringList.Count > 50 then
            begin
              HighNum:=50;
            end else begin
              HighNum:=StringList.Count-1;
            end;
          end;
          {
          1:begin
            LowNum:=51;
            if StringList.Count > 100 then
            begin
              HighNum:=100;
            end else begin
              HighNum:=StringList.Count-1;
            end;
          end;
          2:begin
            LowNum:=101;
            if StringList.Count > 150 then
            begin
              HighNum:=150;
            end else begin
              HighNum:=StringList.Count-1;
            end;
          end;
          }
        else
          //一般化
          LowNum:=(intLoop*50)+1;
          if StringList.Count > (intLoop*50)+50 then
          begin
            HighNum:=(intLoop*50)+50;
          end else begin
            HighNum:=StringList.Count-1;
          end;
        end;

        for i := LowNum to HighNum do
        begin
          Fields.CommaText := StringList[i];
          for j := 0 to Fields.Count - 1 do
          begin
            //処理できる列数を無制限にする
            case j of
              0:k:=0;
            else
              k:=k+FieldWidths[j-1]+ColMargin;
            end;
            //フィールド名に「備考」を追加する
            if i=0 then
            begin
              if j=Fields.Count-1 then
              begin
                Fields[j]:=Fields[j]+' 備考';
              end;
            end;

            //データを出力(数値の右揃え:なし)
            //Image1.Picture.Bitmap.Canvas.TextOut(MarginX+k,MarginY+(iPlus*20),Fields[j]);

            //データを出力(数値の右揃え:あり)
            //数値の右揃え用に追加(20240820)
            if TryStrToInt(Fields[j], intValue) then
            begin
              //数値である -> 右揃えで出力する
              Image1.Picture.Bitmap.Canvas.TextOut(MarginX+k,MarginY+(iPlus*20),
                Format('%3d', [strToInt(Fields[j])]));
            end else begin
              //数値でない -> 左揃えで出力する
              Image1.Picture.Bitmap.Canvas.TextOut(MarginX+k,MarginY+(iPlus*20),Fields[j]);
            end;

            //罫線を描画
            if cbLine.Checked then
            begin
              Image1.Picture.Bitmap.Canvas.Pen.Color:= clBlack;
              FontHeight:= -1 * Image1.Picture.Bitmap.Canvas.Font.Height;
              Image1.Picture.Bitmap.Canvas.MoveTo(MarginX+k, MarginY+(iPlus*20)+FontHeight+4);
              Image1.Picture.Bitmap.Canvas.LineTo(Image1.Picture.Bitmap.Width-50, MarginY+(iPlus*20)+FontHeight+4);
            end;
          end;

          inc(iPlus);

        end;

        //Image1のBitmapをImage2の(XX, YY)の位置に複写
        case intLoop of
          0:CopyBitmapToImage(Image1, Image2, 0, 0);
        else
          CopyBitmapToImage(Image1, Image2, 0, 1169 * intLoop);
        end;

      end;

    finally
      //Printer.EndDoc;
    end;

  finally
    StringList.Free;
    Fields.Free;
    //複数回クリックを防止する
    Button2.Enabled:=True;
  end;

  //ファイルの完全削除
  DeleteFile(PChar(csvFN));

  //Imageの高さをScrollBoxのスクロール範囲に反映
  ScrollBox1.VertScrollBar.Range := Image2.Picture.Bitmap.Height;

  //TImageの表示位置を指定
  ScrollBox1.VertScrollBar.Position:=0;
  ScrollBox1.HorzScrollBar.Position:=0;
  Image1.Top:=ScrollBox1.VertScrollBar.Position+14;
  Image1.Left:=ScrollBox1.HorzScrollBar.Position+14;
  Image2.Top:=ScrollBox1.VertScrollBar.Position+14;
  Image2.Left:=ScrollBox1.HorzScrollBar.Position+14;

  //TImageの表示
  Image1.Visible:=False;
  Image2.Visible:=True;

end;


【実行結果】

実行結果は、次の通り。用意したデータ件数は320件。

1ページ目


スクロールして下へ。表示されているのは、最終ページ。
※ マウスのホイールを廻してスクロールさせるには別途コードの記述が必要(後述)。

最終ページ


マウスのホイールを廻して、TImageをスクロールさせるには、FormのOnMouseWheelイベントの手続きを次のように作成する。

procedure TForm1.FormMouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
var
  LDelta:Integer;
  //追加
  LWinCtrl:TWinControl;
  LCurPos:TPoint;
begin

  {
  //TScrollBox のマウスホイールによるスクロール
  //マウスがTScrollBoxの外にあってもスクロールする・・・ならこちら☆
  LDelta:=WheelDelta div 5;
  if ssCtrl in Shift then
  begin
    ScrollBox1.HorzScrollBar.Position:=ScrollBox1.HorzScrollBar.Position-LDelta;
  end else begin
    ScrollBox1.VertScrollBar.Position:=ScrollBox1.VertScrollBar.Position-LDelta;
  end;
  Handled:=True;
  }

  //マウスカーソルが TScrollBox の領域内にある時だけスクロールを可能にする
  LCurPos := ScrollBox1.Parent.ScreenToClient(MousePos);
  if PtInRect(ScrollBox1.BoundsRect, LCurPos) then
  begin
    LDelta := WheelDelta div 3;
    if ssCtrl in Shift then
    begin
      ScrollBox1.HorzScrollBar.Position := ScrollBox1.HorzScrollBar.Position - LDelta;
    end else begin
      ScrollBox1.VertScrollBar.Position := ScrollBox1.VertScrollBar.Position - LDelta;
      //Memoも連動してスクロールさせる
      {
      if LDelta > 0 then
      begin
        Memo2.Perform(WM_VSCROLL, SB_LINEUP, 0);
      end else begin
        Memo2.Perform(WM_VSCROLL, SB_LINEDOWN, 0);
      end;
      }
    end;
  end else begin
    //マウス直下のコントロールを取得
    LWinCtrl := FindVCLWindow(MousePos);
    //TStringGridの場合
    if LWinCtrl is TStringGrid then
    begin
      if WheelDelta > 0 then
      begin
        LWinCtrl.Perform(WM_VSCROLL, SB_LINEUP, 0);
      end else begin
        LWinCtrl.Perform(WM_VSCROLL, SB_LINEDOWN, 0);
      end;
    end;
  end;

  //この1行を忘れないこと!
  Handled:=True;

end;


【印刷プレビューコードの工夫】

1.ページ毎に作成されるImage1のBitmapを、Image2のCanvasの指定位置に複写する。
2.最初にページ数を調べ、Image2の高さをページ数にあわせて高くしておく。
3.1の複写手続きの最後に、ページ区切り線を描画するコードを追加(20240820)。

1.に関して、Image1のBitmapをImage2のCanvasに複写する手続き

  //Image1のBitmapをImage2の指定位置へ複写する
  procedure CopyBitmapToImage(Image1, Image2: TImage; DestX, DestY: Integer);
  var
    SrcRect, DestRect: TRect;
  begin
    // ソースの矩形を設定
    SrcRect := Rect(0, 0, Image1.Picture.Bitmap.Width, Image1.Picture.Bitmap.Height);

    // 目的地の矩形を設定
    DestRect := Rect(DestX, DestY, DestX + Image1.Picture.Bitmap.Width, DestY + Image1.Picture.Bitmap.Height);

    // Image2のCanvasにImage1のBitmapを複写
    Image2.Picture.Bitmap.Canvas.CopyRect(DestRect, Image1.Picture.Bitmap.Canvas, SrcRect);
  end;

    //追加(20240820)
    //ページ区切り線を表示するコードを追加
    //ペンの色を青に設定
    Image2.Picture.Bitmap.Canvas.Pen.Color := clGray;
    //ページ区切り線の太さ
    Image2.Picture.Bitmap.Canvas.Pen.Width:=3;
    //ペンのスタイルを点線に設定
    //Image1.Canvas.Pen.Style := psDot;
    //ペンのスタイルを直線に設定
    Image1.Canvas.Pen.Style := psSolid;
    //線を引く
    Image2.Canvas.MoveTo(0, DestY + Image1.Picture.Bitmap.Height); // 線の開始位置
    Image2.Canvas.LineTo(Image2.Picture.Bitmap.Width, 
      DestY + Image1.Picture.Bitmap.Height); // 線の終了位置
    //ページ区切り線の太さを元に戻す
    Image2.Picture.Bitmap.Canvas.Pen.Width:=1;
    //ペンの色を黒に設定
    Image2.Picture.Bitmap.Canvas.Pen.Color := clBlack;
    //ペンのスタイルを直線に戻す
    //Image1.Canvas.Pen.Style := psSolid;
  end;

ページ区切り線については、いろいろ試行した結果、やや太い灰色の直線が最も適している(ほどよく自己主張するが、データほどではない)と感じたので、そのように設定。上のコードにはその痕跡を残している。


1.に関して、複写する手続きを呼び出すコード。

        //Image1のBitmapをImage2の(XX, YY)の位置に複写
        case intLoop of
          0:CopyBitmapToImage(Image1, Image2, 0, 0);
        else
          CopyBitmapToImage(Image1, Image2, 0, 1169 * intLoop);
        end;


2.に関して、ページ数に応じてImage2の高さを高くするコード。

    eNum:=StringList.Count div 50;

    //PreView用TImageの初期設定
    Image2.Width := 827;
    case eNum of
      0:Image2.Height := 1169;
    else
      Image2.Height := 1169 * (eNum + 1);
    end;
    Image2.Picture.Bitmap.Width := 827;
    case eNum of
      0:Image2.Picture.Bitmap.Height := 1169;
    else
      Image2.Picture.Bitmap.Height := 1169 * (eNum + 1);
    end;

7.まとめ

(1)StringGridのデータを用紙と向きを指定して罫線付きで印刷するコードを掲載
(2)(1)のコードを流用して、印刷プレビューを表示するコードを掲載
(3)変数名を付ける時は既存の関数名等との衝突に十分に注意する。

8.お願いとお断り

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

引き返す勇気


雲に覆われたピークまでの高低差は、残り100 m。

そこに行くだけの力は、まだ残っていた。


しかし・・・

標高に比例して強まる風。

確実に悪化する天候。

残り100mの高度を往復するのに必要な時間と体力。

予報では、明日は未明から雨・・・

予定を変更して、今日中に下山すれば、最も危険な鎖場を天候が持つうちに通過できる・・・

ただし、予定2日分の行程を今日の日没までに歩かねばならない。


行くか、戻るか。

この状況から判断すれば、選択すべき答えは明らかだ。

いつかまた、ここへ 来ればいい。

登頂を断念し、僕たちは引き返すことを選んだ。


標高が下がると、先ほどまでの強風は徐々に弱まり、

冷気を孕んで吹く風は「天然のクーラー」のようで 心地よかった。

左足親指の巻き爪にできた、小さな肉芽腫の痛みだけが、自分の中の不安要素だが。

でも、まだ、足を引きずらずに歩くことは出来る・・・

パーティの仲間たちを心配させるわけにはいかない。

ゼリー飲料

途中の小屋前の広場で大休止。昼食を摂るために湯を沸かす。

バーナーの力強い音を聞きながら、ふと隣を見ると何もせずに手元を見つめているきみがいた。

そうか・・・。この先には、往路、登攀に苦しんだ連続する鎖場がある・・・

「食べたくないのかい?」

そう問うときみは涙色の目をして、無言で頷いた。

今日の行程は長い。グリコーゲンが尽きたら歩けなくなる。

何としても日没までにベースキャンプまで降りなければならない。

「ゼリーなら食べれる?」

頷くきみに、僕はザックから行動食のゼリー飲料を取り出した。

アタック時のエネルギー補給用に、重いのを我慢して持ってきたものだ。

ここまで運んできたことを思うと少しのためらいはあったが、今はそれより大切なことがある。

ゼリー飲料を受け取ったきみがそのキャップを廻すのを見て、一安心。

「大丈夫。登れたんだ。降りれないわけがない。」

きみは涙目のまま、少し笑って、頷いた。

クライミング・リーダー

「 ザイル出せ 」

登攀リーダーは力強くそう言うと、受け取ったザイルを左肩に掛け、切り立った崖に立った。

その姿は、古代ローマの戦士のように見えた。

体力に優れたサブリーダーがザックのピストン輸送を登攀リーダーに申し出た。

ロッククライミングの経験が豊富な登攀リーダーがメンバーと自らをザイルで結ぶ。

短い言葉で、的確にステップの切り方を指示。

最後に僕が降りて、最大の難所である連続した鎖場をメンバー全員が無事通過した。


よかった。でも、まだここは雲の上だ。

僕たちは、あの雲の下へ行かねばならない。

水場

標高が下がるにつれて気温と湿度が高くなり、発汗が激しくなった。

山頂近くで吹いていた冷たい強風が嘘のようだ。

休憩時だけでなく、身体が欲する度、ひと口、ふた口と、少しずつ水を飲む。

ゴクゴク、音を立てて飲みたくなるが、必死で我慢する。

朝、1.5L あったはずの水。出発時にはその重さから必要十分な量といつも思えてならないが・・・

ザックのハーネスに付けたペットボトル内の水の残量は、今、残り1/3もない。

登りで水を補給した、岩清水の湧く水場が、もう近いはずだ・・・。


水は、ザックの重さを左右する・・・。

水を入れると極端に重みを増すザック。

今回の山行では、真水2.0Lに加え、ペットボトル飲料500mLを3本用意した。

これだけで3.5kg・・・。山行初日、荷の重量は20kgを超過した。

ザックの比較的高い位置に水をパッキングしたため、岩場の登攀時に身体が振られて困ったが。

ヒトは水無しではいられない。


ようやく水場へ到着。岩の割れ目から清らかな冷水がこんこんと湧き出している。

この山系に降った雨が、地下に染み渡り、岩盤で濾過され、冷水となって・・・

ここで湧き出すまでに、いったいどれくらいの歳月を必要とするのだろう・・・


先に到着したメンバーが、歓声をあげて水をペットボトルに詰めている。

水を汲む前に、ペットボトルに残ったぬるい水を一気に全部飲む。

ここまで運んできた水だ。捨てる気になど、到底、なれない。

ザックを開けて空の水筒も出し、ペットボトルと合わせて冷水1.5Lを補給する。

ここでは我慢する必要はない。

古第三紀の花崗岩で濾過された透明で美しい水をペットボトル1本分、そのまま飲む。

ゴクゴク・・・ のどが鳴る。

( なんて うまい 水 なんだろー! )

再び、補給してペットボトルを冷水で満たす。

持っている水筒とペットボトルをフル活用すれば3.5L補給することも可能だが1.5Lに留める。

山行3日目で軽くなったと言っても、まだザックの重さは間違いなく15kg以上ある・・・

これを16kgにするか、18kgにするか、この状況で、どちらか一つを選ぶなら・・・

少しでも軽く・・・ 少しでも軽く・・・ そう気持ちが傾くのは当然だ。

とにかく、この水がなくなる前に、ベースキャンプまで降りなければならない。

ようやく太陽は大きく傾きはじめ、日没が少しずつ近づいてくる。

あとは時間との競争だ。

僕の体力は持つだろうか・・・

肉芽腫

悪いことに、左足親指の爪の左側にできた肉芽腫が次第に強く痛むようになってきた。

時折り、大電流が流れて、強く痺れるような、激しい痛みが僕を襲う。

そうなると、とても歩くどころではない。

両ひざに手をついて、じっと痛みがおさまるのを待つ。

傍から見れば、バテて休憩しているようにしか見えないだろう・・・。


記憶にある往路は、木の根が縦横に入り組んだ、傾斜のきつい、一歩の高低差の大きい登り道。

所々に風化した花崗岩の露頭・・・そう、真砂の上を登る箇所もあった・・・

登り始めから森林限界を超えるまで、その風景の繰り返しだった。

今は、登りが下りに変わっただけで、ゴールまで記憶にあるこの風景が続くのだ。

泣いても、わめいても、誰も僕を救援してはくれない。

自分の命は、自分で運ぶしか ない。

山と交わした その約束は 絶対 だ。


実は、山行前から左足に小さな違和感があった。

山行の一週間ほど前に足の指の爪を切った際、左足親指の爪を少し深く切りすぎたのだ。

( しまった! )と思った時は、後の祭り。


爪と指の細胞のつながりの部分を、僕は切ってしまっていた・・・。


山行2日目に一人用テントの中で、就寝前に靴下を脱ぐと、そこには小さな肉芽腫が出来ていて・・・

流れ出る血と膿を見た瞬間、たまらなく不安になったけれど、

これ以上酷くならないことを祈りながら、絆創膏をそっと患部に貼るくらいしか・・・

僕にできることはなかった・・・。


山行3日目の今日は、朝から状態を1度も確認していないのだけれど、

痛みから想像して、肉芽腫が成長していることだけは間違いない。

今、ここで出来る「治療」など、あるわけがない。

痛みは、生きている証拠。

そう考えて痛みに耐え、一歩一歩前へ進む。

きみと小休止

気がつくと、僕の前を行く きみが 少しずつ遅れ始めた・・・。

決して初心者ではない、きみだけれど、

危険を避けるために必要な予定プラスアルファの行動は、

おそらく、きみの体力とギリギリいっぱい。

そのちいさな肩に、今日のザックは少し重かったに違いない。

僕の左足の痛みは増す一方だけれど、まだ、きみと同じ速さで歩くことは出来る。

僕は、そっと、きみの後ろへついた。


「少し、休んでも いいですか?」

僕の本当を知らない きみがかけてくれた声は、僕の心の声だった。

最後の小休止

みんなが小休止する小広場に、ふたりは少しだけ遅れて到着。

ザックを降ろす間もなく、そのまま地面に崩れ落ち、僕はタオルで汗を拭う。

( もう少しで、ゴールだ・・・ )

ただ、それだけを思う。

息が荒いわけではない。熱中症の心配も、まずない。

呼吸は正常。意識も明瞭。まだ、水もある。

だけど・・・ もう、足が動かない・・・。


ザックのウエストベルトのポケットからブドウ糖のタブレットを取り出す。

錠剤を2つ、掌に落として口へ運び、そのまま、ガリガリと噛み砕く。

ここまで幾度となく、この行動を繰り返してきたけれど、感覚として「何か」が違う。

もしかして、グリコーゲンが尽きた? 多分、そうだ。

( もうすぐ・・・ 動けなくなる )

日没まで、残された時間はあとわずか・・・

もし、引き返していなかったら・・・

登攀リーダーの決断の本当を、体験として理解できた瞬間だった。


経験豊かな登攀リーダーは、山行全体を見ていた。

単に「頂上直下が強風」だから「下山する」のではなく、

そこから山頂を往復するまでに消耗する体力と時間、

さらに、今後悪化する天候を見越して、

今日中にベースキャンプまで降りるのに必要な体力と時間。

メンバー全員のそれを、すべて計算した上での判断だった。


隣ではサブリーダーが、地面に座り込んだきみに声をかけていた。

「あたまを前に・・・」

水場で汲んできた冷たい水をかけてもらって、

きみは少しだけ、自分を取り戻した。

登攀リーダーは、予め、このシーンがあることを予測していたに違いない。


「ここから先は、これまでより高低差のない道がゴールまで続きます・・・」

地図を確認したメンバーが、みんなに説明する声が聞こえる。

最後の出発の合図だ。


地面に降ろしたザックと向かい合う。

左右のショルダーハーネスを掴んで、両手でザックを持ち上げ、両ひざの上に乗せる。

荷の重さを実感する瞬間だ。

そのまま、向かって右のショルダーハーネスに左腕を通す。

身体を右に回転させ、両ひざを伸ばし、その反動を利用して、ザックを背にする。

ウエストベルトを締めて、ショルダーハーネスのスタビライザーを引く。

そこにどんな物理的理由があるのか、僕にはわからないが、ザックは急に軽くなる。

( 唯、歩めば 至る アイン ツバァイ ドライ・・・)

遠い日の記憶を胸に、パーティの最後尾を僕は行く。

きみが左右に揺れながら、僕の前を歩いている・・・。

きみと歩く

行動を開始したのは、午前5時8分だった。

もう、それから12時間以上が経過している・・・。

木々の合間に見える谷の風景。まだ、その底は見えない。

谷底には、ベースキャンプがあるはずだ。

ベースキャンプさえ、見えたなら・・・


きみと僕の歩みは、もどかしいまでに遅くなる。

気持ちはどんなに歩きたくても、もう足が上がらない・・・ 足が前に出ない。

そうだ・・・ 前にも、同じシーンがあった・・・。


確かに・・・ 今と、同じシーンがあった・・・

あの時も・・・

きみは、歩みを止めなかった。


きみの歩みに導かれて

僕は、歩き通すことができた。


今も、きみが前にいる。

きみが、ゆっくりと、歩いている。

それが、今、僕にある 確かなことの すべてだ。

ベースキャンプ

木々の合間に、緑色のテントが見えたような気がした。

よく見るとそれはしかし、日差しを浴びた谷の反対側の森だった。

谷底を流れる川の音はずっと聞こえているが、大きくも小さくもならない。

所々に「倒木に注意」と書かれた看板があり、チェーンソーで切断された丸太が転がっている。

確か、登りはじめに、見た風景だ。


あと何メートルだろう?

あとどれだけ歩けば、いいのだろう?

山行の終わりは、いつも自分の限界との戦いだ・・・。


何か、谷ではないものが、見えた気がした。

木立の隙間に見えるものは、間違いなく平らな地面だ。

とうとう、帰ってきた・・・。

同時に、視野の左に動きを感じる・・・。


人が登ってくる・・・

ザックを置いたサブリーダーだ。

僕たちを心配して、迎えに来てくれたんだ。


合流したサブリーダーがきみの状態を確かめている。

「 ゴールまでがんばろうか 」

体力に優れたサブリーダーは、しかし、きみのザックを背負おうとはしなかった・・・。

きみの気持ちへの最大限の配慮が、その言葉から感じられた。


三人で歩く道は、いつしか広くなり、自動車も入れる林道となった。

その林道の向こうから、みんなが手を振ってやってくる。

先にゴールしたみんながザックを置いて、最後尾の僕たちを迎えに、

いま、降りたばかりの道をのぼってくる。


目指したピークには、誰も立てなかった。

でも、メンバーの誰一人、後悔なんかしていない。

それは全員の表情を見て明らか。みんな笑顔だ。

ピークに立つ、それ以上に大切なことを

僕たちは、この山行で学んだから。


それは ・・・ 「 引き返す勇気 」

言葉にすれば、わずか6文字だけど・・・。


でも、僕は信じたい。

「 引き返す勇気 」が・・・ 導いてくれた明日を。


あの雲と、風の、彼方に・・・

僕たちの頂きがあった。


僕たちは、いつか、そこへ行く。

必ず、行く。


それで、いいじゃないか。


それが、僕たちの勇気との、約束だから・・・。


うん。

大切な約束だから・・・。

塗りつぶさないマークシート

「塗りつぶす」方式でなく、より簡易な「線を引く」方式でマークするシートの例。

複数マーク可能なマークシート(選択肢は0~99 に対応)を作成したら、マークする時間そのものを短縮する必要性を痛感。今回は「よりはやく」・「よりカンタン」にマーク可能なシート作りに挑戦。

追記(20240929)

当Blogで紹介してきた自作のデジタル採点プログラムを一つにまとめました。次のリンク先にその紹介とダウンロードリンクがあります。マークシートも、ここに紹介した形式の他、様々なタイプのものを同梱しています。

上のリンク先で、ここで紹介したマークシートを含む、デジタル採点プログラム一式をダウンロードできます。

【もくじ】

1.もっとはやくマークできないか?
2.凡例として線でマークして違和感のないカタチは?
3.「線」マークの読み取りテスト
4.まとめ
5.お願いとお断り

1.もっとはやくマークできないか?

設問数が100ある試験で、複数マークを可とした場合、受験者は制限時間内に最大で200近いマークを塗りつぶさなくてはならない。制限時間が50分の試験で、190個マークするとして、1個2秒でマークした場合、マークするのに必要な時間は380秒、すなわち6分20秒となる。1個3秒でマークした場合の必要時間は、なんと9分30秒。制限時間の1/5がマークするためだけに使われてしまう。

採点者がラクをするのに、無理やり付き合わされる受験者の不満が爆発するのが見えるような気がして、小心者の筆者は「マークするために必要な時間を短縮する」にはどうしたらいいか、必死で考えた。

これまでに使用してきたマークシートのマークは、すべて選択肢の番号を縦長だ円で囲んだもの。

これまでに使用してきたマークシート


実際には、テストしてみると、次のようにマークしても読み取りパラメータの設定次第で十分読み取り可能なのだが・・・

こんなマークでも、実際には読み取りが可能。


しかし、受験者の心理として、選択肢が縦長だ円で囲まれていれば、だ円内を塗りつぶしたくなるもの。塗りつぶさず、「線」でマークしてもらうには、「線」でマークしたくなる形状にマークシートを改良しなければならない。

最初に考えたのは、「選択肢の番号を縦長四角形で囲む」という方法。

たとえば、こんな感じ


ただ、これだと、凡例で次のようにマーク方法を示してあっても・・・

どちらかと言えば、これはむしろ「悪いマーク」の例


真面目な受験者であれば、あるほど・・・

枠内を塗りつぶさなくてはいけないと考えるのが自然。


かといって、次のようにすると、デザインとして美しくない気がするし、四角形の幅が狭まったたけで「塗りつぶし」たくなる気持ちは同じ。

塗りつぶし面積が減少しただけ?


そんな、こんな理由から縦長四角形で選択肢の番号を囲むというアイデアは見送ることに決定。

2.凡例として線でマークして違和感のないカタチは?

では、凡例として線でマークしてあっても受験者に違和感を与えないマークとは、どんなマークか?

思いついたのは「囲みのない」マーク。これなら・・・

凡例として「線」が使えるし、塗りつぶしたくても塗りつぶす枠がない!


ただ、これだとマークシートっぽくない気が・・・。

マークシートらしくするために一工夫した結果・・・

[ ] 記号で数字の上下を囲んでみた


これならマークの凡例として、「線」が使えるのではあるまいか?


で、出来上がったのが、このマークシート。

複数マーク可能な「線」でマークするシート(設問数は100設問まで)


このマークシートは、次のリンク先からダウンロードすることができます。

3.「線」マークの読み取りテスト

例え、「線」であっても、これまでの経験からまず間違いなくマークの読み取りには成功すると思ったが、「やっぱりできませんでした!」では使ってくださる方に申し訳がたたないので、念のためテストを実行。

読み取り結果を確認しやすいように、設問番号にマークした次のようなマークシートを作成。やっぱり「線」で引く方が、「塗りつぶし」より遥かにラクであることを実感。これなら1設問に対し2か所マークしても「塗りつぶす」より、全然はやい!!

筆記用具は、シャープペンシルを使用。
芯は、HBの0.5mm。
用紙はホームセンターなどで普通に販売されている白色度の高いコピー用紙を使用。
(普段マークシートの印刷に使用している再生紙より、白色度が高いもの)


MS_Reader.exe を起動し、パラメータ設定はデフォルトのまま、読み取りテストを実行。

スキャナーの解像度は200dpiに設定。
カラー画像としてスキャン。
テスト1回目で、全てのマークの読み取りに成功!


間違いなく読めると思ってはいたけれど、ちょっと(あれっ?)って思ったのは、デフォルトパラメータの設定のまま、テスト第1回目で、全てのマークを正しく読み取ることに成功したこと。

実は、今回、実験で使用した用紙とは異なる、白色度が70%程度の再生コピー用紙を用いて予備的に実験した際は、閾値のパラメータをデフォルト設定より1~3程度大きく設定しないと読み取れないマークがあったのだ。今回、実験したものと「線」そのものの濃さや太さが厳密には異なるから正確なことは言えないが、白色度が高い用紙の方が二値化の際に有利なのだろうか?

・・・ということで、今回の実験では何も問題が起きなかったので、その前に行った白色度が70%程度の再生コピー用紙を使って行った予備実験で発見できた問題と対応方法を紹介。

(これは当Blogの過去記事「100選択肢対応マークシートを使用した試験の実施方法」に書いたものの再録です)

【重要】二値化閾値の修正方法(20240707追加)

マークが「うすい」場合、これを正しく読み取ることができず、「空欄」と判定して「999」と表示される場合があります。同じ理由で、複数マークされた解答欄の「1の位」が読めなかった場合も、読み取り判定は「マークの状態に問題あり」となり、「999」と表示されます。

これらの場合は、この後、実行する「読み取り結果のチェック」時に、該当箇所の解答欄が赤枠で囲まれて表示されますので、マークの状態をヒトの眼で確認し、読み取り結果を修正できます。

最も困るのが、複数マークされた解答欄の「10の位」のマークは薄くて読めなかったが、「1の位」のマークの読み取りには成功している場合です。この場合は正しく読み取れた「1の位」のマークが読み取り結果として表示されてしまいます。大変申し訳ないのですが、MS_Reader.exe のチェックプログラムは、この誤読を見つけることができません!!(これは原理的な問題なので、チェックする方法がありません)

この事故を防ぐには、事前に読み取りテストを十分に行って、読み取りパラメータを調整するしか方法がありません。具体的には、最もマークの濃度が薄い受験者のマークシートが正しく読めるようになるまで、閾値の値を1ずつ大きくして読み取りテストを実行します。筆者の行ったテストでは、デフォルト設定の閾値(180)では正しく読めなかったマークも、閾値を大きくすれば読めるようになりました。

「塗りつぶす」方式でなく、より簡易な「線を引く」方式でマークするシートを用いて行った読み取りテストの例

「64」と読むべき箇所の「10の位」を「空欄」と判定、「1の位」は正しく読めた場合、プログラムは読み取り結果を「4」と表示してしまう。


閾値を「1」大きくすると・・・

正しく読めるようになりました。


ごく薄いマークも正しく読めるようになるまで、この操作をくり返します。筆者の行ったテストでは、閾値を1ずつ大きくすることで、指示通り普通の濃さ(マーク箇所の数字が読めなくなる濃さ)でマークされたシートであれば、最終的にすべてのマークを正しく読めるようになりました(上記のマークシートを使用して行った実験では、最終的にすべてのマークを正しく読めた段階で、二値化の閾値の値は「184」でした。なお、このマークシートは後日公開する予定です)。

ただ、あまりにもマークの濃さが薄い場合は「原理的に読めません」ので、「対応不可」としてヒトの眼で読むしかないと思います・・・。

そのような事態にならないよう、予め受験者に対し「薄いマークは読み取れない」旨の注意を徹底しておく必要があります。マークシートを用いた試験では、これが最も重要なことかもしれません。

4.まとめ

(1)複数マーク可能なマークシートを使う場合は、「線」でマークできるようにする。
(2)マークシートを印刷する用紙は、白色度の高いものがよい?カモ
(3)マークシートは「濃く」マークするよう、予め注意を徹底する。
(4)筆記用具は、硬さと濃さが2B、太さ0.9mmのシャープペンシルがよいと思われます。

追記_20240709

【注意】複数マーク可能なマークシートでは、音声読み上げ機能は正しく動作しません!

5.お願いとお断り

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