XProfan

Español

Keine Idea, obs así qué en XProfan ya son, para otro Versionen aber determinado brauchbar:
Kompilieren Marca Separación

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 Cita Zeilenweise Cita

Rolf
Koch

Hi Andreas,

a Info: Sí, el Teil hay bajo XProfan (Dateedit)
Jedoch Yo tener XP y bekomme el Meldung: Falsche Dll Versión.
Habs de Spass veces beide FIN lejos y el código durchlaufen dejar.
Läuft bestens, trotz angeblich falscher Dll.

Rolf

27.08.2004 ▲

Vollständiges Zitat

Absatzweise Cita Zeilenweise Cita

¡Hola Rolf, besten Dank para deine Rückmeldung. Posesiones a Tiempo otra vez Nachtschicht - y como passiert öfters veces son Mist (Yo tener me doch igual pensamiento, el como qué no stimmt

). Yo sólo veces editiert.

28.08.2004 ▲

Vollständiges Zitat

Absatzweise Cita Zeilenweise Cita

Michael
Dell

¡Hola Andreas,

schönes Ding kam genau a rechten Tiempo

, tener o ne- Función hinzugefügt,
así una vorbestimmte Tiempo oder como en el folgenden Demo el Aktuelle Tiempo
direkt a el Control gesendet voluntad kann.
Kompilieren Marca Separación

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)
Disponer TimePick#
End

So Largo...

Michael

Salu Michael...

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

08.09.2004 ▲

Vollständiges Zitat

Absatzweise Cita Zeilenweise Cita

¡Hola Michael...

KLASSE!
Was me todavía fehlte, war el Struktur y el passenden Messages! Sehr schön...
Su Erklärungen a Messages son auch SUPER! Habs verstanden! Das hier eigentlich sólo, weils en Profano 7.5 todavía no se ejecuta:
Kompilieren Marca Separación

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