unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, windows;
type
{ TForm1 }
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
public
png1 : TportableNetworkGraphic;
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
type
TMyData = record
Handle: HWND;
Pid: DWORD;
Caption: String;
ClassName: String;
end;
PMyData = ^TMyData;
function GetWindowClass(const Handle: HWND): String;
begin
SetLength(Result, MAX_PATH);
SetLength(Result, GetClassName(Handle, PChar(Result), Length(Result)));
end;
function GetWindowCaption(const Handle: HWND): String;
begin
SetLength(Result, MAX_PATH);
SetLength(Result, GetWindowText(Handle, PChar(Result), Length(Result)));
end;
function EnumChildWindowsProc(Handle: THandle; MyData: LParam): BOOL; stdcall;
var
ClassName: String;
Caption: String;
Pid: DWORD;
begin
ClassName := GetWindowClass(Handle);
Caption := GetWindowCaption(Handle);
Result := (ClassName = 'SysListView32') and (Caption = 'FolderView');
if Result then
begin
PmyData(MyData)^.Handle := Handle;
GetWindowThreadProcessId(Handle, PmyData(MyData)^.Pid);
PmyData(MyData)^.Caption := Caption;
PmyData(MyData)^.ClassName := ClassName;
end;
// To continue enumeration, the callback function must return TRUE;
// to stop enumeration, it must return FALSE
Result := not Result;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
MyData : TMyData;
P : IntPtr;
DC : HDC;
begin
ZeroMemory(@MyData, SizeOf(MyData));
EnumChildWindows(GetDesktopWindow, @EnumChildWindowsProc, NativeInt(@MyData));
if MyData.Handle > 0 then
begin
ShowMessageFmt('Found Window in Pid %d '+MyData.caption, [MyData.Pid]);
png1:=TportableNetworkGraphic.Create;
DC:=getDC(MyData.handle);
if(DC = 0 ) then
showmessage('no');
png1.LoadFromDevice(DC);
releaseDC(MyData.handle,DC);
png1.SaveToFile(getuserdir+'Pictures\test.png');
png1.Free;
end
else begin
ShowMessage('Window not found!');
end;
end;
end.
Recent
