{

   This program is free software; you can redistribute it and/or
  modify it under the terms of the GNU General Public License
  as published by the Free Software Foundation; either
  version 2 of the License, or (at your option) any later version.

  This program is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  GNU General Public License for more details.

  You should have received a copy of the GNU General Public License
  along with this program; if not, write to the Free Software
  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
}
unit Ucapture;

interface
uses windows, classes, sysutils, graphics, controls, activex,
  dialogs, forms, variants;

procedure g_windowcapture(wnd:thandle; sourceBitmap:tbitmap);
procedure g_screencapture(wnd:thandle; sourceBitmap:tbitmap);
procedure g_screencapture2(wnd:thandle; sourceBitmap:tbitmap);
procedure g_selectcapture(wnd:thandle; sourceBitmap:tbitmap);

implementation

uses UfrmCaptureRect;

procedure g_windowcapture(wnd:thandle; sourceBitmap:tbitmap);
var
  huser32: THandle;
  F: function(Hnd: HWND; HdcBlt: HDC; nFlags: UINT): BOOL; stdcall;
  r1:trect;
  i:integer;
begin
  windows.GetWindowRect(wnd,r1);

//  sourceBitmap:= TBitmap.Create;
  try
   sourceBitmap.PixelFormat:=pf24Bit;
   sourceBitmap.Width:=r1.Right-r1.Left;
   sourceBitmap.Height:=r1.Bottom-r1.Top;

   huser32 := GetModuleHandle(user32);
   if huser32 <> 0 then begin
    @F := GetProcAddress(huser32, 'PrintWindow');
    if @F <> nil then begin
      sourceBitmap.Canvas.Lock;
      try
        F(wnd, sourceBitmap.Canvas.Handle, 0);
//    SendMessage (getbrowserhandle, WM_PRINT, sourceBitmap.Canvas.Handle, PRF_CLIENT or
//       PRF_NONCLIENT or PRF_OWNED or PRF_CHILDREN or PRF_ERASEBKGND);
      finally
        sourceBitmap.Canvas.Unlock;
      end;
    end;
   end;
  finally
//    sourceBitmap.Free;
  end;
end;

procedure g_screencapture(wnd:thandle; sourceBitmap:tbitmap);
var
  c: TCanvas;
  r,r1: TRect;
  i:integer;
begin
//DwmGetWindowAttribute
//  sourceBitmap:=tbitmap.Create;
  sourceBitmap.PixelFormat:=pf24Bit;
  c := TCanvas.Create;
  c.Handle := GetWindowDC(GetDesktopWindow);
  try
    windows.GetWindowRect(wnd,r);
    r1:=Rect(0, 0, r.Right-r.Left, r.Bottom-r.Top);
    sourceBitmap.Width := r1.Right;
    sourceBitmap.Height := r1.Bottom;
    sourceBitmap.Canvas.CopyRect(r1, c, r);
  finally
    ReleaseDC(0, c.Handle);
    c.Free;
//    sourceBitmap.Free;
  end;
end;

type
  _DwmGetWindowAttribute = function (hwnd: HWND; dwAttribute: DWORD;
                              pvAttribute: Pointer; cbAttribute: DWORD): HResult; stdcall;
var
  hDWMAPI:thandle=0;

function DwmGetWindowAttribute(hwnd: HWND; dwAttribute: DWORD;
  pvAttribute: Pointer; cbAttribute: DWORD): HResult;
var
  DwmGetWindowAttribute:_DwmGetWindowAttribute;
begin
  if hDWMAPI = 0 then
    hDWMAPI := LoadLibrary('DWMAPI.DLL');
  Result := E_NOTIMPL;
  if hDWMAPI > 0 then
  begin
    @DwmGetWindowAttribute := GetProcAddress(hDWMAPI, 'DwmGetWindowAttribute'); // Do not localize
    if Assigned(@DwmGetWindowAttribute) then
      Result := DwmGetWindowAttribute(hwnd, dwAttribute, pvAttribute, cbAttribute);
//    FreeLibrary(hDWMAPI);
  end;
end;

function DesktopCoordinateToOriginCoordinate(r: TRect): TRect;
var
  diff:integer;
begin
{  if r.Left<Screen.DesktopLeft then
    r.Left:=Screen.DesktopLeft;
  if r.Right>Screen.DesktopRect.Right then
    r.Right:=Screen.DesktopRect.Right;
  if r.Top<Screen.DesktopTop then
    r.Top:=Screen.DesktopTop;
  if r.Bottom>Screen.DesktopRect.Bottom then
    r.Bottom:=Screen.DesktopRect.Bottom;
}
  if r.Left<Screen.DesktopLeft then begin
    diff:=Screen.DesktopLeft-r.Left;
    r.Left:=Screen.DesktopLeft;
    r.Right:=r.Right-diff;
  end;
  if r.Top<Screen.DesktopTop then begin
    diff:=Screen.DesktopTop-r.Top;
    r.Top:=Screen.DesktopTop;
    r.Bottom:=r.Bottom-diff;
  end;
  result:=r;
end;

procedure g_screencapture2(wnd:thandle; sourceBitmap:tbitmap);
const
  DWMWA_EXTENDED_FRAME_BOUNDS = 9;
var
  c: TCanvas;
  r,r1: TRect;
  i:integer;
  aeroglass:boolean;
begin
//  sourceBitmap:=tbitmap.Create;
  sourceBitmap.PixelFormat:=pf24Bit;

  c := TCanvas.Create;
  c.Handle := GetWindowDC(GetDesktopWindow);
  try
    aeroglass := Win32MajorVersion >= 6;
    if aeroglass then begin
      if DwmGetWindowAttribute(wnd, DWMWA_EXTENDED_FRAME_BOUNDS, @r, SizeOf(TRect))=s_ok then
      else
        aeroglass:=false;
    end;
    if aeroglass=false then
      windows.GetWindowRect(wnd,r);

    r:=DesktopCoordinateToOriginCoordinate(r);

    r1:=Rect(0, 0, r.Right-r.Left, r.Bottom-r.Top);
    sourceBitmap.Width := r1.Right;
    sourceBitmap.Height := r1.Bottom;
    sourceBitmap.Canvas.CopyRect(r1, c, r);
  finally
    ReleaseDC(0, c.Handle);
    c.Free;
//    sourceBitmap.Free;
  end;
end;

procedure g_selectcapture(wnd:thandle; sourceBitmap:tbitmap);
var
  ActHandles: HWnd;
  ActRect: TRect;
  ScreenDC: HDC;
  fObjectLeft: Integer;
  fObjectTop: Integer;
  fObjectWidth: Integer;
  fObjectHeight: Integer;
begin
  ActHandles := wnd;
  ScreenDC := GetWindowDC ( ActHandles );
  try
    GetWindowRect ( ActHandles, ActRect );
    fObjectLeft := ActRect.Left - 0;
    fObjectTop := ActRect.Top - 0;
    fObjectWidth := ActRect.Right - ActRect.Left;
    fObjectHeight := ActRect.Bottom - ActRect.Top;
  finally; ReleaseDC ( ActHandles, ScreenDC ); end;

  frmCaptureRect := TfrmCaptureRect.Create(Application);
  try
    frmCaptureRect.ShowHint := False;
    if frmCaptureRect.ShowModal = mrOK then begin
      fObjectLeft := frmCaptureRect.ScreenToBitmapX ( ActRect.Left );
      fObjectTop := frmCaptureRect.ScreenToBitmapY ( ActRect.Top );
      DoPixelFormatFix(sourceBitmap);
      sourceBitmap.Assign ( frmCaptureRect.RectBitmap );
    end;
  finally
    frmCaptureRect.Free;
  end;
end;

end.
