XProfan

 $H messages.ph
Ventana 100,300-600,500
Var cal&=Control("SysMonthCal32","",$54000000,200,40,178,194,%hwnd,0,%hInstance,$1)

mientras que 1

    getmessage

    IF (%mensaje = ~WM_LBUTTONDBLCLK) and (%mwnd = cal&)

        imprimir "OK"

    endif

wend

end

 {$iq}
Declarar dc#, dcl&
Dim dc#,4
LONG dc#,0 = 0
dcl&= addr(dc#)
declarar dtp#
dim dtp#,20
Declarar datum$
usermessages 3000
Ventana 100,300-600,500
Var cal&=Control("SysMonthCal32","",$54000000,200,40,178,194,%hwnd,0,%hInstance,$1)
~setWindowLong(cal&,~gwl_userData,~setWindowLong(cal&,~gwl_wndProc,procaddr(calProc,4)))
settimer ~GetDoubleClickTime()

mientras que 1

    Waitinput

    IF  (%umessage = 3000) or (%key = 13)

        SendMessage(cal&,~MCM_GETCURSEL,0,dtp#)
        datum$ = format$("00",word(dtp#,6)) + "." +format$("00",word(dtp#,2)) + "." + format$("0000",word(dtp#,0))
        LONG dc#,0 = 0
        romper

    ElseIf %wmtimer

        LONG dc#,0 = 0

    EndIf

EndWhile

killtimer
disponer dtp#
disponer dc#
imprimir datum$
waitkey
End
'**********************************************************************************************************

nProc calProc

    parámetros Wnd&, Msg&, wParam&, lParam&
    global dcl&

    if Msg& =  ~WM_LBUTTONDOWN

        IF LONG(dcl&,0)=0

            LONG dcl&,0 = 1

        Más

            sendmessage(~getparent(wnd&),3000,0,0)
            Volver 0

        EndIf

    endif

    volver ~callWindowProc(~getWindowLong(wnd&,~gwl_userData),Wnd&, Msg&, wParam&, lParam&)

ENDPROC