455 lines
12 KiB
Plaintext
455 lines
12 KiB
Plaintext
{*******************************************************}
|
|
{ }
|
|
{ Tocsg.Capture }
|
|
{ }
|
|
{ Copyright (C) 2022 kku }
|
|
{ }
|
|
{*******************************************************}
|
|
|
|
unit Tocsg.Capture;
|
|
|
|
interface
|
|
|
|
uses
|
|
System.SysUtils, Vcl.Graphics, Vcl.Imaging.jpeg, Winapi.Windows,
|
|
System.Classes;
|
|
|
|
type
|
|
TJPEGDataHelper = class helper for Vcl.Imaging.jpeg.TJPEGData
|
|
public
|
|
function GetJpgDataStream: TStream;
|
|
end;
|
|
|
|
TJPEGImageHelper = class helper for Vcl.Imaging.jpeg.TJPEGImage
|
|
public
|
|
function GetJpgStream: TStream;
|
|
end;
|
|
|
|
function CaptureDesktopAsJPEG: TJPEGImage;
|
|
function CaptureDesktopAsJpegStream(aStream: TStream): Boolean;
|
|
function CaptureDesktopAsJpegFile(sPath: String): Boolean;
|
|
function CaptureDesktopAsBITMAP: Vcl.Graphics.TBitmap;
|
|
function CaptureWindowAsJPEG(hWindow: HWND): TJPEGImage;
|
|
function CaptureWindowAsJpegFile(hWindow: HWND; sPath: String): Boolean;
|
|
function CaptureWindowAsBitmap(hWindow: HWND; pxFormat: TPixelFormat = pf24bit): Vcl.Graphics.TBitmap;
|
|
function CaptureWindowClientAsJPEG(hWindow: HWND): TJPEGImage;
|
|
|
|
implementation
|
|
|
|
uses
|
|
Tocsg.Safe, Tocsg.Exception, Vcl.Forms, Winapi.DwmApi;
|
|
|
|
const
|
|
CaptureBlt = $40000000;
|
|
|
|
{ TJPEGDataHelper }
|
|
|
|
function TJPEGDataHelper.GetJpgDataStream: TStream;
|
|
begin
|
|
with Self do
|
|
Result := FData;
|
|
end;
|
|
|
|
{ TJPEGImageHelper }
|
|
|
|
function TJPEGImageHelper.GetJpgStream: TStream;
|
|
begin
|
|
// TJPEGImage.SaveToStream() 참조
|
|
with Self do
|
|
begin
|
|
JPEGNeeded;
|
|
if TJPEGData(FImage) <> nil then
|
|
Result := TJPEGData(FImage).GetJpgDataStream
|
|
else
|
|
Result := nil;
|
|
end;
|
|
end;
|
|
|
|
function CaptureDesktopAsJPEG: TJPEGImage;
|
|
var
|
|
DC: HDC;
|
|
BM: Vcl.Graphics.TBitmap;
|
|
nLeft, nTop,
|
|
nWidth, nHeight: Integer;
|
|
begin
|
|
DC := 0;
|
|
BM := nil;
|
|
Result := nil;
|
|
|
|
try
|
|
// GetDC에서 CreateDC로 변경
|
|
DC := CreateDC('Display', nil, nil, nil);
|
|
// DC := GetDC(0);
|
|
if DC <> 0 then
|
|
begin
|
|
try
|
|
nLeft := GetSystemMetrics(SM_XVIRTUALSCREEN);
|
|
nTop := GetSystemMetrics(SM_YVIRTUALSCREEN);
|
|
|
|
nWidth := GetSystemMetrics(SM_CXVIRTUALSCREEN);
|
|
nHeight := GetSystemMetrics(SM_CYVIRTUALSCREEN);
|
|
|
|
// nWidth := GetDeviceCaps(DC, HORZRES);
|
|
// nHeight := GetDeviceCaps(DC, VERTRES);
|
|
|
|
// Guard(BM, Vcl.Graphics.TBitmap.Create);
|
|
// BM.Width := nWidth;
|
|
// BM.Height := nHeight;
|
|
//
|
|
// if BitBlt(BM.Canvas.Handle,
|
|
// 0,
|
|
// 0,
|
|
// nWidth,
|
|
// nHeight,
|
|
// DC,
|
|
// nLeft,
|
|
// nTop,
|
|
// SRCCOPY) then
|
|
// begin
|
|
// Result := TJPEGImage.Create;
|
|
// Result.Assign(BM);
|
|
// end;
|
|
|
|
BM := Vcl.Graphics.TBitmap.Create;
|
|
BM.Width := nWidth;
|
|
BM.Height := nHeight;
|
|
|
|
if BitBlt(BM.Canvas.Handle,
|
|
0,
|
|
0,
|
|
nWidth,
|
|
nHeight,
|
|
DC,
|
|
nLeft,
|
|
nTop,
|
|
SRCCOPY + CaptureBlt) then // CaptureBlt 추가, 윈도우 7 이하 투명 효과된 윈도우 캡쳐지원
|
|
begin
|
|
Result := TJPEGImage.Create;
|
|
Result.Assign(BM);
|
|
end;
|
|
finally
|
|
if DC <> 0 then
|
|
DeleteDC(DC);
|
|
// ReleaseDC(0, DC);
|
|
if BM <> nil then //
|
|
FreeAndNil(BM); //
|
|
end;
|
|
end;
|
|
except
|
|
on E: Exception do
|
|
begin
|
|
// ETgException.TraceException(E, Format('Fail .. CaptureDesktopAsJPEG(), sStep = %s', [sStep]));
|
|
ETgException.TraceException(E, 'Fail .. CaptureDesktopAsJPEG()');
|
|
Result := nil;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function CaptureDesktopAsJpegStream(aStream: TStream): Boolean;
|
|
var
|
|
DC: HDC;
|
|
BM: Vcl.Graphics.TBitmap;
|
|
jpg: TJPEGImage;
|
|
nLeft, nTop,
|
|
nWidth, nHeight: Integer;
|
|
begin
|
|
Result := false;
|
|
DC := 0;
|
|
BM := nil;
|
|
jpg := nil;
|
|
|
|
try
|
|
try
|
|
// GetDC에서 CreateDC로 변경
|
|
DC := CreateDC('Display', nil, nil, nil);
|
|
// DC := GetDC(0);
|
|
// DC := GetDC(GetDesktopWindow);
|
|
if DC <> 0 then
|
|
begin
|
|
// 듀얼도 전체 캡쳐되도록 변경
|
|
nLeft := GetSystemMetrics(SM_XVIRTUALSCREEN);
|
|
nTop := GetSystemMetrics(SM_YVIRTUALSCREEN);
|
|
|
|
nWidth := GetSystemMetrics(SM_CXVIRTUALSCREEN);
|
|
nHeight := GetSystemMetrics(SM_CYVIRTUALSCREEN);
|
|
|
|
BM := Vcl.Graphics.TBitmap.Create;
|
|
BM.Width := nWidth;
|
|
BM.Height := nHeight;
|
|
|
|
if BitBlt(BM.Canvas.Handle,
|
|
0,
|
|
0,
|
|
nWidth,
|
|
nHeight,
|
|
DC,
|
|
nLeft,
|
|
nTop,
|
|
SRCCOPY + CaptureBlt) then // CaptureBlt 추가, 윈도우 7 이하 투명 효과된 윈도우 캡쳐지원
|
|
begin
|
|
DeleteDC(DC);
|
|
// ReleaseDC(0, DC);
|
|
DC := 0;
|
|
|
|
jpg := TJPEGImage.Create;
|
|
jpg.Assign(BM);
|
|
FreeAndNil(BM);
|
|
|
|
jpg.SaveToStream(aStream);
|
|
Result := true;
|
|
end;
|
|
end;
|
|
except
|
|
on E: Exception do
|
|
begin
|
|
// ETgException.TraceException(E, 'Fail .. CaptureDesktopAsJpegStream()');
|
|
ETgException.TraceException(E, Format('Fail .. CaptureDesktopAsJpegStream(), Left = %d, Top = %d, Width = %d, Height = %d',
|
|
[nLeft, nTop, nWidth, nHeight]));
|
|
exit;
|
|
end;
|
|
end;
|
|
finally
|
|
if jpg <> nil then
|
|
FreeAndNil(jpg);
|
|
if BM <> nil then //
|
|
FreeAndNil(BM); //
|
|
if DC <> 0 then
|
|
DeleteDC(DC);
|
|
// ReleaseDC(0, DC);
|
|
end;
|
|
end;
|
|
|
|
function CaptureDesktopAsJpegFile(sPath: String): Boolean;
|
|
var
|
|
fs: TFileStream;
|
|
begin
|
|
try
|
|
Guard(fs, TFileStream.Create(sPath, fmCreate));
|
|
Result := CaptureDesktopAsJpegStream(fs);
|
|
except
|
|
Result := false;
|
|
end;
|
|
end;
|
|
|
|
function CaptureDesktopAsBITMAP: Vcl.Graphics.TBitmap;
|
|
var
|
|
DC: HDC;
|
|
nLeft, nTop,
|
|
nWidth, nHeight: Integer;
|
|
begin
|
|
DC := 0;
|
|
Result := nil;
|
|
|
|
try
|
|
// GetDC에서 CreateDC로 변경
|
|
DC := CreateDC('Display', nil, nil, nil);
|
|
// DC := GetDC(0);
|
|
if DC <> 0 then
|
|
begin
|
|
try
|
|
nLeft := GetSystemMetrics(SM_XVIRTUALSCREEN);
|
|
nTop := GetSystemMetrics(SM_YVIRTUALSCREEN);
|
|
|
|
nWidth := GetSystemMetrics(SM_CXVIRTUALSCREEN);
|
|
nHeight := GetSystemMetrics(SM_CYVIRTUALSCREEN);
|
|
|
|
Result := Vcl.Graphics.TBitmap.Create;
|
|
Result.Width := nWidth;
|
|
Result.Height := nHeight;
|
|
|
|
if not BitBlt(Result.Canvas.Handle,
|
|
0,
|
|
0,
|
|
nWidth,
|
|
nHeight,
|
|
DC,
|
|
nLeft,
|
|
nTop,
|
|
SRCCOPY + CaptureBlt) then // CaptureBlt 추가, 윈도우 7 이하 투명 효과된 윈도우 캡쳐지원
|
|
begin
|
|
FreeAndNil(Result);
|
|
end;
|
|
finally
|
|
if DC <> 0 then
|
|
DeleteDC(DC);
|
|
// ReleaseDC(0, DC);
|
|
end;
|
|
end;
|
|
except
|
|
on E: Exception do
|
|
begin
|
|
ETgException.TraceException(E, 'Fail .. CaptureDesktopAsBMP()');
|
|
Result := nil;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function CaptureWindowAsJPEG(hWindow: HWND): TJPEGImage;
|
|
var
|
|
DC: HDC;
|
|
RT: TRect;
|
|
BM: Vcl.Graphics.TBitmap;
|
|
bGetWindRect: Boolean;
|
|
begin
|
|
Result := nil;
|
|
|
|
// GetDC에서 CreateDC로 변경
|
|
DC := CreateDC('Display', nil, nil, nil);
|
|
// DC := GetDC(hWindow);
|
|
if DC <> 0 then
|
|
begin
|
|
ZeroMemory(@RT, SizeOf(TRect));
|
|
|
|
// 기존 GetWindowRect()으로 창 크기를 가져오면 창테두리가 플랫하지 않고,
|
|
// 무엇보다 Scale이 100% 이상일 경우 창 크기와 위치가 밀리는 문제가 있다.
|
|
// 그래서 아래처럼 보완. DwmGetWindowAttribute()은 비스타, 서버 2008 이상만 지원함
|
|
bGetWindRect := DwmGetWindowAttribute(hWindow, DWMWA_EXTENDED_FRAME_BOUNDS, @RT, SizeOf(RT)) = S_OK;
|
|
if not bGetWindRect then
|
|
bGetWindRect := GetWindowRect(hWindow, RT);
|
|
|
|
if bGetWindRect then
|
|
begin
|
|
try
|
|
Guard(BM, Vcl.Graphics.TBitmap.Create);
|
|
BM.Width := RT.Width;
|
|
BM.Height := RT.Height;
|
|
|
|
if BitBlt(BM.Canvas.Handle,
|
|
0,
|
|
0,
|
|
RT.Width,
|
|
RT.Height,
|
|
DC,
|
|
RT.Left,
|
|
RT.Top,
|
|
SRCCOPY + CaptureBlt) then // CaptureBlt 추가, 윈도우 7 이하 투명 효과된 윈도우 캡쳐지원
|
|
begin
|
|
if (BM.Width + BM.Height) > 0 then
|
|
begin
|
|
Result := TJPEGImage.Create;
|
|
Result.Assign(BM);
|
|
end;
|
|
end;
|
|
except
|
|
Result := nil;
|
|
exit;
|
|
end;
|
|
end;
|
|
DeleteDC(DC);
|
|
// ReleaseDC(0, DC);
|
|
end;
|
|
end;
|
|
|
|
function CaptureWindowAsJpegFile(hWindow: HWND; sPath: String): Boolean;
|
|
var
|
|
jpg: TJPEGImage;
|
|
begin
|
|
jpg := CaptureWindowAsJPEG(hWindow);
|
|
if jpg <> nil then
|
|
begin
|
|
Result := true;
|
|
jpg.SaveToFile(sPath);
|
|
jpg.Free;
|
|
end;
|
|
end;
|
|
|
|
function CaptureWindowAsBitmap(hWindow: HWND; pxFormat: TPixelFormat = pf24bit): Vcl.Graphics.TBitmap;
|
|
var
|
|
DC: HDC;
|
|
RT: TRect;
|
|
bGetWindRect: Boolean;
|
|
begin
|
|
Result := nil;
|
|
|
|
// GetDC에서 CreateDC로 변경
|
|
DC := CreateDC('Display', nil, nil, nil);
|
|
// DC := GetDC(0);
|
|
if DC <> 0 then
|
|
begin
|
|
ZeroMemory(@RT, SizeOf(TRect));
|
|
|
|
// 기존 GetWindowRect()으로 창 크기를 가져오면 창테두리가 플랫하지 않고,
|
|
// 무엇보다 Scale이 100% 이상일 경우 창 크기와 위치가 밀리는 문제가 있다.
|
|
// 그래서 아래처럼 보완. DwmGetWindowAttribute()은 비스타, 서버 2008 이상만 지원함
|
|
bGetWindRect := DwmGetWindowAttribute(hWindow, DWMWA_EXTENDED_FRAME_BOUNDS, @RT, SizeOf(RT)) = S_OK;
|
|
if not bGetWindRect then
|
|
bGetWindRect := GetWindowRect(hWindow, RT);
|
|
|
|
if bGetWindRect then
|
|
begin
|
|
try
|
|
Result := Vcl.Graphics.TBitmap.Create;
|
|
Result.Width := RT.Width;
|
|
Result.Height := RT.Height;
|
|
Result.PixelFormat := pxFormat;
|
|
|
|
if not BitBlt(Result.Canvas.Handle,
|
|
0,
|
|
0,
|
|
RT.Width,
|
|
RT.Height,
|
|
DC,
|
|
RT.Left,
|
|
RT.Top,
|
|
SRCCOPY + CaptureBlt) then // CaptureBlt 추가, 윈도우 7 이하 투명 효과된 윈도우 캡쳐지원
|
|
begin
|
|
FreeAndNil(Result);
|
|
end;
|
|
except
|
|
Result := nil;
|
|
exit;
|
|
end;
|
|
end;
|
|
DeleteDC(DC);
|
|
// ReleaseDC(0, DC);
|
|
end;
|
|
end;
|
|
|
|
function CaptureWindowClientAsJPEG(hWindow: HWND): TJPEGImage;
|
|
var
|
|
DC: HDC;
|
|
RT: TRect;
|
|
BM: Vcl.Graphics.TBitmap;
|
|
begin
|
|
Result := nil;
|
|
|
|
// GetDC에서 CreateDC로 변경
|
|
DC := CreateDC('Display', nil, nil, nil);
|
|
// DC := GetDC(hWindow);
|
|
if DC <> 0 then
|
|
begin
|
|
ZeroMemory(@RT, SizeOf(TRect));
|
|
if GetClientRect(hWindow, RT) then
|
|
begin
|
|
try
|
|
Guard(BM, Vcl.Graphics.TBitmap.Create);
|
|
BM.Width := RT.Width;
|
|
BM.Height := RT.Height;
|
|
|
|
if BitBlt(BM.Canvas.Handle,
|
|
0,
|
|
0,
|
|
RT.Width,
|
|
RT.Height,
|
|
DC,
|
|
RT.Left,
|
|
RT.Top,
|
|
SRCCOPY + CaptureBlt) then // CaptureBlt 추가, 윈도우 7 이하 투명 효과된 윈도우 캡쳐지원
|
|
begin
|
|
Result := TJPEGImage.Create;
|
|
Result.Assign(BM);
|
|
end;
|
|
except
|
|
Result := nil;
|
|
exit;
|
|
end;
|
|
end;
|
|
DeleteDC(DC);
|
|
// ReleaseDC(0, DC);
|
|
end;
|
|
end;
|
|
|
|
end.
|