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

解答欄(矩形)検出器を改良しました!

AnswerAreaLocator 実行時の画面


この Blog の過去記事で紹介している手書き答案の採点補助プログラム AC_Reader では、スキャナーでスキャンして Jpeg 形式で保存した試験の解答用紙画像から、解答欄の座標を取得するプログラムを外部的に呼び出して利用しています。

この解答欄の座標を取得するプログラムは、OpenCV の矩形検出機能を使って、その目的を実現しているのですが(掲載しておいてこんなことを言うのもナンですが)、必ずしも意図した通りに動かない場合がありました。

今回、その「いつか直そうと思っていた部分を手直し」して、前よりは少しは意図した通りに動くかな? みたいなプログラムが出来た気がするので、「デジタル採点 All in One」なる大それた名前を付けて世に出してしまったプログラム集のバージョンアップ版として公開させていただきます。

プログラムの名前も、よりわかりやすいものに変更( AnswerAreaLocator.exe )しました(が、単体での使用は事故防止のため非推奨です)。あくまでも AC_Reader.exe から呼び出しての動作が基本ですが、たぶん、以前のモノより、期待通りに動作するものと思われます。万一にでも、バージョンアップしてくれないかなーと思われていた方が「もし、いてくださったら」のお話ではありますが・・・

今回の記事では、そのバージョンアップ内容(正しくは不具合のお詫びとその修正内容)をご紹介させていただきます。

【もくじ】

1.GUIが使いやすくなりました!
2.画像の傾きに強くなりました!
3.ほぼ採点する順番に解答欄を検出できるようになりました!
4.マウスのアイコンがデフォルト状態に戻るようになりました!
5.必要なフォルダがない場合には警告を表示するようになりました!
6.常に最大化して実行する設定にしてやっぱりやめました!
7.最大化から非最大化した際に画面中央にフォームを表示します!
8.ダウンロードのご案内
9.まとめ
10.お願いとお断り

1.GUIが使いやすくなりました!

以前のユーザーインターフェイスは、次のようなものでした。

「画像の傾きを補正する機能を重視」した結果、操作方法がわかりにくい設計となっておりました。


新しいプログラムのユーザーインターフェイスです。基本的に、左から右へ操作していただければ作業がスムースに進むように改良しました。

画像の傾きの補正機能は残しましたが、使用しなくても動作するように修正しました。


スキャナーでスキャンした画像のすべてが、目視状態で明らかに傾いて(左右いずれかの方向に回転して)いる場合がありますので、画像の回転を行って、傾きを補正する機能は残しましたが、機能の実装方法そのものを見直し、負の数で左へ回転/正の数で右へ回転、Prev ボタンで効果を確認、UnDo ボタンでやり直し、実行ボタンで全画像に修正を適用というように簡略化しました。

また、矩形検出「する/しない」の境界を決める閾値も、以前は面積を利用するようにしていましたが、新しいプログラムでは、検出限界とする幅もしくは高さをピクセル単位で指定できるように変更しました。使っていただければ、お分かりいただけると思うのですが、例えば以下のような場合、自動的に小さな矩形を最初から無視しますので、より解答欄の矩形だけを検出する方向に進化できたのではないかと思います。

矩形検出を実行した段階で設問番号の「1」を囲む矩形は検出対象から自動的に外されます。


また、これは以前と同じですが、「6文字で答えよ」と文字数を指定して解答させたい場合は、検出したい矩形の外枠を実線で、内部を点線として予め解答欄を作成(描画)しておくことで、後から手動で範囲指定をやり直さなくとも、取得したい解答欄そのものを自動的に取得できます。

点線は、目視で線がつながっていないことが確認できれば大丈夫(検出されません!)。


ちなみに、点線は、誰もが使っているであろう「あのソフトウェア」で描いたものです。上の図の点線は、下の赤枠内の点線を利用して描画しました。

ちなみに実線は、赤枠の4つ下の実線です。


それから、間違っていたらごめんなさい。赤枠の1つ上の細かな(?)点線は、要注意の線です。私の見間違いかもしれませんが、以前、この線を利用する中で「とても不思議な現象に出会った」ことがあり、それ以来、この線は簡易的な利用にとどめ、本格的な何か(色を変えたりみたいな)には利用しないようにしています。詳しくは書きませんが、いろいろワケありの線のようです・・・

また、GUI で、ブロックと表現している部分の考え方ですが、これは採点する順番に解答欄座標を並べることができるように、解答用紙を幾つかのブロックに分けて、そのブロック内で横書き答案であれば「左 → 右」かつ「上 → 下」へ、国語で使われる縦書き答案であれば「上 → 下」かつ「右 → 左」へ、解答欄の座標を検出します。

上のような場合には、「2」ブロックを指定します。

2.画像の傾きに強くなりました!

以前のバージョンで、最も対応困難であったのが「スキャンした画像の傾き」です。

以前の勤務先で使用していた複合機では、気になるほどスキャンした画像が傾くことなどなかったのですが、今の勤務先で使用している複合機のスキャナーは(同じメーカーさんの同じ型番の製品ですが)、スキャンすると画像がことごとく右肩上がりになるこの固体特有のクセがあり、サービスマンの方に修正を依頼しても「これはちょっと難しいですね・・・」と断られてしまった経緯もあって、自分では紙送りローラーのクリーニングくらいしかできませんので、たいへん困っておりました。

もちろん、傾きと言っても、わずか 0.1° 程度の傾きですので、私以外に誰一人、問題にする人なんていませんが・・・

私はものすごく気になるのです!

なぜか? というと・・・ 私の神経が細やかとか、そんな問題ではなく、どちらかと言えば、私は神経が少し足りないんじゃないかと思うことの方が多いくらいです・・・。その証拠に『点くのが遅い蛍光灯のようなお子さんですね!』と小学校時代、担任の先生から言われたと母親が語っておりましたし、私はその時、多分言葉の意味そのものが理解できず、おそらく褒められたに違いないと勘違いして、むしろ、喜んでいたのではないか? とも思います。ヽ(=´▽`=)ノ

とにかく、これまでの矩形検出プログラムで解答欄矩形の座標を検出して、採点する順番になるように並び替える際、横書き答案であれば「 Y 座標の値が小さいものから順に、左から右へ並べ替える」アルゴリズムを採用しているため、解答用紙の画像が左へ傾いていると、座標原点 0,0 が左上であるため、右側の解答欄ほど Y 座標の値が小さくなり、検出した座標を並び替える際に「上から下へ」の順番はなんとか守れても、「左から右へ」が「右から左へ」と、「一部の解答欄座標の並びが逆転」してしまうわけです。

この修正が大変な手間で・・・

( AC_Reader を使ってくださる方のお手伝いをする際に、いつも、そう感じ・・・ )

ほんとうに、申し訳なく・・・

私自身の心情など、この際、極めて、どうだっていいコト・・・ では、ありますが・・・

私といっしょに暮らしているヒトは、とてもやさしくて、かわいい、イイひとなのですが、極々稀に、ブチ切れると、ながーい間、沈黙した挙句・・・ 私は、完全に悪くないと思えてならないときでも・・・

おまえが、わるい。

必ず、そう言います。

控えめに「そうなの?」と尋ねることにしているのですが、返事は決まって

だって、そうじゃん!

この言葉を聞いた時の心境が、まさに、この場合のそれで・・・。みなさんに、どうにかして、ご理解いただきたい私自身の偽りのない心情なのです・・・

ほんとうに、良かれと信じて、精一杯、その時の自分にある、全身全霊の、すべての力を使って書いた・・・と、そう信じて疑わないプログラム。・・・なのですが・・・

それは・・・悪気なんて全然なく、きみのために良かれと思ってやったこと・・・

でも、その プログラム には、不具合があった・・・。

でも、きみは、なぜか、怒っている・・・。

悪いのは ・・・。

そう、ほんとうに、精一杯、がんばって、「書いたのは間違いない」んだけど・・・ 。

そう、ほんとうに、きみとケ〇カなんて、したくなかった・・・。

だけど・・・ だから・・・

間違ったのは僕なんです。
みんな僕が悪いんです。

一緒に暮らしているヒトと、ケ〇カするといつも、そんな気持ちになります。

で、そんな時、「今日の晩御飯、なぁに?」って彼女に尋ねると・・・

へびとカエル

彼女は、必ずそう答えるのです・・・ 実際に、それが出てきたことは幸いにしてありませんが。

そのように悪いのは私だと理解していますので、以前のプログラムでは、解答欄座標を検出する前に、全画像を傾きがなくなる方向に回転させて、傾きを修正してから解答欄矩形の座標を検出するように手順を工夫していたのです。それは、それで「ない」知恵を絞って考えた自分的には限界とも思える方法だったのですが、この修正を行っても 100 %スムースに作業できるとは到底思えず、(あのプログラム、検出して並び変えた結果の一部は必ず修正が必要な状態なのではなかろうか・・・ある程度はちゃんと動くと思うんだけど・・・、ちょっとでも傾きがあると・・・うーん、困ったぁ)と、思い出す度に同じ思いが込み上げてきて、日々、後悔と、反省と、絶大なる心配とを、交互に繰り返しておりました。

いつか、なんとかしなければ・・・

そう思いながらも、よい方法が思いつかず、更新が先延ばしになってしまいました。お使いいただけた皆さまに、伏してお詫び申し上げます。ほんとうに、すみませんでした。

今回の更新では、正直に言いますと当初、得られた解答欄矩形の座標から、水平方向の直線を複数本検出して、その傾きの平均値を計算し、全自動で画像の傾きを修正する方向でプログラムの修正作業を進めたのです・・・が、残念ながら、現在の私の力では、自分自身が満足できる結果を出すことは出来ませんでした。

そこで、全自動での修正を断念し、画像の傾きを補正する部分と解答欄矩形を検出する部分、両方のアルゴリズムを(自分の力の及ぶ限りの範囲ではありますが)全面的に見直すことにしました。

そこで思いついたのが、横並びの解答欄を「行」のように見なし、Y 方向に「多少のマージン」を設定することで、検出した解答欄座標を理想通りに並べ替えて表示できるのではないかということです。さらに、これが出来れば、解答用紙画像の多少の傾きなど問題ではなくなるはずです。この考えを基にしてスクリプトを書き替えること2度、3度、ようやく思った通りに解答欄矩形の座標を並べ替えて出力できるようになりました。少なくても、私のテストした範囲では、採点する順番で解答欄座標の並び替え出力に成功するようになった・・・と思えるプログラムに改良することが出来ました☆

もちろん、国語の試験で利用される縦書き答案についても、縦並びの解答欄を「列」のように見なし、やはり「多少のマージン」を設定することで、画像が少しくらい傾いていても基本「右から左」かつ「上から下」へという順番で検出した解答欄座標を並べ替えて表示できるように、こちらもプログラムを修正できました。

以下は、Delphi に埋め込んで使用している「横書き答案の解答欄座標を検出して、採点順に並べ替える」 Python Script です(ダウンロードしていただいた Zip ファイルのサイズが大きいのも、展開に時間がかかるのも、Python 用の OpenCV をバックグラウンドで動作させているためです)。

  import cv2
  import numpy as np

  def imread_unicode(path):
      with open(path, "rb") as f:
          data = f.read()
      img_array = np.frombuffer(data, np.uint8)
      return cv2.imdecode(img_array, cv2.IMREAD_COLOR)

  def deskew_image(gray):
      edges = cv2.Canny(gray, 50, 150, apertureSize=3)
      lines = cv2.HoughLines(edges, 1, np.pi / 180, 150)
      if lines is None:
          return gray
      horizontal_angles = []
      for rho, theta in lines[:, 0]:
          angle_deg = (theta * 180 / np.pi)
          if (angle_deg < 10) or (angle_deg > 170):
              adjusted_angle = angle_deg if angle_deg < 90 else angle_deg - 180
              horizontal_angles.append(adjusted_angle)
      if len(horizontal_angles) < 5:
          return gray
      mean_angle = np.mean(horizontal_angles)
      if abs(mean_angle) < 0.3:
          return gray
      (h, w) = gray.shape
      center = (w // 2, h // 2)
      M = cv2.getRotationMatrix2D(center, mean_angle, 1.0)
      rotated = cv2.warpAffine(gray, M, (w, h), flags=cv2.INTER_LINEAR, borderValue=255)
      return rotated

  def detect_inner_boxes(image_path):
      img_color = imread_unicode(image_path)
      if img_color is None:
          raise FileNotFoundError(f"画像が見つかりません: {image_path}")
      img_gray = cv2.cvtColor(img_color, cv2.COLOR_BGR2GRAY)
      thresh = cv2.adaptiveThreshold(
          img_gray, 255,
          cv2.ADAPTIVE_THRESH_GAUSSIAN_C,
          cv2.THRESH_BINARY_INV,
          15, 10
      )
      contours, _ = cv2.findContours(thresh, cv2.RETR_TREE, cv2.CHAIN_APPROX_SIMPLE)
      boxes = []
      for cnt in contours:
          x, y, w, h = cv2.boundingRect(cnt)
          if w > ' + cmbThreshold.Text + ' and h > ' + cmbThreshold.Text + ':
              boxes.append((x, y, w, h))
      inner_boxes = []
      for i, box in enumerate(boxes):
          x1, y1, w1, h1 = box
          rect1 = (x1, y1, x1 + w1, y1 + h1)
          contains_other = False
          for j, other in enumerate(boxes):
              if i == j:
                  continue
              x2, y2, w2, h2 = other
              rect2 = (x2, y2, x2 + w2, y2 + h2)
              if rect1[0] <= rect2[0] and rect1[1] <= rect2[1] and rect1[2] >= rect2[2] and rect1[3] >= rect2[3]:
                  contains_other = True
                  break
          if not contains_other:
              inner_boxes.append(box)

      if not inner_boxes:
          return []
      y_tolerance = max(5, int(np.median([h for (_,_,_,h) in inner_boxes]) * 0.5))
      inner_boxes.sort(key=lambda b: b[1])
      sorted_boxes = []
      current_row = []
      current_y = None
      for b in inner_boxes:
          x, y, w, h = b
          if current_y is None:
              current_y = y
              current_row.append(b)
          elif abs(y - current_y) <= y_tolerance:
              current_row.append(b)
          else:
              current_row.sort(key=lambda b: b[0])
              sorted_boxes.extend(current_row)
              current_row = [b]
              current_y = y
      if current_row:
          current_row.sort(key=lambda b: b[0])
          sorted_boxes.extend(current_row)
      inner_boxes = sorted_boxes
    
      for idx, (x, y, w, h) in enumerate(inner_boxes, start=1):
          var1.Value = str(x) + "," + str(y) + "," + str(x + w) + "," + str(y + h)
      return inner_boxes

  if __name__ == "__main__":
      image_path = r"' + 'CutImage0' + IntToStr(i) + '.jpg' + '"
      boxes = detect_inner_boxes(image_path)

横書き答案で、ブロックの指定が2以上である場合がありますので、この処理を for ループの中に埋め込んでいます。また、この横書きでブロックの指定が2以上である答案の場合には、2ブロック目に検出した座標の値のx座標を一律補正するような処理も Delphi 側で必要ですが、核心部分はなんと言っても、上のスクリプトです。思えば、ここに至るまで、はや幾年月・・・

横書き用が出来てしまえば、あとはそれを縦書き用に書き換えるだけです。「縦書き答案用のスクリプト」は次の通りです。

  import cv2
  import numpy as np

  def imread_unicode(path):
      with open(path, "rb") as f:
          data = f.read()
      img_array = np.frombuffer(data, np.uint8)
      return cv2.imdecode(img_array, cv2.IMREAD_COLOR)

  def detect_inner_boxes(image_path):
      img_color = imread_unicode(image_path)
      if img_color is None:
          raise FileNotFoundError(f"画像が見つかりません: {image_path}")
      img_gray = cv2.cvtColor(img_color, cv2.COLOR_BGR2GRAY)
      thresh = cv2.adaptiveThreshold(
          img_gray, 255,
          cv2.ADAPTIVE_THRESH_GAUSSIAN_C,
          cv2.THRESH_BINARY_INV,
          15, 10
      )

      contours, _ = cv2.findContours(thresh, cv2.RETR_TREE, cv2.CHAIN_APPROX_SIMPLE)

      boxes = []
      for cnt in contours:
          x, y, w, h = cv2.boundingRect(cnt)
          if w > ' + cmbThreshold.Text + ' and h > ' + cmbThreshold.Text + ':
              boxes.append((x, y, w, h))

      inner_boxes = []
      for i, box in enumerate(boxes):
          x1, y1, w1, h1 = box
          rect1 = (x1, y1, x1 + w1, y1 + h1)
          contains_other = False
          for j, other in enumerate(boxes):
              if i == j:
                  continue
              x2, y2, w2, h2 = other
              rect2 = (x2, y2, x2 + w2, y2 + h2)
              if rect1[0] <= rect2[0] and rect1[1] <= rect2[1] and rect1[2] >= rect2[2] and rect1[3] >= rect2[3]:
                  contains_other = True
                  break
          if not contains_other:
              inner_boxes.append(box)

      if not inner_boxes:
          return []
      x_tolerance = max(5, int(np.median([w for (_,_,w,_) in inner_boxes]) * 0.5))
      inner_boxes.sort(key=lambda b: b[0], reverse=True)
      sorted_boxes = []
      current_col = []
      current_x = None
      for b in inner_boxes:
          x, y, w, h = b
          if current_x is None:
              current_x = x
              current_col.append(b)
          elif abs(x - current_x) <= x_tolerance:
              current_col.append(b)
          else:
              current_col.sort(key=lambda b: b[1])
              sorted_boxes.extend(current_col)
              current_col = [b]
              current_x = x
      if current_col:
          current_col.sort(key=lambda b: b[1])
          sorted_boxes.extend(current_col)
      inner_boxes = sorted_boxes

      for (x, y, w, h) in inner_boxes:
          var1.Value = str(x) + "," + str(y) + "," + str(x + w) + "," + str(y + h)

      return inner_boxes

  if __name__ == "__main__":
      image_path = r"CutImage01.jpg"
      detect_inner_boxes(image_path)

こちらについては「横書き答案」とは異なり、私が想定した範囲では「現状」ブロックに分割しての処理の必要性が感じられませんでしたので、Loop での処理は考慮しておりません。

3.ほぼ採点する順番に解答欄を検出できるようになりました!

極端な例として(いくらなんでも、これはないと思いますが)-1.00° ほど故意に画像を傾けて実験してみました。

「回転」に負の数を指定すると画像は左へ回転します。


左へ -1.00° 故意に回転させた画像に対して、解答欄座標の検出を行ってみた結果です。画像がどういう状態であろうと、傾きがあろうと、なかろうと、それに関係なく、プログラムが解答欄矩形の座標を左から右へ、そして上から下へ認識してくれたなら、夢はほんとうになります。

この夢は・・・

他の誰かが、既に実現した夢でもかまいません。私にとっては、まだ、成し遂げていない夢ですから。たとえ、だれひとり、この夢の成就を待っていてくれる人など、いなくても・・・

人の夢と書いて、「儚い」と読むそうですが、これほど、私の思いに重なる言葉はありません・・・。

僕の書いた・・・ プログラムは、僕の夢の結晶。

だから・・・ 人の夢の結晶が、たとえ「儚い」ものであっても・・・

うん。「儚い」ものでしか、なくても・・・

そこに込めた様々な願いと祈りは・・・

僕にとっての「ほんとう」です。

だから僕は、心から、それを いとしく おもいます。

プログラムは修正なしで、「解答欄 エ」よりY座標が大きい「解答欄 ア」を最初の座標に選んでいます。
設問番号「1」部分の矩形は、閾値の設定により検出対象外となっています。
この場合の座標原点は、左上が(0,0)です。


これだけの傾きがあっても、今回修正したプログラムは、ようやく長い間この胸に思い描き続けた夢の通りに動いてくれるようになりました。今回、全自動での補正(修正)処理は実現できませんでしたが、自分的には、この結果から見て・・・おそらく、今後、手動での傾きの補正処理はほぼ不要になるのではないか? と考えます。この実験結果より、「My 解答欄矩形の検出プログラムは、これまで内在していた不具合を一掃できるレベルに到達できた」と判断していいかも・・・と、ようやく思えた次第です。

ものすごく、遠いむかしに、断層を解析し、それを形成した応力場を描くプログラムを書いたことがあります。その際に非常に苦しんだのが PC の座標設定と、中学・高校以来慣れ親しんだ数学的な座標設定の相違でした。

当初、私は「座標原点は数学で学んだのと同じ X 軸と Y 軸の交点の位置にある」というように思い込んで、先人の書いたコードを読んでいましたので・・・

( 座標原点は、いったい、どこなんだ? )

と、大混乱。ようやく「座標原点は左上にある」と理解してからも、なお・・・

( 原点を移動して、解析図を描画するためには、ナニを、どう修正すればいい? )

あの時、大いに悩んだ経験が今回大いに役立ちました☆

ただ・・・、余弦定理の力を初めて知って、私に魂が震えるような感動の経験を与えてくれた・・・

あの断層解析プログラムは、
まだ1度も使っていません☆

が。

まぁ、作るのが楽しかった ♪ から、全然、自分的には「いい」のでありますが・・・

今後、断層解析の科学論文、書くことも、あり得ないし・・・

今はただ・・・ 青春を「理科」に賭けた思い出だけが、懐かしい。

*(^_^)* ♪

4.マウスのアイコンがデフォルト状態に戻るようになりました!

「当たり前のことじゃないか? なにバカなことを言ってるんだ」

そう言われても仕方がないことなので、こちらについても心からお詫びするしかないのですが・・・

実は、これも前から気になっていたことなのですが・・・、これまでのプログラムでは解答欄矩形の座標を取得後、時々、マウスのカーソルの形状が「上下左右の四方を向いた矢印」になり、デフォルトの「左斜め上を向いた白い矢印」に戻らなくなってしまう現象が、時々発生しておりました。

もちろん、ずっと気にはしていたのですが、でも、「何とかしなきゃ」と思いながらも、気づけばこちらも放置したままになってしまいました。理由は2つあって、1つはカーソルの形状が変化するだけで機能的な部分には(実用上何も)問題が生じなかった(つまり、見た目だけの問題であると認識していた)こと、2つめはそもそも「どこをどうしたら直せるのか」それがよくわからなかった・・・というのが私の中での、ほんとうです。

こんな不出来なプログラムを、耐え難きを・・・堪えて、それでもお使い下さった皆さま、ほんとうに、ありがとうございます。この件につきましても、ここであらためて、こころからお詫び申し上げます。重ね重ねではありますが、誠に、誠に申し訳ありませんでした。

今回の見直しにあたって、ようやく本気で「このままではいけない!」と思い、まず、その原因を探るところから修正作業を始めることにしました。まず、「いつ・どこで・何をするとカーソルの形状が変化したまま、元に戻らなくなるのか」それを明らかにする必要があります。私は、問題を再現すべくプログラムを様々に操作してみました。なかなか思った通りに問題が再現できず、ちょっと時間がかかりましたが、ようやく(変な言い方ですが)思った通りに問題を再現することが出来るようになりました。明らかになった問題発生に至るまでの操作は、次の通りです。

解答欄矩形の座標を取得すると表示されるラバーバンドの中をポイントすると、マウスカーソルの形状が次のように変化します。

この上下左右の四方を向いた矢印から成るカーソルは、
「サイズ変更カーソル」(Resize Cursor)という名前のようです。


この状態で、下向きの矢印キーを押し下げると TMemo 内のカーソルが次の座標に移動し、それに合わせてラバーバンドの位置が次の解答欄矩形上に移動します。

TMemo にフォーカスがあり、カーソルは2行目に移動します。
プログラムは2行目の座標を読み取り、その位置に赤い矩形を表示します。


この時、困ったことが起きます。ラバーバンドの外に出たらデフォルト状態に戻るはずのマウスカーソルの形状変化が起きず、その形状は「サイズ変更カーソル状態のまま」になってしまいます。下図はその状態をハードコピーしたものです。

マウスカーソルがデフォルトの白い矢印に戻りません!


ただし、機能的には何の問題もなく、このままの状態でボタンクリック等、通常通りの操作が可能です。このことが、この問題への対応がここまで遅れた原因の1つとなりました。

通常通り操作できますが、あまり気分がよくありません。


ここで、マウスカーソルをもう一度ラバーバンド内に戻してあげると、マウスカーソルの形状はデフォルトの白い矢印に戻るのですが、いちいちそんな操作はやってられません。

ラバーバンド内の左側領域をポイントするとデフォルト状態に戻ります。


この後、マウスカーソルをラバーバンド内から再度外に出します。カーソルの形状はデフォルト状態のままですが、再度、ラバーバンド内にカーソルを戻すとその形状は「サイズ変更」状態に変化し、ラバーバンドの外へ出すとデフォルト状態に戻ります。つまり、カーソルを動かすのではなく、カーソルを固定したまま、ラバーバンドの方を動かすと問題が発生することがわかりました。

マウスカーソルの形状は、デフォルト状態に戻りました。


詳しい原因はまだわかりませんが、とにかく、問題の核心部分がマウスカーソルの形状の制御にあることは明らかですので、次にそれがどのように実現されているのか、確認してみることにしました。

ラバーバンドを表示する部分のプログラムは、Mr.XRAYさんの TplResizeImage クラス(コンポーネント)を使わせていただき、Pen の太さと色を私が追加で指定しています。

この TplResizeImage.pas を開いて、じっくり読んでみます。すると、マウスの形状の制御は FSelected という Bool 型の変数で行われていて、これが True のとき、形状がサイズ変更カーソル(crSizeAll)になり、False のとき、デフォルト(crDefault)になることがわかりました。以下、その制御部分の抜粋です。

  TplResizeImage = class(TImage)
  private
    FSelected        : Boolean;

  ・・・

      if FSelected then begin
        Screen.Cursor := crSizeAll;
      end else begin
        Screen.Cursor := crDefault;
      end;

で、次の手続きで、マウスがコントロールから離れたらカーソルの形状をデフォルトに戻す設定になっていることもわかりました。

//=============================================================================
//  TplResizeImageクラス
//  CM_MOUSELEAVEメッセージ処理
//  マウスがコントロールから離れたらカーソルの形をデフォルトに戻す
//=============================================================================
procedure TplResizeImage.CMMouseleave(var Message: TMessage);
begin
  inherited;
  if not FSelected then exit;
  Screen.Cursor := crDefault;
  FResizeState  := irsNone;
end;

これより「マウスがコントロールから離れた」ことが確認できないところから問題が起きているのではないかと、ようやく、問題の原因らしきものが見えてきました。

どうしたらいいか、ひたすら考えます。すると、コメント文の中に次の一文が・・・

  //SetBoundsを実行すると,Resizeメソッドが自動実行される
  SetBounds(ALeft, ATop, Width, Height);

で、その Resize 部分を読んでみると・・・

procedure TplResizeImage.Resize;
var
  ALeft        : Integer;
  ・・・
begin
  ・・・
  SetBounds(ALeft, ATop, AWidth, AHeight);
  ・・・
end;

解答欄矩形の幅や高さが変わった場合は、必ず Resize が呼ばれます。そこで、ここに保険のような感じで、マウスのカーソルを元に戻す処理を追加しました。

//=============================================================================
//  TplResizeImageクラス
//  TImageのResizeメソッド
//  リサイズが発生すると自動的に呼ばれる
//=============================================================================
procedure TplResizeImage.Resize;
var
  ALeft        : Integer;
  ・・・ 省略 ・・・
begin
  ・・・ 省略 ・・・

  //サイズ変更後も必ずカーソルを戻す
  Screen.Cursor := crDefault;

  inherited Resize;
end;

これで解答欄矩形の幅や高さが変わった場合には、Resize 手続きが呼ばれ、マウスカーソルの形状が必ずデフォルト状態に戻ります。ただ、問題は幅や高さが変わらない場合です。幅や高さが変わらない解答欄は実際たくさんありますから、ここは手抜きをせず絶対にきちんと対応しなくてはなりません。

ただ、上に示したように Resize 手続きの中で SetBounds しているので、Resize 手続きは座標を入れ替える度に必ず呼ばれるような気もするのですが、より確実な方法を設定しておきたいと思い、カーソルの移動に使用している矢印キーの OnKeyDown イベントが使えないかと考えました。

考えました・・・が ・・・、よくよくコードを見ると、

TplResizeImage = class(TImage)

KeyDown は TWinControl 由来のイベントですが、TplResizeImage は TImage( = TGraphicControl )で親が違います。結論だけ言えば、 TImage はフォーカスを受け取れません。したがって KeyDown イベントは書いても無駄です・・・

と、ここで・・・

それなら、逆に、Form の方で KeyDown イベントを拾えばいいのではないか? と、ようやく気づき、

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key in [VK_LEFT, VK_RIGHT, VK_UP, VK_DOWN] then
    Screen.Cursor := crDefault;
end;

さらに、より確実に動作するよう OnKeyUp イベントにも同じ処理を記述します。

procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  if Key in [VK_LEFT, VK_RIGHT, VK_UP, VK_DOWN] then
    Screen.Cursor := crDefault;
end;

で、Form が他のコントロールより先にキーボードイベントを取得できるように FormCreate 手続きで、KeyPreview: = True を設定しておきます。

procedure TForm1.FormCreate(Sender: TObject);
begin
  KeyPreview:=True;
end;

これで完璧かと思いましたが、Application.OnMessage を使ってグローバルに押されたキーを監視し、矢印キーが押された場合にはマウスのカーソルをデフォルトに戻す処理も追加しておくことにしました。こちらは構造的な意味でも、保守性を高める意味でも Form のメンバーとして記述します。こうしておけば、何年か経って今日の作業内容を完全に忘れてしまった場合でも、Private 宣言部分を参照すれば、何を設定したのかがわかり、メンテナンスしやすいコードにすることができます。

私は、そのような意味から、手続きだけでなく関数も Form のメンバーとして記述するようにしています。むかしは何でもかんでも Form のメンバーにしていたのですが、この Blog を書くようになってから、他から呼び出す必要のない手続きや関数は、「ネストされた手続き(Nested Procedure)」 または 「ネストされた関数(Nested Function)」 として記述することも多くなりました。コードを読むのと、( Blog の記事用に)コピペするのが楽だからというのが、その主な理由です。

type
  TForm1 = class(TForm)
    ...
  private
    //Application.OnMessage を使ったグローバルキー監視
    procedure AppMessageHandler(var Msg: TMsg; var Handled: Boolean);
  end;

で、Shift + Ctrl + C で手続きを作成し、実装します。

procedure TForm1.AppMessageHandler(var Msg: TMsg; var Handled: Boolean);
begin
  case Msg.message of
    WM_KEYDOWN, WM_KEYUP:
      case Msg.wParam of
        VK_LEFT, VK_RIGHT, VK_UP, VK_DOWN:
          Screen.Cursor := crDefault;
      end;
  end;
end;

最後に、FormCreate で登録しました。

procedure TForm1.FormCreate(Sender: TObject);
begin
  Application.OnMessage := AppMessageHandler;
end;

これで Form がアクティブ(フォーカスがある)な時も、非アクティブ(フォーカスがない)な時も、常にマウスのカーソルをリセットできるようになったはずです。

実行して確認しました!

ラバーバンドの内部をポイントして、カーソルを「サイズ変更型」に変えます。


下向きの矢印キーを押し下げます。ラバーバンドは次の解答欄へ移動します。マウスカーソルの位置はそのままですが、その形状は・・・

マウスカーソルはデフォルトの白い矢印に無事戻るようになりました☆


余談ですが、このマウスカーソルの形状も含めて画面のハードコピーを取るのはどうしたらいいものかと、今回、少し悩んでしまいました。Windows11の機能のみで行うなら、拡大鏡を固定(?)にして PrintScreen を実行すれば出来るみたいなことを AI が言ってましたが、せっかく Delphi があるんだし、ヒマもあったので、マウスカーソルの形状も含めて画面のハードコピーを取るプログラムを自分で書いてしまいました。後日、機会がありましたら、この Blog でご紹介したいと思います。

5.必要なフォルダがない場合には警告を表示するようになりました!

この解答欄矩形の座標検出プログラムは、ユーザー目線で見ると、ただ1枚の画像だけを扱うプログラムのように見えると思うのですが、実はそうではありません。

画像の傾きを補正して解答欄矩形の座標を取得する機能を追加した段階で、傾きの補正を行った場合には、すべての画像に対して傾き補正を行って上書き保存する処理がどうしても必要になり、採点作業に必要な全画像を処理できるように(1つ前のバージョンで)プログラムを修正しました。

詳しく説明すると、手書き答案の採点補助プログラム( AC_Reader )側では、採点前の真っ新な解答用紙画像と、採点データ(採点記号や得点等)を書き込んだ採点済み解答用紙画像の2種類の画像を使用していますので、傾き補正を行った場合は、両方の画像データを補正して上書き保存する必要が生じるわけです。

今回、全面的にプログラムの見直しを行ったわけですが、その中で、あろうことか、採点済み解答用紙画像を保存しておくフォルダ(フォルダ名: MarkedAnswerSheet )が必ず存在しているという前提でコードを書いていることが判明しました。

もちろん、AC_Reader 側で(正規の・・・というか、私が決めた流れで)画像変換を行って、AC_Reader からこの解答欄矩形の座標を検出するプログラムを呼び出して作業を行う場合は何の問題も生じませんが、単にスキャンした画像を1枚だけ保存した任意のフォルダを指定して、このプログラムを直接単体で実行した場合、採点済み解答用紙画像を保存するフォルダがそもそもありませんから、最初に行う解答用紙画像の選択段階で「確実にエラーが発生」します。

このエラー(というか、正しくは不幸な事故)を防止するために、修正する前のバージョンでも、このプログラムを単体で起動した場合にはパスワードの入力を求めるように設定して、事故を防止する方策としていたわけですが、今回の見直し作業の中で、テスト用の解答用紙画像を作成し、種々の確認作業を行ったところ、作った本人が採点済み解答用紙画像を保存するフォルダの準備を失念してしまい、初めて内在していたこの欠陥に気づいた次第です。

どぉしてこんなにバカなのか・・・

そこで次のように、採点済み解答用紙画像を保存するフォルダがなかった場合には警告を表示するようにプログラムを修正しました。

  //読み込むデータのあるフォルダへのPathを取得して表示
  SrcPath:=ExtractFilePath(imgPath)+'MarkedAnswerSheet';

  //フォルダの存在を確認 -> ない場合は警告してExitする
  if not System.SysUtils.DirectoryExists(SrcPath) then
  begin

    strMsg:='動作に必要なフォルダがありません!'+#13#10+
      'AC_Readerで「画像変換」を行ってから、再度実行してください。'+#13#10+#13#10+
      '処理を中止します。';
    Application.MessageBox(PChar(strMsg), PChar('エラー'), MB_ICONERROR);

    ・・・ 省略 ・・・
    Image1.Picture.Assign(nil);
    Exit;
  end;

5.の記事を書いた真意ですが、このプログラムを単体で起動するとパスワード入力を求められますので、「フリーソフトと言いながら、ふざけんな!」と気分を悪くされた方も、もしかしたらいらっしゃるかもしれないと思い、なぜ、パスワード入力が必要なのか、その本当の理由を記した次第です。

6.常に最大化して実行する設定にしてやっぱりやめました!

解答欄矩形を示すラバーバンドの位置を解答欄上に正しく表示するには、画面は常に最大化して表示する必要があります(最大化表示していないと解答欄矩形とラバーバンドがずれて表示されます)。

こちらの問題も修正しようかとも思いましたが、このプログラムを実行する場合、画面は最大化して作業するのが最も効率がよく、何か他の画面と並べて作業する必要性もないので、Form は常に最大化して表示する設定とし、通常 Form の右上にある最大化及び最小化ボタンは表示しないようにプログラムを変更しました。

また、通常の場合、最大化状態で Form のタイトルバーをクリックしてアクティブにし、そのままタイトルバーをドラッグ&ドロップすると Window 内の任意の位置へ、設計時の大きさになった Form を移動できますが、上記の理由から、この時やはりラバーバンド位置が解答欄矩形からズレます。これを防止するため、Form のタイトルバーをクリックしてドラッグ&ドロップする機能は無効化しました。

この Form の設定に使用したコードは、以下の通りです。

  private
    //最初に1回だけ設定を実行するための確認フラグ
    F_FormActivated: Boolean;

    //タイトルバーは残したまま「最大化解除できない」ように設定
    procedure WMSysCommand(var Msg: TWMSysCommand); message WM_SYSCOMMAND;
    procedure WMNCLButtonDown(var Msg: TWMNCLButtonDown); message WM_NCLBUTTONDOWN;

procedure TForm1.FormCreate(Sender: TObject);
begin

  //Formの最大化ボタン及びドラッグ&ドロップを制御(禁止)する
  F_FormActivated := False;
  //最大化して表示する
  Form1.WindowState := wsMaximized;
  //ここで実行するとFormがタスクバーを覆い隠してしまう -> FormActiveで実行する
  //BorderIcons := [biSystemMenu, biMinimize];

end;

procedure TForm1.FormActivate(Sender: TObject);
begin
  if not F_FormActivated then
  begin
    BorderIcons := [biSystemMenu];
    F_FormActivated := True;
  end;
end;

procedure TForm1.WMNCLButtonDown(var Msg: TWMNCLButtonDown);
begin
  if Msg.HitTest = HTCAPTION then
    Exit; // タイトルバーをドラッグしても動かせない
  inherited;
end;

procedure TForm1.WMSysCommand(var Msg: TWMSysCommand);
begin
  // 「元に戻す」「サイズ変更」を禁止
  if (Msg.CmdType = SC_RESTORE) or (Msg.CmdType = SC_SIZE) then
  begin
    Exit;
  end;
  inherited;
end;

・・・と、ここまで修正(?)したのですが。

ちょっと待て!
おまえ、逃げてない?

・・・ みたいな声が聴こえた気がして。(。>__<。)

「このプログラムを実行する場合、画面は最大化して作業するのが最も効率がよく、何か他の画面と並べて作業する必要性もない」

それって、言い訳じゃない?

なので、上のような現実逃避的「逃げの一手」みたいな卑怯な方法を取らず、やっぱり、ここも

ちゃんとする!

ことにしました。

取りあえず、上で行った設定を全部解除して・・・

画面を最大化せずに、プログラムを実行してみます。これまで、そのようなことをしたことがなかった(してみようとも思わなかった)ので、こんな欠陥が内在していることに、やはり気づかなかったのです。画面を非最大化した状態で、このプログラムを実行されました皆々さまには、大変なご迷惑をお掛けしたことと思います。こちらにつきましても、心より、こころよりお詫び申し上げます。

1つ前のバージョンを「非最大化」して実行すると・・・(後ろは Delphi の IDE です)

ラバーバンドの描画位置がズレてしまいます・・・


そこで最大化した場合でも、非最大化した場合でも、ラバーバンドが同じ位置に描画されるようにコードを修正しました。次がその修正したつもりのコードです。

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

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

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

begin

  if not EditTF then
  begin

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

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

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

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

    //コンポーネントを生成し,イベントを定義し,位置を指定して画像を表示
    plImage1:= TplResizeImage.Create(Self);
    plImage1.Parent:= ScrollBox1;
    plImage1.TransEvent:= True;

    //画像内座標
    p1 := Point(x1, y1);
    p2 := Point(x2, y2);
    //クライアント座標 -> スクリーン座標(Image1基準)
    p1 := Image1.ClientToScreen(p1);
    p2 := Image1.ClientToScreen(p2);
    //スクリーン座標 -> フォームのクライアント座標(Form基準)
    p1 := Form1.ScreenToClient(p1);
    p2 := Form1.ScreenToClient(p2);
    //ラバーバンドの座標を設定(フォームのクライアント座標で配置)
    plImage1.SetBounds(p1.X, p1.Y, p2.X - p1.X, p2.Y - p1.Y);

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

  end;

end;

上記コードを実行してみた結果です。最初に画面を最大化して表示した場合・・・

解答欄矩形に対して、ラバーバンドがわずかではありますが右下へズレています。


続けて、非最大化( Window 右上の「最大化ボタン」をクリック)した場合です。最大化ボタンを押して非最大化するというのも、なんともおかしな表現ですが、再度、このボタンをクリックすれば最大化されるので、やはりこれは最大化ボタンでいいのかな?

やはり微妙にズレてはいますが、位置的には先ほどと同じところに描画されています。
なので、半歩前進というところでしょうか?
背景は Delphi の IDE です。


この微妙なズレは、なぜ生じたのでしょうか? コードを追いかけてみます。

(1)OpenCV の矩形検出機能で読み取った解答欄矩形の座標を TMemo から読み込む。
(2)座標をカンマで切り分けて変数に代入。
(3)Image1.ClientToScreen( ) で、TImage の画像内座標をスクリーン座標に変換。
(4)Form1.ScreenToClient( ) で、スクリーン座標をフォームのクライアント座標に変換。
(5)plImage1.SetBounds( )で、ラバーバンドの描画位置を指定。
(6)plImage1.Selected := True で、ラバーバンドを描画。

どこにもおかしなところはない気がします。OpenCV が正しく読み取って保存したはずの解答欄矩形の座標の数値が間違っているとは到底思えませんし・・・

何が原因かと言えば、SetBounds 関数に渡した値がズレの原因であることは間違いありません。

SetBounds 関数に渡した値がズレの原因・・・

SetBounds 関数に渡した値がズレの原因・・・

SetBounds 関数に渡した値がズレの原因・・・

では、SetBounds 関数は、何の座標系に基づいてラバーバンドを表示しているのか・・・というと、座標系をフォームのクライアント座標に変換して渡しているから、フォームのクライアント座標で描画・・・ した結果・・・ それがちょっとズレてしまう・・・

・・・ってコトは、もしかして、僕は・・・変換すべき座標系を間違えて・・・渡して・・・ る?

    //コンポーネントを生成し,イベントを定義し,位置を指定して画像を表示
    plImage1:= TplResizeImage.Create(Self);
    plImage1.Parent:= ScrollBox1;
    plImage1.TransEvent:= True;

あ”!

そうだ! 解答用紙の画像はデカいから絶対にスクロールが必要で・・・

スクロールの設定でも、いつか、さんざん悩んだけれど。

plImage1 の親は、Form1 じゃなくて・・・

ScrollBox1 ・・・

plImage1 を Image1 の上に重ねて表示したいわけだから、この場合、plImage1.Parent := Image1; とするのが最も自然・・・なんだけれど、Image1 は TGraphicControl なので、子コントロールを持てないから、plImage1 の親は Image1 の親、つまり、ScrollBox1 にしてたんだ・・・。

だから、ラバーバンド( plImage1 )は ScrollBox の座標系で描画しないといけない・・・

ここまでわかれば、もう、必要ない気がするけど、念のため、確認。

    //親を確認
    ShowMessage(plImage1.Parent.Name);

表示されたのは・・・(当たり前ですが)


これでズレた原因がはっきりしました。ScrollBox のクライアント座標でラバーバンドを描画すれば、先ほどの微妙なズレは解消されるはずです。

    p1 := Point(x1, y1);
    p2 := Point(x2, y2);
    // クライアント座標 -> スクリーン座標(Image1基準)
    p1 := Image1.ClientToScreen(p1);
    p2 := Image1.ClientToScreen(p2);
    // スクリーン座標 -> plImage1 の親(ScrollBox1)のクライアント座標に変換
    p1 := plImage1.Parent.ScreenToClient(p1);
    p2 := plImage1.Parent.ScreenToClient(p2);
    // ラバーバンド表示(親のクライアント座標系で配置)
    plImage1.SetBounds(p1.X, p1.Y, p2.X - p1.X, p2.Y - p1.Y);

コードを修正して、実行してみました。最初に、全画面表示の場合です。

ラバーバンドは、解答欄矩形の上に完全に重なって描画されました!


続いて、非全画面表示の場合です。

こちらもOK!


たったひとつ、だけ・・・ ですが、今回も、よくなれた気がします!

7.最大化から非最大化した際に画面中央にフォームを表示します!

上の6.の記事を書いている時に、もうひとつ気になることが出来てしまいました。それは何かというと、最大化状態から非最大化した際に、Form の右側が画面の外にはみ出した状態で表示されてしまうことです。

「最大化」ボタンはちらっと見えていますが、「閉じる」ボタンは完全に見えません・・・


詳しいことはわかりませんが、この表示位置は私の方で何かした覚えがありませんので、おそらく OS 側で決めているのではないか・・・と思うのですが、やはり、これは何とかしたいところです。

私は普段は「1366×768」サイズに設定したモニターを使ってプログラムを書いています。職場ではもっと高解像度のモニターを与えられていますが、もともと大きさ的に限界のあるノート PC のモニターに必要以上の解像度設定は不要だと思います。若い方ならいざ知らず、年寄りには小さな画面&高解像度のモニター環境は厳しすぎる気がします。

ちなみに、このプログラムを書くために使用している Panasonic CF-QV は「2880×1920」の解像度が「推奨」設定されています。この高解像度モニターを「1366×768」という「低」解像度に落として使う私は、何か、もったいないコトをしているのでしょうか?

Word や Excel の使用が主、つまりビジネス用途である場合、コストパフォーマンス的にも、バッテリー効率の面から見ても、文字サイズや視認性の点でも、「普通に使いやすい・無理してない」という感覚的な面からも、汎用モニターにおける最適な画面解像度はやはり「1366×768」であると私的には思えてなりませんので、あくまでも独断ですが、私はこのサイズで収まるように GUI を作成しています。

ですので、この解答欄矩形の座標を検出するプログラムも、設計時の Form の幅は・・・

「1364」ピクセル!


Windows がその気になれば、ギリ! 幅1366 ピクセルの画面内に収めて、全体が見えるように表示できるはずなのですが、現実には右側が切れて表示されてしまいます。

自分でなんとかするしか、なさそうです。

で、どうしたか、というと・・・

  private
    { Private 宣言 }

    //「最大化->元に戻す」で画面の中央に表示
    FPrevWindowState: TWindowState;  //Window の状態を取得する
    procedure AdjustFormPosition;  //Form の表示位置を設定

グローバル変数と手続きをひとつずつ宣言して、Shift + Ctrl + C で手続きを実装。

で、通常状態に戻ったときに Form を中央に表示する AdjustFormPosition 手続きは・・・

procedure TForm1.AdjustFormPosition;
var
  WorkArea: TRect;
begin
  //フォームが属しているモニタのワークエリアを取得(マルチモニタ対応)
  WorkArea := Monitor.WorkareaRect;

  //横方向の調整
  if Width < (WorkArea.Right - WorkArea.Left) then
    Left := WorkArea.Left + ((WorkArea.Right - WorkArea.Left) - Width) div 2
  else
    //はみ出す場合は左端に寄せる
    Left := WorkArea.Left;

  //縦方向の調整
  if Height < (WorkArea.Bottom - WorkArea.Top) then
    Top := WorkArea.Top + ((WorkArea.Bottom - WorkArea.Top) - Height) div 2
  else
    //はみ出す場合は上端に寄せる
    Top := WorkArea.Top;

end;

FormCreate 時に、Form の状態を取得しておきます。

procedure TForm1.FormCreate(Sender: TObject);
begin
  //「最大化->元に戻す」で画面の中央に表示
  FPrevWindowState := WindowState;

あとは、Form の OnResize イベントで、前回が最大化で、今回が通常状態なら、Form を中央に表示する処理を行うように設定。

procedure TForm1.FormResize(Sender: TObject);
var
  //for 高さの調整
  MemoHight, btnHight:integer;
begin
  //VCLの高さを調整
  ・・・ 省略 ・・・

  //「最大化->元に戻す」で画面の中央に表示
  //ユーザーが普通にフォームをドラッグして幅や高さを変えた場合を除外
  if (FPrevWindowState = wsMaximized) and (WindowState = wsNormal) then
    AdjustFormPosition;
  FPrevWindowState := WindowState;  //最新の状態を保存
end;

実行して、非最大化時の動作を確認します。

Form は、画面の中央に表示されました!


できたー☆

予定した(と言うか、気がついた)修正作業は、全部、無事完了しました!

どなた様も、お待ちになってないことと思いますが・・・

8.ダウンロードのご案内

今回、全面的に不具合を修正しました、この「解答欄矩形の座標を検出するプログラム」と、先日この Blog でご紹介した「自動採点機能みたいなモノを搭載した手書き答案の採点補助プログラム(こちらも様々に内在していた不具合を修正し、Version 3.1.0 としました)」及び「マークシートリーダー」、「採点結果通知表並びに成績一覧表作成プログラム」他を1つにまとめた zip ファイルを下記リンク先からダウンロードすることができます。

使用方法につきましては、下記リンク先の過去記事をご参照ください。

高解像度ディスプレイで、プログラムを実行される場合は、次のリンク先の記事の内容も必要に応じてご参照ください。

解答欄矩形の座標を検出するプログラムの操作方法の詳しい解説は(旧版用ですが基本的な操作方法はほとんど同じです)次のリンク先記事をご参照ください。

9.まとめ

あらためて今回の記事の内容を振り返り、これほど多くの不具合が内在していたことに気づかないまま、解答欄矩形の座標検出プログラムを掲載してしまっていたことを、心より深くお詫び申し上げます。

今回の見直しによって多くの問題点を洗い出し、修正することができましたが、もしかすると、まだ発見できていない不具合が残っている可能性も否定できません。

今後、不具合が判明した際には、速やかにこのブログ上でご報告し、修正済みのプログラムが整い次第、あらためてご案内させていただく所存です。今後とも何卒よろしくお願いいたします。

10.お願いとお断り

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

高解像度画面で使いやすくするには?

元々、物理的な大きさに制約のあるノートPCなどでは、モニターの解像度が高くなればなるほど、文字は小さくなり、少なくとも私にとっては「使いやすい」とは言い難い環境になります。

高解像度画面での表示例(2880×1920)
私には、文字が小さすぎて詠めません!


この Blog の過去記事で紹介しているデジタル採点関連のアプリケーションは、横1366 × 縦 768 のディスプレイ解像度での利用を前提に開発しておりますので、高解像度環境で使用される場合には、以下の方法で GUI が適切な大きさで表示されるよう、高 DPI 設定を変更してからお使いいただけますよう、お願い申し上げます。

【もくじ】

1.高 DPI 設定の変更方法 その1(exe のプロパティを表示)
2.高 DPI 設定の変更方法 その2(高DPI設定を変更)
3.高 DPI 設定の変更方法 その3(アプリケーションを起動して確認)
4.補足( DPI 非依存の設計でも発生する問題と対応方法)
5.お願いとお断り

1.高 DPI 設定の変更方法 その1(exe のプロパティを表示)

拡張子が exe の実行形式ファイルを右クリックすると表示されるサブメニューから、プロパティを選んでクリックしてください。

プロパティをクリックします。


お使いの PC の設定によっては、ファイルの拡張子が表示されない場合もあると思います。その場合は、エクスプローラーの画面上部にある「表示」をクリックすると表示されるサブメニューのいちばん下にある「表示」をクリック( or ポイント)し、横に表示されるサブメニューの「ファイル名拡張子」をクリックしてチェックマークを付けると拡張子が表示されます。

青い枠内をクリックすると図のように「大きい縮小版を使って項目を表示」する設定になります。

2.高 DPI 設定の変更方法 その2(高DPI設定を変更)

プロパティの画面が表示されたら、上部のタブの左から2番目にある「互換性」タブをクリックし、表示された画面の「設定」グループにある「高 DPI 設定の変更」ボタンをクリックします。


「〇〇〇.exe の高 DPI 設定」というタイトルの画面が表示されたら、画面下部の「高 DPI スケール設定の上書き」グループの「高い DPI スケールの動作を上書きします。」のチェックボックスをクリックしてチェックし、さらに、その下の「拡大縮小の実行元:」のコンボボックスの選択肢から「システム」をクリックして選択してください。

最初に「チェック」を入れ、次に「選択」の順です。


画面は、次の状態になります。「OK」ボタンをクリックしてください。

「OK」をクリックして、この画面を閉じます。


元の画面が表示されますので、

「適用」ボタンをクリックしてから、
「OK」ボタンをクリックしてください。

3.高 DPI 設定の変更方法 その3(アプリケーションを起動して確認)

高 DPI 設定の変更がアプリケーションに適用されたことを、実際にアプリケーションを起動して確認してください。

高解像度画面( 2880 × 1920 )で、「高 DPI 設定の変更」を行った場合の表示例。
「高 DPI 設定の変更」を行わない場合には読めなかった文字が読めるようになりました!


解像度 1366 × 768 での表示例です。上の高解像度での表示に比べ、縦・横とも狭くなっていますが、表示内容は同じです。

AC_Reader は、解像度 1366 × 768 での使用を前提に開発&動作確認を行っています。

4.補足( DPI 非依存の設計でも発生する問題と対応方法)

この解説を書いていて、初めて気がついたのですが、Form の Scaled プロパティを False に設定し、さらに、アプリケーション全体がDPIスケーリングを無視する( DPI 非依存の設計となる)ように .dpr ファイルを開き※1、Application.Initialize の前に SetProcessDPIAware 関数呼び出し※2 を記述して、実行形式ファイル( exe )を作成した場合でも、画面表示方法の設定によっては表示の一部が読めなくなる等の問題が発生することがわかりました。

※1 Delphi IDE の「プロジェクト」メニューから「ソースの表示」を選択すると編集可能になります。
※2 uses に Winapi.Windows が必要なので追加します。

SetProcessDPIAware 関数とは?

Windowsでは、画面の解像度や物理サイズに応じて、UIを自動的に拡大・縮小する「DPIスケーリング」が行われます。
SetProcessDPIAware 関数は、Windows APIの関数で、「このアプリケーションはDPIスケーリングを自分で管理するから、OS側で勝手に拡大・縮小しないでください」と宣言するために使用します。

Delphiでアプリケーション設計時に Form の Scaled プロパティを False に設定していても(デフォルト設定はなぜか True になっているため)、OSがスケーリングを行うと、「ボタンやラベルの位置がズレる・アイコンがぼやける・マウス座標が合わない・描画が乱れる(特に Panel や Canvas)」といった問題が発生します。

SetProcessDPIAware 関数を使うことで、Windowsはスケーリングを一切行わなくなりますので、アプリケーションの描画はピクセル単位で正確に行われるようになり、Delphi側で設計した通りのサイズ・位置・座標が保たれます。

・・・と、思っていたのですが実際にはそうでもないようです(私の知識不足による間違いかもしれません)。

以下、上記の内容を加えた .dpr ファイルです。

program AC_Reader;

{$R *.dres}

uses
  {$IFDEF EurekaLog}
  {$ENDIF EurekaLog}
  Vcl.Forms,
  Unit03_JPEGConvert in 'Unit03_JPEGConvert.pas' {FormConvert},
  Vcl.Themes,
  Vcl.Styles,
  Winapi.Windows,  //SetProcessDPIAware を使うために追加
  UnitSplash in 'UnitSplash.pas' {SplashForm},
  UnitCollaboration in 'UnitCollaboration.pas' {FormCollaboration},
  UnitNoExcel in 'UnitNoExcel.pas' {frmNoExcel};

{$R *.res}

begin
  SetProcessDPIAware;  //DPIスケーリングを自分で管理する( DPI非依存の設計にする)
  Application.Initialize;
  Application.MainFormOnTaskbar := True;
  Application.CreateForm(TFormCollaboration, FormCollaboration);
  Application.Run;
end.

上の内容でコンパイルして作成したアプリケーションを、実際に高解像度画面( 2880 × 1920 )で実行して確認すると・・・(「高 DPI 設定の変更」なし・「ディスプレイの拡大縮小」は 100 % とした場合です)

TPanel 上に作成した GUI の文字が大きく表示されています。


画面全体では・・・

文字が小さすぎて、私には読めませんが「表示が乱れている」ことは、なんとなくわかります・・・


右上部分を拡大すると・・・

CheckBox のキャプションが大きく表示され、読めなくなっています。


アプリケーション設計時に Form の Scaled プロパティを False に設定し、SetProcessDPIAware 関数を dpr ファイルに記述しても、実行時の設定が「高 DPI 設定の変更」なし・ディスプレイの拡大縮小 100 %であった場合に生じるこの問題への正しい対応方法はまったくわかりません(正直に言って、この解像度で GUI を再作成するしかないのではないか?と思いました)。現在、私にある知識と技術で対応可能な限界が見えたように思います。

ただ、この記事でご紹介した上記1~3の手順で「高 DPI 設定の変更」を行って、「高い DPI スケールの動作を上書きします。」のチェックボックスをチェックし、さらに「拡大縮小の実行元:」で「システム」を設定すれば、解像度( 1366 × 768 )で設計した通りの画面が表示されるようになりました(下図)。ですので、これがこの問題への「正しい対応方法(?)」なのかもしれません。

高解像度画面( 2880 × 1920 )で、「高 DPI 設定の変更」を行った場合の表示例


画面の右側部分を拡大すると・・・

設計通りの画面表示となり、作業するのに特に支障はなさそうです。


以上の理由から、高解像度モニター( 2880 × 1920 など)を使用して、当 Blog の過去記事でご紹介したアプリケーションを実行される場合には、大変お手数をおかけし、恐縮ですが、アプリケーションを実行される前に、この記事でご紹介した「高 DPI 設定の変更」を必ず行っていただけますよう、お願い申し上げます。

5.お願いとお断り

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

PDFファイルの向きを変更したい!

複合機のスキャナーで A3 縦型の原稿をスキャンすると、A3 横置きの PDF ファイルとして出力・・・ つまり、縦型原稿は「横向きに回転された状態でデータ化」されます。

A3 縦置き原稿をそのまま(横向きにしないで)スキャンできる(一般ピーポーが使用できる)複合機は、僕が知る限り、多分ないんじゃないか・・・と思います。表示した際の見た目を A3 縦置きにしたい場合は、後で回転させれば事が足りるわけで、A3 縦でも横でもスキャンできるスキャナーは、普通に考えて、その必要性が感じられません。

ただ、その「回転のひと手間」が問題となる場合を除いては・・・

この PDF ファイルを「そのまま印刷して利用する」のであれば、もちろん何も問題など生じませんが、紙媒体でなく、そのまま電子データとして、例えば、重い障害のある方が iPad の Goodnotes で読み込んで利用するような場合、正しい方向に戻す(=回転させる)ひと手間が(その方から見れば余計に)必要です。

たかが「ひと手間」ですが、この「ひと手間」が「ある」と「ない」とでは、当該 PDF ファイルを受け取った方の「気持ち」は大きく違ってくるのではないでしょうか?

しかも、それが毎回のことになると・・・

そのような観点から、手軽に PDF ファイルの向きを変換して、その状態を保存できるプログラムがないかと探してみたのですが、Web 上にデータをアップロードする必要があったり、例えその問題はクリアできても通信環境によっては、変換に「ちょっと我慢できないくらいの時間」を要したり、はたまたローカル環境 Only で作業できたとしても「単に向きを変換」するだけの工程の手順が、正直、とても使いにくいと感じてしまったり・・・、

「ただ向きを変える」それだけのことで、探し当てたどの方法を使っても、こんなにイライラするのであれば、(自分の知識と技術だけで PDF ファイルの向きを変更するプログラムなど、間違っても書けるわけがありませんので)サードパーティー製(?)ソフトウェアを使わせていただいて PDF ファイルを好きな向きに変更して保存できるプログラムを、自分で書けばいいのではないか? と思った次第です。

幸いなことに、僕の隣には Delphi がいてくれます。無料で使える Python 環境でも、この目標は実現できるともちろん感じましたが、こと GUI を用いて、誰に対しても優しいプログラムを書くなら、やっぱり Delphi です。それより、何より、エラーが出ないプログラム書くなら、絶対 Delphi です。

そんな理由から、PDF ファイルの向きの変換に特化したプログラムを書くことにしました!

【もくじ】

1.PDFtk Server
2.GUI を設計
3.ShellExecute で回転を実行
4.Path の表示方法を改良
5.CreateProcess で回転を実行
6.回転の実際
7.プログラムのダウンロード
8.お願いとお断り

1.PDFtk Server

自分の技術では PDF ファイルの内容をどうこうすることは到底できません。中身がどうなっているのかも、以前、ちょっとだけ勉強したことはあるのですが、今は全部忘れました。でも、他人様のお作りになられたとても良い Tool がたくさん公開されています。PDF ファイル操作のユーティリティは多数ありますが、あれこれダウンロードして実際に試用させていただき、今回は PDFtk Server を使わせていただくことにしました。

この PDFtk Server ですが、プラットフォームは、Windows、macOS、Linux に対応しており、PDF ファイルのマージ・分割・回転・その他、幅広い PDF 操作をコマンドラインで実行できる ユーティリティであるとのこと。

この「コマンドラインで実行」する部分を「 GUI 」から実行できるように、Delphi の力を借りて、インターフェイスを作ります。ただ、問題はライセンスです。

PDFtk Server のライセンスは、GNU GPL バージョン2 なので、非商用の個人利用であれば無償で使用可能です。ただし、GPLの下では自分のソフトウェアに PDFtk Server を同梱して、そのソフトウェアを配布する場合には、ソースコードの公開義務などが適用されますので、今回作成するソフトウェアでは PDFtk Server が動作に必要なことを明示して、利用者の責任で PDFtk Server のダウンロードをしていただき、プログラムの動作に必要な環境の整備を行ってもらう形をとりたいと思います。

2.GUI と Path の表示

Delphi の VCL を使えば、(慣れも必要ですが)ほんの数分で次のようなグラフィカル・ユーザー・インターフェイス(GUI)の作成が可能です(図は、プログラム実行時のものです)。

デフォルトでは、Form は最大化して表示されるようにしましたので、手動で幅と高さを変更しました。


操作方法は、回転させたい PDF ファイルを選択して、回転方向を選ぶ(オプションボタンをクリックする)だけです。回転を実行するボタンをクリックしなくても、回転方向を選んだだけで即回転が実行される機能を実現するチェックボックスも用意しました。

【注意】このプログラムは、ページを指定しての回転は実行することができません。

当初、回転した状態のプレビューを表示するような方向性も考えたのですが、たった3パターンの回転しかありませんし、ファイルの保存にもそれほど時間はかからない(何百ページもあるような PDF 文書はそもそも想定外で動作確認しておりませんので、それが必要な場合は利用者様各自の責任で検証作業を行っていただき、その結果に応じました運用をお願い申し上げます)ので、やや乱暴かもしれませんが、プログラムはオプションボタンをクリックするごとに回転を実行し、ファイルを固有の名称で(上書き)保存してしまう仕様としました。

責任逃れというわけではありませんが、処理が継続中であることを示すため、回転処理の手続き実行中は、マウスカーソルが待機状態になるよう try 文を入れてあります。

※ このプログラムでは、諸般の事情から try 文の中で待機状態を設定しています。

procedure TForm1.Button2Click(Sender: TObject);
begin
  //カーソルを待機状態に変更
  Screen.Cursor := crHourGlass;
  try 
    //処理を実行
    ・・・
  finally
    //カーソルを元の状態に変更
    Screen.Cursor := crDefault;
  end;
end;

オプションボタンをクリックした際の手続きは・・・

procedure TForm1.RadioGroup1Click(Sender: TObject);
begin
  Button2.Enabled:=True;
  if CheckBox1.Checked then
  begin
    Button2.Click;
  end;
end;

「回転実行」ボタン(=Button2)をクリックしたことにしてしまっています。

3.ShellExecute で回転を実行

で、最初に書いた PDF ファイルの回転手続きは・・・

  private
    { Private 宣言 }
    strSrcPDFName, strDstPDFName:string;
    PDFTK_PATH:string;
    //長いPath文字列の途中部分を省略して表示(どのコントロールでも使える汎用版に書き直したコード)
    function FitPathWithMiddleEllipsis(const FilePath: string; AFont: TFont; MaxWidth: Integer): string;

procedure TForm1.Button2Click(Sender: TObject);
var
  InputFile, OutputFile, RotateArg, strCommandLine: string;
begin

  PDFTK_PATH := ExtractFilePath(Application.ExeName)+'pdftk.exe';

  if not FileExists(PDFTK_PATH) then
  begin
    StatusBar1.SimpleText := 'pdftk.exe が見つかりません';
    Exit;
  end;

  InputFile := strSrcPDFName;
  if not FileExists(InputFile) then
  begin
    StatusBar1.SimpleText := 'PDFファイルが存在しません';
    Exit;
  end;

  case RadioGroup1.ItemIndex of
    0: RotateArg := 'west';  // 270°
    1: RotateArg := 'south'; // 180°
    2: RotateArg := 'east';  // 90°
  else
    StatusBar1.SimpleText := '回転方向を選択してください';
    Exit;
  end;

  //OutputFile := strDstPDFName;
  OutputFile := ChangeFileExt(strDstPDFName, '') + '_'+RotateArg+'.pdf';
  strDstPDFName:= OutputFile;

  //コマンド生成
  strCommandLine := Format('"%s" "%s" cat 1-end%s output "%s"', [
    PDFTK_PATH, InputFile, RotateArg, OutputFile
  ]);

  //実行(ダブルクオートでコマンド全体を囲む)
  if ShellExecute(0, 'open', 'cmd.exe', PChar('/C "' + Command + '"'), nil, SW_HIDE) <= 32 then
  begin
    StatusBar1.SimpleText := 'pdftk の実行に失敗しました';
  end else begin
    //長いPath文字列の途中を省略して表示(Create時にStatusBar1.SimplePanel:=True;あり)
    StatusBar1.SimpleText := FitPathWithMiddleEllipsis(
      OutputFile, StatusBar1.Font, StatusBar1.ClientWidth);

    //Application.ProcessMessages;
    Sleep(500); // 0.5秒待機
    //プレビューにPDFを表示(WebBrowser経由)
    WebBrowser1.Navigate('file:///' + StringReplace(OutputFile, '\', '/', [rfReplaceAll]));
  end;
end;

0.5 秒ほど待機時間を入れて、プレビューが失敗しないようにしています。なので、ちょっと処理が重たい感じにはなっちゃってますが、自分的には許容範囲かと・・・。

4.Path の表示方法を改良

この手続きの中で「長い文字列の途中を省略して表示」する FitPathWithMiddleEllipsis 関数を使っていますが、これは前回の記事でご紹介したものをさらに改良したものです。

前回の記事で使った FitPathWithMiddleEllipsis 関数は、TEdit と TLabel のみに対応したものでしたが、今回は StatusBar1 の SimpleText に Path 文字列を表示したかったので、次のように設計を変更し、汎用性を高めた新しい FitPathWithMiddleEllipsis 関数を使いました。

どのように汎用性を高めたかと言うと、つまり、やりたいことは「コントロールの表示幅に合わせた省略文字列を作る」ことだけ!なので、必要なのは「表示フォントと表示幅」です。そのため引数で指定するのは TControl ではなく、(「表示したい文字列」に加え)「Canvas.Font」と「最大幅(ピクセル)」にして、これを(関数側で用意した Canvas へ)渡すようにすれば、コントロール種別への依存をなくせます。こうすればどんな UI コントロールにもこの関数を適用できます。

前回、この関数は単一の手続き内から呼び出せる形式としましたが、今回は複数の手続きから呼び出して利用できるよう、Form のメンバーとして作成しました。

  private
    { Private 宣言 }
    ・・・
    //長いPath文字列の途中部分を省略して表示(どのコントロールでも使える汎用版」に書き直したコード)
    function FitPathWithMiddleEllipsis(const FilePath: string; AFont: TFont; MaxWidth: Integer): string;

関数を Private 部に宣言して、Shift+Ctrl+Cを押して、次の内容を記述します。

function TForm1.FitPathWithMiddleEllipsis(const FilePath: string; AFont: TFont;
  MaxWidth: Integer): string;
var
  Bitmap: TBitmap;
  Canvas: TCanvas;
  Ellipsis: string;
  DirPart, FilePart, DrivePart: string;
  Parts: TArray<string>;
  i, LeftCount, RightCount: Integer;
  TestPath: string;

  function MeasureTextWidth(const S: string): Integer;
  begin
    Result := Canvas.TextWidth(S);
  end;
begin
  Bitmap := TBitmap.Create;
  try
    Canvas := Bitmap.Canvas;
    Canvas.Font.Assign(AFont);

    Ellipsis := '...'+PathDelim;

    //全部入る場合
    if MeasureTextWidth(FilePath) <= MaxWidth then
      Exit(FilePath);

    //ファイル部分とディレクトリ部分を分離
    FilePart := ExtractFileName(FilePath);
    DirPart  := ExtractFilePath(FilePath);
    DrivePart := ExtractFileDrive(FilePath);

    //パスのディレクトリ部分を分解(ドライブ部分は除外)
    Parts := DirPart.Substring(Length(DrivePart) + 1).Split([PathDelim], TStringSplitOptions.ExcludeEmpty);

    //初期状態は全部表示
    TestPath := IncludeTrailingPathDelimiter(DirPart) + FilePart;

    //左右を削っていくアプローチ
    LeftCount := 0; //先頭から残すディレクトリ数
    RightCount := Length(Parts); //後ろから残すディレクトリ数

    while (LeftCount < Length(Parts)) and (MeasureTextWidth(TestPath) > MaxWidth) do
    begin
      Inc(LeftCount);
      TestPath := DrivePart + PathDelim;

      if LeftCount > 0 then
        TestPath := TestPath + Parts[0] + PathDelim;

      if LeftCount < Length(Parts) then
        TestPath := TestPath + Ellipsis;

      if RightCount > 0 then
      begin
        for i := Length(Parts) - RightCount to High(Parts) do
          if i >= 0 then
            TestPath := TestPath + Parts[i] + PathDelim;
      end;

      TestPath := TestPath + FilePart;
      Dec(RightCount);
      if RightCount < 0 then RightCount := 0;
    end;

    //収まる長さで返す
    Result := TestPath;

    //それでも収まらなければ中央省略だけで返す
    if MeasureTextWidth(Result) > MaxWidth then
    begin
      Result := Copy(FilePath, 1, 1) + '...' + Copy(FilePath, Length(FilePath), 1);
    end;

  finally
    Bitmap.Free;
  end;
end;

で、TEdit に表示したい場合は・・・

Edit1.Text:= FitPathWithMiddleEllipsis(strSrcPDFName, Edit1.Font, Edit1.ClientWidth);

TStatusBar に表示したい場合は・・・

StatusBar1.SimpleText := FitPathWithMiddleEllipsis(
      strDstPDFName, StatusBar1.Font, StatusBar1.ClientWidth);

ちなみに、ここで使っている TStatusBar は、次のように FormCreate 手続きで SimplePanel := True に設定しています。

procedure TForm1.FormCreate(Sender: TObject);
begin
  StatusBar1.SimplePanel := True;
  //Formを最大化して表示(幅も最大化される)
  Form1.WindowState:=wsMaximized;
end;

SimplePanel := True としていない場合は・・・(この場合の動作は未確認です!)

StatusBar1.SimpleText := 
  FitPathWithMiddleEllipsis(strDstPDFName, StatusBar1.Font, StatusBar1.Panels[0].Width);

・・・でしょうか?

さらに(今回のプログラムでは使用していませんが)TLabel に表示したい場合は・・・

Label1.Caption := FitPathWithMiddleEllipsis(strDstPDFName, Label1.Font, Label1.Width);

この関数に「表示したい文字列」と「コントロールのFont」と「コントロールの幅」を引数として渡してあげれば(余程コントロールの幅が狭くならない限り)末尾のファイル名と拡張子が見えるように Path の途中を省略する形で、長い Path 文字列を表示してくれます。

実行してみました!

長い Path が途中 … と省略され、末尾のファイル名と拡張子部分は表示されています。


コントロールが異なると、パスの区切り文字の表記が¥マークと \(バックスラッシュ)になるのは、それぞれのコントールの Font の違いによるものと思われます・・・。

5.CreateProcess で回転を実行

プログラムの設計当初、PDF ファイルの回転処理は先に記載した通り ShellExecute で実行していたのですが、プログラムの動作検証を行った際、200ページ以上ある PDF ファイルを回転元ファイルに指定したら、回転に失敗してしまいました。

ShellExecute では、何が起きて回転に失敗してしまったのかが皆目わかりませんので、原因を究明すべく、回転処理の実行( PDFtk Server の呼び出しと実行部分)を CreateProcess に変更し、エラーが発生した場合はメッセージを PDFtk Server から取得して表示できるよう、次のようにプログラムを修正しました。

  private
    { Private 宣言 }
    //PDFtkでコマンドを実行
    function RunPdftk(const ExePath, Params: string; out OutputStr: string): Boolean;

procedure TForm1.Button2Click(Sender: TObject);
var
  InputFile, OutputFile, RotateArg: string;
  Params, Msg:string;
  strMsg: string;
begin

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

  //CreateProcessで実行

  try
    PDFTK_PATH := ExtractFilePath(Application.ExeName) + 'pdftk.exe';

    if not FileExists(PDFTK_PATH) then
    begin
      StatusBar1.SimpleText := 'pdftk.exe が見つかりません';
      Exit;
    end;

    InputFile := strSrcPDFName;
    if not FileExists(InputFile) then
    begin
      StatusBar1.SimpleText := 'PDFファイルが存在しません';
      Exit;
    end;

    case RadioGroup1.ItemIndex of
      0: RotateArg := 'west';  // 270°
      1: RotateArg := 'south'; // 180°
      2: RotateArg := 'east';  // 90°
    else
      StatusBar1.SimpleText := '回転方向を選択してください';
      Exit;
    end;

    OutputFile := ChangeFileExt(strDstPDFName, '') + '_' + RotateArg + '.pdf';
    strDstPDFName := OutputFile;

    //end%sが正しい(end %sとしないこと:半角スペースは不要)
    Params := Format('"%s" cat 1-end%s output "%s"', [
      InputFile, RotateArg, OutputFile
    ]);

    if RunPdftk(PDFTK_PATH, Params, Msg) then
    begin
      StatusBar1.SimpleText := FitPathWithMiddleEllipsis(
        OutputFile, StatusBar1.Font, StatusBar1.ClientWidth);

      if Msg.Trim <> '' then
      begin
        //ShowMessage('pdftk 出力: ' + Msg);
        //コピーできるメッセージを表示する
        strMsg:= 'pdftk 出力: ' + Msg + #13#10 + #13#10 +
        '"Copied to clipboard"';
        //Clipboard.AsText := strMsg;  // クリップボードにコピー
        Clipboard.AsText := Msg;
        //ShowMonospaceMessage(strMsg);
        //ShowMessage(strMsg);
        Application.MessageBox(PChar(strMsg), PChar('エラー'), MB_ICONERROR);
      end;

      Sleep(500);
      WebBrowser1.Navigate('file:///' + StringReplace(OutputFile, '\', '/', [rfReplaceAll]));
    end
    else
    begin
      StatusBar1.SimpleText := 'pdftk の実行に失敗しました';
      if Msg.Trim <> '' then
        ShowMessage('エラー詳細: ' + Msg);
    end;
  finally
    //名前を元に戻しておく!
    strSrcPDFName := OpenDialog1.FileName;
    strDstPDFName := StringReplace(strSrcPDFName, 'SrcPDF', 'DstPDF', [rfReplaceAll, rfIgnoreCase]);
    Screen.Cursor := crDefault;
  end;

end;

function TForm1.RunPdftk(const ExePath, Params: string;
  out OutputStr: string): Boolean;
var
  SI: TStartupInfo;
  PI: TProcessInformation;
  SA: TSecurityAttributes;
  StdOutRead, StdOutWrite: THandle;
  Buffer: array[0..1023] of Byte;
  BytesRead: DWORD;
  OutputBytes: TBytes;
  CmdLine: string;
begin
  //Result := False;
  OutputStr := '';

  if not FileExists(ExePath) then
    raise Exception.CreateFmt('実行ファイルが見つかりません: %s', [ExePath]);

  ZeroMemory(@SA, SizeOf(SA));
  SA.nLength := SizeOf(SA);
  SA.bInheritHandle := True;

  if not CreatePipe(StdOutRead, StdOutWrite, @SA, 0) then
    RaiseLastOSError;
  try
    try
      SetHandleInformation(StdOutRead, HANDLE_FLAG_INHERIT, 0);

      ZeroMemory(@SI, SizeOf(SI));
      SI.cb := SizeOf(SI);
      SI.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
      SI.wShowWindow := SW_HIDE;
      SI.hStdOutput := StdOutWrite;
      SI.hStdError := StdOutWrite;

      ZeroMemory(@PI, SizeOf(PI));

      CmdLine := Format('"%s" %s', [ExePath, Params]);

      if not CreateProcess(
        nil, PChar(CmdLine), nil, nil, True,
        CREATE_NO_WINDOW, nil, nil, SI, PI) then
        RaiseLastOSError;

      CloseHandle(StdOutWrite);

      SetLength(OutputBytes, 0);
      repeat
        if not ReadFile(StdOutRead, Buffer, SizeOf(Buffer), BytesRead, nil) then
          Break;
        if BytesRead > 0 then
        begin
          //W1024 符号付型と符号無し型の演算による、オペランドの拡張」と警告される
          //SetLength(OutputBytes, Length(OutputBytes) + BytesRead);
          //対策1:BytesRead を明示的に Integer にキャストする
          SetLength(OutputBytes, Length(OutputBytes) + Integer(BytesRead));
          //対策2:Length を NativeInt にキャストする(より安全か?)
          //SetLength(OutputBytes, NativeInt(Length(OutputBytes)) + NativeInt(BytesRead));

          //W1024 符号付型と符号無し型の演算による、オペランドの拡張」と警告される
          //Move(Buffer[0], OutputBytes[Length(OutputBytes) - BytesRead], BytesRead);
          //対策1:BytesRead を明示的に Integer にキャストする
          Move(Buffer[0], OutputBytes[Length(OutputBytes) - Integer(BytesRead)], BytesRead);
        end;
      until BytesRead = 0;

      WaitForSingleObject(PI.hProcess, INFINITE);
      CloseHandle(PI.hProcess);
      CloseHandle(PI.hThread);

      if Length(OutputBytes) > 0 then
        OutputStr := TEncoding.UTF8.GetString(OutputBytes);

      Result := True;

    except
      on E: Exception do
      begin
        OutputStr := E.Message;
        Result := False;
      end;
    end;
  finally
    CloseHandle(StdOutRead);
  end;
end;

PDFtk Server の実行は、RunPdftk 関数側で行っています。

こうして CreateProcess での PDFtk Server の呼び出しに実行方法を変更し、何か問題が発生した場合には PDFtk Server 側からのエラーメッセージを取得して表示するようにできました。早速、先ほど回転に失敗した巨大な PDF ファイルを再度指定して、回転を実行してみました。

【わかったこと その①】

1つめは、問題の発生というより、正しくは、エラーの「真」の原因です。

“OWNER PASSWORD REQUIRED” と書いてあります・・・。

ぎぎぎ

( 効果音的歯軋り )

僕は、ただ、PDF を回転させようと・・・ 思っただけ・・・ なのですが、さんざん・・・ ほんとに 散々 苦労してたどり着いた 真実 は・・・

想像を遥かに絶するものでありました。

回転対象の PDF ファイルには、なんとパスワードが設定・・・ されていて当然でした。

・・・ と言うのも、もっともな理由があります。

正直に言うと、PDF ファイルを回転させるという今回のプログラムの動作検証に際し、手近に巨大な PDF ファイルが「なかった」ので、Web から簡単に入手できる 巨大 PDF ファイルはないか?と考え、思いをめぐらしたところ、すぐに思いついたのが「もう10年以上愛用しているプリンターの取扱説明書」でありました・・・ ので、さっそく愛用の 〇〇〇 社製プリンターの取扱説明書を Web から笑顔でダウンロード(何回目かなー?)して、この回転実験に使ったまではよかったのですが・・・、10年も使ったんだから許してもらえるだろうとわけのわかんないことを言い訳に、ラクしようとしたバチが当たったようです( 思いついた時は・・・ 実に!いい思いつきだと思ったのですが )。やはり、その動機が不純すぎました。

でも・・・ よく考えればこの「オーナーパスワード設定」があるのは当然です。取扱説明書、『なんでもできますー!!』みたいに勝手に書き換えられたら、それこそたいへんなコトになりますから・・・。

いやはや、これはもう・・・

手の出しようがないエラーでした!!

ま、原因がわかれば、わからないよりイイです(T_T)

ほとんど、七転八倒+四苦八苦 & いつも四面楚歌ばかり聞こえる人生(=ほぼ被害妄想)ですが、その中で学んだ最重要事項『転んでもタダでは起きるな』を、ここでもまた実践するのみです。

ぐやぐや なんじをいかんせん・・・

よくよく考えれば・・・(よくよく考えなくても・・・)

【わかったこと その②】

今回はタマタマ「手の出しようがないエラー」だったからよかった ♪ ものの、これが「手の出しようがある」エラーだった場合、OK をクリックする前に、エラーメッセージを暗記するか、「文字列」として写し取る(=メモする)必要があります。しかし、紙等に写し取るのは(自分的には)激しく面倒ですし、それより何より、このエラーメッセージはドラッグ等して、そのままクリップボードへコピーすることが、ShowMessage 関数の仕様上、出来ません!!

ちなみに、暗記はさらに無理です。

(そうだ。そのままコピペできたら・・・)

それこそ、全プログラマーの悲願です。

そう・・・

The universal wish of programmers.

それはまた・・・

The ultimate goal of all programmers.

そして、それこそは・・・

Every programmer’s long-cherished dream !

まさに、それを実現するべき時こそ、『今』です。

で、つくったのがコレ!

TMemo を Form に置いて Align := alClient としているだけですが・・・


もちろん、OK その他のボタンは、見渡すかぎり、どこにもありません。が・・・ ボタンがないかわりに・・・

好きな範囲を指定して、右クリックでコピーできます!

Delphi すごぉーイ!

( GUI が作れる全言語で、問題なく作成可能と思われますが・・・ )

OK ボタンなんて、どうせあってもただクリックするだけなんですから、その代替機能は Form 右上の「閉じる」ボタンにおまかせして、それよりエラーの原因テキストのコピペが出来れば、この際よしとしようではありませんか、皆さん!

僕は、もちろん「よし」としました☆

次が、その「エラーの原因メッセージをコピーできるようにする」コードです(表示する Form の幅と高さも自動で調整して表示するようにしてありますが、必要に応じて手動でさらに調整することも可能です)。

  private
    { Private 宣言 }
    strSrcPDFName, strDstPDFName:string;
    PDFTK_PATH:string;
    //PDFにオーナーパスワードがかかっているか調べる関数
    function IsOwnerPasswordRequired(const PdfPath, PdftkPath: string; out Output: string): Boolean;

procedure TForm1.Button1Click(Sender: TObject);
var
  OwnerPwdNeeded: Boolean;
  strMsg: string;
  strOutPut: string;

  //コピー可能なエラーメッセージを表示
  procedure ShowMonospaceMessage(const Msg: string);
  var
    Form: TForm;
    Memo: TMemo;
    CharWidth, CharHeight, MaxLineLength, LinesCount, I: Integer;
    MarginWidth, MarginHeight: Integer;
    Canvas: TCanvas;
  begin
    Form := TForm.Create(nil);
    try
      Form.Caption := 'The Real Truth Behind The Error!';
      Form.Position := poScreenCenter;

      Memo := TMemo.Create(Form);
      Memo.Parent := Form;
      Memo.Align := alClient;
      Memo.Lines.Text := Msg;
      Memo.ReadOnly := True;
      Memo.Font.Name := 'Consolas';
      Memo.Font.Size := 10;

      Form.HandleNeeded;
      Canvas := Form.Canvas;
      Canvas.Font.Assign(Memo.Font);

      CharWidth := Canvas.TextWidth('M');
      CharHeight := Canvas.TextHeight('M');

      MaxLineLength := 0;
      for I := 0 to Memo.Lines.Count - 1 do
        if Length(Memo.Lines[I]) > MaxLineLength then
          MaxLineLength := Length(Memo.Lines[I]);

      LinesCount := Memo.Lines.Count;

      //必要に応じて手動で Form の幅と高さを調整
      MarginWidth := 100;
      MarginHeight := 40;

      Form.ClientWidth := CharWidth * MaxLineLength + 10;
      Form.ClientHeight := CharHeight * LinesCount + 10;

      Form.Width := Form.ClientWidth + MarginWidth;
      Form.Height := Form.ClientHeight + MarginHeight;

      Form.ShowModal;
    finally
      Form.Free;
    end;
  end;

begin

  //ここで待機状態にしてもカーソルがすぐ元に戻ってしまう。
  //Screen.Cursor := crHourGlass;

  try
    ・・・ イロイロ設定 ・・・
    if OpenDialog1.Execute then
    begin
      ・・・ イロイロ設定 ・・・
      Screen.Cursor := crHourGlass;
      Application.ProcessMessages;
      try
        OwnerPwdNeeded := IsOwnerPasswordRequired(strSrcPDFName, PDFTK_PATH, strOutPut);
        if OwnerPwdNeeded then
        begin
          Screen.Cursor := crDefault;  // 必ず戻す
          strMsg := 'このPDFにはオーナーパスワードが設定されています。' + sLineBreak +
            strOutPut + sLineBreak +
            '処理を中止します。';
          ShowMonospaceMessage(strMsg);
          Exit;
        end;
      except
        on E: Exception do
        begin
          Screen.Cursor := crDefault;  // 必ず戻す
          strMsg := 'エラー: ' + E.Message;
          ShowMonospaceMessage(strMsg);
          Exit;
        end;
      end;
      ・・・ イロイロ設定 ・・・
    end;

  finally
    Screen.Cursor := crDefault;
  end;
end;

function TForm1.IsOwnerPasswordRequired(const PdfPath, PdftkPath: string; out Output: string): Boolean;
var
  CmdLine: string;
begin
  Result := False;

  if not FileExists(PdfPath) then
    raise Exception.Create('PDFファイルが存在しません。');

  if not FileExists(PdftkPath) then
    raise Exception.Create('pdftk.exeが見つかりません。');

  //pdftkのdump_dataコマンドでPDF情報を取得
  CmdLine := Format('"%s" "%s" dump_data', [PdftkPath, PdfPath]);

  if RunCommandAndGetOutput(CmdLine, Output) then
  begin
    //オーナーパスワードが必要ならエラーメッセージに含まれることが多い
    if Pos('OWNER PASSWORD REQUIRED', UpperCase(Output)) > 0 then
      Result := True;
  end
  else
    raise Exception.Create('pdftkの実行に失敗しました。');
end;

まぁ、イロイロありましたが、エラーメッセージだけはコピペできるようになりました☆

てか、ここでふと思ったのですが、
何もそこまでしなくても、Clipboard.AsText を使って、単に

uses
  Vcl.Clipbrd;

  strMsg := 'このPDFにはオーナーパスワードが設定されています。' + sLineBreak +
    strOutPut + sLineBreak +
    'クリップボードにエラーの内容を送信して、処理を中止します。';
  Clipboard.AsText:= strMsg;        // クリップボードにコピー
  ShowMessage(strMsg);
  Exit;

・・・としておいて、これを実行すれば、


「OK」をクリックして、メモ帳に貼り付けてみました。

この仕様の方がより親切でしょうか?

より、短く・・・

Clipboard.AsText := strOutPut;

なら・・・

エラーの核心部分のみ表示することも可能かと。


Delphi 12 Athens 以降では、 MessageDlg 関数で「警告」と「エラー」以外のアイコンが表示されなくなってしまいました。この Blog の過去記事にも書きましたが、これは Microsoft 社の UI ガイドライン変更に準拠した仕様変更によるものらしいのですが、ある日、突然、それまでずっと使い続けてきた MessageDlg 関数から「 i 」などのアイコンが消えてしまったあの時の衝撃、何か大切なものを失ったような、たまらない寂寥感が胸に広がったことを今も MessageDlg という文字を見る度に思い出します。

別に Microsoft 様の UI ガイドライン変更に反旗を翻すというような大それた意図はなく、ただメッセージにアイコンを表示したくてたまらなかった僕は必死で MessageDlg 関数の代替手段を探し、Application.MessageBox 関数がまだ生きていることを知って狂喜乱舞したのでした。・・・なので、最終的には、やっぱりいちばんのお気に入り Application.MessageBox 関数で・・・

  strMsg := 'このPDFにはオーナーパスワードが設定されています。' + sLineBreak +
    strOutPut + sLineBreak +
    'クリップボードにエラーの内容を送信して、処理を中止します。';
  Clipboard.AsText := strOutPut;
  Application.MessageBox(PChar(strMsg), PChar('エラー'), MB_ICONERROR);

だから、これが、僕の本当の理想かな?

古い人間ですので、Win32 API が好きなんです。


・・・

最終的にと言いながら、独自性にこだわって、それでもやっぱり TMemo も 「コピー」ボタンも必要なんだという場合には・・・

    { Private 宣言 }
    strMsg: string;
    procedure GetErrorMessage(Sender: TObject);

implementation

uses
  Vcl.Clipbrd;

{$R *.dfm}

procedure TForm1.Button2Click(Sender: TObject);
var
  dlg: TForm;
  btnCopy, btnClose: TButton;
  memoMsg: TMemo;
begin

  //エラーメッセージ
  strMsg := 'Error: Failed to open PDF file:' + sLineBreak +
            'C:\Users\XXX\Win32\Release\SrcPDF\TEST.PDF' + sLineBreak +
            'OWNER PASSWORD REQUIRED, but not given (or incorrect)' + sLineBreak +
            'Done.  Input errors, so no output created.';

  dlg := TForm.Create(nil);
  try
    dlg.Caption := 'メッセージ';
    dlg.Width := 400;
    dlg.Height := 240;
    dlg.Position := poScreenCenter;

    memoMsg := TMemo.Create(dlg);
    memoMsg.Parent := dlg;
    memoMsg.Left := 20;
    memoMsg.Top := 20;
    memoMsg.Width := dlg.ClientWidth - 40;
    memoMsg.Height := 120;
    memoMsg.ReadOnly := True;
    memoMsg.ScrollBars := ssVertical;
    memoMsg.Lines.Text := strMsg;

    btnCopy := TButton.Create(dlg);
    btnCopy.Parent := dlg;
    btnCopy.Caption := 'コピー';
    btnCopy.Left := 80;
    btnCopy.Top := 160;
    btnCopy.OnClick := GetErrorMessage;

    btnClose := TButton.Create(dlg);
    btnClose.Parent := dlg;
    btnClose.Caption := '閉じる';
    btnClose.Left := 200;
    btnClose.Top := 160;
    btnClose.ModalResult := mrClose;

    dlg.ShowModal;
  finally
    dlg.Free;
  end;
end;

procedure TForm1.GetErrorMessage(Sender: TObject);
begin
  Clipboard.AsText := strMsg;
end;

上のようにすれば・・・


やっぱりアイコンがないと・・・ という場合は、さらに

uses
  Vcl.Clipbrd, Vcl.ExtCtrls;

procedure TForm1.Button3Click(Sender: TObject);
var
  dlg: TForm;
  btnCopy, btnClose: TButton;
  memoMsg: TMemo;
  imgIcon: TImage;
begin
  strMsg := 'Error: Failed to open PDF file:' + sLineBreak +
            'C:\Users\XXX\Win32\Release\SrcPDF\TEST.PDF' + sLineBreak +
            'OWNER PASSWORD REQUIRED, but not given (or incorrect)' + sLineBreak +
            'Done.  Input errors, so no output created.';

  dlg := TForm.Create(nil);
  try
    dlg.Caption := 'エラー';
    dlg.Width := 420;
    dlg.Height := 260;
    dlg.Position := poScreenCenter;

    //アイコン追加
    imgIcon := TImage.Create(dlg);
    imgIcon.Parent := dlg;
    imgIcon.Left := 20;
    imgIcon.Top := 20;
    imgIcon.Width := 32;
    imgIcon.Height := 32;
    imgIcon.Picture.Icon.Handle := LoadIcon(0, IDI_ERROR); // Windows標準エラーアイコン

    //メモ表示
    memoMsg := TMemo.Create(dlg);
    memoMsg.Parent := dlg;
    memoMsg.Left := imgIcon.Left + imgIcon.Width + 10;
    memoMsg.Top := 20;
    memoMsg.Width := dlg.ClientWidth - imgIcon.Width - 50;
    memoMsg.Height := 120;
    memoMsg.ReadOnly := True;
    memoMsg.ScrollBars := ssVertical;
    memoMsg.Lines.Text := strMsg;

    //コピーボタン
    btnCopy := TButton.Create(dlg);
    btnCopy.Parent := dlg;
    btnCopy.Caption := 'コピー';
    btnCopy.Left := 80;
    btnCopy.Top := 160;
    btnCopy.OnClick := GetErrorMessage;

    //閉じるボタン
    btnClose := TButton.Create(dlg);
    btnClose.Parent := dlg;
    btnClose.Caption := '閉じる';
    btnClose.Left := 200;
    btnClose.Top := 160;
    btnClose.ModalResult := mrClose;

    dlg.ShowModal;
  finally
    dlg.Free;
  end;
end;

上のコードを実行すれば・・・


なんだか、記事の内容が本来意図した方向とずいぶん逸れてしまいました。なので、このへんで元に戻ります。

6.回転の実際

はるか上の方で、すでに示していますが、実際に PDF の回転を行った様子です。
結論から言えば、「ただ、コレがしたかった・・・ だけ」なのですが、今回もまた、なんか凄くたくさんのことに出会った気がします・・・。

最初に、左へ回転した場合です。


次に、上下反転です。


最後に、右へ回転した場合です。


連続して回転させることは、このプログラムでは考えておりません。・・・と言うか、このプログラムの仕様上、その必要性がありません。また、元の PDF ファイルは、これまたプログラムの仕様上、無加工で Src フォルダに残っていますので、「元に戻す」処理も、このプログラムには、もちろんありません。

7.プログラムのダウンロード

あくまでも自分用に作ったものですが、PDFtk Server 関連のファイルを除いたプログラム一式を以下からダウンロードできます。なお、ダウンロードとご使用にあたっては、免責事項及び使用条件への同意が必要です。免責事項及び使用条件の詳細は付属の License.txt 及び Readme.txt をご覧ください。

また、動作には PDFtk Server が必要です。

PDFtk Server のダウンロードサイト :https://www.pdflabs.com/tools/pdftk-server/

上記 Web サイトより、ダウンロードした pdftk_server-2.02-win-setup.exe をダブルクリックして起動すると、デフォルト設定では C:\Program Files (x86)\PDFtk Server にインストールが行われます。

PDFtk Server の利用にあたり、動作やライセンス内容についての詳細は、必ず公式サイトおよびライセンス文書をご確認ください。

インストール後、C:\Program Files (x86)\PDFtk Server\bin にある pdftk.exe を PDF_Rotator.exe があるPDF_Rotator フォルダ内へコピーしてください。

【プログラムが正常動作するために必要なフォルダ構成です】

PDF_Rotator\
 ├ DstPDF
 ├ SrcPDF
 ├ PDF_Rotator.exe
 ├ pdftk.exe
 ├ License.txt
 └ Readme.txt

PDF_Rotator フォルダは、下記リンク先からダウンロードできる PDF_Rotator.zip を展開すると生成されます。

回転させたい PDF ファイルは必ず SrcPDF フォルダ内に準備してください。なお、プログラムは起動時に SrcPDF フォルダ及び DstPDF フォルダの有無を調査し、それらが存在しない場合は exe と同じ階層に自動的に SrcPDF フォルダ及び DstPDF フォルダを生成します。予めご承知おきください。

PDF_Rotator.exe をダブルクリックして起動後、回転させたい PDF ファイルを選択し、回転方向を指定してください。デフォルト設定では、回転方向の指定と同時に PDF ファイルの回転と保存が行われます。回転後の PDF ファイルは、左へ回転した場合は「元のファイル名_west.pdf」、上下反転した場合は「元のファイル名_south.pdf」、右へ回転した場合は「元のファイル名_east.pdf」のように北を上とした場合の方角が付加されて DstPDF フォルダ内に保存されます。

なお、プログラムの初回起動時には、Windows Defender SmartScreen による警告画面が表示されます。この警告画面に関する詳細は、当 Blog の次の過去記事をご参照ください。

8.お願いとお断り

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

また、pdftk.exe 他、PDFtk Server 関連のファイルを同梱した状態での PDF_Rotator.exe の再配布を禁じます。PDF_Rotator.exe を再配布される場合は、PDFtk Server 関連のファイルはすべて削除し、PDF_Rotator.zip に添付した License.txt 及び Readme.txt を必ず添付してください。

MTSファイルをMP4に変換したい!

仕事で SD カードに保存した MTS ファイルを扱う機会が増えました。使い終わったら不要なファイルは即消去しますが、後日再び利用するものは、わりと自由に使える NAS に MTS 形式のままコピー(=保存)していた ・・・ のですが、さすがに数が増えてくると( このままでいいのかなー )みたいな気が。

ファイルサイズが 10 GB を超えてくると、SD カードから NAS へコピーするにしても時間がかかるし、再利用する際に使うのはノート PC なので、ファイル容量に見合うほど高画質でなくても構わないはずですし、それより何より、休日、何もすることがなくてヒマ なので、MTS 形式の動画ファイルを より容量の小さい MP4 形式に変換するプログラムを書いてみることにしました。

てか、何よりも、ほんとはずっと、前から、やってみたかった・・・こと。なので・・・ *(^_^)*♪

動作には別途 FFmpeg.exe が必要です。
( FFmpeg.exe は MTStoMP4.zip に同梱しておりません)

【もくじ】

1.MTS って何?
2.MP4 に変換
3.動作確認用のコード
4.プログレスバーも表示
5.文字列の一部を省略(…)して表示
6.プログラムのダウンロード
7.まとめ
8.お願いとお断り

1.MTS って何?

まずは、ここから勉強します。

ソニー・パナソニックが共同開発した高画質動画を効率よく記録するための仕様がAVCHD(Advanced Video Codec High Definition)で、この方式で記録された動画ファイルの実体が MTS ファイルなんだそうです。

MTS は、MPEG Transport Stream の略で、主にビデオカメラで録画した高画質動画を保存するためのファイルとして利用されており、このファイルの映像部分で使用される圧縮方式(コーデック)が高画質かつ高圧縮の H.264 であるとのこと。

一言で言うと、MTS は、H.264で圧縮された動画を保存する「入れ物(ファイル形式)」のひとつで、映像の他に音声や字幕などの情報も一緒に保存されているファイルコンテナ。

ファイルコンテナと言えば思い浮かぶのは、JR の貨物列車です。

MTS や MP4 の詳しい仕組みについては、まったくわかりませんが、貨物列車に様々な色や形のコンテナが積載されているように、映像や音声を各ファイルそれぞれの方法で乗っけていることだけは理解できます。その載せ方の工夫次第で、貨物の重さや列車の長さが変わってくるということなのでしょう。

2.MP4 に変換

もちろん、わざわざ自分でプログラムなんて書かなくても、MTS ファイルを MP4 ファイルに変換する方法はいくらでもあります。有名なところでは、無料で使える「HandBrake」がありますし、さらに身近なところでは、Windows10 / 11のフォトでも変換できるようです。

僕は HandBrake は実際に使ったことがありますが、フォトでの変換は試したことがありません。

今回やってみたかったのは、これまた有名な「 FFmpeg 」(動画処理のツール)を使ったファイルコンテナの変換プログラムの作成です。前にも書きましたが、どうせヒマだし、FFmpeg は以前にもいろんなところで使ったことがあって、「期待通りに動作した記憶しかない」ので、今回もきっとうまく行く♪と思えたことと、それより何より Delphi で「なんかしてないと落ち着かない」のです(=これはきっと、僕の心の病です)。

3.動作確認用のコード

最初の一歩は、FFmpeg のダウンロードと準備。

ダウンロードサイト : https://ffmpeg.org/download.html

上記リンク先の「Get packages & executable files」にある Windows のマーク上をポイント(or クリック)すると表示される「Windows builds from gyan.dev」のリンク先ページからダウンロードすればよいのですが、いろいろな FFmpeg があって迷いました。

まず、「git master builds」と「release builds」いずれを選択すればいいのか?

今回の使用目的は、最新の機能のテストとか、そんなんじゃなくて、とにかく安定して動作するバージョンが欲しいので、「release builds」の方を選択。

で、latest release を見ると、選択肢が4つ。

・ffmpeg-release-essentials.7z
・ffmpeg-release-essentials.zip
・ffmpeg-release-full.7z
・ffmpeg-release-full-shared.7z

Essentials は、Win7 以降の OS に対応した最小限の機能のみを搭載した軽量な FFmpeg で、Full は 全機能搭載のWin10 以降用、Full Shared は、Full の DLL 版とのこと。

ここで重要になってくるのがライセンスです。

FFmpeg は、ビルド種別によりそのライセンスが異なります。最もライセンス的に無難な選択は、LGPL v2.1+ が適用される「Release Essentials Build(LGPLビルド)」だと思います。

LGPL v2.1+は、「 FFmpeg を改変せずにそのまま使い、アプリとは動的リンク( exe を呼び出す方式)で接続( = ユーザーが FFmpeg を差し替えられるように設定)し、FFmpeg のライセンス表記を Readme.txt 等に表示」すれば商用利用も可能で、クローズドソースでも OK というライセンス形態なので、今回作成したいプログラムでは、勉強を兼ね、公開に耐えうる仕様とするため「ffmpeg-release-essentials.zip」をダウンロードして、アプリケーションの exe と同じ場所にffmpeg という名前のフォルダを作成し、zip ファイルを展開した内容を一式コピペして、プログラムから FFmpeg.exe を直接呼び出して利用したいと思います。

具体的なフォルダとファイルの構成(位置関係)は、次の通りです。

MTStoMP4\
 ├ Dst
 ├ FFmpeg\bin\ffmpeg.exe
 ├ Src
 ├ Readme.txt
 └ MTStoMP4.exe

早速、次の GUI を Delphi で作成しました。

「テスト」ボタンは動作確認用(動作確認後に削除する予定)。


実際には「変換実行」ボタンをクリックするとプログレスバーを表示して変換作業の進捗状況を可視化する予定なのですが、そこに行きつく前に FFmpeg の動画変換機能を使えるようにならないといけません。なので、取り敢えず、「テスト」ボタンを準備し、そのクリックイベントの中で、コマンドプロンプトを表示して変換の動作確認を行えるようなテスト用のプログラムを書いてみます。

まず、変換元のファイルを選択する部分(ファイル選択ボタンをクリックした場合)の手続きの作成から始めました。

Form 上に TOpenDialog をひとつ準備して、次のコードを書きます。変換元の MTS 形式の動画ファイルは、exe と同じ場所に Src という名前のフォルダを作成して、そこに保存しておく前提です。また、変換先のファイルは、こちらも exe と同じ場所に Dst という名前のフォルダを作成し、そちらへ拡張子に mp4 を指定して書き出すよう、予め、変換先ファイルパスとして準備( Label のキャプションとして表示)しておきます。このように設定したのは、FFmpeg は変換先ファイルの拡張子を見て自動的に出力フォーマットを判別する仕様だからです。

procedure TForm1.Button1Click(Sender: TObject);
begin
  OpenDialog1.Filter := '動画ファイル (*.MTS;*.mp4;*.avi;*.mkv)|*.MTS;*.mp4;*.avi;*.mkv|すべてのファイル (*.*)|*.*';
  OpenDialog1.Title := '動画ファイルを選択してください';
  OpenDialog1.InitialDir:=ExtractFilePath(Application.ExeName)+'Src';
  if OpenDialog1.Execute then
  begin
    Edit1.Text:=OpenDialog1.FileName;
    Label1.Caption:=ExtractFilePath(Application.ExeName)+
      'Dst\'+ChangeFileExt(ExtractFileName(OpenDialog1.FileName), '')+'.mp4';
  end;
end;

上記コードの動作を確認します。実行時の画面は次の通りです。

思った通りに動作しました☆
まぁ、ここはそんなに難しいところではありませんが、「幸先よし」と感じます。


ただ、ちょっと気になったのが変換元ファイルの Path 文字列が長くて TEdit からはみ出している部分です。ここは後からなんとかしたいと思います。

変換に際して指定できるパラメータは3つです。

1つめが CRF 値です。CRF は Constant Rate Factor の略で、これは動画の品質を一定に保ちつつ、ファイルサイズを自動的に調整するために設定するパラメータで、0 ~ 51 までの数値で指定します。数値が小さいほど高画質ですがファイルサイズも大きくなり、数値が大きいほど低画質になりますがファイルサイズは小さくなります。デフォルトで使用する値は 23 のようです。

2つめがプリセット指定で、これは FFmpeg の H.264( libx264 )エンコーダーで使われる「圧縮処理の速度と効率のバランス」を設定するパラメータです。エンコードの速度(=処理時間)と圧縮効率(=ファイルサイズ)のトレードオフを制御します。

ultrafast → superfast → veryfast → faster → fast → medium(デフォルト) → slow → slower → veryslow → placebo の 10 段階の設定が可能で、より右側のパラメータほど処理速度が増加し、ファイルサイズは小さくなります(逆に言えば、左側のパラメータほど処理速度が速く、ファイルサイズは大きくなります)。すべてを試すヒマはないので、取りあえず medium で動作確認することにします。

3つめが AudioBitrate で、これは1秒あたりの音声のデータ量を指定する値です。もちろん、値が大きいほど音質が良くなりますが、ファイルサイズも大きくなります。単位は kbps(キロビット毎秒)です。

で、様々な問題点をクリアしながら最終的に完成したのが次のコードです。動作状況の確認が目的なので、ShellExecute 関数の引数には /K を指定してコマンドプロンプトが自動で閉じないようにしています。また、上記3つのパラメータはわかりやすさを優先し、コード内で直接「値」を指定しています。

procedure TForm1.ButtonXClick(Sender: TObject);
var
  FFmpegPath, Command: string;
  AudioBitrate, VideoCRF: Integer;
  strPreset: string;
  InputFile, OutputFile: string;
begin
  //明示的にエスケープ('ffmpeg\bin\ffmpeg.exe' の中の \b が「バックスペース」として扱われる危険を排除)
  FFmpegPath :=
    IncludeTrailingPathDelimiter(ExtractFilePath(Application.ExeName)) + 'ffmpeg\\bin\\ffmpeg.exe';

  //もしくは PathDelim を使う
  //FFmpegPath := IncludeTrailingPathDelimiter(ExtractFilePath(Application.ExeName))
  //            + 'ffmpeg' + PathDelim + 'bin' + PathDelim + 'ffmpeg.exe';

  //ファイルパスを安全な形式(8.3形式)で取得
  InputFile := ExtractShortPathName(Edit1.Text);
  //ExtractShortPathName関数は存在しないファイルを指定すると空文字列を返すことに注意する。
  //変換先の mp4形式の動画ファイルはプログラムの実行後に生成され、実行時には存在しない!
  OutputFile := Label1.Caption;

  //CRF(0~51)
  VideoCRF := 23;

  //プリセット(ultrafast, superfast, medium, slow, veryslow など)
  strPreset := 'slow';

  //数値の変数(単位はkbps)
  AudioBitrate := 192;

  //-ac 2 を追加して、5.1ch → 2ch ステレオ に変換して出力
  //5.1ch(サラウンド)をうまく処理できない場合があるようです。
  //この場合、変換された mp4ファイルが無音になってしまいます(ハマりました)。
  Command := Format(
    '"%s" -i "%s" -map 0:v -map 0:a -vcodec libx264 -acodec aac -ac 2 -b:a %dk -crf %d -preset %s -y "%s"',
    [FFmpegPath, InputFile, AudioBitrate, VideoCRF, strPreset, OutputFile]
  );

  //コマンドはダブルクォートで囲む(コマンド全体を1つの文字列として渡す)
  ShellExecute(0, 'open', 'cmd.exe', PChar('/K "' + Command + '"'), nil, SW_SHOWNORMAL);

end;

特に、最後の ShellExecute 関数で、Command 部分をダブルクォートで囲む処理を忘れると・・・

My PC 環境では、上のようなエラーが発生します。


原因がわかってしまえば( なぁーんだ )みたいな問題ですが、(私は)なかなか原因がわからなくて、解決までにちょっと時間を要しました。Command 部分をダブルクォートで囲むのを忘れてもコンパイルは通るので、ここはコーディング上の要注意部分です。

また、実行パスに全角文字が含まれている場合でも動作することを確認しましたが、より安定した動作を実現するためには CreateProcess を使って直接実行した方が良いはずです。なので、本番の処理では CreateProcess を使う方法をとることにします(加えて、FFmpeg の処理の進捗状況をプログレスバーに表示する処理も実装しなければいけません)。

CreateProcess を使った場合の、単なる動作確認用コードは、次の通りです。

procedure TForm1.ButtonXXClick(Sender: TObject);
var
  FFmpegPath, CmdLine, InputFile, OutputFile: string;
  AudioBitrate, VideoCRF: Integer;
  strPreset: string;
  StartInfo: TStartupInfo;
  ProcInfo: TProcessInformation;
begin
  //明示的にエスケープ('ffmpeg\bin\ffmpeg.exe' の中の \b が「バックスペース」として扱われる危険を排除)
  FFmpegPath := IncludeTrailingPathDelimiter(ExtractFilePath(Application.ExeName)) + 'ffmpeg\\bin\\ffmpeg.exe';

  //入力・出力ファイル
  InputFile := ExtractShortPathName(Edit1.Text);
  OutputFile := Label1.Caption;

  if (InputFile = '') or (OutputFile = '') then
  begin
    ShowMessage('入力または出力ファイルのパスが無効です');
    Edit1.SetFocus;
    Exit;
  end;

  //エンコード設定
  VideoCRF := 23;
  strPreset := 'slow';
  AudioBitrate := 192;

  //コマンドライン
  CmdLine := Format(
    '"%s" -i "%s" -map 0:v -map 0:a -vcodec libx264 -acodec aac -ac 2 -b:a %dk -crf %d -preset %s -y "%s"',
    [FFmpegPath, InputFile, AudioBitrate, VideoCRF, strPreset, OutputFile]
  );

  ZeroMemory(@StartInfo, SizeOf(StartInfo));
  StartInfo.cb := SizeOf(StartInfo);
  StartInfo.dwFlags := STARTF_USESHOWWINDOW;
  StartInfo.wShowWindow := SW_SHOW;  // 非表示にするなら SW_HIDE

  ZeroMemory(@ProcInfo, SizeOf(ProcInfo));

  if not CreateProcess(
    nil,               //アプリケーション名(CmdLine 内に含まれるので nil)
    PChar(CmdLine),    //コマンドライン(実行ファイルと引数を含む)
    nil, nil,          //セキュリティ属性
    False,             //ハンドル継承
    CREATE_NEW_CONSOLE,  //新しいコンソールで実行
    nil,               //環境変数
    nil,               //カレントディレクトリ
    StartInfo,         //スタートアップ情報
    ProcInfo           //プロセス情報(プロセスIDなど)
  ) then
  begin
    ShowMessage('CreateProcess に失敗しました: ' + SysErrorMessage(GetLastError));
    Exit;
  end;

  //処理の終了まで待ってから後始末&その他の処理を実行する場合は有効化する
  //ただし、有効化すると、タイトルバーに「応答なし」と表示されるなど動作が重くなる気が。
  //FFmpegに処理を渡すだけなら待機不要とした方が軽快動作?
  //WaitForSingleObject(ProcInfo.hProcess, INFINITE);

  //後始末
  CloseHandle(ProcInfo.hProcess);
  CloseHandle(ProcInfo.hThread);
end;

【ご注意願います】

もくじの「5.文字列の一部を省略(…)して表示」の処理を実行(設定)した場合は、Edit1.Text や Label1.Caption の値を参照せず、グローバル変数に保存した省略のない Path 文字列を参照するようにコードを修正する必要があります(参考コードは後述)。どうか、ご注意ください。

4.プログレスバーも表示

FFmpegは実行中に、標準出力(stdout)や標準エラー(stderr)にログを出力するので、このログを利用して処理の進捗状況(フレーム数、時間、速度など)等を取得することが可能です。

なので、Delphi で CreateProcess を利用して FFmpeg を起動する際に、標準出力・標準エラーをパイプで受け取るように設定すれば、ログをリアルタイムで取得でき、これに基づいてプログレスバーで処理の進捗状況を表示することができます。

PC に詳しい方なら次のような画面が表示され、より詳細な変換処理の進捗状況が見えた方が安心かもしれませんが、この背景が真っ黒な画面にあまり馴染みのない方にとっては、この画面よりもプログレスバーに進捗状況が表示されるという、より単純な GUI による表示の方が安心できるのではないでしょうか?(私は、本質的に難しいことが苦手なので、そのように感じてしまいます)

CreateProcess でファイルコンテナの変換を実行中
(StartInfo.wShowWindow := SW_SHOW;)


なので、動作確認後は StartupInfo.wShowWindow := SW_HIDE を指定し、コマンドプロンプト画面は非表示に設定、その代わりにプログレスバーを表示して、変換処理の進捗状況を表示します。

(変換処理の進捗状況を表示する方法は後述)

StatusBar に ProgressBar を埋め込む方法もありますが・・・
それはスペース的に余裕のない場合のお話。


今回の場合、「終了」ボタンと「変換実行」ボタンの間が空いていますので、ProgressBar はここに設置することにします。

さて、問題は進捗状況を表示する機能の実装です。

調べて見ると、FFmpeg は進行状況(Duration: …, time=…など)を 標準エラー(stderr)に出力する仕様のようでした。この進行状況の出力先が標準エラー(stderr)となっている理由は、 FFmpeg は「標準出力(stdout)」を、エンコード結果(映像などのバイナリ)をパイプ出力する用途にも使うため、ここにログを混ぜると混乱が生じる恐れがあり、ログ類は意図的にすべて stderr に分離して出力する仕様となっているとのことでした。

また、デフォルト設定のままログを出力すると多くの情報が入り混じって流れてくるので、経過時間等の取得したい情報が探しにくくなってしまいます。

そこで、出力されるログを行単位で処理し、進捗状況を表示するためのキーワードを正確に検出できるようにしました。

具体的には、FFmpeg に渡すコマンドラインの中で -progress pipe:1 を指定して意図的にログ出力が標準出力( stdout )へ為されるようにして、ここに key=value 形式で送られてくるログ出力中の「out_time=」という文字列を探して経過時間の情報を得ています。

上記内容を実装する具体的手順です。

まず、パラメータ設定を含めて FFmpeg に渡すコマンドラインを作成する部分です。

  FFmpegPath:=IncludeTrailingPathDelimiter(ExtractFilePath(Application.ExeName)) + 'ffmpeg\\bin\\ffmpeg.exe';

  //CRF(0~51)
  //VideoCRF:= 23;
  VideoCRF:=StrToInt(ComboBox1.Text);

  //プリセット
  //strPreset:= 'slow';
  strPreset:= ComboBox2.Text;

  //音声の処理
  //AudioBitrate:= 192;
  AudioBitrate:= StrToInt(ComboBox3.Text);

  //-ac 2 を追加して、5.1ch → 2ch ステレオ に変換して標準出力(stdout)に出力
  //InputFile, OutputFile はこの手続きを呼び出す際に指定
  CmdLine:= Format(
    '"%s" -i "%s" -map 0:v -map 0:a -vcodec libx264 -acodec aac -ac 2 -b:a %dk -crf %d -preset %s -y -progress pipe:1 "%s"',
    [FFmpegPath, InputFile, AudioBitrate, VideoCRF, strPreset, OutputFile]
  );


動作状況を確実に確認するため、Form に TMemo を1つ追加して、この TMemo にログ出力内容を表示してみます。次は、そのテストを行った際の画像です。

実際のプログラムでは TMemo への出力は行いませんが・・・。


ここで記録されたログの最初の方に MTS ファイルの再生(録画)時間が出力されています。実際に取得したログを下に示します。Duration 部分が再生(録画)時間です。

Input #0, mpegts, from 'C:\Users\XXX\Win32\Release\Src\SampleDoga.mts':  Duration: 00:18:58.21, start: 2165.015522, bitrate: 15843 kb/s

この再生(録画)時間の出力と out_time の値を利用して、プログレスバーに進捗状況を表示します。以下、プログレスバーに進捗状況を表示する部分のコードです。

  LogBuffer := '';
  DurationInSec := 0;

  repeat
    FillChar(Buffer, SizeOf(Buffer), 0);
    if ReadFile(StdOutRead, Buffer, SizeOf(Buffer) - 1, BytesRead, nil) and (BytesRead > 0) then
    begin
      LogBuffer := LogBuffer + string(Copy(Buffer, 0, BytesRead));

      //改行で分割して処理
      Lines := LogBuffer.Split([#10, #13], TStringSplitOptions.ExcludeEmpty);
      if Length(Lines) > 0 then
      begin
        for i := 0 to High(Lines) - 1 do
        begin
          Line := Trim(Lines[i]);

          //ログ出力内容を確認
          Memo1.Lines.Add(Line);

          if (DurationInSec = 0) and (Pos('Duration:', Line) > 0) then
          begin
            TotalDurationStr := Copy(Line, Pos('Duration:', Line) + 9, 12);
            DurationInSec := TimeStringToSeconds(Trim(TotalDurationStr));
          end;

          if Pos('out_time=', Line) > 0 then
          begin
            TimeStr := Copy(Line, Pos('out_time=', Line) + 9, 11);
            CurrentTimeInSec := TimeStringToSeconds(Trim(TimeStr));

            if DurationInSec > 0 then
            begin
              ProgressBar.Position := Min(100, Round((CurrentTimeInSec / DurationInSec) * 100));
              Application.ProcessMessages;
            end;
          end;
        end;
        LogBuffer := Lines[High(Lines)];
      end;
    end;
  until WaitForSingleObject(ProcessInfo.hProcess, 10) = WAIT_OBJECT_0;


上記コード内で、「時刻文字列を秒数 に変換」する TimeStringToSeconds 関数を呼び出していますが、この関数は以下のように、別に準備しておきます。

  function TimeStringToSeconds(const TimeStr: string): Double;
  var
    h, m, s: Integer;
    secFrac: Double;
    Parts: TArray<string>;
  begin
    Result := 0;
    Parts := TimeStr.Split([':']);
    if Length(Parts) < 3 then Exit;

    h := StrToIntDef(Parts[0], 0);
    m := StrToIntDef(Parts[1], 0);
    s := Trunc(StrToFloatDef(Parts[2], 0));
    secFrac := Frac(StrToFloatDef(Parts[2], 0));

    Result := h * 3600 + m * 60 + s + secFrac;
  end;


「変換実行」ボタンをクリックした際の手続き全体のコードです。

procedure TForm1.ButtonXClick(Sender: TObject);

  function TimeStringToSeconds(const TimeStr: string): Double;
  var
    h, m, s: Integer;
    secFrac: Double;
    Parts: TArray<string>;
  begin
    Result := 0;
    Parts := TimeStr.Split([':']);
    if Length(Parts) < 3 then Exit;

    h := StrToIntDef(Parts[0], 0);
    m := StrToIntDef(Parts[1], 0);
    s := Trunc(StrToFloatDef(Parts[2], 0));
    secFrac := Frac(StrToFloatDef(Parts[2], 0));

    Result := h * 3600 + m * 60 + s + secFrac;
  end;

  procedure RunFFmpegWithProgressBar(const InputFile, OutputFile: string; ProgressBar: TProgressBar);
  var
    SecurityAttr: TSecurityAttributes;
    StdOutRead, StdOutWrite: THandle;
    StartupInfo: TStartupInfo;
    ProcessInfo: TProcessInformation;
    Buffer: array[0..1023] of AnsiChar;
    LogBuffer: string;
    Lines: TArray<string>;
    Line: string;
    BytesRead: DWORD;
    DurationInSec, CurrentTimeInSec: Double;
    CmdLine: string;
    TotalDurationStr, TimeStr: string;
    FFmpegPath: string;
    AudioBitrate, VideoCRF: Integer;
    strPreset: string;
    i: Integer;
  begin

    //初期化
    ProgressBar.Min := 0;
    ProgressBar.Max := 100;
    ProgressBar.Position := 0;

    //パイプの準備
    SecurityAttr.nLength := SizeOf(SecurityAttr);
    SecurityAttr.bInheritHandle := True;
    SecurityAttr.lpSecurityDescriptor := nil;

    if not CreatePipe(StdOutRead, StdOutWrite, @SecurityAttr, 0) then
      RaiseLastOSError;

    ZeroMemory(@StartupInfo, SizeOf(StartupInfo));
    StartupInfo.cb := SizeOf(StartupInfo);
    StartupInfo.hStdError := StdOutWrite;
    StartupInfo.hStdOutput := StdOutWrite;
    StartupInfo.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
    StartupInfo.wShowWindow := SW_HIDE;

    //Pathを設定
    FFmpegPath:=IncludeTrailingPathDelimiter(ExtractFilePath(Application.ExeName)) + 'ffmpeg\\bin\\ffmpeg.exe';

    //各パラメータの設定(値は参考)

    //VideoCRF:= 23;
    VideoCRF:=StrToInt(ComboBox1.Text);

    //プリセット(例: ultrafast, superfast, medium, slow, veryslow など)
    //strPreset:= 'slow';
    strPreset:= ComboBox2.Text;

    //AudioBitrate:= 192;
    AudioBitrate:= StrToInt(ComboBox3.Text);

    //-ac 2 を追加して、5.1ch → 2ch ステレオ に変換して出力(My環境ではこうしないと無音になる!)
    CmdLine:= Format(
      '"%s" -i "%s" -map 0:v -map 0:a -vcodec libx264 -acodec aac -ac 2 -b:a %dk -crf %d -preset %s -y -progress pipe:1 "%s"',
      [FFmpegPath, InputFile, AudioBitrate, VideoCRF, strPreset, OutputFile]
    );

    if not CreateProcess(nil, PChar(CmdLine), nil, nil, True,
      CREATE_NO_WINDOW, nil, nil, StartupInfo, ProcessInfo) then
    begin
      CloseHandle(StdOutRead);
      CloseHandle(StdOutWrite);
      RaiseLastOSError;
    end;

    CloseHandle(StdOutWrite);

    LogBuffer := '';
    DurationInSec := 0;

    repeat
      FillChar(Buffer, SizeOf(Buffer), 0);
      if ReadFile(StdOutRead, Buffer, SizeOf(Buffer) - 1, BytesRead, nil) and (BytesRead > 0) then
      begin
        LogBuffer := LogBuffer + string(Copy(Buffer, 0, BytesRead));

        //改行で分割して処理
        Lines := LogBuffer.Split([#10, #13], TStringSplitOptions.ExcludeEmpty);
        if Length(Lines) > 0 then
        begin
          for i := 0 to High(Lines) - 1 do
          begin
            Line := Trim(Lines[i]);

            //ログ出力内容を確認
            //Memo1.Lines.Add(Line);

            if (DurationInSec = 0) and (Pos('Duration:', Line) > 0) then
            begin
              TotalDurationStr := Copy(Line, Pos('Duration:', Line) + 9, 12);
              DurationInSec := TimeStringToSeconds(Trim(TotalDurationStr));
            end;

            if Pos('out_time=', Line) > 0 then
            begin
              TimeStr := Copy(Line, Pos('out_time=', Line) + 9, 11);
              CurrentTimeInSec := TimeStringToSeconds(Trim(TimeStr));

              if DurationInSec > 0 then
              begin
                ProgressBar.Position := Min(100, Round((CurrentTimeInSec / DurationInSec) * 100));
                Application.ProcessMessages;
              end;
            end;
          end;
          LogBuffer := Lines[High(Lines)];
        end;
      end;
    until WaitForSingleObject(ProcessInfo.hProcess, 10) = WAIT_OBJECT_0;

    CloseHandle(StdOutRead);
    CloseHandle(ProcessInfo.hProcess);
    CloseHandle(ProcessInfo.hThread);

  end;

begin

  //変換元ファイルの指定がない場合は、処理しない
  if Edit1.Text='' then
  begin
    Edit1.SetFocus;
    Exit;
  end;

  //プログレスバーを表示
  ProgressBar1.Visible:=True;
  try
    //MTS -> MP4変換
    RunFFmpegWithProgressBar(Edit1.Text, Label1.Caption, ProgressBar1);
  finally
    //非表示にする
    ProgressBar1.Visible:=False;
  end;

end;

私の手持ち機材で録画した MTS ファイルを MP4 ファイルへ変換する作業は、・・・ 安定動作するまでに様々な紆余曲折はありましたが、最終的に上のコードで問題なく動作するようになりました。・・・が、(日々進化する)使用機材とPC環境により、録画&録音の環境は、その利用者により当然異なると思います。

例えば、私の環境では、音声は 5.1ch → 2ch として「品質を低下」させないと生成された MP4 には音声が入らないというトラブル(?)がありました。

//-ac 2 を追加して、5.1ch → 2ch ステレオ に変換して出力
CmdLine:= Format(
      '"%s" -i "%s" -map 0:v -map 0:a -vcodec libx264 -acodec aac -ac 2 ・・・

ですので、上記コードがあらゆる録画&録音設定に対応できるものでは『ない』ことに十分ご留意いただけますよう、心からお願い申し上げます。万一、上記コードを流用される場合、環境によっては、様々な不具合が生じることが予想されます。その場合は、利用者各自の責任でコードに適切な修正または改良を加えていただけますよう、お願い申し上げます。

5.文字列の一部を省略(…)して表示

【追記_20250815】

この記事で紹介している「文字列の一部を省略(…)して表示」するコードの Path 版には、さらに改良したコードがあります。

Delphiでは(他の言語についてはさらに知りませんが)、TEditやTLabelに長い文字列を表示した時、コントロールの幅より文字列の長さが長いと文字列の後半が切れて表示されてしまいます。そうならないように自動的に長い文字列の中央よりの一部を … のように省略して表示する機能はデフォルトの状態では準備されていないようです(間違っていたらすみません)。

この機能を実装してみました。設定可能なコントロールは TEdit と TLabel です。コンポーネント化する方法もあるかと思いますが、より簡単に、関数として実装しました。

最初に、非 Path 文字列用の場合です。

文字列の中央部分を省略して表示します。


次に、フォルダ名部分はなるべく残す Path 文字列専用バージョンです。

Path 文字列の先頭の方を省略して表示します。


TEdit のText や TLabel の Caption を参照したい場合に備えて、省略していない Path 文字列をグローバル変数に保存しておきます。必要な場合は Edit1.Text や Label1.Caption ではなく、グローバル変数から Path 文字列を取得して利用します。コードは次の通りです。

  private
    { Private 宣言 }
    //省略していない Path 文字列をグローバル変数に保存
    SrcFileName, DstFileName:string;

implementation

uses
  Winapi.ShellAPI,
  System.Math;

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  SelectedFile: string;
  strMsg: string;

  //表示する文字列の長さの自動調整
  //非Path用
  function FitTextWithMiddleEllipsis(TargetControl: TControl; const Text: string): string;
  var
    Bitmap: TBitmap;
    Canvas: TCanvas;
    MaxWidth: Integer;
    LeftPart, RightPart: string;
    Ellipsis: string;
    i, j: Integer;
    CharWidth: Double;
    InitKeep: Integer;
  begin
    Bitmap := TBitmap.Create;
    try
      Canvas := Bitmap.Canvas;

      if TargetControl is TLabel then
        Canvas.Font := TLabel(TargetControl).Font
      else if TargetControl is TEdit then
        Canvas.Font := TEdit(TargetControl).Font
      else
        raise Exception.Create('Font にアクセスできないコントロールです。');

      MaxWidth := TargetControl.Width;
      Ellipsis := '...';

      //全部入るならそのまま返す
      if Canvas.TextWidth(Text) <= MaxWidth then
        Exit(Text);

      //1文字あたりの平均幅を計算
      if Length(Text) > 0 then
        CharWidth := Canvas.TextWidth(Text) / Length(Text)
      else
        CharWidth := Canvas.TextWidth('W');

      // 残せる文字数を幅から概算(両端合計)
      InitKeep := Trunc((MaxWidth - Canvas.TextWidth(Ellipsis)) / CharWidth);

      // 左右で半分ずつ残す
      if InitKeep < 2 then InitKeep := 2; //最低1文字ずつ残すため
      i := InitKeep div 2;
      j := Length(Text) - (InitKeep - i) + 1;

      //徐々に調整して収まる長さを探す
      while (i >= 1) and (j <= Length(Text)) do
      begin
        LeftPart := Copy(Text, 1, i);
        RightPart := Copy(Text, j, Length(Text) - j + 1);
        Result := LeftPart + Ellipsis + RightPart;

        if Canvas.TextWidth(Result) <= MaxWidth then
          Exit(Result);

        Dec(i);
        Inc(j);
      end;

      //最後の手段:1文字ずつ残す
      if Length(Text) >= 2 then
        Result := Copy(Text, 1, 1) + Ellipsis + Copy(Text, Length(Text), 1)
      else
        Result := Ellipsis;

    finally
      Bitmap.Free;
    end;
  end;

  //Path用
  function FitPathWithMiddleEllipsis(TargetControl: TControl; const FilePath: string): string;
  var
    Bitmap: TBitmap;
    Canvas: TCanvas;
    MaxWidth: Integer;
    Ellipsis: string;
    DirPart, FilePart, DrivePart: string;
    Parts: TArray<string>;
    i, LeftCount, RightCount: Integer;
    TestPath: string;

    function MeasureTextWidth(const S: string): Integer;
    begin
      Result := Canvas.TextWidth(S);
    end;

  begin
    Bitmap := TBitmap.Create;
    try
      Canvas := Bitmap.Canvas;

      if TargetControl is TLabel then
        Canvas.Font := TLabel(TargetControl).Font
      else if TargetControl is TEdit then
        Canvas.Font := TEdit(TargetControl).Font
      else
        raise Exception.Create('Font にアクセスできないコントロールです。');

      MaxWidth := TargetControl.Width;
      Ellipsis := '...\';

      //全部入る場合
      if MeasureTextWidth(FilePath) <= MaxWidth then
        Exit(FilePath);

      //ファイル部分とディレクトリ部分を分離
      FilePart := ExtractFileName(FilePath);
      DirPart  := ExtractFilePath(FilePath);
      DrivePart := ExtractFileDrive(FilePath);

      //パスのディレクトリ部分を分解(ドライブ部分は除外)
      Parts := DirPart.Substring(Length(DrivePart) + 1).Split([PathDelim], TStringSplitOptions.ExcludeEmpty);

      //初期は全部表示してみる
      TestPath := IncludeTrailingPathDelimiter(DirPart) + FilePart;

      //左右を削っていくアプローチ
      LeftCount := 0; // 先頭から残すディレクトリ数
      RightCount := Length(Parts); // 後ろから残すディレクトリ数

      while (LeftCount < Length(Parts)) and (MeasureTextWidth(TestPath) > MaxWidth) do
      begin
        //最初の方のディレクトリを省略(中央に Ellipsis)
        Inc(LeftCount);
        TestPath := DrivePart + PathDelim;

        if LeftCount > 0 then
          TestPath := TestPath + Parts[0] + PathDelim;

        if LeftCount < Length(Parts) then
          TestPath := TestPath + Ellipsis;

        if RightCount > 0 then
        begin
          for i := Length(Parts) - RightCount to High(Parts) do
            if i >= 0 then
              TestPath := TestPath + Parts[i] + PathDelim;
        end;

        TestPath := TestPath + FilePart;
        Dec(RightCount);
        if RightCount < 0 then RightCount := 0;
      end;

      //収まる長さで返す
      Result := TestPath;

      //それでも収まらなければ中央省略だけで返す
      if MeasureTextWidth(Result) > MaxWidth then
      begin
        Result := Copy(FilePath, 1, 1) + '...' + Copy(FilePath, Length(FilePath), 1);
      end;

    finally
      Bitmap.Free;
    end;
  end;

begin
  OpenDialog1.Filter := 'MTS ファイル (*.MTS)|*.MTS|すべてのファイル (*.*)|*.*';
  OpenDialog1.Title := 'MTS 形式の動画ファイルを選択してください';
  //ofFileMustExist:ファイルが存在していなければ選択できない
  //ofHideReadOnly:読み取り専用チェックボックスを非表示にする
  OpenDialog1.Options := [ofFileMustExist, ofHideReadOnly];
  OpenDialog1.InitialDir:=ExtractFilePath(Application.ExeName)+'Src';

  if OpenDialog1.Execute then
  begin
    //ShowMessage('選ばれたファイルは: ' + OpenDialog1.FileName);
    //拡張子をチェック
    SelectedFile := OpenDialog1.FileName;
    //拡張子を小文字で取得して比較
    if not SameText(ExtractFileExt(SelectedFile), '.mts') then
    begin
      strMsg:='選択されたファイルは .MTS ファイルではありません。処理を中止します。';
      Application.MessageBox(PChar(strMsg), PChar('エラー'), MB_ICONERROR);
      Edit1.Text:='';
      Button1.SetFocus;
      Exit; // 以降の処理をキャンセル
    end;

    //変数内には正しい文字列が保存されている
    SrcFileName:=OpenDialog1.FileName;
    DstFileName:=ExtractFilePath(Application.ExeName)+'Dst\'
      +ChangeFileExt(ExtractFileName(OpenDialog1.FileName), '')+'.mp4';

    //短く表示_非Path用
    //Edit1.Text:= FitTextWithMiddleEllipsis(Edit1, SrcFileName);
    //Label1.Caption:= FitTextWithMiddleEllipsis(Label1, DstFileName);

    //短く表示_Path表示用に特化
    Edit1.Text:= FitPathWithMiddleEllipsis(Edit1, SrcFileName);
    Label1.Caption:= FitPathWithMiddleEllipsis(Label1, DstFileName);

  end;
end;

6.プログラムのダウンロード

FFmpeg 関連のファイルの除いたプログラム一式を以下からダウンロードできます。なお、ダウンロードとご使用にあたっては、免責事項及び使用条件への同意が必要です。免責事項及び使用条件の詳細は付属の License.txt をご覧ください。

また、動作には FFmpeg が必要です。

FFmpeg のダウンロードサイト : https://ffmpeg.org/download.html

ダウンロードするファイルは、次のいずれかを推奨します。ご自身の環境で展開しやすい方を選択してください。

・ffmpeg-release-essentials.7z
・ffmpeg-release-essentials.zip

MTStoMP4.zip を展開(解凍)した後、以下のようなフォルダ・ファイル構成となるようにダウンロードした FFmpeg.exe を配置してください。

MTStoMP4\
 ├ Dst
 ├ FFmpeg\bin\ffmpeg.exe
 ├ Src
 ├ License.txt
 └ MTStoMP4.exe

MP4 形式に変換する MTS 形式の動画ファイルは必ず Src フォルダ内に準備してください。

なお、プログラムの初回起動時には、Windows Defender SmartScreen による警告画面が表示されます。この警告画面に関する詳細は、当 Blog の次の過去記事をご参照ください。

7.まとめ

このプログラムは変換元の MTS ファイルを選択後、オプションを指定して「変換実行」ボタンをクリックすることで動作します。複数の MTS ファイルを同時に指定して、MP4 変換することはできません。

このプログラムを用いて大きさ 2.09 GB(=2135.36 MB)の MTS 形式の動画ファイルを MP4 形式に変換してみました。なお、各パラメータですが、CRF 値は「23」、Preset は「Medium」、AudioBitRate は「128」を指定しました。生成された MP4 形式の動画の大きさは 287 MB でしたので、削減量は 1848.36MB 、削減率は 約86.6% になります。My NotePC ( Panasonic CF-QV )で生成された MP4 ファイルを視聴しましたが、自分個人の感想として、気になるレベルでの画質や音質の劣化はないように思えました(私の矯正視力は両眼とも 1.5、人間ドックでの聴力検査結果は正常範囲です)。

8.お願いとお断り

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

また、FFmpeg.exe 他、FFmpeg 関連のファイルを同梱した状態での MTStoMP4.exe の再配布を禁じます。MTStoMP4.exe を再配布される場合は、FFmpeg関連のファイルはすべて削除し、MTStoMP4.zip に添付した License.txt を必ず添付してください。

マウスだけで操作可能な画面の拡大表示ツール “KindLens” のご紹介

「見る力を、やさしく支える」KindLens — ドラッグとクリックだけで、視界のバリアを取り払います。

【もくじ】

1.機能のご紹介
2.ダウンロード
3.お願いとお断り

矢印型 Form をこの位置に置いてクリックすると・・・
予め設定した範囲を、指定した倍率で、図のように枠のない別窓に拡大表示します。
別窓を指定時間後に自動で閉じる設定も可能です。
(デフォルト設定では、幅640×高さ320ピクセル、倍率2倍で、2.5秒間表示後、自動で閉じます)

追記(20250715)

初期バージョンにあった不具合を解消しました。主な改善点は以下の通りです。

(1)矢印型 Form の画面上の位置に応じて、矢印の向きとキャプチャ範囲を自動設定します。
(2)矢印形状(方向)のリアルタイム描画で、より直感的なキャプチャ範囲設定を可能としました。
(3)キャプチャ画面を指定時間後に自動で閉じる機能を追加しました(0.5秒刻みで設定可)

  指定時間経過後に拡大表示画面が自動で閉じる機能はデフォルト ON になっています。

また、上記改善を行った後、マルチモニター環境で行ったテストにおいて、プログラムの設計時、設定 Form の Scaled プロパティの確認を怠り、これを「 True のまま」としたため(なぜ、そうなっているのか、わかりませんが、 Delphi では Form の Scaled プロパティはデフォルト True なのです)、設定 Form に配置した VCL コントロールの配置がモニタの解像度によっては乱れてしまうことを確認し、一旦公開を中止して当該箇所の不具合を修正し、再度公開しました。

プログラムにはバージョン番号の表記等は一切ありませんので、矢印型 Form を右クリックすると表示されるサブメニューから「設定」をクリックして選択し、表示される設定画面が正常でない場合は、当記事のダウンロードリンクより、最新版の KindLens.exe をダウンロードしていただけますよう、伏してお願い申し上げます。

今後も、修正・改善箇所があればこの記事で報告し、修正・改善したプログラムをダウンロードリンク先にアップロードいたします。

追記(20250716)

拡大表示画面の表示位置の微調整を行いました。また、矢印型 Form の初期表示色を「白」、サイズを設計時の50%としました。

1.機能のご紹介

このプログラムは、重い障害のある方が右手でトラックボールマウスを操作して、動画・静止画を問わず、画面上に表示されている細かな文字や図を拡大表示して読めるように Delphi の力を借りて開発したものです。利用規約及び使用条件に同意していただければ、どなたでも無料でお使いいただけます。

PCの画面を拡大表示できるツールは Windows の拡大鏡をはじめとしてさまざまなものがありますが、各種設定変更の必要性がなく、単一の実行形式ファイルのダブルクリックで起動し、マウス操作(ドラッグ&ドロップと左ボタンクリック)のみで画面の拡大表示を実現できる無料ツールはおそらくないのではないかと思います。

使い方は・・・

【初期バージョン】※ 現在、ダウンロードできません。

(1)矢印型の Form を拡大表示したい領域の右下へドラッグして移動します。
(2)ドロップした矢印型 Form 上をクリック(マウスの左ボタンを押し下げ)します。
(3)ドロップした位置の左上方向の画面が、拡大表示されます。

【改良バージョン】

矢印型のFormを拡大表示したい領域へドラッグすると、その位置に応じて矢印の形状(指し示す方向)が変化しますので、拡大表示したい領域(の右上・左上・左下・右下位置)へドロップすると、自動的にキャプチャされた範囲が、予め設定した倍率・大きさで拡大表示されます。

拡大したい領域の右上・左上・左下・右下のどこにドロップしたらよいのかは、矢印の形状から直感的に判断できるように改善しました。

拡大倍率は、デフォルト設定2倍です。表示窓の大きさは、デフォルト設定で幅640ピクセル、高さ320ピクセルです。これらの設定は任意の値への変更と、変更した状態の保存が可能です(ただし、簡単にデフォルト設定に戻す機能は用意してありません — 少々乱暴ですが、exe と同じ場所にある exe と同じ名前の拡張子が ini のイニシャライズファイルを削除すれば、デフォルト設定に戻ります)。なお、イニシャライズファイルは、削除しても「設定」画面の保存ボタンをクリックすれば、exe と同じ場所に再生成されます。

言葉で表現しても動作の様子がイメージしにくいと思いますので、実際の実行例をご覧ください。

拡大表示したい範囲の右下へ矢印型Formをドラッグして移動します。


矢印型 Form 上(内部)をクリック(マウスの左ボタン押し下げ)します。すると、次のように矢印方向左上の画面が拡大表示されます。※ 改良版では、矢印型 Form のドロップと同時に拡大表示されます。

拡大表示された別窓(窓枠はありません)をクリックすれば表示は消えます。
改良版では、指定時間経過後に自動的に消去する設定も可能です。
(ESCキー押し下げでも拡大表示は消えます)


ESCキー押し下げによる拡大表示の消去機能は、当初、計画したプログラムの仕様にはありませんでしたが、このプログラムをお使いになる方の左側に、介助される方がいらっしゃるような場合には役立つことがあるかもしれないと考え、実装しました。

また、矢印型の Form は、常に最前面に表示されますので、動画等を全画面表示している場合でも問題なく動作します。拡大表示は矢印型の Form 上をクリックすることで実行されますので、動画アプリの操作と干渉することはありません(動画を流したまま、その一部の拡大表示が「静止画」として可能です)。

私のPC環境では、TEAMSで配信した動画や、YouTube の動画は静止画として拡大表示できましたが、PC環境や通信方法によっては動画を静止画として取得できない場合があるかもしれません。また、このプログラムは Microsoft 社の Windows11 で開発し、同 OS 上で動作確認を行っています。他社製 OS 上での動作は未確認ですので、間接的な方法やエミュレーション技術を利用されて本プログラムを Windows 以外の OS 上で実行される場合は、プログラムそのものが動作しない可能性があることに十分ご注意ください。

【プログラムの開発環境(ご参考まで)】

・デバイスの仕様

 デバイス名	XXX
 プロセッサ	11th Gen Intel(R) Core(TM) i7-1185G7 @ 3.00GHz (3.00 GHz)
 実装 RAM	32.0 GB (31.7 GB 使用可能)
 デバイス ID	
 プロダクト ID	
 システムの種類	64 ビット オペレーティング システム、x64 ベース プロセッサ
 ペンとタッチ	10 タッチ ポイントでのペンとタッチのサポート

・Windowsの仕様

 エディション	Windows 11 Pro
 バージョン	24H2
 インストール日	‎2024/‎10/‎05
 OS ビルド	26100.4652
 エクスペリエンス	Windows 機能エクスペリエンス パック 1000.26100.128.0

・開発環境

 Embarcadero® Delphi 12.3 (バージョン 29.0.55362.2017)
 Professional with Mobile

当初は、拡大対象が動画であった場合は、拡大表示の映像も動画そのものをリアルタイムで拡大して表示する実装でプログラミングしていたのです・・・が、よくよく考えますと、このプログラムは、その前提として、定点に固定されたビデオカメラで写した映像を視聴する場合を想定しており、特に、「ビデオカメラ自体による画面のズームや向きの変更がない」状態で配信された映像中の文字や図表等を確認したい場合のヘルパーとして役立つ(使える)ように開発しましたので、「読めること」を何よりも優先し、動画も静止画として拡大表示する実装に途中から設計方針を変更しました。

また、矢印型 Form の大きさはデフォルト設定よりさらに大きくすることもできます。ただし、大きくした場合は、矢印内でのクリック位置により、意図した表示範囲と拡大画像の範囲が若干ずれることがあります。

【設定の変更方法】

設定を変更するには、矢印型の Form 上を右クリック(マウスの右ボタン押し下げ)して、表示されるサブメニューから「設定」を選んでクリックします。

「閉じる」をクリックするとプログラムは終了します。


設定画面が次のように表示されます。矢印のサイズは設計時の設定を100(%)としてあります。その他の項目は直感的に意味を御理解いただけると思います。

実行時のイメージをキャプチャしました。


矢印型 Form の色と大きさを変更してみました。

色を水色に、サイズは40%に縮小してみました。


矢印の色に「白」を設定した場合は、矢印の輪郭を黒で描画して白背景の画面でも矢印 Form の位置がわかるように工夫してあります。ただし、白以外の淡色を指定した場合は、このような黒い輪郭の描画は行われません。くれぐれもご注意ください

色を「白」に設定した場合、矢印の輪郭が黒い線で描画されます。


もし、矢印 Form の色を白以外のごく薄い淡色に設定して、矢印型 Form の表示位置がわからなくなった場合は、タスクバーに表示されている KindLens のアイコンを右クリックして表示されるメニューから「ウィンドウを閉じる」を選択(クリック:マウスの左ボタン押し下げ)する方法で、プログラムを終了することができます。

設定状態を保存していない場合は、次回起動時には矢印型 Form の色は以前の状態に戻ると思いますが、ごく薄い淡色の設定状態を保存した場合は、KindLens.exe と同じ場所にある KindLens.ini を削除してから KindLens.exe を起動してください。矢印型 Form は初期設定の赤い状態で表示されます。その後、必要に応じて各種設定を変更してください。設定変更後、「保存」ボタンをクリックすれば、拡張子が ini のイニシャライズファイルが再作成され、新しい設定がこのファイルに保存されます。

タスクバーのアイコンを右クリックした状態です。


上の図で、本来「 KindLens 」と表記されるはずの部分が「 Project1 」と表示されているのは、開発環境である Delphi の最初の保存時のプロジェクトファイルの名称が「 Project1 」であったためかと思われます。

開発が軌道に乗った後、プロジェクトファイルの名称を「 KindLens.dproj 」に変更したのですが、この部分の表記は変更されませんでした。これは Delphi の仕様かと思われます。

【設定の保存】

設定値の変更をデフォルト状態として保存します。


設定画面左下の「保存」ボタンをクリックすれば、イニシャライズファイルに設定内容が記録され、次回起動時は保存された設定内容に従って起動します。

「保存」ボタンをクリックすると、KindLens.exe と同じ場所に KindLens.ini が自動的に作成されます。この拡張子が ini のファイルは設定が記録されているファイルなので、誤って消去しないよう十分にご注意ください(ini ファイルを消去した場合、プログラムはデフォルト設定で起動します)。

また、キャプチャする幅と高さは任意の値を直接指定するか、ComboBox の選択肢から選べます。

//キャプチャ画面の幅と高さの実装コード
cmbCW.Items.AddStrings(['240', '320', '400', '480', '560', '640', '720', '800']);
cmbCH.Items.AddStrings(['240', '320', '400', '480', '560', '640', '720', '800']);

上のコードからわかる通り、選択肢から選べる値は、80の倍数としてあります(80の倍数とした理由は特にありません。480とか、640という数字に対して、僕がうまく言葉に出来ない懐かしさを感じることが、その最大の理由であるように感じます)。

この KindLens と題したプログラムには、自分で考えた最低限の「あったらいいな!」と思う機能はすべて搭載しましたが、今後、実際に使用して判明した問題点等があれば速やかに改善したいと思います。その際は、この blog にバージョンアップ版を掲載いたします。

KindLens に関する操作の説明は以上です。たいへん申し訳ありませんが、取扱説明書やヘルプファイルの準備はございません。仕様・操作方法の説明につきまして、その必要がありましたら、この記事をご参照いただけますよう、お願いできましたら(また、ご案内等いただけましたら)幸いです。

2.ダウンロード

KindLens は、次のリンクからダウンロード可能です。ただし、ご利用に当たっては、利用規約及び使用条件への同意が必要です。

ダウンロード後、ダウンロードした KindLens.zip を右クリックし、表示されるサブメニューから「すべて展開」を選んでクリックしてください。次の画面が表示されます。

展開する場所を指定される場合は「参照」をクリックして、任意のフォルダを指定します。
zip ファイルと同じ場所に展開する場合は、そのまま「展開」をクリックしてください。


無事、ファイルが展開(いまだにこの表現に慣れません。どうしても解凍と言いたくなります)されると、次の3つのファイルがエクスプローラーに表示されます。

Windowsの設定によっては、exe 等の拡張子は表示されません。
(License.txt の内容は必ずご確認ください)


ルーペの中にハートの描かれたアイコンが KindLens の実行形式ファイル( exe )です。

このファイルをダブルクリックしてプログラムを起動してください。
(いきなりダブルクリックせず、このアイコンを右クリックすると表示されるサブメニューから「プロパティ」を選んで、Windows Defender SmartScreen による警告画面の表示を回避することもできます:後述)

【初回起動時に表示される警告について】

プログラムの起動に成功すると、初期状態では赤い矢印型 Form がお使いの PC の画面中央に表示されますが、ダウンロード&展開直後の最初の実行(プログラム起動)時には Windows の保護機能が働いて、次に示す Windows Defender SmartScreen による警告画面が表示されます。

「詳細情報」をクリックします。


次の画面が表示されます。

「実行」をクリックしてください。


これは KindLens.exe が悪意のあるプログラムであるために表示される警告ではなく、Windows に搭載されたセキュリティ機能に「未知の発行元や信頼性の低いファイルに対して警告を出す仕組みがある」ために表示されるものです。

ダウンロードされたファイルに「 Zone.Identifier 」という「ゾーン識別子」が付加されていると、Windows はこの識別子を見て「インターネット経由で取得されたファイル」と判断し、SmartScreen が警告を表示します。

【Windows Defender SmartScreen による警告画面を回避する方法】

ダウンロード&展開直後の最初の実行(プログラム起動)時には Windows の保護機能が働いて、上記 Windows Defender SmartScreen による警告画面が表示されますが、これを回避する方法もあります。以下、その手順です。

(1)KindLens.exe をいきなりダブルクリックせず、KindLens.exe のアイコンを右クリックすると表示されるサブメニューから「プロパティ」を選んでクリックしてください。

(2)次の画面が表示されますので、「全般」タブのいちばん下にある「セキュリティ:」部分を図に示した順にクリックしてください。

この作業を行うと、Zone.Identifier が削除され、警告は表示されなくなります。


上記作業を行うと、KindLens.exe に付加されていた「 Zone.Identifier 」という代替データストリーム(ADS)が削除され、警告の表示が出なくなります。「 Zone.Identifier 」はファイルの「本体(メインストリーム)」とは別の Windows の NTFS ファイルシステムの隠れた領域に付加されるメタ情報で、隠しストリームです。

上記のどちらかの方法で Windows の警告が表示される仕組みを解除してください。ADS の削除に成功すれば、次回の実行時から警告は表示されなくなります。

3.お願いとお断り

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

手書き答案の「デジタル採点補助プログラム」のつもりで作った僕のAC_Reader に自動採点機能みたいなモノを搭載しました!

今回ご紹介するプログラムで、自動採点できるかもしれない(?)手書き答案の解答は・・・

カタカナ「ア・イ・ウ・エ・オ」のいずれか1文字、それから
数字の「1・2・3・4・5」のいずれか1つ、そして
記号の「〇 ・ × 」のどちらかです。

この・・・ わずか 12 個の、文字・数字・記号に限定したお話ですが、僕が行ったテストでは各種パラメータの微調整を行うことなく、デフォルト設定のまま、テストデータ(少ないですが)をほぼ正しく推論できました。※ 制作の最終段階での検証結果です。

「自己責任・サポート無し」という条件付きですが、もし、よかったら、お試しください。

どなたにもお待ちいただいておりませんが、2年ぶりにバージョンアップした解答欄リーダーです。

【もくじ】

0.注意事項
1.論より証拠
2.自動採点機能の使い方
3.推論用画像データの確認
4.プログラムのダウンロード
5.お願いとお断り

【注意事項】

初回の自動採点実行時にPCがフリーズしたような状態になることがあります(正しく動作している状態であっても、Python Engine の初期化には数秒を要します)。特に、ダウンロードした Zip ファイルを展開(解凍)した直後の初めての実行時や、インターネット接続が切れた状態で使用した場合、この初期化作業にかなりの時間を要する場合があることを実際に確認しました(常に、この現象が起きるわけではありません)。この現象発生時に、内部的に呼び出して実行している組み込み Python 環境はエラーメッセージを出しません。つまり、プログラムは単に PythonEngine の初期化等、何らかの作業の完了を待つ「待機状態」であることは明らかなのです・・・ が、「プログラムで使用しているどのライブラリがこの待機状態を作り出しているのか」という、はっきりした原因の特定まで現在至っておりません。

この現象は、自動採点実行時、最初の1回に限って発生します。2回目以降は、採点終了まで滞りなく(素人が作ったプログラムなので実行速度は遅いですが)動作すると思います。

お試しいただける方には、たいへん申し訳ありませんが、そのような現象が発生することをご理解いただいた上で、ご試用いただけますよう、伏してお願い申し上げます。

【追記_20250823】

上記の現象について調査した結果、これは「 Windows Defender や McAfee などの Anti-Virus Software または Antivirus Software : AV による『未知バイナリの初回スキャン』により発生している可能性が極めて高い」ことがわかりました。

このプログラムでは、内部的に(バックグラウンドで)PythonForDelphi(P4D)を通じて Python 環境を利用し、自動採点処理を実行しています。ですので、自動採点実行時には、cv2.pyd や numpy 及び scikit-image の HOG や LBP に関連する pyd ( Python Dynamic Module の略= Python の拡張モジュール)が必ず読み込まれます(これらの pyd ファイルは、内部的には ネイティブ DLL と同等に扱われるようです)。

AV は「初めて見る未知の DLL」をロードしようとした時に、ファイル全体をディスクから読み込み、サンドボックス(外部と隔離された仮想環境:ITやセキュリティの分野では、主に怪しいプログラムを安全に試すための実験室として使われる)や、クラウドサービスに投げて解析(インターネット接続が出来ない環境である場合には、一定時間のタイムアウトを設け、その後ローカル判定にフォールバックする:なのでインターネット接続環境がないPCで実行してもいつまでもフリーズしたような状態が続くわけではない → 待機時間は Windows Defender の場合、既定で数秒~数十秒程度)し、ハッシュをキャッシュに登録という処理を行うため、この「初回スキャン」が終わるまで、DLL ロードは OS レベルでブロックされてしまい、アプリケーション側から見ると フリーズ、すなわち「固まった」ようにしか見えない状態になるわけです。一度、このスキャンを通過すれば「このファイルは安全」とキャッシュされるので、以後は高速にロードできるようになります。

自動採点の初回実行時のみ PC がフリーズしたようになり、2回目以降は何の問題もなかったかのように動作するのは、このスキャンが実行されている証拠だと思われます(このスキャンが実行されていることを直接確認する方法はないようです: AV が検査状態を外部に直接公開すると、逆にマルウェアに悪用される可能性が高まるため)。

さらに「実行形式ファイルを別の場所にコピーすると再びフリーズする」のは、 AV によっては ファイルパスや場所ごとにキャッシュが分かれるためです(同じファイルでもデスクトップに置いたら「未知扱い」になる)。

この問題への対策として、セキュリティソフトを無効化するのは論外ですし、また、それが真の原因とわかったわけではなく、現段階ではその可能性が極めて高いと思われるということなので、次の実験を試行して、結果を後日、こちらに記載させていただきます。

(1)「ウォームアップ import」をアプリ起動時にバックグラウンドで実行。
(2)バックグラウンドスレッドで AV スキャンを監視し、UI に進捗状況を表示。

(追記_20250823 ここまで)

【追記_20250825】

ここで紹介している AC_Reader をはじめ、この Blog の過去記事に掲載したアプリケーションはすべてディスプレイ解像度が 1366 × 768 の環境で実行することを前提として開発しています。高解像度ディスプレイで実行される場合、次のリンク先の記事にあります「高 DPI 設定の変更」を行ってから実行していただけますようお願い申し上げます。

(追記_20250825 ここまで)

【追記_20250826】

ユーザー体験を少しでも向上させるべく、以下の順番で AV のスキャンによる待機状態の改善を目標にプログラムの見直しを図りました。

(1)「ウォームアップ import」をアプリ起動時にバックグラウンドで実行。
(2)バックグラウンドスレッドで AV スキャンを監視し、UI に進捗状況を表示。

(1)については、まず、バックグラウンドで実行はやめることにしました。理由は、バックグラウンドで実行してしまうと、AV のスキャンが完了しないうちにメインスレッド側で Python モジュールが使われてしまう可能性があることに気づいたためです。そこで、スキャン対象となる .pyd ファイルをアプリケーション起動時に全て読み込み、スプラッシュフォームの表示中にAnti-Virus Software による『未知バイナリの初回スキャン』を強制的に実行、この処理が確実に完了するまで待機して、安心安全な状態でアプリケーションを実行し、かつ自動採点機能等 Python のモジュールを使用中に発生する待機状態が極力短くなるよう、プログラムを修正しました。コードは以下の通りです。

procedure TFormCollaboration.LoadAllPythonModules;
var
  PyCode: TStringList;
begin
  PyCode := TStringList.Create;
  try
    //スキャン対象となるモジュール
    PyCode.Add('import cv2');
    PyCode.Add('import numpy');
    PyCode.Add('from skimage.feature import hog, local_binary_pattern');
    //その他 Python モジュール
    //スキャン対象ではないモジュールも読み込んでおく
    //初期化の待機時間短縮やエラー回避のため preload
    PyCode.Add('import os');
    PyCode.Add('import glob');
    PyCode.Add('import re');
    PyCode.Add('import joblib');
    // 実行
    PythonEngine1.ExecStrings(PyCode);
  finally
    PyCode.Free;
  end;
end;
procedure TFormCollaboration.FormCreate(Sender: TObject);
var
  ・・・ 省略 ・・・
begin
  //embPythonの存在の有無を調査(条件コンパイル)
  {$IFDEF WIN32}
    //32bit環境での処理
    AppDataDir:=ExtractFilePath(Application.ExeName)+'Python39-32';
  {$ELSE}
    //64bit環境での処理
    AppDataDir:=ExtractFilePath(Application.ExeName)+'Python39-64';
  {$ENDIF}

  if DirectoryExists(AppDataDir) then
  begin
    //フォルダが存在したときの処理
    PythonEngine1.AutoLoad:=True;
    PythonEngine1.IO:=PythonGUIInputOutput1;
    PythonEngine1.DllPath:=AppDataDir;
    PythonEngine1.SetPythonHome(PythonEngine1.DllPath);
    PythonEngine1.LoadDll;
    //PythonDelphiVar1のOnSeDataイベントを利用する
    PythonDelphiVar1.Engine:=PythonEngine1;
    PythonDelphiVar1.VarName:=AnsiString('var1');
    //初期化
    PythonEngine1.Py_Initialize;
  end else begin
    PythonEngine1.AutoLoad:=False;
  end;

  //Splashフォームを表示
  theSplashForm:=TSplashForm.Create(Application);
  try
    theSplashForm.Show;
    theSplashForm.Refresh;
    theSplashForm.TimeLabel.Caption :=
      'ライブラリをロード中...(スキャンにより数分かかる場合があります)';
    theSplashForm.Update;
    Sleep(1500);
    LoadAllPythonModules;  //Pythonのモジュールを読み込み
    theSplashForm.TimeLabel.Caption := '準備が整いました!';
    theSplashForm.Update;
    Sleep(500);
    FadeOutForm(theSplashForm);
    theSplashForm.Close;
  finally
    theSplashForm.Free;
  end;
  ・・・ 省略 ・・・
end;

上記コードを実行した結果、初回起動時、私の環境では約2分5秒間 PC が待機状態になりました。また、自動採点機能の初回使用時は、私の環境では 15 秒間待機状態が続きました。2回目のアプリケーション起動時、自動採点実行時は、いずれも待機時間は大幅に短縮され、ほとんど気にならないレベル(個人差はあると思いますが)になりました。

(2)について

(1)ではユーザーへの案内が「’ライブラリをロード中…(スキャンにより数分かかる場合があります)’」のみとなってしまい、処理の経過状況がうまく伝わらない可能性があると考え、当初、別スレッドで AV スキャンを監視し、UI (theSplashForm.TimeLabel.Caption)に進捗状況を表示できないかと考えました。そこで、.pyd ファイル(=Python モジュール)のロードと同時に監視を自動で開始し、スキャンが収束するまで待機するユーティリティ関数を作成してみたのですが、PC の環境によりインストールされている AV は異なっていて当然ですので、この AV プロセスをどうすれば確実に取得できるかという部分が、まず大きな問題となりました。

const
  AVList: array[0..4] of TAVInfo = (
    (Name: 'MsMpEng'; Path: 'C:\Program Files\・・・\MsMpEng.exe'),
    (Name: 'McShield'; Path: 'C:\Program Files\・・・\McShield.exe'),
    (Name: 'savservice'; Path: 'C:\Program Files\・・・\XXX.exe'),
    (Name: 'ccSvcHst'; Path: 'C:\Program Files (x86)\・・・\YYY.exe'),
    (Name: 'avp'; Path: 'C:\Program Files\・・・\ZZZ.exe')
  );

PC 環境が異なっても上記 Path を確実に取得できるよう、次のようにしたり・・・

type
  TAVInfo = record
    Name: string;
    Path: string;
  end;

function DetectAVProcesses: TArray<TAVInfo>;

implementation

const
  AVCandidates: array[0..4] of TAVInfo = (
    (Name: 'MsMpEng'; Path: '') //動的に取得する
  );

function GetProcessPath(const ProcName: string): string;
var
  Snapshot: THandle;
  ProcEntry: TProcessEntry32;
  hProcess: THandle;
  PathBuffer: array[0..MAX_PATH - 1] of Char;
begin
  Result := '';
  Snapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  if Snapshot = INVALID_HANDLE_VALUE then Exit;

  ProcEntry.dwSize := SizeOf(TProcessEntry32);
  if Process32First(Snapshot, ProcEntry) then
  begin
    repeat
      if SameText(ProcEntry.szExeFile, ProcName + '.exe') then
      begin
        hProcess := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False, ProcEntry.th32ProcessID);
        if hProcess <> 0 then
        begin
          if GetModuleFileNameEx(hProcess, 0, PathBuffer, Length(PathBuffer)) > 0 then
            Result := PathBuffer;
          CloseHandle(hProcess);
        end;
        Break;
      end;
    until not Process32Next(Snapshot, ProcEntry);
  end;
  CloseHandle(Snapshot);
end;

function DetectAVProcesses: TArray<TAVInfo>;
var
  i: Integer;
  L: TList<TAVInfo>;
  Path: string;
  Info: TAVInfo;
begin
  L := TList<TAVInfo>.Create;
  try
    for i := Low(AVCandidates) to High(AVCandidates) do
    begin
      Path := GetProcessPath(AVCandidates[i].Name);
      if Path <> '' then
      begin
        Info := AVCandidates[i];
        Info.Path := Path;
        L.Add(Info);
      end;
    end;
    Result := L.ToArray;
  finally
    L.Free;
  end;
end;

さまざまに頑張ってみたのですが・・・、最終的に、どうやっても「’対象AVが見つかりません’」という表示が消えません・・・。つまり、AV プロセスを取得することが私の技術では出来ませんでした (ToT)

var
  AVProcesses: TArray<string>;
begin
  theSplashForm.TimeLabel.Caption := 'AV監視開始…';

  AVProcesses := DetectAVProcesses;
  if Length(AVProcesses) = 0 then
  begin
    theSplashForm.TimeLabel.Caption := '対象AVが見つかりません';
    Exit;
  end;

  AVThread := TAVScanThread.Create(
    AVProcesses, 10, 3, 60000,
    procedure(const Msg: string)
    begin
      theSplashForm.TimeLabel.Caption := Msg;
    end
  );

  AVThread.Start;
end;

(1)「ウォームアップ import」をアプリ起動時に実行だけで十分な気がしてきました!

なので、ここは潔く・・・

撤退します!

(追記_20250825 ここまで)

また、このプログラムの動作には「Microsoft Visual C ++ ランタイムライブラリ」のインストールが必要です。お使いのPCに「Microsoft Visual C ++ ランタイムライブラリ」が入っていない場合は、下記 Web サイトから「VisualCppRedist_AIO_x86_x64.exe」をダウンロードし、ダウンロードしたプログラムを管理者権限で実行し、動作に必要なライブラリをPCにインストールしてください。なお、インストール時には Windows のユーザーアカウント制御(UAC) が起動し、管理者用のID とパスワードの入力を求められます。インストールでは、exe の名称からわかるように 32 ビット版と 64 ビット版それぞれの VC++ランタイムライブラリがお使いの PC にセットアップされます。なお、インストール後は(僕のPC環境では)再起動なしで、そのまますぐに AC_Reader.exe を実行できました。

「VisualCppRedist_AIO_x86_x64.exe」の入手先:

https://www.majorgeeks.com/files/details/visual_c_redistributable_runtimes_aio_repack.html

2025年6月11日現在、バージョンは「0.91.0」でした。上記 Web サイトの Download (64-Bit EXE) というリンクをクリックすればインストールプログラムをダウンロードできます。

1.論より証拠

自動採点実行時の画面のハードコピーを以下に示します。なお、テスト用データの手書き「文字・数字・記号」は、すべて「お手本」を参照しながら、僕自身が「お手本」を真似て書いたものです。

まず、最初にカタカナの「アイウエオ」5文字の推論結果です。

正解ラベル:「ア」の場合です。(全体を表示するため、解答欄画像は縮小表示しています)

サンプル画像は、画面の表示倍率を81%に設定しているため、細部が霞んでいます。


正解ラベル:「イ」の場合です。


正解ラベル:「ウ」の場合です。


正解ラベル:「エ」の場合です。


No,1とNo,12の画像に縦方向の直線状の汚れがありますが、推論用画像作成の前段階の処理でその除去に成功しています(これを除去しておかないと、例えばNo,12の画像の推論用データは空白の画像ではなく縦線「|」が入った画像になり、学習モデルは間違いなくこれを「1」と推論してしまうはずです)。

解答欄の切り出し直後の画像では、No,1とNo,12の画像の左側に薄い灰色の直線状の汚れがあります。


推論用データ(文字の輪郭を検出して縦横28ピクセルの画像として解答欄の画像から切り出す)を作成する前段階で、これらの汚れを除去する処理を入れています。

No,1とNo,12の画像にあった汚れはキレイに消えています。


この「文字を消さずに汚れのみ除去する」処理はけっこう苦労しました。が、なんとか工夫を重ねて実現できました。「エ」の構成部品である「|」を消さずに、左側の汚れの「|」のみ除去するのは大変でしたが、線状の汚れと判断する基準にその高さ(長さ)を採用して、それが画像の高さとほぼ等しい場合は汚れと見なすことで、この問題はクリアできました。

以下、そのスクリプトです(ご参考まで)。

# 画像内の灰色の直線状汚れを除去

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

folder = r".\GrayLine"
image_extensions = ["*.png", "*.jpg", "*.jpeg"]
image_paths = []
for ext in image_extensions:
    image_paths.extend(glob(os.path.join(folder, ext)))

tolerance = 20  # 画像の高さとの誤差許容範囲(ピクセル単位)

for image_path in image_paths:
    image = cv2.imdecode(np.fromfile(image_path, dtype=np.uint8), cv2.IMREAD_COLOR)
    if image is None:
        continue
    height, width = image.shape[:2]
    gray = cv2.cvtColor(image, cv2.COLOR_BGR2GRAY)
    edges = cv2.Canny(gray, threshold1=20, threshold2=80, apertureSize=3)
    lines = cv2.HoughLinesP(edges, rho=1, theta=np.pi / 180, threshold=50, minLineLength=50, maxLineGap=5)

    if lines is not None:
        for line in lines:
            x1, y1, x2, y2 = line[0]
            angle = np.degrees(np.arctan2(y2 - y1, x2 - x1))
            line_length = np.hypot(x2 - x1, y2 - y1)

            # 垂直線かつ画像の高さとほぼ同じ長さのみ除去
            if (abs(angle - 90) < 1 or abs(angle + 90) < 1) and abs(line_length - height) < tolerance:
                cv2.rectangle(image, (x1-5, 0), (x2+5, height), (255, 255, 255), 2)
                cv2.rectangle(image, (x1-4, min(y1, y2)-5), (x2+4, max(y1, y2)+5), (255, 255, 255), -1)

    cv2.imencode(".png", image)[1].tofile(image_path)

正解ラベル:「オ」の場合です。


カタカナ「アイウエオ」の5文字は間違えずに推論できました。イイ感じです。
次は数字の「12345」。何となくイケそうな気がしてきました☆

正解ラベル:「1」の場合です。


あ・れ・?

なんで「2」に〇が・・・

夢なら覚めてくれ・・・ T_T

一瞬。そう思いましたが・・・

大丈夫。転ぶのには慣れています。これまでだって さんざん・・・、

ここまで来て、あきらめるなんて、そっちの方が無理です。

急いで推論用の画像を確認。

何の問題もなく、解答欄画像からの切り抜きに成功している・・・


・・・ ということ は、学習データに問題があった ってコトか?

左へ 微妙に傾いているように見えます・・・

よくよく考えてみると、このような左に傾いた「2」は、利き腕が右の場合、なんとなく書きにくいような気もします。このことから、つまり、推論をミスした原因は、学習用データとして用意した画像の中に、左に傾いた「2」が少なかったため(?)ではないかと思えてきました。

見たところ、この「2」の画像には極端なシミも汚れもなく、色の濃さも十分、形状もちょっと縦に伸びてるかなって感じもしますが、まぁ、これは一般的にどう見ても「2」です。輪郭検出にも間違いなく成功して期待通りに切り出せている以上、やはり推論ミスの原因は「その傾きにある」としか思えません。

そこで・・・ ナニをしたかというと、

微妙に傾きの異なる画像を50枚作成


取りあえず、1~20°の範囲で、0.5°ずつ傾きに変化をつけ、推論をミスした「2」を左に回転させた画像を上のように50枚用意(処理する際に名称は関係ないので、ファイル名に一貫性はありません)して、さらに「2」の学習データは全体で約7000枚あるので、その1割にあたる700枚を抜き出し、ランダムに5°、10°、15°、20°のいずれかの角度で左に回転させ、先に用意した50枚と合わせて水増し学習データを合計750枚作りました。

「水増し」なんて言うと(文脈にもよりますが)どちらかと言えばネガティブな意味を含むことが多く、なんだか、とてもずる賢い・よからぬことをしているように感じますが、機械学習で使われる「水増し」という言葉は、 データ拡張(Data Augmentation) という概念を表すもので、基本的に悪い意味はないようです。むしろ、このテクニックは、モデルの汎化性能を向上させ、過学習(Overfitting)を防ぐために重要な技術とされているようです。十分な学習データがない場合に、画像の回転・拡大・ぼかし・ノイズ追加などを行うことで、実質的にデータ数を増やせますし(=過学習の防止という意味でもこれは有効)、既存の学習用データに回転(やりすぎは禁物!)や、サイズ変更して作成した水増し学習用データを加えて学習モデルを作れば、異なる角度やサイズの文字にも対応できる、より頑健なモデルにすることができます。

※ 過学習(Overfitting):学習用データが少なかったりすると、学習モデルがそのデータに最適化されすぎてしまい、汎化性能が低下してしまうことを言うそうです。つまり、見たことがあるデータしか、推論に成功しなくなる(見たことがないデータに対して非常に弱くなる)わけですね。

こうして作成した水増し学習用データをを元の約7000枚に追加し、画像をランダムに並び替えて、連番の名前を付け直し、約7800枚の「2」の画像データを作り、そのうち1/3のデータは余白「4」、1/3のデータは余白「5」、1/3のデータは余白「6」を設定(余白の取り方を変更してモデルの汎用性を高めるため)して再学習用の縦横28ピクセルの画像データに変換し、1、3、4、5の各学習用データと合わせて、カタカナ「アイウエオ」の学習モデルを再度構築し直しました。

実際は、再度ではなく、再々々々・・・度の「構築し直し」ですが。
夢は、きっと、叶えるために、あります。

基本的な考え方としては(間違っているかもしれませんが)、学習用データの余白分布が4~6ピクセルであれば、モデルはその範囲内の「平均的」な状態、すなわち中央値に近い値(つまり5ピクセル)に合わせた特徴抽出を学習する(=最も代表的な状態に合わせて内部の重みが調整される)と仮定して・・・

(推論用データの余白の設定を中央値にすると正解率が良いように経験的に感じたのです)

この仮定がもし正しければ、推論用の画像データはそのすべてを「検出した輪郭の周囲に余白5を指定して作成」することで、モデルは最も慣れている条件下で推論動作を行える=最も良い正解率を示すはずだと・・・

実は、この輪郭検出(=文字認識)後、その周囲にどの程度の余白を設定するかについて最初は適当に「8」とか指定していたのですが、モデルの汎用性を高めるためには、学習データの余白の設定は一律に同じ設定としない方が良いはずなので、ある時、ふとその1/3に余白「8」、1/3に余白「9」、1/3に余白「10」を設定して学習モデルを作成し、推論の成否を確認していたところ、推論用データの余白を「9」に設定した場合に正解率がよくなるように感じました(正確に統計をとったわけではありません)。それと最終的には、学習用データ・推論用データともに縦横28ピクセルの画像とすることから、中央に配置した文字が実質縦横20ピクセル程度の領域に入る余白「4・5・6」あたりが最も適当であろうと考えたわけです。MNISTの作りを見ても、この考えは正しいように思われました。

もちろん、学習用データの余白を3・4・5として、推論用データの余白を中央値の4とする設定も考えましたが、余白が3ピクセルではさすがに小さすぎるのではないかと思い直し・・・ つまり、ちょっとした輪郭抽出のズレでも、文字がフレームに近づきすぎて、文字の上下左右の位置のバラつきが大きくなり、モデルが位置変動に過敏になる可能性が大きいと考えました。

逆に余白が6ピクセルと大きい方が、余白を3ピクセルとした場合よりも、文字が中央に安定しやすく、多少のズレがあっても特徴が大きく変わらなくなるはずです(機械学習においては、機械が覚え込んだ特徴量に近い特徴量を示す推論対象が正解とされるわけですから、このことは非常に重要です)。解答欄画像から輪郭検出を行って推論用データを作成する際の余白の設定を様々に変えて試行している際に、わずか1ピクセル、余白の設定を変更しただけで、正解になったり、不正解になったりする事実(プログラムのテストを繰り返す中で、この現象に気づいた当初は本当に不思議に感じました)は、まさにこの推測が正しいことの証明ではないかと思われました。

最終的には、すべて縦横28ピクセルの画像データとするわけですから、このあたりの判断がコトの成否を分ける、言わば「運命の分岐点」であったと、今、ここまでの歩みを振り返って思います。

また、この各数字の画像が約7000枚ずつあるというのは、僕の制作環境においては学習モデルを作成可能な制限ギリギリの値であったようで、学習モデル作成にあたってはまずPCそのものを再起動し、他のアプリが一切動作していない(メモリが十分に空いている)状態を作ってから、学習モデルを作成するスクリプトを実行する必要がありました。

ちなみに僕のPC環境(仕様)は、以下の通りです。

【デバイスの仕様】
プロセッサ	11th Gen Intel(R) Core(TM) i7-1185G7 @ 3.00GHz   3.00 GHz
実装 RAM	32.0 GB (31.7 GB 使用可能)
システムの種類	64 ビット オペレーティング システム、x64 ベース プロセッサ
ペンとタッチ	10 タッチ ポイントでのペンとタッチのサポート

【Windowsの仕様】
エディション	Windows 11 Pro
バージョン	24H2
インストール日	‎2024/‎10/‎05
OS ビルド	26100.4351
エクスペリエンス	Windows 機能エクスペリエンス パック 1000.26100.107.0

様々なアプリを使用した後や、Webブラウザを開いたままの状態で学習モデルを作成するスクリプトを実行すると、必ず「メモリが足りません!」というエラーメッセージが表示され、学習モデルの作成に失敗してしまうので、「再起動直後に実行する」という手を思いつく前は、「もはやこれまで」とせっかく作った学習データを減らそうかと思ったりもしました。

誰も教えてくれる人はいませんので、すべてが手探り状態で、後から考えれば実に様々な「それくらい最初から気がつけよ!」みたいな「プロから見れば当たり前のこと」に気づくまでに、試行錯誤を繰り返し、膨大な時間を費やしつつ、一歩一歩前進するしかありません。

昼間は仕事があるし・・・、夜はあたまの回転がトロくなるし・・・、なんや・かんやで、
だいたい日付が変わる頃に目を覚まし、あとは朝が来るまで、ちいさな灯りをともして・・・
僕の人生の中で、いちばん充実した「時」を過ごします・・・

自動採点を、あきらめない以上は・・・ その時々で、僕に出来る最善を尽くすのみ です。

何はともあれ、左に傾いた「2」を新しく学習したモデルが出来ました!

このモデルを用いて「1」の推論に再チャレンジした結果です。


やった! やった!!

なせばなる!!!

もちろん、余白の設定は「5」としてあります。

画像はプロトタイプのものです。

正解ラベル:「2」の場合です。

No,10の画像の「2」が正解となっていることもうれしいことです。
実は、No,11の画像は、検証用にわざと誤りのデータを他の画像から切り貼りして作成したものです。
つまり、正解ラベル「1」のNo,11の「2」と、上のNo,10の「2」は同じデータと思われます。


正解ラベル:「3」の場合です。


正解ラベル:「4」の場合です。


正解ラベル:「5」の場合です。


数字も正しく読めるようになりました☆


次は、記号の「 ○ と × 」です。

正解ラベル:「 ○ 」の場合です。


正解ラベル:「 × 」の場合です。



・・・・・・・


2025 年 6 月 15 日 午前4時
とうとう・・・
夢がかないました!


とても静か・・・

まだみんな
眠っています。

これも夢かもしれません。

夢なら、どうか・・・

覚めないでください。

2.自動採点機能の使い方

ダウンロードした zip ファイルを展開すれば、すぐにお試しいただけるよう、次に紹介する採点サンプルデータを同梱してあります。記事の説明を参照しながら、操作していただけますよう、お願い申し上げます。

この記事の冒頭にも書きましたが、プログラムの動作には「Microsoft Visual C ++ ランタイムライブラリ」のインストールが必要です。お使いのPCに「Microsoft Visual C ++ ランタイムライブラリ」が入っていない場合は、下記 Web サイトから「VisualCppRedist_AIO_x86_x64.exe」をダウンロードし、ダウンロードしたプログラムを管理者権限で実行し、動作に必要なライブラリをPCにインストールしてください。なお、インストール時には Windows のユーザーアカウント制御(UAC) が起動し、管理者用のID とパスワードの入力を求められます。インストールでは、exe の名称からわかるように 32 ビット版と 64 ビット版それぞれの VC++ランタイムライブラリがお使いの PC にセットアップされます。なお、インストール後は(僕のPC環境では)再起動なしで、そのまますぐに AC_Reader.exe を実行できました。

「VisualCppRedist_AIO_x86_x64.exe」の入手先:

https://www.majorgeeks.com/files/details/visual_c_redistributable_runtimes_aio_repack.html

2025年6月11日現在、バージョンは「0.91.0」でした。上記 Web サイトの Download (64-Bit EXE) というリンクをクリックすればインストールプログラムをダウンロードできます。

【採点の準備】

AC_Reader.exe をダブルクリックしてプログラムを起動したら、「採点作業」ボタンをクリックします。ここで「Windows によって PC が保護されました」と書かれた青い画面が表示された場合は、当 blog の過去記事に対応方法の詳細な説明を載せてありますので、そちらをご参照ください。

この青い画面( Windows Defender SmartScreen )に関するより詳細な説明は、次の過去記事にも掲載しています。もし、よろしければ合わせてご参照ください。

「採点作業」ボタンをクリックすると、次のメッセージが表示されます。


「はい」をクリックすると、既存の採点設定を選択できるようになります。


採点設定ファイルを選択するには、ComboBox の右側の ∨ マークをクリックします。すると候補の選択肢として採点サンプルファイルが1つだけ表示されますので、これをクリックして選びます。


案内メッセージが表示されます。


フォルダ選択」用のダイアログが表示されますので、解答用紙画像の入っている「フォルダを選択」してから OK をクリックしてください。

【重要】 選択するのは「フォルダ」であって、「ファイル」ではありません!


案内メッセージが表示されます。よく読んで OK をクリックしてください。

【採点設定ファイルとフォルダの関係】

最初に選んだ「採点設定ファイル」は、試験で使用した解答用紙の解答欄の座標他が登録されています。ですので、同じ解答用紙を使用して行った試験であれば、すべて同一の採点設定ファイルで採点作業を行うことができます。

通常、テストは「クラス単位」で実施されますが、採点設定ファイルはどのクラスに対しても共通で利用しますので、クラス名を入れない名称を付けて保存(例:R7_考査①_数学Ⅰ)するよう、ユーザーの皆さまにはご案内しています。

解答用紙の画像は、通常であれば「クラス名を付けたフォルダ(例:R7_考査①_数学Ⅰ_1A)」に保存するのが一般的であると思います。

ですので、このプログラムの実際の運用に当たっては、「採点設定ファイルにはクラス名を入れず、解答用紙の画像を保存するフォルダにはクラス名を含めた名前を付けてください。」とユーザーの皆さまへご案内しております。

【採点方法】

自動採点は、次の GUI で行います(僕は「フローティングパネル」と呼んでいます)。いろいろ考えてデザインしましたが、使い勝手がよくないと感じられる方もいらっしゃるかもしれません。そうだったら、ほんとに、ごめんなさい。

上部のタイトルバーに相当する部分を左クリックして、
そのまま(左ボタンを押したまま)ドラッグすると、
フローティングパネルを任意の位置へ移動できます。
(閉じるボタンは無効化してあります)


まず、現在、採点しようとしている設問への配点を設定します。


以下、手動採点時の採点方法の説明です。

手動採点時には、このまま、配点設定欄の下にある入力ボタンをクリックすると、配点設定欄が「0」であれば、現在表示されているすべての解答欄に不正解の「×」が、配点設定欄が「1以上」であれば、現在表示されているすべての解答欄に正解の「○」が(設定によっては配点の数字も)自動で入力されます。

これは、つまり、手動採点時には、初めに解答欄全体の出来栄えを見て、全体的によく出来ているような場合は一括して正解とし、不正解の解答欄だけを手動で採点、逆に全体的に出来がよくない場合には、一括して不正解とし、正解の解答欄だけを手動で採点した方が、効率よく採点できると考えて、このような仕様としました。

もちろん、自動採点時には、この入力ボタンをクリックする必要はありません。

また、配点を設定する ComboBox の右隣りの CheckBox「□する」にチェックを入れると、手動採点時に入力ボタンをクリックして、一括採点操作が行われる前に確認メッセージが表示されるようになります(誤入力を防ぎたいという、ユーザーからの要望で追加した機能です)。

【ここから自動採点の実行方法の説明です】

配点を入力後、自動採点を行う場合は、「□自動採点」にチェックを入れます。
次に、その下にある ComboBox からその設問の正解を選び、実行ボタンをクリックします。

正解として指定できるのは・・・

・カタカナの「ア・イ・ウ・エ・オ」のいずれか1文字、
・記号の「○・×」のどちらか1つ、
・数字の「1・2・3・4・5」のいずれか1つです。

これ以外のカタカナ(例えば「カ」)、記号(例えば「△」)、数字(例えば「6以上の数字」)は指定できません(決まりとして指定できないだけで、正解ラベルとしてComboBoxの入力欄に入力することはできます・・・が、正しく採点することは絶対に不可能です)。ただ、数字のゼロは、たぶん記号の「○」で代用が可能かと思われます・・・ ので、数字については、もしかしたら「0・1・2・3・4・5」の6種類が採点可能かも?しれません(試していませんが)。

また、正解ラベルに指定する文字・記号・数字は、直接入力せず、ComboBox の選択肢から選択してください。記号の「○:まる」に誤って漢数字の「ゼロ:〇」を指定しないようご注意願います。漢数字のゼロは「まる」の変換でも IME の変換候補の選択肢に表示されるので十分注意してください。

「チェック」→「正解ラベル選択」→「実行」です。


採点が完了すると、解答欄の画像の左上に、採点記号(自動採点を利用した場合は、○ or × のいずれか)と、先に設定した配点が赤く表示されます(表示位置は任意の位置に変更できます。変更方法は上で紹介しました当 blog の過去記事をご参照ください)。

自動採点実行直後の状態

お願い
ここで、全ての解答欄について、機械の採点結果を目視で必ず確認してください。

※ このプログラムは、添付した学習モデルの性能が及ぶ範囲で「正解・不正解」のいずれかを判定する自動採点を実行しますが、自動採点結果について、それが常に 100 %「正しい」ことを保証するものではありません。自動採点を行った結果につきましては、必ず、ご自身の責任で、直接、目視によって、その成否をご確認いただけますよう、お願い申し上げます。この使用条件に完全に同意し、かつ確実に目視による確認作業を実行していただける方のみ、このプログラムをお使いいただけますことを申し添えます。このプログラムに搭載した手動及び自動の採点機能を利用した結果、利用者および第三者に損害が発生したとしても、このサイトの管理者は一切責任を負えません。予め、ご了承ください。

【修正が必要な場合】

もし、修正が必要な場合は、修正対象の解答欄の画像をまずクリックします。

・正解に修正する場合は、配点に相当する数字キー(その設問の配点が「2」なら「2」のキー)を押下げします。

・不正解に修正する場合は、「B」キーを押下げします。ちなみに「B」は「 ×:Batsu 」の頭文字で、右手でマウス・左手で手動採点する際に「B」キーは押しやすい位置にあり、また、機能を覚えやすいんじゃないかと考え、「B」を不正解の入力キーとしました。

【採点結果の保存方法】

採点結果を保存(=書込み)しないと、次の解答欄を表示することはできません。実行の左隣にある「書込」ボタンをクリックしてください。採点結果が保存されます。

3.推論用画像データの確認

プログラム設計時の動作検証用に作成した機能ですが、解答用紙画像から切り出した解答欄画像と、その解答欄画像から切り出した推論用画像データの状態を確認することが出来ます。

【解答欄画像の確認方法】

まず、次のように、正解ラベルが「空欄」の状態で確認作業を実行した場合、解答用紙画像から切り出した解答欄画像を確認することが出来ます。

正解ラベルは「空欄」のままにしておきます。


正解ラベルが「空欄」のままであることを確認した後、「設定」→「推論用画像を確認する」の順にクリックしてください(元々、開発時に推論用画像を確認するために設けた機能なので、ボタンの名称が「解答欄・・・」ではありません)。

画像はプロトタイプのものです。


【重要】 設定画面表示中は、Form の「閉じる」ボタンは無効化されます。

解答欄画像が表示されます。


解答用紙から切り出した解答欄画像のクリーニングは、採点作業補助用の GUI (フローティングパネル)の CheckBox 「□自動採点する」をチェックして、さらに正解ラベルが空欄ではない状態で、実行ボタンをクリックすると行われる(ように設定してある)ので、クリーニング前の状態を確認したい場合は、自動採点を実行する前の段階、すなわち、「◀」もしくは「▶」ボタンをクリックした直後の、まだ「□自動採点する」をチェックせず、正解ラベルも指定していない状態で、「設定」ボタンをクリックして、「推論用画像を確認する」をクリックすれば(クリーニング前の解答欄画像を)表示できます。

リリース版では、上のプロトタイプの状態にさらに画像のクリーニング機能を追加、パラメータが増えたため、ボタンのキャプションは単に「推論用画像」としています。

採点エンジンは2系統あります。
Version1 を選択した場合は、各パラメータを調整できます。
(デフォルト設定は、パラメータを調整済みの Version2 としてあります)

プログラムは、「実行」ボタンをクリックすると、まず、解答用紙から切り出した解答欄画像のクリーニングを行って、それから自動採点を行います。初回のみならず、2度目、3度目の見直し採点時であっても、プログラムは「修正等を一切加えていない無加工の解答用紙画像」から解答欄を切り抜いて解答欄画像として表示しているので、汚れのある解答欄が毎回表示されます。クリーニングが行われるのは、実行ボタンをクリックした後であることにご留意ください。

【点状汚れの除去の例】

画像の左下隅に点状の汚れがあります。


クリーニング後の画像は・・・

よーく見ると、微かにうすいシミが残っていますが・・・まぁ、消えたと言えるんじゃないかと。
(ここは後日、さらに改良してより白くなるように修正しました)

【線状汚れの除去の例】

クリーニング前の画像の例(1番目と12番目の画像左端に線状の汚れがあります)


クリーニング後の画像は・・・

線状の汚れは消えました!

【推論用画像の確認方法】

自動採点を実行すれば、推論用に解答欄画像から切り出した、縦横28ピクセルの推論用画像を確認できます。自動採点時、実際に機械が見ているのは、この推論用画像になります。

正解ラベルが指定されている場合は、推論用画像を確認できます。


上の図のような状態で、「実行」ボタンをクリックした後で、「設定」→「推論用画像」の順にクリックします。

推論用画像が表示されます。


縦横28ピクセルの、この小さな画像を思った通りに切り出せるようになるまで、いったいどれくらいの試行錯誤を繰り返したか、今はもうそのすべてを思い出せませんが、自分の中に「あきらめる」という選択肢だけはなかったように思います。

これまでの経験から、ただひとつだけ言えることは、機械学習の成否はこの機械が見る(機械に見せる)画像にあるということです。

学習用データとまったく同じ手法で作成した推論用画像を自分では「ブレない画像」と呼んでいますが、画像中の汚れ・シミ等も含めて輪郭検出した部分の面積を計算し、その大きな部分を組み合わせた範囲を文字として切り抜き、中心位置を計算し、最適な余白を設け、汚れ・シミを除去し、白い部分はより白く、逆に薄い灰色は黒く(濃く)する等、文字の特徴量抽出を阻害する要素をできるだけ取り除いた、わずか縦横28ピクセルの、このちいさな文字。その「作り方」として、僕のとった方法が正解であったかどうかの答えを AC_Reader が出してくれると信じています。

もりろん、手書き文字にひとつとして同じ文字はありませんから、そのような意味で「正しいア」は存在しません。ただ、これまでの経緯から、特徴量抽出で機械が学んだ「ア」こそ、もしかしたら「正しいア」に最も近い「ア」なのではないかと思うようになりました。

ひとことで言えば、「正解がないのに、正解を探す旅」それが今、僕が思う機械学習のイメージです。

4.プログラムのダウンロード

この記事で紹介した「手書き答案の採点補助プログラム AC_Reader.exe」他、この Blog の過去記事に掲載しましたデジタル採点関連のプログラム一式を同梱した DigitalSaiten_All_in_One.zip を次のリンク先からダウンロードできます。なお、ダウンロードとご使用にあたっては、免責事項及び使用条件への同意が必要です。免責事項及び使用条件の詳細は付属の License.txt をご覧ください。

【更新履歴】

・2024年9月29日 初版公開
・2025年8月25日 不具合の修正及び新機能を追加したバージョンアップ版に更新

5.お願いとお断り

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

追記_返却用答案の印刷方法について

元々、この AC_Reader には簡易的な合計点の計算と返却用答案の印刷機能があったのですが、高等学校現場における観点別評価の導入に伴い、返却用答案の印刷プログラムは、マークシートリーダーと共用の別プログラム(ReportCard_2024.exe)としました。

AC_Reader.exe から ReportCard_2024.exe を呼び出して実行できます。ReportCard_2024.exe の操作方法は、当ブログの過去記事をご参照ください。


こちらの過去記事にも ReportCard_2024.exe の操作方法の解説があります。上の記事と合わせてご参照ください。

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


ほんとうは、今回のお話のタイトルは・・・

手書き答案の「デジタル採点補助プログラム」のつもりで作った僕のAC_Reader に自動採点機能も搭載しました!

・・・にしたかったのですが、すみません。その前に、自動採点を行うための準備ついて、どこのサイトにもあまり書いてないことを、書いておきたいと思います。

これから書くことは、もしかしたら僕が知らなかっただけで、機械学習に携わる方であれば注意・留意事項以前の「常識」と言っていいようなことなのかもしれません。

それでも、万一にでも、僕の経験が、初めて機械学習や自動採点に挑戦される方の参考になれば、それこそ、何よりの幸いです。

追記

機械学習のライブラリは何にするか・・・とか、溢れんばかりに、いや、溢れかえるほどに情報があることではなく、僕は、それ以前の物語(準備作業)の重要性に気づいたのです。思ったような結果が出ないのは、ライブラリが悪いのではなく、学習用データや推論用データの作り方に問題があったのです。

ある規格に揃えられた、ブレないデータで学習し、学習時と同じ規格で生成された、ブレないデータで推論(判定)する。これがさんざんまわり道をしてたどり着いた、僕なりの結論です。機械学習の最重要ポイントは、データの作成にありました。

【もくじ】

1.学習&推論データについて
2.解答欄の切り出し
3.解答欄からの解答の切り出し
4.学習用データを作る
5.学習モデルを作る
6.まとめ
7.お願いとお断り

1.学習&推論データについて

機械学習を行うためには、機械に学習させるデータが必要なことは言うまでもありません。数字ならMNIST、日本語のカタカナであれば ETL といったところでしょうか。

2年前、初めて機械学習にチャレンジしたとき、上の2つのデータベースを知り、当時は keras とニューラルネットワークを使ってカタカナ「アイウエオ」の自動採点に挑戦・・・

それなりに時間と、手間暇をかけて自分なりに頑張ったのですが、どうしても夢見たような結果が得られず、最終的には・・・ 自作のデジタル採点プログラムへの搭載を断念。

そのいちばんの原因は、(今思えば)学習モデル作成以前に、「高品質な学習データを準備できなかった」ことにありました。

例えば、学習データとする文字・数字・記号を縦横 28 ピクセルの画像として用意するとした場合、画僧中の文字・数字・記号の大きさ、位置、濃さ、その他、画像中のシミや汚れ、等々と言った実に様々な要素の影響を考慮し、必要な場合は修正(補正)を施して・・・、

学習モデル作成用に準備した学習用画像の「それ」と

実際の採点に利用する解答用紙の解答欄から切り出した推論用画像の「それ」が

完全に一致するように「学習用」&「推論用」画像を準備しなければなりません。

場合によっては、推論対象ごとに処理(修正・補正)を変更する必要すら生じます。例えば「1」や「イ」など、その形状が比較的単純な数字・文字は、画像を二値化して処理した方が認識率が高まるのではないかと実験して感じました(あくまでも、僕自身の実験結果からの判断です。ご注意ください。ただ、僕自身は、この目で見た実験の結果を信じて、推論対象とする数字や文字ごとに処理を分けて実装しています)。

2年前の僕は、学習用画像を作成する段階で、解答用紙の『解答欄の切り出し』にはなんとか成功したものの、解答欄の中の『解答そのものの切り出し』に失敗(例えば、同じ「ア」でも、「つ」と「ノ」の組み合わせのように見える「ア」の場合、機械は「ア」ではなく、「つ」と「ノ」のように別々に輪郭検出)してしまい、高品質な学習用画像が作れませんでした。もちろん、同じ理由から、思うような推論用画像も、生成できるわけがなく・・・

様々に試行を繰り返しましたが、結果としては、自作ソフトへの自動採点機能の搭載を断念せざるを得ませんでした。ただ、自分がとった方法では『ダメ』だという事実と、無加工状態の大量の手書きのカタカナ文字「アイウエオ」、数字の「0~9」、記号の「 〇 と × 」の画像データが残りました。今回の再チャレンジで、これらのデータが役に立ったことは言うまでもありません。もちろん、『ダメだった』という貴重な経験も、今回はその方向に進んではいけないという、良い指標となりました。

まとめると、良い学習モデルを作成するためには、学習モデルを作成するために使用する学習用画像そのものの品質を、高品質化・・・ と言うか、学習用画像の作成方法と、推論用画像の作成方法の差異をなくし、縦横 28 ピクセルの画像とする過程で、数字・文字・記号の大きさを揃え、画像中の位置を中心化し、シミや汚れの除去等々、徹底した修正(補正)を行って、機械が学習しやすく、かつ、判定もより確実に行えるよう、推論用の画像データも学習用データと同じ処理を行って作成したものにする等、ヒトの側で、学びやすい環境と推論しやすい環境を整えてあげることが、ライブラリ云々以前に、他のどんな要素よりも重要で大切なことなんだということが(僕がそう思うだけかもしれませんが)自分なりに納得できた、機械学習で使用する学習&推論用データ作成に関する最終的な結論です。

以下、僕自身が行った画像の切り出しと修正(補正)方法の一部を紹介します。

2.解答欄の切り出し

2年前は、64 ビット環境で作業したのですが、今回は敢えて 32 ビット環境での機械学習にチャレンジすることにしました。理由は、ただひとつ。自分のアプリケーションがいつも利用している組み込み用の Python 環境である Embeddable Python が 32 ビットバージョンであるためです。

利用するライブラリも、2年前の keras ではなく、scikit-learn に変更しました。2年前は、見様見真似で作ったニューラルネットワークを用いましたが、今回は特徴量を抽出する手法(HOG + LBP)を用いて学習モデルを作成し、推論に利用しました。

世の中の流れには、完全に逆行しているような気がしますが、『正しく自動採点できた!』という結果が出せれば、方法は何でも良いと考え、ニューラルネットワークのことは忘れることにしました。

『機械学習』と言えば、即、ニューラルネットワークだと思い込んでいた・・・2年前の僕に、今は・・・、「そんなに短絡的に、思い込まなくても、よかったんじゃないか・・・」って言ってあげたい気もします。

それより、学習用データや、推論用データを、しっかり作ることの方が、大切だよ・・・って。

データが正しければ、ライブラリは間違えない。
データに誤りがあれば、ライブラリも間違える。

ライブラリの性能を、最高に引き出せるデータを作ることが、

機械学習では、きっと・・・

いちばん、大切な、こと・・・ なんだよ って。

それが、今回のチャレンジを終えて、感じた・・・ 僕自身の偽りのない、正直な、思いです。

プログラムに自動採点機能を実装するためには、文字を認識し、推論(判定)する処理が必要です。そのため、最初に行わなければならないのが解答用紙画像から解答欄矩形を切り出す処理です。これには次のようなスクリプトを使用しました。

# 解答用紙から解答欄矩形を切り出すスクリプト(AnswerColumnCutter.py)

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

# 入出力フォルダ
input_folder = r'.\MyData'  # 解答用紙画像のあるフォルダ
output_folder = r'.\ACData'  # 切り出した解答欄の保存先
os.makedirs(output_folder, exist_ok=True)

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

# 解答欄サイズの閾値(調整可能)
min_width = 100
min_height = 50
max_width = 800
max_height = 400

# 保存ファイルの連番用カウンタ
save_index = 1

# 処理ループ
for image_path in image_files:
    filename = os.path.basename(image_path)

    # 画像読み込み(日本語ファイル名に対応)
    image = cv2.imdecode(np.fromfile(image_path, dtype=np.uint8), cv2.IMREAD_COLOR)
    if image is None:
        print(f'読み込み失敗: {filename}')
        continue

    # グレースケール変換と二値化
    gray = cv2.cvtColor(image, cv2.COLOR_BGR2GRAY)
    blur = cv2.GaussianBlur(gray, (5, 5), 0)
    _, binary = cv2.threshold(blur, 0, 255, cv2.THRESH_BINARY_INV + cv2.THRESH_OTSU)

    # 輪郭検出(内枠も含める)
    contours, _ = cv2.findContours(binary, cv2.RETR_TREE, cv2.CHAIN_APPROX_SIMPLE)

    for cnt in contours:
        area = cv2.contourArea(cnt)
        if area < 1000:
            continue

        approx = cv2.approxPolyDP(cnt, 0.02 * cv2.arcLength(cnt, True), True)

        if len(approx) == 4:
            x, y, w, h = cv2.boundingRect(approx)

            if min_width <= w <= max_width and min_height <= h <= max_height:
                roi = image[y:y+h, x:x+w]

                save_name = f'answer_{save_index:04d}.png'
                save_path = os.path.join(output_folder, save_name)
                cv2.imencode('.png', roi)[1].tofile(save_path)

                save_index += 1

print(f'Saving complete! {save_index - 1} items saved.')

実行結果は、次の通りです。数字・文字(記号)は、この記事用にすべて自分で書きました。

一部の「〇と×」のデータは不要ですので削除する必要があります。


これでOKかというと、実はOKではありません。解答用紙の画像から切り出した解答欄の画像1枚1枚をよく見ると・・・

上の赤枠の中に、うっすらと解答欄の「枠線(罫線)」の一部が見える


文字の他に、解答欄の矩形の一部が見えます。最終的には輪郭検出で文字の部分のみを見つけて、文字のみを切り出すので影響はないようにも思いますが、より確実に文字を切り出すために不安要素はすべて準備段階で取り除いておくことにしました。

上のスクリプトに、枠線(罫線)を除去する機能を追加します。

# 解答欄矩形の枠線を消す処理を追加したスクリプト(AnswerColumnCutter2.py)

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

# 入出力フォルダ
input_folder = r'.\MyData'  # 解答用紙画像のあるフォルダ
output_folder = r'.\ACData'  # 切り出した解答欄の保存先
os.makedirs(output_folder, exist_ok=True)

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

# 解答欄サイズの閾値(調整可能)
min_width = 100
min_height = 50
max_width = 800
max_height = 400

# ROIの枠線除去用パディング(上下左右のピクセル数)※状況によっては、個別に指定することも可とした
Pad = 10  # 画像の状態に応じて適宜修正する
padding_top = Pad
padding_bottom = Pad
padding_left = Pad
padding_right = Pad

# 保存ファイルの連番用カウンタ
save_index = 1

# 処理ループ
for image_path in image_files:
    filename = os.path.basename(image_path)

    # 画像読み込み(日本語ファイル名対応)
    image = cv2.imdecode(np.fromfile(image_path, dtype=np.uint8), cv2.IMREAD_COLOR)
    if image is None:
        print(f'読み込み失敗: {filename}')
        continue

    # グレースケール変換と二値化
    gray = cv2.cvtColor(image, cv2.COLOR_BGR2GRAY)
    blur = cv2.GaussianBlur(gray, (5, 5), 0)
    _, binary = cv2.threshold(blur, 0, 255, cv2.THRESH_BINARY_INV + cv2.THRESH_OTSU)

    # 輪郭検出(内枠も含める)
    contours, _ = cv2.findContours(binary, cv2.RETR_TREE, cv2.CHAIN_APPROX_SIMPLE)

    for cnt in contours:
        area = cv2.contourArea(cnt)
        if area < 1000:
            continue

        approx = cv2.approxPolyDP(cnt, 0.02 * cv2.arcLength(cnt, True), True)

        if len(approx) == 4:
            x, y, w, h = cv2.boundingRect(approx)

            if min_width <= w <= max_width and min_height <= h <= max_height:
                roi = image[y:y+h, x:x+w].copy()

                # 枠線を削除(上下左右 padding ピクセルを白で塗りつぶす)
                roi[:padding_top, :] = 255  # 上
                roi[-padding_bottom:, :] = 255  # 下
                roi[:, :padding_left] = 255  # 左
                roi[:, -padding_right:] = 255  # 右

                save_name = f'answer_{save_index:04d}.png'
                save_path = os.path.join(output_folder, save_name)
                cv2.imencode('.png', roi)[1].tofile(save_path)

                save_index += 1

print(f'Saving complete! {save_index - 1} items saved.')

結果は、次の通りです。

周囲が真っ白になりました!


では、これで OK かというと、まだ問題があります。問題の1つが画像中の黒や灰色の汚れです。


これらも出来る限り、除去できるよう解答欄の切り出しスクリプトを改良します。

'''
解答欄矩形の枠線を消す処理を追加したスクリプト(AnswerColumnCutter2.py)に
黒点も削除する処理を追加したAnswerColumnCutter3.py
'''

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

# 入出力フォルダ
input_folder = r'.\MyData'  # 解答用紙画像のあるフォルダ
output_folder = r'.\ACData'  # 切り出した解答欄の保存先
os.makedirs(output_folder, exist_ok=True)

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

# 解答欄サイズの閾値(調整可能)
min_width = 100
min_height = 50
max_width = 800
max_height = 400

# ROIの枠線除去用パディング(上下左右のピクセル数)
Pad = 5
padding_top = Pad
padding_bottom = Pad
padding_left = Pad
padding_right = Pad

# 保存ファイルの連番用カウンタ
save_index = 1

# 処理ループ
for image_path in image_files:
    filename = os.path.basename(image_path)

    # 画像読み込み(日本語ファイル名対応)
    image = cv2.imdecode(np.fromfile(image_path, dtype=np.uint8), cv2.IMREAD_COLOR)
    if image is None:
        print(f'読み込み失敗: {filename}')
        continue

    # グレースケール変換と二値化(binaryにはblurされた白黒反転画像が入る)
    gray = cv2.cvtColor(image, cv2.COLOR_BGR2GRAY)
    blur = cv2.GaussianBlur(gray, (5, 5), 0)
    _, binary = cv2.threshold(blur, 0, 255, cv2.THRESH_BINARY_INV + cv2.THRESH_OTSU)

    # 輪郭検出(内枠も含める)
    contours, _ = cv2.findContours(binary, cv2.RETR_TREE, cv2.CHAIN_APPROX_SIMPLE)

    for cnt in contours:
        area = cv2.contourArea(cnt)
        if area < 1000:
            continue

        approx = cv2.approxPolyDP(cnt, 0.02 * cv2.arcLength(cnt, True), True)

        if len(approx) == 4:
            x, y, w, h = cv2.boundingRect(approx)

            if min_width <= w <= max_width and min_height <= h <= max_height:
                # imageは元のカラー画像(輪郭検出に使用したbinaryではないことに注意する!)
                roi = image[y:y+h, x:x+w].copy()

                # 枠線を削除(上下左右 padding ピクセルを白で塗りつぶす)
                roi[:padding_top, :] = 255  # 上
                roi[-padding_bottom:, :] = 255  # 下
                roi[:, :padding_left] = 255  # 左
                roi[:, -padding_right:] = 255  # 右

                # --- シミやノイズを除去する処理を追加 ---
                gray_roi = cv2.cvtColor(roi, cv2.COLOR_BGR2GRAY)

                # 小さな黒点や灰色点を除去(モルフォロジー開演算)
                kernel = cv2.getStructuringElement(cv2.MORPH_ELLIPSE, (3, 3))
                opened = cv2.morphologyEx(gray_roi, cv2.MORPH_OPEN, kernel, iterations=1)

                # 小さな輪郭(ノイズ)を除去
                cleaned = opened.copy()
                contours_noise, _ = cv2.findContours(255 - opened, cv2.RETR_EXTERNAL, cv2.CHAIN_APPROX_SIMPLE)
                for c in contours_noise:
                    if cv2.contourArea(c) < 150:  # 小さな汚れを消す
                        cv2.drawContours(cleaned, [c], -1, 255, -1)

                # グレースケール→カラーに戻す
                cleaned_color = cv2.cvtColor(cleaned, cv2.COLOR_GRAY2BGR)
                roi = cleaned_color

                # 保存
                save_name = f'answer_{save_index:04d}.png'
                save_path = os.path.join(output_folder, save_name)
                cv2.imencode('.png', roi)[1].tofile(save_path)

                save_index += 1

print(f'Saving complete! {save_index - 1} items saved.')

結果は、次の通り。

汚れがきれいに消えました!


しかし、まだ問題が残っています。それは・・・

画像の左側に灰色の直線のようなものが入っている


この灰色の直線のようなものが入る理由がわからないのですが、現実問題として、僕が利用している複合機でスキャンしたJpeg画像には時折り、このような直線が入ってしまいます(もっと黒い線になることもあります)。理由はともあれ、これを除去できるよう、新しくスクリプトを作成しました。解答用紙から切り出して保存した解答欄画像に対して処理を行っていることにご注意ください。

'''
縦線は画像の高さに匹敵する長さ、
横線は画像の幅に匹敵する長さを持つ直線のみを除去するスクリプト。
image.shape を使って幅 (width) と高さ (height) を取得。
縦線: 傾き ≒ 垂直(3度以内)かつ 長さ ≥ 高さの 80%。
横線: 傾き ≒ 水平(3度以内)かつ 長さ ≥ 幅の 80%。
'''

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

# 処理対象フォルダ
folder = r'.\ACData'  # 解答欄画像として保存したデータを修正しています
image_extensions = ['*.png', '*.jpg', '*.jpeg']
image_paths = []
for ext in image_extensions:
    image_paths.extend(glob(os.path.join(folder, ext)))

for image_path in image_paths:
    # 日本語ファイル名対応で画像読み込み
    image = cv2.imdecode(np.fromfile(image_path, dtype=np.uint8), cv2.IMREAD_COLOR)
    if image is None:
        print(f"読み込み失敗: {image_path}")
        continue

    height, width = image.shape[:2]
    gray = cv2.cvtColor(image, cv2.COLOR_BGR2GRAY)

    # エッジ検出(低い閾値で薄い線も対象)
    edges = cv2.Canny(gray, threshold1=20, threshold2=80, apertureSize=3)

    # HoughLinesPで直線検出
    lines = cv2.HoughLinesP(
        edges,
        rho=1,
        theta=np.pi / 180,
        threshold=50,
        minLineLength=30,
        maxLineGap=5
    )

    # 線を描画するマスク
    mask = np.zeros_like(gray)

    if lines is not None:
        for line in lines:
            x1, y1, x2, y2 = line[0]
            dx = x2 - x1
            dy = y2 - y1
            length = np.sqrt(dx ** 2 + dy ** 2)

            # 傾きが垂直に近く、高さに匹敵する長さを持つ線
            if (abs(dx) < 1e-5 or abs(dy / dx) > 20) and length >= height * 0.8:
                cv2.line(mask, (x1, y1), (x2, y2), 255, thickness=2)

            # 傾きが水平に近く、幅に匹敵する長さを持つ線
            elif (abs(dy) < 1e-5 or abs(dx / dy) > 20) and length >= width * 0.8:
                cv2.line(mask, (x1, y1), (x2, y2), 255, thickness=2)

    # マスクされた領域を修復(inpainting)
    if np.count_nonzero(mask) > 0:
        inpainted = cv2.inpaint(image, mask, inpaintRadius=3, flags=cv2.INPAINT_TELEA)
    else:
        inpainted = image  # 線が見つからなければそのまま

    # 上書き保存(日本語ファイル名対応)
    cv2.imencode('.png', inpainted)[1].tofile(image_path)

    print(f'修正完了: {os.path.basename(image_path)}')

print("全ファイルの処理が完了しました。")

結果は、次の通り。

左側にあった灰色の直線が消えました!


これでようやく安心して使える解答欄の切り出し画像が準備できました!

3.解答欄からの解答の切り出し

次は、解答の切り出しです。2年前はここで失敗しました。今回、あらためて失敗の原因を考えてみると、2年前も輪郭検出までは成功したのですが、輪郭検出できた場合に、『その後の処理をどう行うか?』という部分で(2年前は)工夫が足りなかったことに気づきました。

それはどういうことか、説明します。
まず、輪郭検出です。わかりやすさのために、検出した部分を赤枠で囲って示します。


文字全体が一筆書きのように描かれていれば正しく検出できるのですが、文字を構成する部品が独立して描かれている場合には、文字全体を正しく検出できていません。

今回は、『輪郭検出できた部分を組み合わせて出来る範囲の周囲を文字と見なして切り取る』という方法を用いてみました。次の画像にその結果を示します。


左から順に拡大して見てみます。


拡大すると、文字を構成する部品が完全に繋がっているわけではないようです。が、輪郭検出自体には成功しています。輪郭検出に使用した OpenCV は本当に優秀なライブラリです。


こちらの「ア」は、3つの輪郭の範囲を合わせて文字として認識。切り出しに成功しました!


こちらの「イ」は、2つの輪郭の範囲を合わせて文字として認識。切り出しに成功しました!

では、これで本当に OK かというと、コトはそう簡単ではありませんでした。

次のような、黒点が残ってしまった画像に対し、この切り抜き処理を実行すると・・・


次のように、左隅の黒点部分まで、文字を構成する部品の一部と見なし、(ヒトから見れば)誤った範囲を文字として切り出してしまいます。

機械的には、極めて正確に、ヒトの命令に忠実に、正しい処理を行っているわけですが・・・


この問題に対しては、『検出した輪郭の中から「面積の大きな輪郭」(最大輪郭の面積の10%以上のもの)をすべて組み合わせた領域を文字領域とみなし、その周囲に上下左右10ピクセルの白い余白を付けて切り抜く』方法で対応しました。次がそのスクリプトです。

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

# 入出力フォルダのパス(必要に応じて変更)
input_folder = r'.\MyInputFolder'     # ←処理対象フォルダ
output_folder = r'.\Crop04_Pic'       # ←保存先フォルダ
os.makedirs(output_folder, exist_ok=True)

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

# 処理ループ
for image_path in image_files:
    filename = os.path.basename(image_path)

    # 日本語ファイル名対応の読み込み
    image = cv2.imdecode(np.fromfile(image_path, dtype=np.uint8), cv2.IMREAD_COLOR)
    if image is None:
        print(f'読み込めません: {filename}')
        continue

    # グレースケール & 二値化
    gray = cv2.cvtColor(image, cv2.COLOR_BGR2GRAY)
    _, binary = cv2.threshold(gray, 0, 255, cv2.THRESH_BINARY_INV + cv2.THRESH_OTSU)

    # 縦線除去処理(細い直線ノイズを消す)
    vertical_kernel = cv2.getStructuringElement(cv2.MORPH_RECT, (1, 30))  # 縦方向に長いカーネル
    vertical_lines = cv2.morphologyEx(binary, cv2.MORPH_OPEN, vertical_kernel, iterations=1)
    binary_cleaned = cv2.subtract(binary, vertical_lines)

    # 輪郭検出(外側のみ)
    contours, _ = cv2.findContours(binary_cleaned, cv2.RETR_EXTERNAL, cv2.CHAIN_APPROX_SIMPLE)
    if not contours:
        print(f'輪郭なし: {filename}')
        continue

    # 最大輪郭の面積を基準に、大きな輪郭(最大輪郭の10%以上)を抽出
    max_area = max([cv2.contourArea(c) for c in contours])
    area_threshold = 0.1 * max_area
    large_contours = [c for c in contours if cv2.contourArea(c) >= area_threshold]
    if not large_contours:
        print(f'大きな輪郭なし: {filename}')
        continue

    # 大きな輪郭群の外接矩形の結合領域を求める
    x_vals = []
    y_vals = []
    x2_vals = []
    y2_vals = []
    for cnt in large_contours:
        x, y, w, h = cv2.boundingRect(cnt)
        x_vals.append(x)
        y_vals.append(y)
        x2_vals.append(x + w)
        y2_vals.append(y + h)
    combined_x = min(x_vals)
    combined_y = min(y_vals)
    combined_x2 = max(x2_vals)
    combined_y2 = max(y2_vals)

    # 余白を加える(画像範囲内に収める)
    pad = 10
    x1 = max(combined_x - pad, 0)
    y1 = max(combined_y - pad, 0)
    x2 = min(combined_x2 + pad, image.shape[1])
    y2 = min(combined_y2 + pad, image.shape[0])
    cropped = image[y1:y2, x1:x2]

    # 保存(PNG形式、元のファイル名と同じ名前)
    save_path = os.path.join(output_folder, os.path.splitext(filename)[0] + '.png')
    cv2.imencode('.png', cropped)[1].tofile(save_path)

print(f'Saving complete!')

次のように、構成部品が離れている「ア」であっても(思った通りに)切り出すことに成功しました!


このようにして切り出した画像から、次に機械学習による学習モデルを作るための学習用データを準備します。今回は、scikit-learn の HOG特徴量抽出を利用するので、解答欄から切り出した手書き数字・文字・記号の画像を、手書き数字や単純な記号認識に適しているとされ、MNISTデータセット(手書き数字認識の標準データセット)で採用されているサイズである 28 × 28 ピクセルの画像に変換します。

次に、その変換方法について説明します。

4.学習用データを作る

機械学習の学習用データの作成方法として、僕が行ったことが正しいかどうかは、この記事をお読みになった方ご自身でご判断ください。僕自身は、機械学習を理論的な背景を含め、基礎からきちんと学んだことはありませんし、今回利用した HOG( Histogram of Oriented Gradients )+ LBP(Local Binary Patterns )という特徴量抽出手法についてもその詳細な部分まで理解しているわけではないからです。そのような点を御理解の上、記事をお読みいただけましら幸いです。

学習用データは、予め、「ア」なら「ア」だけを、正解ラベル名を付けたフォルダに分類しておきます。

実際には、ア~オの各文字につき、2600枚程度の画像を用意しました!


これを処理して、次に示すような 28 × 28 ピクセルの画像を作成します。


この 28 × 28 ピクセルの画像を作成する過程で、必要に応じて、補正処理をかけ、機械学習を行うために必要十分と思われる画像となるよう準備します。ここで言う必要十分とは、機械に見せる画像内の推論対象の「大きさ・位置・傾き・濃さ」等をヒト基準で一定の範囲に収まるように、予め個々の画像を学習前・推論前に調整し、学習時も推論時も同じ処理の過程を経て作成された・・・言わば「ブレていない」画像(データ)を機械が見れる = 機械は余計な気遣いなどできないので、同じ条件下で作成された画像を見て、機械は「その特徴量抽出のみに専念できるようにする」という意味です。

繰り返しになりますが、学習用画像を作成する時だけでなく、推論用画像を作成する際も、学習用画像を作成する際に行ったのと同じ処理をそっくりそのまま行って、機械が常に同じ(安定した)条件下で推論(手書き文字の認識作業)を実行できるようにするという部分も非常に重要だと考えます。

処理に使用したライブラリの一覧です。

import cv2
import numpy as np
import os
from glob import glob
import re
import joblib
from skimage.feature import hog, local_binary_pattern

文字を傾きを均一化し、分類器がより正確な特徴を学習できるようにするために次の関数を用意。

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)

学習用画像データの読み込み処理部分は割愛します。

次が学習用画像の処理ループ部分です。任意に指定した学習用データを保存したフォルダ内の全画像について処理を以下の通り実行します。補正処理の実行内容は、各々のコメントをご参照ください。

index = 1
light_text_threshold = 215  # 文字の視認性の向上(薄いと判断する閾値)
pad = 10                     # 周囲に設定する余白
clip_limit = 0.3            # コントラストの過剰な増加を防ぐための制限値。ごく弱く設定。
tile_grid_size = 2          # 画像を分割するグリッドのサイズ。ごく小さめに設定

# 学習用データの数だけループする
for image_path in image_files:
    image = imread_utf8(image_path)
    if image is None:
        continue
    gray = cv2.cvtColor(image, cv2.COLOR_BGR2GRAY)
    _, binary = cv2.threshold(gray, 0, 255, cv2.THRESH_BINARY_INV + cv2.THRESH_OTSU)

    '''
    小さすぎる or 明るすぎる成分は除外して、画像の連結成分を解析し、有効な成分のみを抽出、
    適切な境界を決めて、その範囲を文字として切り出す処理。
    '''
    num_labels, labels, stats, centroids = cv2.connectedComponentsWithStats(binary, connectivity=8)
    min_area = 50
    brightness_threshold = 200

    valid_components = []
    for i in range(1, num_labels):
        x, y, w, h, area = stats[i]
        if area < min_area:
            roi = gray[y:y+h, x:x+w]
            mean_val = cv2.mean(roi)[0]
            if mean_val > brightness_threshold:
                continue
        valid_components.append((x, y, w, h))

    if not valid_components:
        cropped = np.full((28, 28, 3), 0, dtype=np.uint8)
    else:
        x_vals = [x for x, y, w, h in valid_components]
        y_vals = [y for x, y, w, h in valid_components]
        x2_vals = [x + w for x, y, w, h in valid_components]
        y2_vals = [y + h for x, y, w, h in valid_components]
        combined_x = min(x_vals)
        combined_y = min(y_vals)
        combined_x2 = max(x2_vals)
        combined_y2 = max(y2_vals)

        x1 = max(combined_x - pad, 0)
        y1 = max(combined_y - pad, 0)
        x2 = min(combined_x2 + pad, image.shape[1])
        y2 = min(combined_y2 + pad, image.shape[0])
        cropped = image[y1:y2, x1:x2]

    '''
    明るい文字のコントラストを調整し、認識しやすくする処理。白飛びを防ぎ、画像の視認性を改善する。
    '''
    trimmed_gray = cv2.cvtColor(cropped, cv2.COLOR_BGR2GRAY)
    mask = (trimmed_gray >= light_text_threshold).astype(np.uint8) * 255
    adjusted = trimmed_gray.copy()
    adjusted[mask == 255] = np.clip(adjusted[mask == 255] - 20, 0, 255)

    # 輪郭検出
    contours, _ = cv2.findContours(adjusted, cv2.RETR_EXTERNAL, cv2.CHAIN_APPROX_SIMPLE)

    if contours:
        # CLAHEを適用
        clahe = cv2.createCLAHE(clipLimit=clip_limit, tileGridSize=(tile_grid_size, tile_grid_size))
        trimmed_gray = clahe.apply(trimmed_gray)
        # 調整した結果、ここではぼかし無しと同等にしておくことにした。必要であればより強く設定。
        trimmed_blur = cv2.GaussianBlur(trimmed_gray, (1, 1), 0)
        # 単純な形であれば二値化して処理する
        if label in ["イ", "1"]:
            _, trimmed_thresh = cv2.threshold(trimmed_blur, 0, 255, cv2.THRESH_BINARY + cv2.THRESH_OTSU)
            h_trim, w_trim = trimmed_thresh.shape[:2]
        else:
            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)

        if label in ["イ", "1"]:
            resized = cv2.resize(trimmed_thresh, (new_w, new_h), interpolation=cv2.INTER_AREA)
        else:
            resized = cv2.resize(trimmed_blur, (new_w, new_h), interpolation=cv2.INTER_AREA)

        # 学習用データから切り出した文字を28×28ピクセルのキャンバスの中央に配置する。
        # 入力画像を統一されたサイズに整える。
        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)

        # - 画像のモーメント(統計量) を計算し、文字の重心(中心)を求めてセンタリングする処理
        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_AREA, borderValue=255)

        canvas = deskewed

        # 画像の標準化
        mean, std = cv2.meanStdDev(canvas)
        std = std[0][0] if std[0][0] > 1e-5 else 1.0
        # 画像の正規化
        norm_img = (canvas.astype(np.float32) - mean[0][0]) / std
        norm_img = cv2.normalize(norm_img, None, 0, 255, cv2.NORM_MINMAX)
        canvas = norm_img.astype(np.uint8)
    else:
        # - 有効な画像データがない場合は、白色の 28×28 画像を作成。
        canvas = np.full((28, 28), 255, dtype=np.uint8)

    # png形式で保存する
    save_path = os.path.join(output_folder, f"crop_Img{index:04d}.png")
    is_written = cv2.imencode(".png", canvas)[1]
    with open(save_path, "wb") as f:
        f.write(is_written)
    index += 1

png 形式での保存を選択したことにも理由があります。データを間引いて保存する Jpeg 形式よりも、可逆圧縮を使用し、元の画像データを損失なく保存(ピクセル単位での正確性を維持)できる png 形式の方が機械学習には適しているからです。

こうして、次のような学習用データが完成しました。

こんな小さな画像ですが、ここまで到達するには・・・ 本当に長い時間と・・・ 試行錯誤が必要でした。

5.学習モデルを作る

任意のフォルダ内(ここでは trimed フォルダ)に、正解ラベルの名前を付けたフォルダを必要数分準備して、上の4で作成した学習データを格納しておきます。

そして、学習モデルを作成するスクリプトを実行します。例としてカタカナ「アイウエオ」の推論用の学習用データ作成スクリプトを示します。

import os
import cv2
import numpy as np
import joblib

from skimage.feature import hog, local_binary_pattern
from sklearn.decomposition import IncrementalPCA
from sklearn.svm import SVC
from sklearn.model_selection import train_test_split, GridSearchCV
from sklearn.metrics import classification_report

LABELS = {'ア': 0, 'イ': 1, 'ウ': 2, 'エ': 3, 'オ': 4}
IMG_SIZE = (28, 28)

LBP_RADIUS = 1
LBP_POINTS = 8 * LBP_RADIUS
LBP_METHOD = 'uniform'

DATASET_DIR = r".\aiueo\Trimed"

def extract_features(image):
    image = cv2.GaussianBlur(image, (3, 3), 0)
    hog_features = hog(image, pixels_per_cell=(4, 4), cells_per_block=(2, 2), feature_vector=True)
    lbp = local_binary_pattern(image, LBP_POINTS, LBP_RADIUS, method=LBP_METHOD)
    lbp_hist, _ = np.histogram(lbp.ravel(), bins=np.arange(0, LBP_POINTS + 3), range=(0, LBP_POINTS + 2))
    lbp_hist = lbp_hist.astype("float32")
    lbp_hist /= (lbp_hist.sum() + 1e-6)
    return np.concatenate([hog_features, lbp_hist])

def load_dataset_in_batches(root_dir, max_samples_per_label=7000, batch_size=500, show_progress=False):
    label_dirs = [d for d in os.listdir(root_dir) if os.path.isdir(os.path.join(root_dir, d)) and d in LABELS]

    for label_name in label_dirs:
        label_path = os.path.join(root_dir, label_name)
        files = os.listdir(label_path)
        np.random.shuffle(files)
        batch_features = []
        batch_labels = []

        total_files = min(len(files), max_samples_per_label)
        if show_progress:
            print(f"\n[{label_name}] 読み込み開始 (最大{total_files}枚)")

        for i, file in enumerate(files):
            if i >= max_samples_per_label:
                break
            file_path = os.path.join(label_path, file)
            image = cv2.imdecode(np.fromfile(file_path, dtype=np.uint8), cv2.IMREAD_GRAYSCALE)
            if image is None or image.shape != IMG_SIZE:
                continue
            feat = extract_features(image)
            batch_features.append(feat)
            batch_labels.append(LABELS[label_name])

            if show_progress and ((i + 1) % max(1, total_files // 20) == 0 or (i + 1) == total_files):
                progress = (i + 1) / total_files * 100
                print(f"  {i+1}/{total_files}枚完了 ({progress:.1f}%)")

            if len(batch_features) >= batch_size:
                yield np.array(batch_features, dtype=np.float32), np.array(batch_labels, dtype=np.int32)
                batch_features = []
                batch_labels = []

        if batch_features:
            yield np.array(batch_features, dtype=np.float32), np.array(batch_labels, dtype=np.int32)

# 特徴抽出
print("\n[特徴量収集]")
all_features = []
all_labels = []
for batch_features, batch_labels in load_dataset_in_batches(DATASET_DIR, show_progress=True):
    all_features.append(batch_features)
    all_labels.append(batch_labels)

X_all = np.vstack(all_features)
y_all = np.hstack(all_labels)

# PCA学習
print("\n[PCA学習開始]")
n_components = 200
pca = IncrementalPCA(n_components=n_components)
pca.fit(X_all)

# 特徴量変換
X_pca = pca.transform(X_all)

# データ分割
print("\n[データ分割]")
X_train, X_test, y_train, y_test = train_test_split(X_pca, y_all, test_size=0.2, random_state=42)

# 間違えてもとにかく判定
# model = SVC(kernel='rbf', gamma='scale', C=10)
# 指定正解率未満の場合は「判定不可能」と表示
# この指定着きでビルドしていない場合、判定スクリプトを実行すると「handwritten_digit_0.png の推定結果: モデルが確率推定に未対応」と表示される
model = SVC(kernel='rbf', C=10, probability=True)

'''
# ハイパーパラメータ探索 -> 1, 10, 50, 100 の中から探す。結果、C=10 だった!
print("\n[グリッドサーチ]")
param_grid = {'C': [1, 10, 50, 100]}
svc = SVC(kernel='rbf', gamma='scale')
clf = GridSearchCV(svc, param_grid, cv=3)
clf.fit(X_train, y_train)
print(f"最適なCの値: {clf.best_params_['C']}")
model = clf.best_estimator_
'''

# モデル学習(これが抜けているとエラーになる!)
model.fit(X_train, y_train)

# 評価
print("\n[テストデータで評価]")
y_pred = model.predict(X_test)
print(classification_report(y_test, y_pred, target_names=list(LABELS.keys())))

# 確率推定
# y_proba = model.predict_proba(X_test)  # 各クラスの確率を取得
# print(y_proba[:5])  # 最初の5つの予測結果の確率を表示

# モデル保存
print("\n[モデル保存]")
joblib.dump(model, "aiueo_svm_model.pkl")
joblib.dump(pca, "aiueo_pca.pkl")
print("[保存完了]")

実行結果は、次の通りです。

[特徴量収集]
[ア] 読み込み開始 (最大2511枚)
  125/2511枚完了 (5.0%)
 ・・・(省略)・・・
  2511/2511枚完了 (100.0%)
[イ] 読み込み開始 (最大2575枚)
  128/2575枚完了 (5.0%)
  ・・・(省略)・・・
  2575/2575枚完了 (100.0%)
[ウ] 読み込み開始 (最大2636枚)
  131/2636枚完了 (5.0%)
  ・・・(省略)・・・
  2636/2636枚完了 (100.0%)
[エ] 読み込み開始 (最大2582枚)
  129/2582枚完了 (5.0%)
  ・・・(省略)・・・
  2582/2582枚完了 (100.0%)

[オ] 読み込み開始 (最大2602枚)
  130/2602枚完了 (5.0%)
  ・・・(省略)・・・
  2602/2602枚完了 (100.0%)
[PCA学習開始]
[データ分割]
[テストデータで評価]
              precision    recall  f1-score   support

           ア       1.00      1.00      1.00       516
           イ       1.00      1.00      1.00       538
           ウ       1.00      1.00      1.00       537
           エ       1.00      1.00      1.00       499
           オ       1.00      1.00      1.00       492

    accuracy                           1.00      2582
   macro avg       1.00      1.00      1.00      2582
weighted avg       1.00      1.00      1.00      2582

上のスクリプトで、

X_train, X_test, y_train, y_test = train_test_split(X_pca, y_all, test_size=0.2, random_state=42)

としていますので、データセットの 80% を学習用 (X_train, y_train)、20% をテスト用 (X_test, y_test) に分割していることになります。

スクリプトを実行する度に、テスト用の20%の内容は変化しますので [テストデータで評価] の部分は変化するはずですが、何回か、実行した結果悪くても 0.99 で、どの文字についても、ほとんど 1.00 から変化がありませんでした。

ちなみに、もう1回実行してみると・・・

[テストデータで評価]
              precision    recall  f1-score   support

           ア       1.00      1.00      1.00       516
           イ       1.00      1.00      1.00       538
           ウ       1.00      1.00      1.00       537
           エ       1.00      1.00      1.00       499
           オ       1.00      1.00      1.00       492

    accuracy                           1.00      2582
   macro avg       1.00      1.00      1.00      2582
weighted avg       1.00      1.00      1.00      2582

もう1回、実行してみました。

[テストデータで評価]
              precision    recall  f1-score   support

           ア       1.00      1.00      1.00       516
           イ       0.99      1.00      1.00       538
           ウ       1.00      1.00      1.00       537
           エ       1.00      1.00      1.00       499
           オ       0.99      0.99      0.99       492

    accuracy                           1.00      2582
   macro avg       1.00      1.00      1.00      2582
weighted avg       1.00      1.00      1.00      2582

「イ」と「オ」が 0.99 ですが、それでも 0.99 です。

・適合率 (precision) が ほぼ 1.00 なので、正解ラベルを正しく予測できています。
・再現率 (recall) が ほぼ 1.00 なので、実際の正解ラベルを確実に検出できています。
・F1スコア が ほぼ 1.00 なので、誤分類はありません。

で、総合精度 (accuracy) が 1.00 ですから、今回、作成した学習モデルはテストデータに対して完璧に近い性能を発揮していると言ってよいと思います。ただ、ただ、過学習に陥ってないことを祈るのみです。過学習に陥っていないことの確認するのは簡単です。未知の手書きカタカナ「アイウエオ」のデータを、この学習モデルに見せて、正しく推論できるか、テストしてあげればよいのです。

なので、未知のカタカナ文字を正しく推論できるか、テストしてみました。

文字は、すべて僕自身が書いたものです。


テストに使用したスクリプトです。こちらは簡易版で、実際の場面では、より良い推論用データとなるよう、このスクリプトを適用する前処理として、上で学習用データを作成するために行った補正(修正)を上の5つの画像に対して行い、その後、このテスト用スクリプトを適用することになります。

# アイウエオ判定用最終版

import os
import cv2
import numpy as np
import joblib
from skimage.feature import hog, local_binary_pattern

# 定数
IMG_SIZE = (28, 28)
LBP_RADIUS = 1
LBP_POINTS = 8 * LBP_RADIUS
LBP_METHOD = 'uniform'

# 特徴量抽出関数(前処理スクリプトと整合)
def extract_features(image):
    image = cv2.GaussianBlur(image, (3, 3), 0)

    # HOG特徴量
    hog_features = hog(
        image,
        pixels_per_cell=(4, 4),
        cells_per_block=(2, 2),
        feature_vector=True
    )

    # LBP特徴量(ヒストグラム)
    lbp = local_binary_pattern(image, LBP_POINTS, LBP_RADIUS, method=LBP_METHOD)
    lbp_hist, _ = np.histogram(
        lbp.ravel(),
        bins=np.arange(0, LBP_POINTS + 3),
        range=(0, LBP_POINTS + 2)
    )
    lbp_hist = lbp_hist.astype("float")
    lbp_hist /= (lbp_hist.sum() + 1e-6)

    return np.concatenate([hog_features, lbp_hist])

# モデルとPCA読み込み
model = joblib.load("aiueo_svm_model.pkl")
pca = joblib.load("aiueo_pca.pkl")

# 推論対象ファイル(日本語ファイル名対応)
file_list = [f"katakana_sample_{i+1}.jpg" for i in range(5)]

# 推論実行
for file_name in file_list:
    if not os.path.exists(file_name):
        print(f"ファイルが存在しません: {file_name}")
        continue

    file_path = os.path.abspath(file_name)
    # 日本語パス・ファイル名対応
    image = cv2.imdecode(np.fromfile(file_path, dtype=np.uint8), cv2.IMREAD_GRAYSCALE)

    if image is None:
        print(f"読み込み失敗: {file_name}")
        continue

    # サイズ変換(28x28)と前処理との整合
    image_resized = cv2.resize(image, IMG_SIZE, interpolation=cv2.INTER_AREA)

    # 特徴量 → PCA変換 → SVM予測
    features = extract_features(image_resized)
    features_pca = pca.transform([features])
    prediction = model.predict(features_pca)

    print(f"{file_name} の推定結果: {prediction[0]}")

学習モデル( aiueo_svm_model.pkl と aiueo_pca.pkl )は、スクリプトと同じ場所に置いて実行します。結果は、次の通りです。

katakana_sample_1.jpg の推定結果: 0
katakana_sample_2.jpg の推定結果: 1
katakana_sample_3.jpg の推定結果: 2
katakana_sample_4.jpg の推定結果: 3
katakana_sample_5.jpg の推定結果: 4

よかった・・・。過学習には陥っていないようです。

あとは・・・ Delphi の P4D( Python4Delphi )を使って、僕の手書き答案採点補助プログラム AC_Reader で、このスクリプトを実行すれば・・・

自動採点を、実現できます。

6.まとめ

機械学習で良い学習モデルを作るには、学習用データ作りをしっかり行うことが大切。文字の大きさ・位置(配置)・濃さ等の調節、及び、画像中の不要な点(シミ)や汚れを除去する等々して、個々にブレのない安定した学習用データ(もちろん、推論用データも同様)を作成、これを元に学習モデルを作成すれば上に示した結果を出せるはずです。

今回の記事で紹介した内容は、テストを繰り返し行って、問題点を洗い出し、それら問題点を1つ1つ丁寧に解決した結果です。絶対に『あきらめない』こと、もしかしたら、それがいちばん重要で大切なポイントかもしれません。

7.お願いとお断り

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

TSL205の修理、その後・・・

樹林帯を抜けると、そこからは5月の残雪が輝きながら、僕を待っていた。

【もくじ】

1.軽アイゼンを選ぶ
2.左膝の違和感
3.装備をチェック
4.出発
5.切れたバンド
6.先輩の言葉
7.オベリスク
8.エピローグ

1.軽アイゼンを選ぶ

先輩に修理してもらったスノーシューは、今回は家に置いてきた。昨年のこの時期、今回目指すピークのふたつ隣のピークを目指した際、日当たりの良い斜面で、完全にグシャグシャになった残雪を経験したことを思うと、それを使いたい気持ちはあるにはあった。その気持ちに嘘はないのだが。

三歩に一歩は、足が深く雪面に潜り、転ばずに十歩以上は歩けなかった・・・ 去年の春山の記憶。

今回の計画に際し、もし、今年も雪があの状態であれば、スノーシューも期待した程には役立たないのでは・・・ と思ったこと、及び、今回目指すピークは自宅からそれなりに遠方にあり、スノーシューを運ぶこと自体が手間になること、かつ、テント場からスノーシューが必要になる高度まで、それを運ぶ距離を考えると、スノーシューを使う(運ぶ)メリット以上に、体力的な面で、それを使わない(運ばない)メリットの方が大きいと思えたのだ。

・・・とは言え、雪への備えは必要。スノーシューを選択しないのであれば、カンジキは持っていないので、残る装備品はアイゼンしか、ない。

ただ、ホンモノのアイゼンは重い。それが必要となる高度までの距離と、雪の状態を思うとホンモノのアイゼンを装備するメリットは相当に薄れる・・・。雪対策が必要な高度は森林限界を超えてから 300 m程度のはずだ。そう考えた僕は、様々に悩んだ結果として、軽アイゼンを持参することにした。

本当ならばここで、持参する軽アイゼンを、実際に今回使用する登山靴に装着して、その相性を確認しなければならない。

そう、・・・確認しなければ、ならないのだが・・・正直に言うと、持参する予定の軽アイゼンの登山靴への試着を今回、僕は行わなかった。

昨年もこの時期に同型の軽アイゼンを使用したし、装着法も分かっているので、現地で、もし必要になったら、装着すればいいだけのこと。装備品として忘れずに持参さえすれば「何の問題も起こらない」・・・ と、僕はそう信じ込んでいた。

山行前に入手した今年の残雪の状況は少なそうだったこともあり、もしかしたら、アイゼンを使わなくてもいい状況かもしれないとさえ、考えた。まさか、そのことが後で大きな問題に発展するとは、この時、僕は思いもしなかった。

2.左膝の違和感

実は、今回の山行で、僕の中には雪への対策以上に大きな不安があった。それは両膝の違和感だ。どちらかと言えば、左膝・・・。もちろん、山行自体をキャンセルすれば何の問題もないのだが、その選択肢が僕の中に「ない」以上、すべては「行く」という前提での話になる。

この春先から両ひざに何か違和感があり、特に左膝のそれは登山予定日にセットされた時限爆弾であるかのような思いがして、こちらも TSL205 の修理の先輩から教えてもらったPという商品を爆買いして朝晩飲もうと冷蔵庫に数パックを保管・・・ したまではよかったのだが、それを一緒に暮らしている人が見つけ、「賞味期限までに飲み切れないでしょう。1日1本で十分です。実家の母もひざが痛いと言ってるので、母の日のプレゼントにします。」と最高の理由付きで、先輩から教えてもらったPは冷蔵庫から2パックが消え・・・

そんな想定外の試練を乗り越えて、P を1日1本、飲み続けてはいたのだが、違和感の解消には至らないまま、出発の日を迎えることに・・・

3.装備をチェック

電車に揺られること、数時間。星空の下に張ったテントの中で迎えた 20:45、持参した装備を最終点検。ライトが照らし出す物品を一つ一つチェックする。

僕は、ごく薄い、耐水性のある、軽い布で出来た、濃いオレンジ色のポーチを緊急用装備品入れとして活用している。薬品類他、様々なものが入っているが、ただの一度も活用したことのない物品も混じっている。山行の度に、持って行くかどうか、真剣に悩んで、その都度、取捨選択して残してきたものばかりだが・・・。

今回はいつも以上に膝に不安がある。わずか数グラムでも軽さを優先したい。塵も積もれば・・・の例えの通り、わずか数グラムであっても、その積み重ねが背負う荷を例えようもなく重くするのだ。

登りと降りの連続した・・・ 木の根っこや、泥んこの、あるいは岩石が作る自然の階段を 10 km 以上歩いた時に感じる荷の重さは、疲れを知らない時に想像するそれとは比べものにならない。

( 明日、僕は、これまで経験したことのない距離を歩く・・・。だから、少しでも、軽く・・・ )

そんなことを思いながら、装備品を選別する中で、ふと、目に留まったものがあった。

『細引き』

今まで現地で使ったことは1回しかない。地面が固すぎてペグを打ち込めなかった際、フライシートのペグを引っ掛ける紐を延長して、岩に結ぶために切って使用したことがあるだけだ。今回持参したものは、その時の余りを巻き直したもので、前回使用した紐はフライシートに結び付けたままだし、今回、もし、それが必要になったとしても、前回の使用分がそのまま利用できる。その他に細引きが必要になるシーンがあるとは思えない。そう思った僕は、今回、細引きをテントに残して行くことに決めた。

これで数十グラムだが、荷は軽くなった。

もうひとつ、目に留まった物品があった。『結束バンド』だ。

「何年も使った登山靴は山で突然、底が剥がれることがある。そんな時、役立つのがコレなんだ。あるとないとでは大違い。荷物の中に必ず入れておいた方がいい。」

思い出したのは、僕のスノーシューを修理してくれた大好きな先輩の言葉だった。

僕は、6本の結束バンドを入れたビニール袋を持って考えた。6本としたのは左右2本ずつで4本に予備をそれぞれ1本ずつ加えての数字。持参する量としては、これで十分だと思えたが、それ以前に、僕の靴は去年買ったばかりの靴だ。今回の山行で壊れるとは到底思えない。山行前に防水性能を維持するため、靴の手入れをした際にも、靴に問題点は何一つ発見できなかった。

( いらないか・・・ )

毎回、そう、繰り返してきた自分への問いを、今回もまた繰り返した・・・ その時、

「 外したら、ダメだ。 」

なぜか、大好きな先輩の声が聴こえた気がした・・・。

今回の山行で、それが必要になるとは思えない。でも、尊敬する先輩は、「必ず持参せよ」と言ってる。これまで、ずっと、先輩の言葉を信じてきて、何一つ、間違いはなかった。

わずか、数グラム。

( S さん。僕は、あなたを、信じる。 )

そう、決心した僕は、結束バンド6本を明日持って行くオレンジ色のポーチに、そっと入れた。

4.出発

目覚ましは、その必要性を感じなかったのでセットしなかった。

予定通りの時刻に目覚めた僕は、装備品を最終点検。テントはここに張ったまま、シュラフや着替え、その他不要な装備はテント内に置いて行く。ただし、防寒用のダウンジャケットだけはザックの中へ。真水は1L。ペットボトル飲料3本。ヘッドライトの点灯と明るさを確認し、予備電池3本をもう一度、ポーチの中に見る。

予備電池3本は、もちろん、朝用ではない。日没までにここに戻ることが出来なかった・・・ 万一の事態に備えての準備だ。

「 あの山の下りは長い。日が暮れて、同行者のヘッドライトの光量が足りず、道を見失って・・・ 」

ここでもまた、先輩の言葉を思い出す。経験は絶対だ。そこに嘘はない。

今日の予定も再確認。

04:00 出発。12:00までに登頂。下りに5時間 20 分。日没は 18 時 38 分。行動が困難となる時刻までに数字上の余裕は、1時間以上ある。

夜半から3時ころまで降っていた雨は、今は止んでいる。

樹木の隙間にまたたく星が見える。

( 上は風が強そうだ・・・ )

風が枝を揺らす度に雫が落ちてくる。

頬に当たるそれは、驚くほどに冷たい。

スマートウォッチのルート案内を ON にして、僕は行動を開始した。

5.切れたバンド

日の出は 04:48 。行動開始後、すぐにヘッドライトは不要になる。1500 万年前の地殻変動で誕生したという花崗閃緑岩の大地を僕は順調に踏みしめて進む。この深成岩類は大量の捕獲岩を含んでいる。日本列島が折れ曲がる程に激しかったという、その地殻変動を思いながら、僕は高度を稼いでゆく。

登りはかなり急だ。スマートウォッチの高度計の数字はぐんぐん上がるが、残りの距離を示す数値はほとんど減らない。

( 登りの行動は正午まで。その時、ピークにいなければ、引き返す。 )

胸の中で、そのことを何度も、何度も、繰り返す。その都度、左膝に関心が集まる。大きく屈伸すると違和感がないわけではないが、今のところ、歩く分には痛みなどの問題はない。そのことが何よりの救いだ。

谷間の樹々を揺らす風はかなり強い。森林限界を超えたあたりから、行動に影響が出そうだ。ザックの中に入れてあるシェルジャケットが役に立つだろうか・・・

F 社製のそれは、びっくりする程、高価だったが『オールシーズン対応のミッドシェルで、防風性・透湿性に優れ、ストレッチ性が高く快適な着心地を提供する』という。今日はその性能を試す絶好の機会になりそうだ。

所々で左手側に大小さまざまな滝を見る。谷間には巨大な花崗閃緑岩が転がっている。岩石と言えばその色は黒と思いがちだが、こんなにも白い岩もあるのだ。その岩間を轟音を立てて水が流れ落ちて行く。雪解け水だ。その冷たさはどれ程だろう・・・

ふと気がつくと、先ほどから、ずっと同じ鳥が鳴いている・・・

まるで、僕の後を付けてくるかのようだ。鳥語がわかればどれほど面白いだろう。分かったところで、もしかしたら、それは恐怖の言葉かもしれないが・・・

膝の状態だけは気がかりだが、そんな様々なことを思うほど、今日の僕は体力に余裕があった。

( もしかしたら、正午前に登頂できるかもしれない・・・ )

そう思い始めた頃、残雪が残る高度に達し、足元の岩石を覆う樹々の根に残る雪が、固い透明な氷となり、非常に滑りやすいことに気づく。

( ここで軽アイゼンを付けよう )

そう考えた僕は、登山道がやや広くなった場所でザックを降ろし、中から軽アイゼンを取り出した。

靴を履くときのクセで、左足側から装着。昨年は少し手間取ったが、今年はスマートに作業が進む。左足側の装着が完了。続けて右足側を登山靴にセット。まず足の上側を覆うゴムバンドを締める。一発で決まる。次は踵側のバンドだ。少し長さが足りないようで、引っ張ってもフックが穴に届かない。予め試着して調節しなかったためだ。長さの調節金具部分を確認、ゴムの長さは幾分長く出来そうだ。僕は、調節金具部分のゴムを出し入れして長さを調節(少し長く)し、試しにフックを引いてみた。その時、右足内側の外れないように予め固定されている金具に挟まれたゴムの付け根が・・・ 切れかけている・・・ ように見えた。

( 南無三。頼む、切れないでくれ! )

そう願いながらフックを引いた時、事故が起きた。

軽アイゼンを固定するゴムバンドがその根元から、切れて、しまった・・・

6.先輩の言葉

切れたゴムバンドを手にして、僕は言葉を失った。

( どうしたら、いい? )

ここで軽アイゼンをきちんと修理することは不可能だ。代替部品も、工具もない。

( まず、落ち着こう! )

そう、自分に言い聞かせる。こんな時、焦って取る行動はほとんどが間違いだ。

そう思った僕は、一度、大きく深呼吸してみる。そして、気持ちを落ち着けて、考える。

( 上側、つまり足の甲側のフックは生きている。これだけで行けないか? )

( それは、恐らく、無理だ。設計上の強度が半分になり、やがて、必ず、外れる・・・ )

( 代替部品はない。)

いちばん先に脳裏に浮かんだのは、細引きだが、その細引きはテントに置いてきてしまった・・・

後悔で胸が痛くなる。あれさえあれば、何とかなったのに・・・

でも、今はそれを百万遍繰り返しても、どうにもならない・・・

( なぜ、試着しなかったのか・・・ )

「事故」という言葉の意味を始めて知った思いがする。

試着する「」を、しなかった「」に、起きてしまったこと。

( 後悔ではなく、これを教訓にするんだ。今は前向きになろう・・・ )

今度から、装備品は必ず試着する。そう、自分と絶対の約束を交わす。気持ちが少しだけ、前向きに切り替わった。

( 手持ちの物品で、他に使えるものは・・・ )

そこで、ようやく僕は先輩の言葉を思い出せた。

それを・・・ 今まで1度も使ったことがなかったから・・・ 思い出せなかったのだ。

「 靴の底が取れたときは、結束バンドを使うんだ 」

( そうだ。結束バンドがあった! )

緊急用の装備を入れた濃いオレンジ色のポーチの中に、それはあった。

結束バンドを手にして考える。

( どう使ったら、いい? )

結束バンド1本分の長さでは、到底、足りない。軽アイゼンの左側の穴から登山靴の踵を周って右側の穴へ、結束バンドを上手く廻すには・・・

何となく2本のバンドを繋いでみる。

「 この穴にバンドを通して締めると・・・ 」

「 しまった! 外れない。」

だから結束バンドって言うんだ。何やってるんだ。これで6本のうち2本が無駄になった。残りは4本しか、ない。

その時、なぜか、大好きな先輩が心を込めて修理してくれた あの TSL205 が脳裏に浮かんだ。

先輩は2本の細引きで、それぞれ環を作り、その環を TSL205 の左右の金具に固定、その環と環の間に 100 均で購入した長さ 60 cm荷締めベルトを通して・・・

( そうだ。あれを真似しよう! )

僕は、まず、軽アイゼンの左側、切れたゴムバンドの固定金具だけが残った側に結束バンドを通し、適当と思われる大きさで時計回りに環を作った。続いて反対の右側、こちらは反時計回りに環を作る。取り敢えず、ザックのハーネスから外した・・・ ペットボトル入れを固定するためにハーネスに結んでおいたナイロン製の・・・ 紐で環と環を結んで踵に固定してみる。いい感じだ。なんとかなるかもしれない。

( この紐は保険として残したまま、荷締めベルトでしっかり固定する )

思わず笑みが浮かぶ。心の底から、先輩に感謝する気持ちが込み上げてくる。

自宅で装備品をパッキングする時、ザックの外側に 60 cm の荷締めベルトを2本付けておいた。だから、当たり前のように、それは、そこにあった。この安心・安堵感こそ、言い付けを守ったことに対する先輩からのプレゼントに違いない・・・ そう感じつつ、そのうちの1本を取り外す。

「 結んで締める。これがいちばん確実な方法なんだ。」

先輩の言葉を反芻しながら、軽アイゼンに結んだ結束バンドの環と環の間に荷締めベルトを通し、軽アイゼンが外れない適切な強さで締め上げる。さらに、保険のつもりで残した紐の方も解けないように結ぼうとしたが、肝心な・・・ その解けない結び方がわからない。舫い結びは知ってるが、この場合、適切ではないようだ。携帯電話で動画検索・・・ そう思ったが、僕の携帯電話のキャリアの電波はこの山域では使用できなかったことを思い出し、携帯電話に伸ばしかけた手を止める。ここでは僕の携帯電話は、カメラとしての役割しか果たさない。

( そうだ。記録に残しておこう! )

転んでもタダでは起きなかった何よりの証拠だ。そう思った僕は、右足にようやく装着できた軽アイゼンの写真を数枚、撮影した。もちろん、後で先輩に見せるためだ。

荷締めベルトを使って踵側と甲側をさらに補強する前の状態。
(この写真では、まだ、左(内)側の結束バンドの先端部分が残っている)

【追記】
今、こうして写真を確認すると、写真に写っているのは、荷締めベルトで補強する前の状態のようです。記憶の中では、最終的な完成形を撮影したように思うのですが、やはり、自分的にはかなりの緊急事態だったので、この時もまだ動揺があり、混乱していたのかもしれません。落ち着いて行動したように思っても、あらためて人間・・・というか、自分の弱さを感じました。上記の文言の訂正も考えましたが、その時の僕の状態を正確に記録するには「訂正しない方が良い」と考え、そのままにしました。

以下の写真がテント場に戻ってから撮影した完成形です。

写真を見て、さらに気が付いたのですが、左側の結束バンドが危ない所で切れています・・・。
いつ切れたのか、まったくわかりませんが、結束部の外側だったのが幸いでした。
(アイゼンの左には切れたゴムバンドの固定金具部分のみ、残っています)


この事故によるロスタイムが気になったが、片側アイゼンで歩くより、この方がずっと安全だ。同じ命がけの遊びなら、安全な方を選ぶのが当然だ。

アイゼンの効きを確かめながら、僕は行動を再開した。

7.オベリスク

屹立するオベリスク。
今日のゴールがついに見えた。


写真の撮影時刻は 10:50 a.m. 心に決めたタイムリミットは 12:00。残りは時間との競争だ。

時計が廻るのが早いか、僕がオベリスクの向こう側の世界を見るのが早いか、答えは2つに1つ。

標高 2,764 m まで続く、自分との戦いだ。ここまで来て、負けるわけにはいかない・・・。

足よ。どうか、僕を誘ってくれないか。

遥かなる、あの場所へ。

オベリスクよ。心有らば聞いてくれ。

きみが見ている風景を、僕は、きみとふたりで見たいんだ・・・。

でも、風が・・・

風が、強すぎる・・・

11:48 a.m. 強風が行く手を阻む。


天候は晴れているが、出発時、瞬く星を見て予想した通り、強風が時折り吹いてくる。「吹き荒ぶ」のではなく、思い出したような吹き方の風だ。「吹き荒れてない」のは救いだが、ただ、その時折り吹く強風は一気に体温を奪って行くほどに冷たい。半袖の汗をよく通す速乾性の下着に、こちらもまた通気性に優れた長袖の行動着1枚では、到底、耐えられない。時間は惜しいがザックを降ろし、素早く F 社製のシェルジャケットを取り出して、身に纏う。

一気に表面体温が回復する。このシェルジャケットは、細身のせいだろうか、風によるバタつきも少ないようだ。胸のワンポイントの他は、一切の装飾を廃して性能だけを追求したのだろう。この高価なオールシーズンに対応したジャケットは、山での必需品になりそうな気がする。

風の息が強まった。風化した花崗岩が礫(つぶて)となって飛んでくる。

頬が痛い。

冗談じゃない。僕が暮らしている街では、通常、風で、石は飛ばない・・・ 。

あぁ・・・ タイムリミットだ。

空が、きれい。

オベリスクよ。きみの見ている風景は・・・


最後の力を振り絞って、登る。

この壁の向こう側を見たかったんだ。

喘ぐように、息をしながら・・・ 僕が、見た

壁の向こう側は・・・

真砂と残雪のピークから


理由・・・ など、ない。

この景色が見たかったんだ・・・

どうしても、見たかったんだ。

振り返ると、月が見えた・・・

きみは、月をみていたのか・・・


きみと、月を見た・・・

うん。もう十分だ。

まだ、帰りの道が残っている。

長い、ながい・・・ 道だ。

新しいタイムリミットは、日没。

それまでにシュラフを残した僕のテントへ戻らねばならない。

大丈夫。

右足の軽アイゼンは、外れない。

戻ったら、先輩に話すんだ。

今日、僕に、起きたことを・・・。

8.エピローグ

この山行では、この後の、長いながい下りの道でも生涯忘れ得ない出来事がありました。
まったくの偶然から、僕はある人と一緒に山を下りることになります。
その人との物語も、いつか、ここに残せたらいいな・・・と、思います。
拙い山行記録をここまでお読みくださいましたこと、心から感謝申し上げます。
ほんとうに、ありがとうございました。

【お願いとお断り】

この記事で紹介した軽アイゼンの修理方法は、あくまでも緊急の事態に際して応急的にとった措置であり、それを推奨するものではありません。同様の事故が起きた際に、私と同じ方法で軽アイゼンを修理されたとしても、その効果は保証できません。軽アイゼンの修理・装着後、登り2時間及び下り5時間30分(安全のため残雪帯を過ぎた後も軽アイゼンを装着したまま、テント場の直前まで下りました)の合計7時間半、私の軽アイゼンが外れなかったのは、単に、偶然と幸運であったことを申し添えます。

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

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

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

【もくじ】

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

1.さらに勉強した理由

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

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

多少の傾きは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.お願いとお断り

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