unit myZoomBox;
//{$DEFINE DEBUG}
{
デスクトップの拡大鏡を作るためのコンポーネント。
タイマーと組み合わせて手軽に拡大鏡を作成可能。
拡大画像をマウスで掴んで移動させることが可能。
デスクトップのスクリーンショットをとるクラスもあり。

2011-10-21:
　スムーズに拡大と反転に対応。
2011-09-03:
　アクティブウィンドウ(GetForegroundWindowで得られるウィンドウ)のキャプチャに対応。
　コントロールに関してはアクティブなウィンドウのフォーカスのあるコントロール。
2011-04-22:
　マウスカーソルのキャプチャでビットマップリソースを解放していなかった不具合を修正。
2011-04-20:
}


interface

uses
	Windows,
	Messages,
	SysUtils,
	Classes,
	Controls,
	Graphics,
	ExtCtrls;

type
	TMyBounds = record
		Left, Top, Width, Height: Longint;
	end;

type
//デスクトップのスクリーンショットをとるクラス。
	TScreenBitmap = class(TBitmap)
	private
		FbIsLayeredWindow : Boolean;
		FbIsMouseCursor   : Boolean;
		FbIsPrintWindow   : Boolean;

		procedure FSetSize          (ABitmap: TBitmap; ARect: TRect);
		procedure FCaptureBitmap    (ABitmap: TBitmap; ARect: TRect);
		procedure FPrintWindowBitmap(ABitmap: TBitmap; hHandle: HWND; ARect: TRect);
		procedure FCaptureWindow    (ABitmap: TBitmap; hHandle: HWND);
		function  FGetBGColor: TColor;
		procedure FSetBGColor(clColor: TColor);
	public
		constructor Create; override;
		procedure CaptureDesktop;
		procedure CaptureMonitor(iIndex: Integer); overload;        //0から始まるモニターインデックス(1から始まるMonitorNumではない)
		procedure CaptureMonitor(APoint: TPoint);  overload;
		procedure CaptureMonitor;                  overload;        //アクティブウィンドウのあるモニター
		procedure CaptureToplevelWindow;                  overload; //アクティブウィンドウ
		procedure CaptureToplevelWindow(hHandle: HWND);   overload;
		procedure CaptureToplevelWindow(APoint:  TPoint); overload;
		procedure CaptureClientWindow;                  overload;   //アクティブウィンドウのクライアント領域
		procedure CaptureClientWindow(hHandle: HWND);   overload;
		procedure CaptureClientWindow(APoint:  TPoint); overload;
		procedure CaptureControl;                 overload;          //アクティブウィンドウのフォーカスウィンドウ
		procedure CaptureControl(hHandle: HWND);  overload;
		procedure CaptureControl(APoint: TPoint); overload;
		procedure CaptureArea(ARect: TRect);                          overload;
		procedure CaptureArea(iLeft, iTop, iWidth, iHeight: Integer); overload;

		property IsLayeredWindow : Boolean read FbIsLayeredWindow write FbIsLayeredWindow;
		property IsMouseCursor   : Boolean read FbIsMouseCursor   write FbIsMouseCursor;
		property IsPrintWindow   : Boolean read FbIsPrintWindow   write FbIsPrintWindow;
		property BGColor         : TColor  read FGetBGColor       write FSetBGColor;
	end;

type
//デスクトップの拡大画像を取得するコンポーネント。
	TZoomFlip = (fpNone, fpHorizontal, fpVertical, fpBoth);

	TZoomBox = class(TPaintBox)
	private
		{ Private 宣言 }
		FbDone            : Boolean;
		FbCaptured        : Boolean;
		FiZoom            : Integer;   //倍率
		FiMax             : Integer;   //最大倍率
		FbIsCenter        : Boolean;   //Positionを表示画面の中心にするか
		FptScreenPos      : TPoint;    //キャプチャポイント
		FbIsLayeredWindow : Boolean;   //レイヤードウィンドウをキャプチャするか
		FbIsMouseCursor   : Boolean;   //マウスカーソルをキャプチャするか
		FbIsDragPosition  : Boolean;   //マウスでドラッグしてPositionを移動できるようにするか
		FptDragScreen     : TPoint;    //ドラッグして移動に必要
		FptMove           : TPoint;    //同上
		FbDragThrough     : Boolean;   //同上
//		FrcDragArea       : TRect;     //同上。移動の制限範囲。
		FrgDesktopRegion  : HRGN;
		FbmpDesktop,                   //実寸のキャプチャ画像
		FbmpZoom          : TBitmap;   //拡大画像
		FiRop             : DWORD;     //BitBlt APIの第7引数。レイヤードウィンドウをキャプチャするかどうかで変わる
		FszBuff,
		FszDesktop,                    //デスクトップの拡大されるサイズ
		FszZoom           : TMyBounds; //拡大後のサイズ
		FbSmooth          : Boolean;   //スムーズ拡大
		FFlip             : TZoomFlip; //反転

		procedure FCalcSize;
		function  FGetBGColor: TColor;
		procedure FSetBGColor(clColor: TColor);
		function  FGetShift(iValue: Integer): Integer;
		procedure FSetCenter(bValue: Boolean);
		procedure FSetDragPosition(bValue: Boolean);
		procedure FSetFlip(pfFlip: TZoomFlip);
		procedure FSetLayeredWindow(bValue: Boolean);
		procedure FSetMax(iMax: Integer);
		procedure FSetMouseCursor(bValue: Boolean);
		procedure FSetPosition(APoint: TPoint);
		procedure FSetSmooth(bSmooth: Boolean);
		procedure FSetZoom(iZoom: Integer);
	protected
		{ Protected 宣言 }
//		property  DragArea : TRect  read F_rcDragArea;// write F_SetDragArea;
//		function  SetDragArea(ARect : TRect) : Boolean;
		procedure Paint;  override;
		procedure Resize; override;
		procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
		procedure MouseMove(                      Shift: TShiftState; X, Y: Integer); override;
		procedure MouseUp  (Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
	public
		{ Public 宣言 }
		constructor Create(AOwner : TComponent); override;
		destructor  Destroy; override;
		procedure Capture;
		procedure DisplayChange(Sender: TObject);
		procedure GetBitmap(ABitmap : TBitmap);
		function  PointToScreen(ptPos: TPoint): TPoint;
		property  Position: TPoint read FptScreenPos write FSetPosition;
	published
		{ Published 宣言 }
		property BGColor         : TColor    read FGetBGColor       write FSetBGColor;
		property Flip            : TZoomFlip read FFlip             write FSetFlip;
		property IsCenter        : Boolean   read FbIsCenter        write FSetCenter;
		property IsLayeredWindow : Boolean   read FbIsLayeredWindow write FSetLayeredWindow;
		property IsMouseCursor   : Boolean   read FbIsMouseCursor   write FSetMouseCursor;
		property IsDragPosition  : Boolean   read FbIsDragPosition  write FSetDragPosition;
		property Max             : Integer   read FiMax             write FSetMax;
		property Smooth          : Boolean   read FbSmooth          write FSetSmooth;
		property Zoom            : Integer   read FiZoom            write FSetZoom;
		property OnResize;
	end;

procedure InitMonitorInfo; //モニター情報を更新する


procedure Register;

implementation
uses
{$IFDEF DEBUG}
	myDebug,
{$ENDIF}
	Dialogs,
	Forms,
	MultiMon;



//------------------------------------------------------------------------------
//コメントアウトしてもコンパイルが成功するならコメントアウトしてOK。
const
	CAPTUREBLT = $40000000; //レイヤードウィンドウも含めたキャプチャを行うフラグ
//------------------------------------------------------------------------------


//PrintWindow API 宣言ここから -------------------------------------------------
type
	TPrintWindow = function(hWindow: HWND; hdcBlt: HDC; nFlags: UINT): BOOL stdcall;
var
	lhUser32Module : HMODULE;
	xPrintWindow   : TPrintWindow;
const
	PW_CLIENTONLY = 1;

function PrintWindow(hWindow: HWND; hdcBlt: HDC; nFlags: UINT): BOOL stdcall;
begin
	if (@xPrintWindow = nil) then begin
		Result := False;
	end else begin
		Result := xPrintWindow(hWindow, hdcBlt, nFlags);
	end;
end;
//PrintWindow API ここまで -----------------------------------------------------

//--- エアロテーマ判定ここから -------------------------------------------------
//文末調整
function gfnsStrEndFit(sSrc, sEnd: WideString): WideString;
{2007-07-26:
sSrcの末尾がsEndでなければsEndを足して返す。
}
begin
	if (Copy(sSrc, Length(sSrc) - Length(sEnd) +1, Length(sEnd)) <> sEnd) then begin
		Result := sSrc + sEnd;
	end else begin
		Result := sSrc;
	end;
end;

function gfnsSystem32DirGet: WideString;
var
	li_Size: UINT;
	lp_Buff: PWideChar;
begin
	Result := '';
	li_Size := GetSystemDirectoryW(nil, 0);
	if (li_Size > 0) then begin
		lp_Buff := AllocMem(li_Size * 2);
		try
			li_Size := GetSystemDirectoryW(lp_Buff, li_Size);
			if (li_Size > 0) then begin
				Result := gfnsStrEndFit(WideString(lp_Buff), '\');
			end;
		finally
			FreeMem(lp_Buff);
		end;
	end;
end;

type
	TDwmIsCompositionEnabled = function(var bBool : BOOL): HResult stdcall;
//function DwmIsCompositionEnabled(var bBool : BOOL) : HResult; stdcall external 'Dwmapi.dll';
function DwmIsCompositionEnabled(var bBool : BOOL) : HResult;
var
	ls_Path   : String;
	lh_Module : HMODULE;
	l_DwmIsCompositionEnabled : TDwmIsCompositionEnabled;
begin
	Result := E_NOTIMPL;
	bBool  := False;

	ls_Path := gfnsSystem32DirGet;

	lh_Module := LoadLibrary(PChar(ls_Path + 'Dwmapi.dll'));
	if (lh_Module <> 0)
	then begin
		try
			// DwmIsCompositionEnabled の関数ポインタを取得。
			@l_DwmIsCompositionEnabled := GetProcAddress(lh_Module, 'DwmIsCompositionEnabled');
			if (@l_DwmIsCompositionEnabled <> nil)
			then begin
				Result := l_DwmIsCompositionEnabled(bBool);
			end;
		finally
			FreeLibrary(lh_Module);
		end;
	end;
end;

function gfnbIsAeroActive : Boolean;
var
	lb_IsAero : BOOL;
begin
	DwmIsCompositionEnabled(lb_IsAero);
	Result := lb_IsAero;
end;
//--- エアロテーマ判定ここまで -------------------------------------------------


procedure gpcMouseCursorDraw(ABitmap : TBitmap; iX, iY : Integer);
//ABitmapのiXとiYの位置に現在のマウスカーソルを描画する
{ TODO : 2000でのマウスカーソルのキャプチャ }
var
	l_CursorInfo : TCursorInfo;
	l_IconInfo   : TIconInfo;
begin
	//http://q.hatena.ne.jp/1213429698
	//http://blog.tkooler.net/Entry/72/
	//http://ht-deko.minim.ne.jp/ft0202.html
	FillChar(l_CursorInfo, SizeOf(l_CursorInfo), 0);
	l_CursorInfo.cbSize := SizeOf(l_CursorInfo);
	GetCursorInfo(l_CursorInfo);

	FillChar(l_IconInfo, SizeOf(l_IconInfo), 0);
	l_IconInfo.fIcon := False; //取得するのはカーソル
	GetIconInfo(l_CursorInfo.hCursor, l_IconInfo);
	//http://msdn.microsoft.com/ja-jp/library/ms648070.aspx
	//2011-04-22:hbmMasktoとhbmColorは解放しないとリソースが足りなくなる深刻なエラーに陥る
	DeleteObject(l_IconInfo.hbmMask);
	DeleteObject(l_IconInfo.hbmColor);

	if (l_CursorInfo.flags = CURSOR_SHOWING) then begin
		//カーソルは表示されている
		DrawIconEx(
			ABitmap.Canvas.Handle,
			iX - Integer(l_IconInfo.xHotspot),
			iY - Integer(l_IconInfo.yHotspot),
			l_CursorInfo.hCursor,
			GetSystemMetrics(SM_CXCURSOR),
			GetSystemMetrics(SM_CYCURSOR),
			0,
			0,
			DI_NORMAL
		);
	end;
end;

//--- mySize.pas ---
function gfniRectWidth (rtRect: TRect): Integer;
{2007-06-09:
rtRectの幅を返す
}
begin
	with rtRect do begin
		Result := Right - Left;
	end;
end;

function gfniRectHeight(rtRect: TRect): Integer;
{2007-06-09:
rtRectの高さを返す
}
begin
	with rtRect do begin
		Result := Bottom - Top;
	end;
end;


//--- myNum.pas ---
function gfniNumLimit(iNum : Int64; iMin, iMax : Int64) : Int64;
begin
	if (iMin = iMax) then begin
		Result := iMin;
	end else begin
		if (iNum < iMin) then begin
			Result := iMin;
		end else if (iNum > iMax) then begin
			Result := iMax;
		end else begin
			Result := iNum;
		end;
	end;
end;

function gfniRound(fNum: Extended): Int64;
{2007-06-09:
fNumを四捨五入して返す
Delphiのヘルプからコピー
}
begin
	if (fNum >= 0) then begin
		Result := Trunc(fNum + 0.5);
	end else begin
		Result := Trunc(fNum - 0.5);
	end;
end;

function lfniCeil(X: Extended): Int64;
begin
	Result := Trunc(X);
	if Frac(X) > 0 then
		Inc(Result);
end;

function lfniFloor(X: Extended): Int64;
begin
	Result := Trunc(X);
	if Frac(X) < 0 then
		Dec(Result);
end;

function gfniRoundUp(fNum: Extended): Int64;
{2007-06-09:
fNumを切り上げて返す
}
begin
	if (fNum >= 0) then begin
		Result := lfniCeil(fNum);
	end else begin
		Result := lfniFloor(fNum);
	end;
end;

function gfniMax(iNum: array of Integer): Integer;
{2007-08-27:
引数の中の最大値を返す
}
var
	i: Integer;
begin
	Result := iNum[0];
	for i := 1 to High(iNum) do begin
		if (iNum[i] > Result) then Result := iNum[i];
	end;
end;

function gfniMin(iNum: array of Integer): Integer;
{2007-12-16:
引数の中の最小値を返す
}
var
	i: Integer;
begin
	Result := iNum[0];
	for i := 1 to High(iNum) do begin
		if (iNum[i] < Result) then Result := iNum[i];
	end;
end;

//--- myWindow.pas ---
function gfnbKeyState(iKey: Integer): Boolean;
{2007-08-22,2009-02-04:

2009-02-04:左右ボタンの入れ替えで右ボタンを左ボタンにしていなかった不具合を修正。
}
var
	li_Check: SHORT;
begin
	//左右ボタンを入れ替えている場合に対処
	if (GetSystemMetrics(SM_SWAPBUTTON) <> 0) then begin
		if (iKey = VK_LBUTTON) then begin
			iKey := VK_RBUTTON;
		end else if (iKey = VK_RBUTTON) then begin
			//2009-02-04:VK_RUBTTONとしたままだったのを修正。
			iKey := VK_LBUTTON;
		end;
	end;

	li_Check := GetAsyncKeyState(iKey);
	//Result := BOOL(Hi(li_Check)) and (BOOL(Lo(li_Check)));
	Result := BOOL(Hi(li_Check));
end;

function gfnhToplevelWindowGet(hHandle: HWND): HWND; overload;
{2011-04-10:
トップレベルウィンドウを返す
}
begin
	Result := GetAncestor(hHandle, GA_ROOT);
end;

function gfnhToplevelWindowGet(ptPos: TPoint): HWND; overload;
{2008-04-19,2011-04-11:
gfnhToplevelWindowGetのTPoint版
2011-04-11:EnumWindowsを使わずに1行に書き換え。
}
begin
	//WindowFromPointは見えている一番手前のウィンドウハンドルを返す。
	//一番手前のウィンドウが無効な場合は無効なウィンドウの親ウィンドウのハンドルを返す。
	//トップレベルウィンドウが無効な場合はトップレベルウィンドウのハンドルを返す。
	Result := GetAncestor(WindowFromPoint(ptPos), GA_ROOT);
end;

//APoint上にある可視ウィンドウを返す。
type
	T_TopWindow = record
		hWindow : HWND;   //調べる点の上にあるウィンドウ
		ptPos   : TPoint; //この位置にある一番手前の見えているウィンドウを取得する
	end;
	P_TopWindow = ^T_TopWindow;

	function EnumChildProc(hHandle: HWND; pTopWindow: Pointer): BOOL; stdcall;
	var
		lh_Parent : HWND;
		lrc_Rect  : TRect;
	begin
		Result := True;
		GetWindowRect(hHandle, lrc_Rect);
		if  (IsWindowVisible(hHandle))
		and (PtInRect(lrc_Rect, T_TopWindow(pTopWindow^).ptPos))
		then begin
			lh_Parent := GetAncestor(hHandle, GA_PARENT);
			if (lh_Parent = T_TopWindow(pTopWindow^).hWindow) then begin
				//直前に列挙された対象ウィンドウの子ウィンドウだった
				//hWindowを書き換える
				//子ウィンドウがあるかもしれないので処理を続ける
				T_TopWindow(pTopWindow^).hWindow := hHandle;
			end else begin
				//親ウィンドウが同じなら兄弟ウィンドウ。
				//しかし列挙されるのは手前のウィンドウからなのでその場合はhTopは書き換ず処理を抜ける。
				//親ウィンドウが直前のウィンドウでもない
				//おじさんおばさんウィンドウ、あるいはさらに遡ってのウィンドウであるのでこれまたhTopを書き換えず処理を抜ける
				Result := False;
			end;
		end;
	end;
function gfnhWindowGet(APoint : TPoint) : HWND;
//APoint上にあり一番手前にある見えているウィンドウのハンドルを返す。
var
	lr_TopWindow : T_TopWindow;
	lh_Window,
	lh_CWindow   : HWND;
	lpt_Client   : TPoint;
begin
	//WindowFromPointはAPointが無効ウィンドウ上にある場合はトップレベルウィンドウのハンドルを返す。
	lh_Window  := WindowFromPoint(APoint);
	lpt_Client := APoint;
	Windows.ScreenToClient(lh_Window, lpt_Client);
	lh_CWindow := ChildWindowFromPointEx(lh_Window, lpt_Client,  CWP_SKIPINVISIBLE or CWP_SKIPTRANSPARENT);
	if (lh_Window = lh_CWindow) then begin
		//WindowFromPointとChildWindowFromPointExの戻り値が同じならそれで良い。
		Result := lh_Window;
	end else begin
		FillChar(lr_TopWindow, SizeOf(lr_TopWindow), 0);
		lr_TopWindow.hWindow := lh_Window;
		lr_TopWindow.ptPos   := APoint;
		EnumChildWindows(lh_Window, @EnumChildProc, LPARAM(@lr_TopWindow));
		Result := lr_TopWindow.hWindow;
	end;
end;


//--- myMonitor.pas ---
function gfnhMonitorFromRect(ARect : TRect) : HMONITOR;
begin
	Result := MultiMon.MonitorFromRect(@ARect, MONITOR_DEFAULTTONEAREST);
end;

function gfnhMonitorFromPoint(APoint: TPoint): HMONITOR;
//APointの位置にあるモニターのモニターハンドルを返す。
var
	lrc_Rect : TRect;
begin
	lrc_Rect := Rect(APoint.X, APoint.Y, APoint.X, APoint.Y);
	Result   := gfnhMonitorFromRect(lrc_Rect);
end;

function gfnrcMonitorRectGet(hHandle: HMONITOR): TRect; overload;
{2008-12-02:
モニターのRectを返す。
}
var
	lr_Info: TMonitorInfo;
begin
	Result := Rect(0, 0, 0, 0);
	if (hHandle <> 0) then begin
		FillChar(lr_Info, SizeOf(lr_Info), 0);
		lr_Info.cbSize := SizeOf(lr_Info);
		if (MultiMon.GetMonitorInfo(hHandle, @lr_Info)) then begin;
			Result := lr_Info.rcMonitor;
		end;
	end;
end;

function gfnrcMonitorRectGet(APoint : TPoint) : TRect; overload;
//APointの位置にあるモニターのRectを返す。
begin
	Result := gfnrcMonitorRectGet(gfnhMonitorFromPoint(APoint));
end;


//--- F_GetMonitorItems ---
var
	//ユニット内グローバルな変数
	FrcDesktopRect   : TRect;             //デスクトップの大きさ
	FrgDesktopRegion : HRGN;              //デスクトップのリージョン
	FhMonitorsHandle : array of HMONITOR; //モニターハンドルのリスト

	function lfnbEnumMonitorsProc(hHandle: HMONITOR; dc: HDC; r: PRect; lParam : LPARAM): BOOL; stdcall;
	var
		lrc_Monitor : TRect;
		lrg_Rgn     : HRGN;
//		li_Ret      : Integer;
	begin
		SetLength(FhMonitorsHandle, Length(FhMonitorsHandle) +1);
		FhMonitorsHandle[High(FhMonitorsHandle)] := hHandle;
		lrc_Monitor := gfnrcMonitorRectGet(hHandle);
		if  (FrcDesktopRect.Left   = 0)
		and (FrcDesktopRect.Top    = 0)
		and (FrcDesktopRect.Right  = 0)
		and (FrcDesktopRect.Bottom = 0)
		then begin
			FrcDesktopRect   := lrc_Monitor;
			FrgDesktopRegion := CreateRectRgnIndirect(lrc_Monitor);
		end else begin
			FrcDesktopRect.Left   := gfniMin([FrcDesktopRect.Left,   lrc_Monitor.Left]);
			FrcDesktopRect.Top    := gfniMin([FrcDesktopRect.Top,    lrc_Monitor.Top]);
			FrcDesktopRect.Right  := gfniMax([FrcDesktopRect.Right,  lrc_Monitor.Right]);
			FrcDesktopRect.Bottom := gfniMax([FrcDesktopRect.Bottom, lrc_Monitor.Bottom]);
			lrg_Rgn := CreateRectRgnIndirect(lrc_Monitor);
			try
				{li_Ret :=} CombineRgn(FrgDesktopRegion, FrgDesktopRegion, lrg_Rgn, RGN_OR);
			finally
				DeleteObject(lrg_Rgn);
			end;
		end;
		Result := True;
	end;
procedure InitMonitorInfo;
//デスクトップの大きさ(各モニターの領域の総和)とリージョンをセット。
begin
	//FrcDesktopRectはユニットでの内グローバル変数。
	FrcDesktopRect   := Rect(0, 0, 0, 0);
	FhMonitorsHandle := nil;
//	FrgDesktopRegion := CreateRectRgn(0, 0, 0, 0);
	DeleteObject(FrgDesktopRegion);
	EnumDisplayMonitors(0, nil, @lfnbEnumMonitorsProc, 0);
	OffsetRgn(FrgDesktopRegion, -FrcDesktopRect.Left, -FrcDesktopRect.Top);
end;

{
function gfnrcDesktopRectGet : TRect;
begin
	Result := FrcDesktopRect;
end;
}

//==============================================================================
{ TScreenBitmap }
constructor TScreenBitmap.Create;
begin
	inherited;

	FSetBGColor(clBlack);       //背景色
	FbIsLayeredWindow := True;  //レイヤードウィンドウはキャプチャする
	FbIsMouseCursor   := False; //マウスカーソルはキャプチャしない
	FbIsPrintWindow   := False; //プリントウィンドウは使わない
end;

function TScreenBitmap.FGetBGColor : TColor;
begin
	Result := Self.Canvas.Brush.Color;
end;
procedure TScreenBitmap.FSetBGColor(clColor: TColor);
begin
	Self.Canvas.Brush.Color := clColor;
end;

procedure TScreenBitmap.FSetSize(ABitmap: TBitmap; ARect: TRect);
begin
	ABitmap.Width  := gfniRectWidth (ARect);
	ABitmap.Height := gfniRectHeight(ARect);
	ABitmap.Canvas.Brush.Color := Self.Canvas.Brush.Color;
	ABitmap.Canvas.FillRect(Rect(0, 0, ABitmap.Width, ABitmap.Height));
end;

procedure TScreenBitmap.FCaptureBitmap(ABitmap: TBitmap; ARect: TRect);
var
	ldc_Desktop : HDC;
	li_Rop      : DWORD;
	lpt_Pos     : TPoint;
begin
	if (FbIsLayeredWindow) then
	begin
		li_Rop := SRCCOPY or CAPTUREBLT;
	end else
	begin
		li_Rop := SRCCOPY;
	end;

	ldc_Desktop := CreateDC('DISPLAY', nil, nil, nil);
	try
		Windows.BitBlt(ABitmap.Canvas.Handle, 0, 0, ABitmap.Width, ABitmap.Height, ldc_Desktop, ARect.Left, ARect.Top, li_Rop);
	finally
		DeleteDC(ldc_Desktop);
	end;

	if (FbIsMouseCursor) then
	begin
		GetCursorPos(lpt_Pos);
		gpcMouseCursorDraw(ABitmap, lpt_Pos.X - ARect.Left, lpt_Pos.Y - ARect.Top);
	end;
end;

procedure TScreenBitmap.FPrintWindowBitmap(ABitmap: TBitmap; hHandle: HWND; ARect: TRect);
//隠れた部分もキャプチャ
//トップレベルウィンドウとクライアントエリア、ウィンドウコントロールのみ適用。
//背景色で指定した色は無視されることに注意。
var
	lpt_Pos : TPoint;
begin
	//XP以上かつデスクトップ以外。
	//デスクトップのキャプチャは他のアプリが非表示になったあと戻るが画面の更新処理がおかしくなるのでNG。
	if (@xPrintWindow = nil)
	or (GetAncestor(hHandle, GA_ROOT) = FindWindow('Progman', 'Program Manager'))
	then
	begin
		FCaptureBitmap(ABitmap, ARect);
	end else
	begin
		ABitmap.Canvas.Lock;
		try
			PrintWindow(hHandle, ABitmap.Canvas.Handle, 0);
		finally
			ABitmap.Canvas.Unlock;
		end;
	end;

	if (FbIsMouseCursor) then
	begin
		GetCursorPos(lpt_Pos);
		gpcMouseCursorDraw(ABitmap, lpt_Pos.X - ARect.Left, lpt_Pos.Y - ARect.Top);
	end;
end;

//http://www.delphipraxis.net/159936-form-mit-bssingle-unter-aero-zu-gross.html
const
	 DWMWA_EXTENDED_FRAME_BOUNDS = 9;

//function DwmGetWindowAttribute(hwnd: HWND; dwAttribute: DWORD; pvAttribute: Pointer; cbAttribute: DWORD): HResult; stdcall; external 'Dwmapi.dll';
type
	TDwmGetWindowAttribute = function(hwnd: HWND; dwAttribute: DWORD; pvAttribute: Pointer; cbAttribute: DWORD): HResult; stdcall;
function gfnrcAeroWindowRectGet(hHandle: HWND): TRect;
{2013-11-17:
}
var
	ls_Path   : WideString;
	lh_Module : HMODULE;
	l_DwmGetWindowAttribute : TDwmGetWindowAttribute;
begin
	Result := Rect(0, 0, 0, 0);

	ls_Path := gfnsSystem32DirGet;
	lh_Module := LoadLibraryW(PWideChar(ls_Path + 'Dwmapi.dll'));
	if (lh_Module <> 0)
	then begin
		try
			// DwmGetWindowAttribute の関数ポインタを取得
			@l_DwmGetWindowAttribute := GetProcAddress(lh_Module, 'DwmGetWindowAttribute');
			if (@l_DwmGetWindowAttribute <> nil)
			then begin
				l_DwmGetWindowAttribute(
					hHandle,
					DWMWA_EXTENDED_FRAME_BOUNDS,
					@Result,
					SizeOf(TRect)
				);
			end;
		finally
			FreeLibrary(lh_Module);
		end;
	end;
end;

procedure TScreenBitmap.FCaptureWindow(ABitmap: TBitmap; hHandle: HWND);
var
	l_Rect        : TRect;
	l_Region      : HRGN;
	li_RegionCode : Integer;
begin
	if (gfnbIsAeroActive)
	then begin
		l_Rect := gfnrcAeroWindowRectGet(hHandle);
{
		//http://mrxray.on.coocan.jp/Delphi/plSamples/368_ScreenCaptureTest.htm
		l_Rect := Rect(0, 0, 0, 0);
		//拡張したウィンドウのフレームのTRect構造体の値を取得
		if (Failed(DwmGetWindowAttribute(
			hHandle,
			DWMWA_EXTENDED_FRAME_BOUNDS,
			@l_Rect,
			SizeOf(TRect)
		)))
		then begin
Exit;
		end;
}
	end
	else
	begin
		//エアロテーマがオフなら以前のやり方で良い
		if not(GetWindowRect(hHandle, l_Rect))
		then begin
Exit;
		end;
	end;

	FSetSize(ABitmap, l_Rect);
	l_Region := CreateRectRgn(0,0,0,0);
	try
		//ウィンドウリージョン取得
		li_RegionCode := GetWindowRgn(hHandle, l_Region);
		if (li_RegionCode = COMPLEXREGION)
		then begin
			SelectClipRgn(ABitmap.Canvas.Handle, l_Region);
		end;

		if (FbIsPrintWindow)
		then begin
			//隠れた部分もキャプチャ
			FPrintWindowBitmap(ABitmap, hHandle, l_Rect);
		end
		else
		begin
			//見えている通りにキャプチャ
			FCaptureBitmap(ABitmap, l_Rect);
		end;
	finally
		DeleteObject(l_Region);
		//クリッピングリージョンを解除
		SelectClipRgn(ABitmap.Canvas.Handle, 0);
	end;
end;

procedure TScreenBitmap.CaptureDesktop;
//全画面 (デスクトップ全体)
begin
	InitMonitorInfo;
	FSetSize(Self, FrcDesktopRect);
	try
		SelectClipRgn(Self.Canvas.Handle, FrgDesktopRegion);
		FCaptureBitmap(Self, FrcDesktopRect);
	finally
		//クリッピングリージョンを解除
		SelectClipRgn(Canvas.Handle, 0);
	end;
end;

procedure TScreenBitmap.CaptureMonitor(iIndex: Integer);
//0から始まるモニターインデックス
var
	lrc_Rect : TRect;
begin
	InitMonitorInfo;
	if  (iIndex < 0)
	and (iIndex > High(FhMonitorsHandle))
	then begin
Exit;
	end;

	lrc_Rect := gfnrcMonitorRectGet(FhMonitorsHandle[iIndex]);
	FSetSize(Self, lrc_Rect);
	FCaptureBitmap(Self, lrc_Rect);
end;
procedure TScreenBitmap.CaptureMonitor(APoint: TPoint);
var
	lrc_Rect : TRect;
begin
	lrc_Rect := gfnrcMonitorRectGet(APoint);
	FSetSize(Self, lrc_Rect);
	FCaptureBitmap(Self, lrc_Rect);
end;
procedure TScreenBitmap.CaptureMonitor;
//アクティブウィンドウのあるモニター
var
	hHandle  : HWND;
	lrc_Rect : TRect;
begin
	hHandle := GetForegroundWindow;
	if (hHandle = 0) then
	begin
Exit;
	end;

	InitMonitorInfo;

	GetWindowRect(hHandle, lrc_Rect);
	lrc_Rect := gfnrcMonitorRectGet(gfnhMonitorFromRect(lrc_Rect));
	FSetSize(Self, lrc_Rect);
	FCaptureBitmap(Self, lrc_Rect);
end;


procedure TScreenBitmap.CaptureToplevelWindow(hHandle: HWND);
//トップレベルウィンドウ
begin
	CaptureControl(GetAncestor(hHandle, GA_ROOT)); //GA_ROOTはトップレベルウィンドウの場合は自身のハンドルが返る
end;
procedure TScreenBitmap.CaptureToplevelWindow(APoint: TPoint);
begin
	CaptureToplevelWindow(gfnhToplevelWindowGet(APoint));
end;
procedure TScreenBitmap.CaptureToplevelWindow;
//アクティブウィンドウ
begin
	CaptureToplevelWindow(GetForegroundWindow);
end;


procedure TScreenBitmap.CaptureClientWindow(hHandle: HWND);
//トップレベルウィンドウのクライアント領域
var
	lrc_Rect,
	lrc_Client    : TRect;
	lpt_Pos       : TPoint;
	l_Bitmap      : TBitmap;
begin
	hHandle := GetAncestor(hHandle, GA_ROOT); //GA_ROOTはトップレベルウィンドウの場合は自身のハンドルが返る
	if not(GetWindowRect(hHandle, lrc_Rect)) then
	begin
Exit;
	end;

	l_Bitmap := TBitmap.Create;
	try
		FCaptureWindow(l_Bitmap, hHandle);
		GetClientRect(hHandle, lrc_Client);
		FSetSize(Self, lrc_Client);
		lpt_Pos := Point(0, 0);
		Windows.ClientToScreen(hHandle, lpt_Pos);
		Windows.BitBlt(Self.Canvas.Handle, 0, 0, Self.Width, Self.Height, l_Bitmap.Canvas.Handle, lpt_Pos.X - lrc_Rect.Left, lpt_Pos.Y - lrc_Rect.Top, SRCCOPY);
	finally
		l_Bitmap.Free;
	end;
end;
procedure TScreenBitmap.CaptureClientWindow(APoint: TPoint);
begin
	CaptureClientWindow(gfnhToplevelWindowGet(APoint));
end;
procedure TScreenBitmap.CaptureClientWindow;
//アクティブウィンドウのクライアント領域
begin
	CaptureClientWindow(GetForegroundWindow);
end;


procedure TScreenBitmap.CaptureControl(hHandle: HWND);
begin
	FCaptureWindow(Self, hHandle);
end;
procedure TScreenBitmap.CaptureControl(APoint: TPoint);
begin
	CaptureControl(gfnhWindowGet(APoint));
end;
procedure TScreenBitmap.CaptureControl;
//アクティブウィンドウのフォーカスウィンドウ
var
	li_idAttach   : DWORD;
	li_idAttachTo : DWORD;
	lh_Handle     : HWND;
	lpt_Pos       : TPoint;
begin
	li_idAttach   := GetWindowThreadProcessId(GetForegroundWindow,         nil);
	li_idAttachTo := GetWindowThreadProcessId(Application.MainForm.Handle, nil);
	AttachThreadInput(li_idAttach, li_idAttachTo, True);
	//フォーカスのあるウィンドウを取得
	lh_Handle := GetFocus;
//	lh_Handle := GetActiveWindow;
//myDebug.gpcDebug(lh_Handle);
	if (lh_Handle = 0) then
	begin
		//失敗
		GetCursorPos(lpt_Pos);
		CaptureControl(lpt_Pos);
	end else
	begin
		CaptureControl(lh_Handle);
	end;
	AttachThreadInput(li_idAttach, li_idAttachTo, False);
end;

procedure TScreenBitmap.CaptureArea(ARect: TRect);
var
	l_Bitmap : TBitmap;
begin
	InitMonitorInfo;
	l_Bitmap := TBitmap.Create;
	try
		FSetSize(l_Bitmap, FrcDesktopRect);
		SelectClipRgn(l_Bitmap.Canvas.Handle, FrgDesktopRegion);
		FCaptureBitmap(l_Bitmap, FrcDesktopRect);

		FSetSize(Self, ARect);
		BitBlt(Self.Canvas.Handle, 0, 0, Self.Width, Self.Height, l_Bitmap.Canvas.Handle, ARect.Left -FrcDesktopRect.Left, ARect.Top - FrcDesktopRect.Top, SRCCOPY);
	finally
		l_Bitmap.Free;
	end;
end;
procedure TScreenBitmap.CaptureArea(iLeft, iTop, iWidth, iHeight: Integer);
begin
	CaptureArea(Rect(iLeft, iTop, iLeft + iWidth, iTop + iHeight));
end;


//------------------------------------------------------------------------------
{ TZoomBox }
constructor TZoomBox.Create(AOwner: TComponent);
begin
	inherited;

	FbCaptured  := False;

	FbmpDesktop := TBitmap.Create;
	FbmpZoom    := TBitmap.Create;
	FSetBGColor(clBlack);

	FiZoom            := 1;
	FiMax             := 64;
	FbIsLayeredWindow := True;
	FiRop             := SRCCOPY or CAPTUREBLT;
	FbIsMouseCursor   := False;
//	FptOriginPos      := Point(0, 0);
	FSetDragPosition(False);
	FbIsCenter        := False;
	FrgDesktopRegion  := 0;
	FbSmooth          := False;

	//最新のモニター情報を取得しておく
	DisplayChange(nil);

	if (AOwner is TWinControl) then
	begin
		Parent := TWinControl(AOwner);
	end;

	FbDone := True;
end;

destructor TZoomBox.Destroy;
begin
	FbmpDesktop.Free;
	FbmpZoom.Free;
//	DeleteObject(F_rgDesktopRegion);

	inherited;
end;

procedure TZoomBox.DisplayChange(Sender: TObject);
begin
	//最新のモニター情報を取得
	InitMonitorInfo;
end;

procedure TZoomBox.FSetCenter(bValue: Boolean);
begin
	if (bValue <> FbIsCenter) then
	begin
		FbIsCenter := bValue;
		FCalcSize;
		FSetZoom(FiZoom);
	end;
end;

procedure TZoomBox.FSetLayeredWindow(bValue: Boolean);
begin
	if (bValue <> FbIsLayeredWindow) then
	begin
		FbIsLayeredWindow := bValue;
		if (FbIsLayeredWindow) then
		begin
			//レイヤードウィンドウもキャプチャ
			FiRop := SRCCOPY or CAPTUREBLT;
		end else
		begin
			//レイヤードウィンドウはキャプチャしない
			//自身をキャプチャしない時などに使用
			FiRop := SRCCOPY;
		end;
		Capture;
	end;
end;

procedure TZoomBox.FSetMouseCursor(bValue: Boolean);
begin
	if (bValue <> FbIsMouseCursor) then
	begin
		FbIsMouseCursor := bValue;
		Capture;
	end;
end;

procedure TZoomBox.FSetMax(iMax: Integer);
begin
	FiMax := gfniNumLimit(iMax, 1, iMax);
	if (FiZoom > FiMax) then
	begin
		FSetZoom(FiMax);
	end;
end;

procedure TZoomBox.FSetZoom(iZoom: Integer);
begin
	FiZoom := gfniNumLimit(iZoom, 1, FiMax);
	FCalcSize;
{ TODO : バッファを利用 }
	Capture;
end;

procedure TZoomBox.FSetSmooth(bSmooth: Boolean);
//スムーズな拡大にするか
begin
	FbSmooth := bSmooth;
	Capture;
end;

procedure TZoomBox.FSetFlip(pfFlip: TZoomFlip);
begin
	FFlip := pfFlip;
	Capture;
end;

procedure TZoomBox.FCalcSize;
	//ズーム領域調整関数
	function lfnrc_RectMagni(const ARect: TRect; const fMagni: Extended): TRect;
	begin
		Result := Rect(0, 0, gfniRoundUp(fMagni * gfniRectWidth(ARect)), gfniRoundUp(fMagni * gfniRectHeight(ARect)));
	end;
var
	lrc_Screen : TRect;
	lrc_Zoom   : TRect;
begin
	if not(FbDone) then
	begin
Exit;
	end;

//拡大のための領域のセット------------------------------------------------------
	FbmpZoom.Width     := Self.Width;
	FbmpZoom.Height    := Self.Height;
	FbmpDesktop.Width  := Self.Width;
	FbmpDesktop.Height := Self.Height;

	//バッファの領域情報
	//自身の大きさと同じ領域をコピーして拡大倍率の変動に対応する
	with FszBuff do
	begin
		Width  := FbmpZoom.Width;
		Height := FbmpZoom.Height;
		if (FbIsCenter) then
		begin
			//Left,Top は中心を示すことに注意
			Left := gfniRound(Width  / 2);
			Top  := gfniRound(Height / 2);
		end else
		begin
			Left := 0;
			Top  := 0;
		end;
	end;

	//拡大元の領域 := ズーム表示領域 / 倍率
	lrc_Screen := lfnrc_RectMagni(Self.ClientRect, 1 / FiZoom);
	//(端数が出ないように調整された)拡大される領域
	lrc_Zoom   := lfnrc_RectMagni(lrc_Screen, FiZoom);

	//拡大後の領域情報
	with FszZoom do
	begin
		Width  := gfniRectWidth (lrc_Zoom);
		Height := gfniRectHeight(lrc_Zoom);
		Left   := 0;
		Top    := 0;
	end;

	//拡大元の領域情報
	with FszDesktop do
	begin
		Width  := gfniRectWidth(lrc_Screen);
		Height := gfniRectHeight(lrc_Screen);
		if (FbIsCenter) then
		begin
			//Left,Top は中心を示すことに注意
			Left := gfniRound(Width  / 2);
			Top  := gfniRound(Height / 2);
		end else
		begin
			Left := 0;
			Top  := 0;
		end;
	end;
end;

function TZoomBox.FGetShift(iValue: Integer): Integer;
var
	li_Mod : Integer;
begin
	li_Mod := iValue mod FiZoom;
	if (li_Mod > 0) then
	begin
		Result := FiZoom - li_Mod;
	end else
	begin
		Result := 0;
	end;
	Inc(Result);
end;

procedure TZoomBox.Capture;
var
	ldc_Desktop : HDC;
	lpt_Pos     : TPoint;
	li_Left     : Integer;
	li_Top      : Integer;
	li_Width    : Integer;
	li_Height   : Integer;
begin
	//現在のマウスカーソルの位置。
	//これを後ろのほうにもって行くとカーソルの描画が揺れてしまうので初めに取得しておく
	GetCursorPos(lpt_Pos);

	if not(FbDone)
	or (FbCaptured)
	then
	begin
Exit;
	end;
	FbCaptured := True;

	FbmpZoom.Canvas.FillRect   (Rect(0, 0, FbmpZoom.Width,    FbmpZoom.Height));
	FbmpDesktop.Canvas.FillRect(Rect(0, 0, FbmpDesktop.Width, FbmpDesktop.Height));
	//デスクトップをキャプチャ

	ldc_Desktop := CreateDC('DISPLAY', nil, nil, nil);
	try
		//レイヤードウィンドウはStretchBltでは拡大コピーできないようなので一度等倍でコピーしてから拡大する
		BitBlt(
			FbmpDesktop.Canvas.Handle,
			0,
			0,
			FszBuff.Width,
			FszBuff.Height,
			ldc_Desktop,
			FptScreenPos.X - FszBuff.Left,
			FptScreenPos.Y - FszBuff.Top,
			FiRop
		);
	finally
		DeleteDC(ldc_Desktop);
	end;

	if (FbIsMouseCursor) then
	begin
		//マウスカーソルを含める
		gpcMouseCursorDraw(
			FbmpDesktop,
			lpt_Pos.X - FptScreenPos.X + FszBuff.Left,
			lpt_Pos.Y - FptScreenPos.Y + FszBuff.Top
		);
	end;

	//2011-10-21:スムーズに拡大
	if (FbSmooth) then
	begin
		SetStretchBltMode(FbmpZoom.Canvas.Handle, HALFTONE);
	end;

	//2011-10-21:反転
	case FFlip of
		fpHorizontal
		:begin
			//左右反転
			li_Left   := FszZoom.Width - FGetShift(Self.Width);
			li_Top    := 0;
			li_Width  := -FszZoom.Width;
			li_Height := FszZoom.Height;
		end;
		fpVertical
		:begin
			//上下反転
			li_Left   := 0;
			li_Top    := FszZoom.Height - FGetShift(Self.Height);
			li_Width  := FszZoom.Width;
			li_Height := -FszZoom.Height;
		end;
		fpBoth
		:begin
			//上下左右反転(180度回転)
			li_Left   := FszZoom.Width  - FGetShift(Self.Width);
			li_Top    := FszZoom.Height - FGetShift(Self.Height);
			li_Width  := -FszZoom.Width;
			li_Height := -FszZoom.Height;
		end;
		else
		begin
			//ノーマル
			li_Left   := 0;
			li_Top    := 0;
			li_Width  := FszZoom.Width;
			li_Height := FszZoom.Height;
		end;
	end;

	StretchBlt(
		FbmpZoom.Canvas.Handle,
		li_Left,
		li_Top,
		li_Width,
		li_Height,
		FbmpDesktop.Canvas.Handle,
		FszBuff.Left - FszDesktop.Left,
		FszBuff.Top  - FszDesktop.Top,
		FszDesktop.Width,
		FszDesktop.Height,
		SRCCOPY
	);

	FbCaptured := False;

	Paint;
end;

function TZoomBox.PointToScreen(ptPos: TPoint): TPoint;
//2011-10-21:
//拡大画像上のピクセルの位置をスクリーン座標で返す。
//ptPosは画面上の位置
begin
	case FFlip of
		fpHorizontal
		:begin
			//左右反転
			Result.X := Position.X + Trunc((Self.Width -1 - ptPos.X) / FiZoom);
			Result.Y := Position.Y + Trunc(ptPos.Y / FiZoom);
			if (IsCenter) then
			begin
				//X,Yは画面の中心からの相対座標に変換する
				Dec(Result.X, gfniRound(Self.Width  / 2 / FiZoom) + FiZoom mod 2);
				Dec(Result.Y, gfniRound(Self.Height / 2 / FiZoom));
			end;
		end;
		fpVertical
		:begin
			//上下反転
			Result.X := Position.X + Trunc(ptPos.X / FiZoom);
			Result.Y := Position.Y + Trunc((Self.Height -1 - ptPos.Y) / FiZoom);
			if (IsCenter) then
			begin
				//X,Yは画面の中心からの相対座標に変換する
				Dec(Result.X, gfniRound(Self.Width  / 2 / FiZoom));
				Dec(Result.Y, gfniRound(Self.Height / 2 / FiZoom));
			end;
		end;
		fpBoth
		:begin
			//180度回転
			Result.X := Position.X + Trunc((Self.Width  -1 - ptPos.X) / FiZoom);
			Result.Y := Position.Y + Trunc((Self.Height -1 - ptPos.Y) / FiZoom);
			if (IsCenter) then
			begin
				//X,Yは画面の中心からの相対座標に変換する
				Dec(Result.X, gfniRound(Self.Width  / 2 / FiZoom) + FiZoom mod 2);
				Dec(Result.Y, gfniRound(Self.Height / 2 / FiZoom));
			end;
		end;
		else
		begin
			Result.X := Position.X + Trunc(ptPos.X / FiZoom);
			Result.Y := Position.Y + Trunc(ptPos.Y / FiZoom);
			if (IsCenter) then
			begin
				//X,Yは画面の中心からの相対座標に変換する
				Dec(Result.X, gfniRound(Self.Width  / 2 / FiZoom));
				Dec(Result.Y, gfniRound(Self.Height / 2 / FiZoom));
			end;
		end;
	end;
end;

function TZoomBox.FGetBGColor: TColor;
begin
	Result := inherited Color;
end;
procedure TZoomBox.FSetBGColor(clColor: TColor);
begin
	inherited Color := clColor;

	FbmpDesktop.Canvas.Brush.Color := clColor;
	FbmpZoom.Canvas.Brush.Color    := clColor;
end;

procedure TZoomBox.FSetPosition(APoint: TPoint);
begin
	FptScreenPos := APoint;
	FCalcSize;
	Capture;
end;

procedure TZoomBox.Resize;
begin
	FCalcSize;
	Capture;
	if Assigned(OnResize) then
	begin
		OnResize(Self);
	end;
end;

procedure TZoomBox.Paint;
begin
	if (FbCaptured) then
	begin
Exit;
	end;

//ちらつくのでコメントアウト
//	Canvas.Font := Font;
//	Canvas.Brush.Color := Color;

	BitBlt(Self.Canvas.Handle, 0, 0, Self.Width, Self.Height, FbmpZoom.Canvas.Handle, 0, 0, SRCCOPY);

	if Assigned(OnPaint) then
	begin
		OnPaint(Self);
	end;
end;

procedure TZoomBox.GetBitmap(ABitmap: TBitmap);
begin
	if (Assigned(ABitmap)) then
	begin
		ABitmap.Assign(FbmpZoom);
	end;
end;

procedure TZoomBox.FSetDragPosition(bValue: Boolean);
begin
	FbIsDragPosition := bValue;
	FptMove          := Point(MAXINT, MAXINT);
	FbDragThrough    := False;
end;

(*
function TZoomBox.SetDragArea(ARect: TRect) : Boolean;
{
ドラッグして移動可能な範囲をセット。
ARectが一部でもデスクトップリージョン内にあればTrue、完全にデスクトップリージョン
外ならFalseを返す。
ARectのサイズが0以下の場合、あるいは完全にデスクトップリージョン外の場合はデスク
トップの大きさをセットする。
}
begin
	Result := True;

	//最新のモニター情報を取得
	InitMonitorInfo;

	F_rcDragArea := ARect;
	if (gfniRectWidth (F_rcDragArea) <= 0)
	or (GfniRectHeight(F_rcDragArea) <= 0)
	then begin
		//ARectの幅もしくは高さが1未満ならデフォルトの値(デスクトップの大きさ)にする
		F_rcDragArea := FrcDesktopRect;
	end else if not(RectInRegion(FrgDesktopRegion, F_rcDragArea)) then begin
		//デスクトップリージョン外
		Result       := False;
		F_rcDragArea := FrcDesktopRect;
	end;
end;
*)

procedure TZoomBox.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
	if  (FbIsDragPosition)
	and (Button = mbLeft)
	then
	begin
		FptMove       := Point(X, Y);  //キャプチャ画像上のマウスの位置
		FptDragScreen := FptScreenPos; //キャプチャポイント
	end;

	inherited;
end;
procedure TZoomBox.MouseMove(Shift: TShiftState; X, Y: Integer);
var
	lpt_Pos  : TPoint;
	lrc_Rect : TRect;
begin
	if (FbIsDragPosition) then
	begin
		if (FptMove.X = MAXINT)
		or (FptMove.Y = MAXINT)
		or not(gfnbKeyState(VK_LBUTTON)) then
		begin
			//条件外なので何もしない
		end else
		begin
			if (FbDragThrough) then
			begin
				inherited;
Exit;
			end;
			FbDragThrough := True;

{
			//マウスダウンした時のマウスの位置と現在の位置の差 = 移動量。
			//拡大画面での移動量
			lpt_Pos := Point(
				X - F_ptMove.X,
				Y - F_ptMove.Y
			);

			//	↓↓↓

			//デスクトップ上の移動量
			lpt_Pos := Point(
				gfniRound((X - F_ptMove.X) / F_iZoom),
				gfniRound((Y - F_ptMove.Y) / F_iZoom)
			);

			//	↓↓↓

			//ドラッグ後のキャプチャポイント
			//マウスダウンした時のキャプチャポイント(F_ptScreen)に足すのではなく引いて
			//いるのは拡大画面での移動方向とキャプチャポイントの移動方向が逆であるため。
			lpt_Pos := Point(
				F_ptScreen.X - gfniRound((X - F_ptMove.X) / F_iZoom),
				F_ptScreen.Y - gfniRound((Y - F_ptMove.Y) / F_iZoom)
			);
}
			//拡大画面での移動量をデスクトップ上での移動量に変換してマウスダウンした時のキャプチャポイントから引く。
			//マウスダウンした時のキャプチャポイントに足すのではなく引いているのは拡大画面でのドラッグの方向とキャプチャポイントの移動方向が逆であるため。
			lpt_Pos := Point(
//				gfniNumLimit(F_ptScreen.X - gfniRound((X - F_ptMove.X) / F_iZoom), F_rcDragArea.Left, F_rcDragArea.Right),
//				gfniNumLimit(F_ptScreen.Y - gfniRound((Y - F_ptMove.Y) / F_iZoom), F_rcDragArea.Top,  F_rcDragArea.Bottom)
				gfniNumLimit(FptDragScreen.X - gfniRound((X - FptMove.X) / FiZoom), FrcDesktopRect.Left, FrcDesktopRect.Right),
				gfniNumLimit(FptDragScreen.Y - gfniRound((Y - FptMove.Y) / FiZoom), FrcDesktopRect.Top,  FrcDesktopRect.Bottom)
			);

			//マルチモニターの環境でモニターの範囲外に出ないように調整。
			if not(PtInRegion(FrgDesktopRegion, lpt_Pos.X - FrcDesktopRect.Left, lpt_Pos.Y - FrcDesktopRect.Top)) then
			begin
				lrc_Rect  := gfnrcMonitorRectGet(FptScreenPos);
				lpt_Pos.X := gfniNumLimit(lpt_Pos.X, lrc_Rect.Left, lrc_Rect.Right);
				lpt_Pos.Y := gfniNumLimit(lpt_Pos.Y, lrc_Rect.Top,  lrc_Rect.Bottom);
			end;

			FSetPosition(lpt_Pos);

			FbDragThrough := False;
		end;
	end;

	inherited;
end;
procedure TZoomBox.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
	if (FbIsDragPosition) then
	begin
		FptMove := Point(MAXINT, MAXINT); //初期化
	end;

	inherited;
end;


//==============================================================================
procedure Register;
begin
	RegisterComponents('Samples', [TZoomBox]);
end;


initialization
	FrgDesktopRegion := 0;

//PrintWindow API 初期化ここから -----------------------------------------------
	//PrintWindow APIの関数ポインタを取得。
	if (Win32Platform = VER_PLATFORM_WIN32_NT) then begin       //NT以上。
		if ((Win32MajorVersion = 5) and (Win32MinorVersion >= 1)) //XP。
		or (Win32MajorVersion  > 5)                               //Vista以上。
		then begin
			if (@xPrintWindow = nil) then begin                     //初期化されていなかった
				lhUser32Module := LoadLibrary('User32.dll');
				if (lhUser32Module <> 0) then begin
					@xPrintWindow := GetProcAddress(lhUser32Module, 'PrintWindow');
				end;
			end;
		end;
	end;
//PrintWindow API 初期化ここまで -----------------------------------------------

finalization
	DeleteObject(FrgDesktopRegion);

//PrintWindow API 終了処理ここから ---------------------------------------------
	if (lhUser32Module <> 0) then begin
		FreeLibrary(lhUser32Module);
	end;
//PrintWindow API 終了処理ここまで ---------------------------------------------


end.