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

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

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

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

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

【もくじ】

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

１．GUIが使いやすくなりました！

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

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

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

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

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

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

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

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

２．画像の傾きに強くなりました！

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

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

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

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

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

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

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

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

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

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

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

おまえが、わるい。

必ず、そう言います。

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

だって、そうじゃん！

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

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

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

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

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

悪いのは ･･･。

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

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

だけど･･･　だから･･･

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

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

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

へびとカエル

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

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

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

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

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

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

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

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

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

  import cv2
  import numpy as np

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

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

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

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

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

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

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

  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 での処理は考慮しておりません。

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

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

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

この夢は･･･

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

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

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

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

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

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

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

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

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

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

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

（ 座標原点は、いったい、どこなんだ？ ）

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

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

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

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

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

が。

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

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

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

*(^_^)* ♪

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

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

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

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

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

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

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

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

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

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

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

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

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

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

ラバーバンドを表示する部分のプログラムは、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 でご紹介したいと思います。

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

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

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

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

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

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

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

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

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

  //読み込むデータのあるフォルダへの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;

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

６．常に最大化して実行する設定にしてやっぱりやめました！

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

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

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

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

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

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

procedure TForm1.FormCreate(Sender: TObject);
begin

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

end;

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

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

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

･･･と、ここまで修正（？）したのですが。

ちょっと待て！
おまえ、逃げてない？

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

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

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

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

ちゃんとする！

ことにしました。

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

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

１つ前のバージョンを「非最大化」して実行すると･･･（後ろは 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 右上の「最大化ボタン」をクリック）した場合です。最大化ボタンを押して非最大化するというのも、なんともおかしな表現ですが、再度、このボタンをクリックすれば最大化されるので、やはりこれは最大化ボタンでいいのかな？

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

（１）OpenCV の矩形検出機能で読み取った解答欄矩形の座標を TMemo から読み込む。
（２）座標をカンマで切り分けて変数に代入。
（３）Image1.ClientToScreen(　) で、TImage の画像内座標をスクリーン座標に変換。
（４）Form1.ScreenToClient(　) で、スクリーン座標をフォームのクライアント座標に変換。
（５）plImage1.SetBounds(　)で、ラバーバンドの描画位置を指定。
（６）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);

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

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

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

７．最大化から非最大化した際に画面中央にフォームを表示します！

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

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

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

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

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

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

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;

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

できたー☆

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

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

８．ダウンロードのご案内

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

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

デジタル採点 All in One !

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

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

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

無料で使える手書き答案採点補助プログラム

９．まとめ

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

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

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

１０．お願いとお断り

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

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

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

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

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

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

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

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

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

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

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

【もくじ】

１．PDFtk Server
２．GUI を設計
３．ShellExecute で回転を実行
４．Path の表示方法を改良
５．CreateProcess で回転を実行
６．回転の実際
７．プログラムのダウンロード
８．お願いとお断り

１．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 のダウンロードをしていただき、プログラムの動作に必要な環境の整備を行ってもらう形をとりたいと思います。

２．GUI と Path の表示

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

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

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

当初、回転した状態のプレビューを表示するような方向性も考えたのですが、たった３パターンの回転しかありませんし、ファイルの保存にもそれほど時間はかからない（何百ページもあるような 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）をクリックしたことにしてしまっています。

３．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 秒ほど待機時間を入れて、プレビューが失敗しないようにしています。なので、ちょっと処理が重たい感じにはなっちゃってますが、自分的には許容範囲かと･･･。

４．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 文字列を表示してくれます。

実行してみました！

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

５．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);
          //対策１:BytesRead を明示的に Integer にキャストする
          SetLength(OutputBytes, Length(OutputBytes) + Integer(BytesRead));
          //対策２:Length を NativeInt にキャストする（より安全か？）
          //SetLength(OutputBytes, NativeInt(Length(OutputBytes)) + NativeInt(BytesRead));

          //W1024 符号付型と符号無し型の演算による、オペランドの拡張」と警告される
          //Move(Buffer[0], OutputBytes[Length(OutputBytes) - BytesRead], BytesRead);
          //対策１: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 ファイルを再度指定して、回転を実行してみました。

【わかったこと その①】

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

ぎぎぎ

（ 効果音的歯軋り ）

僕は、ただ、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 !

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

で、つくったのがコレ！

もちろん、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);

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

･･･

最終的にと言いながら、独自性にこだわって、それでもやっぱり 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;

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

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

６．回転の実際

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

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

次に、上下反転です。

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

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

７．プログラムのダウンロード

あくまでも自分用に作ったものですが、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 の次の過去記事をご参照ください。

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

８．お願いとお断り

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

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