Picture」カテゴリーアーカイブ

画像ファイル関連のプログラミング

“Say Hello to Capity Plus.”

A Lightweight screen capture utility

上の図のように、マウスカーソルの形状も含めてキャプチャできます!
範囲の選択には、矩形に加え、正方形/楕円/正円も使えるようになりました!


画像編集に際し、自分が欲しいと思う必要最低限の機能のみを実装したプログラムを前回アップロードし、その紹介記事で次のように書きましたが・・・

『このアプリは本格的な画像編集に使用するための素材、もしくは、操作方法の解説を作成するために必要な情報画像(部分的な切り抜き画像)を簡単に作成したいという目的を実現するために開発しました。ですので「現在、表示されている画面の全部、もしくは一部を、必要であればマウスカーソルの形状を含めた画像データとして取得する」ことしかできません。保存した画像データを再度読み込んで表示したり、キャプチャした画像を加工する(例えば、ぼかす・モザイクをかけるといったような)機能はありません。ただし、画像の指定範囲を「ぼかす・モザイクをかける」機能は、後日、追加できたら、追加したいと考えています。』

今回、「ぼかす・モザイクをかける」といった機能に加え、既存の画像ファイルを読み込んで表示したり、アルファチャンネルを用いた透明化処理を PNG 形式の画像処理に追加するといった、自分では使わないかな? と思う機能も搭載した新しいバージョンができましたので紹介させていただきます。

【追記_20251006】

ぼかし加工やモザイク処理を行った画像データが保存できない不具合を修正しました。この修正に合わせて、ぼかし加工やモザイク処理、及び白色化等、画像データを加工した場合は、任意の段階で「保存」ではなく、メモリ上の表示用データに「反映」する機能を追加しました。具体的には、次の通りです。

次の図のように画像の一部を加工します。例:白色化

画面右のサムネイルには変更が反映されていません。


この状態で、画面右のサムネイルをクリックすると、画像に設定した変更内容はすべて破棄され、加工前の画像が表示(復元)されます。加工状態がサムネイルに反映されていない状態でのサムネイル・クリックは、「一気に元に戻す処理になる」とお考えください。

メモリ上の画像データの更新は「反映(英語表記は Apply)」ボタンをクリックすることで実行できます。

ちいさなボタンですが・・・


このボタンをクリックすることで、メモリ上の画像データが、メイン画面に表示されている加工した状態の画像データに更新されます。

画面右のサムネイルにも変更が反映されます。


このようにメモリ上のデータの更新処理をユーザー側に委ねることで、Undo / Redo の履歴操作とサムネイル更新が完全に分離され、処理の整合性が保たれるようにしました。

初期バージョンで作者の保存機能に関する確認作業が至らなかったため、ご迷惑をおかけした皆さまに、こころからお詫び申し上げます。誠に申し訳ありませんでした。

現在、未発見の不具合が見つかりました場合は、こちらで報告し、速やかに修正版を掲載いたしますので、万一、お使いいただける場合は、修正版のアップロードの有無にご注意いただけましたら幸いです。

【もくじ】

0.基本的な使い方と名称について(前回の記事 Plus α)
(1)起動方法
(2)キャプチャ方法
(3)操作パネルの位置の変更
(4)ラバーバンド形状
(5)処理一覧
 ・名称について
1.追加機能①「開く」
2.追加機能②「円形選択と保存・送信を可能に」
3.追加機能③「ぼかし処理」
4.追加機能④「モザイク処理」
5.追加機能⑤「白色化処理」
6.プログラムのダウンロード
7.まとめ
8.お願いとお断り

0.基本的な使い方と名称について

(1)起動方法

このアイコンをダブルクリックして起動します。

現在表示されているデスクトップ画面(の一部)をキャプチャするのが、このプログラムの主たる目的なので、メイン画面は起動時には表示されません。

起動時の画面
トースト通知(Toast Notification)の表示は Windows の設定により、出ない場合もあります。


元々、このプログラムを作ろうと思ったいちばんの理由は、『マウスカーソルの形状を含めて画面をキャプチャする必要が生じ、探した範囲では手軽に使えるアプリが見つからなかったので、それなら自分で書こうと思った』ことです。なので、この機能をいちばん最初に実装しました。

チェックボックスをチェックすればカーソルも含めて画面をキャプチャできます。

(2)キャプチャ方法

ショートカットキー「Shift+Ctrl+C」で現在表示されている画面全体をキャプチャできます(画面を指定してキャプチャすることはできません)。キャプチャした画像は「静かに」プログラムのメイン画面へと送られ(表示され)ます。その際、メッセージ等は何も表示されません。

キャプチャ後、タスクバーにあるオレンジ色のアイコンをクリックすると、メイン画面が表示されます。

もちろん、自分自身のキャプチャも可能です。
画面右側にキャプチャした画像のサムネイルが表示されます。


(3)操作パネルの位置の変更

上の図に示したように、操作パネルは「メイン画面の上部/下部」いずれかへの配置を選択できるようにしました。

画面上部に操作パネルを表示する場合です。
(設定は即適用&自動的に保存され、次回起動時に適用されます)


(4)ラバーバンド形状

ラバーバンドの形は、円形も選択できるようにしました。Shiftキーを押しながらドラッグすることで、矩形を選択している場合は「四角形 → 正方形」、円形を選択している場合は「楕円 → 正円」へとラバーバンドの形状が変化します。なお、いったん、四角形(長方形)や楕円のラバーバンドを描画し、その後、ラバーバンドのグラブハンドルをクリックしてリサイズする場合も、Shiftキーを押しながら操作すると、ラバーバンドの形状は「四角形 → 正方形」or 「楕円 → 正円」へ変化します。

ラバーバンドの形状は「矩形」or「円形」いずれかを選択できます。


ラバーバンドの線については、太さと色を指定できます。プログラムは、終了時の設定を自動的に記録し、次回起動時は前回終了時の設定を読み込んで(=復元して)起動します。

線の太さは10段階で指定可能です。


色は、TColorBox のデフォルトの設定色3種類から選べます。

上記3種類にチェックがある場合、
2つ上の図の TColorBox には184色が選択可能な Item として設定されました。


(5)処理一覧

あとは、「画像をそのまま保存」したり、「矩形/正方形/楕円/正円のいずれかのラバーバンドでさらにキャプチャしたい範囲を選択して、選択範囲内で右クリックすると表示されるメニューから選択できる処理を選んで実行する」ことが可能です。

このような解説画面を『とにかく簡単に』作りたくて作ったのが Capity です!


処理可能な画像数は、正直、自分でもよくわかりません。お使いの PC 環境(搭載しているメモリの大きさ等)により変化するものと思われます。保存するファイルの名称は、もちろん任意の名称を付けることも可能ですが、デフォルト設定では「 Screenshot_20251005_032342.png 」のように Screenshot_ に続けて西暦年月日時分秒が自動的に付くので、これまでファイルとして保存する際に面倒に感じていた「名前を付ける」作業から完全に解放されました。作った自分で言うのもナンですが、すごく便利です!!

・名称について

Capity という名称は、こちらも前回の記事で、『 AI に相談して決めた!』と書きましたが、その際 AI が示してくれたのが次の内容です。

・発音が柔らかく親しみやすい。技術系にも一般向けにも通用する響き。
・Capture + Simplicity / Utility / Clarity などの抽象的な価値を含められる造語。
・「City(都市)」や「Clarity(明快さ)」にも近い響きがあり、好ましい印象を与える。
・「キャプチャの能力(Capacity)」を連想させることもでき、機能性の高さを暗示。
・ロゴ・UI・ドメイン名・SNS ハンドルなどにも使いやすく、拡張性が高い。

それがほんとうか、どうかは使ってくださった方のお気持ち次第ではありますが・・・ 自分的には、この AI が示してくれた内容を具現化したプログラムになるよう、精一杯努力したつもり・・・です。

もちろん「特許情報プラットフォーム J-Plat Pat」で、特許・実用新案、意匠、商標の各権利について過去に、この名称での申請・登録のないことは確認済みです。(2025年10月5日現在)

1.追加機能①「開く」

最初は既存の画像を開く処理は不要と考え、実装していませんでしたが、簡単に実装できますし、「ない」よりは「ある」方がいいかと思い直して実装しました。ただ、あくまでもこのプログラムは、「現在表示されている画面を簡単にキャプチャする」ことが主な目的なので、ボタンの位置は深く考えずにほとんどおまけ程度に実装しましたので、ボタン自体の使い勝手はよくないと思います・・・。

ボタンクリックで TOpenDialog が表示されます。


ファイルを開く場合の Path の設定は、TOpenDialog の機能まかせ(=Windows まかせ)です。前回使用したフォルダが記憶されていれば、そのフォルダが自動的に選択されます。

表示したい画像を選択して、「開く」をクリックしてください。


表示された画像に対して、必要な処理を適用してください。

2.追加機能②「円形選択と保存・送信を可能に」

範囲を選択するのに使うラバーバンドは、矩形に加え、円形の形状をしたものも使えるようにしました。さらに Shift キーを押しながらドラッグすることにより、正方形や正円も描画できます。

目的に応じて使い分けてください。
(この画像も自分自身で作成しました)


(1)円形選択時の保存処理

画像の保存について解説します。ラバーバンドの形状が矩形・円形のいずれであっても、画像の保存形式は BMP ・ PNG ・ JPEG から選んで1種類を指定できます。

デフォルト設定は PNG 形式ですが、ここでは JPEG 形式が選ばれています。


キャプチャした画像の一部をラバーバンドで範囲選択し、選択した範囲内の任意の位置を右クリックすると次のようなサブメニューが表示されます。ここでは、まず、保存の処理から順に説明します。

表示されるメニューのコマンドは、すべてラバーバンド内のみに限って適用されます。


ラバーバンドが円形の場合、画像の保存時には注意が必要です。ラバーバンドの枠の内部の画像のみ保存対象とするのは、画像の形式によらず共通ですが、BMPとJPEG形式で保存する場合、枠外部分の透明化処理は行われず、枠外の部分は「白に塗りつぶされ」て保存されます。

「いいえ」をクリックした場合は、保存の処理自体がキャンセルされます。


保存された画像(例:BMP形式の場合)です。

青の部分がきれいに保存されています。


保存された画像(例:JPEG形式の場合)です。

圧縮処理が行われたため、青や緑が濃くなっています。


PNG 形式で保存する場合、次のメッセージが表示されます。用途に応じてラバーバンドの枠外の部分を「透明化する」もしくは「白く塗りつぶす」いずれかの処理を選択できます。

使用目的に合わせて処理を選択してください。


PNG 形式かつ「透明化あり」で保存した画像をフォトで見た場合です。

透明化した部分は黒くなっています。

同じ形式で「透明化なし・枠外を白く塗りつぶして保存」した場合の画像をフォトで見ると・・・

こちらは枠外の部分が黒くなっていません(当然ですが)


PNG 形式かつ「透明化あり」で保存した画像をパワーポイントに挿入してみました!

ラバーバンドの枠外が透明化されています。


同じ画像をWordに挿入してみました。

いったん保存してから挿入を行った結果です。


このように、PNG 形式かつ「透明化あり」で保存した画像は、「挿入」することで透明化処理が適用された状態で再利用できます。

(2)円形選択時のクリップボードへの送信

次に、クリップボードへの送信について説明します。

ラバーバンド内を右クリックして表示されるメニューから
「クリップボードへ送る」をクリックしてください。


ラバーバンドの枠が円形指定で、さらに範囲選択した部分を PNG 形式でクリップボードへ送信する場合、次のメッセージが表示されます。


「はい」を選んだ場合、例えば古いお絵描きソフトで背景色「黒」の画像を新規に作成しておいて、そこに円形(楕円)選択した範囲をクリップボードへ送信して(クリップボード経由で)貼り付けてみました。なお、このような場合には「背景色を透過色として貼り付ける(と同等の機能を利用して実行する)」必要があります。

思い出せないくらい、ながーい間愛用しているお絵描きソフトに
「背景色を透過色として」貼り付けてみました。


こちらが貼り付けた結果です。


背景が白の画像を円形で範囲選択して、背景が白の画像にクリップボード経由で貼り付けると困ったことになりますので、注意してください。

黒い字の部分が読めなくなってしまいます・・・


BMP や JPEG 形式を選択してクリップボードへ送信した場合は、次のメッセージが表示されます。


BMP 形式を選択し、表示されたメッセージの「はい」を選択して、クリップボードへ送信したデータを Word に貼り付けてみました。

ヒトの顔の切り抜きとか、そういう用途には使えるカモしれません。


この円形のラバーバンドに関する処理は、矩形時のそれにくらべると、要した時間は3倍以上かかっていると思います。とにかくない袖にタオルと雑巾を付け足して作った袖を振り回し、なんでもいいや、とにかくすーぱー頑張って作成しましたが、自分自身がこの円形のラバーバンドを使用する機会は今回限りであるような気が・・・。どこかで、どなたさまかのお役に立ってほしいと切に祈ります。

3.追加機能③「ぼかし処理」

ほんとうのことを言うと、円形のラバーバンドよりこちらを先に作成したのですが、出来たら実装したかった機能のひとつがこの「ぼかし処理」です。より低速になるのはわかりきっていましたが、搭載するならボックスブラーではなく、ガウシアンブラーと決めていました。

理由はただひとつ。少しくらい遅くても、「美しさ」を優先したかったのです。

ぼかす元画像です。


Box ぼかしを適用した画像です。

速いのですが、どうしてもジャギーな感じになります。

レベルは 10 まで指定できます。


ガウスぼかしを適用した画像です。

ごく自然な感じでぼかせます。
(レベルは5です)


文字にもガウスぼかしをかけてみました。レベルは5です。

ぼかす前の文字のある画像
ラバーバンドの内部をぼかした画像


ガウスぼかしとボックスぼかしのコードのセットです。ガウスぼかしのコードの↓に、ボックスぼかしのコードがあります。Boxぼかしに変更するときは、ガウスぼかしの変数はそのまま、var 宣言部の count 変数だけコメントアウトを解除してください。コード部分は、ガウスぼかしのコードをすべてコメント化して、Box ぼかしのコメントアウトを解除してください。

procedure TForm1.HandleGaussianBlur(Sender: TObject; const SelRectOnParent: TRect);
var
  //ガウスぼかし
  bmpSrc, bmpTemp: TBitmap;
  x, y, dx, dy, i, j: Integer;
  //固定小数点演算のため Int64 を使用 (合計値が非常に大きくなるため)
  r, g, b: Int64;
  radius: Integer;
  //カーネルを固定小数点値 (Int32) の配列として定義し直す
  kernel: array of Int32;
  pSrc, pTemp: PByteArray;
  blurLevel: Integer;
  selRectLocal: TRect;

  cx, cy, rx, ry: Double;
  IsEllipse: Boolean;

  //Box ぼかし
  //count: integer;  //Box ぼかしをかける場合はここのコメントアウトを解除する

  //ガウスカーネル生成関数(固定小数点対応版)
  function CreateGaussianKernel(radius: Integer; var kernel: array of Int32): Double;
  var
    k: array of Double; //一時的に浮動小数点カーネルを作成
    sigma, sum: Double;
    i: Integer;
  begin
      //浮動小数点カーネルの計算
      SetLength(k, radius * 2 + 1);
    sigma := radius / 2.0;
    sum := 0.0;
    for i := -radius to radius do
    begin
      k[i + radius] := Exp(-Sqr(i) / (2 * Sqr(sigma)));
      sum := sum + k[i + radius];
    end;

    //正規化と固定小数点へのスケーリング
    for i := 0 to High(k) do
      //正規化して SCALE_VALUE を乗算し、整数に丸める
      kernel[i] := Round((k[i] / sum) * SCALE_VALUE);
    Result := sigma;
  end;

  function IsInsideEllipse(x, y: Integer): Boolean;
  var
    dx, dy: Double;
  begin
    dx := (x - cx) / rx;
    dy := (y - cy) / ry;
    Result := (dx * dx + dy * dy) <= 1.0;
  end;

begin

  //ガウスぼかし
  if not Assigned(imgPreview.Picture.Graphic) then Exit;

  PushUndo;

  selRectLocal.TopLeft :=
    imgPreview.ScreenToClient(plImage1.Parent.ClientToScreen(SelRectOnParent.TopLeft));
  selRectLocal.BottomRight :=
    imgPreview.ScreenToClient(plImage1.Parent.ClientToScreen(SelRectOnParent.BottomRight));

  Screen.Cursor := crHourGlass;

  bmpSrc := TBitmap.Create;
  try
    bmpSrc.PixelFormat := pf24bit;
    bmpSrc.SetSize(imgPreview.Picture.Width, imgPreview.Picture.Height);
    bmpSrc.Canvas.Draw(0, 0, imgPreview.Picture.Graphic);

    bmpTemp := TBitmap.Create;
    try
      bmpTemp.PixelFormat := pf24bit;
      bmpTemp.SetSize(bmpSrc.Width, bmpSrc.Height);

      blurLevel := TrackBar1.Position;
      radius := EnsureRange(blurLevel, 1, 10);
      SetLength(kernel, radius * 2 + 1);
      CreateGaussianKernel(radius, kernel);

      IsEllipse := (RadioGroup1.ItemIndex = 1);
      if IsEllipse then
      begin
        cx := (selRectLocal.Left + selRectLocal.Right) / 2;
        cy := (selRectLocal.Top + selRectLocal.Bottom) / 2;
        rx := (selRectLocal.Right - selRectLocal.Left) / 2;
        ry := (selRectLocal.Bottom - selRectLocal.Top) / 2;
      end;

      // 横方向ブラー
      for y := selRectLocal.Top to selRectLocal.Bottom - 1 do
      begin
        pSrc := bmpSrc.ScanLine[y];
        pTemp := bmpTemp.ScanLine[y];
        for x := selRectLocal.Left to selRectLocal.Right - 1 do
        begin
          if IsEllipse and not IsInsideEllipse(x, y) then
          begin
            pTemp[x * 3 + 2] := pSrc[x * 3 + 2];
            pTemp[x * 3 + 1] := pSrc[x * 3 + 1];
            pTemp[x * 3 + 0] := pSrc[x * 3 + 0];
            Continue;
          end;

          r := 0; g := 0; b := 0;
          for dx := -radius to radius do
          begin
            i := EnsureRange(x + dx, 0, bmpSrc.Width - 1);
            r := r + Int64(pSrc[i * 3 + 2]) * kernel[dx + radius];
            g := g + Int64(pSrc[i * 3 + 1]) * kernel[dx + radius];
            b := b + Int64(pSrc[i * 3 + 0]) * kernel[dx + radius];
          end;
          pTemp[x * 3 + 2] := Byte(r shr SCALE_SHIFT);
          pTemp[x * 3 + 1] := Byte(g shr SCALE_SHIFT);
          pTemp[x * 3 + 0] := Byte(b shr SCALE_SHIFT);
        end;
      end;

      // 縦方向ブラー
      for x := selRectLocal.Left to selRectLocal.Right - 1 do
      begin
        for y := selRectLocal.Top to selRectLocal.Bottom - 1 do
        begin
          if IsEllipse and not IsInsideEllipse(x, y) then
            Continue;

          r := 0; g := 0; b := 0;
          for dy := -radius to radius do
          begin
            j := EnsureRange(y + dy, 0, bmpSrc.Height - 1);
            pTemp := bmpTemp.ScanLine[j];
            r := r + Int64(pTemp[x * 3 + 2]) * kernel[dy + radius];
            g := g + Int64(pTemp[x * 3 + 1]) * kernel[dy + radius];
            b := b + Int64(pTemp[x * 3 + 0]) * kernel[dy + radius];
          end;
          pSrc := bmpSrc.ScanLine[y];
          pSrc[x * 3 + 2] := Byte(r shr SCALE_SHIFT);
          pSrc[x * 3 + 1] := Byte(g shr SCALE_SHIFT);
          pSrc[x * 3 + 0] := Byte(b shr SCALE_SHIFT);
        end;
      end;

      imgPreview.Canvas.CopyRect(selRectLocal, bmpSrc.Canvas, selRectLocal);

    finally
      bmpTemp.Free;
    end;
  finally
    bmpSrc.Free;
    Screen.Cursor := crDefault;
  end;


  //BoxBlurを試す場合は、上のガウスぼかしのコードをすべてコメントアウトする
  //BoxBlur
  {
  if not Assigned(imgPreview.Picture.Graphic) then Exit;

  PushUndo;

  selRectLocal.TopLeft :=
    imgPreview.ScreenToClient(plImage1.Parent.ClientToScreen(SelRectOnParent.TopLeft));
  selRectLocal.BottomRight :=
    imgPreview.ScreenToClient(plImage1.Parent.ClientToScreen(SelRectOnParent.BottomRight));

  Screen.Cursor := crHourGlass;

  bmpSrc := TBitmap.Create;
  try
    bmpSrc.PixelFormat := pf24bit;
    bmpSrc.SetSize(imgPreview.Picture.Width, imgPreview.Picture.Height);
    bmpSrc.Canvas.Draw(0, 0, imgPreview.Picture.Graphic);

    bmpTemp := TBitmap.Create;
    try
      bmpTemp.PixelFormat := pf24bit;
      bmpTemp.SetSize(bmpSrc.Width, bmpSrc.Height);

      blurLevel := TrackBar1.Position;
      radius := EnsureRange(blurLevel, 1, 10);

      IsEllipse := (RadioGroup1.ItemIndex = 1);
      if IsEllipse then
      begin
        cx := (selRectLocal.Left + selRectLocal.Right) / 2;
        cy := (selRectLocal.Top + selRectLocal.Bottom) / 2;
        rx := (selRectLocal.Right - selRectLocal.Left) / 2;
        ry := (selRectLocal.Bottom - selRectLocal.Top) / 2;
      end;

      // 横方向ボックスぼかし
      for y := selRectLocal.Top to selRectLocal.Bottom - 1 do
      begin
        pSrc := bmpSrc.ScanLine[y];
        pTemp := bmpTemp.ScanLine[y];
        for x := selRectLocal.Left to selRectLocal.Right - 1 do
        begin
          if IsEllipse and not IsInsideEllipse(x, y) then
          begin
            pTemp[x * 3 + 2] := pSrc[x * 3 + 2];
            pTemp[x * 3 + 1] := pSrc[x * 3 + 1];
            pTemp[x * 3 + 0] := pSrc[x * 3 + 0];
            Continue;
          end;

          r := 0; g := 0; b := 0;
          count := 0;
          for dx := -radius to radius do
          begin
            i := EnsureRange(x + dx, 0, bmpSrc.Width - 1);
            r := r + pSrc[i * 3 + 2];
            g := g + pSrc[i * 3 + 1];
            b := b + pSrc[i * 3 + 0];
            Inc(count);
          end;
          pTemp[x * 3 + 2] := Byte(r div count);
          pTemp[x * 3 + 1] := Byte(g div count);
          pTemp[x * 3 + 0] := Byte(b div count);
        end;
      end;

      // 縦方向ボックスぼかし
      for x := selRectLocal.Left to selRectLocal.Right - 1 do
      begin
        for y := selRectLocal.Top to selRectLocal.Bottom - 1 do
        begin
          if IsEllipse and not IsInsideEllipse(x, y) then
            Continue;

          r := 0; g := 0; b := 0;
          count := 0;
          for dy := -radius to radius do
          begin
            j := EnsureRange(y + dy, 0, bmpSrc.Height - 1);
            pTemp := bmpTemp.ScanLine[j];
            r := r + pTemp[x * 3 + 2];
            g := g + pTemp[x * 3 + 1];
            b := b + pTemp[x * 3 + 0];
            Inc(count);
          end;
          pSrc := bmpSrc.ScanLine[y];
          pSrc[x * 3 + 2] := Byte(r div count);
          pSrc[x * 3 + 1] := Byte(g div count);
          pSrc[x * 3 + 0] := Byte(b div count);
        end;
      end;

      imgPreview.Canvas.CopyRect(selRectLocal, bmpSrc.Canvas, selRectLocal);

    finally
      bmpTemp.Free;
    end;
  finally
    bmpSrc.Free;
    Screen.Cursor := crDefault;
  end;
  }
end;

4.追加機能④「モザイク処理」

もうひとつ、出来たら実装したかったのが指定範囲に「モザイクをかける」処理です。文字情報を隠す用途であれば、強くぼかし処理する(or 重ね掛けする)だけで十分な気もしましたが、私には「ぼかす」+「モザイクをかける」の二手間を1セットにして文字情報を隠したい場合に画像を処理するクセがあり(このブログの過去記事を見ていただければ理解していただけると思います)、今回も2つで1セットのような気がして・・・。

モザイク処理する元画像です。


とりあえず、レベル5を設定して・・・

レベルは10まであります。


モザイク処理してみた結果です。ボックスぼかしみたいですね。なのでボックスぼかしは実装しませんでした。


文字をモザイク処理してみました。レベルは5です。

モザイクをかける前の画像
モザイク処理したラバーバンド内は、色の違いしか、わからなくなりました!


モザイクをかける処理のコードです。ご参考まで。

procedure TForm1.HandlePixelation(Sender: TObject; const SelRectOnParent: TRect);
var
  selRectLocal: TRect;
  bmpSrc: TBitmap;
  startX, startY: Integer;
  dx, dy: Integer;
  blockSize: Integer;
  r, g, b, count: Integer;
  pLineRead, pLineWrite: PByteArray;
  BlockWidth, BlockHeight: Integer;
  cx, cy, rx, ry: Double;
  IsEllipse: Boolean;

  function IsInsideEllipse(x, y: Integer): Boolean;
  var
    dx, dy: Double;
  begin
    dx := (x - cx) / rx;
    dy := (y - cy) / ry;
    Result := (dx * dx + dy * dy) <= 1.0;
  end;

begin

  if not Assigned(imgPreview.Picture.Graphic) then Exit;

  PushUndo;

  selRectLocal.TopLeft :=
    imgPreview.ScreenToClient(plImage1.Parent.ClientToScreen(SelRectOnParent.TopLeft));
  selRectLocal.BottomRight :=
    imgPreview.ScreenToClient(plImage1.Parent.ClientToScreen(SelRectOnParent.BottomRight));

  bmpSrc := TBitmap.Create;
  Screen.Cursor := crHourGlass;

  try
    bmpSrc.PixelFormat := pf24bit;
    bmpSrc.SetSize(imgPreview.Picture.Width, imgPreview.Picture.Height);
    bmpSrc.Canvas.Draw(0, 0, imgPreview.Picture.Graphic);

    blockSize := EnsureRange(TrackBar2.Position, 2, 50);

    IsEllipse := (RadioGroup1.ItemIndex = 1);
    if IsEllipse then
    begin
      cx := (selRectLocal.Left + selRectLocal.Right) / 2;
      cy := (selRectLocal.Top + selRectLocal.Bottom) / 2;
      rx := (selRectLocal.Right - selRectLocal.Left) / 2;
      ry := (selRectLocal.Bottom - selRectLocal.Top) / 2;
    end;

    startY := selRectLocal.Top;
    while startY < selRectLocal.Bottom do
    begin
      startX := selRectLocal.Left;
      while startX < selRectLocal.Right do
      begin
        r := 0; g := 0; b := 0; count := 0;

        BlockWidth := blockSize;
        if startX + BlockWidth > selRectLocal.Right then
          BlockWidth := selRectLocal.Right - startX;

        BlockHeight := blockSize;
        if startY + BlockHeight > selRectLocal.Bottom then
          BlockHeight := selRectLocal.Bottom - startY;

        //平均色の計算(楕円内のみ)
        for dy := 0 to BlockHeight - 1 do
        begin
          pLineRead := PByteArray(bmpSrc.ScanLine[startY + dy]);
          for dx := 0 to BlockWidth - 1 do
          begin
            if IsEllipse and not IsInsideEllipse(startX + dx, startY + dy) then
              Continue;

            r := r + pLineRead[(startX + dx) * 3 + 2];
            g := g + pLineRead[(startX + dx) * 3 + 1];
            b := b + pLineRead[(startX + dx) * 3 + 0];
            Inc(count);
          end;
        end;

        if count > 0 then
        begin
          r := r div count;
          g := g div count;
          b := b div count;
        end;

        //平均色の適用(楕円内のみ)
        for dy := 0 to BlockHeight - 1 do
        begin
          pLineWrite := PByteArray(bmpSrc.ScanLine[startY + dy]);
          for dx := 0 to BlockWidth - 1 do
          begin
            if IsEllipse and not IsInsideEllipse(startX + dx, startY + dy) then
              Continue;

            pLineWrite[(startX + dx) * 3 + 2] := r;
            pLineWrite[(startX + dx) * 3 + 1] := g;
            pLineWrite[(startX + dx) * 3 + 0] := b;
          end;
        end;

        Inc(startX, blockSize);
      end;
      Inc(startY, blockSize);
    end;

    imgPreview.Canvas.CopyRect(selRectLocal, bmpSrc.Canvas, selRectLocal);

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

end;

ガウスぼかし + モザイク処理の結果です。レベルはどちらも5です。

未処理の画像です。
ラバーバンド内をガウスぼかし + モザイク処理(ともにレベルは5)

5.追加機能⑤「白色化処理」

つい、(不要なのに)マウスの形状を含めてキャプチャしちゃった! みたいな場合、役に立つかも・・・と考え、実装しました。私の場合、背景色は「白」であることが多いので、単に指定範囲を「白で塗りつぶす」処理です。

不要なマウスカーソルまでキャプチャしちゃった!


マウスカーソル部分を範囲選択して右クリック、メニューの「白色化」をクリックします。


不要なカーソルは消えました☆

これだけです!!!

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

今回の記事で紹介した PC の画面キャプチャを実行するプログラム Capity Plus 一式を以下からダウンロードできます。なお、ダウンロードとご使用にあたっては、免責事項及び使用条件への同意が必要です。免責事項及び使用条件の詳細は付属の License.txt をご覧ください。

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

7.まとめ

初期バージョンに追加した機能のまとめです。

(1)既存の画像も開けるようになりました。
(2)ラバーバンドの形状に円形( Drag : 楕円/Shft & Drag : 正円)を追加しました。
(3)操作パネルの位置を上 or 下に設定できるようにしました。
(4)クリップボードへの送信機能を円形対応にバージョンアップしました。
(5)指定範囲に「ガウスぼかし」をかけることができるようになりました。
(6)指定範囲を「モザイク処理」できるようになりました。
(7)指定範囲を「白色化」できるようになりました。
(8)終了時設定を C:\Users\ユーザー名\AppData\Roaming\Capity\settings.ini に自動保存

8.お願いとお断り

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

マウスカーソルの形状も含めてデスクトップ画面をキャプチャしたくなりました!みたいな時は、もしかしたら『コレ』が使えるカモ?しれません・・・

ほとんど、自分専用のプログラムですが、夢見た通りのモノができました! *(^_^)*♪

マウスのカーソルを含めて画面をキャプチャできます!


起動時に出てくるのはこれだけです!

アプリ起動時に表示される案内です。


過去記事で、怖れ多くも『マウスカーソルの形状も含めて画面のハードコピーを取るプログラムを自分で書いてしまいました。後日、機会がありましたら、この Blog でご紹介したいと思います。』と、ご案内しましたアプリケーションもどきです。

私が試した限りですが、期待通りに動作している気がします・・・。

【推奨動作環境】

業務用PCの 1366 × 768 、拡大率 100 % のモニターで制作・動作確認を行っています。高 DPI 環境下で拡大率 150 %や 200 %の設定では意図した通りに画面をキャプチャできません(Windows がアプリに対してスケーリングされた論理座標を提供するため、キャプチャ結果がズレたり、キャプチャサイズが異なったりします)。ですので、このアプリについては、画面の拡大率 100 %での使用を強く推奨させていただきます。

【追記_20251005】

ここで紹介している画面キャプチャプログラムに新しい機能を追加した Capity Plus を公開しました。新しいプログラムは以下のリンク先からダウンロードできます。

https://coding-tips-memoranda.com/say-hello-to-capity-plus

【もくじ】

1.手作りの『それ』が必要になった理由
2.使い方
3.☆ここではまりました☆
4.ダウンロードはこちらから
5.お願いとお断り

1.手作りの『それ』が必要になった理由

前回、『解答欄(矩形)検出器を改良しました!』の記事を書いた際、どうしても必要になったのがマウスカーソルの形状を含めて画面をキャプチャできるプログラムです。

AI に「マウスカーソルの形状を含めて画面をキャプチャするいちばんかんたんな方法は?」と尋ねてみると Windows 標準搭載の「拡大鏡」を使えばいいよ ♪・・・とのご回答を頂戴したのですが、試して3秒後には、

( 思ったのと、ちがう )

そう感じて画面を閉じてしまいました。

他に、いつも愛用している「 Lightscreen 」という画面キャプチャユーティリティも AI から紹介されましたが、こちらはもう、ほんとうに素晴らしいソフトウェアで、この Blog に掲載した画像もほぼ全部、LightScreen でキャプチャしたものと言っていいくらいです。

ただ、残念ながら、今回の目的である『簡単に』マウスカーソルの形状を含めてキャプチャするという目的の実現に関しては、『タイマーの設定が必要』等の部分で、この目的の実現に関する部分に限っての話ですが、LightScreen は( ベスト・オブ・ベストの選択肢とは言えないかな・・・)って、思ってしまいました。

いつも、お世話になってるのに、こんなコメントしかできなくて、ほんとうにごめんなさい。

それからこれは、僕の PC で起きてしまったことなので、書かせていただきますが、僕のような素人には何が原因なのか・・・さっぱりわからないのですが、何らかの設定変更のあと?でしょうか・・・ タイトルバーが以前よりすごく大きく(逆に文字はほとんど読み取れないくらい小さく)表示されるようになることが(時として)あり、さらにこうなった時は、タイトルバー部分をクリックしてアクティブにして、画面上の位置を変えようとドラッグしても微動だにしないという不思議な現象に遭遇・・・ たしか、以前はそんなことは、なかった・・・ ような気がするのですが・・・

その際は、次のように操作してコトなきを得ましたが・・・。

( ただ、この方法でも「動かない」こともありました・・・ )

左上のアイコンを右クリックすると表示される
サブメニューの移動をクリックしてタイトルバー部分を
ドラッグすると移動できたり・できなかったり・・・

あと、表示されるタイトルバーも文字も、なぜかすごく大きい。
(逆にアプリの文字は、ものすごく小さい)

この状態で、マウスカーソルの形状を含めて画面キャプチャする機能を試そうと思ったのですが、今度は、設定?画面の文字が小さすぎて読めません・・・。

いったい何が原因でこうなったのか、それがわかりません。
私の使い方が間違っていると思うのですが、その間違いがわかりません。


exe を右クリックして、プロパティを表示し、「高 DPI 設定の変更」も試しましたが、効果がありません。これにはどう対応していいのか、まったく手も足も出ず、ほんとうに困ってしまいました。

【これは Windows 側の問題ではないかと?】

Lightscreen の名誉のために追記します。この Lightscreen の見た目の問題ですが OS を再起動したら元の姿に戻りました。再起動前に自分がナニをやったのか、よくよく考えてみると、解像度の変更を数回繰り返したように思います。もしかしたら、そのへんに何か、原因があったのかもしれません。

OS を再起動したら元の姿に戻ってくれました!

拝啓 Lightscreen 様

ご心配をおかけしましたこと、心より深くお詫び申し上げます。
どうか、これまで通り、仲よくしてください!!

いずれにしても、ここまで来てしまった以上、他人様に頼って問題を解決しようという、

甘え切った姿勢に
問題の真の原因がある

のは、火を見るよりも明らかです。それならば、取るべき道はただ一つ。

そう、自前で・・・
なんとかするしか、
ありません。

・・・

そうです。自前でなんとかするしか、ないのですが・・・

なんか、最近、そんなコトばっかり で・・・

それって、やっぱり・・・

前から、ちょっとは、思ってたケド。

僕は能力が低くて、適応力がなくて、ノロくて、グズだから、

もっと アリテー に言えば、ク〇ク〇パーだから

みんなが使ってる、一般的なアプリにすら馴染めないんだ。T_T

僕はやっぱりダメなんだ・・・。

ダメ人間なんだ!!

ひー(我が心の声)

でも、いいんだ。

僕には Delphi がいてくれる。

そう・・・ いつも Delphi がいてくれる。

Delphi があれば、なんにも心配なんかない。

汎用のアプリなんか使えなくても、自力で自分専用のを作るカラ☆

Delphi だけがトモダチさぁ♪

(この変わり身の早さだけが身上です)

こうして深い悲しみを、無上のよろこびに変えるべく、「その気になればマウスカーソルの形状も含めて画面キャプチャが可能なプログラム作り」がはじまりました。

あぁ アプリの名前、なんにしよー☆ みたいな・・・

みんなは、思ったように使えるアプリがないとき、いったいどーしてるのかなー? みたいな・・・

2.使い方

マウスのカーソルを含めてPCの画面をキャプチャする核心部分のコードは次の通りです。参考資料として、「ホットスポット」に対する考慮がないため、IDE のエディタ上などでカーソルが I ビームとなった状態でPC画面をキャプチャすると、マウスカーソルの位置がズレるコード( Version_01 )もコメント化した状態で載せています。試用される場合、コメント化してある下記 Version_01 のコードは、期待通りに動作しないコードであることに、どうかご注意ください。

また、キャプチャした画像のスクロールに関しても(画像関連のプログラムを書くときは、いつもこれが問題になるのですが)、なめらかにスクロールできるように処理を追加しています。Windows11の設定がデフォルト設定のままであれば、マウスのホイールを回転させれば上下方向にスクロール、Shift キーを押しながら、マウスのホイールを回転させれば、左右方向にスクロールします。

procedure TForm1.CaptureDesktop(ABitmap: TBitmap; IncludeCursor: Boolean);
var
  DC: HDC;
  R: TRect;
  CursorInfo: TCursorInfo;
  Pt: TPoint;
  //マウスのカーソル位置を正しくキャプチャするために追加
  IconInfo: TIconInfo;
begin

  //Version_01(マウスカーソルの位置がずれる)
  {
  if not Assigned(ABitmap) then Exit;
  R := Rect(0, 0,
    GetSystemMetrics(SM_CXSCREEN),
    GetSystemMetrics(SM_CYSCREEN));
  DC := GetDC(0);
  try
    ABitmap.PixelFormat := pf24bit;
    ABitmap.Width := R.Right;
    ABitmap.Height := R.Bottom;
    BitBlt(ABitmap.Canvas.Handle, 0, 0, R.Right, R.Bottom,
           DC, 0, 0, SRCCOPY);
    if IncludeCursor then
    begin
      CursorInfo.cbSize := SizeOf(CursorInfo);
      if GetCursorInfo(CursorInfo) and (CursorInfo.Flags = CURSOR_SHOWING) then
      begin
        GetCursorPos(Pt);
        DrawIcon(ABitmap.Canvas.Handle, Pt.X, Pt.Y, CursorInfo.hCursor);
      end;
    end;
  finally
    ReleaseDC(0, DC);
  end;
  }

  //上のコードを実行するとキャプチャした画像の「マウスカーソルの位置がずれる」
  //これは( Delphiの? )スクリーンキャプチャでよく起きる現象のようだ

  //【問題の原因】

  //GetCursorPos(Pt);
  //DrawIcon(ABitmap.Canvas.Handle, Pt.X, Pt.Y, CursorInfo.hCursor);

  //「カーソルのホットスポット(実際のクリック位置)」を考慮せずに
  //アイコンの左上を (Pt.X, Pt.Y) に描画している。

  //マウスカーソルは単なるアイコンではなく、
  //「ホットスポット」という基準点(通常は左上から数ピクセルずれた位置)が存在する。

  //Delphi のコードではその補正をしていないため、
  //キャプチャしたカーソルが右下に数ピクセルずれてしまう。

  //特に Delphi IDE のエディタ上では I ビームカーソルなど、
  //ホットスポットが左上から大きくずれているものを使うので、ズレが目立つ。

  //一方 GUI デザイン画面では標準の矢印カーソル(ホットスポットが左上 0,0 のもの)
  //が使われるのでズレが目立たない。

  //【修正方法】

  //GetIconInfo を使い、カーソルのホットスポットを考慮して描画位置を補正する。
  }

  //スクロールに関する問題の解決方法
  //1. AutoScroll := True (デフォルト)でスクロールバーは自動表示される
  //2. 手続き内で ScrollBox1.HorzScrollBar.Visible := False を設定
  //3. 以降、スクロールバーが表示されなくなる(領域を超えても)
  //いったん Visible を False にすると
  //Delphi が「このスクロールバーは使わない」と判断してしまい、
  //AutoScroll の制御対象から外れてしまう。

  ScrlPreview.AutoScroll:= True;
  ScrlPreview.HorzScrollBar.Visible := True;
  ScrlPreview.VertScrollBar.Visible := True;
  //ScrlPreview.Realign; // ← 状況によってはこれも必要?

  //Version_02(マウスカーソルの位置も正しく取得できる)
  if not Assigned(ABitmap) then Exit;

  R := Rect(0, 0,
    GetSystemMetrics(SM_CXSCREEN),
    GetSystemMetrics(SM_CYSCREEN));

  DC := GetDC(0);
  try
    ABitmap.PixelFormat := pf24bit;
    ABitmap.Width := R.Right;
    ABitmap.Height := R.Bottom;
    BitBlt(ABitmap.Canvas.Handle, 0, 0, R.Right, R.Bottom,
           DC, 0, 0, SRCCOPY);

    if IncludeCursor then
    begin
      CursorInfo.cbSize := SizeOf(CursorInfo);
      if GetCursorInfo(CursorInfo) and (CursorInfo.Flags = CURSOR_SHOWING) then
      begin
        GetCursorPos(Pt);
        if GetIconInfo(CursorInfo.hCursor, IconInfo) then
        try
          //ホットスポットを考慮してカーソルを描画
          DrawIcon(ABitmap.Canvas.Handle,
            Pt.X - Integer(IconInfo.xHotspot),
            Pt.Y - Integer(IconInfo.yHotspot),
            CursorInfo.hCursor);
        finally
          if IconInfo.hbmMask <> 0 then DeleteObject(IconInfo.hbmMask);
          if IconInfo.hbmColor <> 0 then DeleteObject(IconInfo.hbmColor);
        end;
      end;
    end;
  finally
    ReleaseDC(0, DC);
  end;
end;

プログラムの名称は、AI に相談したら即 ” Capity ” がいいよ☆との提案がありまして、それに決めました。なお、この ” Capity ” という名称は、特許情報プラットフォーム「 J-PlatPat 」のキーワード検索で「特許・実用新案、意匠、商標」の四法について過去の登録・申請の有無を調査し、2025年9月27日現在、この名称に該当する登録・申請が0件であることを確認済みです。

Capity – Lightweight Screen Capture Tool

【使い方】

上記コードを核心部分に据えて、(作者が)最低限必要と思われるアレやコレを GUI として付け足して、完成した気がする Capity.exe をダブルクリックして起動すると・・・


画面右下に操作方法の案内(トースト通知:Toast Notification?)だけを表示して、プログラム本体は非表示状態(タスクバーには表示されます)で起動します。

プログラム本体は「非表示」状態で起動します!


プログラム本体を表示するには、タスクバーの Capity (読めないかもしれません!)アイコンをクリックしてください。


タスクバーの Capity アイコンをクリックすると本体が表示されます。

プログラム本体を表示(起動時の画面をこのアプリでキャプチャしました)
なお、メイン画面の画像は、右下隅へスクロールした状態を取得(キャプチャ)しています。


マウスのカーソルの形状を含めて PC の画面をキャプチャする設定であった場合には、起動時に画面右下の通知領域に次の案内が表示されます。ただし、高DPI環境では、ヒントの位置がずれて表示されないことがあるようです。ところで、この表示の名称は「トースト通知」でいいのでしょうか?

起動時の表示は、ヒントの表示が無効化されている場合も、当然、出ません!


上記案内にある通り、Shift + Ctrl + C ( これは Shift キーと Ctrl キーと C キーを同時に押すことを意味します -> 実際の操作では、左手でキーボード左下にある Shift キーと Ctrl キーを同時に押しつつ、右手で C キーを押します)のキー操作で現在表示されている PC 画面が、マウスのカーソルの形状も含めてキャプチャされます。

マウスのカーソルの形状を含めずに PC の画面をキャプチャする設定であった場合には、起動時に次の確認画面が表示されます。


「はい」・「いいえ」どちらを選択しても、画面右下の通知領域に上記案内を出して、プログラム本体は非表示(タスクバーには表示)で起動します。

「はい」を選んだ場合は、IncludeCursor という名前のチェックボックスにチェックが入ります。このチェックボックスの状態(チェックの有無)やその他の VCL コントロールの選択(設定)状態は、プログラム終了時に自動的に保存され、次回はこの自動保存された設定に基づいて起動します。

・設定の保存先フォルダ:C:\Users\ユーザー名\AppData\Roaming\Capity
・設定の保存ファイル:settings.dat

「EN」のチェックを外すと各 VCL コントロールのキャプションは日本語表記になります。


日本語表記の状態です。

「EN」をチェックすれば英語表記に戻ります。


あとは、キャプチャしたい画面を最前面に表示して、Shift + Ctrl + C のショートカットキーで PC 画面をキャプチャしてください。上の画像にある「キャプチャ」ボタンをクリックした場合は、このアプリの作業画面がキャプチャされます。

「キャプチャ」ボタンをクリックするか、アプリを最小化して Shift + Ctrl + C する度に、新しいキャプチャデータが作られます。新しくつくられたキャプチャデータ(画像)は、アプリの右側にサムネイル表示されます。このサムネイル表示を左クリックすると、そのキャプチャデータがアクティブになり、メイン画面に表示されます。右クリックすると削除の可否を問うメッセージが表示されます。キャプチャしたデータを保存していない場合は、削除されたデータを復活させることはできません。

このアプリは本格的な画像編集に使用するための素材、もしくは、操作方法の解説を作成するために必要な情報画像(部分的な切り抜き画像)を簡単に作成したいという目的を実現するために開発しました。ですので「現在、表示されている画面の全部、もしくは一部を、必要であればマウスカーソルの形状を含めた画像データとして取得する」ことしかできません。保存した画像データを再度読み込んで表示したり、キャプチャした画像を加工する(例えば、ぼかす・モザイクをかけるといったような)機能はありません。ただし、画像の指定範囲を「ぼかす・モザイクをかける」機能は、後日、追加できたら、追加したいと考えています。

また、範囲を指定してキャプチャする機能はありませんが、アプリ側でキャプチャした画像上に矩形を描画し、この矩形で囲んだ範囲を任意の名称を付けて保存したり、クリップボードへ送信することができます(方法は後述)。※ このアプリで、本当に実現したかった機能は、この機能です!

キャプチャした画像上に描く矩形の枠線の太さと色は変更可能です。アプリは終了時の設定内容を自動的に記憶しますので、次回起動時は前回終了時の設定を復元して起動します。矩形で囲った範囲内部を右クリックすると表示されるサブメニューから、その範囲のみを「名前を付けて保存」したり、「クリップボードへ送信」したりすることができますが、その際、保存したり、送信されるのは、矩形下の指定した範囲のみです。矩形そのものは保存・送信されません。

範囲を指定する際に描かれる矩形の枠線の太さと色は変更可能です。


何らかの理由で矩形も含めて保存・送信したい場合は、「矩形が表示された状態そのものをキャプチャ」して、その矩形全体を囲むように範囲を指定(範囲選択後も、矩形の上下左右と四隅に表示されるグラブハンドルをドラッグして選択範囲の微調整が可能です)し、保存・送信を行ってください。

なお、アプリの仕様として、単に画面をキャプチャしただけでは画像データとして保存されません。画像データとして利用したい場合は、必ず保存の作業を行ってください。保存していないキャプチャデータはアプリ終了時に自動的に破棄されますので、この点には十分ご注意ください。

キャプチャした画面を画像データとして保存する方法は3つあります。

(1)ショートカットキー( Shift + Ctrl + S )で保存。
(2)アプリ本体の「Save」ボタンをクリックして保存。
(3)アプリ本体で範囲を指定して保存。

(1)ショートカットキー( Shift + Ctrl + S )で保存

まず、(1)のショートカットキーによる保存は、最後に Shift + Ctrl + C を行ったデータに対して有効です。画像データの保存先 Path は、デフォルト設定はデスクトップですが、アプリを起動後、ユーザーが保存先を任意の場所に変更した場合は、ユーザーが選んだ任意の場所となります(アプリは終了時にデータの保存先 Path を記録して終了、次回起動時はその Path の存在を確認し、Path が存在すればそこを、存在しなければユーザーが新しく指定した任意のフォルダ(もしくはデスクトップ)を画像データの保存先として自動選択します)。

ショートカットキー( Shift + Ctrl + S )で保存した場合は、SaveDialog は表示されません。ショートカットキー押し下げと同時に上記指定フォルダに保存後、次のメッセージが表示されます。

画像ファイルの名称は「Screenshot_西暦年月日_時分秒」+「.拡張子」となります。
(SaveDialog 使用時は、任意の名称に変更可能です)

画像データの保存形式は、デフォルト「PNG」形式です。アプリ本体側で 予め指定 すれば「BMP」や「JPEG」形式で保存することもできます。先ほどの Path と同様、アプリは終了時に指定されていた画像ファイルの保存形式を記憶しますので、次回は前回終了時の保存形式が自動的に選択された状態で起動します。

(2)アプリ本体の「Save」ボタンをクリックして保存

2つ目の保存方法が、アプリ本体の「Save」ボタンをクリックして保存する方法です。初めて起動した際には、保存形式はデフォルトで PNG 形式になっていると思いますが、PNG 形式の他に BMP や JPEG でも保存可能です。ですので、アプリの「Save」ボタンを利用する保存の流れとしては、タスクバーのアプリをクリック → 画像の保存形式を指定 → 画像の保存( Save ボタンをクリック)が基本です。

キャプチャした画像の保存形式を指定した後、「Save」ボタンをクリックしてください。

このアプリでキャプチャした画像です!


即時保存のショートカットキー( Shift + Ctrl + S )を使わず、タスクバーに待機していたアプリのアイコンをクリックしてプログラムの本体を表示し、画面右下の「Save」ボタンをクリックする(2)の場合は、(1)の場合とは異なり、「名前を付けて保存」のダイアログが表示されます。必要に応じて保存場所・ファイル名を変更し、「保存」ボタンをクリックすれば、キャプチャした画像をそのまま、任意に指定したディレクトリ(フォルダ)に保存できます。

キャプチャした画像ファイルの保存先とファイル名は Windows 側の機能を利用して変更が可能です。
必要に応じてダイアログを操作し、「任意の場所・任意の名称」に変更してください。

(3)アプリ本体で範囲を指定して保存

キャプチャした画像の一部を範囲指定して保存する方法です。例えば、操作方法の案内で「最小化ボタンをクリックしてください」という趣旨を解説する際に使用したい画像を作成するには、次のように操作します。

まず、マウスのカーソルを最小化ボタンに乗せて(最小化ボタンをポイントして)、画面全体をキャプチャ( Shift + Ctrl + C )して、必要な範囲を矩形で範囲指定します。範囲指定は、必ず、指定したい範囲の左上から右下へドラッグする形で行ってください(右下から左上へドラッグする操作は無効となります)。

解説に使用したい範囲を矩形で囲みます。


矩形で囲んだ範囲の内部へマウスのカーソルを移動させる(矩形内部をポイントする)と、マウスのカーソルの形状が上下・左右の矢印( SizeAll ・「全方向サイズ変更カーソル」or「移動カーソル」に変化します(この状態で範囲そのものを移動させることもできますが、移動はあまりスムースではありません)。この状態でマウスを右クリックするとサブメニューが表示されます。

実行したいコマンドをクリックしてください。


指定範囲をそのまま無加工で使用する場合は「名前を付けて保存」、画像編集ソフトでさらに加工して使いたい場合は「クリップボードへ送る」を選んでください。

この解説そのものも、このアプリで作成しましたが、キャプチャした画像をさらにキャプチャするので、なんだか、すごく混乱しました。解説の解説を作るって、難しいです・・・

【終了方法】

アプリを終了するには、操作画面右下隅にある「Close」or「終了」ボタンをクリックしてください。確認メッセージが表示されます。

「はい」をクリックすると終了します。

3.☆ここではまりました☆

「こんなのカンタンさぁ・すぐ出来るー」みたいな軽いノリで始めたこのアプリの制作でしたが、思わぬ落とし穴にはまり、3日間ほど停滞しました。それは何かというと、範囲を指定する矩形を描画した後の、矩形のリサイズ時の挙動の制御です。

矩形の新規描画の際には、キャプチャした画像上の任意の位置をドラッグするわけですが、この時、ドラッグした範囲が画像の右や下、または右下隅までくると、次の画像のようにドラッグそのものが自動的に停止します。

新規に矩形を描画する際は、画像の端までドラッグしたら、もうそれ以上ドラッグできません。


ところが、この範囲の選択後、矩形の上下左右と四隅に表示されるグラブハンドルをクリックして(掴んで)リサイズしようとすると、選択範囲(上の画像の赤い点線部分:業界用語では「ラバーバンド」と言うようです)が画像の幅・高さを超えて右へ・下へ、大きくずれて描画されてしまうのです。

範囲選択後、矩形をリサイズしようとするとキャプチャした画像の範囲をオーバーしてしまう・・・


上の例はわかりやすさのため、画面の右下隅で新規矩形描画時にカーソルが自動停止した後、さらに右下側へリサイズするという、現実にはあり得ない設定で説明しましたが、実際の場面では、キャプチャした画像の右下方向を範囲選択して切り抜きたいとき、この現象が発生するわけです。

この選択範囲が画像の端をはるかにオーバーした状態で「名前を付けて保存」・「クリップボードへ送信」しても、保存・送信されるのは余計な余白のない(取得したかった)画像データのみなので、『問題がない』と言えば『問題ない』のですが、気分がよくないです。

プログラム的には、キャプチャした画像は imgPreview という名前の TImage に表示し、さらにその上に plImage1という名前の TImage を乗せ、これをラバーバンドとして利用しています。ですので、手続きは、imgPreview の MouseDown 、MouseMove 、MouseUp と、plImage1 の MouseDown 、MouseMove 、MouseUp があるわけです。

plImage1 は、Mr.XRAY さんが公開していらっしゃる plResizeImage.pas を利用させていただき、作成したものです。改変可能とのことでしたので、元の plResizeImage.pas に必要な機能を追加して使わせていただきました。素晴らしいプログラムを公開してくださっている Mr.XRAY さんに心より厚く御礼申し上げます。ほんとうに、ありがとうございました。

157_移動リサイズ可能な TImage ラバーバンドとグラブハンドル

さて、どうやってこの問題を解決したか? ですが・・・

私は、当初、imgPreview 上での動作なので、imgPreview の MouseDown 、MouseMove 、MouseUp の各手続きに必要な制御を記述すればイイとハナから思い込み(しかも、その思い込みが原因で、これまでにもさんざん苦労して、痛い思いを味わい続けてきたことすら完全に忘れ)、手を変え、品を変え、コードを変えて、imgPreview の MouseDown 、MouseMove 、MouseUp の各手続きに、ドラッグ操作が imgPreview の右下隅で自動停止するコードを書き続けたわけですが、どんなにコードを尽くしても、上の画像で示した画像の境界を超えてラバーバンドが描画される現象を改善することが出来ず、つまり、ラバーバンドは画像の端の先々まで伸び続けるという、またまた、この「他に誰一人として悩まないこと」で、さんざんに悩み、まるまる2日間をこの問題の解決に費やしました。今思えば、見方によっては、それは途方もなく無駄で無意味な時間であったわけですが・・・。この悩んでいる状態を経験したくてプログラムを書いているように思えてならないフシもあり、そうなるともう、これは救いようがありません・・・

ともあれ、七転八倒し続けた挙句、(オレは根本的に間違えているのではなかろうか?)と、ようやくそこに思いが至りました。時にして遅すぎですが、これが悩み続けて3日目のことです。

で、気づいた根本的な間違いとはナニか? というと、確実に呼ばれていると思い込んでいた上記イベントは実は呼ばれていないんじゃないか? という至極(「非常に」・「とても」の上位語として、強調の意味を持ちます)当然のことなのですが、3日めにしてようやくというか、やっとそこに思いが至ったわけです。

一緒に暮らしているヒトに『悔い改めましたか?』とよく問われる私ですが、どんなに悔い改めても同じような誤りをひたすら繰り返すのは、懲りてないと言うか、何と言うか、やっぱり、バカなんじゃないかと・・・、今に始まったことではありませんが、そう思えてなりません。

神さま
ボクには信じることと
思い込むことの違いが
よくわかりません。

信じるものは救われると
聞きましたが、
思い込むものは
救われないのでしょうか?

父からは、いつか・・・
『大丈夫。天国の黒板にはあなたの名前が書いてある。』と

ものすごいことを聞きましたが、
あっ。いえ、その・・・
決して「ついでに」という訳ではありませんが、
それも ほんとう でしょうか?

そのように悩みつつ、書いたコードがコレです。

  {$IFDEF DEBUG}
  OutputDebugString('imgPreviewMouseDown called');
  {$ENDIF}

実際の画面上では、こう見えます。(この文字のうすさが、なんかステキで・・・ ♪)


本来ならば、コレをいちばん最初に確認すべきだったのですが、後悔と反省の狭間で目を瞬きながら「いつ・どのイベントが呼ばれているのか」確かめて見ると・・・ 矩形のリサイズ時に呼ばれているのは、


当たり前ですが、(本人は、そのような手続きを書いたことすら忘れていた )plImageResized 手続きでありました!

しばし、唖然としましたが、わかってしまえばコトはカンタンです。

procedure TForm1.plImage1Resized(Sender: TObject; ARect: TRect; ALeft, ATop,
  AWidth, AHeight: Integer);
var
  ・・・ 省略 ・・・
  clipRect: TRect;
  topLeft, bottomRight: TPoint;
begin

  {$IFDEF DEBUG}
  OutputDebugString('plImageResized called');
  {$ENDIF}

  ・・・ 省略 ・・・

  //マウスのカーソルの移動範囲を制限

  //imgPreview のクライアント領域をスクリーン座標に変換してカーソルの移動を制限
  clipRect := imgPreview.ClientRect;
  topLeft := imgPreview.ClientToScreen(Point(clipRect.Left, clipRect.Top));
  bottomRight := imgPreview.ClientToScreen(Point(clipRect.Right, clipRect.Bottom));

  clipRect.Left := topLeft.X;
  clipRect.Top := topLeft.Y;
  clipRect.Right := bottomRight.X;
  clipRect.Bottom := bottomRight.Y;

  // カーソル移動範囲を制限
  ClipCursor(@clipRect);

end;

で、このままだと、マウスのカーソルは imgPreview の外へ出れなくなってしまうので、plImage1 の MouseUp 手続きで ClipCursor に nil を代入してカーソルの移動制限を解除します。

procedure TForm1.plImage1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  screenPt: TPoint;
  localPt: TPoint;
begin

  //フラグをリセット
  DragFlag := False;
  MoveFlag := False;

  //ドロップ後の plImage1 のスクリーン座標を取得
  screenPt := plImage1.ClientToScreen(Point(0, 0));

  //imgPreview のローカル座標に変換
  localPt := imgPreview.ScreenToClient(screenPt);

  //キャプチャ範囲を更新
  rbX := localPt.X;
  rbY := localPt.Y;
  rbW := plImage1.Width;
  rbH := plImage1.Height;

  //カーソルの移動制限を解除
  ClipCursor(nil);

end;

これでリサイズ時でも、キャプチャした画像の端でカーソルが停止するようになったはずです。そしてこれは思い込みではないはずです。

結果を信じながら、キャプチャした画像上を範囲選択します。

範囲選択後、いったん指をマウスから離し、さらにリサイズします。


神さまに祈りながら、グラブハンドルをクリックして(掴んで)右下隅の方へドラッグし(引っ張り)ます。はたして結果は如何に・・・

☆キャプチャ画像の右下隅でドラッグは自動停止しました☆

やった! やった!!

これでようやく
夢が全部叶いました!

4.ダウンロードはこちらから

今回の記事で紹介した PC の画面キャプチャを実行するプログラム一式を以下からダウンロードできます。なお、ダウンロードとご使用にあたっては、免責事項及び使用条件への同意が必要です。免責事項及び使用条件の詳細は付属の License.txt をご覧ください。

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

5.お願いとお断り

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

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.お願いとお断り

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

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

Answer Column Reader

横書き答案の採点実行時の画面です。


スキャナーで読み取った手書き答案のJpeg画像から、大問1の設問(1)なら(1)のみを抽出、一覧表示してイッキに採点。採点記号( 〇・△・× )& 得点付きで元の答案画像に書き戻し、最後に得点合計を自動計算、指定位置に描画して、返却用答案画像(A4サイズに統一/縦・横の指定は可能)を印刷できる無料の手書き答案採点補助プログラムです。

一般的な横書き答案に加え、国語で使用される縦書き答案の採点も可能です。

縦書き答案の採点実行時の画面です。


新教育課程の観点別評価にも対応。もちろん、表計算ソフトを使わずに成績一覧表の作成・印刷・CSVファイルへの出力が可能です(ただし、成績一覧表の出来栄えは、メモ程度)。

画像処理に使用しているPython用OpenCV関連のファイルサイズが巨大ですが、このファイルサイズを許容していただければ、採点現場で十分使えると(複数の高校で使用中)評価していただけました!

もちろん、完全無料。ただし、動作保証は一切ありません。作成者(僕)は開発環境のDelphi(Object Pascal)の大ファンで、この他にも自作のマークシートリーダーなどを開発・このblogの過去記事で公開していますが、学問領域で評価の対象となるようなプログラミングに関しては全くの素人です。ですから、このプログラムのご使用に際しては、あくまでも素人が趣味で作ったものであるということを十分にご理解いただき、ダウンロードから展開・実行までALL自己責任でお願いします(有償販売禁止の他は、それが唯一の使用条件です)。発見できた不具合はすべて改良改善しましたが、取り切れていない未発見の不具合もまだきっとあると思います。それでも、もし、よろしければお使いください。僕の夢のカタチ、Answer Column Reader。

手書き答案採点補助プログラム、名付けて AC_Reader です。

追記(20250825)

当Blogで紹介してきた自作のデジタル採点プログラムを一つにまとめました。次のリンク先にその紹介とダウンロードリンクがあります。この記事で紹介している手書き答案のデジタル採点プログラムAC_Reader Version 2.1.1 と、AC_Reader Version 2.1.1 に自動採点機能を追加で搭載した Version 3.1.1 がプログラムセットに同梱されています。

【更新履歴】

・2024年9月29日 初版公開
・2025年8月25日 不具合の修正及び新機能を追加したバージョンアップ版に更新
・2025年8月26日 Anti-Virus Software による『未知バイナリの初回スキャン』の待機状態を改善
・2025年9月22日 連続ボタンクリックで落ちる問題を改善/自動採点機能無し版も同梱

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

2025年8月25日更新版に含まれている「手書き答案採点補助プログラム AC_Reader Version 3.1.0 )には自動採点機能が新しく追加で搭載されています。プログラムのダウンロード&展開後、初めてこの自動採点機能を実行する際に、Windows Defender や McAfee などの Anti-Virus Software : AV による『未知バイナリの初回スキャン』が行われるようです。このため2~3分間程度 PC は待機状態になります(2回目以降はスムース?に動作します)。また、実行形式ファイルの PC 内での位置が変わった場合にも AV によっては再度『未知バイナリの初回スキャン』が行われ、初回同様の待機状態となる場合があります。このことについては、この Blog の別の記事に詳しい説明があります。下記リンク先の記事をご参照ください。

2025年8月25日の更新版には、解答欄矩形の検出プログラムも機能を大幅に修正した更新版が含まれています。修正内容の詳細は、下記リンク先をご参照ください。

(追記_20250825 ここまで

追記(20250707)

ここで紹介している手書き答案のデジタル採点補助プログラム AC_Reader に自動採点機能みたいなモノを搭載しました。

【もくじ】

1.使い方
(1)zipファイルを展開
(2)プログラムを起動
(3)スキャンした答案の画像を準備
(4)採点用画像の準備
(5)解答欄の座標を取得
 ・【座標データを追加したい場合は?】
 ・【字数制限のある解答欄座標の簡単な取得方法は?】
 ・【機械が認識しやすい解答欄】
 ・【生徒の番号・氏名も解答横に表示して採点したい】
(6)採点
 ・【全員正解を入力】
 ・【全員不正解を入力】
 ・【個別に採点】
 ・【次の設問を採点】
 ・【定型文を入力】
 ・【入力した定型文の削除・消去方法】
(7)採点状況の確認
(8)返却用答案の印刷
(9)成績一覧表の作成・印刷
2.まとめ
3.お願いとお断り

1.使い方

もくじへ戻る

(1)zipファイルを展開

ダウンロードしたzipファイルをデスクトップ上に展開します(任意の場所に置いても動作すると思いますが)。PCによっては展開(解凍)に20分程度かかることがあるようです。

もくじへ戻る

(2)プログラムを起動

展開されたフォルダ内に「AC_Reader.exe」があります。これをダブルクリックしてプログラムを起動します。

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


初回起動時には、次のメッセージが表示されると思います。その場合は「詳細情報」(画像中、赤い枠で囲んで示した部分)をクリックします(プログラムの発行元が不明である場合に、Windows のDefender機能である SmartScreen がこの表示を出すそうです。自分の責任で実行すれば、次回からこのメッセージは表示されなくなります)。

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


すると、次の画面が表示されます。「実行」(画像中、赤い枠で囲んで示した部分)をクリックしてプログラムを起動してください。

「実行」をクリックします。


プログラムの起動時に、次のメッセージが表示されます。「はい」・「いいえ」のいずれかを選択してください。

差し支えなければ「はい」を選択してください。


Excelの採点シートを使って処理する場合は、拙作マークシートリーダーとこの手書き答案採点補助プログラムを併用することも可能です(その方法についての説明は、今回は行いません)。

マークシート方式と併用することも可能ですが、今回は「はい」をクリックしてください。


国語の試験では縦書きの解答用紙が使われますので、この手書き答案採点補助プログラムも縦書き答案の採点が出来るよう設計しました。デフォルト設定の答案書式は「横書き」です。国語の縦書き答案を採点したい場合はここで設定画面を開き、縦書きを指定してください。

今回は「いいえ」で先に進みます。


ちなみに「はい」を選んだ場合は・・・

答案の書式を指定できます。


答案の書式の設定変更を起動時に問われなくするよう設定できます。

採点する答案の書式が決まっている場合は「はい」を選択してください。


試験は毎日行われているわけではなく、定期考査として2~3か月に1回実施されるのが普通です。これくらい間が空くと、△の付け方などをどうしても忘れてしまいます。「忘れた!」と毎回のように質問がありましたので、プログラムの起動時にメッセージとして、採点方法を表示することにしました。

特に「△」の入力方法を問われることが多かったです!


この入力方法の案内は、画面右下の「終了」ボタンのとなりにある「入力方法のご案内」ボタンをクリックすれば、いつでも再表示できます。

入力方法はいつでも確認できます。

もくじへ戻る

(3)スキャンした答案の画像を準備

答案の画像は必ず「解像度200dpi程度」でスキャンし、「Jpeg画像として保存」してください。

重要 白黒の二値化画像としてスキャンしないでください。

なお、答案をスキャンする際は、次のことにご注意ください。

・答案が出席番号順に並んでいることを必ず確認してください。
・答案の向きは問いませんが、上下が揃っていることを必ず確認してください。
・試験を欠席した生徒がいる場合は、そこに未使用の解答用紙を挿入しておきます。
・消しゴムの屑等はよく払い落としておきます。
・一度に採点できる枚数は100枚を想定しています。
・答案に折り目がある場合は、なるべく平らになるよう折り戻しておきます。

スキャンした答案の画像は、科目名とクラス・講座名がわかるよう適切な名前をつけたフォルダ内に保存し、このフォルダをAC_Reader.exeがあるフォルダの「ScanData」フォルダにコピーしてください。

重要 スキャンした画像は、必ず「ScanData」フォルダ内にフォルダを作成し、保存してください。

重要 ScanDataフォルダ内のフォルダに階層構造を作らないでください。

よい例:

ScanData¥数学Ⅰ_1A

わるい例:

ScanData¥1年¥数学Ⅰ_1A

もくじへ戻る

(4)採点用画像の準備

上記の手順で、スキャンした答案のJpeg画像を所定の場所に準備したものとして説明します。

プログラムの画面右上にある「画像変換」ボタンをクリックします。

重要 採点用画像には、必ずこの画像変換プログラムが生成したJpeg画像を使ってください。それ以外の方法で作成した画像は使用できません!


次のWindowが開きます。「選択」をクリックしてください。

ScanDataフォルダ内に用意した「答案画像を入れたフォルダ」をクリックして選択します。
練習では予め用意されているSampleフォルダを選択してください。

重要 選択するのは「フォルダ」で、「ファイル」ではありません。

採点したい答案画像のあるフォルダをクリックすればOKです。
(ダブルクリックして開ける必要はありません)

サムネイル表示を見て、画像の回転の有無・回転方向を指定します。Sampleの画像で練習する場合は「なし」を指定してください。

次に画像のリサイズの有無を指定します。複合機のスキャナーを使用し、解像度200dpiでスキャンした画像の場合、80%程度に縮小すると採点しやすいと思います。答案画像をプレビューして縮小率を確認しながら作業することができます。

画像のリサイズ設定を行ったら、次に採点用画像の保存先を指定します。「参照」ボタンをクリックしてください。画像の保存先を選択するWindowが表示されます。

採点用画像の保存先は、ScanDataフォルダ内ではなく、「ProcData」フォルダです。

Procはprocessed(処理済み)の略です。

重要 ProcDataフォルダ以外の場所は、作業フォルダに出来ません!

画像の変換元として選んだScanDataフォルダ内のフォルダと同じ名前のフォルダを、プログラムはProcDataフォルダ内に自動的に作成します。ここでは、この自動的に作成されたSampleフォルダをクリックして選択し、OKをクリックしてください。

フォルダは自動的に作成されたものを選びます。

「変換実行」ボタンをクリックすると採点用にリサイズされた画像が上で指定したフォルダ内に作成されます。この処理はGDI+で書きましたので、それなりに高速だと思いますが、答案の枚数が多く、回転を伴う場合は少し時間がかかります。処理が完了するまでしばらくお待ちください。

この処理では用途の異なる2種類の画像を作成します。一つは採点マークのない各解答欄画像の読み取り元として利用する画像、もう一つは採点マークその他必要事項を上書きした返却用答案画像として利用する画像です。このようにすることで、何度でも採点のやり直しができる仕組みを実現しています。

注意していただきたいのは(めったにないことですが)、採点結果を答案画像に書き戻している最中に何らかの原因でプログラムが落ちた(クラッシュ/フリーズ)場合です。プログラムは採点結果を数値データとしてCSVファイルに書き込むと同時に、採点マークを付けて返却用答案画像にも書き込みます。CSVファイルへのデータの書き込みは一瞬ですが、返却用答案画像への書き込みには少し時間がかかります。したがって、この書き込み処理の最中にプログラムが落ちると、確かに採点した(採点データを保存したCSVファイルが存在する)のに、採点結果が正しく書き込まれていない答案画像が出来てしまうといった現象が起こります(過去1回だけ、この現象を確認しました)。このような場合には、それを発見した時点で採点済みのデータを読み込んで、再度(画像への)「書き込み」処理を実行すれば不具合を解消できます。

変換が終了すると、そのことを知らせるメッセージが表示されます。メッセージのOKをクリックすると注意のメッセージが表示されます。この注意のメッセージを確認した後、「終了」ボタンをクリックして、画像変換処理を終了してください。

終了をクリックして、この窓を閉じます。

メッセージの「OK」をクリックすると表示されるメッセージです。

画像のリサイズを行った場合は、その際設定した縮小率を試験で使用した解答用紙の残部などに必ずメモしてください。複数クラスで様式の異なる解答用紙を使って試験を行い、それぞれに74%、87%など細かな値を指定した場合は2日も経てばかなりの確率でその値を忘れます。この値を忘れた場合には、採点設定作業をすべてやり直すことになります。十分注意してください。

もくじへ戻る

(5)解答欄の座標を取得

次に解答欄の座標を取得します。その際、重大な注意事項があります。

重要 実際に試験で使用した解答用紙の画像を使用する

わるい例:
・輪転機で大量に印刷した解答用紙でなく、PCからプリンターに出力した解答用紙を使用

上のわるい例のように、実際に試験で使用した解答用紙とは異なる印刷環境で作成した解答用紙は、解答欄座標の取得には使用しないでください。見た目はほとんど同じでも、ほんのわずかな印刷位置のずれが採点作業のすべてに悪影響を及ぼします。この点には、どうか十分にご注意願います。

最初に開発したバージョンでは、拙作マークシートリーダーと同じように解答用紙に座標原点とするマーカー画像を設け、OpenCVのテンプレートマッチングの機能を利用して、マーカー画像からの距離で解答欄の座標を記録し、解答欄矩形の選択に利用していましたが、解答欄矩形を自動的に認識する方法を学んでからは、マーカー画像を利用し、手動で一つ一つ解答欄矩形を指定するよりも、解答欄矩形を自動認識して採点対象とする矩形の座標データのみを取捨選択して保存した方が、実際の採点に入るまでの準備作業時間を大幅に短縮できることがわかりました。また、輪転機を使用して印刷した解答用紙自体に解答欄の印刷位置のずれはほとんど生じないことも、マーカー画像を利用した解答欄座標の取得から、解答欄矩形を自動認識する方向へ設計を変更する大きな要因となりました。

以上の理由からご理解いただけると思うのですが、この手書き答案採点補助プログラムで使用する解答用紙は「解答欄の印刷位置がすべて揃っているもの」でなければなりません。

前置きが長くなりましたが、その具体的な方法は次の通りです。

最初に画面右上の「採点作業」ボタンをクリックしてください。


以前に使用した採点設定ファイルが見当たらない場合は、次のメッセージが表示されます。

よく読んで、OKをクリックしてください。


以前に使用した採点設定ファイルがある場合は、次のメッセージが表示されます。


使用する採点作業の入力欄に下の例のように入力します。

例:R06_考査①_物理基礎

前の方が見えませんが・・・

重要 採点作業の名称にはクラス名を入れないでください。

同じ採点作業の設定を複数クラスに適用する際、採点作業名に特定のクラスの名称が入っていると、なんとなく違和感を感じませんか?(僕は違和感を感じました)

このプログラムでは、(同一問題で実施した)試験の答案をクラス・講座毎のフォルダに準備して、同じ(一つの)採点設定をそれぞれのクラス・講座に適用して採点します。したがって、採点作業の名称には「クラス名を入れない」ことが望ましいわけです。※ クラス名が入っていても採点作業に使えないわけではありません。

採点作業名を付けたら、入力欄の右側にある「Auto」ボタンをクリックしてください。

ほんとうは「解答欄矩形の自動選択」のような名称にしたかったのですが、スペースが・・・


次のメッセージが表示されます。よく読んでOKをクリックしてください。

AC_Readerとは別に、解答欄矩形を見分けて自動選択するプログラムが起動します。このプログラムもObject Pascal に埋め込んだ Python Script で Python 用の OpenCV の機能を利用して動作します。

重要 RectangleDetector.exeを直接起動しないでください

重要 矩形検出機能はAC_Readerから呼び出して使ってください

解答欄矩形を認識するプログラムの名称は「Rectangle Detector(長方形検出器)」です。最初に画面左下にある「画像選択」ボタンをクリックしてください。


ここではフォルダではなく、「ファイルを選択」するダイアログボックスが表示されます。どれでもよいのですが、欠席者がいる場合は、解答欄に何も書き込まれていない欠席者分の解答用紙の画像を選択した方が、誤検出は明らかに減ると思います。ファイルを選択したら「開く」ボタンをクリックしてください。

重要 ここではフォルダではなく、ファイルを選択します。

重要 実際の試験で使用した解答用紙の画像で作業します。

練習では、添付したSampleフォルダ内のファイルを選択してください

解答用紙の画像が表示されます。上下のスクロールバーを操作して、図のように解答用紙の解答欄の直線部分とRectangleDetectorの画面枠の二つを見比べやすい位置に画像を上下に動かして、解答用紙が大きく傾いていないことを確認します。

スキャナーによっては、その機材特有の「クセ」のようなものがあり、どれほどきちんと解答用紙をセットしても必ず0.3~0.4°くらい読み取った画像が傾いてしまう場合があります。サービスマンの方に相談したところ、「答案に付着した消しゴムの屑がローラー等に詰まって、読み取り結果に悪影響を及ぼしているのではないか?」との意見をいただき、実際、スキャナーの可動部をきれいに清掃して試したところ、読み取り結果が改善された経験があります。しかし、その後、またすぐにその機材で読み取った画像は同じ方向に傾くようになりましたので、毎回クリーニングする必要があるのかもしれません。ただ、可動部をクリーニングしなくても、ほとんど傾かずに読み取ることもあり、結局、「これは運だ!」と割り切って、プログラム側で傾きがあった場合は修正できるよう、傾き補正の機能を追加しました。

傾き補正の機能を追加する際に気づいたのですが、回転させた画像をさらに回転させると、画像の質が著しく劣化し、これを繰り返すほどに全体がぼやけて、解答の読み取りに支障をきたす恐れがあるように感じました。そこで、画像の初期状態を保存しておき、回転は必ず初期状態のものに対して行うようプログラミングしました。「なぜ、少しずつ連続して回転させることができないのだろう?」と疑問に思われる方もいらっしゃるかもしれませんが、これがその疑問への回答です。

赤線部分を見比べて、画像の回転の要/不要を判断します。


上の画像のような状態であれば、傾きの補正は必要ありません。オプションボタンは「実行」をクリックして選択してください。また、あまりにも小さな矩形は「解答欄ではない」と判断できるよう、矩形の面積閾値を設定してあります。こちらはデフォルト設定700のままでお試しください。

傾きの修正が必要な場合は「試行」を選択し、修正量を確認してください。
修正量を確認後、その値で傾きの補正を「実行」してください。
(「試行」を選択した場合は、最終的なデータの保存ができません)


続けて答案の「横書き・縦書き」を指定します。Sampleは横書き答案ですので、オプションボタンは「横書き」をクリックして選択してください。


ブロックというのは(表現に苦しんだのですが)、「解答欄の集合をブロックとして見分けられるか・どうか」という意味です。下の図のような解答用紙の場合、1ブロックと表現しています。


ちなみに、次のような場合が2ブロックです。ご理解いただけましたでしょうか?


傾きの修正が必要な場合は、次のGUIで操作してください。「傾き修正」に✅を入れて、▲は修正値を増やす(回転方向は時計回り)、▼は修正値を減らす(回転方向は反時計回り)、「適用」は回転の実行、「やり直し」は画像を初期状態に戻します。


解答欄を取得する準備が整ったら、「解答欄取得」ボタンをクリックしてください。


誠に心苦しいのですが、PCによっては初回実行時、Python Engineの初期化に異常に時間がかかることがあります(職場のPCでは4分程度)。自分のPC(Panasonic製 Let’s note CF-QV)では数秒で終了する処理がなんでPCによってはとんでもない時間を要する処理になるのか? その理由は未だにわかりません。

とにかく、マウスカーソルが砂時計?表示になっていればプログラムは正常に機能していると思われますので、5分程度お待ちください。いったんPython Engineの初期化に成功すれば、プログラムを終了しない限り、2回目以降の実行は何の問題もなく、ほんの数秒で解答欄座標の取得が完了するはずです。

【追記_20250826】

初回起動時に待機状態が長く続く原因が判明しました!
原因はアンチウイルスソフトの未知のDLLスキャンでした。このことについての詳しい解説は次のリンク先の記事をご参照ください。

参考 横書き答案の場合、解答欄矩形の座標はx軸方向については左から右へ、Y軸方向については上から下へという順番で読み取ります。

参考 縦書き答案の場合、解答欄矩形の座標はx軸方向については右から左へ、Y軸方向については上から下へという順番で読み取ります。

ただし、解答用紙の画像が右肩上がりに傾いていた場合、Y軸(上下)方向の座標の上下関係から、より値の小さな(座標原点0,0は解答用紙画像の左上であるため)上の方をプログラムは先に読み取ってしまいます。そのため、横書き答案であっても解答欄矩形の読み取り順が右から左になる現象が発生します。こうなると解答欄矩形の座標の選択作業が著しく煩雑になってしまいます(解答欄矩形の座標自体は読み取れていますから作業ができないわけではありません)。これを防止するために、最初に答案画像の全てに対し、傾きの修正を行う必要があります。

解答欄座標の取得が完了すると、次の図にあるように解答用紙上に赤い矩形が描画されます。小さくてわかりづらいかもしれませんが、画面右上の解答欄座標の値が表示されている部分で、カーソルがある(カーソルが点滅している位置の)解答欄座標が赤の矩形で示されています。ここから必要な座標と、いらない座標を取捨選択する作業を行ってください。


上の図で示されている矩形(座標)は採点には不要です。このまま無視して次へ進んでも構いませんし、面倒でなければ不要な座標は削除することもできます。


「編集」ボタンをクリックすると、キャプションが「編集中」に変わり、カーソル位置の座標が選択された状態になります。DELキーを押し下げして、不要な座標を削除します。

次の図は(削除作業を行わずに)上の図の状態から↓矢印キーを1回押し下げして、カーソルを2行目に移動させた状態を表しています。不要な解答欄座標の削除作業を行った場合は、自動的にこの状態になります(1行目にあった不要な座標は当然消えています)。

カーソルを下の行へ移動させて、解答欄矩形のみを選択(移動)して行きます。


2行目の座標が示す矩形はまさに解答欄ですから、これは必要な座標ということになります。このような座標は「移動」ボタンをクリックして、必要な座標ばかり集めたメモの方へ移動させます。次の図は2行目の座標を移動させた直後の状態です。

必要な解答欄座標のみを選択します。

下向きの矢印キーを押す。必要な座標であれば「移動」ボタンで下のメモに移動する。この作業を繰り返して採点する順番になるよう、解答欄の座標をすべて取得します。次の図は一通り、解答欄の座標を取得した状態です。


続いて正しく解答欄座標が取得できていることを確認します。上の図の移動済み解答欄座標が表示されているメモ(赤枠内)の先頭の座標データをクリックしてください。メモは必要であれば上にスクロールしてください。メモの先頭の座標データをクリックしたら、答案の画像も上にスクロールしてください。画面は、次の図のようになります。

メモ内のフォーカスがある座標データに該当する矩形が赤枠で示されています。


このまま、下向きの矢印キーを次々に押し下げして、赤枠で示される解答欄矩形が必要数あるか・どうか、及び、採点順に並んでいるか・どうかを確認して行きます。

もくじへ戻る

【座標データを追加したい場合は?】

様々な事情から、座標データを後から追加・変更したい場合もあるかと思います。例えば、次の図のように青枠で囲った解答欄AとBを抱き合わせて採点(両方正解で〇等)したい場合です。

青枠部分を抱き合わせて採点したい場合も当然あるかと思います。


このような場合は、該当の座標データの「末尾」にフォーカスした状態で(=座標データの末尾にカーソルを置いて)、「移動」ボタンの隣にある「追加」ボタンをクリックし、さらにEnterキーを1回押し下げして改行します。次の図は、その状態を示します。

「追加」ボタンのキャプションは「追加中」に変わります。


次に、画面の真ん中よりやや右にある追加ボタンをクリックします。


答案画像の上に赤枠の矩形が表示されます。この矩形を新しく解答欄座標を取得したい解答欄に重なるように移動・変形してください。矩形を移動させたい時は、矩形の上の横線中央よりやや右の位置をポイント(マウスのカーソルを載せる)すると、マウスカーソルが上下左右の白い矢印に変わり、ドラッグアンドドロップできる状態になります。

任意の座標を取得可能です。


抱き合わせて採点したい解答欄を矩形で囲んだら(下の図のような状態)、キャプションが「取得」に変わったボタンをクリックします。すると、ボタンの右側に、現在表示されている矩形の座標が表示されます。同時に、この矩形データはクリップボードにも送信されています。


続けて、右側のメモ内の先ほど改行して空行になっている箇所をクリックしてCtrlキーを押しながらVキーを押す(右クリックして表示されるサブメニューから「貼り付け」を選択)等して、取得した座標データを付け加えます。正しくメモに追加できたら、メモの上の「追加中」ボタンをクリックして、キャプションを「追加」に戻します。

上下の矢印キーを押して、解答欄Aの座標を探し、「追加」ボタンをクリックして、メモを編集可能な状態に変更、データを削除します。削除後、編集が終了したことをPCに伝えるため、「追加中」ボタンをクリックして「追加」に切り替えます。

解答欄Bの座標も、解答欄Aと同様に作業してメモから消去します。

注意 「追加中」状態で作業しないとエラーが発生します!

もくじへ戻る

【字数制限のある解答欄座標の簡単な取得方法は?】

例えば、次のような多数の細かい枠で構成された字数制限のある解答欄がある場合、このまま矩形座標の自動取得処理を実行すると一つ一つのマス目の座標をもれなく取得・表示してしまいます。

解答欄を構成する枠がすべて実線の場合、解答欄座標の取得が煩雑になります。


このような場合は、解答欄を作成する段階で、外枠のみ実線で描き、内部の枠はすべて「点線」で描くようにします。点線は、色が薄く、間隔の狭い、細い点線でなく、次の図に示すように、色が濃く、間隔が広い、太い点線を使用してください。

解答欄内部の枠を「点線」で描くとプログラムは外側の枠のみを解答欄座標として認識します。


実は、最初の段階からこの「字数制限のある解答欄の認識処理をどうするか?」という問題は大変気になっていたのですが、親しい国語の教員が作成した解答用紙をスキャンして、解答欄の座標を自動取得する作業を手伝った際、解答用紙の点線部分をプログラムが認識しないことを偶然発見、大喜びしたというのが本当です。最初から、僕に、そのような知識があったわけではありません。

偶然とは言え、僕の不出来なプログラムの動作を信じて、それでも使いたいと言ってくれた彼女に、心から、ほんとうに、こころから、「ありがとう」です。巡り合ってから、もう、30年になりますが、Sさん、ほんとうに、ありがとう! あなたがいてくれて、ほんとうに、よかった!!

ただし、これは「諸刃の剣」で、何らかの原因で解答欄の枠線の一部が途切れていると、プログラムは正直にその部分は「矩形ではない」と判断して、座標データの取得対象から除外します。ですので、解答用紙を印刷する際は、解答欄が完全に実線で囲まれているか・どうかを、よく確認してから印刷する必要があります。

解答欄の枠線の一部が途切れていると座標を取得できません!

もくじへ戻る

【機械が認識しやすい解答欄】

解答欄を構成する矩形は必要最小限度に留めるのが、解答欄座標を自動認識・取得する作業を効率よく進めるための何よりのポイントです。

解答欄を構成する矩形は必要最小限にしてください。

もくじへ戻る

【生徒の番号・氏名も解答横に表示して採点したい】

重要 横書き答案の採点時のみに利用できる機能です。

こちらは同僚からの要望があって付け加えた機能です。解答用紙の氏名欄の画像を取得して、採点時に該当生徒の解答欄の横(位置の指定も可能)に、試験を受けた生徒の出席番号や氏名を表示できます。「追加」ボタンをクリックして赤枠の矩形を描画・適切な位置へ移動後、解答欄矩形としての「取得」の代わりに、「氏名欄取得」のボタンをクリックして、次の図に示すようなかたちで解答用紙の氏名欄の座標を取得してください。ただし、指定する矩形の高さは、解答用紙の解答欄の高さの最小値を超えないよう、十分注意してください。

重要 「解答欄の高さの最小値を超えない高さ」で範囲指定してください。

座標が空欄でなければ、氏名情報ありとして保存されます。


最後に、取得した解答欄の座標を保存して作業は終了です。画面右にある「保存」ボタンをクリックしてください。


次の確認メッセージが表示されます。

「はい」をクリックして、解答欄座標を保存します。


採点作業名として設定した名称で、イニシャライズファイルが作成されています。この採点作業名をクリックするとダイアログの下のファイル名が採点作業の名称に変化します。この状態で「保存」ボタンをクリックしてください。

採点作業名を設定した際にiniファイルも作成されています。
解答用紙の種類に合致するファイルをクリックして選択・上書き保存します。


次のメッセージが表示されます。「はい」をクリックしてください。

既存のiniファイルに上書きします。


解答欄の数によっては、少し(数秒程度)時間が必要です。保存作業が完了すると次のメッセージが表示されます。このメッセージが表示されるまで、何もしないでそのままお待ちください。


画面右下隅にある「閉じる」ボタンをクリックしてプログラムを終了します。解答欄矩形の座標の候補を表示する上のメモにデータがある場合は、「閉じる」をクリックすると、次の確認メッセージが表示されます。「はい」をクリックしてプログラムを終了させてください。


以上で、解答欄の座標の取得作業は完了です。

【追記_20250825】

上で紹介した矩形検出プログラムを全面的に改良しました。気が付いた(気になっていた)不具合は全て改善できたと思います。不具合の改善他、改良された矩形検出プログラムの詳細は、次のリンク先記事をご参照ください。

この Blog でご紹介したデジタル採点プログラムの最新版を1つにまとめた zip ファイルを次のリンク先からダウンロードできます。サポートなし・完全自己責任でという使用条件ですが、もちろん無料でお使いいただけます。

もくじへ戻る

(6)採点

解答欄座標取得後、すぐに採点を実施する場合は、タスクバーにAC_Readerが眠っていますので、クリックして起こしてください。そうでない場合は、AC_Readerを起動してください。

解答欄矩形取得直後、AC_Readerはタスクバーに眠っています。
タスクバーにある上のアイコンをクリックしてください。
AC_Readerが目覚めます!


画面の右上にある「採点作業」ボタンをクリックしてください。


次のメッセージが表示されます。既存の採点設定を利用して採点しますので「はい」をクリックしてください。


バルーン型のヒントが表示されます。V マークをクリックして表示される選択肢から採点設定ファイルを選んでください。


採点設定ファイルを選んだ直後の状態です。


画面中央には、次のメッセージが表示されます。OKをクリックするとフォルダの選択ダイアログが表示されます。


採点したいクラスのフォルダを選択してOKをクリックしてください。

採点したいクラスのフォルダを選択して、OKをクリックします。


採点結果を記録したCSVファイル(場所はユーザーに提示しません)がない場合には、次のメッセージが表示されます。


画面は次のようになります。

個人識別情報が保存されているので、番号や氏名も表示されています。


画面上方、中央よりやや右に、どこにもドッキングしないフローティング状態の必要最小限の採点機能をまとめたパネルがあります。このパネルのタイトルバーの部分を左クリックしてドラッグ&ドロップすると任意の位置へ移動できます。採点しやすい位置へ移動してお使いください。

もくじへ戻る

【全員正解を入力】

解答をざっと見て、過半数が正解であるような場合は、全員に正解を入力し、後から不正解の解答のみチェックして、採点を × に変更します。

この設問の得点は2点として、全員に2点を入力します。


ComboBoxの選択肢に「2」を指定して、「入力」ボタンを

採点記号の位置や大きさは「設定」から変更できます。


設定画面から、採点記号の表示位置や大きさなど、各種設定を変更・保存できます。

何も変更せず、デフォルト設定のまま、みなさんお使いのようです。

もくじへ戻る

【全員不正解を入力】

フローティングパネルの得点欄に0を設定して、入力をクリックすれば、全員不正解となります。

0(ゼロ)は〇(まる)と見間違える可能性があるため、
デフォルト設定では、不正解の場合、得点0を表示しません。

もくじへ戻る

【個別に採点】

重要 左手で入力作業、右手は選択作業(クリックに専念)

・正解 〇 を入力

まず、個別に採点する際の正解入力は、次のように行います。

解答欄の中心付近をクリックして、得点に相当する数字キーを押します。


解答欄に採点記号〇と得点が描画されます。

・不正解 × を入力

不正解を入力する場合は、次のように操作してください。

× は「Batsu」だから「B」キーに割り当てました。


もちろん、数字キーの0(ゼロ)でも × を入力できます。ただ、0はちょっと位置が遠い・・・

・部分点あり △ を入力

部分点ありの場合は、採点記号△と部分点を入力します。方法は、次の通りです。

「部分点あり」のフラグは「-」記号の有無です。
プログラムは負の数の入力を部分点ありと判定しています。
(合計点は絶対値で計算するので、問題ありません)
部分点ありの場合、採点記号△と得点を表示

重要 最後に「書込」を忘れずにクリックします。

もくじへ戻る

【次の設問を採点】

右向きの三角マークをクリックすると、次の設問の解答欄が表示されます。

上で解説した手順で、採点を行います。

右側の操作パネルからも同じ操作を実行することができます。

もくじへ戻る

【定型文を入力】

記述式の設問等で「ここまで何点」のような定型文を記録しておいて適宜入力できます。

「設定」をクリックして、「入力定型文の編集」にチェックを入れます。


画面左上に次の表示が出ますので、内容を編集します。「記録」ボタンをクリックすると編集内容が保存されます。保存後、「入力定型文の編集」のチェックを外し、編集欄を非表示にします。


定型文を入力したい設問の解答欄を採点します。採点後、定型文を入力したい箇所の左上隅あたりにマウスのカーソルを持ってきて右クリックします。表示されるサブメニューから「定型文入力」を選択(クリック)してください。

重要 採点しないと定型文入力はできません!

「定型文入力」をクリックします。


編集済みの定型文が指定位置に入力されます。

もくじへ戻る

【入力した定型文の削除・消去方法】

入力済みの定型文を削除・消去するには、まず、定型文を削除・消去したい解答欄の真ん中付近をクリックします。次に、右側のGridコントロールの青く反転表示された数値を消去して、Enterキーを押してください。

もくじへ戻る

(7)採点状況の確認

現在の採点状況を、解答用紙全体の画像を表示して確認することができます。次のように操作してください。

画面右側の中ほどにある「返却答案を表示」をクリックします。画面は現在選択されている生徒の解答用紙が表示されます。画面をスクロールして、採点状況を確認してください。


移動のボタンで、別の生徒の答案も確認することができます。

左のボタンで「一枚前へ」、右のボタンで「次へ」移動します。

もくじへ戻る

(8)返却用答案の印刷

採点が終了したら、返却用の答案を印刷します。まず、画面右下のプリンタの選択肢から、出力先のプリンタを選択します。次に「合計の印刷」の有無を指定します。「有」を選択した場合は、次の案内が表示されます。


印刷は採点終了後、最後に実行するので、採点と印刷の処理をお互いに行ったり来たりすることは「ない」と判断し、印刷実行後はプログラムの終了のみ可能となっています。

「いいえ」をクリックした場合は、採点処理が継続されます。「はい」をクリックした場合は、次の案内が表示されます。

出力するプリンタの確認です。


「はい」を選択すると、次に合計点の印刷処理の案内が表示されます。


フォントサイズは、40~50程度が適切な場合が多いように思います。半角の数字で入力してOKをクリックしてください。


OKをクリックすると、次の案内が表示されます。


OKをクリックして、合計点印刷位置を指定します。


クリックした瞬間に自動計算された合計点が指定位置に表示され、次のメッセージが表示されます。


よろしければ「はい」を、位置の指定をやり直す場合は「いいえ」をクリックします。「いいえ」をクリックした場合は、再度、合計点を印刷する位置の指定をやり直してください。その際、前回に指定した位置にゴーストというか、残像のようなものが残りますが、実際の印刷時にはゴースト・残像は印刷されません。

「はい」をクリックした場合は、次のメッセージが表示されます。


画面右下の「印刷」ボタンをクリックしてください。

バルーンヒントが案内します。


「印刷」をクリックすると、次のメッセージが表示されます。


OKをクリックすると、プリンタの設定画面が表示されます。この画面はお使いのプリンタにより異なりますが、重要なチェックポイントは次の3点です。

重要 印刷する用紙がA4版であることを確認する

重要 印刷用紙の縦・横指定を答案に合わせて指定する

重要 両面印刷は必ずOFFに設定する

設定画面を閉じると、次のメッセージが表示されます。


「はい」をクリックした場合は、全員分の返却用答案がプリンタへ出力され、次のメッセージが表示されます。


「いいえ」をクリックした場合は、次のインプットボックスが表示されます。

答案の通し番号を入力してOKをクリックしてください。
採点対象がクラスであれば、出席番号となります。


OKをクリックするとプリンタへ印刷データを送信後、次のメッセージが表示されます。


「はい」をクリックすると、再びインプットボックスが表示され、引き続き単票の印刷処理が継続して行われます。「いいえ」をクリックした場合は印刷処理を終了します。画面右下の「終了」ボタンをクリックして、プログラムを終了してください。その際、次の案内が表示されます。

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

もくじへ戻る

(9)成績一覧表の作成・印刷

画面右にある「成績一覧表を作成」の「Excelを使わずに作成します!」をクリックします。


画面は成績一覧表作成モードになります。クラス単位の採点である場合は、学年・クラスを指定(選択)します。

重要 予めsNameフォルダに生徒氏名データを用意しておきます。

重要 講座単位の処理の場合も、講座名等で氏名データを準備しておきます。

重要 氏名データの並び順は、答案の並び順と一致させてください。

クラスを指定する場合は、直接入力してください。


講座を指定する場合は、学年・組は「空欄」のまま、「観点区分入力」に進んでください。

設問毎に「知識・技能」は1、「思考・判断・表現」は2を入力します。


観点別評価の区分を入力後、「保存」をクリックしてください。

保存後、「採点結果表示」をクリックして、採点結果の一覧を表示します。

氏名データは架空のもので、得点はダミーデータです。


学年・組を「空欄」で処理していた場合は、ここで「講座等」の名票を選択します。

氏名データは架空のもので、得点はダミーデータです。


次に、合計点が0の生徒について、欠席者であるか(平均点の計算から除きます)・真に0点であるのかを指定する処理を行います。「欠席者を除外」をチェックしてください。


合計点が0の生徒がいる場合は、次のメッセージが表示されます。

試験を欠席していた場合は「はい」を、0点であった場合は「いいえ」をクリックします。
(ここでは「はい」で処理します)


「再計算」ボタンをクリックして、平均点他の再計算を実行します。


プレビューをチェックして、印刷プレビューを表示します。


プレビューをチェックすると、印刷プレビューとともに、次のメッセージが表示されます。

印刷プレビュー画面(氏名データは架空のもので、得点はダミーデータです)


表示されるメッセージ。


プレビューのチェックを外すと、次のバルーンヒントが印刷ボタンを案内します。


「印刷」ボタンをクリックすると、印刷設定のダイアログが表示されます(ダイアログはプリンタにより異なります)。成績一覧表はデフォルトで「A4・縦置き」印刷に設定されます(この設定を変更することはできません)。


OKをクリックすると、印刷データがプリンタへ送信されます。送信が完了すると、次のメッセージが表示されます。


なお、これとは別に、このプログラム用に作成したExcel Book(添付したマクロ有効テンプレートのコピー)へ採点結果を出力し、成績一覧表及び個人成績票を作成する機能もこのプログラムにはありますが、これに関する説明はまた後日、このblogに掲載できたら・・・とも、考えています。が、ほとんど!!どなたにもお読みいただけないであろうMy blogですので、もしかしたらそれは、はるか未来の話になるかもしれません。

ただ、PCの操作及びExcel Bookの扱いに慣れた方なら、このプログラムに添付したマニュアル(以前のバージョンのものなので画面や内容が現行バージョンと若干異なります)と、マクロ有効のExcel Bookの式とマクロをご覧いただければ、操作方法並びに機能の概要はおわかりいただけるのではないかと考えます。

このExcel Bookに対する出力機能は、(ここに掲載した)成績一覧表を独自に作成する機能をこのプログラムに追加する以前に作成し、実際の試験の採点で何回も活用済みのものですが、こちらも動作保証等は一切ありません。もし、お使いになる場合は自己責任でお願いいたします。

以上で、成績一覧表の印刷は終了です。

もくじへ戻る

2.まとめ

今回、掲載した手書き答案採点補助プログラム(新教育課程観点別評価「知識・技能」及び「思考・判断・表現」の評価に対応)の概要は以下の通りです。

【出来ること】

(1)スキャナーで読み取った答案画像から設問ごとに解答欄を抽出して一括採点。
   ※ 答案画像からの解答欄座標の取得は矩形認識プログラムで(半)自動実行。
(2)解答欄画像の隣に受験者氏名等を表示(予め氏名欄等の読み取り設定が必要です)。
(3)記述式の解答に対する定型文コメントの入力。
(4)採点結果を出力した返却用答案画像の作成と印刷(A4版限定・縦横指定は可能)。
   ※ 得点合計を自動計算、返却用答案の指定位置に印刷可。
   ※ B4やA3の答案画像は、A4サイズに縮小して印刷します。
(5)表計算ソフトを使わずに、成績一覧表(教科担任用)を作成。
(6)成績一覧表データをCSVファイルに出力(観点別評価のうち、2観点の評価に対応)。
(7)拙作マークシートリーダーを利用した試験との併用も可。
   ※ マークシートの読み取りプログラム一式も同梱しています。
(8)PDF化した答案画像をJpeg画像化して採点(添付のPdf2Jpg.exeを使用)。

【出来ないこと】

機械学習による手書き文字の認識にも過去にチャレンジ(〇・× 及びカタカナのアイウエオを判定)したことがあるのですが、どう頑張っても認識率が100%にならない(控えめな表現で9割程度は正しく認識するのですが、解答欄からはみ出した文字や、それは「ア」でなく「つ」と「ノ」でしょ!みたいな文字を構成する部品が極端に離れている字?や、大きく傾いた文字は正しく認識できない)ので、残念ですが、この機能は搭載を見送りました。

〇×記号やカタカナ一文字の認識結果を目視でイチイチ確認するのはどう考えても二度手間です。現時点では、ヒトが行った採点結果を機械にチェックさせる方向で活用した方がいいかもしれません。学習モデルの作成については、Pythonを利用した事例がWeb上に読み切れないほど存在しますが、(僕が実験した範囲では)それらよりMicrosoftのLobeで作成した学習モデルの方が高い認識率を示しました。このことについては当blogの過去記事でその例を幾つか紹介しています。ここで紹介した採点補助プログラムには搭載を見送った自動採点機能ですが、僕の実験結果が何かの参考になれば幸いです。

もくじへ戻る

3.お願いとお断り

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

もくじへ戻る

範囲チェックエラーが出た時は?

{$R-}で範囲チェックさせない!

Delphiで、画像をグレースケール変換するプログラムを作成。実行すると、

表示されたエラーメッセージ

プログラムのコードは、次の通り。
Image1に表示した画像をグレースケールに変換してImage2に表示するというモノ。

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.ExtCtrls, Jpeg,
  Vcl.ComCtrls;

type
  TForm1 = class(TForm)
    Image1: TImage;
    Image2: TImage;
    Button1: TButton;
    StatusBar1: TStatusBar;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function CreateGrayScalePalette(Tone:Byte): HPALETTE;
var
  Palette: ^TLogPalette;
  i: Integer;
begin
  GetMem(Palette, SizeOf(TLogPalette) + SizeOf(TPaletteEntry) * Tone );
  Palette^.palNumEntries:=Tone+1;
  Palette^.palVersion:=$0300;
  for i := 0 to Tone - 1 do begin
    Palette^.palPalEntry[i].peRed:= Tone - i;
    Palette^.palPalEntry[i].peGreen:= Tone - i;
    Palette^.palPalEntry[i].peBlue:= Tone - i;
    Palette^.palPalEntry[i].peFlags:= 0;
  end;
  Result:=CreatePalette(Palette^);
  FreeMem(Palette);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  X, Y: Integer;
  Bmp: TBitmap;
  P: PByte;
begin
  Bmp := TBitmap.Create;
  try
   Bmp.Assign(Image1.Picture.Bitmap);
   Bmp.PixelFormat := pf8bit;
   Bmp.Palette := CreateGrayScalePalette(255);
   Image2.Picture.Bitmap := Bmp;
  finally
   Bmp.Free;
  end;
  Image2.Width:=Image2.Picture.Bitmap.Width;
  Image2.Height:=Image2.Picture.Bitmap.Height;
  Image2.Visible:=True;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  jpg: TJPEGImage;
begin
  StatusBar1.SimplePanel:=true;
  // TJPEGImageオブジェクトをインスタンス化
  jpg := TJPEGImage.Create;
  try
    // Jpegファイル読み込み
    jpg.LoadFromFile('Image.jpg');
    // Image1に割り当てる
    Image1.Picture.Bitmap.Assign(jpg);
    Image1.Width:=Image1.Picture.Bitmap.Width;
    Image1.Height:=Image1.Picture.Bitmap.Height;
    //StatusBar1.SimpleText:=IntToStr(Image1.Width)+'/'+IntToStr(Image1.Height);
  finally
    // TJPEGImageオブジェクトを破棄
    jpg.Free;
  end;
end;

end.

グレースケール変換実行のボタン(Button1)をクリックすると・・・
このButton1Click手続き内で呼び出しているCreateGrayScalePalette関数でエラーが発生。

ブレークして確認すると、エラーになるのはココ。

でも、なんでエラーになるのか、わからない・・・

Google先生に訊くと、次のような情報を発見。

[Delphi?][ネタ]透明に見えるパターンを描く

https://qiita.com/pik/items/25276e49fb131425db07

早速、範囲チェックさせないコンパイラ指令 {$R-} を追加。

ナニがどうして、そうなるのか?
原因も、理由も、皆目わからないけれど・・・

範囲チェックエラーは出なくなりました!

範囲チェックを実行しないというコンパイラ指令 {$R-} は知りませんでした。
同じ理由で困ってる方もいるかもしれないと思い、記録だけUpしました。

なお、画像のグレースケール化にあたっては、次のWebサイト様にあった情報を使わせていただきました。24bitのフルカラー画像を256階調のモノクロ画像に変換(グレースケール変換)する処理を行う際に役立つ情報が、そのアルゴリズムも含めて、多数紹介されています。

カラー画像をモノクロ画像に変換

http://rakasaka.fc2web.com/delphi/grayscale.html

また、上のWebサイト様で紹介されている配列要素を動的に確保する必要のない、Delphiが独自に定義しているTMaxLogPalette構造体を使用したCreateGrayScalePalette関数を利用した場合は、範囲チェックエラーは発生しませんでした。

お願いとお断り

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

Rectangle Detector

矩形検出器

手書き答案をスキャナーで画像化して採点するソフトを書いた。概ね、思った通りにカタチになったが、解答欄の位置座標を取得するのに、解答欄の数だけ、その左上隅から右下隅へマウスでドラッグする作業を繰り返さなくてはならない。(もし、これが自動化できたら・・・) そう思って書いたのが、このプログラム。

1.矩形の検出方法
2.字数制限のある解答欄の作り方
3.GUIはDelphiで作成
4.矩形検出器の使い方
5.まとめ
6.お願いとお断り

1.矩形の検出方法

キーワードを『矩形 検出』にしてGoogle先生にお伺いをたてると、思った通りOpenCVを活用する方法がいくつもヒットする。しかも、そのほとんどすべてがPythonでの活用方法だ。Delphi用のOpenCVもあるようだけれど、次の理由から矩形の検出はPython用のOpenCVで行うことにした。

Pythonを使う利点は、まず、何と言っても、情報が豊富なことだ。マイ・プログラミング環境では、わからないことはすべてGoogle先生に教えてもらうしかないので、情報が入手しやすいことは、他のすべてに優先する。

(メインの開発環境がDelphiなのは、上記の内容と大いに矛盾しますが・・・)

さらに、手書き答案の採点ソフトより前に、マークシートリーダーを作った時、マーク欄の座標を得るために、やはりPythonとOpenCVのお世話になった。マークシートリーダーも、手書き答案の採点ソフトも、embeddable pythonに入れたOpenCVと一緒のフォルダに詰め込んでユーザーに配布しているから、Pythonを内包して使う環境は既に完成済み。PythonのスクリプトをDelphiのコードに埋め込んで、PythonForDelphiを使って実行する方法は勉強済みだから安心。Delphi用のOpenCVは、情報も少ないし、何よりその使い方がわからない・・・。

他人様に使っていただくプログラムはDelphiで書くけれど、自分専用のToolはPython環境を利用して作ることが多い。ちょっと特別なことをしたい時、Pythonはとても便利だ。いろいろ紆余曲折はあったけれど、現在はSDカードにWinPythonとAtomエディタを入れて持ち運べるPython環境を作っている。

そのSDカードに入れたPython環境で、いつものようにAtomを起動し、Web上にあったいくつものScriptをコピペして試してみる。

まず、OpenCVで「ハフ変換」なるものを利用する例だが、ハフ変換はノイズの除去で苦労しそうだ。ノイズの発生源が多数存在する解答用紙の矩形検出でパラメータを適切に設定することが果たしてできるだろうか? 経験がない自分にはちょっと厳しそうだ。

次に、LSD(Line Segment Detectorの略とのこと)という直線検出器を試した。試した瞬間、(もう、これしかない!)と思うほど、これは凄かった。使い方も超カンタンで、LSDをこれでもか!とばかりに並べるだけ。

from pylsd.lsd import lsd
Mylines = lsd(picture)

【検出結果】

LSDで検出できた矩形の例

さらに驚くべきことに、こういう作業には付き物の引数も一切ない。つまり、パラメータを調整する必要など『ない』ということなのだろう・・・。ただ、LSDはそのライセンス形態がAGPLであると知り、使用を断念。MITやBSDでないと自分的にはやはり困る・・・。

最後に試したのが、OpenCVのfindContours関数。これを使うには前処理として、まず、画像をグレースケールに変換し、さらに白黒反転させて二値化しなければならない。

import cv2
import numpy as np
from PIL import Image

# Pillowで画像ファイルを開く(全角文字対応の確認用にファイル名は「ひらがな」)
pil_img = Image.open("./img/さんぷる.jpg")
# PillowからNumPyへ変換
img = np.array(pil_img)

# グレースケールに変換する
gray = cv2.cvtColor(img, cv2.COLOR_BGR2GRAY)

# 白黒を反転
gray = 255 - gray
# 2値化する
ret, bin_img = cv2.threshold(gray, 20, 255, cv2.THRESH_BINARY)

Pillowで画像ファイルを開いているのは、OpenCVのimread関数が日本語(全角文字)に対して拒絶反応を示すので、これを回避するため。もし、ファイル名とそこまでのPathに全角文字が含まれないという確実な保証があるなら、次のようにしてもいいようだ。これなら1行で済む。

# 8ビット1チャンネルのグレースケールとして画像を読み込む
img = cv2.imread("全角文字のないPathと画像ファイル名", cv2.IMREAD_GRAYSCALE) 

で、準備が出来たらfindContours関数を使って輪郭を検出する。

# すべての輪郭を同じ階層として取得する
contours, hierarchy = cv2.findContours(bin_img, cv2.RETR_LIST, cv2.CHAIN_APPROX_SIMPLE)

解答欄には、その性格上、小さな矩形が多く使われることが多いので、閾値以下の面積の矩形は削除する。※ 閾値は整数型の数値で指定する。

# 閾値以下の面積の矩形(小さい輪郭)は削除
contours = list(filter(lambda x: cv2.contourArea(x) > 閾値, contours))

よりスムーズに作業するためには、予め、小さな矩形を消去した機械読み取り用の解答欄(解答用紙)をヒト用の解答用紙のコピーから作成し、これを用いて解答欄座標を取得した方がよい(国語の縦書き解答用紙は、ワープロソフトではなく、表計算ソフトで作成する方法が業界では一般的らしいので、機械読み取り用の解答用紙はそれほど手間をかけなくても、カンタンに作成できる・・・はず)。

解答欄矩形をちゃんと認識できているか・どうかを確認するため、検出した輪郭を描画する。このPythonのスクリプトをDelphiのObject Pascalに埋め込んで実行する際は、ここが最大の「見せ場」になる。検出した矩形をグラブハンドル付きのラバーバンドで表示する方法は後述。

# 検出した輪郭を描画する
cv2.drawContours(img, contours, -1, color=(0, 0, 255), thickness=2)

最後に解答欄矩形の座標を取得する(これが最終的な目標)。取得した座標は、採点順になるよう、並べ替えて表示する(並べ替え方法は後述)。

# 矩形の座標を表示(左上の座標, 右下の座標)
for i in range(len(contours)):
    x, y, w, h = cv2.boundingRect(contours[i])
    print(str(x)+','+str(y)+','+str(x+w)+','+str(y+h))

数値より、画像(絵)で見た方がわかりやすいのは言うまでもない。

# 保存
cv2.imwrite('./img/lined.jpg', img)
# 画像を表示
cv2.imshow("Image", img)
# キー入力で終了
cv2.waitKey()
画像を表示して、解答欄矩形の取得状況を確認

ここまでの Python Script をまとめて示せば、次の通り。

import cv2
import numpy as np
from PIL import Image

# Pillowで画像ファイルを開く
pil_img = Image.open("./img/さんぷる.jpg")
# PillowからNumPyへ変換
img = np.array(pil_img)

# グレースケールに変換する
gray = cv2.cvtColor(img, cv2.COLOR_BGR2GRAY)
# 白黒を反転
gray = 255 - gray
# 2値化する
ret, bin_img = cv2.threshold(gray, 20, 255, cv2.THRESH_BINARY)

# すべての輪郭を同じ階層として取得する
contours, hierarchy = cv2.findContours(bin_img, cv2.RETR_LIST, cv2.CHAIN_APPROX_SIMPLE)

# 閾値以下の面積の矩形(小さい輪郭)は削除
contours = list(filter(lambda x: cv2.contourArea(x) > 数値, contours))

# 検出した輪郭を描画する
cv2.drawContours(img, contours, -1, color=(0, 0, 255), thickness=2)

# 矩形の座標を表示(左上の座標, 右下の座標)
for i in range(len(contours)):
    x, y, w, h = cv2.boundingRect(contours[i])
    print(str(x)+','+str(y)+','+str(x+w)+','+str(y+h))

# 保存
cv2.imwrite('./img/lined.jpg', img)
# 画像を表示
cv2.imshow("Image", img)
# キー入力で終了
cv2.waitKey()

OpenCVのfindContours関数を使って検出した輪郭(=解答欄の矩形)の例。
(解答用紙画像はLSDを試した時と同じものを使用)

矩形を検出しやすいように作った解答用紙なら、この結果はまさに『ブラボー!』

解答用紙中の ■ や □ を検出しないよう、検出下限の閾値を設定したこともあり、期待した通りの満足できる結果が得られた。OpenCVのハフ変換や、LSDでは日本語に対する反応が見られたが、findContours関数は(適切な閾値を設定してあげれば)日本語に反応しないようだ。

答案の「答」には「口」、問にも「口」、漢字にはたくさんの矩形が使われている。適切な閾値を設定することで、誤認識を減らせることも理想的。

【実験してみた!】

閾値を「700」として、□ に対する反応を実験して確認した。結果は次の通り。

26×26=676、28×28=784 だから・・・機械は正確に反応している

28ポイントの「□」から反応するが、40ポイントの「問」には無反応。通常使用される解答用紙であれば、フォントの大きさに制限を設ける必要性はなさそう。

もう少し細かい矩形を使った解答用紙で、閾値700で実験すると・・・

解答欄の矩形をさらに細かく分割したサンプルを作成してテスト
解答欄の番号の矩形に反応してしまう・・・

閾値1400までは・・・

解答欄の番号の矩形に反応するが

閾値を1500にすると・・・

解答欄の番号の矩形には反応しなくなる☆

少し、細かい矩形を用いた解答用紙であれば、閾値1500くらいから試せば狙った通りに解答欄の座標だけを取得することができそうだ。

閾値に上限を設定すれば、さらに良い結果を得られるかも・・・と思ったが、数学の解答用紙には他の教科ではあり得ない巨大な矩形が普通に使用される。矩形を取得できなければ、検出器とは言えない。さらに、解答欄全体を一つの大きな矩形として認識してしまうのはプログラムの性格上、絶対に回避できないから、閾値の上限は設けずに、むしろ、不要な矩形の座標を削除しやすいプログラム(GUIを作成)を書けばいいと気づく。

さらに、ユーザーが矩形座標の編集(修正)を自由にできるようにプログラムを工夫すれば、理想的な矩形検出器ができるはず。

これでDelphiでGUIを作成する際の方向性も見えてきた。

2.字数制限のある解答欄の作り方

解答欄の矩形を検出する上で、大きなハードルになるだろうと予想していたのが『字数制限が設定された解答欄』。

機械読み取り用に作成した解答用紙であっても・・・

上の解答用紙は、ヒト用の解答用紙の問題番号部分にあった小さな矩形を消去して、機械読み取り処理用に作成した解答用紙。この状態で矩形を検出(閾値1500)すると・・・

それでも削除しなければならない矩形座標が多すぎ・・・

閾値を「3100」に設定して、ようやく・・・

閾値をどんどん大きくすれば、何とかなることはわかった!

閾値を大きく設定すれば、何とかなることは上の例でわかったが、閾値を大きくすれば当然必要な解答欄の座標を取得できなくなる可能性も生じてくるわけで・・・。

ところが別の国語用解答用紙を処理している際に、閾値を気にせずに字数制限のある解答欄を作成する良い方法があることを偶然発見。それは・・・

罫線に「点線」を利用した解答用紙

字数制限を設定したり、完全解答で正解としたい解答欄は内側の罫線を点線にする!

閾値「700」で実験した結果

これなら問題2の(1)・(2)が作る大きな矩形の座標のみ削除すればOK!
点線を活用することで、一番大きな問題を難なくクリアできることが判明。
やったー☆

【embeddable Pythonのバージョンとインストールしたライブラリの一覧】

Python 3.9.9

Package Version
numpy 1.21.5
opencv-python 4.5.4.60
Pillow 9.3.0
pip 22.3.1
setuptools 60.1.0
wheel 0.37.1

3.GUIはDelphiで作成

取得した解答欄の座標を編集するGUIはDelphiで作成。最終的にはこうなった。

検出した矩形の確認と編集を行うGUIはDelphiで作成

画面下の「操作」グループ内のVCLを左から右へ順にクリックして行けば、解答用紙画像から解答欄の矩形が取得・表示できる仕組み。

左から右へ順に操作して解答欄矩形の座標を取得する。

取得した解答欄矩形の座標は、画面右上に一覧形式で採点順に表示されるようにプログラミングした。

取得した座標の一覧を表示

横書き答案が指定された場合は、y座標の値が昇順になるよう並べ替え(y座標が同じなら、x座標でさらに昇順に並べ替え)。

縦書き答案が指定された場合は、x座標の値が降順になるよう並べ替え(x座標が同じなら、y座標でさらに昇順に並べ替え)。

こうすれば、座標の並び方が「ほぼ採点する順番になる」はず。なお、並べ替えはカンマで区切った解答欄矩形の座標を入れたStringListを対象として実行(解答欄数は多くても100未満のはず・・・だから、並べ替えの速度はまったく考えていない)。そのアルゴリズムは次の通り。まず、グローバルに使う変数、ソート用のプロパティと関数を準備。

  private
    { Private 宣言 }
    x1,x2:integer;
    y1,y2:integer;
    //Pythonから送られたデータを保存する
    strAnsList:TStringList;

var
  Form1: TForm1;

type TSStyle = (ssText,ssInteger);
var
  //ソート用のプロパティ
  fAscending : Boolean;
  fIndex : Integer; //項目番号
  fStyle : TSStyle; //テキストか整数か

implementation

uses
  System.UITypes;
function GetCommaText(aStr:String; aIndex:Integer):string;
  var
    subList:TStringList;
begin
  subList := TStringList.Create;
  subList.Delimiter := ',';
  subList.DelimitedText := aStr;
  Result := subList.Strings[aIndex];
  subList.Free;
end;
function MyCustomSort(List: TStringList; Index1, Index2: Integer): Integer;
begin
  case fStyle of
    ssText:begin
      Result:=CompareText(GetCommaText(List.Strings[Index1],
      fIndex),
      GetCommaText(List.Strings[Index2],fIndex));
    end;
    ssInteger:begin
      //一重ソート
      //Result:=StrToInt(GetCommaText(List.Strings[Index1],fIndex))
      //          -StrToInt(GetCommaText(List.Strings[Index2],fIndex));
      //二重ソート
      Result:=StrToInt(GetCommaText(List.Strings[Index1],fIndex))
                -StrToInt(GetCommaText(List.Strings[Index2],fIndex));
      if Result=0 then
        //-1することで1番目の項目がソートキーになる
        Result:=StrToInt(GetCommaText(List.Strings[Index1],fIndex-1))  
                  -StrToInt(GetCommaText(List.Strings[Index2],fIndex-1));
      if fAscending then
      begin
        Result:=Result*-1;
      end else begin
        Result:=Result*1;
      end;
    end;
  else
    //これを入れておかないとコンパイラが警告を表示する
    Result:=0;
  end;
end;

で、「解答欄座標を取得」ボタンがクリックされたら、PythonForDelphiを通じてPythonのScriptを内部的に実行して座標を取得し、上記関数を呼び出して並べ替えを実行、結果をMemo2に表示する。

procedure TForm1.btnGetSquareClick(Sender: TObject);
var
  //PythonのScriptを入れる
  strScrList:TStringList;
  //Pythonから送られたデータを保存する -> グローバル変数化
  //strAnsList:TStringList;
  //Sort
  i:integer;
  strFileName:string;
  strList:TStringList;
begin
  //初期化
  Memo1.Clear;
  //Scriptを入れるStringList
  strScrList:=TStringList.Create;
  //結果を保存するStringList
  strAnsList:=TStringList.Create;

  try
    //Python Script
    strScrList.Add('import cv2');
    strScrList.Add('import numpy as np');
    //strScrList.Add('img = cv2.imread("./ProcData/sample2.jpg")');
    strScrList.Add('img = cv2.imread(r"./ProcData/'+ExtractFileName(StatusBar1.SimpleText)+'")');
    strScrList.Add('gray = cv2.cvtColor(img, cv2.COLOR_BGR2GRAY)');
    strScrList.Add('gray = 255 - gray');
    strScrList.Add('ret, bin_img = cv2.threshold(gray, 20, 255, cv2.THRESH_BINARY)');
    strScrList.Add('contours, hierarchy = cv2.findContours(bin_img, cv2.RETR_LIST, cv2.CHAIN_APPROX_SIMPLE)');
    strScrList.Add('contours = list(filter(lambda x: cv2.contourArea(x) > '+cmbThreshold.Text+', contours))');
    strScrList.Add('for i in range(len(contours)):');
    strScrList.Add('    im_con = img.copy()');
    strScrList.Add('    x, y, w, h = cv2.boundingRect(contours[i])');
    strScrList.Add('    var1.Value =str(x)+","+str(y)+","+str(x+w)+","+str(y+h)');
    //Scriptを表示
    Memo1.Lines.Assign(strScrList);
    //Execute
    PythonEngine1.ExecStrings(Memo1.Lines);
    //結果を表示
    Memo2.Lines.Assign(strAnsList);
  finally
    //StringListの解放
    strAnsList.Free;
    strScrList.Free;
  end;

  strFileName:=ExtractFilePath(StatusBar1.SimpleText)+'Temp.csv';
  Memo2.Lines.SaveToFile(strFileName);

  strList := TStringList.Create;
  try
    for i := 0 to Memo2.Lines.Count-1 do
    begin
      strList.Add(Memo2.Lines[i]);
    end;
    //fAscending := True; //昇順で
    fAscending := False;
    fIndex := 1; //2番目の項目を
    fStyle := ssInteger; //整数型でソート
    strList.CustomSort(MyCustomSort); //ソート
    //データ抽出
    Memo2.Clear;
    for i := 0 to strList.Count - 1 do
    begin
      //Memo2.Lines.Add(GetCommaText(strList.Strings[i],fIndex));
      Memo2.Lines.Add(strList[i]);
    end;
  finally
    strList.Free;
  end;

end;

上記のアルゴリズムは、次のWebサイトに紹介されていた情報を元に作成。
カンマ区切りのデータの並べ替えは初めて行った。採点順に座標を並べたかったので、プログラムコードをよく読んで、二重ソートになるよう工夫した。
貴重な情報を投稿してくださった方に心から感謝申し上げます。

[delphi-users:1175] カンマ区切りのデータの並べ替え

https://groups.google.com/g/delphi-users/c/Ck2mQXNFTvw

4.矩形検出器の使い方

ここまでの操作で解答欄の座標はすべて取得できたはずなので、不要な矩形のデータをいかに効率よく削除するかを主眼に、GUIの操作方法を考えた。

まず、取得できた座標データの先頭にセットフォーカスし、そのデータが示す矩形を赤いラバーバンドで囲んで表示する。ユーザーは、ラバーバンドで囲まれた矩形を見て、その要・不要を判断。

この矩形は不要

不要な矩形であった場合は、「編集」ボタンをクリック。不要なデータを自動で選択状態に設定。

Memoの一行全部を選択状態に設定

手続きは次の通り。

procedure TForm1.BitBtn1Click(Sender: TObject);
var
  i:integer;
begin

  //行番号をLines[i]で取得
  i:=StrToInt(LBRow.Caption)-1;

  EditTF:= not EditTF;
  if EditTF then
  begin
    BitBtn1.Caption:='編集中';
    BitBtn1.Font.Color:=clRed;
    Memo2.ReadOnly:=False;
    btnSave.Enabled:=False;

    //i行目の文字全てを選択状態にしたい場合
    //先頭にカーソルをセット
    Memo2.SelStart:=Memo2.Perform(EM_LINEINDEX, i, 0);
    //全ての文字を選択
    Memo2.SelLength:=Length(WideString(Memo2.Lines[i]));
    //Memo2.Perform(WM_VSCROLL,SB_TOP,0); //先頭にスクロール

  end else begin

    BitBtn1.Caption:='編 集';
    BitBtn1.Font.Color:=clBlack;
    Memo2.ReadOnly:=True;
    Memo2.SelStart:=SendMessage(Memo2.Handle,EM_LineIndex,i,0);
    btnSave.Enabled:=True;
    Memo2Click(Sender);

  end;

  //SetFocus
  Memo2.SetFocus;

end;

Delete or Backspaceキーで不要なデータを削除すると同時に、Memoの行も削除する。で、ボタンを「編集」(=意味的には「編集したい場合はクリックせよ」)に戻す。次のデータをラバーバンドで囲む。この一連の動作がすべて自動的に流れ作業で行われるように手続きを作成。

コードは次の通り。

procedure TForm1.Memo2KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
var
  LineNo:integer;
begin
  //現在、カーソルがある行を取得
  LineNo:=Memo2.Perform(EM_LINEFROMCHAR, UINT(-1), 0);
  //空欄なら行を削除
  if Memo2.Lines[LineNo]='' then
  begin
    Memo2.Lines.Delete(LineNo);
  end;
  //表示
  GetLinePos;
  if not EditTF then
  begin
    Memo2Click(Sender);
  end else begin
    BitBtn1Click(Sender);
  end;
end;
procedure TForm1.GetLinePos;
var
  CurPos,Line:Integer;
begin
  with Memo2 do
  begin
    CurPos:=SelStart;
    Line:=Perform(EM_LINEFROMCHAR, CurPos, 0);
    //LBRowは現在フォーカスがある行番号を表示するラベル
    LBRow.Caption:=Format('%d', [Line+1]);
    LBRow2.Left:=LBRow.Left+LBRow.Width;
    LBRow2.Caption:='行目';
  end;
end;
procedure TForm1.Memo2Click(Sender: TObject);
var
  i:integer;
  p1,p2:TPoint;

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

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

begin

  if not EditTF then
  begin

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

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

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

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

    //コンポーネントを生成し,イベントを定義し,位置を指定して画像を表示
    plImage1:=TplResizeImage.Create(Self);
    plImage1.Parent:=ScrollBox1;
    plImage1.TransEvent:=True;
    //クライアント座標をスクリーン座標へ変換
    //GetSystemMetrics(SM_CYCAPTION) -> タイトルバーの高さ
    //GetSystemMetrics(SM_CYFRAME) -> ウィンドウの枠幅
    p1.X:=x1-(GetSystemMetrics(SM_CYFRAME) div 2);
    p1.Y:=y1-GetSystemMetrics(SM_CYCAPTION)-(GetSystemMetrics(SM_CYFRAME) div 2);
    p2.X:=x2-(GetSystemMetrics(SM_CYFRAME) div 2);
    p2.Y:=y2-GetSystemMetrics(SM_CYCAPTION)-(GetSystemMetrics(SM_CYFRAME) div 2);
    p1:=Image1.ClientToScreen(p1);
    p2:=Image1.ClientToScreen(p2);
    plImage1.SetBounds(p1.X, p1.Y, p2.X-p1.X, p2.Y-p1.Y);

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

  end;

end;

ラバーバンドはMr.XRAYさんのWebサイトにあったplResizeImageを使わせていただいて作成。これまでにもどれだけ助けていただいたことか・・・。このような素晴らしい素材を提供し続けてくださっているMr.XRAYさんに今回も心から感謝申し上げます。

157_移動リサイズ可能な TImage   ラバーバンドとグラブハンドル

http://mrxray.on.coocan.jp/Delphi/plSamples/157_MoveResize_GrabHandle.htm

ラバーバンドで囲まれた矩形が必要な矩形であった場合は、下のMemo3へ「移動」ボタンをクリックしてデータを移す。で、次の矩形をラバーバンドで囲んで表示する。

次の矩形の要・不要を判断
必要な矩形であれば下のMemo3へ移動する

この作業を順次繰り返すと、最終的に必要な矩形の座標のみがMemo3に移動。不要な矩形の座標はすべて削除されることになる。

必要な矩形の座標のみ、採点順に取得できた!

最終的に過不足がないか・どうか、Memo3の先頭座標データをクリック、ラバーバンドで該当矩形を囲んで表示、下向きの矢印キーを次へ次へと押して、フォーカスを下の座標データへ移動、ラバーバンドを表示して確認、これを最後の座標データまで繰り返し。

採点順を含めて、必要な座標データがすべて揃っていることを先頭データから順に確認する。

必要な座標がすべて取得できていることを確認したら、「保存」ボタンをクリックして手書き答案採点ソフトが実行時に読み込む、様々な採点設定を記録するための iniファイルに解答欄の座標データを保存する。

データの保存

【任意の範囲を指定したい場合】

複数の解答欄を抱き合わせて、完全解答で正解としたい場合などに対応するため、任意の範囲を矩形選択できるようにした。

画面中央左の追加ボタンをクリックすると、画面の中央にラバーバンドが表示される。これを任意の位置へドラッグする。

追加ボタンをクリックしてラバーバンドを表示
画面の中央にラバーバンドを表示、これを任意の位置へドラッグ。

ボタンのCaptionは、自動で「取得」に変更。

ボタンのCaptionを変更

任意の範囲をラバーバンドで囲んだら(=範囲指定完了)、「取得」ボタンをクリック。取得された座標がボタンの右のEditに表示され、同時にクリップボードへ送られる。

任意の範囲を指定して座標を取得

Memo3上の「追加」ボタンをクリックすると、Memo3が編集可能になるので、採点順を確認して、適切な行に座標のデータを追加(クリップボードから貼り付けても、データを見ながら手動入力してもよい)。

適切な位置に座標のデータを入力する

ラバーバンドを使わなくても、解答欄の左上と右下を、それぞれポイントすればその座標をラベルに表示する機能も追加したので、上の図のように、Memo3を編集モードにして、座標を任意の行へ直接入力することも可能。

マウスでポイントした場所の座標をリアルタイムで表示する

クライアント座標の取得と表示を行う手続きは、次の通り。

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  PtInput:TPoint;
begin
  //スクリーン座標を取得
  GetCursorPos(PtInput);
  //で、そのコントロールのクライアント領域に対するカーソルの座標を取得
  PtInput := Image1.ScreenToClient(PtInput);

  //補正する必要はない(確認済み)
  //表示
  Label2.Caption:=
    Format(' クライアント座標  '+'X : %d, Y : %d', [PtInput.X, PtInput.Y]);
end;

【矢印キーの押し下げを拾う】

最も難しかったのが、フォーカスが「どこにあるか」で矢印キーの挙動を制御すること。以前にStringGridのセルのフォーカスの移動を制限した時に学んだ内容が今回も役に立った。

今回は、Memoにフォーカスがある場合と、ラバーバンドにフォーカスがある場合、さらにラバーバンドにフォーカスがある場合のうち、Shiftキーと同時に矢印キーが押し下げられているのか(=ラバーバンドの大きさの変更)、それとも矢印キーが単独で押し下げられているのか(=ラバーバンドの表示位置の移動)、この3パターンを見分けてそれぞれにあった動作を行わせたいと考えた。最終的には次のコードで対応。

  private
    { Private 宣言 }

    //ある(矢印他)キーが押されたことを知る
    procedure AppMessage(var Msg: TMsg; var Handled: Boolean);

上のように手続きを宣言して、Shift+Ctrl+Cで手続きを生成。

procedure TForm1.AppMessage(var Msg: TMsg; var Handled: Boolean);
var
  StrText: string;
begin
  //何かキーが押し下げられたら
  if Msg.message = WM_KEYDOWN then
  begin
    try
      if ActiveControl is TMemo then
      begin
        //キー操作を「通常動作」にするおまじない
        case Msg.Message of
          WM_USER + $0500:
          Handled := True;
        end;
      end else begin
        //上位ビットが1ならShiftキーが押されている
        if GetKeyState(VK_SHIFT) and $8000 <> 0 then
        begin
          if plImage1.Visible then
          begin
            //右矢印キー
            if Msg.wParam=VK_RIGHT then
            begin
              plImage1.Width := plImage1.Width + 1;
              Msg.wParam:=0;
            end;
            //左矢印キー
            if Msg.wParam=VK_LEFT then
            begin
              plImage1.Width := plImage1.Width - 1;
              Msg.wParam:=0;
            end;
            //上矢印キー
            if Msg.wParam=VK_UP then
            begin
              plImage1.Height := plImage1.Height - 1;
              Msg.wParam:=0;
            end;
            //下矢印キー
            if Msg.wParam=VK_DOWN then
            begin
              plImage1.Height := plImage1.Height + 1;
              Msg.wParam:=0;
            end;
          end;
        end else begin
          //Shiftキーは押されていない
          //対象を限定(どちらでも動いた)
          //if TplResizeImage(ActiveControl).Visible then
          if plImage1.Visible then
          begin
            //右矢印キー
            if Msg.wParam=VK_RIGHT then
            begin
              plImage1.Left := plImage1.Left +1;
              Msg.wParam:=0;
            end;
            //左矢印キー
            if Msg.wParam=VK_LEFT then
            begin
              plImage1.Left := plImage1.Left -1;
              Msg.wParam:=0;
            end;
            //上矢印キー
            if Msg.wParam=VK_UP then
            begin
              plImage1.Top := plImage1.Top - 1;
              Msg.wParam:=0;
            end;
            //下矢印キー
            if Msg.wParam=VK_DOWN then
            begin
              plImage1.Top := plImage1.Top + 1;
              Msg.wParam:=0;
            end;
            //Deleteキー
            if Msg.wParam=VK_DELETE then
            begin
              //plImage1を解放
              if Assigned(plImage1) then begin
                FreeAndNil(plImage1);
              end;
              Msg.wParam:=0;
            end;
          end;
        end;
      end;
    except
      on E: Exception do
      begin
        StrText := E.ClassName + sLineBreak + E.Message;
        Application.MessageBox(PChar(StrText), '情報', MB_ICONINFORMATION);
      end;
    end;
  end;
end;

plImage1が生成されないうちに上の手続きが呼ばれると、当然、一般保護違反のエラーが発生するので、FormCreate時にplImage1を生成しておく。

procedure TForm1.FormCreate(Sender: TObject);
var
  //Python39-32へのPath
  AppDataDir:string;
  i:integer;
begin

  //メモリーリークがあれば検出
  ReportMemoryLeaksOnShutdown:=True;

  //有効にする(忘れないこと!)
  Application.OnMessage := AppMessage;

  //[Enter]でコントロールを移動させるために、Form上のコンポーネント
  //より先にFormがキーボードイベントを取得する。
  KeyPreview:=True;

  //コンポーネントを生成 -> インスタンス(実体)をつくる
  // = 一般保護違反エラーの防止
  //plImage1はグローバル変数として宣言しているから未定義の識別子エラーは発生しない
  //でも、Create(生成)してからでなければ使えない!
  plImage1:=TplResizeImage.Create(Self);

  //編集フラグ(編集中ではない)
  EditTF:=False;
  PlusTF:=False;
  Memo2.ReadOnly:=True;

  //StatusBar1の設定
  StatusBar1.SimplePanel:=True;

  //Formを最大化して表示(幅も最大化される)
  Form1.WindowState:=wsMaximized;

  //Embeddable Pythonの存在の有無を調査
  AppDataDir:=ExtractFilePath(Application.ExeName)+'Python39-32';
  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;

  //面積の閾値の選択肢を設定
  for i := 1 to 200 do
  begin
    cmbThreshold.Items.Add(IntToStr(i*100));
  end;

  //画面のちらつきを防止する
  DoubleBuffered := True;

end;

で、メモリーリーク発生の原因とならないよう、アプリの終了時に忘れずに解放。

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  //メモリーリークを防止する
  PythonEngine1.Py_Finalize;
  PythonDelphiVar1.Finalize;
  FreeAndNil(plImage1);
end;

5.まとめ

(1)矩形の検出は、OpenCVのfindContours関数を利用する。
(2)矩形の検出を回避するには「点線」を利用する。
(3)GUIはDelphiで作成し、必要な座標だけ保存できるように工夫。
(4)「フォーカスがどこにあるか」で矢印キーの動作を制御。
(5)コントロール生成のタイミングと確実な破棄にも注意する。

6.お願いとお断り

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

Fastest Image Reading and Writing

いろいろな画像ファイルを高速読み書き(GDI+を使用)」

BMP, JPEG, GIF, PNG, TIFF, WMF, EMF 形式の画像ファイルをGDI+で読み込み、
BMP, JPEG, GIF, PNG, TIFF いずれかの形式を指定して書き出す方法。
今回の内容をひとことで表現すれば「GDI+で何でも読み書き」。

0.準備
1.読み込み
2.書き出し
3.まとめ
4.お願いとお断り

0.Delphiを起動して画像の読み書き用Formを準備する

Delphiを起動して、新規にVCLアプリケーションを作成。次のVCLコンポーネントを載せたFormを準備する。準備ができたら、任意のフォルダにプロジェクトを保存する。

VCLコンポーネントをFormに配置したところ
VCLコンポーネントの親子関係

(1)FormにStatusBarを1つ置く。
(2)Formの上にPanelを1つ置き、Alignプロパティを「alBottom」、Heightプロパティを「60」に設定。
(3)Panel1をクリックして選択し、Panel1上にButtonを2つ、RadioGroupを1つ置く。名前はデフォルトのまま、CaptionプロパティをButton1は「読み込み」、Button2は「書き出し」、RadioGroup1は「画像の大きさ」に変更。Button2のAnchorsプロパティは下図のようにakTopとakRightのみTrueに変更する。こうすることで、Formを最大化した時、画面右側のButton2がFormの右側下隅(自然な位置)にくる。

Button2のAnchorsプロパティを変更

(4)Formをクリックして選択し、Form上にScrollBoxを1つ置き、Alignプロパティを「alClient」に設定。 ScrollBox1 をアクティブに(クリックして選択)して、ScrollBox1の上にImageを1つ置く。Imageのプロパティはデフォルト設定のまま。
(5)RadioGroup1のCaptionプロパティを「画像の大きさ」に変更し、Columns(表示するオプションボタンの列数)プロパティに「2」を設定。

RadioGroup1のプロパティを設定

さらに、RadioGroup1のItemIndexプロパティを「0」(第1番目のオプションボタンを選択した状態でプログラムが起動する)、Itemsプロパティには1行目に「リサイズ」、2行目に「オリジナル」を設定する。

先に、RadioGroup1のColumnsプロパティを「2」(列)に設定してあるので、1行目の「リサイズ」が1列目に、2行目の「オリジナル」が2列目に表示される。

RadioGroup1のプロパティを設定 ItemIndexを0、Itemsに「リサイズ」と「オリジナル」を準備する

(6)Formのどこでもよいので、OpenDialogとSaveDialogを1つずつ設置する。これらは非ビジュアルコンポーネントなので、下図のようにして非表示に設定することもできる(設置したことを忘れそうな場合は、非表示にしない方がよいと思う)。

非ビジュアルコンポーネントを非表示に設定

実行(F9)すると C:\ XXX \ プロジェクトファイルのあるフォルダ \Win32\ 内にDebugフォルダが作成されるので、ここに画像を保存する「Data」フォルダを作成する。Dataフォルダ内に、任意の画像データを準備する。

例:画像はJPEG形式で、名前は「Sample.jpg」の場合

Debugフォルダ内にDataフォルダを作成し、画像を準備
Sample.jpg

1.読み込み

読み込みボタン(Button1)をダブルクリックして、画像ファイルの読み込み手続きを記述する。画面は次のようになる。

procedure TForm1.Button1Click(Sender: TObject);
begin

end;

まず、必要な変数をvar宣言する。このプログラムでは、画像の読み書きにGDI+を利用する。他の方法に比べ、超高速な画像の読み書きが可能である。

GDI(Graphics Device Interface)は、Windowsで画面のグラフィック処理やプリンターへの出力を行う技術で、WindowsXPからその後継となるGDI+が登場し、GDIで不可能であったJPEGやPNGといった画像形式にも対応し、これにより高レベルの2Dグラフィック処理が可能になった。

GDI+を使用するために必要な変数、及び、処理時間計測に必要な変数を、それぞれ次のように宣言する。

procedure TForm1.Button1Click(Sender: TObject);
var
  //GDI+を利用する
  graphics:TGPGraphics;
  bmp:TGPBitmap;
  W,H:integer;
  //処理時間を計測
  timerStart:DWORD;
  timerEnd:DWORD;
  s:string;
begin

また、GDI+を利用するには、Winapi.GDIPAPI と Winapi.GDIPOBJ をusesに宣言する。また、画像データの保存時に必要なGUIDを自動取得するGetEncoderClsid関数を使用するので、Winapi.GDIPUTILも合わせて宣言する。

さらに、
処理時間計測用に Winapi.MMSystem 、
JPEG形式の画像を使うために Vcl.Imaging.jpeg 、
TPath.GetExtension関数でファイル(Path)名から拡張子を取得するために必要な System.IOUtils もここで同時に uses に追加しておく。

implementation

uses
  Vcl.Imaging.jpeg, Winapi.MMSystem,
  Winapi.GDIPAPI, Winapi.GDIPOBJ, Winapi.GDIPUTIL,
  System.IOUtils;

{$R *.dfm}

読み込みボタン(Button1)をクリックした際に実行される処理を、以下の通り記述する。アイコンの画像以外の、通常使用する画像ファイル(BMP, JPEG, GIF, PNG, TIFF, WMF, EMF 形式)を読み込み可能である。

procedure TForm1.Button1Click(Sender: TObject);
var
  //GDI+を利用する
  graphics:TGPGraphics;
  bmp:TGPBitmap;
  W,H:integer;
  //処理時間を計測
  timerStart:DWORD;
  timerEnd:DWORD;
  s:string;
begin

  //OpenDialogのプロパティはExecuteする前に設定
  With OpenDialog1 do begin
    //表示するファイルの種類を設定
    Filter:='画像ファイル|*.bmp;*.jpg;*.gif;*.png;*.tif;*.emf;*.wmf' +
    '|*.bmp|*.bmp' + '|*.jpg|*.jpg' + '|*.gif|*.gif' + '|*.png|*.png' +
    '|*.tif|*.tif' + '|*.emf|*.emf' + '|*.wmf|*.wmf';
    //データの読込先フォルダを指定
    InitialDir:=ExtractFilePath(Application.ExeName)+'Data';
  end;

  if not OpenDialog1.Execute then Exit; //キャンセルに対応

  //時間計測開始
  timerStart:=TimeGetTime;

  //オブジェクトを生成
  bmp:=TGPBitmap.Create(OpenDialog1.FileName);
  Image1.Picture.Bitmap.Width:=bmp.GetWidth;
  Image1.Picture.Bitmap.Height:=bmp.GetHeight;
  Image1.Picture.Bitmap.PixelFormat:=pf24bit;
  graphics:=TGPGraphics.Create(Image1.Picture.Bitmap.Canvas.Handle);

  try
    //イメージを表示
    graphics.DrawImage(bmp, 0, 0, bmp.GetWidth, bmp.GetHeight);

    //画像の大きさ
    case RadioGroup1.ItemIndex of
      0:begin
        //Image1にリサイズして表示
        Image1.Align:=alClient;
        W:=Image1.Width;
        H:=Image1.Height;
        Image1.Width:=W;
        Image1.Height:=H;
        //Imageに合わせて表示
        Image1.AutoSize:=False;
        //Imageのサイズに合わせて表示する
        Image1.Stretch:=True;
        //縦横の比率を変えずに Image のサイズに変更
        Image1.Proportional:=True;
      end;
      1:begin
        //オリジナルの大きさで表示
        Image1.Align:=alNone;
        Image1.AutoSize:=True;
        //Imageのサイズに合わせて表示する
        Image1.Stretch:=False;
        //縦横の比率を変えずに Image のサイズに変更
        Image1.Proportional:=False;
      end;
    end;

    //処理時間計測終了
    timerEnd:=TimeGetTime;

    //計算時間を表示
    s:='計算時間:'+(IntToStr(timerEnd-timerStart)+' ms');
    StatusBar1.SimpleText:=s;

  finally
    bmp.Free;
    graphics.Free;
  end;

end;

処理時間の計測結果をStatusBarに表示するために、FormのCreate時に、以下の設定を行っておく。

procedure TForm1.FormCreate(Sender: TObject);
begin
  //StatusBar1の設定(FalseだとStatusBarにテキストが表示されない)
  StatusBar1.SimplePanel:=True;
end;

ついでにFormが常に画面の中央に表示されるよう、次のコードをFormのOnShowイベントに記述する。

procedure TForm1.FormShow(Sender: TObject);
begin
  //Formを画面の中央に表示
  Left:=(Screen.Width-Width) div 2;
  Top:=(Screen.Height-Height) div 2;
end;

上書き保存(Ctrl+S)して、実行(F9)。Sample.jpgのファイルサイズは約5.72MBであるが、私のPC環境では最速137msで表示される。最後に旧来の画像読み込み方法も紹介するが、他の方法を使う気にならないくらいGDI+による読み込みはたいへん高速である。

2.書き出し

読み込み手続きの次は、書き出しの手続きを記述する。書き出しボタン(Button2)をダブルクリックして、書き出し手続きを新規に作成する。

procedure TForm1.Button2Click(Sender: TObject);
begin

end;

最初に手続き中で必要な変数をvar宣言する。

procedure TForm1.Button2Click(Sender: TObject);
var
  //usesにWinapi.GDIPAPI, Winapi.GDIPOBJが必要
  graphics:TGPGraphics;
  bmp:TGPBitmap;
  //GetEncoderClsid関数の利用とTGUIDを使用するには、
  //usesにWinapi.GDIPUTILが必要
  ImgGUID:TGUID;
  //処理時間を計測
  timerStart:DWORD;
  timerEnd:DWORD;
  s:string;
  dotExt, strExt:string; //拡張子を取得する
begin

書き出し処理のコードを記述する。

procedure TForm1.Button2Click(Sender: TObject);
var
  //usesにWinapi.GDIPAPI, Winapi.GDIPOBJが必要
  graphics:TGPGraphics;
  bmp:TGPBitmap;
  //GetEncoderClsid関数の利用とTGUIDを使用するには、
  //usesにWinapi.GDIPUTILが必要
  ImgGUID:TGUID;
  //処理時間を計測
  timerStart:DWORD;
  timerEnd:DWORD;
  s:string;
  dotExt, strExt:string; //拡張子を取得する
begin

  //OpenDialogのファイル名が空欄ならExit
  if OpenDialog1.FileName='' then
  begin
    ShowMessage('保存する画像がありません!');
    Exit;
  end;

  //SaveDialogのプロパティはExecuteする前に設定しておくこと
  With SaveDialog1 do begin
    //デフォルトのファイル名を設定
    FileName:='Test';
    //表示するファイルの種類を設定
    Filter:='画像ファイル|*.bmp;*.jpg;*.gif;*.png;*.tif' +
    '|*.bmp|*.bmp' + '|*.jpg|*.jpg' + '|*.gif|*.gif' + '|*.png|*.png' +
    '|*.tif|*.tif';
    //データの読込先フォルダを指定
    InitialDir:=ExtractFilePath(Application.ExeName)+'Data';
    //拡張子の指定がなかった場合に付加される拡張子を指定
    DefaultExt:='jpg';
    //上書き保存の確認の設定
    Options:=[ofOverWritePrompt];
  end;

  if not SaveDialog1.Execute then Exit; //キャンセルに対応

  //時間計測開始
  timerStart:=TimeGetTime;

  bmp:=TGPBitmap.Create(OpenDialog1.FileName);
  //どちらの指定でも保存可能
  //Graphics:=TGPGraphics.Create(Image1.Canvas.Handle);
  Graphics:=TGPGraphics.Create(Image1.Picture.Bitmap.Canvas.Handle);
  try

    //90°回転
    //bmp.RotateFlip(Rotate90FlipNone);

    //画像を取得
    Graphics.DrawImage(bmp,0,0);

    //拡張子を小文字に変換して取得(.XXX形式:Dotが付いている)
    dotExt:=LowerCase(TPath.GetExtension(SaveDialog1.FileName));
    //JPEG & TIFFに対応する
    if dotExt='.jpg' then begin
      strExt:='jpeg';
    end else begin
      if dotExt='.tif' then begin
        strExt:='tiff';
      end else begin
        strExt:=StringReplace(dotExt, '.', '', [rfReplaceAll, rfIgnoreCase]);
      end;
    end;

    //指定された拡張子を付けて保存
    if GetEncoderClsid('image/'+strExt, ImgGUID) >= 0 then
    begin
      bmp.Save(ChangeFileExt(SaveDialog1.FileName, dotExt), ImgGUID);
    end;

    //処理時間計測終了
    timerEnd:=TimeGetTime;
    //計算時間を表示
    s:='計算時間:'+(IntToStr(timerEnd-timerStart)+' ms');
    StatusBar1.SimpleText:=s;

  finally
    Graphics.Free;
    bmp.Free;
  end;

end;

上書き保存(Ctrl+S)して、実行(F9)。読み込みボタンをクリックして画像を読み込んでから、書き出しボタンをクリックして、保存形式(拡張子)を選択、画像ファイル名はデフォルトで「Test」が設定されているので、そのままでよければSaveDialogの「保存」ボタンをクリックして、画像をDataフォルダに保存する。

Sample.jpgを読み込んでから画面を最大化したところ
(画像の大きさも画面に追随して大きくなる)

GDI+による画像ファイルの読み込みと書き出し処理について、次のWebサイトにたいへん詳しく紹介されています。GDI+を学びたい方は必見です。

Delphiを使って、誰かの役に立つプログラムを作成している方なら、誰しもMr.XRAYさんのWebサイトに一度はお世話になっているのではないでしょうか? それくらい貴重な情報が数多く紹介されています。 私自身、これまでに何度助けていただいたことか・・・。Delphiに関する貴重な情報をずっと提供し続けてくださっているMr.XRAYさんに心から感謝申し上げます。

GDI+ 関係サンプル G040_各種の画像形式の表示と変換

URL:http://mrxray.on.coocan.jp/Delphi/GDIPlusSamples/G040_GDIPlus_SomeImageTypes.htm

参考:旧来の画像の呼び出し方法

最も普通に使われてきた(と思われる)JPEG画像の呼び出しの例。GDI+の利用でSample画像は150ms前後で読み込めていたが、こちらの方法では読み込みに1秒近くかかる。

さらに、読み込んだ画像に対して、何か作業を行う場合(例:矩形選択等)は、下のコード内でコメント化してある部分( Image1.Picture.Bitmap.Assign(Jpg); )をアクティブにして、BitmapにAssignしないと、画像加工実行時にエラーになることにも注意。

Image1.Picture.Assign(jpg); として読み込んで、
画像を加工しようとした場合はエラーになる。
implementation

uses
  Vcl.Imaging.jpeg, Winapi.MMSystem;

  //Vcl.Imaging.jpegはJPEGファイルを扱うために必要
  //Winapi.MMSystemは計算処理時間の表示用

{$R *.dfm}



procedure TForm1.Button1Click(Sender: TObject);
var
  Jpg:TJPEGImage;
  //処理時間を計測
  TStart: DWORD;
  TEnd: DWORD;
  s:string;
begin

  //画像を消去する
  Image1.Picture:=nil;

  //OpenDialogのプロパティはExecuteする前に設定
  With OpenDialog1 do begin
    //表示するファイルの種類を設定
    Filter:='JPEG Files (*.jpg, *.jpeg)|*.jpg;*.jpeg';
    //データの読込先フォルダを指定
    InitialDir:=ExtractFilePath(Application.ExeName)+'Data';
  end;

  if not OpenDialog1.Execute then Exit; //キャンセルに対応

  //オブジェクトを生成
  jpg := TJPEGImage.Create;

  try

    //時間計測開始
    TStart:=TimeGetTime;

    //ファイルから読み込み
    jpg.LoadFromFile(OpenDialog1.FileName);
    //Image1に(メモリから)表示
    Image1.Picture.Assign(jpg);
    //Image1.Picture.Bitmap.Assign(Jpg);

    //処理時間計測終了
    TEnd:=TimeGetTime;

    //計算時間を表示
    s:='計算時間:'+(IntToStr(TEnd-TStart)+' ms');
    StatusBar1.SimpleText:=s;

  finally
    //オブジェクトを破棄
    jpg.Free;
  end;

end;

3.まとめ

これまでいろいろな形式の画像を読み込んだり、書き込んだりする場合は、それぞれの画像形式に合わせてプログラムコードを用意していたが、GDI+を利用すればあらゆる場合に対応できることがわかった。かつ、処理速度も超高速で快適に使用できる。

4.お願いとお断り

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

【関連記事】