自作アプリのラベルのCaption等を取得するには？

解決

ahsan 2009-03-16 03:58:37 No: 33659

自作アプリの上にマウスカーソルを重ねると、
その場所のLabel等のコンポーネントのCaptionを
取得できるような、別のアプリを作成したいのです。
その別のアプリのソースが以下ですが、
"Ｘ"のコメントの所で、AccessViolationエラーが
発生してしまいます。HWND型の変数：actHndlを
TForm型で扱う方法がわかりません。教えて下さい。

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    Label1: TLabel;
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormShow(Sender: TObject);
begin
Timer1.Interval:=200;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Timer1.Interval:=0;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  actHndl    : HWND;
  actR      : TRect;
  cp        : TPoint;
  i          : integer;
  c          : array[0..255] of char;
  x1,y1      : integer;
  x2,y2      : integer;
begin
  actHndl:=GetForeGroundWindow;
  if actHndl <> 0 then begin
    if actHndl <> Self.Handle then begin
      Timer1.Interval:=0;
      GetClassName(actHndl,c,SizeOf(c));
      if c = 'TFormMain' then begin
        GetCursorPos(cp);
        GetWindowRect(actHndl,actR);
        for i:=0 to TForm(actHndl).ComponentCount-1 do begin//Ｘ
          if TForm(actHndl).Components[i] is TLabel then begin
            with TForm(actHndl).Components[i] as TLabel do begin
              x1:=actR.Left+Left;//x1,y1,x2,y2=TLabelの範囲
              y1:=actR.Top+Top;
              x2:=x1+Width;
              y2:=y1+Height;
              if (y1 <= cp.Y) and (cp.Y <=y2) then begin//カーソルがTLabel範囲内
                if (x1 <= cp.X) and (cp.X <= x2) then begin
                  Label1.Caption:=Caption;
                  break;
                end;
              end;
            end;
          end;
        end;
      end;
      Timer1.Interval:=200;
    end;
  end;
end;

end.

ofZ 2009-03-17 01:06:19 No: 33660

GetForeGroundWindow は、Form1.Handle で取得するハンドルと同じ。
TFormのインスタンスではない。

また、他アプリのForm1のアドレス（ポインタ）が取得できたとしても、
メモリ空間が違うので、キャストして使用することはできません。

どちらも自作アプリであるなら、共有メモリを使うとか、メッセージの
やりとりをするとかしか思いつきませんねぇ。

ofZ 2009-03-17 17:52:21 No: 33661

メッセージを使った例
------------------------------
【共有ユニット】
unit ShareUnit;

interface

uses
Windows, Messages;

const
  //マウスカーソル位置のラベルキャプションを
  //送信するよう依頼するメッセージ
  WM_GET_LABEL_CAPTION=WM_APP + 1;

//WM_COPYDATA の識別用
GET_LABEL_CAPTION_DATA= 20090315; //適当な値

//Captionの最大サイズ
MAX_CAPTION_SIZE=128;

type
  TLabelCaptionRec= packed record
    dsCaption: array[0..MAX_CAPTION_SIZE-1] of Char;
  end;

  TMyData= packed Record
    Msg: Cardinal;
    SenderHandle: HWND;
    Reserved: LongInt;
    Result: Longint;
  end;
------------------------------
【監視側】
  TFormA = class(TForm)
    procedure Timer1Timer(Sender: TObject);
  private
    //WM_COPYDATA
    procedure WMCopyData(var aMessage:TWMCopyData);message WM_COPYDATA;
  public
  end;

implementation

uses
ShareUnit;

procedure TFormA.Timer1Timer(Sender: TObject);
var
  activeHandle: HWND;
begin
  activeHandle := GetForegroundWindow;
  if (activeHandle > 0) and (activeHandle <> Handle) then begin
    SendMessage(activeHandle, WM_GET_LABEL_CAPTION, Self.Handle, 0);
  end;
end;

//WM_COPYDATA
procedure TFormA.WMCopyData(var aMessage:TWMCopyData);
var
  pLabelCaptionRec:^TLabelCaptionRec;
  pCaption: PChar;
begin
  if aMessage.CopyDataStruct^.dwData = GET_LABEL_CAPTION_DATA then begin
    pLabelCaptionRec := aMessage.CopyDataStruct^.lpData;
    pCaption := @pLabelCaptionRec^.dsCaption;
    Label1.Caption := pCaption;
  end;
end;

------------------------------
【別アプリ側】
  TFormB = class(TForm)
  private
    //WM_COPYDATA
    procedure GetLabelCaptionData(var aMyData: TMyData); message WM_GET_LABEL_CAPTION;
  end;

implementation

procedure TFormB.GetLabelCaptionData(var aMyData: TMyData);
var
  mp: TPoint;
  ctrl: TControl;
  copyDataStruct: TCopyDataStruct;
  labelCaptionRec: TLabelCaptionRec;
begin
  //マウスカーソルの座標
  GetCursorPos(mp);
  //フォーム上のカーソル位置
  mp := ScreenToClient(mp);
  //Control取得
  ctrl := ControlAtPos(mp, False);
  //送信準備
  copyDataStruct.dwData := GET_LABEL_CAPTION_DATA;
  copyDataStruct.cbData := SizeOf(TLabelCaptionRec);
  copyDataStruct.lpData := @labelCaptionRec;
  //Caption編集
  if (ctrl <> nil) and (ctrl is TLabel) then
    StrPLCopy(labelCaptionRec.dsCaption, TLabel(ctrl).Caption, MAX_CAPTION_SIZE)
  else
    StrPLCopy(labelCaptionRec.dsCaption, '×', MAX_CAPTION_SIZE);

//送信
SendMessage(aMyData.SenderHandle, WM_COPYDATA, Handle, Integer(@copyDataStruct));
end;

ahsan 2009-03-17 22:11:31 No: 33662

根本的に理解できていなかったようです。
メッセージを使った例を実際に動作させてみました所、
理解できました。
ありがとうございました。