#Include "windows.bi"
#Include "win\commdlg.bi"

#Include "resource.bi"

Const As String g_szClassName = "myWindowClass"

Dim Shared As HMODULE hInstance
Dim Shared As ZString Ptr lpCmdLine

Dim Shared As HFONT g_hfFont = NULL
Dim Shared As BOOL g_bOpaque = TRUE
Dim Shared As COLORREF g_rgbText = RGBA(0, 0, 0, 0)
Dim Shared As COLORREF g_rgbBackground = RGBA(255, 255, 255, 0)

'Dim As COLORREF g_rgbCustom[16] = {0};
Dim Shared As COLORREF g_rgbCustom(15)

Sub DoSelectFont(hwnd As HWND)
	Dim As CHOOSEFONT cf
	Dim As LOGFONT lf

	GetObject(g_hfFont, SizeOf(LOGFONT), @lf)

	cf.lStructSize = SizeOf(CHOOSEFONT)
	cf.Flags = CF_EFFECTS Or CF_INITTOLOGFONTSTRUCT Or CF_SCREENFONTS
	cf.hwndOwner = hwnd
	cf.lpLogFont = @lf
	cf.rgbColors = g_rgbText

	If ChooseFont(@cf) Then
		Dim As HFONT hf = CreateFontIndirect(@lf)
		If hf Then
			g_hfFont = hf
		Else
			MessageBox(hwnd, "Font creation failed!", "Error", MB_OK Or MB_ICONEXCLAMATION)
		EndIf

		g_rgbText = cf.rgbColors
	EndIf
End Sub

Sub DoSelectColour(hwnd As HWND)
	Dim As CHOOSECOLOR cc

	cc.lStructSize = SizeOf(CHOOSECOLOR)
	cc.Flags = CC_RGBINIT Or CC_FULLOPEN Or CC_ANYCOLOR
	cc.hwndOwner = hwnd
	cc.rgbResult = g_rgbBackground
	cc.lpCustColors = @g_rgbCustom(0)

	If ChooseColor(@cc) Then 
		g_rgbBackground = cc.rgbResult
	EndIf
End Sub

Sub DrawClientSize(hdc As HDC, prc As RECT Ptr, hf As HFONT)
	Dim As ZString*100 szSize
	Dim As String szTitle = "These are the dimensions of your client area:"
	Dim As HFONT hfOld = Cast(HFONT, SelectObject(hdc, hf))

	SetBkColor(hdc, g_rgbBackground)
	SetTextColor(hdc, g_rgbText)

	If g_bOpaque Then
		SetBkMode(hdc, OPAQUE)
	Else
		SetBkMode(hdc, TRANSPARENT)
	EndIf

	DrawText(hdc, szTitle, -1, prc, DT_WORDBREAK)

	wsprintf(szSize, "{%d, %d, %d, %d}", prc->Left, prc->top, prc->Right, prc->bottom)
	DrawText(hdc, szSize, -1, prc, DT_SINGLELINE Or DT_CENTER Or DT_VCENTER)

	SelectObject(hdc, hfOld)
End Sub

Function WndProc(hwnd As HWND, msg As UINT, wParam As WPARAM, lParam As LPARAM) As LRESULT
	Select Case msg
		Case WM_CREATE
			g_hfFont = Cast(HFONT, GetStockObject(DEFAULT_GUI_FONT))
	
		Case WM_CLOSE
			DestroyWindow(hwnd)
	
		Case WM_COMMAND
			Select Case LoWord(wParam)
				Case ID_FILE_EXIT
					PostMessage(hwnd, WM_CLOSE, 0, 0)
			
				Case ID_FORMAT_FONT
					DoSelectFont(hwnd)

					InvalidateRect(hwnd, NULL, TRUE)
					UpdateWindow(hwnd)
				
				Case ID_FORMAT_DEFAULTGUIFONT
					DeleteObject(g_hfFont)
					g_hfFont = Cast(HFONT, GetStockObject(DEFAULT_GUI_FONT))
					
					InvalidateRect(hwnd, NULL, TRUE)
					UpdateWindow(hwnd)
			
				Case ID_FORMAT_TEST
					Dim As HFONT hf
					Dim As HDC hdc
					Dim As Long lfHeight
					
					hdc = GetDC(NULL)
					lfHeight = -MulDiv(12, GetDeviceCaps(hdc, LOGPIXELSY), 72)
					ReleaseDC(NULL, hdc)

					hf = CreateFont(lfHeight, 0, 0, 0, 0, TRUE, 0, 0, 0, 0, 0, 0, 0, "Times New Roman")

					If hf Then
						DeleteObject(g_hfFont)
						g_hfFont = hf
					Else
						MessageBox(hwnd, "Font creation failed!", "Error", MB_OK Or MB_ICONEXCLAMATION)
					EndIf					
					InvalidateRect(hwnd, NULL, TRUE)
					UpdateWindow(hwnd)
				
				Case ID_FORMAT_BACKGROUNDCOLOUR
					DoSelectColour(hwnd)

					InvalidateRect(hwnd, NULL, TRUE)
					UpdateWindow(hwnd)
				
				Case ID_FORMAT_OPAQUE
					g_bOpaque = Not g_bOpaque

					InvalidateRect(hwnd, NULL, TRUE)
					UpdateWindow(hwnd)
				
			End Select
		
		Case WM_INITMENUPOPUP
			CheckMenuItem(Cast(HMENU, wParam), ID_FORMAT_OPAQUE, MF_BYCOMMAND Or ( IIf(g_bOpaque, MF_CHECKED, MF_UNCHECKED)))
		
		Case WM_PAINT
			Dim As RECT rcClient
			Dim As PAINTSTRUCT ps
			Dim As HDC hdc = BeginPaint(hwnd, @ps)

			GetClientRect(hwnd, @rcClient)

			DrawClientSize(hdc, @rcClient, g_hfFont)

			EndPaint(hwnd, @ps)
		
		Case WM_DESTROY
			DeleteObject(g_hfFont)

			PostQuitMessage(0)
		
		Case Else
			Return DefWindowProc(hwnd, msg, wParam, lParam)
	End Select
	Return 0
End Function

Function WinMain(hInstance As HINSTANCE, hPrevInstance As HINSTANCE, lpCmdLine As ZString Ptr, nCmdShow As Long) As Long
	Dim As WNDCLASSEX wc
	Dim As HWND hwnd
	Dim As MSG Msg

	wc.cbSize		     = SizeOf(WNDCLASSEX)
	wc.style		     = CS_VREDRAW Or CS_HREDRAW
	wc.lpfnWndProc	 = @WndProc
	wc.cbClsExtra	   = 0
	wc.cbWndExtra	   = 0
	wc.hInstance	   = hInstance
	wc.hIcon		     = LoadIcon(NULL, IDI_APPLICATION)
	wc.hCursor		   = LoadCursor(NULL, IDC_ARROW)
	wc.hbrBackground = Cast(HBRUSH, COLOR_WINDOW + 1)
	wc.lpszMenuName  = MAKEINTRESOURCE(IDR_MENU)
	wc.lpszClassName = @g_szClassName
	wc.hIconSm		   = LoadIcon(NULL, IDI_APPLICATION)

	If RegisterClassEx(@wc) = 0 Then
		MessageBox(NULL, "Window Registration Failed!", "Error!", MB_ICONEXCLAMATION Or MB_OK)
		Return 0
	EndIf

	hwnd = CreateWindowEx(WS_EX_CLIENTEDGE, _
		                    g_szClassName, _
		                    "A Font Program", _
		                    WS_OVERLAPPEDWINDOW, _
		                    CW_USEDEFAULT, CW_USEDEFAULT, 240, 120, _
		                    NULL, NULL, hInstance, NULL)

	If hwnd = NULL Then
		MessageBox(NULL, "Window Creation Failed!", "Error!", MB_ICONEXCLAMATION Or MB_OK)
		Return 0
	EndIf

	ShowWindow(hwnd, nCmdShow)
	UpdateWindow(hwnd)

	Do While GetMessage(@msg,NULL,0,0)
		TranslateMessage(@msg)
		DispatchMessage(@msg)
	Loop
	Return msg.wParam
End Function

' Program start
hInstance = GetModuleHandle(NULL)
lpCmdLine = GetCommandLine
WinMain(hInstance, NULL, lpCmdLine, SW_SHOWDEFAULT)
ExitProcess(0)