[Webinar] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 242
  • Last Modified:

Only to improve a function

Hello guys, I have this function and I would also like to get the name of my windows.

like: form1 , form2

procedure TForm1.Timer1Timer(Sender: TObject);
var
  pt : TPoint;
  wnd : cardinal;
  txt1 : array [0..255] of char;
  txt2 : array [0..255] of char;
begin
// if you use 'controls' unit, then you may use Mouse.CursorPos instead of variable 'pt'
// in that case GetCursorPos() is not necessary
GetCursorPos(pt);
wnd := WindowFromPoint(pt);
GetClassName(wnd, @txt1[0], sizeof(txt1));
GetWindowText(wnd, @txt2[0], sizeof(txt2));
if txt2 = '' then begin // sometimes wm_gettext works when GetWindowText() does not work
  SendMessage(wnd, wm_gettext, sizeof(txt2), integer(@txt2[0]));
end;
label1.Caption := format('handle: %.8x'#13#10'class: %s'#13#10'text: %s', [wnd, txt1, txt2]);
end;
0
hidrau
Asked:
hidrau
  • 15
  • 11
  • 4
2 Solutions
 
mikelittlewoodCommented:
When I do this with a new application and I hold the mouse over the main form area (not over a component) I get the result you are expecting.
0
 
hidrauAuthor Commented:
I know, but my form is a skin and it doesn't give me the name of my form, you see.

It gives me the component name that is all on the form
0
 
TNameCommented:
Try this:

procedure TForm1.Timer1Timer(Sender: TObject);
var
  pt : TPoint;
  wnd : cardinal;
  txt1 : array [0..255] of char;
  txt2 : array [0..255] of char;
begin
GetCursorPos(pt);
wnd := WindowFromPoint(pt);
if wnd<>0 then begin
  GetClassName(wnd, @txt1[0], sizeof(txt1));
  if txt1<>'TForm' then begin     //if the found window isn't a TForm, let's look for it's parent
     wnd:=GetParent(wnd);
     GetClassName(wnd, @txt1[0], sizeof(txt1));
  end;
  GetWindowText(wnd, @txt2[0], sizeof(txt2));
  if txt2 = '' then begin // sometimes wm_gettext works when GetWindowText() does not work
    SendMessage(wnd, wm_gettext, sizeof(txt2), integer(@txt2[0]));
  end;
  label1.Caption := format('handle: %.8x'#13#10'class: %s'#13#10'text: %s', [wnd, txt1, txt2]);
  end;
end;
0
Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

 
TNameCommented:
Correction, should be
if txt1<>'TForm1' then begin  //or whatever the expected class name (of the form) is.

Or better try (to get through several layers if necessary):

procedure TForm1.Timer1Timer(Sender: TObject);
var
  pt : TPoint;
  i:Integer;
  wnd, backup : cardinal;
  txt1 : array [0..255] of char;
  txt2 : array [0..255] of char;
begin
  GetCursorPos(pt);
  i:=0;
  backup:=0;
  wnd := WindowFromPoint(pt);
  if wnd<>0 then begin
    backup:=wnd;
    GetClassName(wnd, @txt1[0], sizeof(txt1));
    while txt1<>'TForm1' do begin
      wnd:=GetParent(wnd);
      GetClassName(wnd, @txt1[0], sizeof(txt1));
      if i>100 then
        break;
      inc(i);
    end;
    if wnd=0 then begin
       wnd:=backup;
       GetClassName(wnd, @txt1[0], sizeof(txt1));
    end;
    GetWindowText(wnd, @txt2[0], sizeof(txt2));
    if txt2 = '' then begin // sometimes wm_gettext works when GetWindowText() does not work
      SendMessage(wnd, wm_gettext, sizeof(txt2), integer(@txt2[0]));
    end;
    label1.Caption := format('handle: %.8x'#13#10'class: %s'#13#10'text: %s', [wnd, txt1, txt2]);
  end;
end;
0
 
TNameCommented:
Or even better try (a more generic solution, that doesn't rely on the class name):


procedure TForm1.Timer1Timer(Sender: TObject);
var
  pt : TPoint;
  i:Integer;
  wnd, parentWnd, backup : cardinal;
  txt1 : array [0..255] of char;
  txt2 : array [0..255] of char;
begin
  GetCursorPos(pt);
  i:=0;
  backup:=0;
  wnd := WindowFromPoint(pt);

  if wnd<>0 then begin
    backup:=wnd;
    parentWnd:=GetParent(wnd);
    while parentWnd<>0 do begin
      wnd:=GetParent(wnd);
      parentWnd:=GetParent(wnd);
      if i>1000 then
        break;
      inc(i);
    end;
    if wnd=0 then begin
       wnd:=backup;
    end;
    GetClassName(wnd, @txt1[0], sizeof(txt1));
    GetWindowText(wnd, @txt2[0], sizeof(txt2));
    if txt2 = '' then begin
      SendMessage(wnd, wm_gettext, sizeof(txt2), integer(@txt2[0]));
    end;
    label1.Caption :=format('handle: %.8x'#13#10'class: %s'#13#10'text: %s', [wnd, txt1, txt2]);
  end;
end;
0
 
hidrauAuthor Commented:
ok Tname, I am gonna test it.
0
 
TNameCommented:
There are two built in safeguards (backup and brake if i>x) that are probably not needed (at least not both and especially backup). You could try a simplified version (it also shows the level of parentage):

procedure TForm1.Timer1Timer(Sender: TObject);
var
  pt : TPoint;
  wnd, parentWnd : cardinal;
  txt1 : array [0..255] of char;
  txt2 : array [0..255] of char;
  level:Integer;
begin
  level:=0;
  GetCursorPos(pt);
  wnd := WindowFromPoint(pt);
  if wnd<>0 then begin
    parentWnd:=GetParent(wnd);
    while parentWnd<>0 do begin
      wnd:=GetParent(wnd);
      parentWnd:=GetParent(wnd);
      inc(level);
    end;
    GetClassName(wnd, @txt1[0], sizeof(txt1));
    GetWindowText(wnd, @txt2[0], sizeof(txt2));
    if txt2 = '' then begin
      SendMessage(wnd, wm_gettext, sizeof(txt2), integer(@txt2[0]));
    end;
    Label1.Caption:='Level: '+IntToStr(level)+#13#10; //Just to test the level depth
    Label1.Caption:=Label1.Caption+format('handle: %.8x'#13#10'class: %s'#13#10'text: %s', [wnd, txt1, txt2]);
  end;
end;
0
 
hidrauAuthor Commented:
I tested the last version and I got the name only of my form,

I need to get this information:

Component name : Tbutton
Form where the component is present : form2

This is only to work on my system, I need to map my system in run time, for this reason, I need this.

You see,
0
 
TNameCommented:
>brake
I meant break of course :)
0
 
hidrauAuthor Commented:
Sorry, I didn't understand

0
 
TNameCommented:
Sorry, I just meant a typo in one of my previous posts

>I need to get this information:

>Component name : Tbutton
>Form where the component is present : form2

procedure TForm1.Timer1Timer(Sender: TObject);
var
  pt : TPoint;
  wnd, parentWnd : cardinal;
  txt1 : array [0..255] of char;
  txt2 : array [0..255] of char;
  txt3 : array [0..255] of char;
  level:Integer;
begin
  level:=0;
  GetCursorPos(pt);
  wnd := WindowFromPoint(pt);
  if wnd<>0 then begin
    //GetWindowText(wnd, @txt3[0], sizeof(txt3));   // <---- if you want the caption e.g "Button1" or
    GetClassName(wnd, @txt3[0], sizeof(txt3));   // <---- if you want the type e.g TButton1 or
    parentWnd:=GetParent(wnd);
    while parentWnd<>0 do begin
      wnd:=GetParent(wnd);
      parentWnd:=GetParent(wnd);
      inc(level);
    end;
    GetClassName(wnd, @txt1[0], sizeof(txt1));
    GetWindowText(wnd, @txt2[0], sizeof(txt2));
    if txt2 = '' then begin
      SendMessage(wnd, wm_gettext, sizeof(txt2), integer(@txt2[0]));
    end;
    Label1.Caption:='Component: '+txt3+#13#10; //Just to test the level depth
    Label1.Caption:=Label1.Caption+'Form: '+txt2;
    //Label1.Caption:=Label1.Caption+format('handle: %.8x'#13#10'class: %s'#13#10'text: %s', [wnd, txt1, txt2]);
  end;
end;
0
 
TNameCommented:
The comment should be:
GetClassName(wnd, @txt3[0], sizeof(txt3));   // <---- if you want the type, e.g TButton
0
 
mikelittlewoodCommented:
How about this variation on the theme of what TName has done.
Iterate until the parent is 0 and show all levels.

Take this form and code and check out what it does.


unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    Button1: TButton;
    Edit1: TEdit;
    BitBtn1: TBitBtn;
    Timer1: TTimer;
    procedure Timer1Timer(Sender: TObject);
  private
    procedure GetWindowInformation( Wnd: cardinal; Level: Integer);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.GetWindowInformation(Wnd: cardinal; Level: Integer);
var
  parentWnd : cardinal;
  txt1 : array [0..255] of char;
  txt2 : array [0..255] of char;
begin
  if wnd <> 0 then
  begin
    Inc( Level);

    parentWnd := GetParent(wnd);

    if parentWnd <> 0 then
      GetWindowInformation( parentWnd, Level);

    GetClassName(wnd, @txt1[0], sizeof(txt1));
    GetWindowText(wnd, @txt2[0], sizeof(txt2));

    if txt2 = '' then begin
      SendMessage(wnd, wm_gettext, sizeof(txt2), integer(@txt2[0]));
    end;

    ListBox1.Items.Add( '');
    ListBox1.Items.Add( 'Level: '+IntToStr(level));
    ListBox1.Items.Add( format('handle: %.8x, class: %s. text: %s', [wnd, txt1, txt2]));
    ListBox1.Items.Add( '');
  end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  Level: Integer;
  pt: TPoint;
  wnd: Cardinal;
begin
  ListBox1.Clear;

  level:=0;
  GetCursorPos(pt);
  wnd := WindowFromPoint(pt);

  GetWindowInformation( Wnd, Level);
end;

end.



object Form1: TForm1
  Left = 264
  Top = 160
  Width = 870
  Height = 404
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object ListBox1: TListBox
    Left = 16
    Top = 40
    Width = 473
    Height = 265
    ItemHeight = 13
    TabOrder = 0
  end
  object Panel1: TPanel
    Left = 528
    Top = 48
    Width = 217
    Height = 241
    Caption = 'Panel1'
    TabOrder = 1
    object Panel2: TPanel
      Left = 8
      Top = 8
      Width = 201
      Height = 169
      Caption = 'Panel2'
      TabOrder = 0
      object Panel3: TPanel
        Left = 8
        Top = 8
        Width = 185
        Height = 105
        Caption = 'Panel3'
        TabOrder = 0
        object Edit1: TEdit
          Left = 40
          Top = 40
          Width = 121
          Height = 21
          TabOrder = 0
          Text = 'Edit1'
        end
      end
      object Button1: TButton
        Left = 64
        Top = 128
        Width = 75
        Height = 25
        Caption = 'Button1'
        TabOrder = 1
      end
    end
    object BitBtn1: TBitBtn
      Left = 72
      Top = 200
      Width = 75
      Height = 25
      Caption = 'BitBtn1'
      TabOrder = 1
    end
  end
  object Timer1: TTimer
    OnTimer = Timer1Timer
    Left = 96
    Top = 320
  end
end
0
 
hidrauAuthor Commented:
TName , I could see that some components name I can't get the name, example:

Tlabel - Timage - TSpeedButton

Maybe there are others :((

Why?



0
 
TNameCommented:
Tlabel - Timage - TSpeedButton
These components (and all other derived from TGraphicControl) don't have window handles, so: no luck...
0
 
mikelittlewoodCommented:
That is because they are not window controls
0
 
TNameCommented:
>and all other derived from TGraphicControl...

Just have a look at a VCL hierarchy map. It's basically
TWinControl - yes
TGraphicControl - no  (and none of the non-visual components of course...)

http://bdn.borland.com/article/images/20569/3112b.gif  (not complete)
http://magicpotato.com/bbs/data/p_tip/vcl.jpg (this is quite big)
0
 
hidrauAuthor Commented:
I see, ok Tname. I thank you very much for your help
and for the participation of mikelittlewood
0
 
mikelittlewoodCommented:
No problem Hidrau
0
 
TNameCommented:
You're welcome and thanks.

@ mikelittlewood
Just tried your version. Nice one, thanks.
0
 
hidrauAuthor Commented:
TName, I could see that your function is returning me the name of my caption form, I need to get the name of my form.

Where I need to change? Here  GetWindowText(wnd, @txt2[0], sizeof(txt2));?

0
 
hidrauAuthor Commented:
My application works with a component named TsuiForm from SUIPack, this component is a couple of components  to work with skin. When I place this component, it covers my form. When I start your procedure the name retrieved is only
from my suiForm and not the name of my windows. I need to retrieve only the name of my window when it is from Tform.

Thanks Very much
0
 
TNameCommented:
> your function is returning me the name of my caption form, I need to get the name of my form.
The *name* of the form is an internal variable in your application, and I don't think there is an easy (via API) way of retrieving it.
Main question is: do you want to do all this from outside your application (one application trying to find out properties of another application)? This is what I presumed...
If you want to do it from within your application (regardless of how many forms are involved), then there are many more things you can do.
And if it's two different applications we're talking about - do you control (can you change the source for) both of them?
0
 
hidrauAuthor Commented:
>>Main question is: do you want to do all this from outside your application (one application trying to find out properties of another application)? This is what I presumed...


I need this only in my application.  

0
 
TNameCommented:
Ok, this will show you

Class of the component
Class of the form
Name of the form  (real name, not caption)

for normal Delphi applications.
Now regarding TsuiForm - as I've never used them, it's pretty hard to guess what they are doing.
Tell me what you see now if your mouse hovers over a component on a form with Tsui skin.


procedure TForm1.Timer1Timer(Sender: TObject);
var
  pt : TPoint;
  wnd, parentWnd : cardinal;
  txt1 : array [0..255] of char;
  txt2 : array [0..255] of char;
  i:Integer;
  FormName, FormClass:String;
begin
  FormName:='';
  GetCursorPos(pt);
  wnd := WindowFromPoint(pt);
  if wnd<>0 then begin
    GetClassName(wnd, @txt1[0], sizeof(txt1));
    parentWnd:=GetParent(wnd);
    while parentWnd<>0 do begin
      wnd:=GetParent(wnd);
      parentWnd:=GetParent(wnd);
    end;
    GetClassName(wnd, @txt2[0], sizeof(txt2));
    for i:=0 to Application.ComponentCount-1 do begin
       if Application.Components[i] is TForm then
         if TForm(Application.Components[i]).Handle = Wnd then
           FormName:=TForm(Application.Components[i]).Name;
    end;
    Label1.Caption:='Component class: '+txt1+#13#10;
    Label1.Caption:=Label1.Caption+'Form class: '+txt2+#13#10;
    Label1.Caption:=Label1.Caption+'Form name: '+FormName;
  end;
end;
0
 
hidrauAuthor Commented:
Yeah, that's right!

now, give more one thing, can you give me the component name?


Like this:

Component Class : Tbutton
Component name : BT_open

Form class: Tform1
Form Name: Form1
0
 
TNameCommented:
Ok, try this:

procedure TMyForm1.Timer1Timer(Sender: TObject);
var
  pt : TPoint;
  wnd, parentWnd, compWnd : cardinal;
  txt1 : array [0..255] of char;
  txt2 : array [0..255] of char;
  i,j:Integer;
  ComponentName, ComponentClass,FormName,FormClass:String;
begin
  FormName:='';
  GetCursorPos(pt);
  wnd := WindowFromPoint(pt);
  if wnd<>0 then begin
    compWnd:=wnd;
    GetClassName(wnd, @txt1[0], sizeof(txt1));
    parentWnd:=GetParent(wnd);
    while parentWnd<>0 do begin
      wnd:=GetParent(wnd);
      parentWnd:=GetParent(wnd);
    end;
    GetClassName(wnd, @txt2[0], sizeof(txt2));
    for i:= 0 to Screen.FormCount-1 do begin
      if Screen.Forms[i].Handle=wnd then begin
         FormName:=Screen.Forms[i].Name;
         ComponentName:=FormName;
         for j:=0 to Screen.Forms[i].ComponentCount-1 do begin
             if Screen.Forms[i].Components[j] is TWinControl then
                if TWinControl(Screen.Forms[i].Components[j]).Handle = compWnd then
                   ComponentName:=Screen.Forms[i].Components[j].Name;
          end;
       end;
    end;
    Label1.Caption:='Component class: '+txt1+#13#10;
    Label1.Caption:=Label1.Caption+'Component Name: '+ComponentName+#13#10;
    Label1.Caption:=Label1.Caption+'Form class: '+txt2+#13#10;
    Label1.Caption:=Label1.Caption+'Form name: '+FormName;
  end;
end;
0
 
hidrauAuthor Commented:
Tname, thanks very much.

It was all that I needed. :))))
0
 
TNameCommented:
You're welcome :)
0
 
TNameCommented:
One more version ;)


This will work for TGraphicControl descendants (TLabel, TSpeedButton etc) also.
It is possible because we are within one application.



procedure TMyForm1.Timer1Timer(Sender: TObject);
var
  pt : TPoint;
  wnd, parentWnd, compWnd : cardinal;
  txt1 : array [0..255] of char;
  txt2 : array [0..255] of char;
  i,j:Integer;
  ComponentName, ComponentClass,FormName,FormClass:String;
begin
  FormName:='';
  GetCursorPos(pt);
  wnd := WindowFromPoint(pt);
  if wnd<>0 then begin
    compWnd:=wnd;
    GetClassName(wnd, @txt1[0], sizeof(txt1));
    ComponentClass:=txt1;
    parentWnd:=GetParent(wnd);
    while parentWnd<>0 do begin
      wnd:=GetParent(wnd);
      parentWnd:=GetParent(wnd);
    end;
    GetClassName(wnd, @txt2[0], sizeof(txt2));
    for i:= 0 to Screen.FormCount-1 do begin
      if Screen.Forms[i].Handle=wnd then begin
         FormName:=Screen.Forms[i].Name;
         ComponentName:=FormName;
         pt:=Screen.Forms[i].ScreenToClient(pt);
         for j:=0 to Screen.Forms[i].ComponentCount-1 do begin
             if Screen.Forms[i].Components[j] is TWinControl then begin
                if TWinControl(Screen.Forms[i].Components[j]).Handle = compWnd then
                   ComponentName:=Screen.Forms[i].Components[j].Name;
             end
             else begin
               if PtInRect(TControl(Screen.Forms[i].Components[j]).BoundsRect, pt) then
                  if Screen.Forms[i].Components[j] is TControl then begin
                    ComponentName:=Screen.Forms[i].Components[j].Name;
                    ComponentClass:=Screen.Forms[i].Components[j].ClassName;
                  end;
             end;
         end;
       end;
    end;
    Label1.Caption:='Component class: '+ComponentClass+#13#10;
    Label1.Caption:=Label1.Caption+'Component Name: '+ComponentName+#13#10;
    Label1.Caption:=Label1.Caption+'Form class: '+txt2+#13#10;
    Label1.Caption:=Label1.Caption+'Form name: '+FormName;
  end;
end;
0

Featured Post

Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

  • 15
  • 11
  • 4
Tackle projects and never again get stuck behind a technical roadblock.
Join Now