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

Delphiによるプログラミング関係のTips

Delphi 11.2 Alexandria has arrived!

「アレキサンドリアがやってきた!」

2022年9月17日(土)早朝、てか、普通のヒト的には深夜、MyPCにDelphi 11.2 Alexandriaがやってきた。わぁーい*(^_^)*♪ インストールに時間がかかりそうだから、土曜日を待ってたんだ。きゃっほー♪ isoファイルをDLして、マウントして、インストーラを起動。しばらく待って無事インストール完了。それから、My Secret Weapon、大好きなPython4Delphiも入れて、今、作ってるプログラムを読み込んで実行したら・・・。

あれー? バルーンヒントが指定したVCLじゃなくて、マウスのポインタ位置に表示されるんだけど・・・。ふーん、今度からそうなったんだ。Delphi すごーい。でも、なんでー? みたいな・・・ T_T

1.11.2でバルーンヒントが大変なコトに
2.VCLの位置をTPointでGet!
3.まとめ
4.お願いとお断り

1.11.2でバルーンヒントが大変なコトに

MyPCだけで起きていることカモしれないけど、Delphi 11.2 Alexandriaをインストールして、以前のバージョンで作ったプログラムを読み込んで実行したら、バルーンヒントの表示される位置が・・・、んー。設定と・・・かなり「違う」。みたいな・・・

早速、検証用プログラムを作って、動作確認。

Button3をクリックしたら・・・ の手続きの中で、
(※注意:バルーンヒントにアイコンを表示する方法は、この下で解説)

procedure TForm1.Button3Click(Sender: TObject);
begin
  //バルーンヒントを表示
  BalloonHint1.Title := 'ヒント';
  BalloonHint1.Description := 'ここをクリックしてください';
  BalloonHint1.HideAfter := 12000; //表示時間(単位:ms)
  BalloonHint1.ShowHint(button2.ClientToScreen(CenterPoint(button2.ClientRect)));
  //案内アイコンも追加
  BalloonHint1.ImageIndex := 0;
end;

バルーンヒントを表示するのは、「button2」の真ん中だよって、ちゃんと指定してるのに・・・

なぜか Button2ではなく、マウスポインタ位置にバルーンヒントが表示・・・される

これでは役に立たないけれど、案内アイコンを付けてバルーンヒントを表示する方法をいちおうメモ(11.2より前のバージョンのDelphiなら、期待通りに動くはず)。

(1)FormにImageList1を置いて、HeightプロパティとWidthプロパティ両方に「32」を設定。

ImageList1のHeightプロパティとWidthプロパティ両方に「32」を設定。

(2)BalloonHint1のImagesプロパティにImageList1を指定。

BalloonHint1のImagesプロパティにImageList1を指定。

(3)IconExplorerをDLして、インストール。

Icon Explorer

https://www.mitec.cz/iconex.html

(4)IconExplorerを起動し、c:\Windows\System32\Shell32.dllをクリックするとアイコン一覧が表示されるので、その中から目的のIconを探して、以下のように操作。

c:\Windows\のSystem32フォルダをクリック
Shell32.dllをクリック
目的のアイコンをさがしてクリック
32×32を右クリック

で、表示されるサブメニューから、「Save to Bitmap」を選択し、任意のフォルダに保存する(PNGだと背景が透明になる・・・。Jpegは試していない)。

(5)TImageListをダブルクリックして表示されるWindowの「追加」をクリックして、上で任意のフォルダに保存したInfoアイコンを選択して「OK」をクリックする。

「追加」をクリックして、上で任意のフォルダに保存したInfoアイコンを選択してOKをクリック

(6)上で紹介したコードを記述して実行すれば、11.2より前のバージョンのDelphiなら期待した通りに動作するはず。バルーンヒントが表示される位置が、目的のVCLコントロールの上だったり、下だったり、その表示位置を自由に制御できないのがもどかしかったり、ヒントの色が背景と同じで、実際に使ってみると思ったほどヒントが目立たなかったり・・・ みたいな不満は、正直ずっとあったけど。少なくても「そこに出せ!」とコードで指示したVCLを無視するようなことだけはなかった・・・。11.2より前のバージョンのDelphiなら・・・

でも、もう前のバージョンには戻せない。

何回コンパイルしても、頑なまでに、指示を無視する11.2。
生まれたてなのに、イイ根性してます・・・。

でもね。

Delphiを心から信じ、愛している人間は、きっとこう思うはずなんですよ。

これは11.2で「バルーンヒントの表示位置は、マウスポインタがアクティブな場合、プログラム内容よりポインタの現在位置を優先する」仕様へとDelphiが進化したため・・・。

一瞬、そう思いたくもなったのですが。次の瞬間、

こんなプログラム。フツーのヒトは、
壊れてるとしか思わねーだろ!

・・・という声が聞こえ(た気がする)、僕は自分を取り戻した次第です。

そう言えば、ある冬の寒い朝、これと似た出来事がありました。

ハナが冷たくて目が覚めた僕は、
となりでまどろんでる彼女に、小さな声でききました。

『ねぇ 今日もさむいー?』

想像を絶する大音量で、返事が。

冬だから寒いに決まってんだろ!

おまけに、

冬をなめとんのか? オマエは

はい。すみません。

ですが、そこまで言わなくても・・・。
クー。クー。眠ってたはずなのに。もしかして、寝言?

こんな、違うだろ・・・みたいな出来事は、たくさんあって、僕は彼女が大好き。

パスタが大好きな僕ですが、ある晩、無茶苦茶美味しいパスタを彼女が作ってくれて・・・。ほんとに美味しかったから、翌朝、夢で味わったようなパスタを思い出して

『ねぇ まだおかわり、あるー?』って、やっぱり夢の中にいる彼女にきいたら、

ヨーシ、髪の毛で増量!

この人と結婚してよかったぁ☆

彼女とのことは、これでよくても、プログラムは、良くないです。
もし、本当に仕様変更であったにしても、この設定は受け入れられません。

で、Google先生に、どうしたらイイかを、いっぱい訊ねて得た僕なりの結論は・・・

現段階で、どうしてもバルーンヒントを表示したい。・・・なら
自前で作ったバルーンヒントを表示するしかない(したい)。

VCLコントロールのHintプロパティに「言い訳」的に何かを入力して、ShowHintプロパティをTrueに設定。で、実行時、マウスポインタがそのVCLコントロールをポイントしたら、操作方法のヒントを表示するみたいな「控えめ」なユーザーへの案内でなく、何かVCLをクリックしたら、プログラムを初めて使うユーザーにも「こっちだよー!」と手招きするような案内を、僕は表示したくて・・・。

普通のヒントでなく、バルーンヒントを表示させたいだけなら、こちらのWebサイトで紹介されていた方法もあるけど。

Delphi2010 バルーンヒント(BalloonHint)

http://afsoft.jp/program/del2010/p11_047.html

Mr.XRAYさんのWebサイトに完璧な答えが掲載されていました。
以下、その記事を引用して書いたプログラムです。

06_バルーンヒントウィンドウを自作

http://mrxray.on.coocan.jp/Delphi/Others/BalloonHintWindow.htm

上記サイトからDLできるplBalloonHint.pasをdprojファイルがあるのと同じフォルダに入れて、usesに次のように記述。

implementation

uses
  plBalloonHint;

{$R *.dfm}

Button1Click手続きに、以下のコードを記述。

procedure TForm1.Button1Click(Sender: TObject);
var
  LTitle : string;
  LText  : string;
  LhIcon : HICON;
  LPos   : TPoint;
  LArrow : TBalloonArrow;
begin

  //バルーンヒントを表示

  //タイトルとヒントの内容
  LTitle := 'ヒント';
  LText  := 'バルーンヒントを表示' + sLineBreak + '2行目'+ sLineBreak + '3行目';

  //表示のスタイル
  //LArrow:= baTopLeft;       //VCLの上・左へ向けて表示
  //LArrow:= baTopCenter;     //VCLの上・中央
  LArrow:= baTopRight;        //VCLの上・右へ向けて表示
  //LArrow := baBottomRight;  //VCLの下・右へ向けて表示
  //LArrow := baBottomCenter; //VCLの下・中央
  //LArrow := baBottomLeft;   //VCLの下・左へ向けて表示

  //吹き出しの始点
  GetCursorPos(LPos);   //マウスでクリックした位置に表示

  //システムのInfoアイコンを使用
  LhIcon := LoadIcon(0, IDI_INFORMATION);

  try
    //引数はタイトル、ヒント、アイコン、表示位置、吹き出しの始点、時間はミリ秒
    BalloonHint(LTitle, LText, LhIcon, LArrow, LPos, 12000);
  finally
    DestroyIcon(LhIcon);
  end;

end;

で、実行すると・・・

これくらい目立って欲しかった! Mr.XRAYさん、ほんとうにありがとうございます。

2.VCLの位置をTPointでGet!

んじゃ、Button1をクリックしたら、Button2の上に「こっちだよー」みたいにバルーンヒントを表示できたらいいなーっと思って、コードを書こうとしたら、なんと! その書き方を知らないことに気がつきました。

とりあえず、Button2の位置が取得できればいいわけですから、イロイロ調べた結果、次のstack overflow の記事を発見。

How can I get the X,Y position of a TWinControl (relative to the screen)

https://stackoverflow.com/questions/290000/how-can-i-get-the-x-y-position-of-a-twincontrol-relative-to-the-screen

で、以下のコードで、Button2の位置をLabel1に表示できることを確認。
(Pointを使うためにusesにSystem.Typesを追加)

implementation

uses
  plBalloonHint,
  System.Types;

  //System.TypesはButtonの位置を取得するPointを使用するために追加

{$R *.dfm}

procedure TForm1.Button3Click(Sender: TObject);
var
  LPos: TPoint;
begin
  //Button2の左上座標を取得して表示
  LPos := Button2.ClientToScreen(Point(0,0));
  Label1.Caption := Format('Screen: %d, %d', [LPos.X, LPos.Y]);
end;

で、Button1Click手続きのコードを次のように変更。

procedure TForm1.Button1Click(Sender: TObject);
var
  LTitle : string;
  LText  : string;
  LhIcon : HICON;
  LPos   : TPoint;
  LArrow : TBalloonArrow;
begin

  //バルーンヒントを表示

  //タイトルとヒントの内容
  LTitle := 'ヒント';
  LText  := 'バルーンヒントを表示' + sLineBreak + '2行目'+ sLineBreak + '3行目';

  //表示のスタイル
  //LArrow:= baTopLeft;       //VCLの上・左へ向けて表示
  //LArrow:= baTopCenter;     //VCLの上・中央
  LArrow:= baTopRight;        //VCLの上・右へ向けて表示
  //LArrow := baBottomRight;  //VCLの下・右へ向けて表示
  //LArrow := baBottomCenter; //VCLの下・中央
  //LArrow := baBottomLeft;   //VCLの下・左へ向けて表示

  //吹き出しの始点
  //GetCursorPos(LPos);   //マウスでクリックした位置に表示
  //Button2の上・幅の1/2の位置に吹き出しの始点がくるように表示
  LPos := Button2.ClientToScreen(Point(Trunc(Button2.Width div 2), 0));

  //システムのInfoアイコンを使用
  LhIcon := LoadIcon(0, IDI_INFORMATION);

  try
    //引数はタイトル、ヒント、アイコン、表示位置、吹き出しの始点、時間はミリ秒
    BalloonHint(LTitle, LText, LhIcon, LArrow, LPos, 12000);
  finally
    DestroyIcon(LhIcon);
  end;

end;
実現したかったのは、まさにコレ!

バルーンヒントを表示する位置によっては、ヒントが画面からはみ出して見えなくなってしまうことがあるので、表示位置の上下・表示する向きは実際の場面に合わせて調整する必要があるけれど、表示位置はDelphiまかせで制御できない(・・・と思ってるのは私だけ?)TBalloonHintより、見た目もくっきり・はっきりしていて目立つし、plBalloonHint.pasを公開してくださったMr.XRAYさんに心から感謝です。

うまく動かなかったTBalloonHintのコードの一部を使って、次のコードにすれば、

  //LPos := Button2.ClientToScreen(Point(Trunc(Button2.Width div 2), 0));
  LPos := Button2.ClientToScreen(CenterPoint(button2.ClientRect));

ボタンの中心に吹き出しの始点を持ってくることもできます。

ほんとに微妙な違いですが・・・僕はButtonのCaptionが全部見える方が好きです。

バルーンヒント表示対象のVCLコントロールの大きさや位置によって、VCLの周囲に表示するか、内部に表示するか、その判断が異なってくると思うので、ClientRectで座標を取得する方法も覚えておいた方が賢明かと。

3.まとめ

MyPCだけで発生する現象なのかもしれないが、Delphi 11.2 をインストールしたらバルーンヒントの表示位置がオカしくなった。

Mr.XRAYさんが配布してくださっている「自作のバルーンヒント」が表示可能なplBalloonHint.pasを使用すれば、この問題は解決でき、さらに「より良く目立つ」バルーンを表示できる。

バルーンヒントを表示するターゲット(VCL)の左上座標は、

  LPos := ターゲットとするVCLの名称.ClientToScreen(Point(0,0));

上のコードで取得できるので、結果をTPoint型の変数に代入して、バルーンヒントの引数に指定(必要に応じてX、Y座標の値が増加するような式を付加する)。また、VCLコントロールの大きさによっては、ClientRectで座標を取得した方がよい場合もありそう。

LPos := ターゲットとするVCLの名称.ClientToScreen(Point(VCLの名称.ClientRect));

で、表示するコードは、

  //引数はタイトル、ヒント、アイコン、表示位置、吹き出しの始点、時間はミリ秒
  BalloonHint(LTitle, LText, LhIcon, LArrow, LPos, 12000);

4.お願いとお断り

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

Management of Printing Equipment

「プリンタの管理で悩む」

1.Windows10のプリンタ管理方法の変更で困ったこと
2.AD環境下で管理者として実行するとネットワークプリンタが見えない!
3.プログラムから「デバイスとプリンター」設定画面を呼び出し
4.まとめ
5.お願いとお断り

1.Windows10のプリンタ管理方法の変更で困ったこと

Windows10になって、いちばん困ったのはプリンタの管理方法の変化だった。デフォルト設定で、最後に使ったプリンタが通常使うプリンタと見なされるようになってから、職場のあちこちで「印刷ができない!」という声が上がることが多くなった。駆け付けてみると、出力先プリンタはいつも「Microsoft Print to PDF」みたいな・・・。

そのたびに「Windowsで通常使うプリンターを管理する」のチェックをOFFにして、AD環境下に置かれた最も近いネットワークプリンタを「通常使うプリンタに設定」する作業を繰り返してきた。

プリンタ設定の方法を文書にして配布しても、どこかへなくしてしまったり、設定方法を忘れた頃にWindows Updateがあってプリンタの設定が勝手に(?)変更されたり・・・、

一般的ユーザーにとっては、「設定やコントロールパネルを開いて操作する」というのは、やはりどこか嫌な感じがする作業のようで、AD環境下でのプリンタ設定は、もうずっと前から思い出すと悩ましい、あまり考えたくないことのひとつだった。

2.AD環境下で管理者として実行するとネットワークプリンタが見えない!

そのように状況が変化する中で、僕は上司から要請されて、出張・休暇関係の申請文書を処理するシステムを組んだ。職員がPCで申請手続きを行うと、申請内容がそのままデータベース化され、管理職が電子決済を行い、出張・休暇を承認する。で、日報や週報のカタチで出張・休暇者の一覧が帳票形式で出力できる、そんなシステムだ。手続きの全部を電子データで行えば「紙」は必要ないと思うのだが、僕が所属する業界では(最終的には本社へ)事務方から「紙」のカタチで様々な報告がなされるようで、どうしても「印刷」作業が必要とのこと(ほぼ同時期に、某公的機関が全県一斉に出退勤時刻の記録方式を改めたことに追随するよう、これまた上司から要請され、新規にICカードとICカードリーダーを用いた勤務記録の管理システムも組んだが、こちらは本社への報告を含め、全て電子データでの処理となっている)。

OSをめぐる状況の変化から、当然、「Windowsで通常使うプリンターを管理する」のチェックがONで、通常使うプリンタが明示的に設定されておらず、出力先プリンタが「Microsoft Print to PDF」になっていて、印刷が「できない」PCが出現することは予測できた。

AD環境下なので、PCごとにグループポリシーでプリンタの割り当ては行ってあるのだが、そのプリンタはADにログオンした時、ネットワークプリンタとして「見える」だけで、通常使うプリンタに明示的に設定されているわけではない。

「通常使うプリンタに設定」するには、どうしても「誰か」が手動でこれを設定しなければならない。しかし、現在動かしている〇〇プログラムとは別に、「設定」もしくは「コントロールパネル」を開いてプリンタの設定を変更する方法が「組織全体の記憶」としてなかなか定着しないのだ・・・。

困った僕は次の方法で、この問題を解決しようとした。それは・・・

プリンターの選択ダイアログを表示して、設定を変更!

印刷の際にプリンターの選択ダイアログを「必ず」表示し、もし「通常使うプリンタに設定」されているプリンタがなかった場合は、出力先プリンタを右クリックして表示されるサブメニューから「通常使うプリンタに設定」を選んでクリックしてもらい、そのプリンタへ出力してもらうというもの(クリックして単に選択しただけでは出力されない)。

この方法をとれば、設定やコントロールパネルをいちいち呼び出す必要がないし、プリンタ名を右クリックすれば簡単に「通常使うプリンタに設定」できるから、PCの操作に自信のないユーザーにも敷居が低いのではないか? と考えたのだ。

こうして、職場にある多くのノートPCで、通常使うプリンタの指定がなされていない場合(=Windowsに管理を任せている場合)に、印刷データが「Microsoft Print to PDF」に出力され、紙に印刷できなくなってしまう問題をなんとか回避することができた。

ちなみに、この方法は次のWebサイトで紹介されていた情報から考案。
Mr.XRAYさんに心より感謝申し上げます。

015_プリンタ設定関係ダイアログ API の使用方法

http://mrxray.on.coocan.jp/Delphi/plSamples/015_PrintDlgAPI.htm#01

Mr.XRAYさんのサイトの情報に援けられて、なんとかその場はしのいだけれど、僕自身の中ではずっと「しこり」のようなものが残って・・・。

たまたま印刷ダイアログに表示されたプリンタ名を右クリックしたら通常使うプリンタに設定できた!」のではなくて、「① ComboBoxの選択肢から通常使うプリンタに設定したいプリンタ名を選び、ボタンクリックで設定」もしくは「② 最初から通常使うプリンタに設定することを目的にワンクリックでコントロールパネルの『デバイスとプリンター』を開きたい」みたいな想いが・・・。

あれからずっと・・・、僕の中に。

そこで今回、自分自身の勉強も兼ねて、さらにいろいろ調べて最初に①の方法が実現できないか、試してみた。コードは次の通り。

type
  TForm1 = class(TForm)
    ComboBox1: TComboBox;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure ComboBox1Select(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private 宣言 }
    FDevice : array[0..MAX_PATH - 1] of Char;
    FDriver : array[0..MAX_PATH - 1] of Char;
    FPort : array[0..MAX_PATH - 1] of Char;
    FDeviceMode : THandle;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  Vcl.Printers,
  Winapi.WinSpool,
  System.Win.ComObj,
  Vcl.ComCtrls;

{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
  APP : Variant;
  str : String;
begin
  //ネットワークプリンタに接続
  str := ComboBox1.Text;
  APP := CreateOleObject('WScript.Network');
  try
    APP.SetDefaultPrinter(str);
    ShowMessage(str + 'を既定のプリンタに設定しました');
  except
    ShowMessage('既定のプリンタへの設定に失敗しました');
  end;
end;

procedure TForm1.ComboBox1Select(Sender: TObject);
begin
  //選択したプリンタを現在のプリンタとする
  Printer.PrinterIndex := ComboBox1.ItemIndex;
  //ここで取得するFDeviceMode1には,変更前のプリンタの情報が格納されている
  //その他の値は現在(変更後)のプリンタの情報となっている
  Printer.GetPrinter(FDevice, FDriver, FPort, FDeviceMode);
  //FDeviceMode初期化
  Printer.SetPrinter(FDevice, FDriver, FPort, 0);
  //FDeviceModeが新しいプリンタドライバの値となる
  Printer.GetPrinter(FDevice, FDriver, FPort, FDeviceMode);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  ComboBox1.Items.Clear;
  ComboBox1.Items.Assign(Printer.Printers);
  ComboBox1.ItemIndex := Printer.PrinterIndex;
  //選択したプリンタを初期化
  //ここでは通常使うプリンタとなっている
  ComboBox1Select(nil);
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  //Formを画面の中央に表示
  Left:=(Screen.Width-Width) div 2;
  Top:=(Screen.Height-Height) div 2;
end;

実行すると・・・

ネットワークプリンタを選んで、設定ボタンをクリックする
MyPCでは、問題なく設定できた!

管理者権限でログオンしているMyPCでは上の例のように「何の問題もなく」動作する。が、AD環境下ではどうだろうか? 通常、ADにログオンする場合は、何でもできるネットワーク管理者権限ではなく、誰もが一般制限ユーザーとしてログオンする。この管理者でないユーザーが果たしてプリンタの設定を、このプログラムで変更可能か・どうか、試してみた。

結論から先に。
動作したり・しなかったりで、挙動が不安定だった。なぜ、Aパソコンでは動作するのに、Bパソコンでは動作しないのか。明示的に通常使うプリンタを設定したAでは、「設定しました」というメッセージが出て、コントロールパネルのデバイスとプリンターの画面にも反映される。が、明示的に通常使うプリンタを設定していないBでは「設定しました」というメッセージは出ても、コントロールパネルのデバイスとプリンターの画面には反映されない。「Windowsで通常使うプリンターを管理する」のチェック状態でこの違いは生まれるのか? (ちなみにAもBもT社製のまったく同じ時期に導入したリース機材)。

このBパソコンではさらに不思議なことが発生。僕の書いたDelphiのプログラムのプリンタ選択画面では「ユーザーが通常使うプリンタに明示的に指定したプリンタが緑のチェックマーク付きで表示されている」のに、コントロールパネルの「デバイスとプリンター」を開くと、そこでは「通常使うプリンタの設定がない」状態で表示され、さらに変更を加えようとすると「このプリンターを通常使うプリンターに設定すると、Windowsは通常使うプリンターの管理を停止します。」の注意メッセージが表示されてしまった・・・。これに関しては、もう、わけがわかりません・・・。が、結論として、①案は、今回はちょっとダメかなーみたいな・・・。

では、これを管理者権限で実行したらどうなるのか?

管理者権限でログオンしているPCであれば、このプリンタ設定プログラムは何の問題もなく動く。それならばということで、ネットワークプリンタがデバイスとプリンターに表示されているAD環境下で、プログラムのアイコンを右クリックして表示される「管理者として実行」を試してみた。すると・・・

ComboBoxの選択肢からは、ネットワークプリンタが全部きれいに・・・

消えたー!!

いとをかし。
ローカルPCにログオンするカタチになるからなのでしょうか・・・?

そんなこんなで、①的アプローチは「今回は」あきらめることに決定。
でもまだ心は折れてないので、②「ワンクリックでデバイスとプリンターを表示する」にチャレンジ!

3.プログラムから「デバイスとプリンター」設定画面を呼び出し

Mr.XRAYさんのWebサイトに、そのものズバリの答えがありました!!

468_各種システム設定ダイアログ表示

http://mrxray.on.coocan.jp/Delphi/plSamples/468_ShowDialog_System.htm

さまざまなシステム設定ダイアログの表示方法の詳細を学ぶことができました。
またまたお世話になり、本当にありがとうございました!!

で、紹介されていたコードをワンクリック用に書き換えたものがこちら。

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
  Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;  //基本的に必要なVCLはこれだけ
    EditPath: TEdit;  //確認用に置いてあるだけで絶対に必要なわけではない
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  Winapi.ShellAPI, System.StrUtils;

{$R *.dfm}

//ワンクリックでデバイスとプリンターを表示する
procedure TForm1.Button1Click(Sender: TObject);
var
  RetCode : Integer;
  strList : TStringList;
  OrgCmd : string;
  EnvPath : string;
  strPath : string;
  CmdPath : string;
  CmdParam : string;

  //環境変数を含む(%等の文字を含む)を実際のパス名に変換
  function ExpandEnvironmentString(S: String): String;
  var
    LDstChar:array [0..MAX_PATH - 1] of Char;
  begin
    ExpandEnvironmentStrings(PChar(S), LDstChar, MAX_PATH);
    Result := LDstChar;
  end;

begin

  //コントロールパネルの「デバイスとプリンター」を表示
  strPath := '%SystemRoot%\System32\control.exe /name Microsoft.DevicesAndPrinters';

  //選択中のItems文字列を取得してコマンド文字列を作成
  OrgCmd := Trim(strPath);
  EnvPath := ExpandEnvironmentString(OrgCmd);

  //実行ファイル名とパラメータに分解
  strList := TStringList.Create;
  try
    strList.Delimiter := ' ';
    strList.StrictDelimiter := True;
    strList.DelimitedText := EnvPath;

    if strList.Count = 1 then
    begin
      CmdPath := Trim(EnvPath);
      CmdParam := '';
    end else begin
      CmdPath := Trim(strList[0]);
      CmdParam := Trim(StringReplace(EnvPath, CmdPath, '', [rfIgnoreCase]));
    end;
  finally
    FreeAndNil(strList);
  end;

  //パス名の空白までをパスと認識してしまうのでダブルクォーテーションで囲む
  //パラメータはそのままとする
  if Pos(' ', CmdPath) > 1 then begin
    if LeftStr(CmdPath, 1) <> '"' then begin
      CmdPath := AnsiQuotedStr(CmdPath, '"');
    end;
  end;

  //Pathを確認用に表示
  EditPath.Text := CmdPath;

  //ShellExecute
  RetCode := ShellExecute(Handle, '', PChar(CmdPath), PChar(CmdParam), nil, SW_SHOW);

  //エラー対策
  if RetCode <= 32 then begin
    MessageBox(Handle, PChar(SysErrorMessage(RetCode)), '情報', MB_ICONINFORMATION);
  end;

end;

end.
設計時の画面
実行時の画面(ボタンをクリックした直後の状態)
Button1クリックで、デバイスとプリンターの画面が表示された

Mr.XRAYさんのおかげで無事目的を達成することができた!
(もちろん、このプログラムが、AD環境下、一般制限ユーザーとしてログオンしている状態でも完全に動作することを確認)

・・・ということで、このButton1をクリックした時の手続きを、業務に使用するプログラムへコピーしてコンパイル、職場のネットワーク上に「新しい更新プログラムとして公開」すれば、クライアントPCのプログラムは自動更新されるように組んであるから、いちばん最初に夢見たカタチで、カンタン・明示的なプリンタ設定の変更が実現できる・・・。

4.まとめ

AD環境下で、自主開発した業務用ソフトウェアを操作する「PC操作にあまり詳しくない」ユーザーに「通常使うプリンタに設定」等の作業をお願いしなければならない時は、コントロールパネルの「デバイスとプリンター」の画面をワンクリックで表示できるプログラムを、その業務用ソフトウェア内に埋め込んで提供するのがいちばんイイ(・・・と今回の経験から僕は思った。あくまでも個人的感想です)

5.お願いとお断り

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

Global And Local Variables

「グローバル変数とローカル変数」

ずっとDelphiを使ってきて、今回初めて「アレっ?」と思ったことがあり、そんなことも知らなかったの? って、バカな自分にあらためて驚愕したという、大変恥ずかしいお話。

1.代入済みの文字列型グローバル変数がなぜか空欄に
2.原因はすぐに判明
3.まとめ
4.お願いとお断り

1.代入済みの文字列型グローバル変数がなぜか空欄に

あるプログラムの中で、あるファイルまでのフルパスを入れておくグローバル変数を宣言した。

  private
    { Private 宣言 }
    strFilePath : string;

Button1をクリックしたら、あるファイルまでのフルパスを取得し、Button2をクリックしたら、そのプロシージャの中で取得済みのパスを使用するつもりだった。

実は、Button2側のプロシージャの中にも、Button1クリックで行ったのと同じ、あるファイルまでのフルパスの取得作業があり、既にButton1クリックで取得済みであれば、Button1をクリックした後、必ずButton2をクリックする設計なので、既に取得済みのパスがある場合は、そのまま使うコードでプログラミングした・・・はずだった。

コードを書いて、実行してみる。
順調に動き始めたように見える。

Button1をクリック。エラーなし。

Button1Clickでファイルまでのパスは取得済みだから、
Button2Clickではファイル選択のダイアログは出ないはず・・・

procedure TForm1.Button2Click(Sender: TObject);
begin
  ・・・略・・・
  if strFilePath='' then
  begin
    ・・・ファイル選択のダイアログを表示・・・
  end;
end;

Button2をクリック。
ファイル選択のダイアログが・・・表示・・・

される。

なんでー!?

取得済みのパスはどこへ消えた?

確認すると、Button2クリックの段階で、取得したはずのパスは、なぜか空欄に。

2.原因はすぐに判明

Button1Clickのプロシージャの先頭にある変数の初期化コード strFilePath:= ” を選択して、Ctrl+Fで検索を実行。で、ここにしか strFilePath:= ” が「ない」ことを確認。

続いて strFilePath だけを選択して再び Ctrl+F

全プログラムコード中にある strFilePath を1つずつ確認して行く・・・。

最優先されるのは、ローカル変数。で、Button1クリックの処理が実行されて、その処理が終わった時点で、Var宣言されたButton1Clickプロシージャ内でのみ有効なローカル変数は破棄される・・・。Google先生から教えてもらった「新」知識を胸に刻みつつ、検索を繰り返すこと、数回・・・

procedure TForm1.Button1Click(Sender: TObject);
var
  ・・・省略・・・
  strFilePath:string;
  ・・・省略・・・
begin

あ、れ?
ナンでこんなところにキミが!?

グローバル変数に、ローカル変数と同じ名前の変数があっても、ローカル変数から自動で代入なんかされない!!・・・ってコトを、今回初めて知りました。たぶん、変数をローカルに宣言した時は、何にも考えていなかったか、ローカル変数に入れた値がそのまま自動でグローバル変数に代入されるって思って(信じて)いたのでしょう。

つまり、グローバル変数の strFilePath は最初からずっと、空欄のまま・・・。

Var宣言の strFilePath : string。書いたのは、誰? はぁーい。ボクです。T_T

3.まとめ

似たような変数名を使いたい時は、例えばグローバル変数ならG_strFilePathのように最初に G_ を付け、ローカル変数なら最初は L_ から始めるとか、そういうほんのちょっとした自分自身との約束があれば起こるはずのないミスでした。今度からは、こんなことが起きないように気を付けたいと思います!

4.お願いとお断り

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

TDirectory.GetFiles Function

「特定ファイルの名称をフルパス付きで取得したい!」

例えば、特定のフォルダ内にある拡張子が「jpg」のファイルの名称と、そのファイルまでのフルパスをイッキに全部!取得したい・・・なんて場合の覚書。

1.特定のフォルダ内にあるJpeg画像名を全部取得
2.サブフォルダがあったらその中も探す
3.ListBoxに高速で項目を追加する方法
4.まとめ
5.お願いとお断り

1.特定のフォルダ内にあるJpeg画像名を全部取得

ある特定のフォルダにある拡張子が「jpg」のファイル全てについて、そこまでのフルパスを取得してListBoxに表示する方法は次の通り。

FormにButtonとListBoxを一つずつ追加して、以下を記述。

implementation

uses
  System.Types,
  System.IOUtils,
  System.StrUtils,
  System.Masks,
  Vcl.FileCtrl,
  System.UITypes;

  //System.TypesはTStringDynArrayを使うために追加
  //System.IOUtilsはTDirectory.TFilterPredicateを使うために追加
  //System.StrUtilsはSplitStringを使うために追加
  //System.MasksはMatchesMaskを使うために追加
  //Vcl.FileCtrlはSelectDirectoryを使うために追加
  //System.UITypesはMessageDlgを使うために追加

{$R *.dfm}

procedure TForm1.ButtonXClick(Sender: TObject);
var
  //フォルダの選択
  iStartFolder: string;
  iDirectories: TArray<string>;
  //ファイルリストの取得
  FileNames: TStringDynArray;
  strFileName: String;

  //ファイルを検索
  function MyGetFiles(const Path, Masks: string): TStringDynArray;
  var
    MaskArray: TStringDynArray;
    Predicate: TDirectory.TFilterPredicate;
  begin
    MaskArray := SplitString(Masks, ';');
    Predicate :=
      function(const Path: string; const SearchRec: TSearchRec): Boolean
      var
        Mask: string;
      begin
        for Mask in MaskArray do
          if MatchesMask(SearchRec.Name, Mask) then
            exit(True);
        exit(False);
      end;
    Result := TDirectory.GetFiles(Path, Predicate);
  end;
begin
  //フォルダを選択
  iStartFolder:=ExtractFilePath(Application.ExeName);
  if SelectDirectory(iStartFolder, iDirectories,
    [sdHidePinnedPlaces, sdNoDereferenceLinks, sdForceShowHidden,
    sdAllowMultiselect], 'フォルダを選択してください', 'Folder', 'Ok') then
  begin
    FileNames:=MyGetFiles(iDirectories[0], '*.jpg');
    for strFileName in FileNames do
    begin
      ListBox1.Items.Add(strFileName);
    end;
  end else begin
    //確認(キャンセルされた時に何かしたい場合)
    MessageDlg('キャンセルされました', mtInformation, [mbOk] , 0);
  end;
end;

たくさんのファイルを扱う場合には、ファイルへのPathとそれぞれに異なるファイル名の処理がまず問題になるが、上記の方法を用いれば、用意したListBoxに指定した拡張子のファイルのみ、フルパス付きでリストが作成される。TListBoxを表示する必要がなければVisibleプロパティをFalseにしておけば、その存在はまったく気にならないし、あとは、使いたい時にItemIndexやItems.Countを参照するだけでOKだから、Pathとファイル名の取得についてはもうなぁーんにも気にすることがなくなり、非常に便利!

例えば、以下の通り。

  //ファイルの数だけLoopする
  for i := 0 to ListBox1.Items.Count-1 do
  begin
    ShowMessage(ListBox1.Items[i]);
  end;

2.サブフォルダがあったらその中も探す

上の例のTDirectory.GetFiles関数では検索する際、サブフォルダを無視しているが、引数の指定を次のように変更すれば、サブフォルダ内も検索できる。

procedure TForm1.ButtonXClick(Sender: TObject);
var
  //フォルダの選択
  iStartFolder: string;
  iDirectories: TArray<string>;
  //ファイルリストの取得
  FileNames: TStringDynArray;
  strFileName: String;
  //検索するファイルの拡張子を指定
  SearchPattern: string;
  //サブフォルダも検索
  Option: TSearchOption;
begin
  //初期化
  ListBox1.Items.Clear;
  //フォルダを選択
  iStartFolder:=ExtractFilePath(Application.ExeName);
  if SelectDirectory(iStartFolder, iDirectories,
    [sdHidePinnedPlaces, sdNoDereferenceLinks, sdForceShowHidden,
    sdAllowMultiselect], 'フォルダを選択してください', 'Folder', 'Ok') then
  begin
    SearchPattern:= '*.jpg';
    //検索モード
    //Option:= TSearchOption.soTopDirectoryOnly; //指定フォルダ直下のみ
    Option:= TSearchOption.soAllDirectories; //サブフォルダ内も検索
    //指定拡張子のファイル名をフルパス付きで取得
    FileNames:= TDirectory.GetFiles(iDirectories[0], SearchPattern, Option);
    for strFileName in FileNames do
    begin
      ListBox1.Items.Add(strFileName);
    end;
  end else begin
    //確認(キャンセルされた時に何かしたい場合)
    MessageDlg('キャンセルされました', mtInformation, [mbOk] , 0);
  end;
end;

どうやらTDirectory.GetFiles関数はいろんな引数を指定できるらしい。
せっかくだから調べてみた。

System.IOUtils.TDirectory.GetFiles

https://docwiki.embarcadero.com/Libraries/Sydney/ja/System.IOUtils.TDirectory.GetFiles
以下、上記Webサイトより引用

class function GetFiles(const Path: string): TStringDynArray;
class function GetFiles(const Path: string;  const Predicate: TFilterPredicate): TStringDynArray;
class function GetFiles(const Path, SearchPattern: string): TStringDynArray;
class function GetFiles(const Path, SearchPattern: string;  const Predicate: TFilterPredicate): TStringDynArray;
class function GetFiles(const Path, SearchPattern: string;  const SearchOption: TSearchOption): TStringDynArray; overload; static;
class function GetFiles(const Path, SearchPattern: string;  const SearchOption: TSearchOption; const Predicate: TFilterPredicate): TStringDynArray; overload; static;
class function GetFiles(const Path: string;  const SearchOption: TSearchOption; const Predicate: TFilterPredicate): TStringDynArray; overload; static;

こんなにあったんだ。びっくり☆

もし、検索対象フォルダが決まっているのであれば、さらに簡単に・・・
(サブフォルダまで検索するか・どうかはOptionを切り替えて指定)

procedure TForm1.ButtonXClick(Sender: TObject);
var
  Path:string;
  SearchPattern:string;
  Option:TSearchOption;
  FileNames:TStringDynArray;
  FileName:String;
begin
  //初期化
  ListBox1.Items.Clear;
  //検索先のPathは指定
  Path:=ExtractFilePath(Application.ExeName) + 'Data';
  //ファイル名に一致する検索パターン
  SearchPattern:='*.jpg';
  //検索モード
  //Option:=TSearchOption.soTopDirectoryOnly; //指定フォルダ直下のみ
  Option:=TSearchOption.soAllDirectories; //サブフォルダ内も検索
  //ファイルのリストを作成
  FileNames:=TDirectory.GetFiles(Path, SearchPattern, Option);
  for FileName in FileNames do
  begin
    ListBox1.Items.Add(FileName);
  end;
end;

3.ListBoxに高速で項目を追加する方法

ファイルのリスト作成をより一層高速化するには、以下のようにリストをAddするfor文の前後にListBox1.Items.BeginUpdate / EndUpdateを入れると良いそうで・・・
(TListBoxのStyleプロパティがlbStandardの場合)

  ListBox1.Items.BeginUpdate;
  for FileName in FileNames do
  begin
    ListBox1.Items.Add(FileName);
  end;
  ListBox1.Items.EndUpdate;

あくまでもMyPC環境での値だが、1000枚のJpeg画像の名称を取得するのに、UpDate命令なしの場合が5回平均で120ms、UpDate命令ありの場合が同じく5回平均で17ms。

たった1000枚でこれだけの差。ファイルの数が増えれば増えるほど、その差が大きくなるのは自明の理。

これはTListBoxだけでなく、TMemo等のDelphiのコンポーネントに多数の項目を追加または変更する際に共通して起きる現象で、発生理由は、変更のたびに画面が再描画されるためとのこと。例えば、今回のようにListBoxに多数の項目を追加すると追加項目数分の再描画が発生し、項目数が多いほど処理時間が必要に。

そこでアイテムに変更を加える前に、 BeginUpdateを呼び出し、すべての変更が完了したら、EndUpdateを呼び出して変更を画面に表示するように指定すると画面の再描画が抑止され、処理時間は大幅に短縮される・・・ということで、大量の項目の追加・変更を行うときは忘れずにUpDate命令を使ったほうがよさそう。

ちなみにTMemoの場合であれば・・・

  Memo1.Lines.BeginUpdate;
  for i := 1 to 5000 do
  begin
    Memo1.Lines.Add('あいうえお');
  end;
  Memo1.Lines.EndUpdate;

つまり、BeginUpdateが画面更新の停止で、EndUpdateが再開ってことでいいのかな?
私はそんなふうに理解しました☆

4.まとめ

ある特定のフォルダ内にある、特定の拡張子を持つファイルのリストを作成したい場合は、TDirectory.GetFiles関数が便利。
取得したフルパス付きのファイル名はListBoxに入れておけば、ItemIndexやItems.Countを参照するだけで具体的な名前やPathを気にせずに使えてこれも便利。
ListBoxに大量に項目を追加する時は、BeginUpDateとEndUpDateを忘れずに使おう! というお話でした。

5.お願いとお断り

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

InputQuery Where Only Numeric Values Can Be Entered

「数値のみ入力可能なInputQuery」

ユーザーからの数値入力を受け取って動作するプログラムを作成した。このような場合には、以前からInputQueryを使用してきた(自前のDialogを作成したこともあった)が、今回、「数値だけ入力可能」なInputQueryを作成してみた。これは、その覚書。

1.入力をチェックして数値のみの入力を実現
2.MyInputQueryを作る
3.まとめ
4.お願いとお断り

1.入力をチェックして数値のみの入力を実現

Delphiでユーザーからの入力を受け取るプログラムを作る時、戻り値がString型のInputBox関数や、Boolean型のInputQuery関数を使う。僕はこれまでユーザーが「どのボタンを押したのか?」がはっきりわかるInputQuery関数を多用してきた(対し、InputBox関数ではデフォルトで設定しておいた文字列が返る)。

procedure TForm1.Button1Click(Sender: TObject);
var
  Ret:string;
begin
  if InputQuery('InputQuery', '値を入力:', Ret) then
  begin
    //OKボタンがクリックされた時

  end else begin
    //キャンセルボタンがクリックされた時(ESCキーで閉じた場合もFalseになる)

  end;
end;
InputQuery実行時の画面

今回、多くの画像の印刷を実行するプログラムの中で、何ページめの画像を印刷するのか、ユーザーに指定してもらう必要があり、そこで、やはりInputQuery関数を利用した。

以前から、このようなシーンで「数値のみ入力可能」なInputQuery関数が欲しいなー、とずっと思ってきたんだけど、とりあえず、プログラムの完成を急ぎたくて、そのたびに、この問題は先送りにされてきた。 僕の中で、もう長いこと ずっと・・・。

Excel VBAで帳票印刷を行う時は、「ちゃっちゃ」っと次のようなFormを作成して

コード書いてないのにEnterキーでFocusまで移動する・・・

「ちゃっちゃ」っと次のコードを書いて・・・

Private Sub CommandButton1_Click()

    Dim PrintNo1 As Integer
    Dim PrintNo2 As Integer
    Dim i As Integer
    
    If UserForm1.TextBox1.Text = "" Then
        MsgBox ("開始番号を半角数字で入力してください。")
        TextBox1.SetFocus
        Exit Sub
    End If
    
    If UserForm1.TextBox2.Text = "" Then
        MsgBox ("終了番号を半角数字で入力してください。")
        TextBox2.SetFocus
        Exit Sub
    End If
    
    PrintNo1 = UserForm1.TextBox1.Text
    PrintNo2 = UserForm1.TextBox2.Text
    i = PrintNo1

    For i = PrintNo1 To PrintNo2
        Range("A2").Select
        ActiveCell.FormulaR1C1 = i
        Range("B6:AB38").Select
    
        ActiveSheet.PageSetup.PrintArea = "$B$6:$AB$38"
        ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
    Next i
    
    Range("A2").Select

End Sub

Private Sub CommandButton2_Click()
    'キャンセルボタンがクリックされた場合
    Unload UserForm1
    Exit Sub
End Sub

で、FormのTextBoxをクリックして・・・

TextBox1を選択

IME ModeプロパティをDisableに設定。

IMEは絶対利用できないようにDisableを指定

あとは実行!
サク・・・っと印刷して終わり。みたいな感じで、VBAならカンタンなんだけど、これをDelphiでやるとなると、全然できるんだけど、でも、ちょっと・・・めんどくさい。

今回も、「数値のみ入力可能なInputQuery」は(現時点で)実現できないから、とりあえず、ユーザーが入力した値をチェック(数値であるか・どうか)して対応してしまった・・・。

それが次のコード。

implementation

uses
  System.UITypes;

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  Ret: string;
  intNum: integer;
  //全角 -> 半角に変換
  Chr: array [0..255] of char;
begin
  if InputQuery('印刷', 'ページを指定', Ret) then
  begin
    //OKボタンがクリックされた時
    //全角->半角変換
    //全角だった場合は半角数字に変換、すでに半角のものは半角のまま
    //半角にできない文字、たとえばひらがな等は変換されない
    Winapi.Windows.LCMapString(
      GetUserDefaultLCID(),
      LCMAP_HALFWIDTH,
      PChar(Ret),  //変換する文字列
      Length(Ret)+1,  //サイズ
      chr,  //変換結果
      Sizeof(chr)  //サイズ
      );
      Ret := Chr;
    //数値であるかチェック
    if TryStrToInt(Ret, intNum) then
    begin
      //数値である
      j := StrToInt(Ret);
      //本当に使える数値か、さらにチェック
      if (j = 0) or (j > 印刷ページの上限値) then
      begin
        MessageDlg('入力された値は印刷できない番号です。'+#13#10+
        '処理を中止します。', mtInformation, [mbOk] , 0);
        Exit;
      end else begin
        // j の値を使って印刷実行
        ・・・ 省略 ・・・
      end;
    end else begin
      MessageDlg('入力された値は数値ではありません!'+#13#10+
        '処理を中止します。', mtInformation, [mbOk] , 0);
      Exit;
    end;
  end;
end;

まぁ、確かにこれで目的は実現できてるから、イイっちゃイイんだけど・・・。
なんか、スマートじゃない・・・気がして。
あと出しジャンケンみたいで・・・

そこで、今回だけは逃げずに自分と戦うことにしました☆

2.MyInputQueryを作る

とりあえずの目標はVBAでやったように、InputQueryのテキストボックスのIMEモードをDisableに設定すること。

Google先生に訊いたら、次の情報を教えてくれた。

Vcl.StdCtrls.TCustomEdit.NumbersOnly

https://docwiki.embarcadero.com/Libraries/Sydney/ja/Vcl.StdCtrls.TCustomEdit.NumbersOnly

Delphi2009からNumbersOnlyプロパティがTEditに実装されたとのこと。で、さらに、そのTEditを内部に抱えているInputQueryの正体については、次のサイト他で情報をGet!

InputQueryについて

https://www.petitmonte.com/bbs/answers?question_id=4867

どうやらいちばんの問題解決方法は、InputQueryのソースコードをそのままコピペして(挙動不審にならないように)名前を変更し、それぞれの目的が実現できるようにコードを修正することのようだ。

上記Webサイト他に掲載されていたInputQueryのコードを読むと、自分でもなんとかなりそうだったので、さっそくやってみることにした。

で、書いたのが次のコード(ほとんどコピペですが・・・)。

//Formのメンバーにはしていません。
//名前は MyInputQuery に変更
function MyInputQuery(const ACaption, APrompt: string;
  var Value: string): Boolean;
var
  Form: TForm;
  Prompt: TLabel;
  Edit: TEdit;
  DialogUnits: TPoint;
  ButtonTop, ButtonWidth, ButtonHeight: Integer;

  function GetAveCharSize(Canvas: TCanvas): TPoint;
  var
    I: Integer;
    Buffer: array[0..51] of Char;
  begin
    for I := 0 to 25 do Buffer[I] := Chr(I + Ord('A'));
    for I := 0 to 25 do Buffer[I + 26] := Chr(I + Ord('a'));
    GetTextExtentPoint(Canvas.Handle, Buffer, 52, TSize(Result));
    Result.X := Result.X div 52;
  end;

begin
  Result := False;
  Form := TForm.Create(Application);
  with Form do begin
    try
      Canvas.Font := Font;
      DialogUnits := GetAveCharSize(Canvas);
      BorderStyle := bsDialog;
      Caption := ACaption;
      ClientWidth := MulDiv(180, DialogUnits.X, 4);
      Position := poScreenCenter;

      Prompt := TLabel.Create(Form);
      with Prompt do
      begin
        Parent := Form;
        Caption := APrompt;
        Left := MulDiv(8, DialogUnits.X, 4);
        Top := MulDiv(8, DialogUnits.Y, 8);
        Constraints.MaxWidth := MulDiv(164, DialogUnits.X, 4);
        WordWrap := True;
      end;
      Edit := TEdit.Create(Form);
      with Edit do
      begin
        Parent := Form;
        Left := Prompt.Left;
        Top := Prompt.Top + Prompt.Height + 5;
        Width := MulDiv(164, DialogUnits.X, 4);
        MaxLength := 255;
        Text := Value;
        SelectAll;

        //Password入力用にInputQueryを使用するための設定(Password Mask)
        //EditコントロールではPasswordCharに設定した文字が
        //入力した文字の代わりに表示される(デフォルトは'#0')
        //パスワードマスクするなら
        //PasswordChar:= '*';
        //これでマスクしなくなる('#0'として文字列化しないこと)
        PasswordChar := #0;

        //Delphi2009からTEditにNumbersOnlyプロパティ(数字だけを入力可能にする)が
        //実装されているそうなので、せっかくだからTrueにしてみた!
        //全角文字の「123」も「数値である」と判断してくれます・・・
        NumbersOnly := True;

        //IMEは使用不可(この1行がどうしても書きたかった!)
        ImeMode := imDisable;

        //文字位置
        //Alignment := taCenter;
        Alignment := taLeftJustify;
        //Alignment := taRightJustify;

      end;
      ButtonTop := Edit.Top + Edit.Height + 15;
      ButtonWidth := MulDiv(50, DialogUnits.X, 4);
      ButtonHeight := MulDiv(14, DialogUnits.Y, 8);
      with TButton.Create(Form) do
      begin
        Parent := Form;
        Caption := 'OK';
        ModalResult := mrOk;
        Default := True;
        SetBounds(MulDiv(38, DialogUnits.X, 4), ButtonTop, ButtonWidth,
          ButtonHeight);
      end;
      with TButton.Create(Form) do
      begin
        Parent := Form;
        Caption := 'キャンセル';
        ModalResult := mrCancel;
        Cancel := True;
        SetBounds(MulDiv(92, DialogUnits.X, 4), Edit.Top + Edit.Height + 15,
          ButtonWidth, ButtonHeight);
        Form.ClientHeight := Top + Height + 13;
      end;
      if ShowModal = mrOk then
      begin
        Value := Edit.Text;
        Result := True;
      end;
    finally
      Form.Free;
    end;
  end;
end;

このInputQueryをボタンクリックで呼び出します。

procedure TForm1.Button1Click(Sender: TObject);
var
  Ret:string;
begin
  if MyInputQuery('Dialog Caption', 'Please Enter the number:', Ret) then
  begin
    ShowMessage('Entered: '+ Ret);
  end else begin
    ShowMessage('False!');
  end;
end;

上のコードを実行すると・・・

InputQueryのTextBoxではIMEモードは変更できない
Form上のEditコントロールではIMEモードの切り替えが可能

これで、ずっと夢だった「数値のみ入力可能な」InputQueryが完成しました☆
さらに工夫すれば、入力できる数値の範囲を制限したりすることもできると思います。

また、次のWebサイトではマウスポインタの近くにInputQueryを表示させるという技も紹介されていました。

.InputQueryのポップアップ位置

https://www.petitmonte.com/bbs/answers?question_id=6520

3.まとめ

数値のみ入力可能なInputQueryを実現するには、InputQueryのソースコードをコピペして、名前を変更したInputQuery関数(例:MyInputQuery)を作成し、その中でやりたいことを書いていけばイイということ。

ここでは、「IMEModeの設定」を主に、それに加えて「パスワードマスク、NumbersOnlyプロパティ、文字位置(Alignment)」等の設定を行ってみた。

4.お願いとお断り

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

Mouse Down Event Usage Example

「MouseDownイベントの活用例」

手書き答案をスキャナーで読み込んで採点するプログラムを書いた。Gridコントロールへの入力に対し、各々の解答欄の画像に ○ や × や得点を表示できるようにしたら、合計点がなければ採点済み答案とは言えないコトに気付いた。でも、それを「どこ」に記入するかは答案ごとに違うし、採点ミスがあった場合は個別の修正に対応する必要もある。そこでMouseDownイベントが役に立ったというお話。

1.合計点はいつ・どこに書く?
2.画像に ○ や × それから得点も表示
3.「やっぱりココ!」に対応
4.まとめ
5.お願いとお断り

1.合計点はいつ・どこに書く?

多くの場合、それは答案の右上か、右下に書かれている。左上や左下、まして「ど真ん中」ってのはまず見たコトない・・・ケド。とりあえず、合計点を書く場所は、まったく採点者の自由で、法的に「ココじゃなきゃダメ」って、決められているなんて話は聞かない。だから、合計点を書く(プログラム的には「置く」の方がしっくりするが)場所は、採点者が「ココ!」ってクリックした位置にすることにした。100%自由ってステキ。

それから採点者も人間である以上、当然のように間違える。採点ミスがあれば、もちろん合計点も変わる。・・・ってコトは、PCと協働作業する以上、合計点の計算はPCに任せるからイイとして、それを答案画像に「二度と修正できない」カタチで「埋め込んで」しまうわけにはいかない。合計点は、返却用の答案画像を印刷するときに、「どっかから持ってきて」、答案画像の上に一時的に「置く」くらいがちょうどイイ。

・・・ということで、基本方針だけを決め、新しいチャレンジがはじまった!

2.画像に や × それから得点も表示

最初は正誤の表示(○と×)だけだったけれど、得点も表示することにした

上のような画面に、スキャンした答案画像から設問ごとにかき集めた解答欄を表示してイッキに採点する。上のように全員が同じ解答なら得点の一括入力も可能だ。採点が済んだら、読み込み元の答案画像とは別に用意した返却用の答案画像に、集めてきた時とは逆のアルゴリズムで書き戻す。

答案に書き戻してみたところ(もっとズレるかと思ったが案外ずれてない)

で、決定的に足りないモノがあることに気づく・・・。ここまでやって「合計点がない」というのは、仏作って魂入れず & 画竜点睛を欠く & ツメが甘い & 九仞の功を一簣に虧く 以外の何者でもない。日本語の豊かさに感動しつつ、もっと簡単な言い方をすれば、プログラムは、どう考えても不完全。元よりこれを売るつもりはまったくナイけど(買うヒトがいるとも思えない)、合計点が「出ない」採点プログラムなんて詐欺だ。

なにより、この答案は、なんだかさみしい・・・

恐るべし。合計点の存在感。

・・・ということで、合計点も入れることに。

3.「やっぱりココ!」に対応

StringGridに見えない列を1つ追加して、ここに計算した合計点を書き込んでおけばいつでも印刷に使える。合計点の計算そのものはカンタン。何も問題はない。

var
  i, j, k:integer;
begin
  //初期化
  k:=0;
  //合計点を計算
  for i := 1 to StringGrid1.RowCount-1 do
  begin
    for j := 1 to ( 解答欄の数 ) do
    begin
      if StringGrid1.Cells[j,i] <> '' then
      begin
        k := K + StrToInt(StringGrid1.Cells[j, i]);
      end;
    end;
    //StringGrid.Cells[, ]
    StringGrid1.Cells[( 解答欄の数 ) + 1, i]:= IntToStr(k);
    //初期化
    k:=0;
  end;

これで合計点の準備はOK!
あとは「いつ」印刷するか・・・ってか、採点ミスがあった時、カンタンに合計点も修正できるようにしなければならない。これは結構、難しい。合計点を答案画像に画像データとして埋め込んでしまうと、まず修正はできない。どぉーするか・・・

よく考えたら(よく考えなくても)、この解答用紙には合計点を記入する場所すらない。まぁもともとがマークシートで、そこに無理やり手書き用の解答欄を付け加えたのがほんとうだから、ないのが当然なんだが。

こうなったらもう、面倒なことは全部やめて、答案画像を印刷する直前に、採点者が適当に「ココ!」ってクリックした場所に合計点を置いて、印刷はするけど、その後、画像は保存しない仕様で行こう。

印刷日が異なると、ビミョー(ヒトによっては大きく)に合計点印刷位置がズレる・・・という問題?は、「気にしない」ことにしよう。法的には何の問題もない。返却された答案に合計点が「ある」ことが大切なのだ。

フォントの大きさは、得点入力のところで使った指定をそのまま使えばイイ。

FontのSizeは50

これでアルゴリズムは決まり。あとは採点者に「ココ!」って指定してもらうプログラムをDelphiで書くだけ。でも、その「ココ!」はきっと、やっぱりもぉちょっと上とか、左とか、位置指定をやり直したい場合が絶対あるよなー。どぉするか・・・

TImageの上でマウスのボタンを押すたびにMouseDownイベントが起こるから、コレをうまく活用すればイイ。きっとそれだなー。で、書いたのがコレです。

合計点を印刷したい場所をクリックするとサンプル99を表示
procedure TFormCollaboration.Image1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  //表示倍率
  rate:Double;
  ・・・ 省略 ・・・

  //普通の四捨五入を行う関数を設定
  function Roundoff(X: Extended): Longint;
  begin
    if x >= 0 then Result := Trunc(x + 0.5)
              else Result := Trunc(x - 0.5);
  end;

  //合計点印刷位置の座標を取得する手続き
  procedure GetXY(iX,iY:Integer);
  begin
    //合計点印刷位置の座標を取得
    iX:= Roundoff(iX/(TrackBar1.Position/100));
    iY:= Roundoff(iY/(TrackBar1.Position/100));
    //表示倍率を計算(答案画像は縮小してWidth1000にセットしている)
    rate:= 1000/Image1.Picture.Bitmap.Width;
    合計点のX座標:= Trunc(iX/rate);
    合計点のY座標:= Trunc(iY/rate);
    //矩形を描画
    with Image1 do
    begin
      //Canvas.Brush.Style:= bsClear;  //Pythonを使っていない時はこれでOK!
      //Pythonを使っている時は明示的に書く(Python.pasにもbsClearが定義されている)
      Canvas.Brush.Style:= Vcl.Graphics.bsClear;  
      Canvas.Pen.Color:=clRed;
      Canvas.Pen.Width:=3;
      //矩形を描画
      (サンプル99はLabelのCaption).Font.Size:=StrToInt(ComboBox.Text);
      Canvas.Rectangle(合計点のX座標, 
                       合計点のY座標, 
                       合計点のX座標 + Label.Width, 
                       合計点のY座標 + Label.Height);
      //サンプル合計点を描画
      Canvas.Font.Color:=clRed;
      Canvas.Font.Size:=StrToInt(ComboBox.Text);
      Canvas.TextOut(合計点のX座標, 合計点のY座標, Label.Caption);
    end;
  end;

begin
  //座標を指定する手続きを呼び出し
  GetXY(X,Y);
  //Information
  if MessageDlg('印刷位置は、この位置でよろしいですか?' + #13#10 + #13#10 +
    '(左寄せ・数字はサンプル。矩形は印刷されません。)', 
    mtInformation, [mbYes, mbNo], 0) = mrYes then
  begin
    //[はい]が選ばれた時
    //案内
    MessageDlg('印刷ボタンをクリックしてください。', mtInformation,[mbOK],0);
    //バルーンヒントを表示
    BalloonHint1.Title := '印刷ボタン';
    BalloonHint1.Description := 'ココです!';
    BalloonHint1.HideAfter := 3000; //表示時間(単位:ms)
    BalloonHint1.ShowHint(button.ClientToScreen(CenterPoint(button.ClientRect)));
    //案内アイコンも追加
    BalloonHint1.ImageIndex := 0;
    //カーソルを元に戻す
    Screen.Cursor:=crDefault;
    Image1.Visible:=False;
    Image1.Picture.Assign(nil);
    //SetFocus
    button.Enabled:=True;
    button.SetFocus;
  end else begin
    //[いいえ]が選ばれた時
    with Image1 do
    begin
      //Canvas.Brush.Style:=bsClear;  //Pythonを使っていない時はこれでOK!
      //Pythonを使っている時(Python.pasにもbsClearが定義されている)
      Canvas.Brush.Style:=Vcl.Graphics.bsClear;  
      Canvas.Pen.Color:=clWhite;
      Canvas.Pen.Width:=3;
      //矩形を描画
      (サンプル99はLabelのCaption).Font.Size:=StrToInt(ComboBox.Text);
      Canvas.Rectangle(合計点のX座標, 
                       合計点のY座標, 
                       合計点のX座標 + Label.Width, 
                       合計点のY座標 + Label.Height);
      //サンプル合計点を描画
      Canvas.Font.Color:=clWhite;
      Canvas.Font.Size:=StrToInt(ComboBox.Text);
      Canvas.TextOut(合計点のX座標, 合計点のY座標, Label.Caption);
    end;
  end;
end;

ユーザーが「ココ!じゃない」=「いいえ」を選択した場合は、サンプルとして表示した合計点を消去しなければならない。Undoの実装方法をいろいろ調べてみたのだが、よくわからない。で、思いついたのが上の方法。「いいえ」が選択された場合は、サンプルを「赤」じゃなくて「白」で書いちゃう。正直、完全に消えるわけじゃなくて、なぜか、よく見るとうっすらと赤が残っているけれど、気にしない。これで全然イケます。

合計点も印刷できるようになりました!

【追記 20221003】

合計点はサンプル「99」ではなく、個々の合計点を取得して表示できるよう、プログラムを修正しました。下のリンク先をご参照ください。

4.まとめ

そこにTImageがあれば、彼はいつでも OnMouseDown を待ち続けているから、このイベントをうまく利用すれば、再帰的な処理(?)が実現できてしまう。画像として保存したくは「ない」んだけれど、印刷時には「ちょっとイジりたい」時にはこんな方法もあります・・・というお話でした。

5.お願いとお断り

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

How to use the StatusBar

「StatusBarの使い方」

これまでStatusBarを使う時は、FormCreate 時にその SimplePanel プロパティを True に設定して、あとは必要なところで SimpleText に表示したい文字列を指定したり、ProgressBar の Parent を StatusBar にして、時間のかかる処理の進捗状況を示したりしてきた。が、今回、いろいろあって TStatusPanels を使って、StatusBar に表示する文字の色を変えたり、背景色を変更する方法を学んだ。これは、その覚書。

1.いちばんカンタンな使い方(SimplePanel:=True;)
2.TStatusPanelsを使う(SimplePanel:=False;)
3.こんなこともできた! (その1) (その2)
4.まとめ
5.お願いとお断り

1.いちばんカンタンな使い方

StatusBar のいちばんカンタンな使い方は、SimplePanel プロパティを True (デフォルトは False )にして、StatusBar の SimpleText プロパティに表示したい文字列を指定する方法だ。

以下、いちばんカンタンな使い方の例。

新しいVCLアプリケーションを作成し、適当に名前を付けてプロジェクトを保存して、パレットにStatusと入力、表示されたTStatusBarをダブルクリックする。

FormにTStatusBarを追加したところ

Formのいちばん下に(自動的に位置は指定される)StatusBar1が追加される。

次に、Form をクリックして選択し、オブジェクト インスペクタのイベントタブをクリックして、OnCreate イベントの右の空白部分をダブルクリック。FormCreate 手続きを作成する。で、忘れないうちに次の1行を入力する。

procedure TForm1.FormCreate(Sender: TObject);
begin
  //設定
  StatusBar1.SimplePanel:= True;
end;

StatusBar1.SimplePanel:= True; とすることで、StatusBar1.SimpleText に指定した文字列がそのまま自動的にStatusBarに表示されるようになる(SimplePanel のデフォルト設定は False なので、これを True に変更しておかないと Statusbar への描画は StatusBar1DrawPanel イベントに全て自前で記述しなければ「行われない!」)。

あとは使いたいシーンで、SimpleTextに代入した文字列を表示するようコードを書けばOK! 例えば、「進捗状況:」と表示するなら、FormにButtonを1個追加して、Button1Click手続きを作成し、以下のように記述。

procedure TForm1.Button1Click(Sender: TObject);
begin
  //表示
  StatusBar1.SimpleText:= '進捗状況:';
end;

実行(F9)すれば ・・・

StatusBarに文字列を表示

進捗状況を表示するコントロールと言えば ProgressBar。これをFormに追加して、FormCreate 及び Button1Click の各手続きに以下のコードを記述(赤文字が追加するコード)。

procedure TForm1.FormCreate(Sender: TObject);
var
  w: integer;
begin

  //設定
  StatusBar1.SimplePanel:=True;

  //文字列の長さを取得
  w:=StatusBar1.Canvas.TextWidth('進捗状況:');

  //ProgressBarの設定
  with ProgressBar1 do begin
    Parent  := StatusBar1;
    Top     := 2;  //表示位置の調整
    Left    := w;
    Height  := StatusBar1.Height-2;
    Width := StatusBar1.Width-20;
    Visible :=False;
  end;

end;
procedure TForm1.Button1Click(Sender: TObject);
begin
  //表示
  StatusBar1.SimpleText:= '進捗状況:';
  ProgressBar1.Visible:=True;

end;

保存(Ctrl+S)して、実行(F9)

ボタンをクリックすると、StatusBarに文字列とProgressBarが表示される

せっかくここまで書いたのですから、ProgressBarに進捗状況を表示しましょう。以下のコードをButton1Click手続きに追加します(赤文字が追加するコード)。

procedure TForm1.Button1Click(Sender: TObject);
var
  i: integer;
begin
  //表示
  StatusBar1.SimpleText:= '進捗状況:';

  //ProgressBarの設定
  ProgressBar1.Visible:=True;
  ProgressBar1.Position:=0;
  ProgressBar1.Max:=100;

  for i:= 0 to 100 do
  begin
    ProgressBar1.Position:= i; // -> MAXまで表示されない
    Sleep(25);
    Application.ProcessMessages;
  end;
  ProgressBar1.Visible:= False;
  ShowMessage('Done!');

end;

保存(Ctrl+S)して、実行(F9)してみるとわかるのですが、このコードには問題があります。上にすでにコメントとして書いてある通り、ProgressBarのPositionが100まで表示されないのです。機能的には、「処理が進んでいることがユーザーに伝わればいい」ので、それほど大きな問題ではありませんが、表示できるものならやはり100まで表示できたほうが気持ちイイ。

実は少し工夫すれば100まできちんと表示できます。以前、どこかWeb上の情報で知ったのですが、Loopの中で増加する i の値をそのままProgressBarのPositionに代入せず、現在の i 値より「1大きな値をまず代入」し、その後、「1小さい値をセットしなおす」という技です。どなたが考えた技か知りませんが、これで100まできちんと表示できます。以下に、そのコードを示します(赤文字が追加するコード)。

procedure TForm1.Button1Click(Sender: TObject);
var
  i, j:integer;
begin
  //表示
  StatusBar1.SimpleText:= '進捗状況:';

  //ProgressBarの設定
  ProgressBar1.Visible:=True;
  ProgressBar1.Position:=0;
  ProgressBar1.Max:=100;
  //初期化
  j:= 0;
  for i:= 0 to 100 do
  begin
    //ProgressBar1.Position:= i; // -> MAXまで表示されない

    // 100まで表示するコード
    inc(j);
    If ProgressBar1.Position < ProgressBar1.Max Then
    begin
      //目的の値より一つ大きくしてから、目的の値にする
      ProgressBar1.Position:= j + 1;
      ProgressBar1.Position:= j;
    end else begin
      //最大値にする時
      //最大値を1つ増やしてから、元に戻す
      ProgressBar1.Max:= 100 + 1;
      ProgressBar1.Position:= j + 1;
      ProgressBar1.Max:= 100;
      ProgressBar1.Position:= j;
    end;
    Sleep(25);
    Application.ProcessMessages;
  end;
  ProgressBar1.Visible:= False;
  ShowMessage('Done!');

end;

さらにLabelを使って、次のような表示の追加も可能です。FormにLabelを1つ追加して、次のコードを FormCreate と Button1Click の各手続きに追加します(赤文字が追加するコード)。

Labelを1つFormに追加
procedure TForm1.FormCreate(Sender: TObject);
var
  w: integer;
begin

  //設定
  StatusBar1.SimplePanel:= True;

  //文字列の長さを取得
  w:=StatusBar1.Canvas.TextWidth('進捗状況:');

  //ProgressBarの設定
  with ProgressBar1 do begin
    Parent  := StatusBar1;
    Top     := 2;  //表示位置の調整
    Left    := w;
    Height  := StatusBar1.Height - 2;
    Width := StatusBar1.Width - 20;
    Visible := False;
  end;

  //LabelをProgressBarの中心に表示
  Label1.Parent:= ProgressBar1;  // ParentがStatusBarでないことに注意する
  Label1.AutoSize:= False;
  Label1.Transparent:= True;
  Label1.Caption:= '';
  Label1.Visible:= False;

end;
procedure TForm1.Button1Click(Sender: TObject);
var
  i, j:integer;
begin

  //進捗状況を表示するLabelの設定
  Label1.Visible:=True;
  Label1.Top:= 0;
  Label1.Left:= 0;
  Label1.Width:= ProgressBar1.ClientWidth;
  Label1.Height:= ProgressBar1.ClientHeight;
  Label1.Alignment:= taCenter;
  Label1.Layout:= tlCenter;

  //表示
  StatusBar1.SimpleText:= '進捗状況:';

  //ProgressBarの設定
  ProgressBar1.Visible:= True;
  ProgressBar1.Position:= 0;
  ProgressBar1.Max:= 100;
  //初期化
  j:= 0;
  for i:= 0 to 100 do
  begin
    //ProgressBar1.Position:= i; // -> MAXまで表示されない

    //値を増やす
    inc(j);
    If ProgressBar1.Position < ProgressBar1.Max Then
    begin
      //目的の値より一つ大きくしてから、目的の値にする
      ProgressBar1.Position:= j + 1;
      ProgressBar1.Position:= j;
    end else begin
      //最大値にする時
      //最大値を1つ増やしてから、元に戻す
      ProgressBar1.Max:= 100 + 1;
      ProgressBar1.Position:= j + 1;
      ProgressBar1.Max:= 100;
      ProgressBar1.Position:= j;
    end;

    //数値でも進捗状況を表示
    Label1.Caption:= '( '+IntToStr(j-1)+' %)';

    Sleep(25);
    Application.ProcessMessages;
  end;
  ProgressBar1.Visible:= False;
  ShowMessage('Done!');

end;

保存(Ctrl+S)して、実行(F9)。

数値でも進捗状況を表示

Button1Click手続きの最後にある「ProgressBar1.Visible:= False;」をコメント化して表示の状況を確認することもできます。「Label1.Visible:=False;」としなくてもLabelが非表示になるのは、Label1のParentを「Label1.Parent:=ProgressBar1;」としているためだと思われます。

【ヒントをStatusBarに表示する】

引用先には、設定したヒントをことごとくStatusBarに表示するという技が紹介されていました。StatusBar1.SimplePanel プロパティを True に設定して使うのであれば、内容もシンプルで、実際に使えるテクニックだと思います。

ヒントをステータスバーに表示するようなアプリケーションのためのコード

http://hp.vector.co.jp/authors/VA015850/delphi/fragments/AppHint.html

以上、いちばんカンタンなStatusBarの使い方でした!

2.TStatusPanelsを使う方法

2つめが、StatusBarがもともと持っているPanelを1つ、または複数個設置して、各々のPanelに対して描画の指示を出すという方法です。

新しいプロジェクトを作成し、FormにStatusBarを1つ、追加します。で、これを選択したまま、オブジェクト インスペクタのPanelsプロパティの(TStatusPanels)の右の…をクリックすると、次のような別Windowが表示されます。

(TstatusPanels)の右にある…をクリック

左上の「新規追加」アイコンを2回クリックして、StatusPanelを2つ追加します。

StatusPanelを2つ追加したところ

ここではStatusBarに表示する文字の文字色を変えたり、背景色を変更してみたいと思います。「0-TStatusPanel」をクリックして選択し、オブジェクト インスペクタのStyleプロパティをデフォルトの「psText」から「psOwnerDraw」へ変更します。

0-TStatusPanelを選択
StyleプロパティをpsOwnerDrawに変更

同じ操作を「1-TStatusPanel」にも行います。
これでStatusBarへの描画は「すべて自力で行う」ことになります。
設定したら右上の閉じるボタンをクリックして、設定画面を閉じます。

TStatusPanelをコードで設定する場合は、FormCreate手続きに以下の内容を入力します(赤文字が追加するコード)。

procedure TForm1.FormCreate(Sender: TObject);
var
  w:integer;
begin

  //コードで設定
  //StyleをpsOwnerDrawに変更
  StatusBar1.Panels[0].Style:=psOwnerDraw;
  StatusBar1.Panels[0].Text:='Information:';

  //Panel[0]の幅の調整(表示する予定の文字列で初期化)
  w:= StatusBar1.Canvas.TextWidth('Information:');
  StatusBar1.Panels[0].Width:= w + 15;
  StatusBar1.Refresh;

  //StyleをpsOwnerDrawに変更
  StatusBar1.Panels[1].Style:= psOwnerDraw;
  StatusBar1.Panels[1].Text:= '最初の表示';

end;

保存(Ctrl+S)して、実行(F9)。

よく見ると、StatusBarに StatusBar1.Panels[0] と StatusBar1.Panels[1] があることがわかります。コードで設定したはずの文字列は、Styleプロパティを psOwnerDraw へ変更したので当然表示されていません。

描画コードを設定して、文字列が表示されるようにします。
StatusBarをクリックして選択し、オブジェクト インスペクタのOnDrawPanelプロパティ右側の空欄をダブルクリックして StatusBar1DrawPanel 手続きを作成し、次のコードを入力します。

StatusBar1DrawPanel 手続きを作成
procedure TForm1.StatusBar1DrawPanel(StatusBar: TStatusBar; Panel: TStatusPanel;
  const Rect: TRect);
var
  ARect: TRect;
begin

  if Panel = StatusBar.Panels[0] then
  begin

    //文字色(このPanel内のみ有効となるようだ)
    StatusBar1.Canvas.Font.Color:= clBlack;

    //背景色(このPanel内のみ有効となるようだ)
    StatusBar1.Canvas.Brush.Color:= clBtnFace;

    //矩形を取得
    ARect:= Rect;

    //表示位置(中央寄せ)
    DrawText(StatusBar1.Canvas.Handle, PChar(Panel.Text), -1, ARect,
      DT_CENTER or DT_VCENTER or DT_SINGLELINE);

  end;

  if Panel=StatusBar.Panels[1] then
  begin

    //文字の表示(このPanel内のみ有効となるようだ)
    StatusBar1.Canvas.Font.Color:= clBlack;

    //背景色(このPanel内のみ有効となるようだ)
    StatusBar1.Canvas.Brush.Color:= clBtnFace;

    //矩形を取得
    ARect:= Rect;

    //表示位置(左寄せ)
    DrawText(StatusBar1.Canvas.Handle, PChar(Panel.Text), -1, ARect,
      DT_LEFT or DT_VCENTER or DT_SINGLELINE);

  end;

end;

保存(Ctrl+S)して、実行(F9)。

StatusBar1DrawPanel手続きに描画コードを書いたので文字列が表示される

文字列の色と背景色を変更してみましょう。Panels[0]の方だけ、コードを少し変更します。

  if Panel = StatusBar.Panels[0] then
  begin

    //文字色(このPanel内のみ有効となるようだ)
    //StatusBar1.Canvas.Font.Color:= clBlack;
    StatusBar1.Canvas.Font.Color:= clBlue;

    //背景色(このPanel内のみ有効となるようだ)
    //StatusBar1.Canvas.Brush.Color:= clBtnFace;
    StatusBar1.Canvas.Brush.Color:= clAqua;

    //矩形を取得
    ARect:= Rect;

    //表示位置(中央寄せ)
    DrawText(StatusBar1.Canvas.Handle, PChar(Panel.Text), -1, ARect,
      DT_CENTER or DT_VCENTER or DT_SINGLELINE);

  end;

保存(Ctrl+S)して、実行(F9)。

ボタンをクリックするとPanel[1]の文字列が変わるようにしてみます。
FormにButtonを1つ、追加して次のコードを書きこます。

procedure TForm1.Button1Click(Sender: TObject);
begin
  StatusBar1.Panels[1].Text:= '2番目の表示';
end;

保存(Ctrl+S)して、実行(F9)。

描画更新(StatusBar1.Refresh等)の命令は必要ないようだ

最初に紹介したように、進捗状況の表示に使うのであれば、Panel[1]の方にProgressBarを設定すればOKです。やり方は、次の通り(FormにProgressBarとLabelとButtonを1つずつ、追加してからコードを書きます)。

まず、ボタンをクリックした時の処理。こちらは全部新規に書きます。

procedure TForm1.Button2Click(Sender: TObject);
var
  i, j: integer;
  w: integer;
begin

  //進捗状況を表示するLabelの設定
  Label1.Visible:= True;
  Label1.Top:= 0;
  Label1.Left:= 0;
  Label1.Width:= ProgressBar1.ClientWidth;
  Label1.Height:= ProgressBar1.ClientHeight;
  Label1.Alignment:= taCenter;
  Label1.Layout:= tlCenter;
  Label1.Font.Color:= clBlue;

  //表示する文字列を設定
  StatusBar1.Panels[0].Text:= '進捗状況:';
  //Panel[0]の幅の調整(表示する予定の文字列で初期化)
  w:=StatusBar1.Canvas.TextWidth('進捗状況:');
  StatusBar1.Panels[0].Width:= w + 10;
  StatusBar1.Refresh;

  //Panels[1]の文字列は初期化
  StatusBar1.Panels[1].Text:= '';

  //ProgressBarの設定
  ProgressBar1.Visible:= True;
  ProgressBar1.Position:= 0;
  ProgressBar1.Max:= 100;
  //初期化
  j:= 0;
  for i:= 0 to 100 do
  begin
    //ProgressBar1.Position:=i; // -> MAXまで表示されない
    //値を増やす時
    j:= j + 1;
    If ProgressBar1.Position < ProgressBar1.Max Then
    begin
      //目的の値より一つ大きくしてから、目的の値にする
      ProgressBar1.Position:= j + 1;
      ProgressBar1.Position:= j;
    end else begin
      //最大値にする時
      //最大値を1つ増やしてから、元に戻す
      ProgressBar1.Max:= 100 + 1;
      ProgressBar1.Position:= j + 1;
      ProgressBar1.Max:= 100;
      ProgressBar1.Position:= j;
    end;
    //処理件数を表示
    Label1.Caption:='( '+IntToStr(j-1)+' %)';
    Sleep(25);
    Application.ProcessMessages;
  end;
  ProgressBar1.Visible:= False;
  StatusBar1.Panels[1].Text:= '終了!';
  ShowMessage('Done!');

end;

FormCreate手続きに処理を追加(赤文字の部分)。

procedure TForm1.FormCreate(Sender: TObject);
var
  w:integer;
begin

  //コードで設定
  //StyleをpsOwnerDrawに変更
  StatusBar1.Panels[0].Style:= psOwnerDraw;
  StatusBar1.Panels[0].Text:= 'Information:';

  //Panel[0]の幅の調整(表示する予定の文字列で初期化)
  w:= StatusBar1.Canvas.TextWidth('Information:');
  StatusBar1.Panels[0].Width:= w + 15;
  StatusBar1.Refresh;

  //StyleをpsOwnerDrawに変更
  StatusBar1.Panels[1].Style:= psOwnerDraw;
  StatusBar1.Panels[1].Text:= '最初の表示';

  //進行状況バーをステータスバーに配置する
  ProgressBar1.Parent:=StatusBar1;
  ProgressBar1.Visible:=False;

  //LabelをProgressBarの中心に表示
  Label1.Parent:=ProgressBar1;
  Label1.AutoSize:=False;
  Label1.Transparent:=True;
  Label1.Caption:='';
  Label1.Visible:=False;

end;

StatusBar1DrawPanel手続きの if Panel=StatusBar.Panels[1] then 部分にもProgressBarに関する処理を追加します(赤文字の部分)。

  if Panel=StatusBar.Panels[1] then
  begin

    //文字の表示(このPanel内のみ有効となるようだ)
    StatusBar1.Canvas.Font.Color:= clBlack;

    //背景色(このPanel内のみ有効となるようだ)
    StatusBar1.Canvas.Brush.Color:= clBtnFace;

    //矩形を取得
    ARect:= Rect;

    //表示位置(左寄せ)
    DrawText(StatusBar1.Canvas.Handle, PChar(Panel.Text), -1, ARect,
      DT_LEFT or DT_VCENTER or DT_SINGLELINE);

    //ProgressBarの位置を設定
    With ProgressBar1 do begin
      Top:=Rect.Top;
      Left:=Rect.Left;
      Width:=Rect.Right - Rect.Left - 15;
      Height:=Rect.Bottom - Rect.Top;
    end;

  end;

保存(Ctrl+S)して、実行(F9)。

進捗状況の表示に関する限り、「これがいちばんイイ」と私は思います。

以上がPanelを複数使用して、各々のPanelに対して文字色や背景色を設定する方法の解説です。

3.こんなこともできた! (その1)

他にも実現方法はたくさんあると思いますが、ユーザーに対して最初の1回だけは「とても重要な案内表示を行いたい」場合もあると思います。で、ユーザーが理解したことを(OKボタンを押すなどして)表明したら、もうその表示はプログラムが終了するまで出さない・・・みたいな処理をStatusBarを使って書いてみました。

ボタン3をクリックすると1回だけ案内を表示(OKするとプログラム終了まで表示されない)

FormにButtonを2つ追加します。ここで解説に使ったFormをそのまま使う場合は、新しく追加したボタンはButton3とButton4になります。Button4のNameは「btnOK」、Captionは「OK」に、Widthは「40」、Visibleは「False」に変更します。で、次のコードを記述します。

  private
    { Private 宣言 }
    boolInfo: boolean;

表示の制御に使用するフラグをグローバル変数として宣言しました。続けてButton3をクリックした時の処理を書きます。

procedure TForm1.Button3Click(Sender: TObject);
var
  w:integer;
begin
  if not boolInfo then
  begin
    //制御用フラグを既読扱いに設定
    boolInfo:=True;
    StatusBar1.Panels[1].Text:= '最初の1回だけは表示したい案内';
    //OKボタンを表示する位置を設定
    w:= StatusBar1.Canvas.TextWidth('最初の1回だけは表示したい案内');
    btnOK.SetBounds(
      StatusBar1.Panels[0].Width + w + 5, 0, 40, StatusBar1.ClientHeight);
    btnOK.Visible:=True;
    StatusBar1.Refresh;
  end;
end;

FormCreate手続きに追加する処理です。

procedure TForm1.FormCreate(Sender: TObject);
var
  w:integer;
begin

  ・・・ 省略 ・・・

  //案内表示の制御用フラグ
  boolInfo:= False;

  //OKボタン
  btnOK.Parent:= StatusBar1;
  btnOK.Visible:= False;

end;

StatusBar1DrawPanel手続きの中の if Panel=StatusBar.Panels[1] then の内容を次のように変更します。

  if Panel=StatusBar.Panels[1] then
  begin

    //文字の表示(このPanel内のみ有効となるようだ)
    if not boolInfo then
    begin
      StatusBar1.Canvas.Font.Color:= clBlack;
    end else begin
      StatusBar1.Canvas.Font.Color:= clBlue;
    end;

    //背景色(このPanel内のみ有効となるようだ)
    if not boolInfo then
    begin
      StatusBar1.Canvas.Brush.Color:= clBtnFace;
    end else begin
      StatusBar1.Canvas.Brush.Color:= clAqua;
    end;

    ・・・ 省略 ・・・

  end;

グローバル変数を使用するので、Button1、2が押された時の処理にも制御用変数の初期化を忘れずに追加します。

procedure TForm1.Button1Click(Sender: TObject);
begin
  //制御用フラグを初期化
  boolInfo:= False;
  //表示
  StatusBar1.Panels[1].Text:= '2番目の表示';
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
  //制御用フラグを初期化
  boolInfo:= False;
  
  ・・・ 省略 ・・・
end;

最後に、ユーザーが表示された案内を読み、内容を理解したことを「OK」ボタンを押したというイベントから受け取ります。そのOKボタンの処理です。

procedure TForm1.btnOKClick(Sender: TObject);
begin
  StatusBar1.Canvas.Brush.Color:= clBtnFace;
  StatusBar1.Canvas.Font.Color:= clBlack;
  StatusBar1.Panels[1].Text:= '';
  btnOK.Visible:= False;
end;

これで他の動作モード(Button1や2をクリック)に切り替えない限り、1回OKをクリックすると、もうButton3を何度クリックしても案内は表示されなくなります。

以上、こんなこともできた!(その1) でした。

3.こんなこともできた(その2)

Panelを1つだけ用意して、次のように設定することで、文字列だけでなく、文字の色や背景色の変更も比較的簡単に実現できます。設定方法は次の通り。

StatusBarのSimplePanelは「False」に設定(デフォルト設定のまま)
StatusBarにPanelを1つ追加、StyleをpsOwnerDrawに設定

重要な設定のポイントは2つ。
(1)StatusBarのSimplePanelは「False」に設定(デフォルト設定のまま)
(2)追加したPanelのStyleはpsOwnerDrawに変更(デフォルト設定はpsText)
さらに、これをコードでも設定しておけば、見た目にもわかりやすいと思います。

procedure TForm1.FormCreate(Sender: TObject);
begin
  //SimplePanelの設定
  StatusBar1.SimplePanel:= False;
  //StyleをpsOwnerDrawに変更
  StatusBar1.Panels[0].Style:= psOwnerDraw;
end;

準備ができたら、次の2つの手続きを作成します。

procedure TForm1.Button1Click(Sender: TObject);
begin
  //描画内容の指定
  StatusBar1.SimpleText:='文字列の表示&文字色及び背景色の変更をSimpleTextで実行';
end;
procedure TForm1.StatusBar1DrawPanel(StatusBar: TStatusBar; Panel: TStatusPanel;
  const Rect: TRect);
begin
  if Panel = StatusBar.Panels[0] then
  begin
    //Fontの色
    StatusBar1.Canvas.Font.Color:=clBlue;
    //背景色
    StatusBar1.Canvas.Brush.Color:=clAqua;
    //描画コード
    StatusBar1.Canvas.TextOut(Rect.left, Rect.top, StatusBar1.SimpleText);
  end;
end;

保存(Crtl+S)して、実行(F9)。

文字だけでは気付いてもらえないかな?・・・みたいな時に使えます!

記述するコードも少なく、比較的簡単に「色の変更」を実装できる方法なのではないか・・・と思います。ただし、さらに色の変更を追加したい場合などには、注意が必要です。それは何かというと、「色の変更の設定はStatusBar1DrawPanel手続きの中で行う」ということです。以下のコードは動作しません。

// 注意:このコードは検証用です。正しく動作しません!
procedure TForm1.Button1Click(Sender: TObject);
begin
  //Fontの色
  StatusBar1.Canvas.Font.Color:=clBlue;
  //背景色
  StatusBar1.Canvas.Brush.Color:=clAqua;
  //描画内容の指定
  StatusBar1.SimpleText:='文字列の表示&文字色及び背景色の変更をSimpleTextで実行';
end;

procedure TForm1.StatusBar1DrawPanel(StatusBar: TStatusBar; Panel: TStatusPanel;
  const Rect: TRect);
begin
  if Panel = StatusBar.Panels[0] then
  begin
    //描画コード
    StatusBar1.Canvas.TextOut(Rect.left, Rect.top, StatusBar1.SimpleText);
    //この手続きの中で更新を実行してはいけない(検証用に追加、すべて誤りです)
    //StatusBar1.Refresh;
    //StatusBar1.Repaint;
    //StatusBar1.Update;
    //StatusBar1.Invalidate;
  end;
end;

【参考】Refreshメソッド

Refresh メソッドを呼び出すと,速やかにコントロールを再描画できます。Refresh は Repaint メソッドを呼び出します。Refresh と Repaint メソッドとは互換性があります。

https://docwiki.embarcadero.com/Libraries/Sydney/ja/Vcl.Controls.TControl.Refresh

保存(Crtl+S)して、実行(F9)。

テキストは表示されるが、文字色も背景色も変更されない

ですから、Buttonをもう一つ追加して、押したボタンによって表示される文字や背景の色を変更したい場合は、グローバル変数「例 ColorMode: boolean;」を準備して、Falseなら青、Trueなら赤にする等、さらなる工夫が必要です。以下、その場合の例です。

  private
    { Private 宣言 }
    ColorMode: boolean;

procedure TForm1.FormCreate(Sender: TObject);
begin
  //SimplePanelの設定
  StatusBar1.SimplePanel:= False;
  //StyleをpsOwnerDrawに変更
  StatusBar1.Panels[0].Style:= psOwnerDraw;
  //デフォルトの文字色は青
  ColorMode:= False;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  //色の設定はSimpleTextへの文字列の代入より先に行うこと!
  //理由:SimpleTextへの文字列の代入即DrawPanel手続きが実行されるため
  //色は青
  ColorMode:= False;
  //描画内容の指定
  StatusBar1.SimpleText:= '文字列の表示&文字色及び背景色の変更をSimpleTextで実行';
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  //色は赤
  ColorMode:=True;
  //描画内容の指定
  StatusBar1.SimpleText:= 'SimpleTextで文字列の表示&文字色及び背景色の変更を実行';
end;

procedure TForm1.StatusBar1DrawPanel(StatusBar: TStatusBar; Panel: TStatusPanel;
  const Rect: TRect);
begin
  if Panel = StatusBar.Panels[0] then
  begin
    if not ColorMode then
    begin
      //Fontの色
      StatusBar1.Canvas.Font.Color:= clBlue;
      //背景色
      StatusBar1.Canvas.Brush.Color:= clAqua;
    end else begin
      //Fontの色
      StatusBar1.Canvas.Font.Color:= clRed;
      //背景色
      StatusBar1.Canvas.Brush.Color:= clWebViolet;
    end;
    //描画コード
    StatusBar1.Canvas.TextOut(Rect.left, Rect.top, StatusBar1.SimpleText);
  end;
end;

保存(Crtl+S)して、実行(F9)。

Button1をクリックしたところ
Button2をクリックしたところ

さらに複数の色を使いたい場合は、TRadioGroup等を利用して、そこで色をユーザーに選択してもらい、StatusBar1DrawPanel 手続きでは、if文ではなくcase文を利用し、その中で RadioGroup の ItemIndex を参照して色を変更する方法が考えられます。

TRadioGroupを利用する場合は、StatusBar1.Refreshも実行する必要があるようです(実行するタイミングも重要!-> StatusBar1DrawPanel 手続きではなく、ButtonClickの中で行う。Refreshを実行する場所を間違えると、これがエンエンと呼び出され続け、画面の描画が非常に重たくなり、通常1つしか選択できないはずのオプションボタンが同時に複数選択状態で表示されるなど、TRadioGroupの挙動もおかしくなります)。

以下に、TRadioGroupを利用する場合の例を示します。

FormにRadioGroupを2つ、Buttonを1つ追加します

RadioGroup1のCaptionは「文字色を選択」、Columnsは「1」、Itemsは「黒、青、赤」、RadioGroup2のCaptionは「背景色を選択」、Columnsは「1」、Itemsは「clBtnFace、clAqua、clWebViolet」をそれぞれ指定します。

新しく追加したButton3をクリックした時のコードです。

procedure TForm1.Button3Click(Sender: TObject);
begin
  //描画内容の指定
  StatusBar1.SimpleText:='文字列の表示&文字色及び背景色の変更を実行';
  //更新
  StatusBar1.Refresh;
end;

StatusBar1DrawPanel手続きのコードは、次のようになります。

procedure TForm1.StatusBar1DrawPanel(StatusBar: TStatusBar; Panel: TStatusPanel;
  const Rect: TRect);
begin
  if Panel = StatusBar.Panels[0] then
  begin

    { //コメント化 -> 前に使った Button1 も Button2 もクリックしない前提です
    if not ColorMode then
    begin
      //Fontの色
      StatusBar1.Canvas.Font.Color:=clBlue;
      //背景色
      StatusBar1.Canvas.Brush.Color:=clAqua;
    end else begin
      //Fontの色
      StatusBar1.Canvas.Font.Color:=clRed;
      //背景色
      StatusBar1.Canvas.Brush.Color:=clWebViolet;
    end;
    }

    //文字色
    case RadioGroup1.ItemIndex of
      0:StatusBar1.Canvas.Font.Color:= clBlack;
      1:StatusBar1.Canvas.Font.Color:= clBlue;
      2:StatusBar1.Canvas.Font.Color:= clRed;
    end;

    //背景色
    case RadioGroup2.ItemIndex of
      0:StatusBar1.Canvas.Brush.Color:= clBtnFace;
      1:StatusBar1.Canvas.Brush.Color:= clAqua;
      2:StatusBar1.Canvas.Brush.Color:= clWebViolet;
    end;

    //描画コード
    StatusBar1.Canvas.TextOut(Rect.left, Rect.top, StatusBar1.SimpleText);

    //更新(ここに書いてはいけない)
    //StatusBar1.Refresh;
    //StatusBar1.Repaint;
    //StatusBar1.Update;
    //StatusBar1.Invalidate;

  end;
end;

保存(Crtl+S)して、実行(F9)。

文字色は「黒」、背景色は「clBtnFace」を指定
文字色は「青」、背景色は「clAqua」を指定
文字色は「赤」、背景色は「clWebViolet」を指定
文字色は「黒」、背景色は「clAqua」を指定

StatusBarのPanelを利用して、そのStyleプロパティを「psOwnerDraw」に設定し、描画を自前で行う場合には広範囲に(コードの実行順等まで含む)様々な注意が必要です。
以上が「こんなこともできた!(その2)」の内容です。

4.まとめ

StatusBarの使い方はSimplePanel:= True; として、SimpleTextに指定した文字列を表示するというカンタンな方法と、デフォルト設定のSimplePanel:= False; のまま、Panelsプロパティで複数個のPanelを設定して、描画はStatusBar1DrawPanel手続きに自分で記述する方法の2種類があり、文字列の表示と色の変更だけならPanelを1個用紙して、SimpleTextを利用する、中間的な方法で「文字列の表示」と「表示色の変更」の両方を実装できる。

さらに複数の色を使いたい場合はRadioGroup等を利用して設定できるが、この場合は描画をRefreshする必要がある。StatusBar1.Refreshは、StatusBar1DrawPanel 手続きの中で呼び出してはいけない。

5.お願いとお断り

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

Link Image click position with Grid control

「画像のクリック位置とグリッドコントロールの連動」

画像を表示したTImageの任意の1点をクリックしたら、そのY座標に応じてStringGridコントロールの適切なセルを選択するようなプログラムが書けないかなー。・・・と思って、実際に書いてみたら、あまりにも簡単に実現できてしまったお話。

1.やりたかったこと
2.作成したプログラム
3.まとめ
4.お願いとお断り

1.やりたかったこと

次のようなGUIのある採点プログラムを作成した。プログラムはスキャナーで読み込んだ複数枚の答案画像から、設問ごとに解答欄をかき集めて表示するもの(答案画像への書き戻しも可能)。で、採点作業をより一層効率的に行うには、各々の解答欄画像をクリックした際、自動的に採点結果を入力するGridコントロールのセルが選択されたらイイなーと思ったことが、この連動プログラムを書こうとしたきっかけです。

画像をクリックした時に得られるY座標を元に、Gridコントロールの最適なセルを選択したい!

2.作成したプログラム

まず、思ったことはTImageのOnMouseDownイベントを利用すればイイ(画像上でクリックした位置のX, Y座標が取得できる)ということです。早速、imgAnswerという名前をつけたTImageをクリックして選択し、OnMouseDownイベントの右側をダブルクリックして、imgAnswerMouseDown手続きを作成。

次のようなコードを書いてみました!

procedure TFormCollaboration.imgAnswerMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  //imgAnswerの高さは、解答欄1つの高さ × 解答用紙数 だから
  //クリックした場所の(Y座標 div 解答欄1つの高さ) + 1 が解答用紙の番号になるはず
  OutPutDebugString(PChar(IntToStr((Y div 解答欄1つの高さ) + 1)));   
end;

実行(F9)して、確認。

No,5の解答欄をクリックすると、確かに「5」と表示されている! やった☆

必要と思われる変数 i, j を宣言して・・・
あとは Gridコントロールへ SetFocus するコードを書くだけ!

procedure TFormCollaboration.imgAnswerMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  i,j:integer;
begin
  //imgAnswerの高さは、解答欄1つの高さ × 解答用紙数 だから
  //クリックした場所の(Y座標 div 解答欄1つの高さ) + 1 が解答用紙の番号になるはず
  OutPutDebugString(PChar(IntToStr((Y div 解答欄1つの高さ) + 1)));
  i:= (Y div 解答欄1つの高さ) + 1;
  //SetFocus
  j:= StrToInt(現在選択している解答欄の番号);
  StringGrid1.Col:= j;
  StringGrid1.Row:= i;
  StringGrid1.SetFocus;   
end;

上のコードでは、わかりやすさのため変数(記号)ではなく、そのかわりに「解答欄1つの高さ」等のように説明の文字列で記述しています。また、採点ミスを防止する観点から、Gridコントロールに表示する入力可能な列は、現在選択(=画像として表示)している解答欄に対応する1列のみとしています。

これで理想としていたカタチの採点プログラムに一歩近づけたように思います。ユーザーに案内したい採点方法は、サっと見て全員が良く出来ている設問であれば、最初に全員正解として得点を一括自動入力し、誤りの解答のみ、解答欄画像を見ながらチェックしてクリック、自動選択された採点欄のセルにゼロ(得点)を入力する方法です。

3.まとめ

案ずるよりナントカといいますが、ほんとうにその通りで、内心、ずっとできるかなー? なんて思っていたことが、案外、基本的な知識だけで簡単に実現できてしまいました!

//Integer 型で、割り算をしたいときは、整数除算の演算を行う div を使う
A div B  //A ÷ B の商が取得できる

あとは、やりたいことを実現するアルゴリズムを考えるだけですね!
プログラミングしていて、いちばんしあわせで、楽しい時間を過ごせました☆

【注意!】
画像の表示倍率の変更が伴う場合には、表示倍率に合わせてプログラムの変更が必要
です。完璧には動作しませんが、ある程度使える(と思われる)表示倍率の変更に対応するコードは次の通りです(クリック位置が画像の下へ行くほど、誤差が大きくなります)。

procedure TFormCollaboration.imgAnswerMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  i,j,w:integer;
  k:double;
begin
  //imgAnswerの高さは、解答欄1つの高さ × 解答用紙数 だから
  //クリックした場所の(Y座標 div 解答欄1つの高さ) + 1 が解答用紙の番号になるはず
  OutPutDebugString(PChar(IntToStr((Y div 解答欄1つの高さ) + 1)));
  i:= (Y div 解答欄1つの高さ) + 1;
  //表示倍率が100%の時
  if Edit1.Text='100' then
  begin
    i:=(Y div 解答欄1つの高さ)+1;  //このアルゴリズムは記録として残したい
  end else begin
    //表示倍率が100%ではない時
    k:= 解答欄1つの高さ * (StrToFloat(Edit1.Text)/100);
    i:=Ceil(Float(Y)/k);  // <- とりあえずこれで使えるカモ?
  end;

4.お願いとお断り

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

The width of the TImage was not the width of the Graphic

「TImageの幅はグラフィックの幅じゃなかった」

1つのTImageに、様々に組み合わせた画像を、次々に表示して、その幅(と高さ)が頻繁に変わるようなプログラムを書いた。プログラムがほぼ完成?に近づいた段階で、画像の要素の組み合わせ方を変えるとTImageの幅が、画像全体の幅の変更に追随しなくなる現象に遭遇。原因はプログラムの記述ミス。これは、それを繰り返さないための備忘録。

1.最初に結論
2.練習プログラムで問題を再現
3.まとめ
4.お願いとお断り

1.最初に結論

TImage は、「グラフィックスを表示する」ためのコントロールであって、「描画そのものはグラフィッククラス側で行う必要」があり、TImage は「位置決めと描画タイミングの面倒を見ているだけ」とのこと。

つまり、TImageが内部に抱えているグラフィックスクラスに対して、適切な指示を与えてあげないとプログラムは予期した通りに動作しないよ!・・・ということになります。

そのことを教えてくれたのが、次の2つのWebサイトの情報です。心から感謝です。

TImageのリサイズ時に気をつけること

https://vogelbarsch.com/2016-01-13-212108/

TImage

http://tknakamuri.web.fc2.com/vcl2-12.htm

結論として、TImageに複数の画像を埋め込んで、切ったり、貼ったり、幅や高さを変更して使用する場合、TImage内部のグラフィックスクラスにTBitMapを使うのであれば(私の場合は全部そうです)「TImageが内部にBitMapを抱えていることを忘れてはいけない」ということです。

では、「TImageが内部にBitMapを抱えていることを忘れる」とどうなるのか? その具体例を次に示します。

作成しているプログラムは、100枚程度の答案画像をスキャナーで読み込み、ここから設問ごとに(1問ずつ)解答欄を切り出して1枚の画像に合成し、横に置いたGridコントロールに採点結果を入力。その後、採点結果はCSVファイル(必要であればExcelで作成した採点Sheetも利用可)に保存し、採点結果(○×)をつけた画像も元の答案画像に埋め込んで印刷して返却できるようにする・・・というもの(答案そのものは重要な証拠として保管し、適切な時期にシュレッダーにかけて処分するような運用を予定しています)。

スキャナーで読み込んだ答案画像(マークシートは別のプログラムで採点)

当初は、設問の解答欄のみを切り出して表示する機能のみ実装するつもりでしたが、「個人識別も可能にして欲しい(解答者の理解度や弱点を知るため、誰の解答か、すぐわかるようにして欲しい)」という要望があり、これに応えるため、解答欄の横に答案から切り出してきた組・番号・氏名等も表示できる機能を付け加えました。

解答者の氏名を表示しない(個人識別なし)で動作させた画面がこちらです。

解答欄の画像のみ切り出して合成
個人識別を行わない設定

この時のTImageの幅を確認すると、次の通り「628」でした。

次に、「個人識別」にチェックを入れ、解答欄の左に組・番号・氏名等を表示するモードに切り替えて動作させます。

数値15は垂直方向の表示位置です
解答欄が半分しか表示されていない・・・

なのに、TImageの幅は・・・

大きくなってるー!!
なんでー???

悪いのは確かに私なんですが、この時点で原因はまるでわかりません。
問題を作り出しているのはもちろん自分が書いたコードです。次に、個人識別なしの場合の誤りを含むコードを示します。ナニがいけないのか、お気づきになりますでしょうか?
(imgAnswerは、画像を表示しているTImageの名前です)

  //描画(修正前の誤りを含むコード)
  imgAnswer.Height := (解答欄1個の高さ) * ListBox1.Items.Count;
  imgAnswer.Width := 解答欄1個の幅;
  imgAnswer.Canvas.CopyRect(DestRect, Image1.canvas, SrcRect);

そうです。TImageの高さと幅をいじっています。冒頭で述べた通り、TImageは表示する画像の「位置決めと描画タイミングの面倒を見ているだけ」なのです。重要なのは、そのTImageが内部に抱えているTBitMapです。こちらの高さと幅を設定し忘れています。おそらく画像の切り出しに注意が集中しすぎ、(TImageの幅と高さを設定すればOK!)と勘違いして、TBitMapのことまでアタマがまわらなかったのだと思います。

こんな恥ずかしい間違いを私以外にする人がいるとは思えませんが・・・。もしかしたら、どこかにおひと方くらい、同じ問題で悩む方がいるかもしれません。その方の一助にでもなれば幸いと、あえて誤りを公開する次第です。

  //描画(修正後)
  imgAnswer.Picture.Bitmap.Height := (解答欄1個の高さ) * ListBox1.Items.Count;
  imgAnswer.Picture.Bitmap.Width := 解答欄1個の幅;
  imgAnswer.Canvas.CopyRect(DestRect, Image1.canvas, SrcRect);

で、描画手続きの最後に以下のコードでTImageの高さと幅を設定。Visible も True に。

  //表示
  imgAnswer.Height:=imgAnswer.Picture.Bitmap.Height;
  imgAnswer.Width:=imgAnswer.Picture.Bitmap.Width;
  imgAnswer.Visible:=True;
正しく表示されるようになりました☆

現象を確認してから、問題の本質に気付き、プログラムを修正するまで2時間少々かかりました。修正しながら、この問題そのものに「既視感」を感じたことも事実であり、もしかしたら(はっきり覚えていないだけで)、私は以前にも今回と同じ問題で悩んだことがあるのかもしれません。いや、きっとあります。問題解決の重要なヒントとさせていただいた上記Webサイト様の情報にも確かな既視感がありましたから。

なお、本題に関係ない部分ですが、採点のマーキング位置と個人識別情報の表示位置は細かな指定ができる設計にしてあります。上記画像も「ちゃんと」すれば、次の画像のようにもう少し見やすく変更できます。これが自動で出来ればスゴイのですが・・・

2.練習プログラムで問題を再現

FormにTImage1つと、Buttonを2つおいて、ボタンをクリックすると表示される画像を切り替える練習プログラムで問題を再現してみます。

点線で囲まれた部分がTImage(幅と高さは右下のハンドルを適当にドラッグしたままの状態で設定)

で、TImageに表示する画像は次の2枚。

Picture01.jpg
Picture02.jpg(幅を1/2にした画像)

Button1をクリックした時の手続き

procedure TForm1.Button1Click(Sender: TObject);
var
  pFileName:string;
  //GDI+を利用する
  Graphics:TGPGraphics;
  GPbmp:TGPBitmap;
begin

  //Image(メモリ)を初期化
  Image1.Picture.Assign(nil);  //縦横比が変化しないと、再描画されないことがあった!

  //表示する画像のファイル名を取得
  pFileName:=ExtractFilePath(Application.ExeName)+'Data\Picture01.jpg';

  //オブジェクトを生成
  GPbmp:=TGPBitmap.Create(pFileName);
  //回転・反転ともになし
  GPbmp.RotateFlip(RotateNoneFlipNone);

  //描画
  Image1.Picture.Bitmap.Width:=GPbmp.GetWidth;
  Image1.Picture.Bitmap.Height:=GPbmp.GetHeight;
  Image1.Picture.Bitmap.PixelFormat:=pf24bit;
  Graphics:=TGPGraphics.Create(Image1.Picture.Bitmap.Canvas.Handle);
  try
    //イメージを表示
    Graphics.DrawImage(GPbmp, 0, 0, GPbmp.GetWidth, GPbmp.GetHeight);
    Image1.AutoSize:=True;
  finally
    GPbmp.Free;
    graphics.Free;
  end;

  //画像を表示
  Image1.Visible:=True;

end;

button2をクリックした時の手続きも同様に記述して(画像の名前を「Picture02.jpg」に変更するだけです)、動作を確認。まず、button1をクリック。

画像が表示される

続けて、button2をクリック。

こちらも問題なし(予期した通りに動作する)

TImageの幅の変更は適切に処理され、期待した通りに動作することが確認できました。
次に、button1 クリック時のコードを誤りのあるものに変更。
ついでにGDI+のビットマップの幅と、Image1の幅も表示して比較できるように設定。

  //Image1.Picture.Bitmap.Width:=GPbmp.GetWidth;
  //Image1.Picture.Bitmap.Height:=GPbmp.GetHeight;

  //誤ったコード
  Image1.Width:=GPbmp.GetWidth;
  Image1.Height:=GPbmp.GetHeight;
  //Freeする前にGPbmpの幅を見ておく
  ShowMessage(GPbmp.GetWidth.ToString);

  Image1.Picture.Bitmap.PixelFormat:=pf24bit;
  Graphics:=TGPGraphics.Create(Image1.Picture.Bitmap.Canvas.Handle);
  try
    ・・・(略)・・・
  finally
    GPbmp.Free;
    graphics.Free;
  end;

  //画像を表示
  Image1.Visible:=True;
  //TImageの幅を確認
  ShowMessage(IntToStr(Image1.Width));

上記設定で動かしてみると、ShowMessage(GPbmp.GetWidth.ToString) の結果は・・・

GDI+のBitMapに画像が読み込まれている証拠

続けて、Image1の幅はどうなっているかというと・・・

予期した通りゼロ

Image1のPicture.Graphicに代入されるTBitmapがカラだから、結果としてImage1の幅が変更されない? もちろん、画像も表示されません。

誤りのあるコードで、button1をクリックした結果

ShowMessageではなく、OutPutDebugString関数を使えば、次のようにメッセージを表示せずに確認することもできます。

  //ShowMessage(GPbmp.GetWidth.ToString);
  OutPutDebugString(PChar(GPbmp.GetWidth.ToString));

  //ShowMessage(IntToStr(Image1.Width));
  OutPutDebugString(PChar(IntToStr(Image1.Width)));

実行(F9)でイベントログにOutPutDebugString関数の結果が出力される。

GPbmp.GetWidthが「468」、Image1.Widthが「0」であることがわかる

私の場合、いつもはShowMessage関数で確認して、消去するか、そのままコメントアウトしてしまうことが多いのですが・・・。

なぜ、この例を追加したかというと、問題の原因がどこにあるのかわからない時は、「基本に返る」ことの大切さを、この間違い探しの作業を通じてしみじみ実感したからです。

実は自分の書いたコードのどこに誤りがあるのか、当初はまったくわからず(見当すらつかず)、少しずつコードを追いかけてようやくImageの幅がおかしなコトになっているという点に気が付きました。

で、幅の設定を手掛かりにして、GDI+で画像を読み込む手続きの部分を見直した時、

  Image1.Picture.Bitmap.Width:=GPbmp.GetWidth;
  Image1.Picture.Bitmap.Height:=GPbmp.GetHeight;

(あれっ なんかついて る・・・)という違和感を感じたのです。

画像の読み込みでは、Picture.Bitmap があるのに、
画像の合成部分には、確か、それがなかった・・・

やっと、わかったー(解決)

基本に戻るということの大切さを、しみじみ実感しました。
で、あらためてTImageの幅について勉強し直した結果、上記Webサイト様の情報に行きつき、問題の本質が明らかになった次第です。

しかし、またココで新たな謎が・・・

ShowMessage(GPbmp.GetWidth.ToString);

この1行、実行にすごく時間がかかる気が・・・
なんでかなー???

3.まとめ

TImageは、そのPicture.Graphicに読み込んだ画像を表示するVisual Component Library (VCL)。TImage は「位置決めと描画タイミングの面倒を見ているだけ」で、「描画そのものはグラフィッククラス側で行う必要」がある。だから高さや幅の設定も・・・

  Image1.Picture.Bitmap.Width:=GPbmp.GetWidth;
  Image1.Picture.Bitmap.Height:=GPbmp.GetHeight;

TImageが内部に抱えているBitmapに対して行う必要がある。

4.お願いとお断り

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

When The Cancel Button is Pressed

「キャンセルボタンが押された時は?」

JpegファイルをTImageに読み込み、プリンターのプロパティを設定して印刷するとき、設定画面にある「OKボタン」ではなく、「キャンセルボタン」が「押された時」の対応方法がわからずハマった話。

1.つくった練習プログラム
2.キャンセルボタンが押されたら・・・?
3.TOpenDialogなら・・・
4.解決方法を知る
5.まとめ
6.お願いとお断り

1.つくった練習プログラム

Formに最低限必要なVCLコンポーネントを以下のように配置。
(右上にある「Printerを選択」のVCLはTLabel(のCaption)。これはなくてもOK。)

Formの幅は810、高さは480に設定

GUIを作成後、Mr.XRAYさんのWebサイトにあった情報を参照して、プリンタのプロパティのダイアログを表示して印刷設定する方法で、練習プログラムを書いてみた。Mr.XRAYさんのWebサイトにはいつも本当にお世話になっています。詳細かつ丁寧なご説明に心より感謝申し上げます。

013_プリンタのプロパティ設定

http://mrxray.on.coocan.jp/Delphi/plSamples/013_SetPrinterProperty.htm#04

グローバル変数の設定は、{ Private 宣言 } に以下の通り記述。

type
  TForm1 = class(TForm)
    Image1: TImage;
    ListBox1: TListBox;
    ComboBox1: TComboBox;
    Button1: TButton;
    Label1: TLabel;
    CheckBox1: TCheckBox;
    procedure FormCreate(Sender: TObject);
    procedure ComboBox1Select(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
    ADevice     : array[0..MAX_PATH - 1] of Char;
    ADriver     : array[0..MAX_PATH - 1] of Char;
    APort       : array[0..MAX_PATH - 1] of Char;
    ADeviceMode : THandle;
  public
    { Public 宣言 }
  end;

「プリンタのプロパティ」として表示したいダイアログは、TPrintDialog ダイアログ or TPrinterSetupDialog ダイアログを表示した際に、その画面にある「プロパティ」ボタンをクリックすると表示されるダイアログ。(自分的には、これが「かゆいところに手が届く」いちばんイイ!ダイアログじゃないかなー みたいな気がして・・・)

もっと正直な、ほんとうのところを言うと、コントロールパネル → ハードウェアとサウンドの「デバイスとプリンターの表示」で表示されるプリンタを右クリックして出てくるサブメニューにある「プリンターのプロパティ」をクリックして表示される「詳細設定」タブのある「(プリンター名)のプロパティ」の画面を出したかったんだけど、コレを出す方法がわからなかった。
(もちろん、今でもわかりません。わかる方、Web上のどこか、いつまでも、ずっと残る場所に情報を書いていただけるとすごくうれしいです!)

Printerの選択肢を表示する部分は・・・

procedure TForm1.FormCreate(Sender: TObject);
//プリンタのリストを取得してComboBox1にセット
begin
  ComboBox1.Items.Clear;
  ComboBox1.Items.Assign(Printer.Printers);
  ComboBox1.ItemIndex := Printer.PrinterIndex;
  //プリンタを初期化
  ComboBox1Select(nil);  //このprocedureはまだ作ってないから当然エラーになる!
end;

エラーは無視。そのままForm上のComboBox1をクリックして、表示されるオブジェクトインスペクタの OnSelect の右の空欄をダブルクリックして表示される新しいプロシージャに以下の内容を記述。

procedure TForm1.ComboBox1Select(Sender: TObject);
begin
  //選択したプリンタをアクティブなプリンタに設定
  Printer.PrinterIndex := ComboBox1.ItemIndex;
  //ADeviceModeには変更前のプリンタの情報が格納されている
  //その他の値は現在(変更後)のプリンタの情報
  Printer.GetPrinter(ADevice, ADriver, APort, ADeviceMode);
  //ADeviceMode初期化
  Printer.SetPrinter(ADevice, ADriver, APort, 0);
  //ADeviceModeが新しいプリンタドライバの値になる
  Printer.GetPrinter(ADevice, ADriver, APort, ADeviceMode);
end;

プログラムを上書き保存(ComboBox1Select(nil);のエラーはここで解消される)。

で、最初に書いた(キャンセルボタンが押された場合の処理がない)印刷部分のプログラムは以下の通り(usesへの追加内容とButton1Click)。
EXEのある場所にDataフォルダを作成しておき、そこに印刷したいJpegファイルを入れておく。プログラムはこのJpegファイル1枚1枚へのPathをListBox1にセットして、セットされたItemの数だけ印刷Loopをまわすという内容。
なお、Jpegファイルの読み込みはGDI+を使用している。

implementation

uses
  Winapi.GDIPAPI, Winapi.GDIPOBJ, Winapi.GDIPUTIL,
  System.IOUtils, System.UITypes,
  Printers, Winapi.WinSpool,
  System.Types, Vcl.FileCtrl, System.StrUtils, System.Masks,
  Winapi.CommDlg;

  //Vcl.Imaging.jpeg, Winapi.MMSystem, Vcl.axCtrls,は削除した
  //System.UITypesはMessageDlgを使用するために追加
  //Printersは印刷を実行するために追加
  //Winapi.WinSpoolはPrinterPropertyを表示して印刷するために追加
  //System.IOUtils, System.Types, Vcl.FileCtrl, System.StrUtils, System.Masksは
  //ファイル名取得用の関数を使うために必要
  //Winapi.CommDlgはTPrintDlgの表示に必要

{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
  //PrinterプロパティのDialogを表示
  DevMode  : PDeviceMode;
  Mode     : Cardinal;
  hPrinter : THandle;
  //矩形
  rect:TRect;
  //印刷関連
  j:integer;
  //for フォルダの選択
  iStartFolder: string;
  iDirectories: TArray<string>;
  FileNames:TStringDynArray;  // -> ローカル変数でなければならない
  //TStringDynArrayの使用にはusesにTypesが必要
  strFileName, strSavePath:string;
  //for 画像読み込み
  graphics:TGPGraphics;
  bmp:TGPBitmap;

  //拡張子の異なるファイルをそれぞれ検索
  function MyGetFiles(const Path, Masks: string): TStringDynArray;
  var
    MaskArray: TStringDynArray;
    Predicate: TDirectory.TFilterPredicate;
  begin
    MaskArray := SplitString(Masks, ';');
    Predicate :=
      function(const Path: string; const SearchRec: TSearchRec): Boolean
      var
        Mask: string;
      begin
        for Mask in MaskArray do
          if MatchesMask(SearchRec.Name, Mask) then
            exit(True);
        exit(False);
      end;
    Result := TDirectory.GetFiles(Path, Predicate);
  end;

begin

  //プロパティの設定Dialogの表示がチェックされていたら実行
  //これを設定しない場合は、デフォルトの設定で印刷される(A4・縦とか)
  if CheckBox1.Checked then
  begin

    //FDeviceModeのメモリをロックしDEVMODE構造体のポインタを取得
    DevMode:=GlobalLock(ADeviceMode);

    try

      //対象のプリンタのハンドルを取得
      if Winapi.WinSpool.OpenPrinter(ADevice, hPrinter, nil) then begin
        try
          //このLModeの値によって,ダイアログ表示かプロパティの設定かが決まる
          Mode:=DM_IN_PROMPT or DM_OUT_BUFFER or DM_IN_BUFFER;
          //必要な場合は、ここで DevModeを修正する
          //例:A4・横の設定にしてからダイアログを表示する
          with DevMode^ do begin
            dmPaperSize:=DMPAPER_A4;  //A4
            dmOrientation:=DMORIENT_LANDSCAPE;  //横
          end;
          //プリンターのプロパティ設定Dialogを表示
          //キャンセルボタンが押された場合の処理なし(これを何とかしたい
          DocumentProperties(Handle, hPrinter, ADevice, DevMode^, DevMode^, Mode);
        finally
          //閉じる
          ClosePrinter(hPrinter);
        end;
      end;
    finally
      //ロック解除
      GlobalUnlock(ADeviceMode);
    end;

  end;

  //設定を反映させる
  Printer.SetPrinter(ADevice, ADriver, APort, ADeviceMode);

  //印刷実行
  //表示に設定
  Image1.Visible:=True;
  //ListBoxも初期化
  ListBox1.Items.Clear;
  //表示位置を設定
  Image1.Left:=10;
  Image1.Top:=10;

  //フォルダの選択
  MessageDlg('OKをクリックするとフォルダ選択ダイアログが表示されます。'+#13#10+#13#10+
      '採点したいデータのあるフォルダを選択してください。', mtInformation, [mbOk] , 0);

  iStartFolder:=ExtractFilePath(Application.ExeName);
  if SelectDirectory(iStartFolder, iDirectories,
    [sdHidePinnedPlaces, sdNoDereferenceLinks, sdForceShowHidden,
    sdAllowMultiselect], 'フォルダを選択してください', 'Folder', 'Ok') then
  begin

    //開いた時のPathを採点結果の保存先Pathとして取得しておく
    strSavePath:=iDirectories[0];

    //拡張子が'jpg'のファイルの名前を取得してListBoxへ格納
    FileNames:=MyGetFiles(iDirectories[0], '*.jpg');
    for strFileName in FileNames do
    begin
      ListBox1.Items.Add(strFileName);
    end;

    //答案の枚数分Loopする
    for j := 0 to ListBox1.Items.Count-1 do
    begin

      //画像の初期化
      Image1.Picture:=nil;

      //GDI+で読む
      bmp:=TGPBitmap.Create(ListBox1.Items[j]);
      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);
        Image1.Align:=alNone;
        Image1.Center:=True;  //Imageの中央に表示
        Image1.AutoSize:=False; //サイズは固定しない
        //StretchとProportionalをセットで指定して、伸縮と縦横比維持を両立
        Image1.Stretch:=False; //Image枠内収まるよう画像の大きさを変更しない
        Image1.Proportional:=True;  //画像の縦横比を維持
      finally
        bmp.Free;
        graphics.Free;
      end;

      //処理の表示を止めないおまじない
      Application.ProcessMessages;

      //印刷実行
      //if MessageDlg('印刷しますか?',mtConfirmation,[mbYes,mbNo],0) = mrYes then
      //begin
        //ページを印刷する
        with Printer do
        begin
          {
          if j=0 then
          begin
            BeginDoc;
          end else begin
            NewPage;
          end;
          }
          BeginDoc;
          //大きさを指定
          rect.Top    := 0;
          rect.Left   := 0;
          rect.Bottom := Trunc(( PageWidth / Image1.Picture.Width) * Image1.Picture.Height);
          rect.Right  := PageWidth;
          //ファイルを描画
          Printer.Canvas.StretchDraw(rect, Image1.Picture.Graphic);
          {
          if j=ListBox1.Items.Count-1 then
          begin
            EndDoc;
          end;
          }
          EndDoc;
        end;
      //end;
    end;
  end;

end;

【20220830 追記】
印刷部分の動作検証は、普段愛用している印刷ユーティリティソフトのFinePrintで行いました(FinePrintは、株式会社NSDさんが販売している多機能プリンタドライバで、ページを縮小してのまとめ印刷等が簡単に行える非常に使いやすいソフトです)。FinePrintに出力している分については、上記コードで全ページがきちんと出力されるのですが、実際に業務で使用しているプリンタを指定して出力すると、ページが「抜ける」大変困った現象が発生することを確認しました。そこで、まとめて印刷せず、1枚毎にプリンタへ出力するようコードを修正してあります。

【20220901追記】
次のWebサイトに紹介されている方法を、上記印刷プログラムに対して試したところ、印刷の「抜け」が発生しなくなりました。貴重な情報をご提供くださいました中村 様、本当にありがとうございました。

ビットマップがプリンタに印刷できない

http://tknakamuri.web.fc2.com/tips004.htm

最後の印刷部分は、メタファイルに流し込む等は行わず、TImageのグラフィックをそのままプリンターのCanvasに大きさを合わせて描画している。

この方法は、次のWebサイトで紹介されていたものを、複数枚印刷用にコードを変更して利用させていただきました。ありがとうございました!

Delphi/400 Tips プログラムからの印刷 の 画像の印刷

https://www.migaro.co.jp/contents/products/delphi400/tips/introduction/4_19/01/02.html

プリンターのプロパティ設定を行わずに印刷すると(当たり前だが)、プリンタのデフォルト設定がそのまま適用される。

プリンターのプロパティ設定を行って印刷すると(当たり前だが)、変更した設定が適用されて印刷が実行される。

何の問題もない。これで出来上がり。OK!・・・でも、よかったんだけど、

2.キャンセルボタンが押されたら・・・?

ふと気になって、プリンターのプロパティ設定画面にある「キャンセルボタン」をクリックしてみた。

設定Dialog画面は確かにキャンセルされるんだけど・・・
プログラムがそのまま先へ進んでしまう・・・。
(気持ち的にはキャンセルした時点でExitして欲しいところだ)

んじゃ、キャンセルボタンが押されたらExitすればイイ。
で、その処理はどう書くの?

えぇっ ボク、知らないよー (T_T)
ここで、またハマりました!!

3.TOpenDialogなら・・・

よく使うTOpenDialogなら、こうするのが定番(・・・だと思う)

begin
  if OpenDialog1.Execute then
  begin
    ShowMessage(OpenDialog1.FileName);
  end else begin
    ShowMessage('キャンセル');
  end;
end;

でも、DocumentProperties( )には .Execute はありませんでした。これで、さらに(T_T)

×:DocumentProperties(Handle, hPrinter, ADevice, DevMode^, DevMode^, Mode).Execute

なんだか、面白いコトになってキタ!

4.解決方法を知る

Google先生しか頼りになるヒトはいませんから、さっそくカタカタきいてみます。
(実際には、最終的な解決に至るまでには、かなりの時間を費やしたのですが・・・)

Delphi DocumentProperties関数 ・・・というキーワードでお伺いをたてると、上から3番目に次の情報がHit!

Googleの検索結果から引用

この解説の下の方に、以下の記事がありました☆

関数がプロパティ シートを表示する場合、戻り値は、ユーザーが選択するボタンに応じて IDOK または IDCANCEL になります。

https://docs.microsoft.com/ja-jp/windows/win32/printdocs/documentproperties

あったー!!

さっそくこの情報を元にプログラムを書き換えます。

//DocumentProperties(Handle, hPrinter, ADevice, DevMode^, DevMode^, Mode);

//キャンセルボタンに対応
if DocumentProperties(
  Handle, hPrinter, ADevice, DevMode^, DevMode^, Mode) = IDCANCEL then Exit;

あっけないくらい、カンタンに解決☆
(やったー! コレでまたBlog書けるー!! ・・・みたいな気も)

5.まとめ

DocumentProperties関数は、キャンセルボタンが押されるとIDCANCELが戻り値として返る。これを利用してExitするには・・・

//キャンセルボタンに対応
if DocumentProperties( 略 ) = IDCANCEL then Exit;

6.お願いとお断り

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

Bitmap Conversion

「ビットマップ変換」

TImageに画像を読み込んで、変更を加え、その画像をGDI+で高速に保存しようとした。
しかし、VCLのTBitmapをGDI+のBitmapへ変換する方法がわからず、半日以上試行錯誤。これはその時の記録。

0.Bitmapを変換したい理由
1.わかったこと
2.まとめ
3.お願いとお断り

0.Bitmapを変換したい理由

GDI+を使うようになる前は、次のようなコードでJpegファイルを保存していた。

var
  Jpeg: TJPEGImage;
  S:string;
begin
  S := ChangeFileExt(画像ファイルへのPath, '.jpg');
  Jpeg := TJPEGImage.Create;
  try
    Jpeg.Assign(Image1.Picture.Bitmap);
    Jpeg.Compress;
    Jpeg.SaveToFile(S);
  finally
    Screen.Cursor := crDefault;
    Jpeg.Free;
  end;
end;

1枚とか、ごくわずかな枚数の画像を保存するだけなら、この方法でも特に問題はないんだが、何十枚もの画像を頻繁に処理することを繰り返すような場合には、やはりGDI+を使って高速に処理したくなる。例えば、次のような場合だ。

マークシートと手書きの解答がセットになった解答用紙をスキャナーで読み取り、その手書きの解答欄を矩形選択して切り取り、(1)なら(1)だけ!以下の画像のように人数分集めて表示 & 採点するプログラムを作りたいとき(実際に今、作っている)。

矩形で切り抜いて表示、採点までは無事にプログラミングできた☆

手書き答案をPCと協働で採点するプロジェクト

ハマったのは、ココからだ。採点したら、各々の解答欄を、解答用紙の元の場所に戻したい。矩形で切り取って集めて1枚の画像に仕立てたアルゴリズムを再利用し、読み込み元Rectと書き込み先Rect、及び読み取り元Imageと書き込み先Imageをそれぞれ逆にすれば、各々の解答欄は「ばっちり元の場所に戻る」ハズだ。・・・と考え、実際にその処理を書いてみた。

ところが赤い丸印(採点済みのマーク)を付加して変更を加えたTImage(VCL)のTBitmapをGDI+のBitmapへ変換する方法がどぉーしてもわからない。走召!困った。。。

        //GDI+で元の答案画像を読み込んでおく
        bmp:=TGPBitmap.Create(答案の画像ファイル);
        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);

            ・・・ 採点結果の書き戻し準備処理 ・・・

          //採点した解答欄の矩形を元の答案画像へ書き戻し(これは成功する)
          Image1.Canvas.CopyRect(DestRect, Image2.canvas, SrcRect);
        finally
          bmp.Free;
          graphics.Free;
        end;

        //書き戻した答案画像はできてるけど、まだファイルになってない!
        //・・・ってか、それをファイルにする処理をここに書きたい・・・んだけど
        bmp:=TGPBitmap.Create(ココの書き方がわからない);
        //Graphics:=TGPGraphics.Create(Image1.Picture.Bitmap.Canvas.Handle);
        Graphics:=TGPGraphics.Create(Image1.Canvas.Handle);
        try
          Graphics.DrawImage(bmp,0,0);
          ・・・

上のコードで、TGPBitmap.Create( )の( )の中にナニを入れたらいいのか、この部分がどうしてもわからず、かなり苦しんだ。仕方がないからGDI+での保存はいったんあきらめて、Jpeg.Assign(Image1.Picture.Bitmap)の方法を試してみることにする。すると、思っていた通り、たった10枚の答案でも とぉーっても 遅いのだ。

数十枚(最大100枚程度を想定している)の答案の解答欄一つひとつについて、採点後に元の答案画像への書き戻しを行うことを考えると、Jpeg.SaveToFileメソッドはどうしても使う気になれない。保存方法は何がナンでも高速なGDI+を使いたい。

長くなったけど、これがビットマップを変換したい理由なのです。

1.わかったこと

いろいろ調べたり、思い出したりして、試行錯誤。

Image1.Picture.SaveToFile(画像の保存先Path);

GDI+とは何の関係もないけれど、上のコードも試したが、これはエラーに。

bmp:=TGPBitmap.Create(ココの書き方がわからない);
                  ↓
bmp:=TGPBitmap.Create(画像の保存先Pathを入れてみた);

エラーにはならないけど、変更したImageは当然保存されない。
(あたりまえです。元画像を読み込んで、そのまま上書きコピーしてるだけだもん。)

時間だけがゆっくりと過ぎて行く。
このプログラムの完成を待ってる人もいないけど、教えてくれる人もいない。

Google先生も調子悪そうだ。
何を尋ねても、わかってることしか表示してくれない。

僕は、DelphiのIDEではなく、NanaTreeの画面を「ぼー」っと見つめていた。

NanaTreeは、オープンソースのフリーソフト(階層化テキストエディター)で、僕はこのNanaTreeに、これまでに調べたことや、学んだことを備忘録として記録、資料化している。10年以上前から書き溜めてきた、お金では買えない、僕のたからものだ。

僕とDelphi(Object Pascal)の、これまでのすべてが、ここに詰まっている・・・。

ふと、下から3番目のノードが目に留まった。

VCL TBitmap から

なんだって、その先は? あわててノードをクリックする。
すると、目に飛び込んできたのは・・・

VCL TBitmap から GDI+ Bitmap へ

そのものズバリがあったー!!

「灯台元暗し」とはまさにこのこと。

オレ、調べてたんだ・・・。これまで使ったことがなかっただけで・・・。
少し前の記事になりますが、NanaTreeに記録した資料の元の記事がこちらです。

めもニャンだむ

junkiの日常雑感・日記・プログラミングのランダムメモ

VCL TBitmap から GDI+ Bitmap への転送を試した。

TGPBitmap クラスのコンストラクタのうち
constructor Create(stream:IStream;..);reintroduce;overload;
を使う。

まず、VCL TBitmap オブジェクトの内容を SaveToStream() によって、TMemoryStream にセーブする。次に、TStreamAdapter クラスのインスタンスを作成して、TMemoryStream オブジェクトを IStream に変換し、上記のコンストラクタで作成する。

URL:http://blog.livedoor.jp/junki560/archives/21910595.htmlより引用

junkiさん、ほんとうにありがとうございます。
TMemoryStreamを介してVCLビットマップのデータをGDI+に渡せるのですね!

さっそく書いたのが次のコード。

implementation

uses
  System.IOUtils,
  Winapi.GDIPAPI, Winapi.GDIPOBJ, Winapi.GDIPUTIL;

  //System.IOUtilsはPathから拡張子を取得するTPath.GetExtensionを使うために追加
  //GDIPAPI, GDIPOBJ はGDI+を利用した描画に資料するために必要
  //GDIPUTILを宣言すればGetEncoderClsid関数を利用してGUIDを取得できる

{$R *.dfm}

var
  ・・・
  //VCL TBitmapからGDI+ Bitmapへ変換
  Graphics:TGPGraphics;
  srcBMP:TBitmap;
  dstBMP:TGPBitmap;
  stream:TMemoryStream;
  //拡張子を取得する
  dotExt, strExt:string;
  //GetEncoderClsid関数の利用とTGUIDを使用するには、usesにWinapi.GDIPUTILが必要
  ImgGUID:TGUID;
begin

  //解答欄の矩形を元の答案画像へ書き戻し(内容が変更されたImageができる)
  Image1.Canvas.CopyRect(DestRect, Image2.canvas, SrcRect);

  //保存(VCL TBitmap -> GDI+ Bitmap)
  srcBMP:=TBitmap.Create;
  srcBMP.Width:=Image1.Width;
  srcBMP.Height:=Image1.Height;
  srcBMP.Assign(Image1.Picture.graphic);
  //データ受け渡し用のストリームを生成して保存
  stream:=TMemoryStream.Create;
  srcbmp.SaveToStream(stream);
  //保存GDI+のBMPを生成
  dstbmp:=TGPBitmap.Create(TStreamAdapter.Create(stream));
  //引数の指定をImage1.Picture.Bitmap.Canvas.Handleに変更
  //Graphics:=TGPGraphics.Create(Image1.Canvas.Handle);
  Graphics:=TGPGraphics.Create(Image1.Picture.Bitmap.Canvas.Handle);
  try
    Graphics.DrawImage(dstbmp,0,0);
    //拡張子を小文字に変換して取得(.XXX形式:Dotが付いている)
    dotExt:=LowerCase(TPath.GetExtension(画像の保存先Path));
    //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
      //20220930訂正 bmp -> dstbmp
      //bmp.Save(ChangeFileExt(画像の保存先Path, dotExt), ImgGUID);
      dstbmp.Save(ChangeFileExt(画像の保存先Path, dotExt), ImgGUID);
    end;
  finally
    Graphics.Free;
    srcbmp.Free;
    dstBMP.Free;
    stream.Free;
  end;

end;

ちなみに uses は・・・(参考まで)

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
  Vcl.ExtCtrls, Vcl.StdCtrls, Vcl.Imaging.Jpeg, Vcl.Grids, Vcl.ComCtrls,
  System.IOUtils, System.Types, Winapi.ShellAPI, System.UITypes,
  System.IniFiles, System.Masks, Vcl.Filectrl, System.StrUtils,
  Ipl, OpenCV, Winapi.GDIPAPI, Winapi.GDIPOBJ, Winapi.GDIPUTIL,
  System.Win.ComObj, PythonEngine, Vcl.PythonGUIInputOutput, System.ImageList,
  Vcl.ImgList;

  //GDIPAPI, GDIPOBJ はGDI+を利用した描画に資料するために必要
  //usesにWinapi.GDIPUTILを宣言すればGetEncoderClsid関数を利用してGUIDを取得できる
  //System.Win.ComObjはExcelのxlsmファイルの読み書きに必要

TMemoryStreamを使えば、間に「ファイル」というかたちを入れないでBMPデータをGDI+のBitmapに渡すことができるなんて知りませんでした。これで扱う画像の数が何十枚あっても超高速!に保存処理を実行できます。

GDI+ の bitmap クラス(TGPBitmap)と graphics クラスを使って、画像ファイルから VCL の TBitmap へイメージを読み込むことはもうできてるから、これで画像ファイルからGDI+を使って高速にデータを読み取り、VCL Imageに表示し、必要な変更を加えたりした後、VCL TBitmapからGDI+のTGPBitmapにデータを移して高速に保存処理を行う、GDI+の利点を最大限に活用したプログラムが書けるようになった。

2.まとめ

(1)VCLのTBitmapのデータをまずTMemoryStreamに保存する。

var
  //VCL TBitmapからGDI+ Bitmapへ変換
  srcBMP:TBitmap;
  dstBMP:TGPBitmap;
  stream:TMemoryStream;
begin
  //保存(VCL TBitmap -> GDI+ Bitmap)
  srcBMP:=TBitmap.Create;
  srcBMP.Width:=Image1.Width;
  srcBMP.Height:=Image1.Height;
  srcBMP.Assign(Image1.Picture.graphic);
  //データ受け渡し用のストリームを生成して保存
  stream:=TMemoryStream.Create;
  srcbmp.SaveToStream(stream);
  ・・・
end;

(2)GDI+のTGPBitmapに入れるには TStreamAdapter.Create(stream) を使う。

  //GDI+のBMPを生成
  dstbmp:=TGPBitmap.Create(TStreamAdapter.Create(stream));
  //Graphics:=TGPGraphics.Create(Image1.Picture.Bitmap.Canvas.Handle);
  Graphics:=TGPGraphics.Create(Image1.Canvas.Handle);
  try
    Graphics.DrawImage(dstbmp,0,0);

(3)最後に使用したBitmapとMemoryStreamのオブジェクトを解放(Free)する。

  finally
    Graphics.Free;
    srcbmp.Free;
    dstBMP.Free;
    stream.Free;
  end;

3.お願いとお断り

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

Disable left and right arrow keys on StringGrid

「StringGrid上で左右の矢印キーを無効化」

Enterキーでのカーソル移動と違って、矢印キーの制御に大苦労(私だけカモだが)。
これが正しい方法かどうか、わからないが結果としてタイトルにある通り、
StringGrid上で左右の矢印キーの無効化に成功。これはその覚書。

0.左右の矢印キーを無効化したい理由
1.無効化する前に行った設定
2.無効化にチャレンジ
3.まとめ
4.お願いとお断り

0.左右の矢印キーを無効化したい理由

例えば、次のようなGUIで、テストの解答用紙をスキャンした画像から解答欄(1)のみをトリミングして採点したい場合、採点用のGridコントロールの列数は2列として、1列目に解答用紙の番号、2列目に採点結果を入力する仕様とすれば、最も使いやすいのではないかと考え、これを実現するために、Gridコントロールの現在必要ない列を「非表示」にする設定を行った。

画面右側に採点用のStringGridを配置している

ここまでは、全然、難しくなかった。

次に、StringGridにフォーカスがあるとき、Enterキーを押し下げるとカーソルが下のセルに移動するように設定。これも以前やったことがあったので、問題なく実現できた。

で、あとはEnterキーでコントロールを移動させるために、Form上のコンポーネントより先にFormがキーボードイベントを取得できるよう、FormCreateで以下を指定。

  KeyPreview:=True;

で、Enterキーの挙動を設定したのと同じFormKeyPressプロシージャで、

  if Ord(Key)=VK_RIGHT then
  begin
    if ActiveControl is TStringGrid then
    begin
      if TStringGrid(ActiveControl).EditorMode then
      begin
        Key:=#0;
        //Exit;
      end;
    end;
  end;

と、設定してあげれば・・・思った通りのGUIが完成・・・するはずだった。

・・・だったが、実際にコンパイルしてみると・・・

Enterキーを押し下げると、次の採点欄にフォーカスが移動(ここまでは予定通り)し、左右の矢印キーは無効化してあるので、押し下げても反応しないはず・・・が、採点欄1で右矢印キーを押し下げると、「カーソルがきえちゃった!」

で、左矢印キーを押すと、「カーソルが現れた!」

って、コトは。

非表示にしてある採点欄2へ、カーソルが移動している・・・

無効化されてない。

矢印キーは、無効化されてないよー

無駄だと思ったが、いちおう確認のため

  if Ord(Key)=VK_RIGHT then
  begin
    if ActiveControl is TStringGrid then
    begin
      if TStringGrid(ActiveControl).EditorMode then
      begin
        ShowMessage('VK_RIGHT');
        Key:=#0;
        //Exit;
      end;
    end;
  end;

右矢印キーの押し下げをフックできたらメッセージを表示するようにしてみたが、まったく反応なし。つまり、Enterキーの押し下げを検出するのと同じ方法では矢印キーの押し下げを検出できないことが判明(号泣)。なんだか、面白いことになってキタ。

1.無効化する前に行った設定

FormにStringGridを配置し、列数・行数は実行時に動的に指定する仕様でプログラミング。さらに、採点しやすいよう、Enterキーでのフォーカスの移動(下のセルへ)と、不要な列の非表示設定を次のように行った。

【StringGridの設定】

procedure TFormCollaboration.FormCreate(Sender: TObject);
var
  i:integer;
begin

  //以下StringGrid関係
  StringGrid1.DefaultDrawing := True;
  StringGrid1.DrawingStyle   := gdsThemed;
  StringGrid1.Options        := StringGrid1.Options + [goDrawFocusSelected];

  //フォーカスのあるセルを強調表示
  StringGrid1.Options:=StringGrid1.Options + [goDrawFocusSelected];
  //Clickでセル編集を可能にする-> [goEditing]をTrueに設定
  StringGrid1.Options:=StringGrid1.Options + [goEditing];
  //常に編集可能に設定
  StringGrid1.Options:=StringGrid1.Options + [goAlwaysShowEditor];
  //範囲選択を可能に設定
  StringGrid1.Options:=StringGrid1.Options + [goRangeSelect];
  //ドラッグ中グリッド内容のスクロールを「行う」に設定
  StringGrid1.Options:=StringGrid1.Options + [goThumbTracking];

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

end;

【IMEは使用不可に設定】

  type
    ・・・

  //Col毎のIMEの制御
  type
    _TGrid = class(TCustomGrid);

  private
    { Private 宣言 }
    ・・・

procedure TFormCollaboration.StringGrid1GetEditText(Sender: TObject; ACol,
  ARow: Integer; var Value: string);
begin
  //IMEの制御
  with TEdit(_TGrid(Sender).InplaceEditor) do
  begin
    ImeMode := imDisable;   //日本語入力OFFは imDisable
  end;
end;

【Enterキーでカーソルは下のセルへ移動】

procedure TFormCollaboration.FormKeyPress(Sender: TObject; var Key: Char);
begin

  //[Enter]キーでコントロールを移動
  //StringGridは編集可能にFormCreateで設定しておく
  //->忘れるとセルの移動にEnter×2回必要!
  //この方法を使う時はKeyPreview:=True;をFormCreateで指定。
  if Ord(Key)=VK_RETURN then
  begin
    if ActiveControl is TStringGrid then
    begin
      if TStringGrid(ActiveControl).EditorMode then
      begin
        //VK_TABではカーソルがレコードの項目を右へ移動。
        //ActiveControl.Perform(WM_KEYDOWN,VK_TAB,0);
        //VK_DOWNにすると同じ項目の次のレコードへ移動。
        ActiveControl.Perform(WM_KEYDOWN,VK_DOWN,0);
        Key:=#0;
      end;
    end else begin
      SelectNext(ActiveControl,True,True);
      Key:=#0;
    end;
  end;

end;

【列の非表示】※StringGridの初期化時と採点欄の切り替え時の両方に設定

  //列幅の自動調整(やるなら列の非表示設定の前に実行)
  for iCOL := 0 to StringGrid1.ColCount-1 do
  begin
    MaxColWidth := 0;
    for iROW := 0 to StringGrid1.RowCount-1 do
    begin
      TmpColWidth := Canvas.TextWidth(StringGrid1.Cells[iCOL,iROW])+10;
      if MaxColWidth < TmpColWidth then
      begin
        MaxColWidth := TmpColWidth;
      end;
    end;
    StringGrid1.ColWidths[iCOL] := MaxColWidth;
  end;

  //必要な列のみ表示
  for i := 1 to StringGrid1.ColCount-1 do
  begin
    if i<>StrToInt(ComboBox1.Text) then
    begin
      StringGrid1.ColWidths[i]:=-StringGrid1.GridLineWidth;
      //StringGrid1.ColWidths[i]:=-1;
    end else begin
      StringGrid1.ColWidths[i]:=45;
    end;
  end;

2.無効化にチャレンジ

やりたいことはわかってるけど、その方法がわからない。特に今回の場合はまったくわからない。なぜ、右矢印キーの押し下げをキャッチしてくれないのか・・・

if Ord(Key)=VK_RIGHT then

理由はわからないが、とにかくFormKeyPress手続きの中に書く上の方法ではダメらしい。VK_RIGHTはここを素通りしてしまう。

Google先生が教えてくれる様々なヒントを読み漁る(ワタシに理解できない内容大変多し・心が折れそうになる)が、「コレだ!」と叫びたくなるような瞬間は訪れず。

しかし、神は私を見捨てなかった・・・。

「Delphi 矢印キー Ord(Key)」で検索すると、検索結果のTopに表示されたのは

Googleの検索結果より抜粋

運命的な出会いを感じつつ、リンクをクリック。すると・・・リンク先(FDELPHI Delphi users’ forum)の記事には、「KeyPreviewをTrueにするだけでは不十分です」との解説が!

記事へのリンク:[Q] フォームへ仮想キーを送ることでつまずいています。

「あったー!」

どこのどなたか存じませぬが、20年以上前にこの書き込みを行ってくださった方に心より深く御礼申し上げます(回答のみで、回答者ご自身のお名前の書き込みはありませんでした)。自らの知識が後の世のどこかで役に立つ日があることを信じて、回答を寄せられたそのお気持ちに到底及ばないと知りながらも、私も同じ気持ちでこれを書いております。

なぜ、到底及ばないか?

上のサイトの回答者様=理由も、仕組みも、わかった上で回答されている。

ワタシ=理由も、仕組みも、なんにもわかってないけど、これを書いている。

共通点:困ってるひとをたすけたい、その一心。

閑話休題。

上記サイトの回答によれば、次のようなイベントハンドラが別に必要であるとのこと。

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

procedure TForm1.AppMessage(var Msg: TMsg; var Handled: Boolean);
begin
  if Msg.message = WM_KEYDOWN then begin

  end;
end;

ここまで用意していただけたなら、あとは「左右の矢印キーだったら、入力を無効化する処理」を書けばイイだけ! それなら、ワタシにもできます。
さっそく、記述しました!!

procedure TFormCollaboration.AppMessage(var Msg: TMsg; var Handled: Boolean);
begin

  //StringGrid上で押された右矢印キーを無効化する
  if Msg.message = WM_KEYDOWN then
  begin
    if ActiveControl is TStringGrid then
    begin
      if TStringGrid(ActiveControl).EditorMode then
      begin
        if Msg.wParam = VK_RIGHT then
        begin
          ShowMessage('捕まえた!');
          Key:=#0;
        end;
      end;
    end;
  end;
end;

うわーん。Keyが「未定義の識別子」エラーに!!! よく見たら・・・

procedure TFormCollaboration.AppMessage(var Msg: TMsg; var Handled: Boolean);

パラメーターにあるはずの(私は「ある」と思い込んでいた)・・・、我が愛しの

var Key: Char

が・・・ない。

ない。ない。ないよー。

どこにもない!!(超号泣)

( やっと、ここまでキタのにー )信じていたものに裏切られた哀しみが、千尋の海のような深まりをもって、胸いっぱいに広がって行くのを感じました。

(天の声:よく確認しないオマエがアホなだけだろー)

それでも(なんでかなー)と思いながら、FormCreate部分に書いた次の一文をよく確認してみると、

Application.OnMessage := AppMessage;

OnMessageをポイントして表示されるヒントを見れば、Keyパラメータが最初から入っていないことは明らかです。そうだったのか・・・

オレの人生は、これまで、いつも、いつだって、七転び八起き じゃねー

七転八倒の人生だったじゃねーか。

ここでもそれを確かめただけだぜー。どぉーってことないよ。

たったひとつだけ残された唯一の取柄、それは「あきらめない」こと☆

ここで私は気がつきます。Keyは未定義の識別子エラーになって使えないけど、

if Msg.wParam = VK_RIGHT then

もしかして、コレは動くんじゃね?

可及的速やかに「実行」

実行してみました

やったー☆ うごいたー☆☆

無効化はまだできませんが、とりあえず今までできなかった「右向きの矢印キーが押し下げられたこと」をキャッチできました。偉大なる前進です。

で、思ったことは、VK_RIGHTって確か仮想キーで、ほんとの姿はただの数字だったはずだよなってことです。試しにMsg.wParamの「wParam」をポイントしてみると表示されるヒントには、wParamは「NativeUInt型」って表示されています。

・・・ってことは、NativeUInt型がナンなのかはまったくわからない(こんな型は初めて見た)けれど、Intが付くから、おそらくInteger型の1種なのでしょう。Google先生に訊くと「プラットフォームに依存する符号なし整数型」と解説にあったので、自然数と言いながらきっと0も使えるのでしょう・・・と、自分に都合よく解釈し、Enterキーの押し下げをキャッチしたときは#0を代入していたから、同じだろうと考え wParam に 0 を投入!(正しくは代入です)

procedure TFormCollaboration.AppMessage(var Msg: TMsg; var Handled: Boolean);
begin

  //StringGrid上で押された右矢印キーを無効化する
  if Msg.message = WM_KEYDOWN then
  begin
    if ActiveControl is TStringGrid then
    begin
      if TStringGrid(ActiveControl).EditorMode then
      begin
        if Msg.wParam=VK_RIGHT then
        begin
          //単に0を代入してwParamを書き換え
          Msg.wParam := 0;
        end;
      end;
    end;
  end;

左矢印キーの押し下げにも、忘れずに対応☆

  //StringGrid上で押された左矢印キーを無効化する
  if Msg.message = WM_KEYDOWN then
  begin
    if ActiveControl is TStringGrid then
    begin
      if TStringGrid(ActiveControl).EditorMode then
      begin
        if Msg.wParam=VK_LEFT then
        begin
          //単に0を代入してwParamを書き換え
          Msg.wParam := 0;
        end;
      end;
    end;
  end;

end;

翌日、左右の制御を合体させた方がイイと気づき、上の2つを合体させて・・・

procedure TFormCollaboration.AppMessage(var Msg: TMsg; var Handled: Boolean);
begin
  //StringGrid上で押された左右の矢印キーを無効化する
  if Msg.message = WM_KEYDOWN then
  begin
    if ActiveControl is TStringGrid then
    begin
      if TStringGrid(ActiveControl).EditorMode then
      begin
        if Msg.wParam=VK_RIGHT then
        begin
          //単に0を代入してwParamを書き換え
          Msg.wParam:=0;
        end;
        if Msg.wParam=VK_LEFT then
        begin
          //単に0を代入してwParamを書き換え
          Msg.wParam:=0;
        end;
      end;
    end;
  end;
end;

で、実行!

StringGridにフォーカスして、Enterキーを押し下げ。
カーソルは期待通り、一つ下のセルへ移動。
次に祈りつつ、右矢印キーを押し下げ。
カーソルは消えません。点滅しています。
なんだか、うれしそうです(おまえだろ)。
期待が確信に変わるのを感じつつ、左矢印キーを押し下げ。
カーソルはやっぱり消えません。

ぎゃはは。為せば成る!

根本的に理解してないけど・・・ *(^_^)*♪

3.まとめ

(1)矢印キーは、Enterキーとは違う手続きで押し下げをキャッチする必要がある。
(2)FormCreate時にKeyPreview を True に設定。
(3)さらにFormCreate時に Application.OnMessage := AppMessage; を記述。
(4)Formのメンバーとして Shift+Ctrl+C でAppMessage 手続きを作成。
(5)AppMessage 手続きの中で矢印キーの押し下げをキャッチする。

4.お願いとお断り

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

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

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

【関連記事】

Mark Sheet Reader (Basic version)

「マークシートリーダーをつくる(基礎編)」

DelphiでGUIを作成、マークシート画像はPythonにインストールしたOpenCVとNumpyで読み取り&計算処理して、結果をMemoに表示するマークシートリーダーの練習プログラム。

0.準備
1.使用するプログラムとマークシート画像について
2.マークシート画像を読み込む
3.マークシート読み取り処理のアルゴリズム
4.マークシート読み取り処理の実際(Object Pascalのコード)
5.さらに進化
6.著作権表示の記載方法
7.お願いとお断り

ここで紹介している練習用プログラムを、実際の採点業務で使用できるようにした拙作マークシートリーダーです。

0.準備

マークシートリーダー作成にあたって、以下の事前準備が必要です。

・PythonForDelphiのインストール
・Embeddable Pythonのダウンロードと必要なライブラリのインストール
(作業後、このプログラムへの埋め込み用にフォルダ名を「Python39-32」に変えて、このプログラム(マークシートリーダー)のexeがある場所へコピーする)
・アプリケーションの表示画面のリサイズ対応(縦編)

(いずれも、当Blogの記事で過去に紹介)

重要 上の記事の手順で、OpenCVとNumpyをインストールしたEmbeddable Pythonが入ったフォルダを「Python39-32」という名前で、以下のフォルダ内にコピーする。

C:\Users\ xxx \ Project1.dprojファイルのあるフォルダ \Win32\Debug\

1.使用するプログラムとマークシート画像について

当Blogの過去記事『~主として「高さ」の変更に関する覚書~』で作成したDelphiのGUIをそのまま使用します。

必要なVCLとその構造(親子関係)

画面サイズの変更に対応できるよう、以下のコードを記述。

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
  Vcl.ExtCtrls, Vcl.Grids, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    Splitter1: TSplitter;
    ScrollBox1: TScrollBox;
    Image1: TImage;
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure Splitter1Moved(Sender: TObject);
  private
    { Private 宣言 }
    //Panel1の幅とFormの高さを記憶する変数
    intPH, intFH:integer;
    //Formの表示終了イベントを取得
    procedure CMShowingChanged(var Msg:TMessage); message CM_SHOWINGCHANGED;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TForm1 }

procedure TForm1.CMShowingChanged(var Msg: TMessage);
begin
  inherited; {通常の CMShowingChagenedをまず実行}
  if Visible then
  begin
    Update; {完全に描画}
    //Formの表示終了時に以下を実行
    Panel1.Height:=intPH;
    intPH:=Panel1.Height;
    intFH:=Form1.Height;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  //Panel1とFormの高さを記憶する変数を初期化
  intPH:=200;
  intFH:=480;
end;

procedure TForm1.FormResize(Sender: TObject);
begin
  //比率を維持してPanel1の高さを変更
  Panel1.Height:=Trunc(Form1.Height * intPH/intFH);
end;

procedure TForm1.Splitter1Moved(Sender: TObject);
begin
  //Panel1とFormの高さを取得
  intPH:=Panel1.Height;
  intFH:=Form1.Height;
end;

end.

マークシート画像は、以下の画像を使用。

「ms01.Jpg」

マークシート画像は、以下の場所に「MarkSheet」という名前のフォルダを作成して、その中に保存。

C:\Users\ xxx \ Project1.dprojファイルのあるフォルダ \Win32\Debug\Marksheet

2.マークシート画像を読み込む

Delphiを起動して、Project1.dproj(マークシート読み取り用GUIの保存してあるフォルダ内のDelphiのプロジェクトファイル)を開き、Panel3をクリックして選択しておいて、Panel3上にButton1を作成。Button1のNameプロパティはButton1のまま、Captionプロパティを「画像を表示」に変更。Button1の位置は下図を参照。

Captionプロパティを「画像を表示」に変更
Button1の位置は画面下・Panel3の左に寄せる

OpenDialog1をForm上に置く。

OpenDialogをダブルクリック
Form上のOpenDialog1

次に、Form上のButton1をダブルクリックして、procedure TForm1.Button1Click(Sender: TObject);を作成。

procedure TForm1.Button1Click(Sender: TObject);
begin

end;

作成した手続きではJpeg画像を扱うので、画面を上にスクロールして、implementation部の下に Vcl.Imaging.Jpeg を uses する。

implementation

uses
  Vcl.Imaging.Jpeg; //Jpeg画像を読み込む

{$R *.dfm}

Button1Clickプロシージャにvar宣言を追加して、Jpeg画像読み込み用の変数jpgを宣言。

procedure TForm1.Button1Click(Sender: TObject);
var
  jpg: TJPEGImage;
begin

end;

beginとend;の間に、以下のコードを記述。

  //OpenDialogのプロパティはExecuteする前に設定
  With OpenDialog1 do begin
    //表示するファイルの種類を設定
    Filter:='JPEG Files (*.jpg, *.jpeg)|*.jpg;*.jpeg';
    //データの読込先フォルダを指定
    InitialDir:=ExtractFilePath(Application.ExeName)+'MarkSheet';
  end;

  if not OpenDialog1.Execute then Exit;  //キャンセルに対応
  //オブジェクトを生成
  jpg := TJPEGImage.Create;
  try
    //読み込み
    jpg.LoadFromFile(OpenDialog1.FileName);
    //Image1に表示
    Image1.Picture.Assign(jpg);
  finally
    //オブジェクトを破棄
    jpg.Free;
  end;

上書き保存(Ctrl+S)して、実行(F9)。データの読み込み先を指定しておくと、目的のフォルダが一発で開くので便利。

マークシート画像が表示される。が、ごく一部しか見えない。

これはImage1のAutoSizeプロパティがデフォルトFalseに設定されているため。 Image1 のAutoSizeプロパティをTrueにするコードを追加(オブジェクトインスペクタで Image1 のAutoSizeプロパティを 直接指定してもOK)。

  try

    //読み込み
    jpg.LoadFromFile(OpenDialog1.FileName);
    //Image1に表示
    Image1.Picture.Assign(jpg);

    //追加
    Image1.AutoSize:=True;

  finally

上書き保存(Ctrl+S)して、実行(F9) 。画像の表示を確認する。

うまくいったように見える。Formを最大化してSplitterを下げて、さらに確認。
画像の表示位置を修正する必要がありそうだ

画像が表示される位置を、画面の左側へ移動するコードを手続きの先頭に追加する。

begin

  //Imageの表示位置を指定
  Image1.Top := 25;
  Image1.Left := 40;

  //OpenDialogのプロパティはExecuteする前に設定しておくこと
  With OpenDialog1 do begin

上書き保存(Ctrl+S)して、実行(F9) 。画像の表示を再度確認する。

ほぼイメージに近い出来栄え?

参考:画像読み込みのコード(全体)

implementation

uses
  Vcl.Imaging.Jpeg; //Jpeg画像を読み込む

{$R *.dfm}

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
var
  jpg: TJPEGImage;
begin

  //Imageの表示位置を指定
  Image1.Top := 25;
  Image1.Left := 40;

  //OpenDialogのプロパティはExecuteする前に設定しておく
  With OpenDialog1 do begin
    //表示するファイルの種類を設定
    Filter:='JPEG Files (*.jpg, *.jpeg)|*.jpg;*.jpeg';
    //データの読込先フォルダを指定
    InitialDir:=ExtractFilePath(Application.ExeName)+'MarkSheet';
  end;

  if not OpenDialog1.Execute then Exit;  //キャンセルに対応
  //オブジェクトを生成
  jpg := TJPEGImage.Create;
  try

    //読み込み
    jpg.LoadFromFile(OpenDialog1.FileName);
    //Image1に表示
    Image1.Picture.Assign(jpg);

    //追加
    Image1.AutoSize:=True;

  finally
    //オブジェクトを破棄
    jpg.Free;
  end;

end;

3.マークシート読み取り処理のアルゴリズム

まず最初にマークシートの左上にある特徴点(マーカー)画像: ■■■(トリプルドット)をOpenCVのテンプレートマッチングで探す。

特徴点(マーカー)画像が見つかったら、 特徴点(マーカー)画像左上位置を基準にして、「マークシートの周囲の枠部分のみ」を矩形選択して切り出し。

参考①:あらかじめ測定しておいた特徴点(マーカー)画像の位置(単位はピクセル)
左上のX座標=65
左上のY座標=28
右下のX座標=121(マークシート矩形の座標計算には使用しない)
右下のY座標=43(マークシート矩形の座標計算には使用しない)

参考②:あらかじめ測定しておいたマークシート矩形の座標 (単位はピクセル)
左上の X座標=65
左上の Y座標=61
右下の X 座標=419
右下の Y 座標=497

参考 上記の各座標をマークシート画像から計測し、テンプレートとして用意したマークシートごとに登録(座標値を保存)するプログラムを別途作成した。なお、座標原点(0,0)は画像の左上である(使い慣れた数学の座標系とちょっと違うことに注意!)。

赤が左上、青が右下の座標で、緑がマークシート枠の矩形

この座標を元にして、 特徴点(マーカー)画像からの距離で、マークシート矩形を切り出す。

マークシート矩形において、(W1、H1)が左上位置を、(W2、H2)が右下位置を示す座標となる。

上の例では、マークシートの列数は「1」、行数は「10」と数えることにする。列数が「1」の場合、W1は「ほぼ0(ゼロ)」になり、値としての意味がないように思われるが、このプログラムを実用化した場合は、下の例のように、複数の列があるマークシートを用いることになるので、2列めのマークシート矩形の座標は、左上が(W3,H3)、右下が(W4,H4)、3列めのマークシート矩形の座標は左上が (W5,H5)、右下が(W6,H6)のように指定でき、W値が0ではない場合が生じる。

マークシート用紙の作成に、私はWordを用いたが、Wordのバージョンによっては、あろうことか、上書き保存時に、マーカー画像(■■■)の位置が数ミリ程度、勝手に左へ移動するという予期しないトラブル(Wordの仕様?)が発生。このような点も考慮して、W1の座標は敢えて(0として)定数化していない。

マークシートの作成例(実験用に使用)
列数3、1列あたりの行数25、1行あたりの選択肢の数は16
この用紙の場合、総マーク数は3×25×16=1200個/枚となる
つまり用紙1枚につき、1200回マークの有無の判定が必要

実際の作業では、マークシート画像をスキャナーで読み取って、グレースケールのJpeg画像としてデータ化するので、マークシート(用紙)に「しわ」があったり、状況によっては「折られ」ていたりする関係上、読み取り画像を1枚ずつ比較すると、その上下・左右にどうしても微妙なブレ・ズレが生じてしまう。しかし、同じ印刷機で、同時に印刷したマークシートであれば、特徴点(マーカー)画像とマークシートの行列位置の関係は絶対であり、これが1枚ごとに変化することはありえない。つまり、スキャンした画像が余程大きく傾きでもしていない限り、テンプレートマッチングで、特徴点(マーカー)画像さえ発見できれば、予め測定・記録しておいた座標の相対的位置関係からマークシート矩形は容易に切り出せる。

次の画像は、別データとして保存してある特徴点(マーカー)画像を元に、OpenCVのテンプレートマッチングをマークシート画像に対して行ったもの。類似度の高い部分を赤枠で囲んで示すようプログラミングしている。

マーカー
テンプレートマッチングを行った画像

次に、上に述べた方法で計算したマークシート矩形を列単位で切り出す。切り出した画像は、マークの(=列)数・行数の整数倍のサイズになるようリサイズする(これは、このあと画像を細かく分割して処理するので、切り出す行や列の計算を簡単にするための工夫 → 整数倍にリサイズすれば、列数分&行数分廻すLoop処理の中で処理しやすい)。

列単位で切り出したマークシート矩形

マークシート用紙は、一般的なマークシート用紙のような厚みのある(高級感あふれる)専用紙でなく、ホームセンターでも「売ってない!」ような見た目が灰色の再生紙を用いている。このためか、あちらこちらにゴミのような黒い点や、細いすじが入っていることがある。これらの黒点やすじを判定プログラムが「マークあり」と誤認しないようにするため、次に「平滑化(ボカシ)処理」を行う。

平滑化(ボカシ)処理には「ガウシアンフィルタ」を用いた。これは、正規(ガウス)分布を利用して「注目画素からの距離に応じて近傍の画素値に重みをかける」という処理を行うもので、自然な平滑化が実現できるとのこと。次の画像は、上の切り出したマークシート矩形に対して、この平滑化処理を行ったもの。

img = cv2.GaussianBlur(img,(35,35),0) ※引数は奇数を指定する必要がある

引数の値が大きいほど正規分布のピークが低く、広がりは広くなる(=より均一に、より全体にボカシがかかる)。ここでは引数をかなり大きめにとり「35」としている。こうすることで、ゴミやシミを画像からほぼ完全に除去できる。

ガウシアンフィルタ処理を行い、ゴミやシミを除去する

さらに、この画像を「ある閾値」を元に白と黒に二値化処理する。この処理で枠線やマークされていないマーク部分が「すべて白」になり、鉛筆で濃くマークされている部分だけが「黒」になった白黒画像が得られる。当初は、以下のように引数を指定して二値化画像を作成した。

ret, img = cv2.threshold(img, 140, 255, cv2.THRESH_BINARY)

現在は、次のように閾値の設定を自動で行う「大津の二値化」を利用している。

ret, img = cv2.threshold(img, 0, 255, cv2.THRESH_BINARY + cv2.THRESH_OTSU)

式中の第2引数は閾値だが、大津の二値化では自動計算させるので0(ゼロ)を指定。第3引数は0-255の256段階でグレースケール化しているから、最大値の255を指定する。これによって、次の画像が得られる。

大津の二値化で作成した白黒画像

さらに、これを白黒反転させた画像を作成する。式は以下の通り。

img = 255 - img

これにより、次の画像が得られる。

マーク部分を「白」に変換した画像

次に、この画像を「行」単位に分割して切り出す。

1行目を切り出した画像

次に、選択肢の数で、均等に分割する。ここでは選択肢の数が「8」なので、上の画像を等幅で8個に分割する。下は、その1個目の切り出し画像である。

このように細かく分割して切り出した画像1つ1つについて、画素が白なら値を255・黒なら0として面積あたりの合計値を計算し、マークされている部分の面積の中央値を算出、これを閾値として、下の式では、マークされている(白い部分の)面積が他より3倍以上あるものを「マークあり!」と判定している。この数値が大きいほど、判定はきびしくなる。

result.append(area_sum > np.median(area_sum) * 3)

このマークシート読み取り処理のアルゴリズムの主要部分は全て、GitHubの次の記事に紹介されていたものです。素晴らしい記事を投稿してくださった作成者の方に、心から感謝申し上げます。

PythonとOpenCVで簡易OMR(マークシートリーダ)を作る

URL:https://qiita.com/sbtseiji/items/6438ec2bf970d63817b8

参考 列が複数あるマークシートの読み取り処理について

上記記事では、特徴点(マーカー)画像をマークシートの上下に複数個用意し、テンプレートマッチングを行っています。確かに、マークシートの左上と右下に特徴点(マーカー)画像を用意すれば、より簡単にマークシート矩形の切り出しが可能でした。これは素晴らしいアイデアです。

私も当初は特徴点(マーカー)画像を複数個用意してマークシートを作成していたのですが、列数を2列、3列と増やすと、さまざまな問題が生じることに気が付きました。

第一に、特徴点(マーカー)画像を変えないと、列ごとの切り出しが困難だということです。つまり、3列あるマークシートでは、最も左の列用の特徴点を■■■、真ん中の列用の特徴点を■□■、最も右側の列用の特徴点を■□□として、Loop処理の中でテンプレートマッチングに使用する特徴点(マーカー)画像を切り替えて、目的とするマークシート矩形を切り出せるようにしてみた(□□■や□□□も含めればさらに多くの列が作成可能)のですが、この方法では、うまく特徴点(マーカー)画像を認識してくれないことがあり、安定感に欠ける気がしました。

第二に、万一、回答者が特徴点(マーカー)画像に意図的に変更を加える(例: ■□□ → ■■□)等の暴挙に出た場合、対応が難しいこと。

第三に、マーカー画像が多いと、マークシートの見た目もなんだか騒がしくて、個人的にはマーカー画像を複数個用意する方法はなるべく避けたいと考えたこと。

これらの理由から、「なんとか特徴点(マーカー)画像が1個で済まないか」と、私なりに工夫して、当ブログで紹介した方法を考えました。

創意工夫の過程で一時は、回答者が意図的に変更できるようなマーカー(例: □ )がなければOKかとも思い、別の特徴点(マーカー)画像も使ってみたのですが、それはそれでまた別の問題を起こすことがわかりました。

例えば、下のように、ヒトなら簡単に両者の違いを判別できる画像を用意します。

用意した特徴点(マーカー)画像

これに対して、左側の画像でテンプレートマッチングを行うと・・・

機械はヒトと違うモノの見方をしていることが、大変良くわかりました。

4.マークシート読み取り処理の実際(Object Pascalのコード)

Form上に、Buttonを1つ、PythonForDelphi関連のVCLコンポーネントを3つ配置する。Button2は、Panel3の中央付近に置き、Nameプロパティはそのまま、Captionプロパティを「読み取り」に変更する。PythonForDelphi関連のVCLコンポーネントは、すべて非ビジュアルコンポーネントなので、位置はどこでもよく、Nameプロパティもデフォルトのままとする。 PythonForDelphi関連で配置するコンポーネントは以下の通り。

以下のように、PythonForDelphi関連のコンポーネントのプロパティとイベントを設定

・PythonEngine1のAutoLoadプロパティはFalseに設定。

・PythonEngine1のDllNameプロパティはpython39.dllを指定(埋め込みPythonのバージョンに合わせて設定する)。ここでは3.9.9以下のバージョンのPythonでないとNumpyが非対応(2021年12月現在)であり、用意した埋め込みPythonのバージョンは3.9.9なのでpython39.dllに変更する。

・PythonEngine1のIOにはPythonGUIInputOutput1を指定。

・PythonGUIInputOutput1は他で利用するならプロパティのOutPutに「Memo1」などとするところだけれど、ここでは何も設定しない。

・PythonDelphiVar1のVarNameはプログラムコードの記述に合わせて「var1」とする。var1と入力後、Enterで確定すること!(青く反転表示されるのを確認する)

Formが生成される時、PythonEngine1を初期化する。Formのタイトルバーの上をクリックして選択し、オブジェクトインスペクタのイベントタブをクリックしてOnCreateイベントの右に表示されている「FormCreate」をダブルクリックして、コードの入力に切り替える。

参考:エラー対応方法(20220724追加)

P4D使用時にImageコントロールの bsClear を使うとエラーが発生します。

[dcc32 エラー] Unit02_MSReader.pas(1199): E2010 'TBrushStyle' と 'Enumeration' には互換性がありません

これはPythonEngine.pasの中で bsClear が定義(使用)されているためです。次に示す例のように、Image1の方のbsClearを明示的に Vcl.Graphics.bsClear として対応します。

  //矩形を描画
  with Image1 do
  begin
    //Canvas.Brush.Style:=bsClear;
    Canvas.Brush.Style:=Vcl.Graphics.bsClear;
  end;

以上、エラー対応でした。解説を続けます。

表示は次のようになっている(はず)。ここにコードを追加する。

procedure TForm1.FormCreate(Sender: TObject);
begin

  //Panel1とFormの高さを記憶する変数を初期化
  intPH:=200;
  intFH:=480;

end;

追加するコード

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

  //Panel1とFormの高さを記憶する変数を初期化
  intPH:=200;
  intFH:=480;

  //以下のコードを追加
  //embPythonの存在の有無を調査
  AppDataDir:=ExtractFilePath(Application.ExeName)+'Python39-32';

  if DirectoryExists(AppDataDir) then
  begin
    //フォルダが存在したときの処理
    MessageDlg('Embeddable Pythonが利用可能です。',
      mtInformation, [mbOk] , 0);
    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
    MessageDlg('Embeddable Pythonが見つかりません!',
      mtInformation, [mbOk] , 0);
    PythonEngine1.AutoLoad:=False;
  end;

end;

ここでMessageDlgを使用しているので、以下のように System.UITypes を uses に追加する。

implementation

uses
  Vcl.Imaging.Jpeg, System.UITypes;  // <-追加

  //Jpeg:Jpeg画像を読み込む
  //System.UITypesはMessageDlgの表示に必要

{$R *.dfm}

プライベートメンバー変数 intCnt(カウンタとして利用する)と strAnsList(Pythonから返された計算結果を保存する) を2つ、Private宣言で新しく宣言する。

  private
    { Private 宣言 }

    //for Python(追加)
    //Counter
    intCnt:integer;
    //Pythonから送られたデータを保存
    strAnsList:TStringList;

    //Panel1の幅とFormの高さを記憶する変数
    intPH, intFH:integer;
    //Formの表示終了イベントを取得
    procedure CMShowingChanged(var Msg:TMessage); message CM_SHOWINGCHANGED;

  public
    { Public 宣言 }
  end;

Form上のButton2(読み取りボタン)をダブルクリックして、手続きを作成し、以下の内容を入力する。

procedure TForm1.Button2Click(Sender: TObject);
var
  StrList:TStringList;
  strJCnt,strColCnt,strRowCnt,strSelCnt:String;
  TopLX, TopLY, TLX1, TLY1, BRX1, BRY1:integer;
  strPicName:string;
begin

  //初期化
  Memo1.Clear;
  intCnt:=1;

  //座標
  TopLX:=65;
  TopLY:=28;
  //BtmRX:=121;
  //BtmRY:=43;
  TLX1:=65;
  TLY1:=61;
  BRX1:=419;
  BRY1:=497;

  //マークシート数Check(+1することを忘れない)
  strJCnt:=IntToStr(2);

  //列数Check(+1することを忘れない)
  strColCnt:=IntToStr(2);

  //1列あたりの行数Check
  strRowCnt:=IntToStr(10);

  //選択肢数Check
  strSelCnt:=IntToStr(8);

  //マークシート名
  strPicName:='ms';

  //結果を保存するStringList
  strAnsList := TStringList.Create;

  //Scriptを入れるStringList
  StrList := TStringList.Create;

  try

    //Python Script
    StrList.Add('import cv2');
    StrList.Add('import numpy as np');

    //for JPN(日本語に対応)
    StrList.Add('def imread(filename, flags=cv2.IMREAD_GRAYSCALE, dtype=np.uint8):');
    StrList.Add('    try:');
    StrList.Add('        n = np.fromfile(filename, dtype)');
    StrList.Add('        img = cv2.imdecode(n, flags)');
    StrList.Add('        return img');
    StrList.Add('    except Exception as e:');
    StrList.Add('        return None');

    //マーカー画像を読み込む
    StrList.Add('template = imread("marker.png", cv2.IMREAD_GRAYSCALE)');

    //マークシートの枚数
    StrList.Add('for j in range(1,'+strJCnt+'):');

    //列数
    StrList.Add('    for i in range(1,'+strColCnt+'):');

    //マークシートへのパスを取得
    StrList.Add('        if j < 10:');
    StrList.Add('            MS_Name = r".\Marksheet\'+ strPicName +'0"+ str(j) +".jpg"');
    StrList.Add('        else:');
    StrList.Add('            MS_Name = r".\Marksheet\'+ strPicName +'"+ str(j) +".jpg"');

    //画像を読み込む
    StrList.Add('        img = imread(MS_Name)');
    //画像をグレースケールで読み込む
    StrList.Add('        img_gray = imread(MS_Name, 0)');

    //テンプレートマッチングの実行(比較方法cv2.TM_CCORR_NORMED)
    StrList.Add('        result = cv2.matchTemplate(img, template, cv2.TM_CCORR_NORMED)');

    //類似度が最小,最大となる画素の類似度、位置を調べ代入する
    StrList.Add('        min_val, max_val, min_loc, max_loc = cv2.minMaxLoc(result)');
    //最も似ている領域の左上の座標を取得
    StrList.Add('        top_left = max_loc');
    StrList.Add('        if i == 1:');

    //補正値を取得(高さ)
    StrList.Add('            h1 = ' + IntToStr(TLY1 - TopLY));
    StrList.Add('            h2 = ' + IntToStr(BRY1 - TopLY));
    //補正値を取得(幅)
    StrList.Add('            w1 = ' + IntToStr(TLX1 - TopLX));
    StrList.Add('            w2 = ' + IntToStr(BRX1 - TopLX));

    //矩形の左上の座標を計算 [0]-> X, [1]-> Y
    StrList.Add('        TL = (top_left[0] + w1, top_left[1] + h1)');
    //矩形の右下の座標を計算
    StrList.Add('        BR = (top_left[0] + w2, top_left[1] + h2)');
    //画像を切り出し img[top_Y : bottom_Y, left_X : right_X]
    StrList.Add('        img = img_gray[TL[1] : BR[1], TL[0] : BR[0]]');

    //選択肢数
    StrList.Add('        n_col = '+ strSelCnt);

    //解答欄1列あたりの行数
    StrList.Add('        n_row = '+ strRowCnt);
    StrList.Add('        margin_top = 0');
    StrList.Add('        margin_bottom = 0');
    StrList.Add('        n_row = n_row + margin_top + margin_bottom');

    //マークの列数・行数の整数倍のサイズになるようリサイズ
    StrList.Add('        img = cv2.resize(img, (n_col*100, n_row*100))');

    //保存して確認
    //StrList.Add('        cv2.imwrite("01_ReSize.png", img)');

    //平滑化の度合い
    StrList.Add('        img = cv2.GaussianBlur(img,(35,35),0)');

    //保存して確認
    //StrList.Add('        cv2.imwrite("02_GaussianBlur.png", img)');

    //二値化の閾値
    //50を閾値として2値化
    //imgはグレースケール画像でなければならない
    //第2引数はしきい値で,
    //画素値を識別するために使用(指定)
    //第3引数は最大値でしきい値以上
    //(指定するフラグ次第では以下)の値を持つ
    //画素に対して割り当てられる値
    //StrList.Add('        ret, img = cv2.threshold(img, 140, 255, cv2.THRESH_BINARY)');

    //大津の二値化で閾値の設定を自動化
    //第1引数には画像データを設定
    //(グレースケール画像でなければならない)
    //第2引数はしきいだが自動計算させるので0(ゼロ)を指定
    //第3引数は0-255の256段階でグレースケール化しているから
    //最大値の255を指定
    StrList.Add('        ret, img = cv2.threshold(img, 0, 255, cv2.THRESH_BINARY + cv2.THRESH_OTSU)');

    //保存して確認
    //StrList.Add('        cv2.imwrite("03_threshold.png", img)');

    //白黒を反転
    StrList.Add('        img = 255 - img');

    //保存して確認(追加)
    StrList.Add('        cv2.imwrite("04_threshold.png", img)');

    //全マークを判定
    StrList.Add('        result = []');
    StrList.Add('        for row in range(margin_top, n_row - margin_bottom):');
    StrList.Add('            tmp_img = img [row*100:(row+1)*100,]');
    StrList.Add('            area_sum = []');
    StrList.Add('            for col in range(n_col):');
    StrList.Add('                area_sum.append(np.sum(tmp_img[:,col*100:(col+1)*100]))');
    StrList.Add('            result.append(area_sum > np.median(area_sum) * 3)');

    //判定結果を出力
    StrList.Add('        for x in range(len(result)):');
    StrList.Add('            res = np.where(result[x]==True)[0]+1');
    StrList.Add('            if len(res)>1:');
    StrList.Add('                var1.Value = "99"');
    StrList.Add('            elif len(res)==1:');
    StrList.Add('                s = str(res)');
    StrList.Add('                var1.Value = s[1]');
    StrList.Add('            else:');
    StrList.Add('                var1.Value = "999"');

    //Execute
    PythonEngine1.ExecStrings(StrList);

    //結果を表示
    Memo1.Lines.Assign(strAnsList);

    //Userへ案内
    MessageDlg('読み取り完了!', mtInformation, [mbOk] , 0);

  finally
    //解放
    StrList.Free;
    strAnsList.Free;
  end;

end;

Pythonから返された計算結果を受け取るため、PythonDelphiVar1のOnSetDataイベントの手続きを作成する。Form上のPythonDelphiVar1をクリックして選択し、オブジェクトインスペクタのOnSetDataイベントの右側をダブルクリックして、コード入力画面で以下の内容を入力する。

procedure TForm1.PythonDelphiVar1SetData(Sender: TObject; Data: Variant);
begin
  //値がセットされたら動的配列に値を追加
  strAnsList.Add(Data);
  intCnt:=intCnt+1;
  Application.ProcessMessages;
end;
表示の「999」は空欄、「99」は複数マークであることを意味する。

上書き保存(Ctrl+S)して、実行(F9)。次の画像のように、マークシートが正しく読み取り処理されることを確認する。

複数マークを許可する場合には、判定結果を出力する部分のコードを次のように変更する。マークシートの読み取り結果をCSVファイルに出力したり、Excelに書き出したりして利用する場合には、複数回答は99、未回答は999のように処理した方が、後々の処理がラクになる(・・・と思う)。

    //判定結果を出力(複数回答は99、未回答は999で表示)
    {コメント化ここから
    StrList.Add('        for x in range(len(result)):');
    StrList.Add('            res = np.where(result[x]==True)[0]+1');
    StrList.Add('            if len(res)>1:');
    StrList.Add('                var1.Value = "99"');
    StrList.Add('            elif len(res)==1:');
    StrList.Add('                s = str(res)');
    StrList.Add('                var1.Value = s[1]');
    StrList.Add('            else:');
    StrList.Add('                var1.Value = "999"');
    ここまで}

    //判定結果を出力(複数回答の詳細を表示)
    StrList.Add('        for x in range(len(result)):');
    StrList.Add('            res = np.where(result[x]==True)[0]+1');
    StrList.Add('            if len(res)>1:');
    StrList.Add('                var1.Value = str(res)+ '+'"!複数回答!"');
    StrList.Add('            elif len(res)==1:');
    StrList.Add('                s = str(res)');
    StrList.Add('                var1.Value = s[1]');
    StrList.Add('            else:');
    StrList.Add('                var1.Value = " *未回答*"');

PythonEngineが正しく初期化され、Embeddable Pythonが利用できることが確認できたら、このメッセージは必要ないのでコメント化しておく。

procedure TForm1.FormCreate(Sender: TObject);
var
  //Python39-32へのPath
  AppDataDir:string;
begin
  ・・・
  if DirectoryExists(AppDataDir) then
  begin
    //フォルダが存在したときの処理(コメント化)
    //MessageDlg('Embeddable Pythonが利用可能です。',
    //  mtInformation, [mbOk] , 0);
    PythonEngine1.AutoLoad:=True;

5.さらに進化

さまざまな機能を追加したマークシートリーダー
(ファイルの名称を連番で変更/画像の回転/グリッド指示位置と画像の連動/グリッド指示位置を画像上で矩形選択/閾値等各種パラメータの調整と保存機能/音声読み上げ関連機能の搭載/回答チェック機能(空欄&複数回答対応)/CSV形式でのデータ出力/ExcelBookへのデータ出力/様式の異なるマークシートをテンプレートとして登録して利用可能/抱き合わせ採点の実施機能/共通テスト(数学の様式)に対応等、考えつく限りの機能を搭載/さらに進化します!)

このプログラムでは、「マークシート画像の表示」と、「読み取り処理」の間に何も関連がないが、このプログラムをさらに発展させて、複数枚数の処理を可能にし、読み取り結果を画面上で確認するような機能を追加する際には、マークシート画像の表示はどうしても必要な機能になる。

さらに、画面の左側などに読み込んだマークシートがリスト形式で表示されるようにして、ここから任意のマークシート画像を選んで表示できるような機能も追加するとよいと思う。

読み取り結果も、ここではMemoに表示しているが、CSVやExcelへ出力して利用することを考えると、ここはGridコントロールに変更したい。

Gridコントロール上で選択したデータの該当回答欄に相当する画像が自動的に画面上に表示され、かつ、表示されたマークシート画像上の該当回答欄が矩形で選択され、ユーザーがチェックしやすいGUIにするとなお良いだろう。

また、チェック時にはユーザーがマークシート画像を見ながら確認作業が行えるよう、Gridコントロールの数字をアナウンスしてくれる音声読み上げ機能があると大変便利だ。それから、回答の必要がない、全マークシートが空欄となっている部分は、予め指定することで、チェックから除外できる機能も欲しい。

さらに、スキャナーから読み込んだ画像データを回転させたり、連番で扱いやすい名前に変更したり、様式の異なるマークシートをテンプレートとして登録できるような機能も搭載したい。

より一層ユーザーに優しい、夢に見たようなマークシートリーダーを開発したい。この希望の実現に向けて、日々努力する私でありたい。

Web上に貴重な資料を公開してくださった多くの皆さまに心より深く御礼申し上げます。ほんとうにありがとうございました。

6.著作権表示の記載方法

参考:Python4DelphiのLicenseについて

GitHubのPython4Delphiのダウンロードページには「The project is licensed under the MIT License.」とある。これは「改変・再配布・商用利用・有料販売すべてが自由かつ無料」であること、及び使用するにあたっての必須条件はPython4Delphiの「著作権を表示すること」と「MITライセンスの全文」or 「 MITライセンス全文へのLink」をソフトウェアに記載する、もしくは、別ファイルとして同梱しなさい・・・ということを意味する。

したがってPython4Delphiを利用したプログラムの配布にあたっては、ソフトウェアの中で、次のような著作権表示を行うか、もしくは P4DフォルダのルートにあるLicenseフォルダをプログラムに同梱して配布すればよいことになる。

Python4Delphiを利用した場合の著作権表示の記載例:

Copyright (c) 2018 Dietmar Budelsky, Morgan Martinet, Kiriakos Vlahos
Released under the MIT license
https://opensource.org/licenses/mit-license.php

7.お願いとお断り

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

【関連記事】

Installing The Splitter & Resizing Height of the VCL Components

「~ 主として「高さ」の変更に関する覚書 ~」

0.準備
1.最も簡単なリサイズ対応(高さの変更)・・・ AlignプロパティとSplitterの利用法
2.さまざまなVCLコンポーネントを追加する
3.画面サイズの変更に追随(主として高さ)
4.まとめ
5.ご案内
6.お願いとお断り

DelphiのVCLコンポーネントTSplitterの使い方と画面のリサイズ対応の覚書Part2。
ここでは、主として「高さ」に関する設定を取り上げる。

0.準備

Delphiを起動して、新規プロジェクトを作成後、任意のフォルダに「プロジェクトに名前を付けて保存」する。※ 同じフォルダにプロジェクトとは別名で、Unitファイルも保存する(Unitが1つしかないプログラムでも、プロジェクトとは別名でUnitファイルを保存する必要がある)。ここではデフォルト設定の名称をそのまま利用する。

・プロジェクトファイル名:Project1.dproj
・ユニットファイル名:Unit1.pas

1.最も簡単なリサイズ対応(高さの変更)・・・ AlignプロパティとSplitterの利用法

FormにPanelを3つドラッグ&ドロップする。もし、 ドラッグ&ドロップ ではなく、PanelをダブルクリックしてFormに置く場合は、操作手順に要注意。パレットのPanelを連続してダブルクリックすると、Formではなく、Panel1の上に次々と新しいPanelが乗っかってしまう。Panel1が出現したら、いったん(Panel2の親となる)Formをクリックして選択してから、パレットのPanelを再度ダブルクリックする。

PanelはStandardに入っている
Formへドラッグ&ドロップする

画面は、次のようになる。

Panel1をクリックして選択したら、次の図のように操作してPanel1のAlignプロパティをalTopに設定する。

画面は次のようになる。

ここでFormをクリックして選択し、Form(親)がアクティブな状態で、このForm(親)に対して、Splitterコンポーネントを(子として)設置する。この「何が親で、何が子なのか」をまず明確にして、かつ、「それぞれの子の状態は、親に対してどうなのか=どんなGUIにするのか」を考えながら作業すると混乱を防げる。

構造をみれば親子関係がわかる

下の図はSplitterを置いたところ。Alignプロパティのデフォルト設定が「alLeft」なのでSplitterはFormの左端に貼りついている。ここで、Splitterを選択したまま、SplitterのAlignプロパティを 「alTop」 に設定すると、Panel1の下に貼り付くように、Splitterの位置が変化して、それと同時に、SplitterのCursorプロパティが上下分割カーソルを意味する「crVSplit」に自動的に変更される。このようにして「親」に対する、「子」の状態を適切に決めて行く。

この状態で SplitterのAlignプロパティを 「alTop」 に設定する
SplitterのAlignプロパティをalTopに設定すると、Cursorプロパティも連動して「crVSplit」に変化する

さらに、実行時のSplitterの動作をわかりやすくするため、SplitterのAutoSnapプロパティをFalseに設定し、MinSizeを「30(デフォルト設定値)」にする。実際の操作としては、SplitterのAutoSnapプロパティをFalseに設定し、下方へスクロールすれば、MinSizeは30になっている(はず)。

AutoSnapプロパティをFalseに設定

次に、Panel3をクリックして選択し、 次の図のように操作してPanel3のAlignプロパティをalBottomに設定する。

画面は次のようになる。

次に、Panel2をクリックして選択し、 次の図のように操作してPanel2のAlignプロパティをalClientに設定する。

Panel2のAlignプロパティをalClientに設定

次にPanel1をクリックして選択し、下のハンドルをドラッグして(Panel1の)高さを少し大きくして下の図のようにする。この状態で上書き保存(Ctrl+S)して実行(F9)し、Splitterが意図した通りに動作することを確かめる。

実行(F9)して、Splitterの動作を確認する

2.さまざまなVCLコンポーネントを追加する

ここで、Panel1~3のCaptionプロパティを「空欄」にして、Panelの名前が表示されないように設定する。さらに、Panel1をクリックして選択し(親にして)、Panel1の上にScrollBoxを載せ、ScrollBoxのAlignプロパティをalClientに設定する。さらに、その上にImageを1つ載せる。ImageのAlignプロパティは「None」のままでよい。

次に、Panel2をクリックして選択し、Memoを1つ載せ、MemoのAlignプロパティをal Clientに設定する。

VCLコンポーネントの配置について慣れないうちは、かなり混乱するが、何が親で、どれが子になって、どういう状況で仕事をさせたいか(このVCLは常に画面の下方に固定で・・・とか、親の残りのスペース全部=alClientで・・・など)を、「よーく考えながら」作業すると、必要なコンポーネントだけでなく、それを設置する順番も見えてくる。

必要な各VCLコンポーネントがパレットのどこにあるのか? もし、場所を忘れてしまっていても、 コンポーネントの名前で検索すれば、検索窓に3~4文字入れた時点で、ほぼ見つかるので、設置したいVCLコンポーネント の機能と名前さえ思い出せれば、そのパレット内の配置に関しては、まったく覚えていなくても、何とかなる。

むしろ、このようなシーンで重要なのは、「実現したい処理にはどんなVCLコンポーネントが最適なのか?」そして「どのコンポーネントを、どう配置すれば、ユーザーに最も使いやすいGUI環境を提供できるのか?」の2点だと思う。

GUI作成に関しては、プログラマ個々のデザインのセンスの良し悪しも当然あると思うが、これに加えて、そのプログラマが「どれだけ修羅場を経験したか・・・」というような、個々のバックグラウンドにある経験も、もしかしたら重要な要素のひとつかもしれない・・・。

VCLコンポーネントの検索例

各VCLコンポーネントの親子関係を「構造」で確認。

VCLコンポーネントの親子関係がよくわかる

いちばん下の階層にあるPanelは、画面では他のコントロールに隠されて見えない。

画面を見ただけでは、各コンポーネントの階層構造はわからない

上書き保存(Ctrl+S)して実行(F9)し、Splitterの動作やFormを最大化した際の各コントロールの見え方等を確認する。

3.画面サイズの変更に追随(主として高さ)

さらに、Formの大きさが変わっても、その時点でのPanel1とFormの高さの比率が維持されるようにプログラミングしてみた。 まず、Private宣言部で整数型の変数2つと、Formが完全に表示された時点で実行される表示終了イベントを取得する手続き procedure CMShowingChanged を宣言。

Formの 表示終了イベントを取得するprocedureの実現部は、以下に記載したコードをミスのないように入力し(文法的に誤りのない状態で)、procedure CMSShowingChanged~行のどこか(付近でも可)にフォーカスがある(=カーソルがある)状態で、Shift+Ctrl+C操作を行うと、手続きが自動的に生成される。

Shift+Ctrl+C:キーボード左側のShiftキーとCtrlキーを左手で同時に押して、さらに右手でCキーを押す

また、宣言の順番も大切。プライベートメンバー変数と手続き(procedure)の宣言の順番が逆になってはいけない。 プライベートメンバー変数の宣言を、手続きの宣言より必ず先に行う必要がある。

  private
    { Private 宣言 }
    //Panel1の幅とFormの高さを記憶する変数
    intPH, intFH:integer;
    //Formの表示終了イベントを取得
    procedure CMShowingChanged(var Msg:TMessage); message CM_SHOWINGCHANGED;
  public
    { Public 宣言 }
  end;

Formの表示終了イベントを取得して、その時点でのPanel1とFormの高さを記憶する。

フォームの表示完了時に処理する(くろねこ研究所さん)

URL:https://www.blackcat.xyz/article.php/ProgramingFAQ_del0049より引用
procedure TForm1.CMShowingChanged(var Msg: TMessage);
begin
  inherited; {通常の CMShowingChagenedをまず実行}
  if Visible then
  begin
    Update; {完全に描画}
    //Formの表示終了時に以下を実行
    Panel1.Height:=intPH;
    intPH:=Panel1.Height;
    intFH:=Form1.Height;
  end;
end;

Formが生成される際に、Panel1とFormの高さをプログラムから指示して決定。

procedure TForm1.FormCreate(Sender: TObject);
begin
  //Panel1とFormの高さを記憶する変数を初期化
  intPH:=200;
  intFH:=480;
end;

Formの大きさの変更イベントに合わせて、Panel1の高さを計算して決定。

procedure TForm1.FormResize(Sender: TObject);
begin
  //比率を維持してPanel1の高さを変更
  Panel1.Height:=Trunc(Form1.Height * intPH/intFH);
end;

ここがいちばん重要か? Splitterが動かされたら(=Movedイベントが発生)、それが動かされた時点(=動かされる直前)でのFormとPanel1の高さを取得。この値をもとにしてFormとPanel1の高さの比率を計算し、さらに、この比率をもとにFormのResize時に Panel1 の高さを計算、その計算結果の小数点以下を切り捨てた整数値を Panel1.Heightプロパティに設定している。※ Heightは整数値で、小数点以下の値にこだわる必要はまったくないから。

procedure TForm1.Splitter1Moved(Sender: TObject);
begin
  //Panel1とFormの高さを取得
  intPH:=Panel1.Height;
  intFH:=Form1.Height;
end;

上書き保存(Ctrl+S)し、実行(F9)して、Panel1の高さを変更し、Formの大きさを最大化して、Formと Panel1の高さの比率が維持されることを確認する。

プログラム起動時の画面
最大化した状態(縦の比率が維持されていることを確認)

4.まとめ

Formに置いたVCLコンポーネントの高さを実行時に調整できるようにするには、Splitterを利用する。手順は以下の通り。

(1)Panelを3つ、Formに設置。上位のPanel1のAlignプロパティを alTop に設定。
(2)Form(親)をクリックして選択後、Splitter(子)を設置。
(3)Panel3のAlignプロパティを alBottomに設定(=Panel3は固定する)。
(4)Panel2の AlignプロパティをalClientに設定。

5.ご案内

今回作成したプログラムを利用して、次回、マークシートリーダー作成の練習プログラムを紹介します。プログラムのGUIはDelphiで今回作成したものをそのまま使い、マークシート読み取りと計算処理は、このBlogでこれまでに紹介してきた PythonForDelphi と Embeddable Python を用いて行います。練習用なので、マークシートの読み取り枚数は1枚で、読み取り結果の表示にはMemoを利用します。

実用化するには、複数シートを読み取れるよう、さらにLoop処理を加えたり、読み取り結果のCSVファイル等への出力も考慮して、結果表示用にMemoではなく、Gridコントロールを用いる等、さらなる工夫が必要ですが、最も重要な「マークシートを読み取る」というプログラムの核心部分を丁寧に紹介します。興味のある方はぜひ、ご覧ください。

6.お願いとお断り

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

【関連記事】

Installing the Splitter & Resizing Width of the VCL Components

「~ 主として「幅」の変更に関する覚書 ~」

0.準備
1.最も簡単なリサイズ対応(幅の変更)・・・ AlignプロパティとSplitterの利用法
2.最も簡単なリサイズ対応(幅の変更)・・・ Anchorsプロパティの利用法
3.画面サイズの変更に追随(主として幅)
4.まとめ
5.お願いとお断り

DelphiのVCLコンポーネントTSplitterの使い方と画面のリサイズ対応の覚書。

Formの大きさは決め打ちで、決してResizeしない前提でプログラミングできれば、ある意味、それがいちばんラクなんだけど・・・。百歩譲って、Formの大きさはResizeしなくても、Formの中にあるVclコンポーネントの幅・高さは変更できた方がうれしい場合は多い。

例えば、 マークシート画像を読み取って処理する場合、マークシート画像と読み取り結果を比較(チェック)するには、画像と読み取り結果の両方が1つの画面上に表示されていることが望ましい。このような場合に備えて、必要に応じて「画像」と「データ」の表示領域を思いのまま手動で広げたり、狭めたり出来る機能をユーザーに提供したいと考えるのは、全プログラマに共通の思いだろう・・・。

そのような私自身の経験を基に、何に使うかはアイデア次第として、画面の左右や上下にさまざまなVCLコンポーネントが置かれている時、 Splitterを使ってその幅や高さを自由に変える方法をここでは取り上げた。

さらに、Formの大きさの変化に合わせ、Form上に置いた各コンポーネントの大きさ(主として幅)が追随して変化するようなプログラミングにも(自我流で恥ずかしい限りだが)チャレンジしてみた。

主として「幅」の変更に関する覚書

0.準備
1.最も簡単なリサイズ対応(幅の変更)・・・ AlignプロパティとSplitterの利用法
2.最も簡単なリサイズ対応(幅の変更)・・・ Anchorsプロパティの利用法
3.画面サイズの変更に追随(主として幅)
4.まとめ
5.お願いとお断り

0.準備

Delphiを起動して、新規プロジェクトを作成後、任意のフォルダに「プロジェクトに名前を付けて保存」する。※ 同じフォルダにプロジェクトとは別名で、Unitファイルも保存する(Unitが1つしかないプログラムでも、プロジェクトとは別名でUnitファイルを保存する必要がある)。ここではデフォルト設定の名称をそのまま利用する。

・プロジェクトファイル名:Project1.dproj
・ユニットファイル名:Unit1.pas

1.最も簡単なリサイズ対応(幅の変更)・・・ AlignプロパティとSplitterの利用法

最も簡単なリサイズ対応は、Formに置いたPanelなどのAlignプロパティをalNoneからalClientに変更することだ。これでFormの大きさの変更に合わせて(幅・高さ共に)、Form上のPanelの大きさも、親Formの大きさの変更に追随して変わるようになる。
もし、Panel上にButtonを1つだけ置いて使用するのであれば、Buttonの Anchorsプロパティを適切に指定するだけで、画面のリサイズに対応したGUIが完成する。

何に使うかはアイデア次第として、ここではサンプルとして画面の左にMemo、右にPanel(いろいろなコンポーネントを置くベース)がある条件で、Memoの幅を自由に変える方法を取り上げる。さらに、Formの大きさが変わっても、その時点でのMemoとPanelの幅の比率が維持されるような(自我流の)プログラミング例も掲載した。

新規作成したプロジェクトのForm上に、MemoとPanelを1つずつ置く。
MemoもPanelもパレットのStandardにあるので、まずStandardを開く。

>をクリックして開く
MemoとPanelをそれぞれFormへドラッグ&ドロップ
(それぞれをダブルクリックしてもよい)
Form上にMemoとPanelがのる

Memo1をクリックして選択し、下図のように操作してMemoのAlignプロパティをalLeftに設定する。

画面は次のようになる。

重要 ここでFormをクリックして選択する(Formをアクティブにする)。

ハンドル(水色の枠)がMemoからFormに移動し、Formの方がアクティブになる。

Formをアクティブにした状態で、パレットでsplitterを検索する。splitterはAdditionalにあるコントロールで、これを2つのコントロールの間に追加すると、ユーザーが実行時にそのコントロールのサイズを変更できるようになる。

「split」未満の入力で見つかるはず

見つけたらTSplitterをダブルクリックしてFormに配置する。

Memoの右側にSplitterが配置される。
デフォルトでは「幅」の変更用になっている

Cursorプロパティに設定された「crHSplit」は「左右分割カーソル」を意味する。ちなみに、「crVSplit」を指定すると「上下分割カーソル」になる。

最後に、PanelコンポーネントのAlignプロパティを変更する。Panelをクリックして選択し、オブジェクトインスペクタのAlignプロパティを alClient に設定する。

これでMemoの幅の大きさを自由に変更できるはず

Ctrl+Sで上書き保存、F9を押して実行。意図した通りに操作できるか、確認する。

設計時にMemoの幅を適切に指定することで、実行時の初期画面を意図した通りに作成できる。

参考:SplitterのAutoSnapプロパティをFalseすると、幅を小さくしたとき、 Splitterの MinSizeプロパティで設定した値以下に変更されなくなる。これを用いると、MemoやPanelが完全に隠されてしまう事態を予め防止できる。

SplitterのAutoSnapをFalse、MinSizeを30に設定
MemoもPanelも幅がMinSize以下にならない

2.最も簡単なリサイズ対応(幅の変更)・・・ Anchorsプロパティの利用法

では、Panelの上にButtonをのせたら、画面サイズの変更に合わせてButtonの位置はどのように変わるのだろうか?

これを検証してみる。Panel1をクリックして選択し、その上にButtonを1つ設置する。

Panel1が選択されている状態でダブルクリック

設置したButtonの位置を変更する(下図のようにFormの右下隅の方へドラッグして移動)。Buttonのプロパティはデフォルト設定のままにしておく。

この状態で上書き保存(Ctrl+S)し、実行(F9)して、Formの大きさを最大化してみる。

右上の × をクリックして画面を閉じる

Button1の位置を常識的な位置へ自動的に変化させる最も簡単な方法は、「Anchorsプロパティ」の利用である。Button1をクリックして選択し、オブジェクトインスペクタのAnchorsプロパティの設定を次のように変更する。

上書き保存(Ctrl+S)し、実行(F9)して、Formの大きさを最大化して確認する。

右上の × をクリックして画面を閉じる

ちなみに下図のように設定すると・・・

AnchorsプロパティをすべてTrueに設定
もしかしたら、場合によってはアリかも・・・。 右上の × をクリックして画面を閉じる

ちなみに、コレだと・・・

akTopのみFalseに設定
「年越しそば」的な挙動を見せました。ほそーく、ながーく なりました。ある意味これがベスト?

3.画面サイズの変更に追随(主として幅)

さらに、Formの大きさが変わっても、その時点でのMemoとPanelの幅の比率が維持されるようにプログラミングしてみた。 まず、Private宣言部で整数型の変数2つと、Formが完全に表示された時点で実行される表示終了イベントを取得する手続き procedure CMShowingChangedを宣言。

Formの 表示終了イベントを取得するprocedureの実現部は、以下に記載したコードをミスのないように入力し(文法的に誤りのない状態で)、procedure CMSShowingChanged ~行のどこか(付近でも可)にフォーカスがある(=カーソルがある)状態で、Shift+Ctrl+C 操作を行うと、手続きが自動的に生成される。

Shift+Ctrl+C:キーボード左側のShiftキーとCtrlキーを左手で同時に押して、さらに右手でCキーを押す

また、宣言の順番も大切。プライベートメンバー変数と手続き(procedure)の宣言の順番が逆になってはいけない。 プライベートメンバー変数の宣言を、手続きの宣言より必ず先に行う必要がある。

  private
    { Private 宣言 }
    //Memoの幅とFormの幅を記憶する変数
    intMW, intFW:integer;
    //Formの表示終了イベントを取得
    procedure CMShowingChanged(var Msg:TMessage); message CM_SHOWINGCHANGED;
  public
    { Public 宣言 }
  end;

Formの表示終了イベントを取得して、その時点でのMemoとFormの幅を記憶する。

フォームの表示完了時に処理する(くろねこ研究所さん)

URL:https://www.blackcat.xyz/article.php/ProgramingFAQ_del0049より引用
procedure TForm1.CMShowingChanged(var Msg: TMessage);
begin
  inherited; {通常の CMShowingChagenedをまず実行}
  if Visible then
  begin
    Update; {完全に描画}
    //Formの表示終了時に以下を実行
    Memo1.Width:=intMW;
    intMW:=Memo1.Width;
    intFW:=Form1.Width;
  end;
end;

Formが生成される際に、MemoとFormの大きさをプログラムから指示して決定。

procedure TForm1.FormCreate(Sender: TObject);
begin
  //MemoとFormの幅を記憶する変数を初期化
  intMW:=480;
  intFW:=640;
end;

Formの大きさの変更イベントに合わせて、Memoの幅を計算して決定。

procedure TForm1.FormResize(Sender: TObject);
begin
  //比率を維持してMemoの幅を変更
  Memo1.Width:=Trunc(Form1.Width*intMW/intFW);
end;

ここがいちばん重要か? Splitterが動かされたら(=Movedイベントが発生)、それが動かされた時点(=動かされる直前)でのFormとMemoの幅を取得。この値をもとにしてFormとMemoの幅の比率を計算し、さらに、この比率をもとにFormのResize時にMemoの幅を計算、その計算結果の小数点以下を切り捨てた整数値をMemo1.Widthプロパティに設定している。※ Widthは整数値で、小数点以下の値にこだわる必要はまったくないから。

procedure TForm1.Splitter1Moved(Sender: TObject);
begin
  //MemoとFormの幅を取得
  intMW:=Memo1.Width;
  intFW:=Form1.Width;
end;

上書き保存(Ctrl+S)し、実行(F9)して、Memoの幅を変更し、Formの大きさを最大化して、FormとMemoの幅の比率が維持されることを確認する。

Buttonコントロールの幅の違いに注目(上と下の画像は、同じ画像ではありません)

Formの幅は640ピクセル、Memoの幅は480ピクセルで表示
画面を最大化してみた。Formの幅とMemoの幅の比率は保たれているように見える。

数値的にはどうかと思い、FResize前のFormとMemoの幅を表示してみた。

procedure TForm1.FormResize(Sender: TObject);
begin
  //比率を維持してMemoの幅を変更
  Memo1.Width:=Trunc(Form1.Width*intMW/intFW);
  ShowMessage('Memoの幅 / Formの幅:'+IntToStr(intMW)+
    ' / '+IntToStr(intFW));
end;

画面を最大化してから、元の大きさに戻した時のようす。

Formの幅は1382ピクセルと表示されている

参考:私のPCは、画面の解像度を1366×768に設定している(Formが表示される際、Screen.Widthを調査すると1366と表示された)。そこで、FormのWidthを1366に設定すると、ClientWidthはそれより小さくなり、設計時に画面の横幅いっぱいに配置したVCLコンポーネントの右側に実行時余白が生まれる。
FormのClientWidthを1366に設定すると、Widthは1382となり、画面の解像度より大きくなるが、VCLコンポーネントの位置は設計時も実行時も同じになった。
この経験から、画面の解像度はClientWidth×ClientHeightを意味するものと、私は理解しているのだが、これでいいのだろうか?

4.まとめ

Formに置いたVCLコンポーネント(例:Memo)の幅を実行時に調整できるようにするには、Splitterを利用する。手順は以下の通り。

(1)MemoコンポーネントのAlignプロパティを alLeft に設定。
(2)Formを選択後、Splitterを設置。
(3)Panelコンポーネントを置いて、Alignプロパティを alClient に設定。

Panelの上に乗せたButtonなどのコンポーネントは、 Anchorsプロパティを適切に設定することでFormのリサイズに合わせて、その表示位置を変更できる。

5.お願いとお断り

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

【関連記事】

How to use Python4Delphi

「PythonForDelphiの使い方(Delphiのプログラム内でPythonを動かす)」

1.Delphiで埋め込みPythonを使う
2.準備
3.ノートPCの電池残量を表示するプログラムを作成
4.PythonEngineのメモリリーク
5.Delphi11のIDEが真っ白になってしまう問題への対応方法
6.著作権表示の記載方法
7.お願いとお断り

こちらで紹介した方法の応用版として、自作のマークシートリーダーの読み取り速度をPython4Delphiで高速化。プログラムのダウンロード(無料)も可能です。もし、よかったら次のリンク先記事もご参照ください。

1.Delphiで埋め込みPythonを使う

ノートPCの電池残量を表示する練習プログラムを、埋め込みPythonを使ってDelphiで書いてみる。
埋め込み用途のembeddable pythonをDelphiで使うには? というテーマで悩んでいらっしゃる方の参考になれば、望外の喜びです。なお、以下の内容はDelphiで開発経験のある方を対象としています。IDEの基本的な操作方法等は省略していますので、予めご了承ください。

2.準備

(1)DelphiにPython4Delphi(P4D)のパッケージを予めインストールしておく。

(2)埋め込み用のEmbeddable Pythonをダウンロードし、各種ライブラリをインストール(下記リンク先ではNumpyとOpenCVライブラリをインストール)。

(3)Embeddable PythonにノートPCの電池残量を表示するため、psutilライブラリをインストール( Embeddable Python のダウンロードと設定方法は上の(2)を参照してください)。

「python -m pip install psutil」と入力してEnterキーを押す

(4)Delphiを起動して「ファイル」→「新規作成」→「Windows VCL アプリケーション」の順にクリックして新しいプロジェクトを準備する。

VCLアプリケーションの新規作成(Delphi11の場合)

3.ノートPCの電池残量を表示するプログラムを作成

(1)プロジェクトに名前を付けて保存する
(2)GUIを作成
(3)コンパイル & Python環境をコピー
(4)Python関連のVCLコンポーネントを配置
(5)Python関連のVCLコンポーネントのプロパティを設定
(6)エラー対応(ライブラリパスの確認)
(7)閉じるボタンのコードを書く
(8)FormのCreateでPython39-32の有無を確認する
(9)Messageダイアログを使う
(10)埋め込みPythonと接続する
(11)OnSetDataイベントを利用する
(12)プログラムの完成と動作確認

(1)プロジェクトに名前を付けて保存する

新しいフォルダを作成(名称は任意:ここではBTRC_byP4Dとしている)し、Unit1.pasを保存(Unit1を別名にしてもよいが、名称をメモしておく)。

参考 BTR:Battery(電池) / C:Charging(充電)/ P4D:PythonForDelphi

つづけて、プロジェクトファイル(Project1.dproj)を同じフォルダに保存。
Project1は別名にしてもよいが、上のpasファイルと同じ名称にしないこと。
また、別名にした場合は、名称を忘れないようにメモしておく。

(2)GUIを作成

画面にVCLコンポーネントを配置してGUIを作る。
Memoを2つ(Memo1とMemo2)、
Buttonを2つ(Button1とButton2)が最低限必要。

パレットのTMemoとTButtonをそれぞれ2つずつ、FormへD&Dする。

DelphiのIDEの基本的な操作方法や、VCLコンポーネントの配置方法は、次のリンク先の解説がわかりやすい。

はじめてのDelphiアプリケーション (VCL Form編) (Delphi プログラミング)

URL:https://www.ipentec.com/document/delphi-first-application-vcl-form-application



※ Formの大きさの変更にMemoの大きさやButtonの表示位置を追随させる方法は、別途解説する予定。

各VCLコンポーネントの名称はデフォルト設定のまま

Button1のCaptionプロパティを「実行」に変更。
Button2のCaptionプロパティを「終了」に変更。

Button1のCaptionプロパティを「実行」に変更。 Button2も同様にして「終了」に変更する。
ボタンのCaptionプロパティを変更

(3)コンパイル & Python環境をコピー

ビルド構成(Debug)のまま、ここで1回コンパイルしてexeを生成。

Ctrl+F9(Ctrlキーを押しながらF9キーを押す)でもOK!
コンパイル成功を確認→OKをクリック

※ ツールバーの実行(F9)をクリックして実行した場合は、生成されたexeが実行されてFormが表示されるので、表示されたFormを右上の閉じるボタンをクリックして閉じる。

ツールバーの実行(F9)から実行する場合
右上の「閉じる」ボタンでFormを閉じる

コンパイルに成功すると、BTRC_byP4Dフォルダの中にWin32フォルダが、さらにその下にDebugフォルダがそれぞれ自動的に作成される。このDebugフォルダを開き、別途作成しておいたEnbeddable Pythonの入ったフォルダをコピーして、貼り付ける(下の例では Enbeddable Pythonの入ったフォルダ名をpython39-32としている)。

Enbeddable Pythonの入ったフォルダを
ここへ貼り付ける。
フォルダとファイルの構造はこうなる。

Embeddable Pythonのダウンロードと各種ライブラリのインストール方法は以下のリンク先を参照してください。

(4)Python関連のVCLコンポーネントを配置

DelphiにPythonのスクリプトを埋め込んで実行するには、PythonForDelphiが必要。
PythonForDelphi(またはPython4Delphi さらに略すと P4D)をDelphiにセットアップする方法は以下のリンク先で解説。

(Python4Delphiのパッケージがインストールされた)Delphiのパレットのいちばん下にPython4Delphiの非ビジュアルコンポーネントがあるので、この中から次の3つのコンポーネント

「PythonEngine、PythonGUIInputOutput、PythonDelphiVar」

をForm上にドラッグ&ドロップ(各非ビジュアルコンポーネントをダブルクリックしてもよい)。

※ 非ビジュアルとは、「実行時に見えなくなる」コンポーネントを意味する。

Python4Delphiの非ビジュアルコンポーネント
非ビジュアルコンポーネントなので画面の任意の位置へD&DすればOK!
非ビジュアルコンポーネントは表示しない設定にすることも出来る(忘れっぽい私は常に表示している)。

(5) Python関連のVCLコンポーネントのプロパティを設定

・PythonEngine1のAutoLoadプロパティをFalseに設定

Form上にパレットからPythonEngineコンポーネントをドラッグ&ドロップすると、名称は自動的に PythonEngine1になる。上の図のようにこれをクリックして選択すると、オブジェクトインスペクタにPythonEngine1のプロパティが表示されるので、その中のAutoLoadプロパティをFalseに変更する(デフォルトTrueに設定されているので、チェックボックスのチェックを外す)。

AutoLoadプロパティをFalseに変更

練習ではなく、本格的にプログラミングする際、私はビジュアルコンポーネントについては、その名称を必ず変更するようにしている。理由はButtonコントールなどは使用数が多く、わかりやすい名前を付けておいた方がプログラミングしやすいからだ。

 例:OKボタンなら、そのNameプロパティを button1→btnOK へ変更

しかし、非ビジュアルコンポーネントの場合は、同じコンポーネントを複数配置することは稀なので、Delphiが自動的に割り振った名前をそのまま利用している。ここでもその例にならって、非ビジュアルコンポーネントの名称は Delphiが自動的に割り振った名前をそのまま利用することにする。

・PythonEngine1のDllNameプロパティは、python39.dllを予め指定(組み込み用のPythonのバージョンに合わせて設定する)。

最新版のPython4Delphiでは「python310.dll」がデフォルト値になっていた。

python39.dllは、上でDebugフォルダ内に張り付けたPython39-32フォルダ内にある。

・PythonEngine1のIOプロパティにはPythonGUIInputOutput1を指定する。

IOプロパティのデフォルト設定は「空欄」になっていた。

・PythonGUIInputOutput1のOutPutプロパティに「Memo2」のように出力先を指定したくなるが、ここでは敢えて何も設定しない。

・PythonDelphiVar1のVarNameプロパティは、プログラムコードの記述に合わせるため「var1」とする。※var1と入力後、Enterで確定すること!(青く反転表示されるのを確認する)

「var1」と入力後、Enterキーを押さないと変更が反映されない。

・この状態で実行(F9)した際に「Python Engineが見つかりません」というようなエラーメッセージが表示される場合は、P4Dのパッケージをインストールした際のライブラリパス設定に誤りがないか、確認する

画面下のメッセージ欄の表示:[dcc32 致命的エラー] Unit1.pas(7): F2613 ユニット ‘PythonEngine’ が見つかりません。
コンパイルエラー発生時のUnit1画面

(6)エラー対応(ライブラリパスの確認)

GitHubから入手したPython4DelphiのフォルダのSourceフォルダ以下にある、このプログラムの動作に必要なファイルへのライブラリパスが正しく設定されていることを確認する。設定されていない場合は、(灰色で表示されている誤ったパスを削除して)ライブラリパスを再設定する。

「ツール」→「オプション」の順にクリックして、次の画面を表示する。

「言語」→「Delphi」→「ライブラリ」とクリックして、赤枠囲みの中をクリック。

ライブラリパスを正しく設定する。

PCを新しくした場合等、再設定する必要があるかもしれないので、
設定内容をメモしておく。

ライブラリパスの設定が完了したら、再度コンパイル(実行:F9)してエラーが発生しないことを確認する。

(右上の閉じるボタンで終了)

参考:コンパイルとビルドの違い

・メニューの「プロジェクト」 →「Project1をコンパイル」
 (ショートカットは「Ctrl+F9」)

前回のビルド以降に変更されたファイルと、それに依存するファイルのみをコンパイルして EXE を生成するが、アプリケーションは起動しない。

・メニューの「プロジェクト」 →「Project1をビルド」
 (ショートカットは「Shift+F9」)

変更の有無に関わらず、全てのユニットを再コンパイルして EXE を生成するが、アプリケーションは起動しない。ユニット数が多ければ当然それだけ遅くなる。

・実行(ショートカットはF9)

変更されたソースコードをすべてコンパイルする。コンパイルが成功した場合は、アプリケーションを実行するので、そのアプリケーションを IDE でテストできるようになる。

・デバッガを使わずに実行。(ショートカットは「Shift+Ctrl+F9」)

変更があったユニットだけをコンパイルしてexeを生成し、 アプリケーションを起動する(exe単体での起動と同じ)。

(7)閉じるボタンのコードを書く

Formの「終了」ボタンをダブルクリックすると画面は次のようになる。ここに終了ボタン(Button2)がクリックされた時のProcedure(手続き)を記述する。

procedure TForm1.Button2Click(Sender: TObject);
begin

end;

beginとend;の間に次のように記入する。

procedure TForm1.Button2Click(Sender: TObject);
begin
  //プログラムの終了
  Close;
end;

//は1行をコメント化(コンパイラはコメント部分を無視する)

Closeは、Formを閉じる命令(正確にはメソッドだから方法?)。アプリケーションのメインフォームを閉じると、そのアプリケーションは終了する。
(ここはApplication.TerminateでもOKだが、 Windowsでは、Application.Terminate でアプリケーションを強制終了させた場合には、OnCloseQueryイベントが実行されない仕様になっているとのこと)。← これは不具合ではなく、Windowsの仕様。

もし、アプリケーション終了時(Windowsの終了やログアウト時も含む)に、何らかの終了処理(中止を含む)を行いたい場合は、OnCloseQueryイベントが実行されるCloseを使用する。(今回は行わないがForm生成時に、例えばTStringListをCreateしてプログラム内で利用するような場合には、CreateしてTry文で使用(~Finally ここで解放 End;)の一般的流れが使えないので、 OnCloseQueryイベントもしくはOnDestroyイベントで、TStringList.Freeのようにして確実に解放しなければならない。)

実行(F9)してFormが表示されたら、「終了」ボタンでアプリケーションを終了できることを確認する。

(8)FormのCreateでPython39-32の有無を確認する

FormがCreateされる時に、Embeddable Python(Python39-32 フォルダ)があることを確認し、必要な諸設定を行う。F12を押すとFormとUnitの表示を交互に切り替えることができる。画面をFormに切り替え、アクティブ(Formのどこかをシングルクリック)にし、オブジェクトインスペクタのイベントタブをクリックして、下にスクロールさせ、OnCreateイベントの右の空白部分をダブルクリックする。自動的にUnit画面に表示が切り替わり、下のようにForm.Create手続き部が生成される。

procedure TForm1.FormCreate(Sender: TObject);
begin

end;

Python39-32フォルダのパスを入れる変数を宣言する。procedureとbeginの間にvar(宣言)を入力して、改行&字下げを行い、文字列型変数AppDataDirを宣言する。必要であればコメントで変数の用途を書いておく。

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

end;

次に、beginとend;の間にForm.Create手続きで行いたい内容を記述する。

begin

  //Embeddable Pythonの存在の有無を調査
  AppDataDir:=ExtractFilePath(Application.ExeName)+'Python39-32';

  if DirectoryExists(AppDataDir) then
  begin
    //フォルダが存在したときの処理
    MessageDlg('Embeddable Pythonが利用可能です。',
      mtInformation, [mbOk] , 0);
    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
    MessageDlg('Embeddable Pythonが見つかりません!',
      mtInformation, [mbOk] , 0);
    PythonEngine1.AutoLoad:=False;
  end;

end;

Ctrl+Sでコードを上書き保存。保存したら実行(F9)。
ここまでの操作にミスがなければ次のメッセージが表示される。

「OK」をクリックして閉じる

続けてFormが表示されるので、終了ボタンをクリックして閉じる。
画面下のメッセージ欄に次のヒントが表示されることを確認する。

(9) Messageダイアログを使う

[dcc32 ヒント] Unit1.pas(118): H2443 インライン関数 ‘MessageDlg’ はユニット ‘System.UITypes’ が USES リストで指定されていないため展開されません

ヒントの言う通り、 ‘System.UITypes’ を USES リストで指定する。以下のように、30行目付近の implementation (実装・実現部)宣言と、その下の コンパイラ指令 {$R *.dfm}の間が空白行になっているので、ここに「uses」と「 System.UITypes ;」を記述。なお、System.UITypes の後ろには行末を意味するセミコロン;を半角で入力する。

implementation

{$R *.dfm}

implementation の下に「uses」と入力してEnter & 字下げ(TABキー)、
で、次の行に「System.UITypes;」を記述。

implementation

uses
  System.UITypes;  // <-入力する

{$R *.dfm}

{$R *.dfm} はコメントではなく、dfmファイルを見つけて 実行ファイルにリンクさせるコンパイラ指令(命令)。「不要なコメントである」と勘違いして、消してはいけない。

以上が入力した状態。上書き保存(Ctrl+S)して、実行(F9)。メッセージにヒントが表示されないことを確認。 表示されたらメッセージ欄を確認。確認後、Formを閉じる。

警告もヒントも表示されない

(10) 埋め込みPythonと接続する

次に、いよいよ埋め込みPythonと接続する。Unitが表示されている場合はF12キーを押してFormの画面に切り替え、左下の「実行」ボタンをダブルクリックする。表示は自動的に以下のように、Button1Click手続きに切り替わる。

procedure TForm1.Button1Click(Sender: TObject);
begin

end;

初めにPythonのスクリプトを入れる文字列型リストと、Pythonから送られたデータを保存する文字列型リストをローカル変数として、以下のように宣言する。

procedure TForm1.Button1Click(Sender: TObject);
var
  //PythonのScriptを入れる
  strScrList:TStringList;
  //Pythonから送られたデータを保存する
  strAnsList:TStringList;
begin

end;

最初に、Memo1を初期化し、データの入れ物をそれぞれ準備する。

begin

  //初期化
  Memo1.Clear;

  //Scriptを入れるStringList
  strScrList:=TStringList.Create;
  //結果を保存するStringList
  strAnsList:=TStringList.Create;

end;

準備したStringListが処理の最後にきちんと解放されるよう、try文を用いて処理する。
tryと入力してEnterキーを押すと、次の画面のようにfinallyとend;が自動入力される。

begin

  //初期化
  Memo1.Clear;

  //Scriptを入れるStringList
  strScrList:=TStringList.Create;
  //結果を保存するStringList
  strAnsList:=TStringList.Create;

  try

  finally

  end;

end;

StringListの解放処理を先に書いてしまう。これで万一、トラブルが発生しても必ずStringListは処理の最後に解放(メモリが空く)される。

  //Scriptを入れるStringList
  strScrList:=TStringList.Create;
  //結果を保存するStringList
  strAnsList:=TStringList.Create;

  try

  finally
    //StringListの解放
    strAnsList.Free;
    strScrList.Free;
  end;

最後に、バッテリー残量を取得するPython Scriptを文字列型リストへ、1行ずつ書き込んで、Memo1に表示、Python側でMemo1に表示されたスクリプトを実行し、返ってきた結果を文字列型リストに読み込んで、Memo2に表示するコードを記述する。

  try
    //バッテリー残量を取得するPython Script
    strScrList.Add('import psutil');
    //バッテリー残量
    strScrList.Add('btr = psutil.sensors_battery()');
    //バッテリー残量を表示
    strScrList.Add('var1.Value = str("残量:") 
      + str(btr.percent) + str("%")');
    //Scriptを表示
    Memo1.Lines.Assign(strScrList);
    //Execute
    PythonEngine1.ExecStrings(Memo1.Lines);
    //結果を表示
    Memo2.Lines.Assign(strAnsList);
  finally
    //StringListの解放
    strAnsList.Free;
    strScrList.Free;
  end;

入力したら上書き保存(Ctrl+S)して、実行(F9)する。Formが表示されたら、Form上の「実行」ボタンをクリックする。結果は次のようになる。

Memo1には、意図した通り、StringListに入れたPythonのScritが表示されているが、
Memo2は空欄のままである。

Object Pascalのコードをよく読むとPythonEngineをExecuteしてPythonに電池残量を計算させるところまではOKだが、Pythonが計算した結果を「Delphi側が受け取れていない」ことがわかる。

    //Execute
    PythonEngine1.ExecStrings(Memo1.Lines);

    { ここでPythonからの結果通知を受け取る必要がある }

    //結果を表示
    Memo2.Lines.Assign(strAnsList);

(11) OnSetDataイベントを利用する

では、Pythonからの結果通知を受け取るにはどうしたらいいかというと、残念ながらその処理はこのprocedure内には書けない。

結論から言うと、Pythonの返した結果は、Formに配置したPythonDelphiVar1コンポーネントのOnSetDataイベントで受け取ることができる。その処理を実現するため、プログラムに必要な変更を加える。

まず、実行ボタンがクリックされた時の手続きの冒頭で、「結果を保存するStringList」として「strAnsList」というローカル変数を宣言したが、今、結果は「PythonDelphiVar1のOnSetDataイベントで受け取る」ことにした=つまり「別の手続きの中で受け取る」ことになるから、この変数をプログラムのあちこちから使える(見える)プライベートメンバー変数(クラス内部でのみ利用可能な変数) に変更することにする。以下、その処理を示す。

まず、 Button1Click手続きでローカル変数として宣言したstrAnsList変数をコメント化する。

procedure TForm1.Button1Click(Sender: TObject);
var
  //PythonのScriptを入れる
  strScrList:TStringList;
  //Pythonから送られたデータを保存する
  //strAnsList:TStringList;  //コメント化してしまう
begin

22行目付近のprivate部に、このクラス内部でのみ利用可能な プライベートメンバー変数として、strAnsList変数を再宣言する。

  private
    { Private 宣言 }
    //Pythonから送られたデータを保存する
    strAnsList:TStringList;
  public
    { Public 宣言 }
  end;

これでstrAnsList変数は、プライベートメンバー(クラス内部でのみ利用)化され、異なる手続きの中でアクセスできるようになった。

続けて、PythonDelphiVar1のOnSetDataイベントの処理を実装する。F12を押して画面をFormの方に切り替えて、PythonDelphiVar1をクリックして選択する。

選択する

画面左下のオブジェクトインスペクタにPythonDelphiVar1が表示されていることを確認して、イベントタブをクリックし、下にスクロールしてOnSetDataイベント部分の右の空白をダブルクリックする。

OnSetDataの右の空白をダブルクリック

PythonDelphiVar1SetData手続きが自動的に生成されるので、次のコードを記述する。

procedure TForm1.PythonDelphiVar1SetData(Sender: TObject; Data: Variant);
begin
  //値がセットされたら文字列リストに値を追加
  strAnsList.Add(Data);
  Application.ProcessMessages;
end;

これでPython側からDelphi側へ、計算結果を渡せるようになった。ここでは単純な処理しかしていないので実質不要であるが、例えばループ処理を行って何度も結果が返るなど、より複雑な計算処理をPython側で行わせる場合に、確実に結果を受け取れるよう、 Application.ProcessMessagesを「おまじない」として入れてある。

Application.ProcessMessages メソッドは、「Windows がイベントに応答できるようアプリケーションの実行を一時的に停止」する命令であるとのこと。このメソッドについては下記リンク先の説明が詳しい。

Article: 待ち関数の必要性

URL:http://gumina.sakura.ne.jp/CREATION/OLD/COLUMN/CD1MATI.htm

(12)プログラムの完成と動作確認

これで、最低限の機能だけは組み込んだノートPCの電池の残容量を表示するプログラムの完成である。上書き保存(Ctrl+S)して、実行(F9)し、結果を確認する。

電池の残量が表示された

4. PythonEngineのメモリリーク

参考 PythonEngineのメモリリークが起きた時は・・・

別のプログラムでPythonEngineがメモリリークを起こしたことがある。この問題について、次のようにFormのOnDestroyイベントでFinalize処理を行うよう対応したところ、メモリリークは解消された。備忘録として記しておく。

procedure TFormZZZ.FormDestroy(Sender: TObject);
begin
  //これでメモリーリークは発生しなくなった
  //PythonDLLによって割り当てられたすべてのメモリが解放される
  //旧バージョンのPythonEngineの場合
  //PythonEngine1.Finalize;
  //最新バージョン(2021年12月現在)のPythonEngineの場合
  PythonEngine1.Py_Finalize;
  PythonDelphiVar1.Finalize;
end;

5. Delphi11のIDEが真っ白になってしまう問題への対応方法

参考リンク Delphi11のIDEが真っ白になってしまう問題への対応方法

RAD Studio 11のプロジェクトファイル(.dproj、.cbproj)をダブルクリックしてIDEを起動し、デバッグ実行すると、IDEの各ウィンドウが白く表示される

URL:上のLinkをクリックしてください。

6.著作権表示の記載方法

参考:Python4DelphiのLicenseについて

GitHubのPython4Delphiのダウンロードページには「The project is licensed under the MIT License.」とある。これは「改変・再配布・商用利用・有料販売すべてが自由かつ無料」であること、及び使用するにあたっての必須条件はPython4Delphiの「著作権を表示すること」と「MITライセンスの全文」or 「 MITライセンス全文へのLink」をソフトウェアに記載する、もしくは、別ファイルとして同梱しなさい・・・ということを意味する。

したがってPython4Delphiを利用したプログラムの配布にあたっては、ソフトウェアの中で、次のような著作権表示を行うか、もしくは P4DフォルダのルートにあるLicenseフォルダをプログラムに同梱して配布すればよいことになる。

Python4Delphiを利用した場合の著作権表示の記載例:

Copyright (c) 2018 Dietmar Budelsky, Morgan Martinet, Kiriakos Vlahos
Released under the MIT license
https://opensource.org/licenses/mit-license.php

7.お願いとお断り

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

【関連記事】

Download Embeddable Python and Install the library

「埋め込み用Pythonのダウンロードとライブラリのインストール方法」

1.始めに
2.Embeddable Python をダウンロード
3.必要なライブラリをインストールする準備
4.Numpyのインストール
5.OpenCVのインストール
6.単体で動作確認(検証)
7.まとめ
8.お願いとお断り

1.始めに

なぜ、Embeddable(埋め込み用)なのかというと、内部的なデータ処理にPythonのOpenCV & Numpyライブラリを使うと、アプリケーションをより一層高速化できることがわかったから。
それから、Python環境のアップデートとは関係なく、安定動作する実行環境を、PCの操作にあまり詳しくないユーザーに提供できるから。

重要

このような特殊な目的ではなく、学習用にPythonを導入したい場合は、埋め込み用途に配布されている Embeddable Python はお勧めできません! 普通にインストーラを使用して、普通のPython環境をPCにセットアップしてください。

もし、PC環境を変更せずに、(持ち運びも可能な)Pythonが実行できる環境を作りたい場合は、WinPythonが便利! WinPythonならUSBメモリやSDカードにセットアップして、PC環境に変更を加えずに利用可能。なお、この場合は・・・

スタートボタン → 設定 → アプリ → アプリと機能 → その他の設定 → アプリ実行エイリアス → アプリ インストーラー(項目のいちばん下)のPythonとPython3をオフ

・・・にしてから、外部メディアにセットアップしたWinPythonを実行。

WinPythonのDL先URL:https://winpython.github.io/

WinPythonを外部メディアに入れて利用する場合

2.Embeddable Python をダウンロード

Embeddable Python は https://www.python.org/downloads/windows/ からダウンロード可能。

上記のサイトに行くと、古い2.X.Xから最新版の3.11.0(テスト用)まで、これまでにリリースされた Embeddable Python すべてがある。どれを選んでよいか、困ってしまう(実際、困った)。だから、使用目的(& 条件)に合わせてダウンロードする Embeddable Python を選択しなければならない。

私の場合、まず Stable Release (安定動作版:様々な動作検証がそれなりに行われたバージョンってこと?)であること。さらに、数値演算用のNumpyライブラリと、コンピュータの眼として利用する画像処理用のOpenCVがインストールできること。最低限、この3つを満たしていればOK!だ。

それから、32 or 64bitバージョンのどちらを選択するか、ちょっと迷ったが、よく考えたら(私が)、Delphi11で設定しているVCLのターゲットプラットフォームは32bitアプリケーション。だから32bitバージョンを選択すべきだと気付く。

ターゲットプラットフォームの設定はWindows32ビット(私の場合)

あとは・・・新しいのか、ちょっと前のか、すごく古いのか、どれを選べばいいんだろー??? 2.X.Xはもう既にサポートがないから、3.X.X なのは絶対だけど。。。3.6.X? 3.7.X? 3.8.X? それとも3.9.X? 最新版は3.10.1があるけどー。

うー。うーー。うーーー。(悩む私)

※ 実はマイナーバージョンごとの違いすらまったくわかってない。

たぶん(根拠無し)、最新版でいいだろー☆(←完全な思い込み)

単純極まりない私は、Stable Release のいちばん上にある

「Win7より前のOSには使えません」・・・って注意書きしかないし、この時点での私はNumpyが3.10.1に非対応(2021年12月現在)だということを、誰も教えてくれないから当然知らない(調べろ!)し、なにより、普通の人(?)は、最新版が取り敢えず良さそうに思えちゃうものじゃないですか。

3.10.1のダウンロード&解凍作業完了! 続いてライブラリのインストール。

コマンドプロンプトを開いて・・・。解凍先フォルダへ行って・・・。ラッタッタッタ。

python -m pip install numpy で、ポチ!

ERROR: Could not build wheels for numpy, which is required to install pyproject.toml-based projects

・・・と、表示され、あっけなく阻止される。なんでー

エラーメッセージの内容をよく読んでみると・・・

setup.py:63: RuntimeWarning: NumPy 1.21.5 may not yet support Python 3.10.

確かに。たいへんよくわかりました。はい。

インストールするライブラリが、どのPythonのマイナーバージョンに対応しているか? なんて、対応状況をあらかじめ調査するなんてこと、まずやるわけない私のようなド素人が(無茶を承知で) Python3.10.1 にNumpyライブラリを強制インストールする凶行に及んでも、ちゃんと阻止してくれるんですね。

できればこういう大事なことは、N○Kの朝と晩の7時の全国放送で毎日しつこくアナウンスするとか、誰もがTopページにしているであろう某サイトのいちばん見やすい場所に広告として日々表示してほしい☆・・・と夜空の星に願いつつ、

「使いたいライブラリがどのバージョンに対応しているか、ダウンロード前にきちんと調べる」という貴重な教訓を得て、ここで初めて検索キーワード「numpy python 対応バージョン」でGoogle先生にお伺いをたてると、以下の情報がヒット!

Python向け科学計算パッケージNumPyの開発チームは、最新版となる「NumPy 1.20.0」を1月30日(現地時間)にリリースした。
「NumPy 1.20.0」はこれまでで最大となるアップデートで、Python 3.7~3.9をサポートし、Python 3.6のサポートは終了している。

1月30日とあるのは2021年のこと。この記事は https://codezine.jp/article/detail/13574 より引用

わかった☆OK これでバージョン3.10.1は除外。とりあえず3.9.Xのどれかにしよう。

もうひとつ、どうしても入れたいのがコンピュータの眼「OpenCV」ライブラリ。そこで、PythonとNumpyとOpenCVの関係について調べてみると・・・

opencv-python 4.5.1.48が最新です。
pythonのバージョンは3.6以上とされていますが、numpyについては特に指定はありません。
pipのバージョンは19.3以上

teratailのPythonに関する質問(https://teratail.com/questions/323063)より引用

わかった☆OK これを近所の3歳児でもわかるように言い換えてみよう。

OpenCVとNumpyは仲がイイ。

ダウンロードするPythonのバージョンは、この情報をもとに 3.9.X の中でいちばん新しい 3.9.9 に決定。

理由は次の通り。

Pythonのバージョンを意味する番号は前から順に、メジャー.マイナー.マイクロのそれぞれを意味するそうで、Pythonのメジャーバージョンは2or3。サポート状況から、これは当然「3」を選択。マイナーバージョンは、これもやはりサポート期限を考えるといちばん長いのは3.9.Xで「2025年10月」までだから、これを根拠に「3.9.X」に決定。で、さらにマイクロバージョンは「バグ修正リリース」に相当し、マイクロバージョン間については、互換性が保証されるとのこと。ならば最もバグが消えているのは「3.9.9」なのかなー。みたいな・・・

Pythonのバージョンによる違いについては、次のサイトの解説が詳しい。

Pythonの複数バージョンの扱い方(Windowsの場合)

URL:https://gammasoft.jp/python/python-version-management/

あらためて気合を入れなおし Embeddable Python3.9.9 のダウンロードを持てる全力を挙げて決行!

(正直 ポチ!するだけだけど)

控えめに言えば、Python3.9.9-32bitのEmbeddable Packageを選択してダウンロード。

3.必要なライブラリをインストールする準備

ダウンロードした Package を任意のフォルダに解凍し、ライブラリのインストールに pip が使えるよう、設定を変更( pythonNN._pthファイルを修正 )する。

デスクトップに新しいフォルダーを作成して、そこにDLしたPackageを保存(Zipファイルの大きさはたったの7.3MB!)。

これを解凍すると、

python-3.9.9-embed-win32ができる(大きさは14.0MBとかなり小さい)

python-3.9.9-embed-win32 フォルダを開き、pythonNN._pthファイルを見つけて修正を加える(NNはPythonのバージョンを示す数字)。その方法は下記の通り。

→ バージョン3.9.9をダウンロードしたから、修正するファイルは python39._pth。見つけたらテキストエディタで開いて、いちばん下の行・・・

このナンバーを削除する→ # import site

を、

import site

と コメント解除 する。(※ 正確には、削除するのは#とその後ろの半角スペース)

【補足】
3.9.10では「#import site」となっており、ナンバー#の後ろには「半角スペースがありません」でした!(20220822追記)

コメント解除したら、上書き保存(Ctrl+S)する。

※ 以前、こんな場面で「上書き保存」ではなく「名前を付けて保存」し、あろうことか、ファイル名が「例:XXXXX._pth.txt」になってしまったコトが・・・

次に、ライブラリのインストールに必要な pip を実行するためのScriptファイル get-pip.py を入手する。get-pip.py は次のリンクからダウンロードできる。ちなみにダウンロードした get-pip.py をテキストエディタで開いたら、内容が知らない言語(もしかして、コレが宇宙語?)で書かれており、驚愕。びっくり。もうあけない。

get-pip.py の入手先はこちら(https://bootstrap.pypa.io/get-pip.py

で、ダウンロードした get-pip.py を python-3.9.9-embed-win32 フォルダへコピー。これで get-pip.py が使えるので、次に説明する方法で、まずpipをインストール。

ここからはコマンドプロンプトで作業する(PowerShellでは、モジュールエラーとなり、実行出来ないようだ:情報のみ、未検証です)。

スタートボタンを右クリック→ファイル名を指定して実行→「cmd」と入力して「OK」をクリック→コマンドプロンプトが起動→「cd」+半角スペースを入力→エクスプローラーから「 python-3.9.9-embed-win32 フォルダ」をドラッグ&ドロップしてEnterキーを押す。

で、画面に表示されている > の後ろに「python get-pip.py」と入力してEnterキーを押す(下図赤のアンダーライン部分)。正しく操作が行われていれば、下の画面のようにpipのダウンロードとインストールが自動的に行われる。

pipをインストール(この時点でフォルダ全体の大きさは29.7MB)

Consider adding this directory to PATH(このディレクトリをPATHに追加することを検討してください)と警告されるが、これは気にしない。Embeddable Python を使う目的そのものが、PATHなんかどこにも通さずに

「好き勝手にPythonを使う」

ことだから。

参考:もし、ここで「’python’ は、内部コマンドまたは外部コマンド、操作可能なプログラムまたはバッチ ファイルとして認識されていません。」というエラーが出る場合は、コマンドプロンプトの現在位置(カレントディレクトリ)をよく確認すること。Python.exeがある(見える)フォルダじゃないと、>python ~ コマンドは使えない。

pipがきちんとインストールされたことを、ここで確認しておく。

python -m pip list と入力してEnter

問題がなければ、インストールされたpip他のバージョンが表示される。
「python -m pip list」で「python.exe: No module named pip」が返る場合は、 pythonNN._pthファイルの修正(# import siteの前にある記号#(ナンバー)とその後ろの半角スペースを削除して import site だけにするコメント化の解除手続き)が正しく行われていない可能性が高い。
また、複数のライブラリのインストールを行うと、 pythonNN._pthファイル が修正前の状態に戻されてしまうこともあるようだ。要確認。

4.Numpyのインストール

続いて「愛しのNumpy」をインストール。

>python -m pip install numpy と入力してEnter!

「生きていてよかった」と思える至福の一瞬がここに。

警告:Consider adding this directory to PATH (このディレクトリをPATHに追加することを検討してください) は、まったく気にしない。Numpyが入ればいいのだ。わはは*(^_^)*♪

5.OpenCVのインストール

さらに、視力0.01かつ老眼&緑内障の恐れありと診断(2万ン千円も払ったのにイタいことばかり言いやがって:チ○ショー!「我が愛と哀しみの人間ドック2021年の記録」より抜粋)された私の眼に代わるSecret Weapon、目にも止まらぬ 走召 高速!でマークシートを読んでくれる機械の眼という意味がほぼない長い前置きを乗り越え、今、怒涛のクライマックス。「OpenCV」ライブラリがいよいよ My PC へ!

サぁイレント ナァイ~ ホぉリィ ナァイ~(さらに意味なし)

>python -m pip install opencv-python と入力してEnter!

注意:「opencv」に続けて「-python」が必要。

念願のOpenCVのインストールについに成功した・・・その日、彼は狂喜乱舞して泣き崩れたという。彼の日記の末尾には「OpenCVよ。永遠なれー」の文字が。

ちなみに、この時点で「Numpy」と「OpenCV」を入れた「python-3.9.9-embed-win32」フォルダの内容は152MB!と他を圧する勢いで巨大化していた。最初は15MB程度しかなかったのに10倍に膨れ上がっている・・・。

なんということか。すでに語るべき言葉を私は持たない。大きな広い美しい心で、この変化をありのままに・・・、そうだ、謙虚に受け止めよう。さぁ深呼吸だ。おぉ空気がうまい。生きてるってことは素晴らしい。

そう言えば、私が書いたDelphiのプログラムをことごとく「ウイルス扱い」して「隔離」しやがる某有名ウイルス対策ソフトも、今日は静かにしてるじゃないか。人間、すべからく、受容することが肝心だ。別にPCの重さがいつの間にか10倍になって、持ち運び困難になったわけではないのだから。

6.単体で動作確認(検証)

作成したEmbeddable Pythonのフォルダ「python-3.9.9-embed-win32」は名前が長く、ちょっと扱いにくいので、フォルダ名をもう少し短く、わかりやすい名前に変更してから、動作検証を行う。

変更前: python-3.9.9-embed-win32 → 変更後:python39-32

フォルダ名の意味:前から順に「Pythonが入っているフォルダで、そのメジャーバージョンは「3」、マイナーバージョンは「9」で、ターゲットプラットフォームは32ビット版だよ」と、全世界のユーザーにやさしくPR(どこかのサイトでこの表記法を見て感動!)。

【動作検証の準備】

上で作成した「python39-32」フォルダと同じ階層に、新しく「psf」という名前のフォルダを作成する。ここにテスト用のScriptファイルや画像データを保存する。

【説明】psf:「P」ythonの「S」criptが入っている「F」older ・・・ という意味。

データ保存用の psf フォルダを作成

【動作検証用の環境変数設定バッチファイルを作成】

最終的にはDelphiから操作する予定のEmbeddable Pythonだが、ここでは動作検証用のバッチファイルを作成し、これを起動してテスト用のScriptを走らせる。

最初に環境変数をセットするバッチファイルを作成する(バッチファイルの作成に関しては、下記参考リンク先:「Windowsでpythonを使う/配布する時に便利!Python embeddable package使い方」に大変詳しい解説があります。作成した方に心から感謝 m(__)m )。

以下の3行をテキストエディタに入力(コピペ)し、文字コードはUTF-8を指定して「setmyenv.bat」という名前を付けて、上の図の「新しいフォルダー」に保存する。

SET DP0=%~dp0
SET PATH=%DP0%\python39-32;%PATH%
SET PYTHON_PATH=%PYTHON_PATH%;%PYTHON_PATH%\Scripts

1行目で、バッチファイルのあるフォルダをカレントディレクトリに指定
2行目で、PATHにEmbeddable Pythonを入れたフォルダへのパスを設定
3行目で、Python.exeとpip.exeへのパスを設定

【動作検証用のスクリプト実行バッチファイルを作成】

続いてScriptを実行するためのバッチファイルを作成する。 以下の5行をテキストエディタに入力(コピペ)し、文字コードはUTF-8を指定して「python_script.bat」という名前を付けて「新しいフォルダー」に保存する。

@echo off
cd /D %~dp0
call setmyenv.bat
cd psf
cmd

1行目は、コマンドプロンプトの画面表示を抑制して見やすくする
2行目は、 バッチファイルのあるフォルダをカレントディレクトリに指定
3行目は、環境変数設定用バッチファイルを内部的に呼び出して実行
4行目で、画面に表示するディレクトリへ移動
5行目は、コマンドプロンプトを表示する

フォルダとファイル構成

【検証用スクリプトを作成】

Embeddable PythonにインストールしたNumpyとOpenCVをインポートして動作する検証用のScriptを作成する。 以下の内容をテキストエディタに入力(コピペ)し、文字コードはUTF-8を指定して「test.py」という名前を付けて「psf」フォルダーに保存する。

import numpy as np
import cv2

img = cv2.imread("test.jpg")
print(type(img))   # Numpy配列に画像データが読み込まれたことを確認
print(img.shape)   # OpenCVが読んだ画像情報(縦横画素数他)を表示

【検証用画像を用意】

任意のJpeg形式の画像を「test.jpg」という名前で「psf」フォルダーに用意する。画像ファイル名に日本語は使えないことに注意する(OpenCVの読み書きコマンドは日本語に対応していないため、日本語が混じっているとエラーになる)。この問題への対応方法は下記参考リンクをご参照ください。

psf フォルダの内容

【検証】

(1)「python_script.bat」 をダブルクリックしてコマンドプロンプトを起動。

コマンドプロンプトを起動したところ

(2)赤で示した下線部に「python test.py」と入力してEnterキーを押す。

黄色の枠内に結果より正しく動作したことがわかる。
<class ‘numpy.ndarray’>:データ形式はNumpyの配列、
(284, 283, 3)は、縦・横の画素数とチャンネル数を示す。

【参考URL】

Windowsでpythonを使う/配布する時に便利!Python embeddable package使い方

URL:https://hituji-ws.com/code/python/python-emb-usage/

Python OpenCV の cv2.imread 及び cv2.imwrite で日本語を含むファイルパスを取り扱う際の問題への対処について

URL:https://qiita.com/SKYS/items/cbde3775e2143cad7455

WindowsでPython3.7の実行環境を手早く作る方法

URL:https://qiita.com/hirohiro77/items/377dfc0a264acb3db222

7.まとめ

(1)使用目的や使用条件、必要なライブラリのインストール上の制約(どのバージョンのPythonに対応しているか)、何bitのアプリケーションに埋め込むのか等、事前に必要事項を十分調査した上でダウンロードするEmbeddable Pythonのバージョンを決める。

(2)ライブラリのインストールは必ず「Python -m」を付ける。→ 付けないとモジュール参照パスの指定等に問題が発生(構成を壊してしまうとの情報あり:参考リンク「WindowsでPython3.7の実行環境を手早く作る方法」を参照)するようだ。

Python -m pip install (ライブラリ名)

(3)必要なライブラリをインストール後、実際にそれらをimportして動くPython Script をEmbeddable Pythonで動かし、確実に動作することを確認する。Delphiに埋め込んでから余計なトラブルに悩まされないよう、ここで必ず単体で動作することを確かめておく。

8.お願いとお断り

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

【関連記事】

Delphi & Embeddable Python

「なぜ Delphi & Embeddable Python なのか?」

自分ひとりで使うにはPythonはとても便利だ。カプセル化してある高機能なライブラリのおかげで、わずか数行Scriptを書くだけで、とんでもない処理が誰にでも簡単に実現できる。

必要な大抵の処理は、自分で書かなくても、どこかの優秀な方が作ったサンプルが、Web上のあちこちで公開されているから、ほとんどすべてそれで間に合ってしまう。だから、Pythonに関する限り、自分で書くというよりは、誰かが書いたものを探している時間の方が多い・・・というのは、私だけではないだろう。

それらを写経して、切ったり、貼ったりして業務をこなす。便利であること、この上ない。ラクをしたその分だけ、プログラミングする楽しさや喜びが失われたような、そんな気がすることもあるが・・・。

ただ、他人様に使っていただくモノについては、これが当てはまらない。

「マニュアルを読まなければ使えないようなプログラムは、ダメなプログラムだ。」・・・という、もはや信念と化した、狂気に近い思い込みが私にはある。

「マニュアルを読まなくても使えるプログラム」

それを実現するのがGUIなのだが、簡単・高速に、そのインターフェイスを作る機能は残念ながらPythonにはない。tkinterやPyQtを試したこともあったけど、Delphiのようにはいかなかった。直感的な操作という点で、どうしてもPythonで使えるGUI環境作成ツールはどれもこれもDelphiのそれに見劣りする(・・・と私は思う)。

唯一、2018年から開発が始まったというPySimpleGUIだけは、ちょっと違ったが。

さらに、実行形式のexeファイルにする作業もPythonだと困ることが多い。以前、業務で使用するプログラムをPythonで書き、exe化したら何と300MBを超える巨大なexeができちゃった・・・ことがある。ちゃんと動いたけど。必要なライブラリを全部!詰め込んだから、おなかいっぱいになっちゃった・・・んだろう。たぶん。

ところで逆に、Delphiで業務で使用するマークシートリーダーを開発した際、Delphiから利用できるOpenCVライブラリを使ったのだが、100枚読み取るのに4~5分を要した。読み取るA4横のマークシートは1枚が「1行あたりマーク数16個×25行×3列」という仕様(これは必須)なので、1枚あたり判定必要数はなんと1200! で、これが100枚あるとすると合計12万!

PCは、マークされている場所だけ読み取る・・・なんてヒト並みの芸当は絶対にできないから、白紙のマークシートであっても地道に1個1個・・・1枚についてきちんと1200回、白・黒の判定を繰り返す(実際の処理は、スキャナーで読み取ったマークシート画像にゴミ取り用のガウシアンぼかしをかけてから、ある閾値で二値化して、白黒反転させ、1行ずつ元画像から切り出して、さらにその画像を1行あたりのマーク数で細かく均等に分割して、1枚について1200個生成される画像1つ1つについて画素が白の部分の面積を計算し、白面積が最も大きい画像をマークありぃ!と判定している)。

私なら、1枚でやめます。・・・ってか、1行分でも多分無理です。

読み取りに「5分」かかったとすると、5分は300秒。12万個のマークを300秒で読むから、1秒あたりの読み取りマーク数は400個。1枚に3列(1200個)あるから1列1秒、1枚3秒で読んでおり、ヒトがそれをやるのに比べれば、これでも十分に高速なのだが・・・。

ところがPythonで同じ処理を書いてみたら、速いのだ。コレが・・・。

1枚250ms以下で読み取ってしまう。処理の流れはどちらも同じ(どちらも書いたのは私)だから、Python環境での処理速度は、Delphi環境のそれの12倍も速いことになる・・・。100枚を30秒未満で処理できる実力。これをどうにかして生かしたい。

そんな時、Embeddable Python というモノが存在することを、私は知ってしまったのだ。

Python Embeddableとは、超軽量なPythonの実行環境でファイルサイズがとても小さく、Windowsのシステムを汚さずに環境構築ができ、配布するのも簡単という特徴があります。

Webエンジニアの仕事見聞録(https://engineer-milione.com/programming/python-embeddable.html)より引用

Delphiで創ったコレが・・・

拙作Delphi製マークシートリーダー(テスト用サンプルを読み込んだところ)
拙作マークシートリーダーは上記リンク先ページからダウンロードできます。

PythonのOpenCVという視力を得たなら・・・どういうコトになるか?と思うと・・・

年甲斐もなく、ドキドキしてくるじゃありませんか! 皆さん

まとめ

(1)DelphiはGUI環境を簡単・高速に作成できる。

(2)Pythonには強力無比の数値演算ライブラリがある。

(3)DelphiでGUIを作成し、内部的な演算処理はPythonで実行。

(4)それを可能にするのがEmbeddable Python

(5)誰が言ったか知らんけど、

為せば成る!

俺はやるぞ!

お願いとお断り

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

【関連記事】

Setup Old Python4Delphi

「Delphiで古いPythonForDelphiを使う(おすすめしません)」

OpenCVとNumpyをインストールしたembeddable pythonをDelphiから利用できるようにした。これはその覚書その2。タイトルにあるように古いPython4Delphiをセットアップした時の記録。

1.どなたにもおすすめしません(最新版が便利です)
2.旧バージョンのインストール方法
3.まとめ
4.著作権表示の記載方法
5.お願いとお断り

1.どなたにもおすすめしません(最新版が便利です)

今はどこを探しても、この古いPython4Delphiはダウンロードできないが、もし、それが入手できて、使わなければならなくなった時には参考になる(カモ)。

ちなみに、ずっと愛用していた(10年以上前のバージョン?の)Python4Delphiは最新のDelphi11に、ここに記載した方法でほぼ問題なくインストールでき、かつ、期待通りに(VCLコンポーネントとして)動作した。←が、どなたにもおすすめしません。

最新のPython4DelphiをDelphi10.3以降のバージョンにインストールする方法は・・・

2.旧バージョンのインストール方法

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

まず、困ったことに、ここで取り上げているPython4Delphiのバージョンがいくつなのか、どれくらい前にリリースされたものなのか、いつ、どこから入手したものなのか、いずれもわからない。

気が付いた時には、My PCの中にいた・・・。そんな存在である。

python4delphi-master\PythonForDelphiにあるDeployment.txtには、See document “Deploying P4D.PDF” first.・・・とあるので、これを読むとドキュメントの日付は「5/1/2005」となっている。もしかしたら、それくらい前のものかもしれない。

fmxには非対応のようで、vcl関連のファイルのみで構成されている。Readme.txtで紹介されているファイルとフォルダの構成は以下の通り。

FILES:
Readme.txt This file.
Python.txt Infos about Python, and further references.
Changes.txt List of all changes since the first release.
Tutorial.txt A simple tutorial to use the PythonEngine
To do.txt A to do list.
Deploying P4D.pdf Notes on the Deployment of your applications using Python for Delphi.
C++ Builder Notes.txt Notes on using C++Builder with the Python for Delphi components.
PythonAtom.hlp A help file explaining the use of TPythonAtom
Demos A folder containing several demos of Python for Delphi.
Components\Python.* The “Python for Delphi” packages.
Components\Sources\Core The source folder of the core “Python for Delphi”.
Lib Library of Python modules.
PythonIDE A Python developpment environment written in Delphi.
See PythonIDE\Readme.txt for the required components.
Modules Contains the Delphi\Delphi.dpr project that creates the Modules\Delphi.pyd Python module
that allows you to interact with Delphi VCL objects from Python.

同じく Readme.txt にあるインストール方法は、次の通り。この手順でDelphi10.4にインストール。

INSTALLATION:
install the Python for Windows distribution (http://www.python.org/).

1) Install the core components
For recent versions of Delphi, install the “Python_d” package located in the
Components folder and add the folder “…\Components\Sources\Core” to the library path.

1) コアコンポーネントのインストール

Components フォルダにある “Python_d” パッケージをインストールし、ライブラリパスに “…\Components\Sources\Core” フォルダを追加してください。

注意:異なるバージョンのDelphiがインストールされている環境では、Python_D.dpkをダブルクリックすると拡張子dpkに関連付けされたバージョンのDelphiが起動してしまう(あたりまえ)。このような場合は、P4D環境をインストールしたいDelphiを起動し、ファイルメニューの「開く」からPython_D.dpkを指定してパッケージをインストールする。

また、「開く」のは「Python_D.dpk」で、「Python_D.dproj」ではないことにも注意する。で、「Python_D.dpk」を開いたら・・・

プロジェクトマネージャーに表示されたPython_D.bplを右クリックして、表示されたサブメニューの「インストール」をクリック。

【Delphi10.4の場合】

この方法でエラーなくインストールできた。(・・・気がするだけかもしれない)

【Delphi11の場合】

次のエラーが発生!

[dcc32 エラー] PythonEngine.pas(63): E2029 ‘INTERFACE’ が必要な場所に 識別子 ‘Error’ があります。

エラーが起きている場所を確認すると・・・

unit PythonEngine;

{ TODO -oMMM : implement tp_as_buffer slot }
{ TODO -oMMM : implement Attribute descriptor and subclassing stuff }

{$IFNDEF FPC}
{$IFNDEF DELPHI2010_OR_HIGHER}
  Error! Delphi 2010 or higher is required! ←ここでエラーが発生!
{$ENDIF}
{$ENDIF}

とりあえず、この1行をコメント化して再実行。

{$IFNDEF FPC}
{$IFNDEF DELPHI2010_OR_HIGHER}
  //Error! Delphi 2010 or higher is required!
{$ENDIF}
{$ENDIF}

エラーは発生せず。表示されたメッセージを読み、インストールの成功を確認。

もう一度Python_D.bplを右クリックして、表示されたサブメニューの「上書き保存」をクリック。これでパッケージのインストールは完了。

「ライブラリパスに “…\Components\Sources\Core” フォルダを追加・・・」とあるが、パスを追加しなくてもプログラムの動作に必要な.pasファイルをプロジェクトファイルのあるフォルダにコピーすれば動くから、ここでは「追加しない」ことを選択。

重要 特別な理由のない限り、最新版のPython4Delphiを選択することをお勧めします。
(最新版のP4Dパッケージを登録する場合は、ライブラリパスをきちんと設定しましょう)

2) Install the VCL components (this is optional)

For recent versions of Delphi, install the “PythonVCL_d” package located in the Components folder and add the folder “…\Components\Sources\Core” to the library path.

2) this is optional ・・・とあるので、オプションならやらなくてもいいか!ということで実行しない。

3) Build Modules\Delphi\Delphi.dpr (This is optional and unsupported)

Once the project is build you can either extend the Python path with ..\Modules or copy ..Modules\Delphi.pyd to C:\Python24\DLLs, to be able to import the Delphi module from Python.

Note that you can try this module by invoking the ..\Modules\TestApp.py script.

3) This is optional and unsupported ・・・とあり、オプションである上にサポートなしとあるので、これも実行しない。

3.まとめ

(1) Readme.txt の INSTALLATION の手順1)のみ実行すればOKだった。

(2)DelphiのXXX.dprojファイルのあるフォルダへコピーするPython関係のファイルは以下の通り。他のプロジェクトでも利用する場合は、ライブラリパスへ登録した方が使いやすくなるが、このP4Dは最新版ではないので、このようにして利用した(←過去形であることに注意)。

動作に必要なファイル

4. 著作権表示の記載例

参考:Python4DelphiのLicenseについて

GitHubのPython4Delphiのダウンロードページには「The project is licensed under the MIT License.」とある。これは「改変・再配布・商用利用・有料販売すべてが自由かつ無料」であること、及び使用するにあたっての必須条件はPython4Delphiの「著作権を表示すること」と「MITライセンスの全文」or 「 MITライセンス全文へのLink」をソフトウェアに記載する、もしくは、別ファイルとして同梱しなさい・・・ということを意味する。

したがってPython4Delphiを利用したプログラムの配布にあたっては、ソフトウェアの中で、次のような著作権表示を行うか、もしくは P4DフォルダのルートにあるLicenseフォルダをプログラムに同梱して配布すればよいことになる。

Python4Delphiを利用した場合の著作権表示の記載例:

Copyright (c) 2018 Dietmar Budelsky, Morgan Martinet, Kiriakos Vlahos
Released under the MIT license
https://opensource.org/licenses/mit-license.php

5.お願いとお断り

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

【関連記事】