(*
Window List Component 1.5 by Jerry Ryle
Aaugh! I accidentally uploaded the wrong source
which had a nasty bug in the refresh procedure!
Thanks to Serge, who found my mistake and suggested
a few other improvements!
This component will enumerate windows and return
information about them in the Windows property.
The component currently returns a handle, caption text,
associated ProcessID, visibility, and dimensions.
For documentation, please read the accompanying
WindowList.txt
This component is completely free of course. If you find
it useful, and are compelled to send me cash, beer, or
dead things in envelopes, please feel free to do so.
email me if you make it better: gryle@calpoly.edu
*)
unit WindowList;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
type
TWindowObject = record
WinHandle : HWnd; {Window Handle}
WinCaption : String; {Window Caption Text (If any)}
ProcessID : Integer; {Process the window belongs to}
IsVisible : Boolean; {Is the window visible?}
IsEnabled : Boolean; {Is the window enabled for mouse/keyboard input?}
IsIconic : Boolean; {Is the window minimized?}
WindowRect : TRect; {Window Dimensions}
{Add more properties here if you like,
then fill them in at the WindowCallback
function.}
end;
PTWindowObject = ^TWindowObject;
TWindowList = class(TComponent)
private
WindowLst : TList;
FCount : Integer;
protected
Function GetAWindow(Index : Integer) : TWindowObject;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
Procedure Refresh;
Property Windows[Index : Integer]: TWindowObject read GetAWindow;
Property Count : Integer read FCount;
published
{ Published declarations }
end;
procedure Register;
implementation
{Note that this function is not a member of WindowList.
Therefore, the list to be filled needs to be passed
as a pointer. Note that this is passed as a VAR. if you
don’t do this, bad things happen in memory.}
Function WindowCallback(WHandle : HWnd; Var Parm : Pointer) : Boolean; stdcall;
{This function is called once for each window}
Var MyString : PChar;
MyInt : Integer;
MyWindowPtr : ^TWindowObject;
begin
New(MyWindowPtr);
{Window Handle (Passed by the enumeration)}
MyWindowPtr.WinHandle := WHandle;
{Window text}
MyString := Allocmem(255);
GetWindowText(WHandle,MyString,255);
MyWindowPtr.WinCaption := String(MyString);
FreeMem(MyString,255);
{Process ID}
MyInt := 0;
MyWindowPtr.ProcessID := GetWindowThreadProcessId(WHandle,@MyInt);
{Visiblity}
MyWindowPtr.IsVisible := IsWindowVisible(WHandle);
{Enabled}
MyWindowPtr.IsEnabled := IsWindowEnabled(WHandle);
{Iconic}
MyWindowPtr.IsIconic := IsIconic(WHandle);
{Window Dimensions}
MyWindowPtr.WindowRect := Rect(0,0,0,0);
GetWindowRect(WHandle,MyWindowPtr.WindowRect);
{Add the structure to the list. Do not dereference Parm…
once again, bad things happen.}
TList(Parm).Add(MyWindowPtr);
Result := True; {Everything’s okay. Continue to enumerate windows}
end;
constructor TWindowList.Create(AOwner: TComponent);
var MyWindowPtr : PTWindowObject;
begin
inherited;
WindowLst := TList.Create;
{Thanks Serge, I should’ve done this from the start :)
Sloppy me. }
If Not ( csDesigning in ComponentState ) Then
Begin
EnumWindows(@WindowCallback,Longint(@WindowLst));
FCount := WindowLst.Count;
End
Else
FCount := 0;
end;
destructor TWindowList.Destroy;
var I : Integer;
begin
If WindowLst.Count > 0 Then
Begin
For I := 0 To (WindowLst.Count – 1) Do
Dispose(PTWindowObject(WindowLst[I]));
End;
WindowLst.Free;
inherited;
end;
procedure TWindowList.Refresh;
begin
WindowLst.Clear; {Clear the list!}
EnumWindows(@WindowCallback,Longint(@WindowLst));
FCount := WindowLst.Count;
end;
function TWindowList.GetAWindow(Index : Integer) : TWindowObject;
begin
Result := PTWindowObject(WindowLst[Index])^;
end;
procedure Register;
begin
RegisterComponents(‘System’, [TWindowList]);
end;
end.
示例程序
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,WindowList, ComCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Label1: TLabel;
ListView1: TListView;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
FWindowList:TWindowList;
FWindowObject:TWindowObject;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
i:integer;
ListItem: TListItem;
sRect:string;
begin
ListView1.Items.Clear;
FWindowList:=TWindowList.Create(nil);
FWindowList.Refresh;
label1.Caption:=inttostr(FWindowList.Count);
for i:=0 to FWindowList.Count-1 do
begin
FWindowObject:=FWindowList.Windows[i];
ListItem:=ListView1.Items.Add;
ListItem.Caption:=inttostr(FWindowObject.WinHandle);
ListItem.SubItems.Add(FWindowObject.WinCaption);
ListItem.SubItems.Add(inttostr(FWindowObject.ProcessID));
if FWindowObject.IsVisible then ListItem.SubItems.Add(‘true’)
else ListItem.SubItems.Add(‘false’);
sRect:=’left:’+inttostr(FWindowObject.WindowRect.Left)+
‘top:’+inttostr(FWindowObject.WindowRect.Top)+
‘Right:’+inttostr(FWindowObject.WindowRect.Right)+
‘Bottom:’+inttostr(FWindowObject.WindowRect.Bottom);
ListItem.SubItems.Add(sRect);
if FWindowObject.IsEnabled then ListItem.SubItems.Add(‘true’)
else ListItem.SubItems.Add(‘false’);
if FWindowObject.IsIconic then ListItem.SubItems.Add(‘true’)
else ListItem.SubItems.Add(‘false’);
end;
end;
end.
对应的form
object Form1: TForm1
Left = 15
Top = 117
Width = 928
Height = 480
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 Label1: TLabel
Left = 712
Top = 336
Width = 169
Height = 13
AutoSize = False
Caption = ‘Label1’
end
object Button1: TButton
Left = 728
Top = 376
Width = 75
Height = 25
Caption = ‘Button1’
TabOrder = 0
OnClick = Button1Click
end
object ListView1: TListView
Left = 0
Top = 0
Width = 665
Height = 453
Align = alLeft
Columns = < item Caption = 'WinHandle' end item Caption = 'WinCaption ' end item Caption = 'ProcessID ' end item Caption = 'IsVisible ' end item Caption = 'WindowRect ' end item Caption = 'IsEnabled ' end item Caption = 'IsIconic ' end>
TabOrder = 1
ViewStyle = vsReport
end
end