XProfan

Deutsch

Hallo IF...

Ich habs mal getestet und hoffe nichts falsch gemacht zu haben:
Kompilieren Markieren Separieren

 $U thread.pcu = thread.
DEF @GetDlgCtrlID(1) !"USER32","GetDlgCtrlID"
DEF @ButtonClicked(1) @GetDlgCtrlID(@&(1))=-%MENUITEM
Testprogramm Timer
Profan Version 9
 $H Windows.ph
-Main----------------------------------------------------------------
Declare Timer_Busy%,Ende%
Declare TimerID&,Create%,T_Text&,Test#
WindowStyle 26
WindowTitle "Timertest PHU-60"
Window 100,100 - 370,200
cls
Let T_TEXT&=@CREATETEXT(%HWND,"",30,30,300,30)
-Menue---------------------------------------------------------------
PopUp "&Programm"
AppendMenu 108,"&Einstellungen"
AppendMenu 109,"&Ende"
Ende% = 0
Timer setzen (4x pro Sekunde, 250ms)
thread.start 1,1

WhileNot Ende%

    WaitInput

    If @MenuItem(108)

        Einstellungen

    Endif

    If @MenuItem(109)

        thread.stopall
        Ende% = 1

    Endif

Wend

End
-Proc Einstellungen

Proc Einstellungen

    Declare hD%, hA%, hB%, OK%, hTime%
    Declare hF1%, hT1%
    Clear OK%
    Dialogfenster erzeugen
    hD% = @Create("Dialog",%hWnd,"Einstellungen",%WinLeft+80,%WinTop+155,230,190)
    hF1% = @Create("Font","Arial",16,0,0,0,0)
    hT1% = @Create("Text",hD%,"Einstellungen...",10,10,220,20)
    SetFont hT1%,hF1%
    hTime% = @Create("TimeEdit", hD%, "00:00:00", 10, 35, 70, 24)
    hB% = @Create("Button",hD%,"&Nachstellen",10,120,100,28)
    hA% = @Create("Button",hD%,"&Abbrechen",120,120,100,28)

    WhileNot Ok%

        WaitInput

        If @ButtonClicked(hB%)  Nachstellen

            Ok% = 1
            Aktionen hier

        ElseIf @ButtonClicked(hA%) Abbrechen

            Ok% = 1

        ElseIf (%Key = 2) ALT+F4 bzw. schließen

            Ok% = 1

        EndIf

    EndWhile

    DeleteObject hF1%
    @DestroyWindow(hD%)

EndProc

-Prozedur die in bestimmten Zeitintervallen ausgefuehrt wird (4x pro Sekunde)

Proc thread.do

    parameters n&
    Dim Test#,1000000
    Inc Timer_Busy%
    Locate 5,5
    Print "Timer:" + @str$(Timer_Busy%) + " Durchläufe"
    Settext T_Text&,"Timer:" + @str$(Timer_Busy%) + " Durchläufe"
    Dispose Test#

EndProc

Auch hier wird das Fenster nicht richtig angezeigt!
Was bedeutet das? Werden im Hauptprogramm während ein Thread ausgeführt, überschreibt Profan intern gespeicherte Variablen zum Aufrufen von API. Je nachdem, welche Profanfunktionen im Hauptprogramm verwendet werden, ist die Gefahr mal mehr und mal weniger gegeben, sie ist aber auch (laut Roland) beim direkten Aufrufen von APIs vorhanden. Wann und ob ein Fehler auftritt, hängt vom gewählten Zeitintervall, vom Rechner und von der Programmbedienung durch den User ab.
Was bedeutet das genau?

Ein Beispiel:
Beim einem Rechner unter Windows2000 wird beim Aufruf der API RegUnloadKey ein solcher Crash verursacht und die API wird deshalb nicht korrekt ausgeführt. Daraufhin wird der Registryhive des User nicht wie geplant entladen und ist beim nächsten Start nicht mehr verfügbar => ein ganzes Userprofile ist unwiederbringlich verloren.

Ein anders Beispiel:
Das Hauptprogramm schreibt während ein Callback läuft in die Registry. Da alles ungünstig zusammentrifft, wird in einen anderen Schlüssel geschrieben und Datenj in der Registry gehen verloren!

Weitere Fragen und Anmerkungen?

09.09.2006 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

- Seite 3 -

Falsch verstanden, meine ich. Roland hat schon längst geantwortet - in seinem Forum

.
Probiers doch aus - schreib den Callback in eine DLL und spreche ihn von Profan über SetTimer an - das dauert doch nur wenige Minuten und ich kanns nicht.

09.09.2006 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

Ich wüsste jetzt leider Rolands Beitrag dazu nicht - schreib den Callback in eine DLL und spreche ihn von Profan über SetTimer an kann ich nicht umsetzen, die Aufgabenstellung verstehe ich nicht.

Wenn es hilft der Problematik etwas entgegenzuwirken dann nur raus damit...

09.09.2006 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

Wie gesagt - schreib irgendeine Funktion in eine DLL und ruf den Callback in einem Profanprogramm mit SetTimer auf - also aus diesem Quelltext
Kompilieren Markieren Separieren

DEF @GetDlgCtrlID(1) !"USER32","GetDlgCtrlID"
DEF @ButtonClicked(1) @GetDlgCtrlID(@&(1))=-%MENUITEM
Testprogramm Timer
Profan Version 9
 $H Windows.ph
-Main----------------------------------------------------------------
Declare Timer_Busy%,Ende%
Declare TimerID&,Create%,T_Text&,Test#
WindowStyle 26
WindowTitle "Timertest PHU-60"
Window 100,100 - 370,200
cls
Let T_TEXT&=@CREATETEXT(%HWND,"",30,30,300,30)
-Menue---------------------------------------------------------------
PopUp "&Programm"
AppendMenu 108,"&Einstellungen"
AppendMenu 109,"&Ende"
Ende% = 0
Timer setzen (4x pro Sekunde, 250ms)
TimerID& = ~SetTimer(%HWND,333,25,@ProcAddr("Timer",4))

WhileNot Ende%

    WaitInput

    If @MenuItem(108)

        Einstellungen

    Endif

    If @MenuItem(109)

        ~KillTimer(%HWND,333)
        Ende% = 1

    Endif

Wend

End
-Proc Einstellungen

Proc Einstellungen

    Declare hD%, hA%, hB%, OK%, hTime%
    Declare hF1%, hT1%
    Clear OK%
    Dialogfenster erzeugen
    hD% = @Create("Dialog",%hWnd,"Einstellungen",%WinLeft+80,%WinTop+155,230,190)
    hF1% = @Create("Font","Arial",16,0,0,0,0)
    hT1% = @Create("Text",hD%,"Einstellungen...",10,10,220,20)
    SetFont hT1%,hF1%
    hTime% = @Create("TimeEdit", hD%, "00:00:00", 10, 35, 70, 24)
    hB% = @Create("Button",hD%,"&Nachstellen",10,120,100,28)
    hA% = @Create("Button",hD%,"&Abbrechen",120,120,100,28)

    WhileNot Ok%

        WaitInput

        If @ButtonClicked(hB%)  Nachstellen

            Ok% = 1
            Aktionen hier

        ElseIf @ButtonClicked(hA%) Abbrechen

            Ok% = 1

        ElseIf (%Key = 2) ALT+F4 bzw. schließen

            Ok% = 1

        EndIf

    EndWhile

    DeleteObject hF1%
    @DestroyWindow(hD%)

EndProc

-Prozedur die in bestimmten Zeitintervallen ausgefuehrt wird (4x pro Sekunde)

Proc Timer

    Parameters P1&,P2&,P3&,P4&
    Dim Test#,1000000
    Inc Timer_Busy%
    Locate 5,5
    Print "Timer:" + @str$(Timer_Busy%) + " Durchläufe"
    Settext T_Text&,"Timer:" + @str$(Timer_Busy%) + " Durchläufe"
    Dispose Test#

EndProc

sol das
Kompilieren Markieren Separieren

Proc Timer

    Parameters P1&,P2&,P3&,P4&
    Dim Test#,1000000
    Inc Timer_Busy%
    Locate 5,5
    Print "Timer:" + @str$(Timer_Busy%) + " Durchläufe"
    Settext T_Text&,"Timer:" + @str$(Timer_Busy%) + " Durchläufe"
    Dispose Test#

EndProc

In eine Funktion einer DLL untergeracht werden.

Hier steht [...]

zu dem Problem, und hier steht [...]

09.09.2006 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

Aha ich habe die für mich entscheidene Aussage von Roland mal extrahiert:

[quote:a314d200ca] Die CallBacks in XPofan habe ich ja auch eher für die Fälle eingebaut, wo eine API-Funktion eine CallBack-Prozdur benötigt und erst zurückkehrt, nachdem diese ausgeführt wurde. [/quote:a314d200ca]
Diese Aussage begründet das ich ganz und garnicht daneben liege wenn ich sage das die Grundproblematik bei procaddr

liegt wenn eine Proc von aussen aufgerufen wird. Den Roland selbst meint mit obiger Aussage ja auch, das es besser ist wenn das XProfanprogramm wartet.

Demzufolge ist es egal ob die XProfanProc von der Api SetTimer, oder per Call aus einer anderen DLL ausgelöst wird. Wenn das XProfanprogramm nicht grade im Modus des wartens auf ein Funktionsende ist - dann gibts mächtig trouble.

Das wiederum ists worüber ich seid procaddr grüble - was aber auch bedeutet - das Roland vielleicht die Aufzurufenden Funktionen hinter der Procaddr-Adresse kapseln sollte - wie eine Wartehalle - welche dann durch Roland abgebaut wird wenn XProfan meint das es nichts zu tun hat.

09.09.2006 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

Wie gesagt: Bitte Testen! Interessiert mich brennend. Bau mal die Callback in eine DLL - dauert ja nicht lange...

09.09.2006 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

Jaja kein Problem - aber ich verstehe die Aufgabe immer noch nicht!

Die Callback in eine DLL bauen

Schreib doch einfach nen XProfan10 Zeiler für das XProfanprogramm, und ein anderes für das was ich in der DLL erledigen soll! Ich glaub diese Syntax liegt mir mehr... ;D

09.09.2006 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

...denn auch hier scheinst du die Hälfte überlesen zu haben:
[quote:ce4ddc094d]
Deine Analyse trifft das Problem recht genau: Bei Create ist die Chance, daß der Timer zur Unzeit (also während der Abarbeitung des Befehles) ausgelöst wird, deutlich höher als bei einem Control und dort etwas höher, als bei einem direkten API-Aufruf, aber auch da kann es nicht 100%ig ausgeschlossen werden.
[/quote:ce4ddc094d]
Das ist genau das was ich meine.
Und diese
[quote:ce4ddc094d]
Die CallBacks in XPofan habe ich ja auch eher für die Fälle eingebaut, wo eine API-Funktion eine CallBack-Prozdur benötigt und erst zurückkehrt, nachdem diese ausgeführt wurde.
[/quote:ce4ddc094d]
widerspricht deiner Aussage, das alle Callbacks problematisch sind. Wie gesagt, test!

Nochmals zu deinem Quelltext:
Ist ein guter Workaround, doch könnte man dann nicht gleich eine Schleife mit einem Wartebefehl der nach einer Eingabe abbricht einbauen? Zeitgerecht wird da doch gar nichts mehr ausgeführt, oder?

09.09.2006 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

Ne Andreas, ich habs nicht überlesen - aber wir reden auf verschiedenen Leveln - ich meins nicht böse. Ich durchschaue die Angelegenheit - darum geht es schon lange nicht mehr.

Ich merke aber das Du mich nicht so ganz verstehst - deshalb auch Deine Meinung das sich mein Posting mit dem Zitat widerspricht - was es aber in meinem Gedankenraum sogar untermalt.

Grunsatzdiskussion beiseite - laß uns morgen an der DLL feilen - mein Frauchen ruft...

Gute Nacht!

09.09.2006 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

OK! Gute Nacht!

09.09.2006 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

Frank
Abbing

[quote:5cd369ff12]Wie gesagt: Bitte Testen! Interessiert mich brennend. Bau mal die Callback in eine DLL - dauert ja nicht lange...[/quote:5cd369ff12]
Ich hatte das schon gemacht. Meine Dll hat einen Thread erzeugt und dieser hat eine profansche Callbackroutine aufgerufen. Nach mehreren Aufrufen brach Profan mit den sonderlichsten Fehlermeldungen ab. Je kürzer die Spanne der Aufrufe, desto schneller kamen die Fehler.

10.09.2006 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

Hallo IF...

Ich denke mal, wir sehen die Problematik wirklich an verschiedenen Stellen.
Hier der Beweis, das das nichts mit ProcAddr zu tun hat:
Kompilieren Markieren Separieren

DEF @GetDlgCtrlID(1) !"USER32","GetDlgCtrlID"
DEF @ButtonClicked(1) @GetDlgCtrlID(@&(1))=-%MENUITEM
Testprogramm Timer
Profan Version 9
 $H Windows.ph
-Main----------------------------------------------------------------
Declare Timer_Busy%,Ende%
Declare TimerID&,Create%,T_Text&,Test#
WindowStyle 26
WindowTitle "Timertest PHU-60"
Window 100,100 - 370,200
cls
Let T_TEXT&=@CREATETEXT(%HWND,"",30,30,300,30)
-Menue---------------------------------------------------------------
PopUp "&Programm"
AppendMenu 108,"&Einstellungen"
AppendMenu 109,"&Ende"
Ende% = 0
Timer setzen (4x pro Sekunde, 250ms)
TimerID& = ~SetTimer(%HWND,333,25,@ProcAddr("Timer",4))

WhileNot Ende%

    WaitInput

    If @MenuItem(108)

        Einstellungen

    Endif

    If @MenuItem(109)

        ~KillTimer(%HWND,333)
        Ende% = 1

    Endif

Wend

End
-Proc Einstellungen

Proc Einstellungen

    Declare hD%, hA%, hB%, OK%, hTime%
    Declare hF1%, hT1%
    Clear OK%
    Dialogfenster erzeugen
    Set("FastMode",1)
    hD% = @Create("Dialog",%hWnd,"Einstellungen",%WinLeft+80,%WinTop+155,230,190)
    hF1% = @Create("Font","Arial",16,0,0,0,0)
    hT1% = @Create("Text",hD%,"Einstellungen...",10,10,220,20)
    SetFont hT1%,hF1%
    hTime% = @Create("TimeEdit", hD%, "00:00:00", 10, 35, 70, 24)
    hB% = @Create("Button",hD%,"&Nachstellen",10,120,100,28)
    hA% = @Create("Button",hD%,"&Abbrechen",120,120,100,28)
    Set("FastMode",0)

    WhileNot Ok%

        WaitInput

        If @ButtonClicked(hB%)  Nachstellen

            Ok% = 1
            Aktionen hier

        ElseIf @ButtonClicked(hA%) Abbrechen

            Ok% = 1

        ElseIf (%Key = 2) ALT+F4 bzw. schließen

            Ok% = 1

        EndIf

    EndWhile

    DeleteObject hF1%
    @DestroyWindow(hD%)

EndProc

-Prozedur die in bestimmten Zeitintervallen ausgefuehrt wird (4x pro Sekunde)

Proc Timer

    Parameters P1&,P2&,P3&,P4&
    Dim Test#,1000000
    Inc Timer_Busy%
    Locate 5,5
    Print "Timer:" + @str$(Timer_Busy%) + " Durchläufe"
    Settext T_Text&,"Timer:" + @str$(Timer_Busy%) + " Durchläufe"
    Dispose Test#

EndProc

Wie du siehst, das geht - also gibt es auch mit Subclassing im Prinzip keine Probleme, egal woran es liegen sollte. Ich habe hier einfach nur das Message Handling abgeschaltet - was wohl auch eine Ursache der Problematik ist.

Hier etwas zum Timer:
Kompilieren Markieren Separieren

 $H Windows.ph
 $H Messages.ph
Declare Ende%, OldWndProc&, hButton%
Declare P_A$,P_A&,TIMERID&

Proc Timer_Sub

    Parameters hWnd&,Message&,wParam&,lParam&

    If Message& = ~WM_TIMER

        Locate 0,0
        Print "Timermessage in WndProc empfangen: "+@STR$(wParam&)

    Else

        Return ~CallWindowProc(OldWndProc&,hWnd&,Message&,wParam&,lParam&)

    EndIf

EndProc

Set("FastMode", 1)
Window 0,0 -640,440
LET P_A$=@INPUT$("Adresse der TimerProc:","Funktionsadresse",@STR$(@ProcAddr("TimerProc",4)))

IF P_a$=""

    END

else

    LET P_A&=@VAL(P_A$)

endif

OldWndProc& = ~GetWindowLong(%hWnd,~GWL_WNDPROC)
~SetWindowLong(%hWnd,~GWL_WNDPROC,@ProcAddr("Timer_Sub",4))
LET hButton%=@Create("Button",%hWnd,"Ende",10,100,100,24)
TimerID& = ~SetTimer(%HWND,333,20000,P_A&)
Clear Ende%

WhileNot Ende%

    WaitInput

    If %Key = 2

        Ende% = 1

    ElseIf @Clicked(hButton%)

        Ende% = 1

    EndIf

EndWhile

~KillTimer(%HWND,333)
~SetWindowLong(%hWnd,~GWL_WNDPROC,OldWndProc&)
End

Proc TimerProc

    Parameters 1&,2&,3&,4&
    Locate 2,0
    Print "TimerProc über Adresse aufgerufen: "+@STR$(3&)

endproc

Wie man sieht, erreicht der Timer die WndProc gar nicht. Gib mal im Edit 0 ein, statt der Adresse - dann siehts anders aus.

Hier noch mal mit externer DLL (so wie ich das meinte):
Die DLL
Kompilieren Markieren Separieren

 $DLL
-Prozedur die in bestimmten Zeitintervallen ausgefuehrt wird (4x pro Sekunde)
Declare Timer_Busy%

dllproc Timer,4

    Parameters P1&,P2&,P3&,P4&
    Dim Test#,1000000
    Inc Timer_Busy%
    Settext P3&,"Timer:" + @str$(Timer_Busy%) + " Durchläufe"
    Dispose Test#

EndProc

und hier das Hauptprogramm
Kompilieren Markieren Separieren

DEF @GetDlgCtrlID(1) !"USER32","GetDlgCtrlID"
DEF @ButtonClicked(1) @GetDlgCtrlID(@&(1))=-%MENUITEM
DEF @GetProcAddress(2) !"KERNEL32","GetProcAddress"
Testprogramm Timer
Profan Version 9
 $H Windows.ph
-Main----------------------------------------------------------------
Declare Ende%,DLL&,P_A&
Declare TimerID&,Create%,T_Text&,Test#
LET DLL&=@Usedll("Thread.DLL")
WindowStyle 26+512
WindowTitle "Timertest PHU-60"
Window 100,100 - 370,200
cls
Usermessages $10
LET P_A&=@GetProcAddress(DLL&,"_timer@16")
Print P_A&,DLL&
Let T_TEXT&=@CREATETEXT(%HWND,"",30,30,300,30)
-Menue---------------------------------------------------------------
PopUp "&Programm"
AppendMenu 108,"&Einstellungen"
AppendMenu 109,"&Ende"
Ende% = 0
Timer setzen (4x pro Sekunde, 250ms)
TimerID& = ~SetTimer(%HWND,T_TEXT&,25,P_A&)

WhileNot Ende%

    WaitInput

    IF %UMESSAGE=$10

        LET ENDE%=1

    endif

    If @MenuItem(108)

        Einstellungen

    Endif

    If @MenuItem(109)

        ~KillTimer(%HWND,T_TEXT&)
        Ende% = 1

    Endif

Wend

~KillTimer(%HWND,T_TEXT&)
FreeDLL DLL&
End
-Proc Einstellungen

Proc Einstellungen

    Declare hD%, hA%, hB%, OK%, hTime%
    Declare hF1%, hT1%
    Clear OK%
    Dialogfenster erzeugen
    hD% = @Create("Dialog",%hWnd,"Einstellungen",%WinLeft+80,%WinTop+155,230,190)
    hF1% = @Create("Font","Arial",16,0,0,0,0)
    hT1% = @Create("Text",hD%,"Einstellungen...",10,10,220,20)
    SetFont hT1%,hF1%
    hTime% = @Create("TimeEdit", hD%, "00:00:00", 10, 35, 70, 24)
    hB% = @Create("Button",hD%,"&Nachstellen",10,120,100,28)
    hA% = @Create("Button",hD%,"&Abbrechen",120,120,100,28)

    WhileNot Ok%

        WaitInput

        If @ButtonClicked(hB%)  Nachstellen

            Ok% = 1
            Aktionen hier

        ElseIf @ButtonClicked(hA%) Abbrechen

            Ok% = 1

        ElseIf (%Key = 2) ALT+F4 bzw. schließen

            Ok% = 1

        EndIf

    EndWhile

    DeleteObject hF1%
    @DestroyWindow(hD%)

EndProc

-Prozedur die in bestimmten Zeitintervallen ausgefuehrt wird (4x pro Sekunde)

Proc Timer

    Parameters P1&,P2&,P3&,P4&
    Dim Test#,1000000
    Inc Timer_Busy%
    Settext P3&,"Timer:" + @str$(Timer_Busy%) + " Durchläufe"
    Dispose Test#

EndProc

Funktioniert ebenfalls.
Und hier zum Vergleich ohne DLL:
Kompilieren Markieren Separieren

DEF @GetDlgCtrlID(1) !"USER32","GetDlgCtrlID"
DEF @ButtonClicked(1) @GetDlgCtrlID(@&(1))=-%MENUITEM
DEF @GetProcAddress(2) !"KERNEL32","GetProcAddress"
Testprogramm Timer
Profan Version 9
 $H Windows.ph
-Main----------------------------------------------------------------
Declare Timer_Busy%,Ende%
Declare TimerID&,Create%,T_Text&,Test#
WindowStyle 26+512
WindowTitle "Timertest PHU-60"
Window 100,100 - 370,200
cls
Usermessages $10
Let T_TEXT&=@CREATETEXT(%HWND,"",30,30,300,30)
-Menue---------------------------------------------------------------
PopUp "&Programm"
AppendMenu 108,"&Einstellungen"
AppendMenu 109,"&Ende"
Ende% = 0
Timer setzen (4x pro Sekunde, 250ms)
TimerID& = ~SetTimer(%HWND,T_TEXT&,25,@ProcAddr("Timer",4))

WhileNot Ende%

    WaitInput

    IF %UMESSAGE=$10

        LET ENDE%=1

    endif

    If @MenuItem(108)

        Einstellungen

    Endif

    If @MenuItem(109)

        ~KillTimer(%HWND,T_TEXT&)
        Ende% = 1

    Endif

Wend

End
-Proc Einstellungen

Proc Einstellungen

    Declare hD%, hA%, hB%, OK%, hTime%
    Declare hF1%, hT1%
    Clear OK%
    Dialogfenster erzeugen
    hD% = @Create("Dialog",%hWnd,"Einstellungen",%WinLeft+80,%WinTop+155,230,190)
    hF1% = @Create("Font","Arial",16,0,0,0,0)
    hT1% = @Create("Text",hD%,"Einstellungen...",10,10,220,20)
    SetFont hT1%,hF1%
    hTime% = @Create("TimeEdit", hD%, "00:00:00", 10, 35, 70, 24)
    hB% = @Create("Button",hD%,"&Nachstellen",10,120,100,28)
    hA% = @Create("Button",hD%,"&Abbrechen",120,120,100,28)

    WhileNot Ok%

        WaitInput

        If @ButtonClicked(hB%)  Nachstellen

            Ok% = 1
            Aktionen hier

        ElseIf @ButtonClicked(hA%) Abbrechen

            Ok% = 1

        ElseIf (%Key = 2) ALT+F4 bzw. schließen

            Ok% = 1

        EndIf

    EndWhile

    DeleteObject hF1%
    @DestroyWindow(hD%)

EndProc

-Prozedur die in bestimmten Zeitintervallen ausgefuehrt wird (4x pro Sekunde)

Proc Timer

    Parameters P1&,P2&,P3&,P4&
    Dim Test#,1000000
    Inc Timer_Busy%
    Settext P3&,"Timer:" + @str$(Timer_Busy%) + " Durchläufe"
    Dispose Test#

EndProc

was wieder den Fehler verursacht.
Meiner Meinung nach liegt dieses spezielle Problem wirklich an WM_TIMER - aber ich beim besten Willen kein Experte und lasse mich auch gern (am liebsten durch beweisfähige Quelltexte) vom Gegenteil überzeugen.

10.09.2006 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

Und diese drei Quelltexte wären da unter anderem auch noch interessant:
Kompilieren Markieren Separieren

DEF @GetDlgCtrlID(1) !"USER32","GetDlgCtrlID"
DEF @ButtonClicked(1) @GetDlgCtrlID(@&(1))=-%MENUITEM
DEF @GetProcAddress(2) !"KERNEL32","GetProcAddress"
Testprogramm Timer
Profan Version 9
 $H Windows.ph
-Main----------------------------------------------------------------
Declare Timer_Busy%,Ende%
Declare TimerID&,Create%,T_Text&,Test#,T_TEXT2&
Declare OldWndProc&,DLL&,P_A&
LET DLL&=@Usedll("Send.DLL")
WindowStyle 26+512
WindowTitle "Subclassingtest"
Window 100,100 - 370,200
Let T_TEXT&=@CREATEButton(%HWND,"",30,80,300,30)
Let T_TEXT2&=@CREATEButton(%HWND,"Ende",30,120,300,30)
Waitinput
Set("FastMode", 1)
OldWndProc& = ~GetWindowLong(%hWnd,~GWL_WNDPROC)
LET P_A&=@GetProcAddress(DLL&,"_timer@16")
~SetWindowLong(%hWnd,~GWL_WNDPROC,@ProcAddr("Sub",4))
Ende%=0
TimerID&=~SetTimer(%HWND,333,20,P_A&)
Print TimerID&

WhileNot Ende%

    WaitInput

    If @Buttonclicked(T_TEXT&)

        Einstellungen

    Endif

    If @Buttonclicked(T_TEXT2&)

        ~KillTimer(%HWND,333)
        Ende%=1
        Freedll DLL&

    Endif

Wend

End
-Proc Einstellungen

Proc Einstellungen

    Declare hD%, hA%, hB%, OK%, hTime%
    Declare hF1%, hT1%
    Clear OK%
    Dialogfenster erzeugen
    hD% = @Create("Dialog",%hWnd,"Einstellungen",%WinLeft+80,%WinTop+155,230,190)
    hD% = @Control("Dialog","Einstellungen",$14C80084,%WinLeft+80,%WinTop+155,230,190,%HWND,0,%HINSTANCE,$101)
    hF1% = @Create("Font","Arial",16,0,0,0,0)
    hT1% = @Create("Text",hD%,"Einstellungen...",10,10,220,20)
    SetFont hT1%,hF1%
    hTime% = @Create("TimeEdit", hD%, "00:00:00", 10, 35, 70, 24)
    hB% = @Create("Button",hD%,"&Nachstellen",10,120,100,28)
    hA% = @Create("Button",hD%,"&Abbrechen",120,120,100,28)

    WhileNot Ok%

        WaitInput

        If @ButtonClicked(hB%)  Nachstellen

            Ok% = 1
            Aktionen hier

        ElseIf @ButtonClicked(hA%) Abbrechen

            Ok% = 1

        ElseIf (%Key = 2) ALT+F4 bzw. schließen

            Ok% = 1

        EndIf

    EndWhile

    DeleteObject hF1%
    @DestroyWindow(hD%)

EndProc

Proc Sub

    Parameters hWnd&,Message&,wParam&,lParam&

    If Message&=$401

        Inc Timer_Busy%
        Settext T_Text&,"Timer: " + @str$(Timer_Busy%) + " Durchläufe"
        Return ~CallWindowProc(OldWndProc&,hWnd&,Message&,wParam&,lParam&)

    Else

        Return ~CallWindowProc(OldWndProc&,hWnd&,Message&,wParam&,lParam&)

    EndIf

EndProc

Kompilieren Markieren Separieren

DEF @GetDlgCtrlID(1) !"USER32","GetDlgCtrlID"
DEF @ButtonClicked(1) @GetDlgCtrlID(@&(1))=-%MENUITEM
DEF @GetProcAddress(2) !"KERNEL32","GetProcAddress"
Testprogramm Timer
Profan Version 9
 $H Windows.ph
-Main----------------------------------------------------------------
Declare Timer_Busy%,Ende%
Declare TimerID&,Create%,T_Text&,Test#,T_TEXT2&
Declare OldWndProc&,DLL&,P_A&
LET DLL&=@Usedll("Send.DLL")
WindowStyle 26+512
WindowTitle "Subclassingtest 2"
Window 100,100 - 370,200
Let T_TEXT&=@CREATEButton(%HWND,"",30,80,300,30)
Let T_TEXT2&=@CREATEButton(%HWND,"Ende",30,120,300,30)
Waitinput
Set("FastMode", 1)
OldWndProc& = ~GetWindowLong(%hWnd,~GWL_WNDPROC)
LET P_A&=@GetProcAddress(DLL&,"_timer@16")
~SetWindowLong(%hWnd,~GWL_WNDPROC,@ProcAddr("Sub",4))
Ende%=0
TimerID&=~SetTimer(%HWND,333,25,@ProcAddr("Sub",4))
Print TimerID&

WhileNot Ende%

    WaitInput

    If @Buttonclicked(T_TEXT&)

        Einstellungen

    Endif

    If @Buttonclicked(T_TEXT2&)

        ~KillTimer(%HWND,333)
        Ende%=1
        Freedll DLL&

    Endif

Wend

End
-Proc Einstellungen

Proc Einstellungen

    Declare hD%, hA%, hB%, OK%, hTime%
    Declare hF1%, hT1%
    Clear OK%
    Dialogfenster erzeugen
    hD% = @Create("Dialog",%hWnd,"Einstellungen",%WinLeft+80,%WinTop+155,230,190)
    hD% = @Control("Dialog","Einstellungen",$14C80084,%WinLeft+80,%WinTop+155,230,190,%HWND,0,%HINSTANCE,$101)
    hF1% = @Create("Font","Arial",16,0,0,0,0)
    hT1% = @Create("Text",hD%,"Einstellungen...",10,10,220,20)
    SetFont hT1%,hF1%
    hTime% = @Create("TimeEdit", hD%, "00:00:00", 10, 35, 70, 24)
    hB% = @Create("Button",hD%,"&Nachstellen",10,120,100,28)
    hA% = @Create("Button",hD%,"&Abbrechen",120,120,100,28)

    WhileNot Ok%

        WaitInput

        If @ButtonClicked(hB%)  Nachstellen

            Ok% = 1
            Aktionen hier

        ElseIf @ButtonClicked(hA%) Abbrechen

            Ok% = 1

        ElseIf (%Key = 2) ALT+F4 bzw. schließen

            Ok% = 1

        EndIf

    EndWhile

    DeleteObject hF1%
    @DestroyWindow(hD%)

EndProc

Proc Sub

    Parameters hWnd&,Message&,wParam&,lParam&
    Inc Timer_Busy%
    Settext T_Text&,"Timer: " + @str$(Timer_Busy%) + " Durchläufe"

EndProc

Kompilieren Markieren Separieren

 $DLL
-Prozedur die in bestimmten Zeitintervallen ausgefuehrt wird (4x pro Sekunde)
Declare Timer_Busy%,WND&

dllproc Timer,4

    Parameters P1&,P2&,P3&,P4&
    @SendMessage(@FindWindow("Subclassingtest"),$401,0,0)

EndProc