{*******************************************************}
{                                                       }
{       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.