''
'' calendar demo, code by zydon (...@...)
''

#include once "windows.bi"
#include once "win/commctrl.bi"

	dim shared hInstance as HINSTANCE
	dim shared calClass as string
	dim shared hCal as HWND

    hInstance = GetModuleHandle( NULL )
    calClass = MONTHCAL_CLASS

	dim iccx as INITCOMMONCONTROLSEX
	iccx.dwSize = len( iccx )
	iccx.dwICC  = ICC_DATE_CLASSES
	InitCommonControlsEx( @iccx )



''
'' Window Procedure Handler
''
function WndProc ( byval hWnd as HWND, _
                   byval uMsg as UINT, _
                   byval wParam as WPARAM, _
                   byval lParam as LPARAM ) as integer

    function = 0

    select case ( uMsg )
    case WM_CREATE
		hCal = CreateWindowEx( 0, _
                               calClass, "", _
                               WS_CHILD or WS_VISIBLE, _
                               2, 2, 200, 160, _
                               hWnd, null, _
                               hInstance, null )

	case WM_KEYDOWN
		if( lobyte( wParam ) = 27 ) then
			PostMessage( hWnd, WM_CLOSE, 0, 0 )
        end if

	case WM_DESTROY
    	PostQuitMessage( 0 )
        exit function
    end select

    function = DefWindowProc( hWnd, uMsg, wParam, lParam )

end function


	''
	'' Program entry
	''
	dim wMsg as MSG
	dim wcls as WNDCLASS
	dim hWnd as HWND

	dim appName as string
    appName = "WinCal32"

	with wcls
		.style         = CS_HREDRAW or CS_VREDRAW
		.lpfnWndProc   = cast( WNDPROC, @WndProc )
		.cbClsExtra    = 0
		.cbWndExtra    = 0
		.hInstance     = hInstance
		.hIcon         = LoadIcon( null, IDI_APPLICATION )
		.hCursor       = LoadCursor( null, IDC_ARROW )
		.hbrBackground = cast( HGDIOBJ, 6 )  ' default color
		.lpszMenuName  = null
		.lpszClassName = strptr( appName )
	end with

	if( RegisterClass( @wcls ) = FALSE ) then
   		MessageBox( null, "Failed to register wcls!", appName, MB_ICONERROR )
   		end 1
	end if

	hWnd = CreateWindowEx( 0, _
						   appName, "Calendar Demo [ESC to Quit]", _
						   WS_CLIPCHILDREN or WS_DLGFRAME or WS_BORDER or WS_VISIBLE, _
						   200, 200, 210, 190, _
						   null, null, hInstance, null )


	''
	'' messages loop
	''
	do until( GetMessage( @wMsg, null, 0, 0 ) = FALSE )
		TranslateMessage( @wMsg )
		DispatchMessage( @wMsg )
	loop

	end 0
