XProfan

Italia

Keine Ahnung, obs so was in XProfan schon gibt, per andere Versionen aber bestimmt brauchbar:
Kompilieren Markieren Separieren

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

27.08.2004 ▲

Vollständiges Zitat

Absatzweise Citazione Zeilenweise Citazione

Rolf
Koch

Hi Andreas,

zur Info: Ja, das Teil gibt es unter XProfan (Dateedit)
Jedoch ich hab XP und bekomme die Meldung: Falsche Dll Version.
Habs aus Spass mal beide END entfernt und den Code durchlaufen lassen.
Läuft bestens, trotz angeblich falscher Dll.

Rolf

27.08.2004 ▲

Vollständiges Zitat

Absatzweise Citazione Zeilenweise Citazione

Hallo Rolf, besten Dank per deine Rückmeldung. Habe zur Zeit wieder Nachtschicht - und da passiert öfters mal son Mist (ich hab mir doch gleich gedacht, das da was nicht stimmt

). Ich erst mal editiert.

28.08.2004 ▲

Vollständiges Zitat

Absatzweise Citazione Zeilenweise Citazione

Michael
Dell

Hallo Andreas,

schönes Ding kam genau zur rechten Zeit

, hab noch ne Funktion hinzugefügt,
damit eine vorbestimmte Zeit oder wie im folgenden Demo die Aktuelle Zeit
direkt an das Control gesendet werden kann.
Kompilieren Markieren Separieren

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!

08.09.2004 ▲

Vollständiges Zitat

Absatzweise Citazione Zeilenweise Citazione

Hallo Michael...

KLASSE!
Was mir noch fehlte, war die Struktur und die passenden Messages! Sehr schön...
Deine Erklärungen zu den Messages sind auch SUPER! Habs verstanden! Das hier eigentlich nur, weils auf Profan 7.5 noch nicht corre:
Kompilieren Markieren Separieren

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