English
Forum

counter without Timer

 

Jörg
Sellmeyer
Hi,

How could I a counter release, the quasi with voller speed counts, during my Hauptprogramm in the Waitinput on a input wait?
with folgendem small code standing the counter. If I but the mouse move raging it go. These speed bräuchte I dauernd. gives it a Message, The dauernd übermittelt becomes? One Timer is In any drop too slow.
Cls
Declare Counter%

SubClassProc

    'If SubClassMessage(%hwnd,?)
    Inc Counter%

    If Counter% = 385

        Counter% = 1
        Cls

    EndIf

    'EndIf

ENDPROC

Subclass %hwnd,1
Screen 4000,500

While 1

    WaitInput
    Window Title Str $(Counter%)

    If IsKey($20)

        DrawText Counter% * 10,40,"!"

    ElseIf IsKey(27)

        Break

    EndIf

Wend

Subclass %hwnd,0
 
Windows XP SP2 XProfan X4
... und hier mal was ganz anderes als Profan ...
09/27/11  
 




Nico
Madysa
In XProfan X2 would the well with Multiprozessing To solve.

RGH
so would about The often asked Time in the Headline resolved go:
Proc SetTitleTime

    parameters handle&
    var end% = 0

    whilenot end%

        setText handle&, dt("getdate", 6)
        case getText$(handle&) = "" : end% = 1
        sleep 100

    endwhile

endproc

Randomize
windowstyle 24 + 512
Window 100,550-500,200
pExec("|SetTitleTime", %hWnd)
var end% = 0

whilenot end%

    waitinput
    case %key = 2 : end% = 1

endwhile

end



otherwise wären Threads a Solution. have with XPSE and NProcs something hingezimmert get, the about the power, what You want:
 {$cleq}
Cls

nproc Timer

    parameters addr&

    whilenot Long(addr&,0) < 0

        Sleep(1)
        Long addr&,0 = Long(addr&,0) + 1
        SetText %hWnd,st$(Long(addr&,0))

        if Long(addr&,0) >= 385

            Long addr&,0 = 0
            BitBlt(%hDC,0,0,4000,500,%hDC,0,0,WHITENESS)

        endif

    wend

    ExitThread(0)

ENDPROC

var id& = 0
var exit& = 0
declare count#
dim count#,4
CreateThread(0,0,ProcAddr(Timer,1),count#,0,Addr(id&))
Screen 4000,500

While 1

    WaitInput
    Window Title Str $(Long(count#,0))

    If IsKey($20)

        DrawText Long(count#,0) * 10,40,"!"

    ElseIf IsKey(27)

        Long count#,0 = -10
        Break

    EndIf

Wend

if GetExitCodeThread(id&,Addr(exit&)) = STILL_ACTIVE

    whileloop 5

        print "Thread yet active ..."
        Sleep 100
        casenot GetExitCodeThread(id&,Addr(exit&)) = STILL_ACTIVE : break

    EndWhile

    case GetExitCodeThread(id&,Addr(exit&)) = STILL_ACTIVE : TerminateThread(id&,0)

endif

Dispose count#
end

naturally are some Dummejungenfehler drin, but at least by me functions it.
here The Exe:
Download
external Download

1.373 kB
Hochgeladen:09/27/11
Downloadcounter26
Download
 
09/27/11  
 



@Jörg: windows counts already always z.B. in getTickCount ^^ -

if you you means to that Time X whom getTickCount merkst then can always by difference determined how far ("im Hintergrund") counted watts.

Jörg Sellmeyer (27.09.11)
These speed bräuchte I dauernd. gives it a Message, The dauernd übermittelt becomes?


Noe -

the program would otherwise too "immer" busy. ^^
 
09/27/11  
 




RGH
Why not one own Process:
Declare hFileMap&, Buffer#, Counter%
Dim Buffer#, 5' Space for a LongInt + 1 CLS-Flag

Proc Counter

    ' Eigener Process, therefore no globaler Variablenzugriff
    Declare c_hFileMap&, c_Buffer#, c_Counter%
    Dim c_Buffer#, 5' Space for a LongInt
    c_hFileMap& = FileMap("Open", "Counter")
    c_Counter% = 0
    ' Speicherdate existing: go goes's with count

    If c_hFileMap&

        c_Buffer# = FileMap("Map", c_hFileMap&)
        Long c_Buffer#, 0 = c_Counter%
        byte c_Buffer#, 4 = 0' CLS-Flag on 0

        While 1

            Sleep 10' for Testzwecke to that better Understand
            Inc c_Counter%

            If c_Counter% = 385

                c_Counter% = 1
                byte c_Buffer#, 4 = 1' CLS-Flag on 1

            EndIf

            Long c_Buffer#, 0 = c_Counter%

        EndWhile

        Dispose c_Buffer#
        FileMap("Close", c_hFileMap&)

    Else

        MessageBox("Speicherdatei couldn't opened go!", "MAP-Hinweis", 48)

    EndIf

ENDPROC

CLS
Screen 4000,500
counter% = 0
hFileMap& = Create("FileMap", "Counter", 4)

If hFileMap&

    Buffer# = FileMap("Map", hFileMap&)

Else

    MessageBox("Speicherdatei couldn't prepares go!", "Hinweis", 48)

EndIf

' Speicherdatei is prepared: The Process Conter can launched go
var hCounter& = PExec("|Counter")

While 1

    WaitInput
    Counter% = Long(Buffer#, 0)

    If byte(Buffer#, 4 = 1)

        CLS
        byte Buffer#, 4 = 0' CLS-Flag zurücksetzen

    EndIf

    Window Title Str $(Counter%)

    If IsKey($20)

        DrawText Counter% * 10,40,"!"

    ElseIf IsKey(27)

        Break

    EndIf

EndWhile

' Conter-Process terminate!
process("kill", hCounter&, 0)
Dispose Buffer#
FileMap("Close", hFileMap&)
End

Greeting
Roland

EDIT: there was someone faster, if something differently ...
 
XProfan X2
Intel Duo E8400 3,0 GHz / 4 GB RAM / 1000 GB HDD - ATI Radeon HD 4770 512 MB - Windows 7 Home Premium 32Bit - XProfan X4
09/27/11  
 



RGH (27.09.11)
Why not one own Process:


The Initialisierung is unfortunately very Systemlastig!
 
09/27/11  
 




Nico
Madysa
RGH (27.09.11)
Why not one own Process:


because I since the Adressen not so simply had transfer can. I have whom code only fix to the lunch hingepinselt and wished me not still in Filemaps reading. but so, How du's made have, geht's naturally too.
 
09/27/11  
 




Jörg
Sellmeyer
I hab's me already virtual. time schaun, what itself there make can. I had hoped, the ließe itself (Thanks Wunderwaffe Subclassing) in a Program manage.
thanks for suggestions and Codes!
 
Windows XP SP2 XProfan X4
... und hier mal was ganz anderes als Profan ...
09/28/11  
 



how'bout with Opcode on The createThread-API transfer so You at a Speicherstelle always a Zählerwert have?
 
09/28/11  
 




Jörg
Sellmeyer
the says me nothing
 
Windows XP SP2 XProfan X4
... und hier mal was ganz anderes als Profan ...
09/28/11  
 



How quick should because counted go? I take not on the You with 100% CPU-Last "zählen" want and so I the question. I could then z.B. simply bisl nativen Opcode in a area write and the by createThread to process indicate.
 
09/28/11  
 




Jörg
Sellmeyer
Ah Yes. I faith, that with the count functions so already. in the momentum nervt me something other. Register again.
 
Windows XP SP2 XProfan X4
... und hier mal was ganz anderes als Profan ...
09/29/11  
 



Answer


Topictitle, max. 100 characters.
 

Systemprofile:

no Systemprofil laid out. [anlegen]

XProfan:

 Posting  Font  Smilies  ▼ 

Please register circa a Posting To verfassen.
 

Topic-Options

2.234 Views

Untitledvor 0 min.
Tango07/14/17
Jörg Sellmeyer12/03/15
GDL09/03/15
Peter Max Müller05/16/15
More...

Themeninformationen



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