08-08-2025, 04:38 AM
إستخدم BitBlt
و الإستخدام كالآتي:
كود :
procedure BitBltFullScreen(aImage: TImage);
const
CAPTUREBLT = $40000000;
var
LScreenDC, LMemDC: HDC;
LBitmap: HBITMAP;
LBMP: TBitmap;
LScreenWidth, LScreenHeight: Integer;
begin
LScreenWidth := GetSystemMetrics(SM_CXSCREEN);
LScreenHeight := GetSystemMetrics(SM_CYSCREEN);
LBMP := TBitmap.Create;
try
LBMP.PixelFormat := pf24bit;
LBMP.Width := LScreenWidth;
LBMP.Height := LScreenHeight;
LScreenDC := GetDC(0);
LMemDC := CreateCompatibleDC(LScreenDC);
LBitmap := CreateCompatibleBitmap(LScreenDC, LScreenWidth, LScreenHeight);
SelectObject(LMemDC, LBitmap);
BitBlt(LMemDC, 0, 0, LScreenWidth, LScreenHeight, LScreenDC, 0, 0, SRCCOPY or CAPTUREBLT);
LBMP.Handle := LBitmap;
aImage.Picture.Assign(LBMP);
DeleteDC(LMemDC);
ReleaseDC(0, LScreenDC);
finally
LBMP.Free;
end;
end;
procedure BitBltWindow(aHWnd: HWND; aImage: TImage);
const
cCAPTUREBLT = $40000000;
var
LWindowDC, LMemDC: HDC;
LBitmap: HBITMAP;
LBMP: TBitmap;
LRect: TRect;
LWidth, LHeight: Integer;
begin
if not IsWindow(aHWnd) then
Exit;
// Get the window size
GetWindowRect(aHWnd, LRect);
LWidth := LRect.Right - LRect.Left;
LHeight := LRect.Bottom - LRect.Top;
LBMP := TBitmap.Create;
try
LBMP.PixelFormat := pf24bit;
LBMP.Width := LWidth;
LBMP.Height := LHeight;
// Get window device context
LWindowDC := GetWindowDC(aHWnd); // Use GetDC(aHWnd) for client area only
LMemDC := CreateCompatibleDC(LWindowDC);
LBitmap := CreateCompatibleBitmap(LWindowDC, LWidth, LHeight);
SelectObject(LMemDC, LBitmap);
// Copy the window content into memory DC
BitBlt(LMemDC, 0, 0, LWidth, LHeight, LWindowDC, 0, 0, SRCCOPY or cCAPTUREBLT);
// Assign result to TImage
LBMP.Handle := LBitmap;
aImage.Picture.Assign(LBMP);
// Cleanup
DeleteDC(LMemDC);
ReleaseDC(aHWnd, LWindowDC);
finally
LBMP.Free;
end;
end;كود :
procedure TForm1.BtnPrintScreenClick(Sender: TObject);
begin
BitBltFullScreen(imgScreenShot);
// BitBltWindow(FindWindow('TAppBuilder', nil), imgScreenShot);
end;