05.07.2018, 09:50
|
|
Исполняемый Ретровирус
|
|
Регистрация: 09.08.2008
Адрес: Umbrella Corporation
Сообщения: 743
Репутация: 1293
|
|
Попробуйте эти варианты, не тестировал, в проблему вопроса вникать некогда)
Код:
//v1
function GetScreenShot(const AHandle: THandle; FileName: String; QuickSave: Boolean): Boolean;
var
fBitmap: PBitmap;
DC: HDC;
Rect: TRect;
OSD: POpenSaveDialog;
Image: PPngObject;
begin
Image := NewPngObject;
fBitmap := nil;
Result := False;
DC := GetDC(AHandle);
if DC <> 0 then
try
if not GetClientRect(AHandle, Rect) then Exit;
fBitmap := NewDIBBitmap(Rect.Right - Rect.Left, Rect.Bottom - Rect.Top, pf32bit);
Result := BitBlt(fBitmap.Canvas.Handle, 0, 0, fBitmap.Width, fBitmap.Height, DC, 0, 0, SRCCOPY);
if not Result then Exit;
Image.AssignHandle(fBitmap.Handle, false, 0);
if not QuickSave then
begin
OSD := NewOpenSaveDialog('', '', DefOpenSaveDlgOptions );
OSD.Filter := 'PNG - Portable Network Graphics|*.png';
OSD.Filename := FileName;
OSD.WndOwner := OpWnd;
OSD.OpenDialog := false;
if OSD.Execute then
begin
Image.SaveToFile(OSD.Filename);
end;
OSD.Free;
end
else Image.SaveToFile(FileName);
finally
fBitmap.Free;
Image.Free;
ReleaseDC(AHandle, DC);
end;
end;
//v2
//WindowSnap(Self.Handle, Image1.Picture.Bitmap) ;
//Image1.Refresh;
function WindowSnap(windowHandle: HWND; bmp: TBitmap): boolean;
var
r: TRect;
user32DLLHandle: THandle;
printWindowAPI: function(sourceHandle: HWND; destinationHandle: HDC;
nFlags: UINT): BOOL; stdcall;
begin
result := False;
user32DLLHandle := GetModuleHandle(user32) ;
if user32DLLHandle <> 0 then
begin
@printWindowAPI := GetProcAddress(huser32, 'PrintWindow') ;
if @printWindowAPI <> nil then
begin
GetWindowRect(windowHandle, r) ;
bmp.Width := r.Right - r.Left;
bmp.Height := r.Bottom - r.Top;
bmp.Canvas.Lock;
try
result := printWindowAPI(windowHandle, bmp.Canvas.Handle, 0) ;
finally
bmp.Canvas.Unlock;
end;
end;
end;
end; (*WindowSnap*)
//v3
procedure TForm1.Button1Click(Sender: TObject);
const
FullWindow = True; // Set to false if you only want the client area.
var
Win: HWND;
DC: HDC;
Bmp: TBitmap;
FileName: string;
WinRect: TRect;
Width: Integer;
Height: Integer;
begin
Form1.Hide;
try
Application.ProcessMessages; // Was Sleep(500);
Win := GetForegroundWindow;
if FullWindow then
begin
GetWindowRect(Win, WinRect);
DC := GetWindowDC(Win);
end else
begin
Windows.GetClientRect(Win, WinRect);
DC := GetDC(Win);
end;
try
Width := WinRect.Right - WinRect.Left;
Height := WinRect.Bottom - WinRect.Top;
Bmp := TBitmap.Create;
try
Bmp.Height := Height;
Bmp.Width := Width;
BitBlt(Bmp.Canvas.Handle, 0, 0, Width, Height, DC, 0, 0, SRCCOPY);
FileName := 'Screenshot_' +
FormatDateTime('mm-dd-yyyy-hhnnss', Now());
Bmp.SaveToFile(Format('C:\Screenshots\%s.bmp', [FileName]));
finally
Bmp.Free;
end;
finally
ReleaseDC(Win, DC);
end;
finally
Form1.Show;
end;
end;
|