The following example demonstrates how to create an instance of the MonthView Control included in MSCOMCT2.OCX (Microsoft Windows Common Controls-2 6.0 (SP4)).
' ########################################################################################
' Test for the MonthView control
' ########################################################################################
' SED_PBWIN - Use the PBWIN compiler
#COMPILE EXE
#DIM ALL
#INCLUDE ONCE "OLECON.INC" ' // Ole Container
#INCLUDE ONCE "MSCOMCT2.INC" ' // Microsoft Windows Common Controls-2 6.0 (SP4)
%IDC_MONTHVIEW = 101
' ========================================================================================
' Main
' ========================================================================================
FUNCTION WINMAIN (BYVAL hInstance AS DWORD, BYVAL hPrevInstance AS DWORD, BYVAL lpszCmdLine AS ASCIIZ PTR, BYVAL nCmdShow AS LONG) AS LONG
LOCAL hWndMain AS DWORD
LOCAL hFont AS DWORD
LOCAL wcex AS WNDCLASSEX
LOCAL szClassName AS ASCIIZ * 80
LOCAL rc AS RECT
LOCAL szCaption AS ASCIIZ * 255
LOCAL nLeft AS LONG
LOCAL nTop AS LONG
LOCAL nWidth AS LONG
LOCAL nHeight AS LONG
' Required: Initialize the OLE Container
OC_WinInit
hFont = GetStockObject(%ANSI_VAR_FONT)
' Register the window class
szClassName = "MonthView"
wcex.cbSize = SIZEOF(wcex)
wcex.style = 0 '%CS_HREDRAW OR %CS_VREDRAW
wcex.lpfnWndProc = CODEPTR(WndProc)
wcex.cbClsExtra = 0
wcex.cbWndExtra = 0
wcex.hInstance = hInstance
wcex.hCursor = LoadCursor (%NULL, BYVAL %IDC_ARROW)
wcex.hbrBackground = %COLOR_3DFACE + 1
wcex.lpszMenuName = %NULL
wcex.lpszClassName = VARPTR(szClassName)
wcex.hIcon = LoadIcon (%NULL, BYVAL %IDI_APPLICATION) ' Sample, if resource icon: LoadIcon(hInst, "APPICON")
wcex.hIconSm = LoadIcon (%NULL, BYVAL %IDI_APPLICATION) ' Remember to set small icon too..
RegisterClassEx wcex
' Window caption
szCaption = "Monthview Demo"
' Retrieve the size of the working area
SystemParametersInfo %SPI_GETWORKAREA, 0, BYVAL VARPTR(rc), 0
' Calculate the position and size of the window
nWidth = (((rc.nRight - rc.nLeft)) + 2) * 0.75 ' 75% of the client screen width
nHeight = (((rc.nBottom - rc.nTop)) + 2) * 0.70 ' 70% of the client screen height
nLeft = ((rc.nRight - rc.nLeft) \ 2) - nWidth \ 2
nTop = ((rc.nBottom - rc.nTop) \ 2) - (nHeight \ 2)
' Create a window using the registered class
hWndMain = CreateWindowEx(%WS_EX_CONTROLPARENT, _ ' extended style
szClassName, _ ' window class name
szCaption, _ ' window caption
%WS_OVERLAPPEDWINDOW OR _
%WS_CLIPCHILDREN, _ ' window style
nLeft, _ ' initial x position
nTop, _ ' initial y position
nWidth, _ ' initial x size
nHeight, _ ' initial y size
%NULL, _ ' parent window handle
0, _ ' window menu handle
hInstance, _ ' program instance handle
BYVAL %NULL) ' creation parameters
' Show the window
ShowWindow hWndMain, nCmdShow
UpdateWindow hWndMain
' Message handler loop
LOCAL uMsg AS tagMsg
WHILE GetMessage(uMsg, %NULL, 0, 0)
IF ISFALSE OC_ForwardMessage(GetFocus, uMsg) THEN
IF IsDialogMessage(hWndMain, uMsg) = 0 THEN
TranslateMessage uMsg
DispatchMessage uMsg
END IF
END IF
WEND
FUNCTION = uMsg.wParam
END FUNCTION
' ========================================================================================
' ========================================================================================
' Main Window procedure
' ========================================================================================
FUNCTION WndProc (BYVAL hWnd AS DWORD, BYVAL wMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG
LOCAL hr AS LONG
LOCAL hCtrl AS DWORD
LOCAL rc AS RECT
LOCAL pMonthView AS MSComCtl2_IMonthView
STATIC pMonthViewEvents AS DMonthViewEventsImpl
SELECT CASE wMsg
CASE %WM_CREATE
' Get the coordinates of the main window client area
GetClientRect hWnd, rc
' Create an instance of the MonthView control
hCtrl = CreateWindowEx(0, $OC_CLASSNAME, _
"MSComCtl2.MonthView.2;RTLKEY:651A8940-87C5-11d1-8BE3-0000F8754DA1", _
%WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP, 0, 0, 0, 0, hWnd, %IDC_MONTHVIEW, GetModuleHandle(""), BYVAL %NULL)
' Set the focus in the control
SetFocus hCtrl
' Get a pointer to the IMonthView interface
pMonthView = OC_GetDispatch(hCtrl)
' Connect events
IF ISOBJECT(pMonthView) THEN
pMonthViewEvents = CLASS "CDMonthViewEvents"
IF ISOBJECT(pMonthViewEvents) THEN
EVENTS FROM pMonthView CALL pMonthViewEvents
END IF
' Release the interface
pMonthView = NOTHING
END IF
CASE %WM_SIZE
' Resizes the control
IF wParam <> %SIZE_MINIMIZED THEN
GetClientRect hWnd, rc
MoveWindow GetDlgItem(hWnd, %IDC_MONTHVIEW), 0, 0, rc.nRight - rc.nLeft, rc.nBottom - rc.nTop, %TRUE
END IF
CASE %WM_COMMAND
SELECT CASE LO(WORD, wParam)
CASE %IDCANCEL
IF HI(WORD, wParam) = %BN_CLICKED THEN
SendMessage hWnd, %WM_CLOSE, 0, 0
EXIT FUNCTION
END IF
END SELECT
CASE %WM_SYSCOMMAND
' Capture this message and send a WM_CLOSE message
IF (wParam AND &HFFF0) = %SC_CLOSE THEN
SendMessage hWnd, %WM_CLOSE, 0, 0
EXIT FUNCTION
END IF
CASE %WM_DESTROY
' Disconnect events
IF ISOBJECT(pMonthViewEvents) THEN
EVENTS END pMonthViewEvents
pMonthViewEvents = NOTHING
END IF
PostQuitMessage 0
EXIT FUNCTION
END SELECT
FUNCTION = DefWindowProc(hWnd, wMsg, wParam, lParam)
END FUNCTION
' ========================================================================================
' ########################################################################################
' Class CDMonthViewEvents
' Interface name = DMonthViewEvents
' IID = {232E4569-87C3-11D1-8BE3-0000F8754DA1}
' Attributes = 4112 [&H1010] [Hidden] [Dispatchable]
' Code generated by the TypeLib Browser 4.0.10 (c) 2008 by José Roca
' Date: 10 sep 2008 Time: 18:58:10
' ########################################################################################
CLASS CDMonthViewEvents GUID$("{9F1994AC-39EB-4F7E-90B7-205B285F840F}") AS EVENT
INTERFACE DMonthViewEventsImpl GUID$("{232E4569-87C3-11D1-8BE3-0000F8754DA1}") AS EVENT
INHERIT IDispatch
' =====================================================================================
METHOD DateClick <1> ( _
BYVAL DateClicked AS DOUBLE _ ' __in Date DateClicked
) ' void
' *** Insert your code here ***
END METHOD
' =====================================================================================
' =====================================================================================
METHOD DateDblClick <2> ( _
BYVAL DateDblClicked AS DOUBLE _ ' __in Date DateDblClicked
) ' void
' *** Insert your code here ***
END METHOD
' =====================================================================================
' =====================================================================================
METHOD GetDayBold <3> ( _
BYVAL StartDate AS DOUBLE _ ' __in date StartDate
, BYVAL iCount AS INTEGER _ ' __in short Count
, BYREF pState AS DWORD _ ' __in_out SAFEARRAY *State
) ' void
' *** Insert your code here ***
END METHOD
' =====================================================================================
' =====================================================================================
METHOD SelChange <4> ( _
BYVAL StartDate AS DOUBLE _ ' __in Date StartDate
, BYVAL EndDate AS DOUBLE _ ' __in Date EndDate
, BYREF iCancel AS INTEGER _ ' __out VARIANT_BOOL* Cancel
) ' void
' *** Insert your code here ***
END METHOD
' =====================================================================================
' =====================================================================================
METHOD Click <-600>
' *** Insert your code here ***
END METHOD
' =====================================================================================
' =====================================================================================
METHOD DblClick <-601>
' *** Insert your code here ***
' Sample code
' LOCAL hCtrl AS DWORD
' hCtrl = GetFocus
' MSGBOX "DblClick"
' SetFocus hCtrl
END METHOD
' =====================================================================================
' =====================================================================================
METHOD KeyDown <-602> ( _
BYREF KeyCode AS INTEGER _ ' __in_out short* KeyCode
, BYVAL iShift AS INTEGER _ ' __in short Shift
) ' void
' *** Insert your code here ***
END METHOD
' =====================================================================================
' =====================================================================================
METHOD KeyUp <-604> ( _
BYREF KeyCode AS INTEGER _ ' __in_out short* KeyCode
, BYVAL iShift AS INTEGER _ ' __in short Shift
) ' void
' *** Insert your code here ***
END METHOD
' =====================================================================================
' =====================================================================================
METHOD KeyPress <-603> ( _
BYREF KeyAscii AS INTEGER _ ' __in_out short* KeyAscii
) ' void
' *** Insert your code here ***
END METHOD
' =====================================================================================
' =====================================================================================
METHOD MouseDown <-605> ( _
BYVAL iButton AS INTEGER _ ' __in short Button
, BYVAL iShift AS INTEGER _ ' __in short Shift
, BYVAL x AS LONG _ ' __in OLE_XPOS_PIXELS x
, BYVAL y AS LONG _ ' __in OLE_YPOS_PIXELS y
) ' void
' *** Insert your code here ***
END METHOD
' =====================================================================================
' =====================================================================================
METHOD MouseMove <-606> ( _
BYVAL iButton AS INTEGER _ ' __in short Button
, BYVAL iShift AS INTEGER _ ' __in short Shift
, BYVAL x AS LONG _ ' __in OLE_XPOS_PIXELS x
, BYVAL y AS LONG _ ' __in OLE_YPOS_PIXELS y
) ' void
' *** Insert your code here ***
END METHOD
' =====================================================================================
' =====================================================================================
METHOD MouseUp <-607> ( _
BYVAL iButton AS INTEGER _ ' __in short Button
, BYVAL iShift AS INTEGER _ ' __in short Shift
, BYVAL x AS LONG _ ' __in OLE_XPOS_PIXELS x
, BYVAL y AS LONG _ ' __in OLE_YPOS_PIXELS y
) ' void
' *** Insert your code here ***
END METHOD
' =====================================================================================
' =====================================================================================
METHOD OLEStartDrag <1550> ( _
BYREF pData AS IDispatch _ ' __in_out DataObject** Data
, BYREF AllowedEffects AS LONG _ ' __in_out long *AllowedEffects
) ' void
' *** Insert your code here ***
END METHOD
' =====================================================================================
' =====================================================================================
METHOD OLEGiveFeedback <1551> ( _
BYREF Effect AS LONG _ ' __in_out long* Effect
, BYREF DefaultCursors AS INTEGER _ ' __in_out VARIANT_BOOL* DefaultCursors
) ' void
' *** Insert your code here ***
END METHOD
' =====================================================================================
' =====================================================================================
METHOD OLESetData <1552> ( _
BYREF pData AS IDispatch _ ' __in_out DataObject** Data
, BYREF DataFormat AS INTEGER _ ' __in_out short *DataFormat
) ' void
' *** Insert your code here ***
END METHOD
' =====================================================================================
' =====================================================================================
METHOD OLECompleteDrag <1553> ( _
BYREF Effect AS LONG _ ' __in_out long *Effect
) ' void
' *** Insert your code here ***
END METHOD
' =====================================================================================
' =====================================================================================
METHOD OLEDragOver <1554> ( _
BYREF pData AS IDispatch _ ' __in_out DataObject** Data
, BYREF Effect AS LONG _ ' __in_out long* Effect
, BYREF iButton AS INTEGER _ ' __in_out short* Button
, BYREF iShift AS INTEGER _ ' __in_out short* Shift
, BYREF x AS SINGLE _ ' __in_out float* x
, BYREF y AS SINGLE _ ' __in_out float* y
, BYREF iState AS INTEGER _ ' __in_out short* State
) ' void
' *** Insert your code here ***
END METHOD
' =====================================================================================
' =====================================================================================
METHOD OLEDragDrop <1555> ( _
BYREF pData AS IDispatch _ ' __in_out DataObject** Data
, BYREF Effect AS LONG _ ' __in_out long* Effect
, BYREF iButton AS INTEGER _ ' __in_out short* Button
, BYREF iShift AS INTEGER _ ' __in_out short* Shift
, BYREF x AS SINGLE _ ' __in_out float* x
, BYREF y AS SINGLE _ ' __in_out float* y
) ' void
' *** Insert your code here ***
END METHOD
' =====================================================================================
END INTERFACE
END CLASS
' ========================================================================================