LazarusでFindWindowが常に0を返してしまう件について


km  2020-06-21 15:28:13  No: 148839

 先日は大変お世話になりました。引き続き、もう1件ご相談させてください。
 表記のとおり、FindWindowという関数で目当てのWindowハンドルを意図どおり
に取得せず、悩んでおります。(Class名をきちんと指定しても0が返って来てしまう)
 いろいろと検索してみると、「効かない」と書いている方もおり、同じように悩んで
いる方もいらっしゃったようです。もし解決している方がいらっしゃましたら、
お知恵をお貸しいただけないでしょうか。なにとぞよろしくお願いいたします。

↓以下は、新規プロジェクトで試したソースです。Windowのタイトルは場面によって
 変える想定なので、Class名でWIndow ハンドルを取得したいと思っています。

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, Windows;
var
  Form1: TForm1;

procedure TForm1.Button1Click(Sender: TObject);
var
  H: HWND;
begin
  H := FindWindow(nil, 'Form1');
  ShowMessage(IntToStr(H));      // 正常

  H := FindWindow('TForm1', nil);
  ShowMessage(IntToStr(H));      // なぜか0

  H := FindWindowW(nil, 'Form1');
  ShowMessage(IntToStr(H));      // 正常

  H := FindWindowW('TForm1', nil);
  ShowMessage(IntToStr(H));      // なぜか0
end;


km  2020-06-21 15:43:17  No: 148840

環境はWindows10 Home 64bitで、Lazarusは2.0.8を使用しています。
検索してみると、以下のような定義がなされていましたが、単に外部から
関数を読みだして名前を付けているだけのようで、動作の様子はよく
わかりませんでした。

function FindWindow(lpClassName:LPCSTR; lpWindowName:LPCSTR):HWND; external 'user32' name 'FindWindowA';


Mr.XRAY  2020-06-22 08:07:15  No: 148841

EXE を作成したら IDE を閉じてから,EXE を起動してテストしてみてください.
sLineBreak は #13#10 です.Lazarus になければ置き換えてください.
       
procedure TForm1.Button1Click(Sender: TObject);
var
  H : HWND;
begin  
  H := FindWindow('Window', nil);
  if H <> 0 then begin   
    ShowMessage(IntToStr(H) + sLineBreak + IntToStr(Form1.Handle));
    PostMessage(H, WM_CLOSE, 0, 0);
  end;
end;

Delphi のフォームのクラス名は内部的に使用されるものですが,
デフォルトではこのクラス名がフォームのウィンドウのクラス名として使われます.
このウィンドウのクラス名は CreateParams メソッドを使用して変更できます.

procedure TForm1.CreateParams(var Params: TCreateParams);
begin
  inherited;
  Params.WinClassName := 'TMyMainFormClass';
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  LhWnd : HWND;
begin
  LhWnd := FindWindow('TMyMainFormClass', nil);
  if LhWnd <> 0 then begin
    PostMessage(LhWnd, WM_CLOSE, 0, 0);
  end; 
end;


km  2020-06-22 12:24:33  No: 148845

Mr.XRAY様、早々のご回答、誠にありがとうございます。
今回の件はあまりにも基本的な部分で直し方が思いつかず、他のAPIや回避策がないか、この土日はずっと検索し続けておりました。
今日、家に帰りましたら早速試してみたいと思います。毎日少しずつ前に進んでいて、本当に嬉しく思います。深く感謝いたします。


おかぽん  2020-06-22 15:52:31  No: 148846

フォームに TMemoとTButton 貼りつけて、イカの(結構手抜き)コードで、Windowを列挙すると・・・
「Window/Form1」と取得できる行があります。
ですので、Delphiのように、クラス名で検索することはできないようですね。

var
  memo:TMemo;

function EnumWindowsProc(hWindow: HWND; lParam: LPARAM):WINBOOL; stdcall;
var
  WinClass,
  WinText  :array[0..255]of char;
  newText  :String;
begin
  Result:= True;
  GetClassName(hWindow, WinClass, 256);
  GetWindowText(hWindow, WinText, 256);

  newText := PChar(@WinClass[0]);
  if CompareText(newText, 'IME') <> 0 then begin  //'IME'が邪魔だったのでスキップ
    newText := newText + '/' + PChar(@WinText[0]);
    memo.Lines.Add(newText);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Memo1.Lines.Clear;
  memo := Memo1;
  EnumWindows(@EnumWindowsProc, 0);
end;

また、Mr.XRAYさんのレスにある CreateParams を使う方法を試すと・・・
相変わらず「Window/Form1」で取得できてしまうという。
ですので、Lazarusは、固有のクラス名としては利用していないのかもしれませんね。

なお、前回は記述していませんでしたが、テスト環境は、Windows 2000 SP4(Virtual BOX) + Lazarusは2.0.8 です。
一応報告まで。


km  2020-06-22 20:13:40  No: 148847

 Mr.XRAY様、おかぽん様、ご返事ありがとうございます。
 早速帰宅したのでテストしてみました。…結果は、おかぽんさまの
おっしゃるとおりでした。Mr.XRAY様の手法だと、クラス名を明示的に
変更することになるので、きっとうまくいくはずだと思っていたので、
本当に予想外でした。

おかぽん様に使用例をお示しいただいたEnumWindowsは、先ほど検索
しているときにも見かけ、いざとなればこれですべて列挙してクラス名が
一致するものを抜き出してみよう、ともくろんでいたのですが、まさか
これもダメとは思いませんでした。

 なかなか難しいところですが、いただいた関数をいじってみて試行錯誤
したり、ほかの可能性のありそうなAPIやルーチン、ライブラリなども、
改めて探してみようと思います。


Mr.XRAY  2020-06-23 13:44:40  No: 148850

Lazarus を持っていない私が書くのも何てすが.
Lazarus では,Delphi と対比してみると,

  Lazarus では,フォームのウィンドウのクラス名は常に Window
  Delphi ではフォームのクラス名がウィンドウのクラス名
  Delphi ではウィンドウのクラス名を変更できる

  FindWindow 関数の第 1 引数はウィンドウのクラス名  
  したがって,FindWindow('TForm1', nil) ではフォームのハンドルは取得できない
  何故なら,Lazarus では TForm1 というクラス名のウィンドウは生成されないから 
    
同じアプリ内のフォームを検索するのに FindWindow を使う必要はないので, 
問題は,起動している Lazarus で作成したアプリを検出しなければならない時です.
ちょっと調べた限りでは,Lazarus のフォームのウィンドウのクラス名を
変更する方法はないようです.    

Lazarus で作成したアプリが 1 つしか起動していない時は簡単です.
クラス名が Window のウィンドウを探せばすみます.


Mr.XRAY  2020-06-23 14:01:34  No: 148851

>  したがって,FindWindow('TForm1', nil) ではフォームのハンドルは取得できない

失礼しました.
Delphi で作成したアプリが起動していたら検出されることがありますね.


km  2020-06-23 22:47:23  No: 148853

Mr.XRAY様、重ねてのコメント、ありがとうございます。今、業務から期間中です。
解決方法ではないのですが、現在、この関数を直ちに使いたい場面は、二重起動を防止したとき、起動中のウィンドウにメッセージを送信するというものです。
この場合、例えば実行ファイルのフルパスが分かっていますので、そこからスレッドIDやウィンドウハンドルを把握できないか、などといった、少しトリッキーな対応案を考えています。(検索したての、うろ覚えの情報を元に書いておりますので、もしかしたらできないかも知れませんが…)
ここまで使いやすい環境なので、こういうところでうまく動かせないというのは本当にもったいないことですが、それを補ってなお、魅力ある開発環境だと思うので、もう少し粘ってみたいと思います。

※本件については、引き続き検討したく、もし情報をお持ちの方はご教示くださればありがたく存じます。


Mr.XRAY  2020-06-26 06:44:52  No: 148859

おかぽんさんが,
 
> また、Mr.XRAYさんのレスにある CreateParams を使う方法を試すと・・・
> 相変わらず「Window/Form1」で取得できてしまうという。 

と書いているので調べました.その結果,Lazarus では
フォームのウィンドウのクラス名が変更できないようであると書きました.
Lazarus をインストールして再度調べて記事にしてみました.

[ Lazarus のフォームのウィントウのクラス名設定 ]
file:///D:/MyWWW/home/Delphi/Others/Lazarus_WindowClassName.htm

Lazarus でも FindWindow('TForm1', nil) を使用して,
フォームのウィンドウハンドルが取得できるようになりました.


Mr.XRAY  2020-06-26 06:48:11  No: 148860

file:///D:/MyWWW/home/Delphi/Others/Lazarus_WindowClassName.htm

失礼しました.ローカルファイルを指定してどうすんだ !!
http://mrxray.on.coocan.jp/Delphi/Others/Lazarus_WindowClassName.htm


km  2020-06-26 20:22:18  No: 148865

Mr.XRAY様、非常にご多忙なところ、わざわざホームページにてソースコードまでご提示、検証くださり、本当に頭の下がる思いです。深く感謝いたします。本当にありがとうございます。

実は昨日も別の部分で、Delphiと同様に書いて、コンパイルは通るが動かない、という現象に行き当たっており、Delphiに戻りたくなってきたところでしたが、こうやって一緒に考えてくださって、本当に勇気づけられました。帰った後、改めて検証してみたいと思います。

ついでで恐縮ですが、1点、情報共有をさせていただきます。私はもともと、二重起動を防止した際、先に動いているインスタンスのウィンドウにコマンドラインパラメータを送信したい、という処理の一部でこの関数を使いたいと思っていました。
しかし、その後も調べてみると、Lazarusにはuniqueinstanceというコンポーネントがあり、これを貼ってenabledを有効にするだけで二重起動を防止し、さらにUniqueInstanceOnOtherInstanceというイベントで、追随するインスタンスが終了する間際、そのコマンドラインパラメータを受信できるものになっています。
複雑なことを考えず、単純に二重起動を防止するためだけなら、このような手法も使えるようでした。
(もちろん、findwindowを使用した時ほどの汎用性はありません。ただ、このコンポーネントのなかで使っている通信方法は、IPCServer?などと、あまりみたことのないものでした。やっている処理はまだ理解していませんが、汎用性がありそうな通信方法なら学んでみたいです。)


Mr.XRAY  2020-06-29 08:29:28  No: 148869

突然思い出しました.
おかぽんが提示された EnumWindows のコールバック関数内のコードですが,
Lazarus は UTF-8 です.
日本語があると文字化けしますから,以下のようにした方がいいですね.
細かくてスミマセン. 

    memo.Lines.Add(newText);
       ↓ 変更
    // uses に LazUTF8 が必要
    memo.Lines.Add(WinCPToUTF8(newText));


※返信する前に利用規約をご確認ください。








  このエントリーをはてなブックマークに追加