XProfan

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

while 1

    getmessage

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

        print "OK"

    endif

wend

end

 {$iq}
Declare dc#, dcl&
Dim dc#,4
LONG dc#,0 = 0
dcl&= addr(dc#)
declare dtp#
dim dtp#,20
Declare date$
usermessages 3000
Window 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()

while 1

    Waitinput

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

        SendMessage(cal&,~MCM_GETCURSEL,0,dtp#)
        date$ = stature$("00",word(dtp#,6)) + "." +stature$("00",word(dtp#,2)) + "." + stature$("0000",word(dtp#,0))
        LONG dc#,0 = 0
        break

    ElseIf %wmtimer

        LONG dc#,0 = 0

    EndIf

EndWhile

killtimer
dispose dtp#
dispose dc#
print date$
waitkey
End
'**********************************************************************************************************

nProc calProc

    parameters Wnd&, Msg&, wParam&, lParam&
    global dcl&

    if Msg& =  ~WM_LBUTTONDOWN

        IF LONG(dcl&,0)=0

            LONG dcl&,0 = 1

        Else

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

        EndIf

    endif

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

ENDPROC