XProfan

English

Rainer
Hoefs

Hello together,

have there a Please,

i want a Calendar (with SysMonthCal32 prepares) the date read.

have already sought and sought and sought...
but unfortunately nothing found.

can me Please someone help?

thanks beforehand
Rainer

Compile Mark Separation

' code created with F.Abbing's LemonViD Version 1.0.0.3 on the 19.04.2016 circa 12:59 watch,
' donate-Button, as well as further Freeware-Tools for XProfan on https://frabbing.net
' Technischer Support on ./../../sys/?nohdr=1&u=www.paules-pc-forum.de/forum/XProfan and 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

    Window Style 10 | 512 | 2048
    Window Title "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

    User Messages 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

04/19/16 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

RGH

I have time a function "GetDate" installed, with the the currently chosen date read go can:

Compile Mark Separation

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

    Window Style 10 | 512 | 2048
    Window Title "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 date#, Erg$
    dim date#,20
    SendMessage(Cal&,4097,0,date#)
    Erg$ = stature$("00",word(date#,6))+"."+stature$("00",word(date#,2))+"."+stature$("0000",word(date#,0))
    Dispose date#
    Return Erg$

ENDPROC

Proc MainLoop

    User Messages 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