XProfan

English

in a, obs so what in XProfan already gives, for others versions but certainly useable:
Compile Mark Separation

DEF DTP_GETSYSTEMTIME(2) SendMessage(&(1),4097,0,&(2))
Declare DateTimePick#,Meldung$,TIMEBUTTON&,Setzen&
Def @InitCommonControlsEx(1) !"COMCTL32","InitCommonControlsEx"
DEf @CreateWindowEx(12) !"USER32","CreateWindowExA"
DEF @GetSysColor(1) !"USER32","GetSysColor"
DEF @GetFileVersion(4) ! "Version","GetFileVersionInfoA"
Settruecolor 1
Declare CLASSNAME$,TIMEHandle&,HWND&,Windowname#
Declare INITC#,TIMEBUTTON2&,MESS%,Zahl1&,Zahl2&,DateTimePick#
Windowstyle 31
Windowtitle "Zeiteinstellung"
Window 0,0-640,440
CLS @getsyscolor(15)
LET TIMEBUTTON&=@CREATEBUTTON(%HWND,"Zeit 1",10,360,100,30)
LET TIMEBUTTON2&=@CREATEBUTTON(%HWND,"Zeit 2",120,360,100,30)
LET setzen&=@CREATEBUTTON(%HWND,"Auf 00:00 Uhr setzen!",230,360,200,30)
LET HWND&=%HWND
DIM INITC#,8
long INITC#,0=8
long INITC#,4=$00000100
@InitCommonControlsEx(INITC#)
LET CLASSNAME$="SysDateTimePick32"
LET TIMEHandle&=@CreateWindowEx(0,@addr(CLASSNAME$),0,$40000000+$10000000+$0009,20,20,110,30,HWND&,0,%Hinstance,0)
USEFONT "Times New Roman",20,10,0,0,0
SETFONT TIMEHandle&,%FONT
Dispose initc#

While 0=0

    Waitinput

    If GetFocus(TIMEBUTTON&)

        Dim DateTimePick#,20
        DTP_GETSYSTEMTIME(TIMEHandle&,DateTimePick#)
        Let Meldung$ = Str$(word(DateTimePick#,8));"Uhr ";Str$(word(DateTimePick#,10));"Minuten ";Str$(word(DateTimePick#,12))+"Sekunden"
        @MessageBox(Meldung$,"Zeiteinstellung:",64)
        Dispose DateTimePick#

    ElseIf GetFocus(TIMEBUTTON2&)

        Let Meldung$=@gettext$(TIMEHandle&)
        @MessageBox("Zeiteinstellung: "+Meldung$+" !","Abfrage",64)

    ElseIf GetFocus(Setzen&)

        @Setfocus(TIMEHandle&)
        @sendstring(TIMEHandle&,"00")
        @sendkey(TIMEHandle&,39)
        @sendstring(TIMEHandle&,"00")
        @sendkey(TIMEHandle&,39)
        @sendstring(TIMEHandle&,"00")
        @Setfocus(%HWND)

    Endif

/../../function-references/XProfan/wend/'>wend

08/27/04 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Rolf
Koch

Hi Andreas,

to Info: Yes, the part there under XProfan (Dateedit)
however I Have XP and get The Message: incorrect Dll Version.
Habs from joke time both END removes and the code go through let.
Runs fine, withal allegedly falser Dll.

Rolf

08/27/04 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Hello Rolf, best Thanks for your feedback. have to Time again night shift - and there happens often times son Mist (I Have me still same virtual, the there what not is correct

). I first time edited.

08/28/04 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Michael
Dell

Hello Andreas,

nice thing coming very to rechten Time

, Have yet ne function added,
so a vorbestimmte Time or How in the subesquent demonstration The actually Time
directly on the control gesendet go can.
Compile Mark Separation

Time-Control.prf
Autor      : Andreas Hötker
co Autor   : Michael Dell
Konstanten
Def &ICC_DATE_CLASSES       $0100  month picker, date picker, time picker, updown
Funktionen
Def InitComCont(1)  !"Comctl32.dll","InitCommonControlsEx"
Def GSC(1)          !"User32.dll"  ,"GetSysColor"
Def DestroyWin(1)   !"User32.dll"  ,"DestroyWindow"
Def ButtonUp(1)     Equ(If(Equ(%Lastmessage,514),1,If(Equ(%Lastmessage,512),SetFocus(&(1)),0)),1)
Def gConTime(2)     SendMessage(&(1),$1001,0,&(2))                  Zeit- Control via Structur auslesen
Def sConTime(2)     SendMessage(&(1),$1002,0,&(2))                  Zeit- Control via Structur neu setzen
Deklarationen
Declare iCont#,TimePick#,TimeButt01&,TimeButt02&,SetTimeButt01&,Set&,TimeHndl&
Strukturen
Struct SysTime = Jahr%,Mon%,wTag%,Tag%,Std%,Min%,Sek%,mSek%        SystemTime Struktur laut WinHlp32
Struct INITtag = Size&,ICC&                                        legt Größe und Art des Controls
Dim TimePick#,SysTime

Proc gTimeCon

    Parameters cHndl&,art%
    Declare Anz$

    IfNot art%

        gConTime(cHndl&,TimePick#)
        Anz$ = Add$(Add$(Format$("#0 Uhr - "    ,TimePick#.Std%),
        Format$("0# Minuten - ",TimePick#.Min%)),
        Format$("0# Sekunden"  ,TimePick#.Sek%))

    ElseIf art%

        Anz$ = Add$(Add$(Format$("#0:"   ,TimePick#.Std%),
        Format$("0#:"   ,TimePick#.Min%)),
        Format$("0# Uhr",TimePick#.Sek%))           so gehts natürlich auch
        Anz$ = Add$(@GetText$(cHndl&)," Uhr")

    EndIf

    MessageBox(Anz$,"Zeiteinstellung:",64)

EndProc

Proc sTimeCon

    Parameters cHndl&,H%,M%,S%
    Case Or(Or(Gt(H%,23),Or(Gt(M%,59),Gt(S%,59))),Or(Lt(H%,0),Or(Lt(M%,0),Lt(S%,0)))): Return -1
    TimePick#.Std% = H%
    TimePick#.Min% = M%
    TimePick#.Sek% = S%
    sConTime(cHndl&,TimePick#)

EndProc

Proc SetTimeControl

    Dim iCont#,INITtag
    iCont#.Size& = 8
    iCont#.ICC&  = &ICC_DATE_CLASSES
    InitComCont(iCont#)
    TimeHndl& = @Control("SysDateTimePick32","",$50000009,10,10,90,20,%HWnd,&ICC_DATE_CLASSES,%Hinstance)
    UseFont "Courier New",16,8,1,0,0
    SetFont TimeHndl&,%FONT
    gConTime(TimeHndl&,TimePick#)  Wichtig!!
    Da hier nur die Zeit Abgefragt und wieder gesetzt wird, muß vorab schon einmal
    Abgefragt werden damit auch der restlichen Strucktur-Inhalt gesetzt wird!
    !!!! Wird dies nicht getan, funtioniert Setzen und Reset nicht (oder nicht so einfach wie hier) !!!!
    Aus diesem Grunde muß die Struktur auch Global eingesetzt werden!
    Dispose iCont#

EndProc

Def ResTimeCont(1)  sTimeCon(&(1),0,0,0)
Settruecolor 1
Windowstyle 512+26
Windowtitle "Time - Control"
Window Add(%maxX,10),0-296,100
CLS GSC(15)
TimeButt01&    = @CREATE("Button",%HWND,"Zeit 1" ,110,10,80 ,24)
TimeButt02&    = @CREATE("Button",%HWND,"Zeit 2" ,200,10,80 ,24)
Set&           = @CREATE("BUTTON",%HWND,"Reset"  ,10 ,40,120,24)
SetTimeButt01& = @CREATE("BUTTON",%HWND,"Aktuell",160,40,120,24)
SetTimeControl
Window 0,0-296,100

WhileNot Or(Equ(%MenuItem,-4000),Equ(%MenuItem,-2))

    GetMessage

    If GetFocus(TimeButt01&)

        If ButtonUp(%HWnd)

            gTimeCon(TimeHndl&,0)                                           Zeit- Control auslesen 1. Variante

        EndIf

    ElseIf GetFocus(TimeButt02&)

        If ButtonUp(%HWnd)

            gTimeCon(TimeHndl&,1)                                           Zeit- Control auslesen 2. Variante

        EndIf

    ElseIf GetFocus(Set&)

        If ButtonUp(%HWnd)

            ResTimeCont(TimeHndl&)                                          Uhr auf Null setzen

        EndIf

    ElseIf GetFocus(SetTimeButt01&)

        If ButtonUp(%HWnd)

            sTimeCon(TimeHndl&,20,15,00)                                    Bestimmte Zeit setzen hier 20 Uhr 15 und 0 Sek.
            sTimeCon(TimeHndl&,Val(SubStr$(@Time$(0),1,":")),
            Val(SubStr$(@Time$(0),2,":")),
            Val(SubStr$(@Time$(1),1,".")))               Aktuelle Zeit setzen

        EndIf

    Endif

EndWhile

Window Add(%maxX,10),0-296,100
DestroyWin(TimeHndl&)
DestroyWin(%HWnd)
Dispose TimePick#
End

so Long...

Michael

Salu Michael...

Hab zwar krumme Fieß awer dofir e' ecklich Gsicht!

09/08/04 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Hello Michael...

KLASSE!
what me yet fehlte, was the structure and The suitable Messages! Very beautiful...
your Explanations to the Messages are too SUPER! Habs understood! the here really only, weils on Profan 7.5 not yet runs:
Compile Mark Separation

Declare DateTimePick#,Meldung$,TIMEBUTTON&,Setzen&,Format$
Declare CLASSNAME$,TIMEHandle&,HWND&,Windowname#,TimePick#
Declare INITC#,TIMEBUTTON2&,MESS%,Zahl1&,Zahl2&,DateTimePick#
DEF DTP_GETSYSTEMTIME(2) SendMessage(&(1),4097,0,&(2))
Def @InitCommonControlsEx(1) !"COMCTL32","InitCommonControlsEx"
DEf @CreateWindowEx(12) !"USER32","CreateWindowExA"
DEF @GetSysColor(1) !"USER32","GetSysColor"
DEF @GetFileVersion(4) ! "Version","GetFileVersionInfoA"
Struct SysTime = Jahr%,Mon%,wTag%,Tag%,Std%,Min%,Sek%,mSek%
Settruecolor 1
Windowstyle 31
Windowtitle "Zeiteinstellung"
Window 0,0-640,440
CLS @getsyscolor(15)
LET TIMEBUTTON&=@CREATEBUTTON(%HWND,"Zeit 1",10,360,100,30)
LET TIMEBUTTON2&=@CREATEBUTTON(%HWND,"Zeit 2",120,360,100,30)
LET setzen&=@CREATEBUTTON(%HWND,"Auf 12:00 Uhr setzen!",230,360,200,30)
LET HWND&=%HWND
DIM INITC#,8
long INITC#,0=8
long INITC#,4=$00000100
@InitCommonControlsEx(INITC#)
LET CLASSNAME$="SysDateTimePick32"
LET TIMEHandle&=@CreateWindowEx(0,@addr(CLASSNAME$),0,$40000000+$10000000+$0009,20,20,110,30,HWND&,0,%Hinstance,0)
USEFONT "Times New Roman",20,10,0,0,0
SETFONT TIMEHandle&,%FONT
Dispose initc#
LET FORMAT$="HH:mm"
@SENDMESSAGE(TIMEHandle&,$1000+5,0,@addr(Format$)) Format setzen

While 0=0

    Waitinput

    If GetFocus(TIMEBUTTON&)

        Dim DateTimePick#,20
        DTP_GETSYSTEMTIME(TIMEHandle&,DateTimePick#)
        Let Meldung$ = Str$(word(DateTimePick#,8));"Uhr ";Str$(word(DateTimePick#,10));"Minuten ";Str$(word(DateTimePick#,12))+"Sekunden"
        @MessageBox(Meldung$,"Zeiteinstellung:",64)
        Dispose DateTimePick#

    ElseIf GetFocus(TIMEBUTTON2&)

        Let Meldung$=@gettext$(TIMEHandle&)
        @MessageBox("Zeiteinstellung: "+Meldung$+" !","Abfrage",64)

    ElseIf GetFocus(Setzen&)

        Dim TimePick#,SysTime
        SendMessage(TIMEHandle&,$1001,0,TimePick#)  Zeit- Control via Structur auslesen
        TimePick#.Std% = 12
        TimePick#.Min% = 0
        TimePick#.Sek% = 0
        SendMessage(TIMEHandle&,$1002,0,TimePick#)  Zeit- Control via Structur neu setzen
        Dispose TimePick#

    Endif

='./../../function-references/XProfan/wend/'>wend