(910)  Registro

Italia
Fonte/ Codesnippets

Timer-Button

 

RudiB.
Hab mal wieder was gebastelt....einen TIMER-BUTTON
einfach mal probieren, ich hoffe es ist selbsterklärend...
KompilierenMarkierenSeparieren
Window 100,100-800,500
WindowTitle "Es wird die Zeit gemessen , wie lange der Timer-Button gedrückt bleibt..."
Declare zeit&,sek&,sekundaer_sek&,stop&,Edit&,text$,z&,button&,Button_dummy&,button_ende&,button_Anleitung&,edit_status&,Font3%
FONT3%=@Create("FONT","MS SANS SERIF",25,10,1,0,0)
button&=create("Button",%Hwnd,"Timer-Button",150,200,120,80)
edit_status&=Control("EDIT","",$540100C1,50,150,650,30,%Hwnd,0,%hinstance,$0)
setfont edit_status&,font3%
edit&=Control("EDIT","",$540100C1,30,50,60,18,button&,0,%hinstance,$0)
settext edit&,"0.00 ms"
enablewindow edit&,0
button_dummy& = CONTROL("Button","Dummy Buttton  CLS ", $54012000,300,200,80,80, %HWnd,1, %HINSTANCE)
button_ende&=create("Button",%Hwnd,"Ende",500,200,80,80)
button_Anleitung&=create("Button",%Hwnd,"Anleitung",400,200,80,80)
Stop&=0
CLS
Set("Decimals",2)
zeit&=&gettickcount

While 1'Endlosschleife! (Button-Abfrage)

    If Getfocus(button_dummy&)

        CLS:setfocus(%Hwnd)
        Settext edit_status&,"Dummy-Button wurde gerade geklickt >>> CLS"

    ElseIf getfocus(button_Anleitung&)

        Anleitung

    ElseIf getfocus(button_ende&)

        End

    Else

        GetStatus_TimerButton

    endif

EndWhile

End

Proc GetStatus_TimerButton

    z&=Sendmessage(Button&,$00F2,0,0)'Statuswert des Buttons (Button Message : bm_GetState)

    If z&>600'Linke Maustaste gedrückt

        inc stop&
        sek&=((&gettickcount-zeit&)/10)-sekundaer_sek&
        Settext edit_status&,"Linke Maustaste auf Timer-Button ist gerade gedrückt"

    Else

        sekundaer_sek&=((&gettickcount-zeit&)/10)

    EndIf

    If (stop&>=1) And (z&>600)

        settext edit&,str$(sek&/100)+" ms"

    EndIf

    z&=Sendmessage(Button&,$00F2,0,0)'Statuswert Timer-Button neu auslesen

    If (z& <600) And (sek&>0)

        settext edit&,str$(sek&/100)+" ms"
        Text$="Timer-Button wurde "+str$(sek&/100)+" Sekunden lang gedrückt ......    "
        Settext edit_status&,Text$
        setfocus(%Hwnd)
        settext edit&,str$(sek&/100)+" ms"
        '-------------------------------------------------------------------------------------------
        '------In Abhängigkeit vom Timer-Wert wird hier eine Aktion corsa ---------------------

        If sek&/100>1.5

            Rectangle 200,350 - 550,400

        Endif

        If (sek&/100>1.0) And (sek&/100<1.5)

            Ellipse 200,350 - 550,400

        Endif

        If (sek&/100>.5) And (sek&/100<1)

            Line 200,350 - 550,400

        Endif

        If sek&/100<.5

            Cls

        Endif

        '-------------------------------------------------------------------------------------------
        sek&=0

    EndIf

    z&=Sendmessage(Button&,$00F2,0,0)'Statuswert Timer-Button neu auslesen

    If (z&>0) And (stop&=0)

        sek&=0
        stop&=0
        sekundaer_sek&=0
        zeit&=&gettickcount

    EndIf

    If (%mousepressed=2) And (z&>0)'Rechter Mausklick auf Timer-Button (Timerwert wird auf 0.00 gesetzt)

        settext edit&,"0.00 ms"
        Settext edit_status&,"Rechte Maustaste auf Timer-Button wurde gerade geklickt"

    EndIf

EndProc

Proc Anleitung

    Locate 1,1
    Print "Linke Maustaste auf Timer-Button gedrückt halten...Zeit wird in ms im Timer-Button-Edit angezeigt"
    Print "In Abhängigkeit vom Timerwert wird eine Aktion corsa...Nur zu Demo-Zwecken."
    Print "mehr als 1,5 sek -------- es wird ein Rechteck gezeichnet"
    Print "zwischen 1,0 - 1,5 sek -- es wird eine Ellipse gezeichnet"
    Print "zwischen 0,5 - 1,0 sek -- es wird eine Linie gezeichnet"
    Print "weniger als 0,5 sek ----- Es wird ein CLS corsa."
    Print "Rechte Maustaste auf Timer-Button klicken setzt den Timerwert auf 0.00 ms zurück..."
    Print "Dummy-Button macht einfach nur ein CLS...."
    Print "Ende-Button muss ich nicht erklären, oder ???"
    setfocus(%Hwnd)

EndProc
 
Xprofan X4
Rudolf Beske / München

Hardware: NB Intel I9 - 16GByte RAM
28.05.2021  ▲
 




p.specht

"In Abhängigkeit vom Timer-Wert wird hier eine Aktion corsa..." - coole Idee!

Mehrfachausnutzung von Buttons bedarf aber einer klaren Trennung zwischen KURZEM und LANGEM DRUCK. Bei meinem chinesischen Würfelradio-bluetooth-mp3player klicke ich regelmäßig falsch. Damit fängt der 1-Stunden-Vortrag auf mp3 jedesmal von vorne an, statt in Pause zu gehen. Also: Eindeutige Zeiten sind wichtig!
 
XProfan 11
Computer: Gerät, daß es in Mikrosekunden erlaubt, 50.000 Fehler zu machen, zB 'daß' statt 'das'...
28.05.2021  ▲
 




RudiB.
Und noch eine weiter Variante des Timer-Buttons ....hier kommt Farbe ins Spiel.

7 kB
Hochgeladen:28.05.2021
Downloadcounter: 75
Download
 
XProfan X4
Xprofan X4
Rudolf Beske / München

Hardware: NB Intel I9 - 16GByte RAM
28.05.2021  ▲
 




RudiB.

"In Abhängigkeit vom Timer-Wert wird hier eine Aktion corsa..." - coole Idee!


Nun ja....soooo weit habe ich jetzt noch nicht gedacht. Im Moment bastele ich eher nur an der Optik. Der Rest kommt dann....
 
XProfan X4
Xprofan X4
Rudolf Beske / München

Hardware: NB Intel I9 - 16GByte RAM
28.05.2021  ▲
 




Georg
Teles
Nabend,

coole Idee !
per etwas CPU Entlastung eventuell WaitInput und Timer hinzufügen wäre gut
KompilierenMarkierenSeparieren
Window 100,100-800,500
WindowTitle "Es wird die Zeit gemessen , wie lange der Timer-Button gedrückt bleibt..."
Declare zeit&,sek&,sekundaer_sek&,stop&,Edit&,text$,z&,button&,Button_dummy&,button_ende&,button_Anleitung&,edit_status&,Font3%
'Declare a&.b&,c&,d&,e&
Def LoadImage(6) !"USER32","LoadImageA"
FONT3%=@Create("FONT","MS SANS SERIF",25,10,1,0,0)
button&=control("Button","Timer-Button",$54010400,150,220,120,40,%hwnd,1,%HINSTANCE)
edit_status&=Control("EDIT","",$540100C1,50,150,650,30,%Hwnd,0,%hinstance,$0)
setfont edit_status&,font3%
edit&=Control("EDIT","",$540100C1,30,50,60,18,button&,0,%hinstance,$0)
showwindow(edit&,0)
Var a&=  Control("STATIC", "Test", $5400110E, 10, 22, 10, 10, Button&,0, %hInstance)
Var b&=  Control("STATIC", "Test", $5400110E, 25, 22, 10, 10, Button&,0, %hInstance)
Var c&=  Control("STATIC", "Test", $5400110E, 40, 22, 10, 10, Button&,0, %hInstance)
Var d&=  Control("STATIC", "Test", $5400110E, 55, 22, 10, 10, Button&,0, %hInstance)
Var e&=  Control("STATIC", "Test", $5400110E, 70, 22, 10, 10, Button&,0, %hInstance)
Var f&=  Control("STATIC", "Test", $5400110E, 85, 22, 10, 10, Button&,0, %hInstance)
Var g&=  Control("STATIC", "Test", $5400110E, 100, 22, 10, 10, Button&,0, %hInstance)
'Var e&=  Control("STATIC", "Test", $5400110E, 10, 68, 10, 10, Button&,0, %hInstance)
settext edit&,"0.00 ms"
enablewindow edit&,0
button_dummy& = CONTROL("Button","Dummy Buttton  CLS ", $54012000,300,200,80,80, %HWnd,1, %HINSTANCE)
button_ende&=create("Button",%Hwnd,"Ende",500,200,80,80)
button_Anleitung&=create("Button",%Hwnd,"Anleitung",400,200,80,80)
Stop&=0
CLS
Set("Decimals",2)
zeit&=&gettickcount
SetTimer 10

While 1'Endlosschleife! (Button-Abfrage)

    WaitInput

    If %wmTimer

        If Getfocus(button_dummy&)

            CLS:setfocus(%Hwnd)
            Settext edit_status&,"Dummy-Button wurde gerade geklickt >>> CLS"

        ElseIf getfocus(button_Anleitung&)

            Anleitung

        ElseIf getfocus(button_ende&)

            End

        Else

            GetStatus_TimerButton

        endif

    EndIf

EndWhile

KillTimer
End

Proc GetStatus_TimerButton

    z&=Sendmessage(Button&,$00F2,0,0)'Statuswert des Buttons (Button Message : bm_GetState)

    If z&>600'Linke Maustaste gedrückt

        inc stop&
        sek&=((&gettickcount-zeit&)/10)-sekundaer_sek&
        Settext edit_status&,"Linke Maustaste auf Timer-Button ist gerade gedrückt"

        If sek&>25

            FAERBESTATIC a&,10,10,RGB(0,255,0)

        EndIf

        If sek&>50

            FAERBESTATIC b&,10,10,RGB(127,255,0)

        EndIf

        If sek&>75

            FAERBESTATIC c&,10,10,RGB(255,255,0)

        EndIf

        If sek&>100

            FAERBESTATIC d&,10,10,RGB(255,193,0)

        EndIf

        If sek&>125

            FAERBESTATIC e&,10,10,RGB(255,165,0)

        EndIf

        If sek&>150

            FAERBESTATIC f&,10,10,RGB(255,69,0)

        EndIf

        If sek&>175

            FAERBESTATIC g&,10,10,RGB(255,0,0)

        EndIf

        Setfocus(Button&)

    Else

        sekundaer_sek&=((&gettickcount-zeit&)/10)

    EndIf

    If (stop&>=1) And (z&>600)

        settext edit&,str$(sek&/100)+" ms"

    EndIf

    z&=Sendmessage(Button&,$00F2,0,0)'Statuswert Timer-Button neu auslesen

    If (z& <600) And (sek&>0)

        settext edit&,str$(sek&/100)+" ms"
        Text$="Timer-Button wurde "+str$(sek&/100)+" Sekunden lang gedrückt ......    "
        Settext edit_status&,Text$
        setfocus(%Hwnd)
        settext edit&,str$(sek&/100)+" ms"
        '-------------------------------------------------------------------------------------------
        '------In Abhängigkeit vom Timer-Wert wird hier eine Aktion corsa ---------------------

        If sek&/100>1.5

            Rectangle 200,350 - 550,400

        Endif

        If (sek&/100>1.0) And (sek&/100<1.5)

            Ellipse 200,350 - 550,400

        Endif

        If (sek&/100>.5) And (sek&/100<1)

            Line 200,350 - 550,400

        Endif

        If sek&/100<.5

            Cls

        Endif

        '-------------------------------------------------------------------------------------------
        FAERBESTATIC a&,10,10,RGB(229,229,229)
        FAERBESTATIC b&,10,10,RGB(229,229,229)
        FAERBESTATIC c&,10,10,RGB(229,229,229)
        FAERBESTATIC d&,10,10,RGB(229,229,229)
        FAERBESTATIC e&,10,10,RGB(229,229,229)
        FAERBESTATIC f&,10,10,RGB(229,229,229)
        FAERBESTATIC g&,10,10,RGB(229,229,229)
        'Setfocus(%Hwnd)
        Setfocus(Button&)
        settext edit&,"0.00 ms"
        sek&=0

    EndIf

    z&=Sendmessage(Button&,$00F2,0,0)'Statuswert Timer-Button neu auslesen

    If (z&>0) And (stop&=0)

        sek&=0
        stop&=0
        sekundaer_sek&=0
        zeit&=&gettickcount

    EndIf

    If (%mousepressed=2) And (z&>0)'Rechter Mausklick auf Timer-Button (Timerwert wird auf 0.00 gesetzt)

        settext edit&,"0.00 ms"
        Settext edit_status&,"Rechte Maustaste auf Timer-Button wurde gerade geklickt"

    EndIf

EndProc

Proc Anleitung

    Locate 1,1
    Print "Linke Maustaste auf Timer-Button gedrückt halten...Zeit wird in ms im Timer-Button-Edit angezeigt"
    Print "In Abhängigkeit vom Timerwert wird eine Aktion corsa...Nur zu Demo-Zwecken."
    Print "mehr als 1,5 sek -------- es wird ein Rechteck gezeichnet"
    Print "zwischen 1,0 - 1,5 sek -- es wird eine Ellipse gezeichnet"
    Print "zwischen 0,5 - 1,0 sek -- es wird eine Linie gezeichnet"
    Print "weniger als 0,5 sek ----- Es wird ein CLS corsa."
    Print "Rechte Maustaste auf Timer-Button klicken setzt den Timerwert auf 0.00 ms zurück..."
    Print "Dummy-Button macht einfach nur ein CLS...."
    Print "Ende-Button muss ich nicht erklären, oder ???"
    setfocus(%Hwnd)

EndProc

PROC FAERBESTATIC

    Declare wfb#,h&,bild$
    Parameters statbild&,breitobj&,hochobj&,hwndfarb%
    bild$="DUMMY.BMP"
    MCLS breitobj&,hochobj&
    STARTPAINT -1
    SetPixel 0,0,hwndfarb%
    Savebmp bild$,0,0-1,1;0
    ENDPAINT
    Dim wfb#,Len(bild$)+1
    String wfb#,0=bild$
    Let h&=LoadImage(%hinstance,wfb#,0,breitobj&,hochobj&,$50)
    SendMessage(statbild&,$172,0,h&)
    DISPOSE wfb#
    ASSIGN #1,"DUMMY.BMP"
    ERASE #1

EndProc

Grüße
 
XProfan X2
TC-Programming [...] 
XProfan 8.0 - 10.0 - X2 - X3 - X4

19.10.2022  ▲
 




RudiB.
Hatte ich schon fast wieder vergessen....

Danke.....teste ich mal aus ......
 
XProfan X4
Xprofan X4
Rudolf Beske / München

Hardware: NB Intel I9 - 16GByte RAM
19.10.2022  ▲
 



Zum Quelltext


Topictitle, max. 100 characters.
 

Systemprofile:

Kein Systemprofil angelegt. [anlegen]

XProfan:

 Posting  Font  Smilies  ▼ 

Bitte anmelden um einen Beitrag zu verfassen.
 

Topic-Options

Unreaded
subscribe
Remember-List
Notes
guests
Delete
Permanent
Done

3.978 Views

Untitledvor 0 min.
Gast.0815 vor 5 Tagen
Member 862464112.05.2024
E.T.27.12.2023
Axel Berse13.08.2023
Di più...

Themeninformationen

Dieses Thema hat 3 subscriber:

RudiB. (4x)
Georg Teles (1x)
p.specht (1x)


Admins  |  AGB  |  Applications  |  Autori  |  Chat  |  Informativa sulla privacy  |  Download  |  Entrance  |  Aiuto  |  Merchantportal  |  Impronta  |  Mart  |  Interfaces  |  SDK  |  Services  |  Giochi  |  Cerca  |  Support

Ein Projekt aller XProfaner, die es gibt!


Il mio XProfan
Private Notizie
Eigenes Ablageforum
Argomenti-Merkliste
Eigene Beiträge
Eigene Argomenti
Zwischenablage
Annullare
 Deutsch English Français Español Italia
Traduzioni

Informativa sulla privacy


Wir verwenden Cookies nur als Session-Cookies wegen der technischen Notwendigkeit und bei uns gibt es keine Cookies von Drittanbietern.

Wenn du hier auf unsere Webseite klickst oder navigierst, stimmst du unserer Erfassung von Informationen in unseren Cookies auf XProfan.Net zu.

Weitere Informationen zu unseren Cookies und dazu, wie du die Kontrolle darüber behältst, findest du in unserer nachfolgenden Datenschutzerklärung.

einverstandenDatenschutzerklärung
Ich möchte keinen Cookie