XProfan

 $H messages.ph
Fenêtre 100,300-600,500
Var cal&=Contrôle("SysMonthCal32",»,$54000000,200,40,178,194,%hwnd,0,%HINSTANCE,$1)

tandis que 1

    getmessage

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

        imprimer "OK"

    endif

Wend

end

 {$iq}
Déclarer dc#, dcl&
Faible dc#,4
LONG dc#,0 = 0
dcl&= addr(dc#)
declare dtp#
dim dtp#,20
Déclarer date$
usermessages 3000
Fenêtre 100,300-600,500
Var cal&=Contrôle("SysMonthCal32",»,$54000000,200,40,178,194,%hwnd,0,%HINSTANCE,$1)
~setWindowLong(cal&,~gwl_userData,~setWindowLong(cal&,~gwl_wndProc,procaddr(calProc,4)))
settimer ~GetDoubleClickTime()

tandis que 1

    Waitinput

    IF  (%umessage = 3000) or (%clé = 13)

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

    ElseIf %wmtimer

        LONG dc#,0 = 0

    EndIf

Endwhile

killtimer
dispose dtp#
dispose dc#
imprimer date$
waitkey
Fin
'**********************************************************************************************************

nProc calProc

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

    si Msg& =  ~WM_LBUTTONDOWN

        IF LONG(dcl&,0)=0

            LONG dcl&,0 = 1

        D'autre

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

        EndIf

    endif

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

ENDPROC