program chkovlay;
{
2011-01-21:Ver 0.1.2.6
・DLLプリロード攻撃対策。

2010-01-08:Ver 0.1.1.6
・メニューに「最小化」を追加。

2009-03-14:Ver 0.1.0.6
・VCLを使わずに実装。
・フォーム枠をアクティブなキャプションの色に変更。
・マウスホイールは不測の事態が予想されるのでとりあえず非対応。
機能的にはダウンしてしまったがファイルサイズはえらく小さくなったので満足度は高い。

2008-12-03:Ver 0.0.1.0
・フォームの枠を1ピクセルの銀色に変更。
・マウスホイールでフォームの拡大・縮小を行えるよう機能追加。
・「常に前面に表示」オプション追加。起動時は常に前面に表示。

2008-12-01:作成。
}

//{$DEFINE DEBUG}
//{$DEFINE WHEEL}

{$IFNDEF DEBUG}
{$O+}
//{$Q-}
//{$R-}
{$ENDIF}

uses
	my_safedll,

{$IFDEF DEBUG}
	myDebug,
{$ENDIF}
	Messages,
	Windows;

{$R *.res}


const
	IDM_EXIT      = 200;
	IDM_STAYONTOP = 201;
	IDM_MINIMIZE  = 202;
var
	lhMenu: HMENU;


procedure OnPaint(var Msg: TWMPaint);
var
	lh_Pen, lh_DefPen: HPEN;
	lrc_Rect: TRect;
begin
	GetClientRect(Msg.Msg, lrc_Rect);
	lh_Pen := CreatePen(PS_SOLID, 1, GetSysColor(COLOR_ACTIVECAPTION));
	try
		lh_DefPen := SelectObject(Msg.DC, lh_Pen);
		MoveToEx(Msg.DC, 0, 0, nil);
		LineTo(Msg.DC, lrc_Rect.Right -1, 0);
		LineTo(Msg.DC, lrc_Rect.Right -1, lrc_Rect.Bottom -1);
		LineTo(Msg.DC, 0,                 lrc_Rect.Bottom -1);
		LineTo(Msg.DC, 0,                 0);
		SelectObject(Msg.DC, lh_DefPen);
	finally
		DeleteObject(lh_Pen);
	end;
end;

procedure OnMouse(var Msg: TWMMouse; bSizing: Boolean);
const
	lci_MARGIN = 4;
var
	lrc_Rect: TRect;
	li_SizeX, li_SizeY, ClientWidth, ClientHeight: Integer;
begin
	li_SizeX := GetSystemMetrics(SM_CXFRAME);
	li_SizeY := GetSystemMetrics(SM_CYFRAME);
	GetClientRect(Msg.Msg, lrc_Rect);
	ClientWidth  := lrc_Rect.Right;
	ClientHeight := lrc_Rect.Bottom;
	if ((Msg.XPos < li_SizeX * lci_MARGIN) and (Msg.YPos < li_SizeY * lci_MARGIN)) then begin
		//左上
		SetCursor(LoadCursorW(0, IDC_SIZENWSE));
		if (bSizing) then SendMessageW(Msg.Msg, WM_SYSCOMMAND, WPARAM(SC_SIZE or WMSZ_TOPLEFT), 0);
	end else if ((ClientWidth - Msg.XPos <= li_SizeX * lci_MARGIN) and (ClientHeight - Msg.YPos <= li_SizeY * lci_MARGIN)) then begin
		//右下
		SetCursor(LoadCursorW(0, IDC_SIZENWSE));
		if (bSizing) then SendMessageW(Msg.Msg, WM_SYSCOMMAND, WPARAM(SC_SIZE or WMSZ_BOTTOMRIGHT), 0);
	end else if ((ClientWidth - Msg.XPos <= li_SizeX * lci_MARGIN) and (Msg.YPos < li_SizeY * lci_MARGIN)) then begin
		//右上
		SetCursor(LoadCursorW(0, IDC_SIZENESW));
		if (bSizing) then SendMessageW(Msg.Msg, WM_SYSCOMMAND, WPARAM(SC_SIZE or WMSZ_TOPRIGHT), 0);
	end else if ((Msg.XPos < li_SizeX * lci_MARGIN) and (ClientHeight - Msg.YPos <= li_SizeY * lci_MARGIN)) then begin
		//左下
		SetCursor(LoadCursorW(0, IDC_SIZENESW));
		if (bSizing) then SendMessageW(Msg.Msg, WM_SYSCOMMAND, WPARAM(SC_SIZE or WMSZ_BOTTOMLEFT), 0);
	end else if (Msg.XPos < li_SizeX) then begin
		//左
		SetCursor(LoadCursorW(0, IDC_SIZEWE));
		if (bSizing) then SendMessageW(Msg.Msg, WM_SYSCOMMAND, WPARAM(SC_SIZE or WMSZ_LEFT), 0);
	end else if (ClientWidth - Msg.XPos <= li_SizeX) then begin
		//右
		SetCursor(LoadCursorW(0, IDC_SIZEWE));
		if (bSizing) then SendMessageW(Msg.Msg, WM_SYSCOMMAND, WPARAM(SC_SIZE or WMSZ_RIGHT), 0);
	end else if (Msg.YPos < li_SizeY) then begin
		//上
		SetCursor(LoadCursorW(0, IDC_SIZENS));
		if (bSizing) then SendMessageW(Msg.Msg, WM_SYSCOMMAND, WPARAM(SC_SIZE or WMSZ_TOP), 0);
	end else if (ClientHeight - Msg.YPos <= li_SizeY) then begin
		//下
		SetCursor(LoadCursorW(0, IDC_SIZENS));
		if (bSizing) then SendMessageW(Msg.Msg, WM_SYSCOMMAND, WPARAM(SC_SIZE or WMSZ_BOTTOM), 0);
	end else begin
		//移動
		SetCursor(LoadCursorW(0, IDC_ARROW));
		if (bSizing) then SendMessageW(Msg.Msg, WM_SYSCOMMAND, WPARAM(SC_SIZE or 9), 0);
	end;
end;

procedure OnContextMenu(var Msg: TWMMouse);
var
	lpt_Pos: TPoint;
begin
	GetCursorPos(lpt_Pos);
	TrackPopupMenu(lhMenu, 0, lpt_Pos.X, lpt_Pos.Y, 0, Msg.Msg, nil);
end;

procedure OnCommand(var Msg: TMessage);
begin
	if (Msg.WParamHi = 0) then begin
		// Menu=0,Accel=1,NotifyCode=Control
		case Msg.WParamLo of
			IDM_EXIT: begin
				DestroyWindow(Msg.Msg);
			end;
			IDM_STAYONTOP: begin
				if (CheckMenuItem(lhMenu, 0, MF_BYPOSITION) = MF_CHECKED) then begin
					CheckMenuItem(lhMenu, 0, MF_BYPOSITION or MF_UNCHECKED);
					SetWindowPos(Msg.Msg, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE);
				end else begin
					CheckMenuItem(lhMenu, 0, MF_BYPOSITION or MF_CHECKED);
					SetWindowPos(Msg.Msg, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE);
				end;
				DrawMenuBar(lhMenu);
			end;
			IDM_MINIMIZE: begin
				SendMessage(Msg.Msg, WM_SYSCOMMAND, WPARAM(SC_MINIMIZE and $FFF0), 0);
			end;
		end;
	end;
end;

{$IFDEF WHEEL}
procedure OnMouseWheel(var Msg: TWMMouseWheel);
const
	lci_MINWIDTH  = 120;
	lci_MINHEIGHT = 90;
	lci_MAXWIDTH  = 1280;
	lci_MAXHEIGHT = 960;
var
	lrc_Rect: TRect;
	li_Width, li_Height: Integer;
begin
	GetWindowRect(Msg.Msg, lrc_Rect);

	with lrc_Rect do begin
		if (Msg.WheelDelta > 0) then begin
			li_Width := Trunc((Right - Left) * 1.1);
			if (li_Width > lci_MAXWIDTH) then li_Width := lci_MAXWIDTH;
			li_Height := Trunc((Bottom - Top) * 1.1);
			if (li_Height > lci_MAXHEIGHT) then li_Height := lci_MAXHEIGHT;
			SetWindowPos(Msg.Msg, 0, Left, Top, li_Width, li_Height, SWP_NOZORDER);
		end else begin
			li_Width := Trunc((Right - Left) * 0.9);
			if (li_Width < lci_MINWIDTH) then li_Width := lci_MINWIDTH;
			li_Height := Trunc((Bottom - Top) * 0.9);
			if (li_Height < lci_MINHEIGHT) then li_Height := lci_MINHEIGHT;
			SetWindowPos(Msg.Msg, 0, Left, Top, li_Width, li_Height, SWP_NOZORDER);
		end;
	end;
end;
{$ENDIF}

function MainWndProc(hWindow: HWND; Msg: UINT; iWParam: WPARAM; iLParam: LPARAM): LRESULT; stdcall;
var
	ps: TPaintStruct;
	lr_Msg: TMessage;
begin
	Result := 0;

	FillChar(lr_Msg, SizeOf(lr_Msg), 0);
	with lr_Msg do begin
		Msg := hWindow;
		WParam := iWParam;
		LParam := iLParam;
		Result := 0;
	end;

	case Msg of
		WM_PAINT: begin
			BeginPaint(hWindow, ps);
			TWMPaint(lr_Msg).DC := ps.hdc;
			OnPaint(TWMPaint(lr_Msg));
			EndPaint(hWindow, ps);
		end;
		WM_LBUTTONDOWN, WM_MOUSEMOVE: begin
			OnMouse(TWMMouse(lr_Msg), Msg = WM_LBUTTONDOWN);
		end;
		WM_CONTEXTMENU: begin
			OnContextMenu(TWMMouse(lr_Msg));
		end;
		WM_COMMAND: begin
			OnCommand(lr_Msg);
		end;
		{$IFDEF WHEEL}
		WM_MOUSEWHEEL: begin
			OnMouseWheel(TWMMouseWheel(lr_Msg));
		end;
		{$ENDIF}
		WM_DESTROY: begin
			PostQuitMessage(0);
		end;
		else begin
			Result := DefWindowProcW(hWindow, Msg, iWParam, iLParam);
		end;
	end;
end;

const
	lcsCLASSNAME = 'TTOOL_CheckOverlay';
var
	lh_Window: HWND;
	lr_WndClass: TWndClassW;
	lr_Msg: TMsg;
begin
	FillChar(lr_WndClass, SizeOf(lr_WndClass), 0);
	lr_WndClass.lpszClassName   := lcsCLASSNAME;
	lr_WndClass.lpfnWndProc     := @MainWndProc;
	lr_WndClass.style           := CS_VREDRAW or CS_HREDRAW;
	lr_WndClass.hInstance       := hInstance;
	lr_WndClass.hIcon           := LoadIconW(hInstance, 'MAINICON');
	lr_WndClass.hCursor         := 0;
	lr_WndClass.hbrBackground   := CreateSolidBrush($100010);
	lr_WndClass.lpszMenuName    := nil;
	lr_WndClass.cbClsExtra      := 0;
	lr_WndClass.cbWndExtra      := 0;
	if (RegisterClassW(lr_WndClass) =  0) then Halt(1);

	lh_Window := CreateWindowExW(
		WS_EX_CONTROLPARENT
		or WS_EX_TOPMOST
		,
		lcsCLASSNAME,
		'check overlay',
		WS_VISIBLE
		or WS_POPUP
		or WS_SYSMENU
		or WS_MINIMIZEBOX
		,
		75,
		75,
		240,
		160,
		0,
		0,
		hInstance,
		nil
	);
	if (lh_Window = 0) then Halt(1);

	lhMenu := GetSystemMenu(lh_Window, False);
	DeleteMenu(lhMenu, SC_MAXIMIZE, MF_BYCOMMAND);
	DeleteMenu(lhMenu, SC_SIZE,     MF_BYCOMMAND);
	DrawMenuBar(lhMenu);

	lhMenu := CreatePopupMenu;
	AppendMenuW(lhMenu, MF_STRING or MF_CHECKED, IDM_STAYONTOP, '常に前面に表示(&A)');
	AppendMenuW(lhMenu, MF_STRING,               IDM_MINIMIZE,  '最小化(&N)');
	AppendMenuW(lhMenu, MF_SEPARATOR, 0, nil);
	AppendMenuW(lhMenu, MF_STRING, IDM_EXIT, '終了(&X)');

	UpDateWindow(lh_Window);

	while (GetMessageW(lr_Msg, 0, 0, 0)) do begin
		TranslateMessage(lr_Msg);
		DispatchMessageW(lr_Msg);
	end;

	DestroyMenu(lhMenu);
	DestroyWindow(lh_Window);

	Halt(lr_Msg.wParam);
end.