(339)  Login

English
Source / code snippets

Timer-Button

 

RudiB.
Have time again what gebastelt....a TIMER-BUTTON
simply time try, i hope so is selbsterklärend...
CompileMarkSeparation
Window 100,100-800,500
Window Title "Es becomes The Time measured , How long the Timer-Button pressed remaining..."
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-request)

    If Getfocus(button_dummy&)

        CLS:setfocus(%Hwnd)
        Settext edit_status&,"Dummy-Button watts straight clicked >>> CLS"

    ElseIf getfocus(button_Anleitung&)

        guide

    ElseIf getfocus(button_ende&)

        End

    Else

        GetStatus_TimerButton

    endif

EndWhile

End

Proc GetStatus_TimerButton

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

    If z&>600'left Mouse button pressed

        inc stop&
        sek&=((&gettickcount-zeit&)/10)-sekundaer_sek&
        Settext edit_status&,"Linke Mouse button on Timer-Button is straight gedrückt"

    Else

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

    EndIf

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

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

    EndIf

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

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

        settext edit&,st$(sek&/100)+" ms"
        Text$="Timer-Button watts "+st$(sek&/100)+" sec long pressed ......    "
        Settext edit_status&,Text$
        setfocus(%Hwnd)
        settext edit&,st$(sek&/100)+" ms"
        '-------------------------------------------------------------------------------------------
        '------In dependence of Timer-worth becomes here a action carryed out ---------------------

        If sek&/100>1.5

            Rectangle 200,350 - 550,400

        Endif

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

            ellipsis 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 new read

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

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

    EndIf

    If (%mousepressed=2) And (z&>0)'right Click on Timer-Button (Timerwert becomes on 0.00 staid)

        settext edit&,"0.00 ms"
        Settext edit_status&,"Rechte Mouse button on Timer-Button watts straight geklickt"

    EndIf

ENDPROC

Proc guide

    Locate 1,1
    Print "Linke Mouse button on Timer-Button pressed hold...Time becomes in ms in the Timer-Button-Edit angezeigt"
    Print "In dependence of Timerwert becomes a action carryed out...go ahead demonstration-Zwecken."
    Print "mehr as 1,5 sek -------- it'll one rectangle gezeichnet"
    Print "zwischen 1,0 - 1,5 sek -- it'll a ellipsis gezeichnet"
    Print "zwischen 0,5 - 1,0 sek -- it'll a line gezeichnet"
    Print "weniger as 0,5 sek ----- it'll one CLS carryed out."
    Print "Rechte Mouse button on Timer-Button clicking setting whom Timerwert on 0.00 ms back..."
    Print "Dummy-Button power just one CLS...."
    Print "Ende-Button must I do not explain, or ???"
    setfocus(%Hwnd)

ENDPROC
 
Xprofan X4
Rudolf Beske / München

Hardware: NB Intel I9 - 16GByte RAM
05/28/21  ▲
 




p.specht

"In dependence of Timer-worth becomes here a action carryed out..." - coole idea!

Mehrfachausnutzung of Buttons want but of/ one klaren Trennung between KURZEM and LONG DRUCK. with my chinese Würfelradio-bluetooth-mp3player click I regularly wrong. so catches the 1-hours-talk on mp3 jedesmal of in front on, instead of in interval to go. means: Eindeutige times are important!
 
XProfan 11
Computer: Gerät, daß es in Mikrosekunden erlaubt, 50.000 Fehler zu machen, zB 'daß' statt 'das'...
05/28/21  ▲
 




RudiB.
and another moreover Variante the Timer-Buttons ....here comes colour in that game.

 
XProfan X4
Xprofan X4
Rudolf Beske / München

Hardware: NB Intel I9 - 16GByte RAM
05/28/21  ▲
 




RudiB.

"In dependence of Timer-worth becomes here a action carryed out..." - coole idea!


now Yes....soooo far have I yet not virtual. in the momentum bastele I sooner only on the Optik. The remainder comes then....
 
XProfan X4
Xprofan X4
Rudolf Beske / München

Hardware: NB Intel I9 - 16GByte RAM
05/28/21  ▲
 




Georg
Teles
Nabend,

coole idea !
for something CPU Entlastung possible WaitInput and Timer add would well
CompileMarkSeparation
Window 100,100-800,500
Window Title "Es becomes The Time measured , How long the Timer-Button pressed remaining..."
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-request)

    WaitInput

    If %wmtimer

        If Getfocus(button_dummy&)

            CLS:setfocus(%Hwnd)
            Settext edit_status&,"Dummy-Button watts straight clicked >>> CLS"

        ElseIf getfocus(button_Anleitung&)

            guide

        ElseIf getfocus(button_ende&)

            End

        Else

            GetStatus_TimerButton

        endif

    EndIf

EndWhile

KillTimer
End

Proc GetStatus_TimerButton

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

    If z&>600'left Mouse button pressed

        inc stop&
        sek&=((&gettickcount-zeit&)/10)-sekundaer_sek&
        Settext edit_status&,"Linke Mouse button on Timer-Button is straight 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&,st$(sek&/100)+" ms"

    EndIf

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

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

        settext edit&,st$(sek&/100)+" ms"
        Text$="Timer-Button watts "+st$(sek&/100)+" sec long pressed ......    "
        Settext edit_status&,Text$
        setfocus(%Hwnd)
        settext edit&,st$(sek&/100)+" ms"
        '-------------------------------------------------------------------------------------------
        '------In dependence of Timer-worth becomes here a action carryed out ---------------------

        If sek&/100>1.5

            Rectangle 200,350 - 550,400

        Endif

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

            ellipsis 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 new read

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

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

    EndIf

    If (%mousepressed=2) And (z&>0)'right Click on Timer-Button (Timerwert becomes on 0.00 staid)

        settext edit&,"0.00 ms"
        Settext edit_status&,"Rechte Mouse button on Timer-Button watts straight geklickt"

    EndIf

ENDPROC

Proc guide

    Locate 1,1
    Print "Linke Mouse button on Timer-Button pressed hold...Time becomes in ms in the Timer-Button-Edit angezeigt"
    Print "In dependence of Timerwert becomes a action carryed out...go ahead demonstration-Zwecken."
    Print "mehr as 1,5 sek -------- it'll one rectangle gezeichnet"
    Print "zwischen 1,0 - 1,5 sek -- it'll a ellipsis gezeichnet"
    Print "zwischen 0,5 - 1,0 sek -- it'll a line gezeichnet"
    Print "weniger as 0,5 sek ----- it'll one CLS carryed out."
    Print "Rechte Mouse button on Timer-Button clicking setting whom Timerwert on 0.00 ms back..."
    Print "Dummy-Button power just one CLS...."
    Print "Ende-Button must I do not explain, or ???"
    setfocus(%Hwnd)

ENDPROC

PROC FAERBESTATIC

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

ENDPROC

Regards
 
XProfan X2
TC-Programming [...] 
XProfan 8.0 - 10.0 - X2 - X3 - X4

10/19/22  ▲
 




RudiB.
having I already almost again forget....

thanks.....teste I time from ......
 
XProfan X4
Xprofan X4
Rudolf Beske / München

Hardware: NB Intel I9 - 16GByte RAM
10/19/22  ▲
 



Zum Quelltext


Topictitle, max. 100 characters.
 

Systemprofile:

no Systemprofil laid out. [anlegen]

XProfan:

 Posting  Font  Smilies  ▼ 

Please register circa a Posting To verfassen.
 

Topic-Options

Unreaded
subscribe
Remember-List
Notes
guests
Delete
Permanent
Done

3.275 Views

Untitledvor 0 min.
E.T.12/27/23
Axel Berse08/13/23
ecki07/28/23
Manfred Barei05/05/23
More...

Themeninformationen

this Topic has 3 subscriber:

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


Admins  |  AGB  |  Applications  |  Authors  |  Chat  |  Privacy Policy  |  Download  |  Entrance  |  Help  |  Merchantportal  |  Imprint  |  Mart  |  Interfaces  |  SDK  |  Services  |  Games  |  Search  |  Support

One proposition all XProfan, The there's!


My XProfan
Private Messages
Own Storage Forum
Topics-Remember-List
Own Posts
Own Topics
Clipboard
Log off
 Deutsch English Français Español Italia
Translations

Privacy Policy


we use Cookies only as Session-Cookies because of the technical necessity and with us there no Cookies of Drittanbietern.

If you here on our Website click or navigate, stimmst You ours registration of Information in our Cookies on XProfan.Net To.

further Information To our Cookies and moreover, How You The control above keep, find You in ours nachfolgenden Datenschutzerklärung.

all rightDatenschutzerklärung
i want none Cookie