Microsoft MonthView Control

[José Roca]

 
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)).

Code Select Expand


' ########################################################################################
' 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
' ========================================================================================