XProfan

« Dieser Beitrag wurde als Lösung gekennzeichnet. »

Georg
Teles

Habe etwas rumgespielt, hier ziemlich simpel

Declare e%, oWndProc&
Declare neu%, beenden%
Declare trigger&, wartezeit&
Declare frage%, antwort%
Declare frage$, antwort$
Declare zeit%
Def GetWindowLong(2)!"USER32","GetWindowLongA"
Def SetWindowLong(3)!"USER32","SetWindowLongA"
Def KillTimer32(2)!"USER32","KillTimer"
Def SetTimer32(4)!"USER32","SetTimer"
CLS
frage$ = "Frage: Wieviel ist 44 * 5 ?"
antwort$ = "Lösung: 220"
frage% = Create("Text",%hWnd,frage$,5,5,255,20)
antwort% = Create("Text",%hWnd,"Lösung:",5,30,255,20)
zeit% = Create("Text",%hWnd,"",100,61,65,20)
neu% = Create("Button",%hWnd,"näch. Frage",5,60,90,20)
beenden% = Create("Button",%hWnd,"beenden",170,60,90,20)

Proc tmpr

    Inc wartezeit&

    If trigger& = 1

        SetText antwort%,antwort$+" (durch ESC ausgelöst)"
        wartezeit& = 0
        SetText zeit%,""

    Else

        SetText zeit%,Str$(10-(wartezeit&)\3)+" Sek."

    EndIf

    If wartezeit& >= 3*10

        SetText antwort%,antwort$+" (Wartezeit vorbei)"
        wartezeit& = 0
        SetText zeit%,""

    EndIf

EndProc

SetTimer32(%hWnd,1,333,ProcAddr("tmpr",0))
oWndProc& = GetWindowLong(%hWnd,-4)
Clear e%, trigger&, wartezeit&

WhileNot e%

    Waitinput
    ' Trigger auslösen

    If (%Key = 27) or (%Key = 2)

        locate 1,1
        trigger& = 1

    EndIf

    ' nächste Frage + Trigger auf 0

    If Clicked(neu%)

        frage$ = "Frage: Hauptstadt von Germania ?"
        antwort$ = "Lösung: Berlin"
        SetText frage%,frage$
        SetText antwort%,"Lösung:"
        Clear trigger&, wartezeit&
        SetFocus(%hWnd)

    EndIf

    ' Programm direkt beenden

    If Clicked(beenden%)

        Inc e%

    EndIf

EndWhile

KillTimer32(%hWnd,1)
SetWindowLong(%hWnd,-4,oWndProc&)

hier mit Arrays als Frage/Lösung

Declare e%, oWndProc&
Declare neu%, beenden%
Declare trigger&, wartezeit&
Declare frage%, antwort%
Declare fragen$, antworten$
Declare frage$[], antwort$[]
Declare zufall&, zeit%
Def GetWindowLong(2)!"USER32","GetWindowLongA"
Def SetWindowLong(3)!"USER32","SetWindowLongA"
Def KillTimer32(2)!"USER32","KillTimer"
Def SetTimer32(4)!"USER32","SetTimer"
Randomize
CLS
fragen$ = "Wieviel ist 44 * 5 ?;Hauptstadt von Germania ?;2^4 - 2 ?;Wurzel aus 27 ?"
antworten$ = "220;Berlin;14;3"
frage$[] = explode(fragen$,";")
antwort$[] = explode(antworten$,";")
zufall& = Rnd(4)
frage% = Create("Text",%hWnd,frage$[zufall&],5,5,255,20)
antwort% = Create("Text",%hWnd,"",5,30,700,20)
zeit% = Create("Text",%hWnd,"",100,61,65,20)
neu% = Create("Button",%hWnd,"näch. Frage",5,60,90,20)
beenden% = Create("Button",%hWnd,"beenden",170,60,90,20)

Proc tmpr

    Inc wartezeit&

    If trigger& = 1

        SetText antwort%,antwort$[zufall&]+" (durch ESC ausgelöst) bzw Wartezeit vorbei s. \qAUSLÖSER\q"
        wartezeit& = 0
        SetText zeit%,""

    Else

        SetText zeit%,Str$(10-(wartezeit&)\3)+" Sek."' von 10 Sekunden Zeit abziehen

    EndIf

    If wartezeit& >= 3*10' 10 Sekunden

        ' damit die Zeit nicht mehr rückwärts corre, kann dieser Schritt ausgelassen werden und
        ' nur trigger = 1 gesetzt, da Lösung auch Oben angezeigt wird, siehe oben
        trigger& = 1'AUSLÖSER
        'SetText antwort%,antwort$[zufall&]+" (Wartezeit vorbei)"
        'wartezeit& = 0
        'SetText zeit%,""

    EndIf

EndProc

SetTimer32(%hWnd,1,333,ProcAddr("tmpr",0))
oWndProc& = GetWindowLong(%hWnd,-4)
Clear e%, trigger&, wartezeit&

WhileNot e%

    Waitinput
    ' Trigger auslösen

    If (%Key = 27) or (%Key = 2)

        locate 1,1
        trigger& = 1

    EndIf

    ' nächste Frage + Trigger auf 0

    If Clicked(neu%)

        zufall& = Rnd(4)
        SetText frage%, frage$[zufall&]
        SetText antwort%,""
        Clear trigger&, wartezeit&
        SetFocus(%hWnd)

    EndIf

    ' Programm direkt beenden

    If Clicked(beenden%)

        Inc e%

    EndIf

EndWhile

KillTimer32(%hWnd,1)
SetWindowLong(%hWnd,-4,oWndProc&)

Vielleicht kannst Du etwas damit anfangen

Grüße Georg

XProfan X2
TC-Programming [...]

XProfan 8.0 - 10.0 - X2 - X3 - X4

02.05.2020 ▲

RudiB.

Hat sich schon erledigt...

Habe eine Lösung gefunden um schneller / Schnell aus dem Sleep rauszukommen.

Whileloop 20

    If @IsKey(27)

        ende%=1
        break

    Endif

    Sleep 50 * pause%

EndWhile

XProfan X4
Xprofan X4
Rudolf Beske / München

Hardware: NB Intel I9 - 16GByte RAM

28.04.2020 ▲

Georg
Teles

Guten Tag,

aah hat sich erledigt

weiß' ja nicht, was du vor hast, aber ich hatte einen Vorschlag, wo du rumexperementieren kannst

Declare e%, t&, oWndProc&
Def GetWindowLong(2)!"USER32","GetWindowLongA"
Def SetWindowLong(3)!"USER32","SetWindowLongA"
Def KillTimer32(2)!"USER32","KillTimer"
Def SetTimer32(4)!"USER32","SetTimer"

Proc tmpr

    Locate 1,1
    print time$(0);":";time$(1);" - ESC drücken, um Timer zu beenden"
    print "verschiebe Fenster, Timer aktualisiert dennoch diesen Text"

EndProc

CLS
var Button% = Create("Button",%hWNd,"teste",20,50,100,20)
t& = SetTimer32(%hWnd,1,333,ProcAddr("tmpr",0))
oWndProc& = GetWindowLong(%hWnd,-4)
Clear e%

WhileNot e%

    Waitinput

    If (%Key = 27) or (%Key = 2)

        Locate 1,1
        'Case t&:KillTimer32(%hWnd,1)

        If t& = 1

            KillTimer32(%hWnd,1)
            t& = 0

        EndIf

        print space$(23)+"ABBRUCH"+space$(23)
        'Inc e% '= ENDE

    EndIf

    '-------------------------------------------------

    If t& = 0

        ' tu was, wenn Timer weg ist

    EndIf

    ' eleganter hier, wenn Button UND Timer = 1

    If (Clicked(Button%)) AND (t& = 1)

        locate 5,20
        print "nix geschieht"
        SetFocus(%hWnd)

    EndIf

    ' eleganter hier, wenn Button UND Timer = 0

    If (Clicked(Button%)) AND (t& = 0)

        locate 5,20
        print "was jetzt? (X oben rechts um zu beenden)"

    EndIf

EndWhile

SetWindowLong(%hWnd,-4,oWndProc&)

Grüße

XProfan X2
TC-Programming [...]

XProfan 8.0 - 10.0 - X2 - X3 - X4

01.05.2020 ▲

RudiB.

nun ja, ich schreibe gerade an eimem Vokabe-Trainer. Eine Funktion ist hier halt wie bei einer "Dia-Show" ...Vokabel wird angezeigt und anschliessend nach einer einstellbaren Pause (zw. 1 und 10 sek.) wird die Antwort eingeblendet. So hat man eben eine gewisse Zeit sich die Antwort zu überlegen.
Weiß man die Antwort aber sofort, dann soll der User aber nicht unbedingt die volle Pausenzeit "absitzen" müssen. Also raus aus der Pause....mit ESC, danach halt weiter ...
Daher habe ich halt die Pausenzeit verkürzt und in un Whileloop-Schleife gelegt.
Vorher 10 sek. Pause am Stück und so dann halt aufgeteilt auf 20*0,5sek. mit der möglichkeit mit ESC auszusteigen.

Aber Deine Lösung ist wirklich Super und werde diese Lösung mal ausgiebig testen und mit Sicherheit auch mit einbauen. Wesentlich eleganter....

Danke Dir Georg

Saluto aus München Rudi

XProfan X4
Xprofan X4
Rudolf Beske / München

Hardware: NB Intel I9 - 16GByte RAM

01.05.2020 ▲

Georg
Teles

Habe etwas rumgespielt, hier ziemlich simpel

Declare e%, oWndProc&
Declare neu%, beenden%
Declare trigger&, wartezeit&
Declare frage%, antwort%
Declare frage$, antwort$
Declare zeit%
Def GetWindowLong(2)!"USER32","GetWindowLongA"
Def SetWindowLong(3)!"USER32","SetWindowLongA"
Def KillTimer32(2)!"USER32","KillTimer"
Def SetTimer32(4)!"USER32","SetTimer"
CLS
frage$ = "Frage: Wieviel ist 44 * 5 ?"
antwort$ = "Lösung: 220"
frage% = Create("Text",%hWnd,frage$,5,5,255,20)
antwort% = Create("Text",%hWnd,"Lösung:",5,30,255,20)
zeit% = Create("Text",%hWnd,"",100,61,65,20)
neu% = Create("Button",%hWnd,"näch. Frage",5,60,90,20)
beenden% = Create("Button",%hWnd,"beenden",170,60,90,20)

Proc tmpr

    Inc wartezeit&

    If trigger& = 1

        SetText antwort%,antwort$+" (durch ESC ausgelöst)"
        wartezeit& = 0
        SetText zeit%,""

    Else

        SetText zeit%,Str$(10-(wartezeit&)\3)+" Sek."

    EndIf

    If wartezeit& >= 3*10

        SetText antwort%,antwort$+" (Wartezeit vorbei)"
        wartezeit& = 0
        SetText zeit%,""

    EndIf

EndProc

SetTimer32(%hWnd,1,333,ProcAddr("tmpr",0))
oWndProc& = GetWindowLong(%hWnd,-4)
Clear e%, trigger&, wartezeit&

WhileNot e%

    Waitinput
    ' Trigger auslösen

    If (%Key = 27) or (%Key = 2)

        locate 1,1
        trigger& = 1

    EndIf

    ' nächste Frage + Trigger auf 0

    If Clicked(neu%)

        frage$ = "Frage: Hauptstadt von Germania ?"
        antwort$ = "Lösung: Berlin"
        SetText frage%,frage$
        SetText antwort%,"Lösung:"
        Clear trigger&, wartezeit&
        SetFocus(%hWnd)

    EndIf

    ' Programm direkt beenden

    If Clicked(beenden%)

        Inc e%

    EndIf

EndWhile

KillTimer32(%hWnd,1)
SetWindowLong(%hWnd,-4,oWndProc&)

hier mit Arrays als Frage/Lösung

Declare e%, oWndProc&
Declare neu%, beenden%
Declare trigger&, wartezeit&
Declare frage%, antwort%
Declare fragen$, antworten$
Declare frage$[], antwort$[]
Declare zufall&, zeit%
Def GetWindowLong(2)!"USER32","GetWindowLongA"
Def SetWindowLong(3)!"USER32","SetWindowLongA"
Def KillTimer32(2)!"USER32","KillTimer"
Def SetTimer32(4)!"USER32","SetTimer"
Randomize
CLS
fragen$ = "Wieviel ist 44 * 5 ?;Hauptstadt von Germania ?;2^4 - 2 ?;Wurzel aus 27 ?"
antworten$ = "220;Berlin;14;3"
frage$[] = explode(fragen$,";")
antwort$[] = explode(antworten$,";")
zufall& = Rnd(4)
frage% = Create("Text",%hWnd,frage$[zufall&],5,5,255,20)
antwort% = Create("Text",%hWnd,"",5,30,700,20)
zeit% = Create("Text",%hWnd,"",100,61,65,20)
neu% = Create("Button",%hWnd,"näch. Frage",5,60,90,20)
beenden% = Create("Button",%hWnd,"beenden",170,60,90,20)

Proc tmpr

    Inc wartezeit&

    If trigger& = 1

        SetText antwort%,antwort$[zufall&]+" (durch ESC ausgelöst) bzw Wartezeit vorbei s. \qAUSLÖSER\q"
        wartezeit& = 0
        SetText zeit%,""

    Else

        SetText zeit%,Str$(10-(wartezeit&)\3)+" Sek."' von 10 Sekunden Zeit abziehen

    EndIf

    If wartezeit& >= 3*10' 10 Sekunden

        ' damit die Zeit nicht mehr rückwärts corre, kann dieser Schritt ausgelassen werden und
        ' nur trigger = 1 gesetzt, da Lösung auch Oben angezeigt wird, siehe oben
        trigger& = 1'AUSLÖSER
        'SetText antwort%,antwort$[zufall&]+" (Wartezeit vorbei)"
        'wartezeit& = 0
        'SetText zeit%,""

    EndIf

EndProc

SetTimer32(%hWnd,1,333,ProcAddr("tmpr",0))
oWndProc& = GetWindowLong(%hWnd,-4)
Clear e%, trigger&, wartezeit&

WhileNot e%

    Waitinput
    ' Trigger auslösen

    If (%Key = 27) or (%Key = 2)

        locate 1,1
        trigger& = 1

    EndIf

    ' nächste Frage + Trigger auf 0

    If Clicked(neu%)

        zufall& = Rnd(4)
        SetText frage%, frage$[zufall&]
        SetText antwort%,""
        Clear trigger&, wartezeit&
        SetFocus(%hWnd)

    EndIf

    ' Programm direkt beenden

    If Clicked(beenden%)

        Inc e%

    EndIf

EndWhile

KillTimer32(%hWnd,1)
SetWindowLong(%hWnd,-4,oWndProc&)

Vielleicht kannst Du etwas damit anfangen

Grüße Georg

XProfan X2
TC-Programming [...]

XProfan 8.0 - 10.0 - X2 - X3 - X4

02.05.2020 ▲

RudiB.

da kann ich absolut was mit anfangen, hat mich doch gleich zu einer neuen Idee inspiriert.
Muss mal schauen wie ich das jetzt in mein Programm einbaue ohne es mir zu zerschießen.....
Das bekomm ich schon hin...

Danke Georg

XProfan X4
Xprofan X4
Rudolf Beske / München

Hardware: NB Intel I9 - 16GByte RAM

03.05.2020 ▲

Georg
Teles

Perfekt

Grüße

XProfan X2
TC-Programming [...]

XProfan 8.0 - 10.0 - X2 - X3 - X4

03.05.2020 ▲

Programme, die asynchrone Prozedurenaufrufe auf eine Proc ansetzen, die nur per synchrone Enumeration geeignet ist, können jederzeit und scheinbar zufällig jegliche Funktionen des Betriebssystemes aufrufen.

Denke man, der Call auf DeleteFileA ist ausgenommen der Adresse kein anderer, als der auf SetPixel - da reichen zum Unglück ein zeitversetztes xor eax,eax und ein paar geeignete Werte auf dem Stack - viel Glück.

Sleep 10000 kannst Du sicher mit ExitProcess/ TerminateThread etc. "killen"/ müsste eben delegiert sein/ werden/ bzw. scheint hier nicht sinnvoll eingesetzt zu werden.

"Nicht blockierendes Warten" per Waitinput, sinngemäß:

Alle Sprachen
WinXP, SP3, Core(TM) i7-3770 @ 3.40GHz

sleep_(long ms){

    ms=getTickCount+ms-1

    do{

        waitInput 100
        case getTickCount>ms : break

    }

}

24.09.2020 ▲