Unit Unit1;
{$MODE OBJFPC}{$H+}
Interface
USES
Classes, SysUtils, Forms, Controls,
Windows, StdCtrls;
TYPE
TForm1 = Class(TForm)
Button1: TButton;
Memo1 : TMemo;
Procedure FormCreate (Sender: TObject);
Procedure Button1Click (Sender: TObject);
PRIVATE
FGLevel: Integer;
End;
VAR
Form1: TForm1;
Implementation
{$R *.LFM}
Function EnumChildProc(AHandle: hWnd; ASList: LPARAM): BOOL; StdCall;
Var
tmpS,
theClassName: String;
theWinText: UnicodeString;
l: longInt;
Begin
Result:= True;
SetLength (theClassName, 256);
GetClassName (AHandle, PChar(theClassName), 255);
l := Windows.GetWindowTextLengthW(AHandle);
SetLength(theWinText, l);
l := Windows.GetWindowTextW(AHandle, @theWinText[1], l+2);
SetLength(theWinText, l);
SetLength (tmpS, Form1.FGLevel);
FillChar (tmpS[1], Length(tmpS), ' ');
tmpS:= tmpS+StrPas(PChar(theClassName));
If theWinText <> EmptyStr
Then tmpS:= tmpS+' <'+Utf8Encode(theWinText)+'>'
Else tmpS:= tmpS+'""';
TStringList(ASList).Add(tmpS);
End;
Function EnumWindowsProc(AHandle: hWnd; ASList: LPARAM): BOOL; StdCall;
Var
tmpS,
theClassName: String;
theWinText: UnicodeString;
l: longInt;
Begin
Result:= True;
SetLength (theClassName, 256);
GetClassName (AHandle, PChar(theClassName), 255);
l := Windows.GetWindowTextLengthW(AHandle);
SetLength(theWinText, l);
l := Windows.GetWindowTextW(AHandle, @theWinText[1], l+2);
SetLength(theWinText, l);
tmpS:= StrPas(PChar(theClassName));
If (theWinText <> EmptyStr)
Then tmpS:= tmpS+' <'+Utf8Encode(theWinText)+'>'
Else tmpS:= tmpS+'""';
TStringList(ASList).Add(tmpS);
Inc(Form1.FGLevel);
EnumChildWindows(AHandle, @EnumChildProc, LPARAM(ASList));
Dec(Form1.FGLevel);
End;
Procedure TForm1.Button1Click(Sender: TObject);
Var
sl: TStringlist;
Begin
sl:= TStringlist.Create;
Try
EnumWindows(@EnumWindowsProc, LPARAM(sl));
Memo1.Text:= sl.Text;
Finally
sl.Free;
End;
End;
Procedure TForm1.FormCreate(Sender: TObject);
Begin
FGLevel:= 0;
End;
END.