Solved

Only to improve a function

Posted on 2006-10-31
30
213 Views
Last Modified: 2010-04-05
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
Comment
Question by:hidrau
  • 15
  • 11
  • 4
30 Comments
 
LVL 15

Expert Comment

by:mikelittlewood
ID: 17842619
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
 
LVL 1

Author Comment

by:hidrau
ID: 17842654
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
 
LVL 28

Expert Comment

by:TName
ID: 17843487
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
 
LVL 28

Expert Comment

by:TName
ID: 17843590
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
 
LVL 28

Expert Comment

by:TName
ID: 17843690
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
 
LVL 1

Author Comment

by:hidrau
ID: 17843721
ok Tname, I am gonna test it.
0
 
LVL 28

Expert Comment

by:TName
ID: 17843839
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
 
LVL 1

Author Comment

by:hidrau
ID: 17843905
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
 
LVL 28

Expert Comment

by:TName
ID: 17843916
>brake
I meant break of course :)
0
 
LVL 1

Author Comment

by:hidrau
ID: 17843972
Sorry, I didn't understand

0
 
LVL 28

Accepted Solution

by:
TName earned 400 total points
ID: 17844161
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
 
LVL 28

Expert Comment

by:TName
ID: 17844172
The comment should be:
GetClassName(wnd, @txt3[0], sizeof(txt3));   // <---- if you want the type, e.g TButton
0
 
LVL 15

Assisted Solution

by:mikelittlewood
mikelittlewood earned 100 total points
ID: 17844192
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
 
LVL 1

Author Comment

by:hidrau
ID: 17844315
TName , I could see that some components name I can't get the name, example:

Tlabel - Timage - TSpeedButton

Maybe there are others :((

Why?



0
 
LVL 28

Expert Comment

by:TName
ID: 17844398
Tlabel - Timage - TSpeedButton
These components (and all other derived from TGraphicControl) don't have window handles, so: no luck...
0
How to improve team productivity

Quip adds documents, spreadsheets, and tasklists to your Slack experience
- Elevate ideas to Quip docs
- Share Quip docs in Slack
- Get notified of changes to your docs
- Available on iOS/Android/Desktop/Web
- Online/Offline

 
LVL 15

Expert Comment

by:mikelittlewood
ID: 17844409
That is because they are not window controls
0
 
LVL 28

Expert Comment

by:TName
ID: 17844587
>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
 
LVL 1

Author Comment

by:hidrau
ID: 17844611
I see, ok Tname. I thank you very much for your help
and for the participation of mikelittlewood
0
 
LVL 15

Expert Comment

by:mikelittlewood
ID: 17845226
No problem Hidrau
0
 
LVL 28

Expert Comment

by:TName
ID: 17845450
You're welcome and thanks.

@ mikelittlewood
Just tried your version. Nice one, thanks.
0
 
LVL 1

Author Comment

by:hidrau
ID: 17848610
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
 
LVL 1

Author Comment

by:hidrau
ID: 17848663
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
 
LVL 28

Expert Comment

by:TName
ID: 17848897
> 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
 
LVL 1

Author Comment

by:hidrau
ID: 17848939
>>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
 
LVL 28

Expert Comment

by:TName
ID: 17849564
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
 
LVL 1

Author Comment

by:hidrau
ID: 17849800
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
 
LVL 28

Expert Comment

by:TName
ID: 17850246
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
 
LVL 1

Author Comment

by:hidrau
ID: 17850268
Tname, thanks very much.

It was all that I needed. :))))
0
 
LVL 28

Expert Comment

by:TName
ID: 17850358
You're welcome :)
0
 
LVL 28

Expert Comment

by:TName
ID: 17851017
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

What Is Threat Intelligence?

Threat intelligence is often discussed, but rarely understood. Starting with a precise definition, along with clear business goals, is essential.

Join & Write a Comment

Creating an auto free TStringList The TStringList is a basic and frequently used object in Delphi. On many occasions, you may want to create a temporary list, process some items in the list and be done with the list. In such cases, you have to…
Have you ever had your Delphi form/application just hanging while waiting for data to load? This is the article to read if you want to learn some things about adding threads for data loading in the background. First, I'll setup a general applica…
Here's a very brief overview of the methods PRTG Network Monitor (https://www.paessler.com/prtg) offers for monitoring bandwidth, to help you decide which methods you´d like to investigate in more detail.  The methods are covered in more detail in o…
In this tutorial you'll learn about bandwidth monitoring with flows and packet sniffing with our network monitoring solution PRTG Network Monitor (https://www.paessler.com/prtg). If you're interested in additional methods for monitoring bandwidt…

707 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now