XProfan

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

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"
DEF @GetFileVersion(4) ! "Version","GetFileVersionInfoA"
Settruecolor 1

Proc GetVersion

    Declare Version!,FileName#,Data#
    Parameters Datei$
    Dim FileName#,Len(datei$)
    Dim Data#,56
    String FileName#,0=Datei$
    @GetFileVersion(FileName#,0,56,Data#)
    Let Version! = add(word(Data#,50),div(word(Data#,48),100))
    Return Version!
    Dispose FileName#
    Dispose Data#

EndProc

Declare CLASSNAME$,MonthHandle&,HWND&,Windowname#
Declare INITC#,DateButton2&,MESS%,Zahl1&,Zahl2&,DateTimePick#
Windowstyle 31
Windowtitle "DateTimePick"
Window 0,0-640,440
CLS @getsyscolor(15)
LET DateButton&=@CREATEBUTTON(%HWND,"Datum 1",10,360,100,30)
LET DateButton2&=@CREATEBUTTON(%HWND,"Datum 2",120,360,100,30)
LET HWND&=%HWND
GetVersion "COMCTL32.DLL"

IF @!(0)<4.7

    @messagebox("Control nicht verfügbar! Machen Sie ein Update der COMCTL32.DLL auf eine neuere Version!","Falsche DLL-Version!",16)
    END

endif

DIM INITC#,8
long INITC#,0=8
long INITC#,4=$00000100
@InitCommonControlsEx(INITC#)
LET CLASSNAME$="SysDateTimePick32"
LET MonthHandle&=@CreateWindowEx(0,@addr(CLASSNAME$),0,$40000000+$10000000,20,20,80,20,HWND&,0,%Hinstance,0)
Dispose initc#

While 0=0

    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$,"Eingestelltes Datum:",64)
        Dispose DateTimePick#

    elseif GetFocus(DateButton2&)

        Let Meldung$=@gettext$(MonthHandle&)
        @MessageBox("Datum: "+Meldung$+" !","Eingestelltes Datum:",64)

    Endif

wend