XProfan

Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
Kalender-Control erstellen
DEF DTP_GETSYSTEMTIME(2) SendMessage(&(1),4097,0,&(2))
Declare DateTimePick#,Meldung$,DateButton&
Def @InitCommonControlsEx(1) !COMCTL32,InitCommonControlsEx
DEf @CreateWindowEx(12) !USER32,CreateWindowExA
DEF @GetSysColor(1) !USER32,GetSysColor
Settruecolor 1
Declare CLASSNAME$,MonthHandle&,HWND&,Windowname#
Declare INITC#,OK&,MESS%,Zahl1&,Zahl2&,DateTimePick#
Windowstyle 31
Windowtitle KalenderControl
Window 0,0-640,440
CLS @getsyscolor(15)
LET OK&=@CREATEBUTTON(%HWND,OK,10,360,100,30)
LET DateButton&=@CREATEBUTTON(%HWND,Datum,120,360,100,30)
LET HWND&=%HWND
DIM INITC#,8
long INITC#,0=8
long INITC#,4=$00000100
@InitCommonControlsEx(INITC#)
LET CLASSNAME$=SysMonthCal32
LET MonthHandle&=@CreateWindowEx(0,@addr(CLASSNAME$),0,$40000000+$10000000,20,20,300 ,300,HWND&,0,%Hinstance,0)
Dispose initc#

Whilenot @getfocus(OK&)

    Waitinput

    If GetFocus(DateButton&)

        Dim DateTimePick#,20
        DTP_GETSYSTEMTIME(MonthHandle&,DateTimePick#)
        Let Meldung$ = Str$(word(DateTimePick#,6));.;Str$(word(DateTimePick#,2));.;Str$(word(DateTimePick#,0))
        @MessageBox(Meldung$,Datum,0)
        Dispose DateTimePick#

    Endif

wend