XProfan

Français

je n'en sais rien, obs so quoi dans XProfan déjà gibt, pour autre Versionen mais bestimmt brauchbar:
Kompilieren Marque Séparation

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 citation

Absatzweise Citation Zeilenweise Citation

Rolf
Koch

Hi Andreas,

zur Info: oui, cela partie gibt es sous XProfan (Dateedit)
cependant je hab XP et bekomme qui annonce: Falsche Dll Version.
Tricolore aus Spass la fois beide FIN entfernt et den Code durchlaufen laisser.
Läuft bestens, trotz angeblich falscher Dll.

Rolf

27.08.2004 ▲

Vollständiges citation

Absatzweise Citation Zeilenweise Citation

allô Rolf, besten Dank pour deine Rückmeldung. Habe zur Zeit wieder Nachtschicht - et là passiert öfters la fois son Mist (je hab mir doch juste gedacht, cela là quoi pas stimmt

). je seulement la fois editiert.

28.08.2004 ▲

Vollständiges citation

Absatzweise Citation Zeilenweise Citation

Michael
Dell

allô Andreas,

schönes Ding kam oui c'est ca zur rechten Zeit

, hab encore ne Funktion hinzugefügt,
avec cela une vorbestimmte Zeit ou bien comment im folgenden Demo qui Aktuelle Zeit
direct à cela Contrôle gesendet volonté peux.
Kompilieren Marque Séparation

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#
Fin

So Long...

Michael

Salu Michael...

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

08.09.2004 ▲

Vollständiges citation

Absatzweise Citation Zeilenweise Citation

allô Michael...

KLASSE!
quoi mir encore fehlte, était qui Struktur et qui passenden Messages! très joli...
Votre Erklärungen le Messages sommes aussi SUPER! Tricolore verstanden! cela ici eigentlich seulement, weils sur Profan 7.5 encore pas fonctionne:
Kompilieren Marque Séparation

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