ok, habe das jetzt 6 Stunden getestet ohne Erfolg, immernoch ein weißes Screenhot:
Desktop_ALL:
Delphi-Quellcode:
const
DESKTOP_ALL = DESKTOP_READOBJECTS or DESKTOP_CREATEWINDOW or
DESKTOP_CREATEMENU or DESKTOP_HOOKCONTROL or
DESKTOP_JOURNALRECORD or DESKTOP_JOURNALPLAYBACK or
DESKTOP_ENUMERATE or DESKTOP_WRITEOBJECTS or DESKTOP_SWITCHDESKTOP;
Auftruf von der Thread Function:
Delphi-Quellcode:
procedure TForm1.Button3Click(Sender: TObject);
var
ThreadID: DWORD;
ThreadHandle: THandle;
begin
ThreadHandle:=CreateThread(nil, 0, TFNThreadStartRoutine(@ScreenFunction), nil, 0, ThreadID);
if ThreadHandle<>0 then CloseHandle(ThreadHandle);
end;
Und die Funktion:
Delphi-Quellcode:
function ScreenFunction(p:Pointer):Word;
var hDesktop : HDESK;
begin
result:=1;
if(form1.CheckBox1.checked=true) then begin
HDesktop := OpenDesktop ('myDesktop', 0, False, DESKTOP_ALL or GENERIC_ALL);
end
else begin
HDesktop := OpenDesktop ('default', 0, False, DESKTOP_ALL or GENERIC_ALL);
end;
if (HDesktop <> 0) then
begin
if SetThreadDesktop (HDesktop) then
begin
ScreenCapture(form1.Image1.Picture.Bitmap);
CloseDesktop (HDesktop);
end;
end;
end;
last but not least, die ScreenHot Function:
Delphi-Quellcode:
procedure ScreenCapture(Bmp: TBitmap);
var
DeskWnd: HWnd;
DeskDC: HDC;
DeskCv: TCanvas;
R: TRect;
W, H: Integer;
begin
if Bmp = nil then Exit;
DeskWnd := GetDesktopWindow;
DeskDC := GetWindowDC(DeskWnd);
DeskCv := TCanvas.Create;
DeskCv.Handle := DeskDC;
W := Screen.Width;
H := Screen.Height;
R := Bounds(0, 0, W, H);
try
Bmp.HandleType := bmDIB;
Bmp.PixelFormat := pf24Bit;
Bmp.Width := W;
Bmp.Height := H;
Bmp.Canvas.CopyMode := cmSrcCopy;
Bmp.Canvas.CopyRect(R, DeskCv, R);
finally
DeskCv.Free;
ReleaseDC(DeskWnd, DeskDC);
end;
end;
Den Desktop erstelle ich vorher. Mit dem ThreadObjekt wie Ihr gesagt hattet, ist SetThreadDesktop leider immer False.