XProfan

Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
Datum: DateEdit erstellen (ohne XProfan)
DEF DTP_GETSYSTEMTIME(2) SendMessage(&(1),4097,0,&(2))
Declare DateTimePick#,Meldung$,DateButton&
Def @InitCommonControlsEx(1) !COMCTL32,InitCommonControlsEx
DEF @GetSysColor(1) !USER32,GetSysColor
Settruecolor 1
Declare CLASSNAME$,MonthHandle&,HWND&,Windowname#
Declare INITC#,OK&,MESS%,Zahl1&,Zahl2&
Windowstyle 31
Windowtitle DateTimePick
Window 0,0-640,440
CLS @getsyscolor(15)
LET OK&=@CREATEBUTTON(%HWND,OK,10,360,100,30)
LET DateButton&=@CREATEBUTTON(%HWND,Date,120,360,100,30)
LET HWND&=%HWND
DIM INITC#,8
long INITC#,0=8
long INITC#,4=$00000100
@InitCommonControlsEx(INITC#)
LET CLASSNAME$=SysDateTimePick32
LET MonthHandle&=@Control(CLASSNAME$,,$40000000+$10000000+$000D,20,20,200,20,HWND&,2500,%Hinstance,0)
Dispose initc#
Declare Systemtime#
Dim Systemtime#,16
Clear Systemtime#
Word Systemtime#,0=2006
Word Systemtime#,2=1
Word Systemtime#,6=31
@Sendmessage(MonthHandle&,$1002,0,Systemtime#)
Dispose Systemtime#

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$,Date,0)
        Dispose DateTimePick#

    Endif

wend