Microsoft Date Time Picker Control

[José Roca]

 
The following example demonstrates how to create an instance of the Date Time Picker Control included in MSCOMCT2.OCX (Microsoft Windows Common Controls-2 6.0 (SP4)).

Code Select Expand


' ########################################################################################
' Demonstrates the use of the Date Time Picker control included in MSCOMCT2.OCX.
' ########################################################################################

' SED_PBWIN - Use the PBWIN compiler
#COMPILE EXE
#DIM ALL
#INCLUDE "MSCOMCT2.INC"
#INCLUDE "OLECON.INC"

%IDC_DTPICKER = 1001

' ========================================================================================
' 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 hCtl        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        = "DateTimePickerClass"
   wcex.cbSize        = SIZEOF(wcex)
   wcex.style         = %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 = "Microsoft Date Time Picker Control"

   ' 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.60
   nHeight = (((rc.nBottom - rc.nTop)) + 2) * 0.50
   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

   hCtl = CreateWindowEx(0, "BUTTON", "&Close", %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %BS_FLAT, _
          0, 0, 0, 0, hWndMain, %IDCANCEL, hInstance, BYVAL %NULL)
   IF hFont THEN SendMessage hCtl, %WM_SETFONT, hFont, 0

   ' 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 rc AS RECT
   LOCAL hCtl AS DWORD
   LOCAL hr AS DWORD
   LOCAL pDTPicker AS MSComCtl2_IDTPicker
   STATIC pDTPickerEvents AS DDTPickerEventsImpl

   SELECT CASE wMsg

      CASE %WM_CREATE
         ' Create an instance of the Date Time Picker control
         hCtl = CreateWindowEx(0, $OC_CLASSNAME, _
                "MSComCtl2.DTPicker.2;RTLKEY:651A8940-87C5-11d1-8BE3-0000F8754DA1", _
                %WS_CHILD OR %WS_VISIBLE, 0, 0, 0, 0, hWnd, %IDC_DTPICKER, GetModuleHandle(""), BYVAL %NULL)
         ' Retrieve the IDispatch of the control
         pDTPicker = OC_GetDispatch(hCtl)
         IF ISOBJECT(pDTPicker) THEN
            ' Connect events
            pDTPickerEvents = CLASS "CDDTPickerEvents"
            EVENTS FROM pDTPicker CALL pDTPickerEvents
            pDTPicker.CheckBox = -1
            ' Release the interface
            pDTPicker = NOTHING
         END IF

      CASE %WM_SIZE
         IF wParam <> %SIZE_MINIMIZED THEN
            GetClientRect hWnd, rc
            MoveWindow GetDlgItem(hWnd, %IDCANCEL), (rc.nRight - rc.nLeft) - 95, (rc.nBottom - rc.nTop) - 35, 75, 23, %TRUE
            MoveWindow GetDlgItem(hWnd, %IDC_DTPICKER), 150, 70, 182, 20, %TRUE
         END IF

      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_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_DESTROY
         ' Disconnect events
         EVENTS END pDTPickerEvents
         pDTPickerEvents = NOTHING
         PostQuitMessage 0
         EXIT FUNCTION

   END SELECT

   FUNCTION = DefWindowProc(hWnd, wMsg, wParam, lParam)

END FUNCTION
' ========================================================================================

' ########################################################################################
' Class CDDTPickerEvents
' Interface name = DDTPickerEvents
' IID = {20DD1B9D-87C4-11D1-8BE3-0000F8754DA1}
' Attributes = 4112 [&H1010] [Hidden] [Dispatchable]
' ########################################################################################

CLASS CDDTPickerEvents GUID$("{0D4147F9-6B2E-4180-ACA7-DEE1A598E2C5}") AS EVENT

INTERFACE DDTPickerEventsImpl GUID$("{20DD1B9D-87C4-11D1-8BE3-0000F8754DA1}") AS EVENT

  INHERIT IDispatch

   ' =====================================================================================
   METHOD CallbackKeyDown <1> ( _
     BYVAL KeyCode AS INTEGER _                         ' [in] KeyCode VT_I2 <Integer>
   , BYVAL iShift AS INTEGER _                          ' [in] Shift VT_I2 <Integer>
   , BYVAL CallbackField AS STRING _                    ' [in] CallbackField VT_BSTR
   , BYREF CallbackDate AS DOUBLE _                     ' [in][out] *CallbackDate VT_DATE <Double>
   )                                                    ' VOID

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD Change <2>

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD CloseUp <3>

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD DropDown <4>

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD Format <5> ( _
     BYVAL CallbackField AS STRING _                    ' [in] CallbackField VT_BSTR
   , BYREF FormattedString AS STRING _                  ' [out] *FormattedString VT_BSTR
   )                                                    ' VOID

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD FormatSize <6> ( _
     BYVAL CallbackField AS STRING _                    ' [in] CallbackField VT_BSTR
   , BYREF iSize AS INTEGER _                           ' [out] *Size VT_I2 <Integer>
   )                                                    ' VOID

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD Click <-600>

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD DblClick <-601>

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD KeyDown <-602> ( _
     BYREF KeyCode AS INTEGER _                         ' *KeyCode VT_I2 <Integer>
   , BYVAL iShift AS INTEGER _                          ' Shift VT_I2 <Integer>
   )                                                    ' VOID

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD KeyUp <-604> ( _
     BYREF KeyCode AS INTEGER _                         ' *KeyCode VT_I2 <Integer>
   , BYVAL iShift AS INTEGER _                          ' Shift VT_I2 <Integer>
   )                                                    ' VOID

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD KeyPress <-603> ( _
     BYREF KeyAscii AS INTEGER _                        ' *KeyAscii VT_I2 <Integer>
   )                                                    ' VOID

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD MouseDown <-605> ( _
     BYVAL iButton AS INTEGER _                         ' Button VT_I2 <Integer>
   , BYVAL iShift AS INTEGER _                          ' Shift VT_I2 <Integer>
   , BYVAL x AS LONG _                                  ' x OLE_XPOS_PIXELS <alias> <VT_I4>
   , BYVAL y AS LONG _                                  ' y OLE_YPOS_PIXELS <alias> <VT_I4>
   )                                                    ' VOID

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD MouseMove <-606> ( _
     BYVAL iButton AS INTEGER _                         ' Button VT_I2 <Integer>
   , BYVAL iShift AS INTEGER _                          ' Shift VT_I2 <Integer>
   , BYVAL x AS LONG _                                  ' x OLE_XPOS_PIXELS <alias> <VT_I4>
   , BYVAL y AS LONG _                                  ' y OLE_YPOS_PIXELS <alias> <VT_I4>
   )                                                    ' VOID

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD MouseUp <-607> ( _
     BYVAL iButton AS INTEGER _                         ' Button VT_I2 <Integer>
   , BYVAL iShift AS INTEGER _                          ' Shift VT_I2 <Integer>
   , BYVAL x AS LONG _                                  ' x OLE_XPOS_PIXELS <alias> <VT_I4>
   , BYVAL y AS LONG _                                  ' y OLE_YPOS_PIXELS <alias> <VT_I4>
   )                                                    ' VOID

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD OLEStartDrag <1550> ( _
     BYREF pData AS IDispatch _                         ' [in][out] **Data DataObject <coclass>
   , BYREF AllowedEffects AS LONG _                     ' [in][out] *AllowedEffects VT_I4 <Long>
   )                                                    ' VOID

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD OLEGiveFeedback <1551> ( _
     BYREF Effect AS LONG _                             ' [in][out] *Effect VT_I4 <Long>
   , BYREF DefaultCursors AS INTEGER _                  ' [in][out] *DefaultCursors VT_BOOL <Integer>
   )                                                    ' VOID

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD OLESetData <1552> ( _
     BYREF pData AS IDispatch _                         ' [in][out] **Data DataObject <coclass>
   , BYREF DataFormat AS INTEGER _                      ' [in][out] *DataFormat VT_I2 <Integer>
   )                                                    ' VOID

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD OLECompleteDrag <1553> ( _
     BYREF Effect AS LONG _                             ' [in][out] *Effect VT_I4 <Long>
   )                                                    ' VOID

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD OLEDragOver <1554> ( _
     BYREF pData AS IDispatch _                         ' [in][out] **Data DataObject <coclass>
   , BYREF Effect AS LONG _                             ' [in][out] *Effect VT_I4 <Long>
   , BYREF iButton AS INTEGER _                         ' [in][out] *Button VT_I2 <Integer>
   , BYREF iShift AS INTEGER _                          ' [in][out] *Shift VT_I2 <Integer>
   , BYREF x AS SINGLE _                                ' [in][out] *x VT_R4 <Single>
   , BYREF y AS SINGLE _                                ' [in][out] *y VT_R4 <Single>
   , BYREF iState AS INTEGER _                           ' [in][out] *State VT_I2 <Integer>
   )                                                    ' VOID

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD OLEDragDrop <1555> ( _
     BYREF pData AS IDispatch _                         ' [in][out] **Data DataObject <coclass>
   , BYREF Effect AS LONG _                             ' [in][out] *Effect VT_I4 <Long>
   , BYREF iButton AS INTEGER _                         ' [in][out] *Button VT_I2 <Integer>
   , BYREF iShift AS INTEGER _                          ' [in][out] *Shift VT_I2 <Integer>
   , BYREF x AS SINGLE _                                ' [in][out] *x VT_R4 <Single>
   , BYREF y AS SINGLE _                                ' [in][out] *y VT_R4 <Single>
   )                                                    ' VOID

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

END INTERFACE

END CLASS