XProfan

Deutsch

Rainer
Hoefs

Hallo zusammen,

habe da eine Bitte,

ich möchte aus einem Kalender (mit SysMonthCal32 erstellt) das Datum auslesen.

Habe schon gesucht und gesucht und gesucht...
aber leider nichts gefunden.

Kann mir bitte jemand helfen?

Danke im voraus
Rainer

Kompilieren Markieren Separieren

' Code erzeugt mit F.Abbing's LemonViD Version 1.0.0.3 am 19.04.2016 um 12:59 Uhr,
' Spenden-Button, sowie weitere Freeware-Tools für XProfan auf https://frabbing.net
' Technischer Support auf ./../../sys/?nohdr=1&u=www.paules-pc-forum.de/forum/xprofan und https://purebasic.fr/german
' --------------------------------------------------------------------------------------------------
Declare nurso%, dialog1%, button1%, button2%, calendar1%
Def GetStockObject(1) !"GDI32","GetStockObject"
Def GetSysColor(1) !"USER32","GetSysColor"
Def GetParent(1) !"USER32","GetParent"
Def GetDlgCtrlID(1) !"USER32","GetDlgCtrlID"
Def &COLOR_BTNFACE $F
Def &DEFAULT_GUI_FONT $11
Def &WM_COMMAND $111

Proc CreateElements

    WindowStyle 10 | 512 | 2048
    WindowTitle "Arbeitsfenster"
    Window 280, 0 - 474, 434
    Cls GetSysColor(&COLOR_BTNFACE)
    SetDialogFont GetStockObject(&DEFAULT_GUI_FONT)
    dialog1% = Create("Dialog", %hwnd, "dialog", 64, 40, 224, 280)
    calendar1% = Control("SysMonthCal32", "", $54000000, 8, 13, 200, 200, dialog1%, $4000, %hInstance, 0)
    button2% = Create("Button", dialog1%, "Abbrechen", 112, 221, 96, 24)
    button1% = Create("Button", dialog1%, "Datum lesen", 8, 221, 96, 24)

EndProc

SubClassProc

    Select %smessage

        CaseOf $114, $115

        SendMessage(%hwnd, %smessage, &swparam, &slparam)

        CaseOf $101, $202, $205, $208

        SendMessage(%hwnd, &WM_COMMAND, MakeLong(GetDlgCtrlID(&swnd), 0), &swnd)

    EndSelect

Endproc

Proc MainLoop

    UserMessages 16
    ShowWindow(%hwnd, 1)
    Subclass calendar1%, 1

    While 1

        WaitInput
        Case ((%umessage = 16) And (&uwnd = %hwnd)) : BREAK

        If Clicked(button1%)'dialog1% -> #window

        ElseIf Clicked(button2%)'dialog1% -> #window

        ElseIf Clicked(calendar1%)'dialog1% -> #window

        EndIf

    EndWhile

    Subclass calendar1%, 0

EndProc

Proc Main

    CreateElements
    MainLoop

EndProc

Main
End

FreeProfan

19.04.2016 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

RGH

Ich habe mal eine Funktion "GetDate" eingebaut, mit der das aktuell gewählte Datum ausgelesen werden kann:

Kompilieren Markieren Separieren

Def GetParent(1) !"USER32","GetParent"
Def GetDlgCtrlID(1) !"USER32","GetDlgCtrlID"
Def &COLOR_BTNFACE $F
Def &DEFAULT_GUI_FONT $11
Def &WM_COMMAND $111

Proc CreateElements

    WindowStyle 10 | 512 | 2048
    WindowTitle "Arbeitsfenster"
    Window 280, 0 - 474, 434
    Cls GetSysColor(&COLOR_BTNFACE)
    SetDialogFont GetStockObject(&DEFAULT_GUI_FONT)
    dialog1% = Create("Dialog", %hwnd, "dialog", 64, 40, 224, 280)
    calendar1% = Control("SysMonthCal32", "", $54000000, 8, 13, 200, 200, dialog1%, $4000, %hInstance, 0)
    button2% = Create("Button", dialog1%, "Abbrechen", 112, 221, 96, 24)
    button1% = Create("Button", dialog1%, "Datum lesen", 8, 221, 96, 24)

EndProc

Proc GetDate

    Parameters cal&
    Declare Datum#, Erg$
    dim Datum#,20
    SendMessage(Cal&,4097,0,Datum#)
    Erg$ = format$("00",word(Datum#,6))+"."+format$("00",word(Datum#,2))+"."+format$("0000",word(Datum#,0))
    Dispose Datum#
    Return Erg$

ENDPROC

Proc MainLoop

    UserMessages 16
    ShowWindow(%hwnd, 1)

    While 1

        WaitInput
        Case ((%umessage = 16) And (&uwnd = %hwnd)) : BREAK

        If Clicked(button1%)'dialog1% -> #window

            print GetDate(calendar1%)

        ElseIf Clicked(button2%)'dialog1% -> #window

            DestroyWindow(dialog1%)

        EndIf

    EndWhile

EndProc

Proc Main

    CreateElements
    MainLoop

EndProc

Main
End