XProfan

 $DLL

DLLPROC Count_C,1,"Count_C"

    parameters param#
    declare i&,a&,s$,hAufrufer&,ThreadRunning#,hText&,StartWert&
    s$=@string$(param#,0)
    'als erstes das Flag für das aufrufende Programm setzen, dass der Thread läuft
    a&=val(@substr$(s$,2,"²~³"))
    ThreadRunning#=a&
    long ThreadRunning#,0=1
    'Aufrufer-Fensterhandle ermitteln
    hAufrufer&=@val(@substr$(s$,1,"²~³"))
    'Textcontrol-Handle ermitteln
    hText&=@val(@substr$(s$,3,"²~³"))
    'Startwert ermitteln
    StartWert&=@val(@substr$(s$,4,"²~³"))
    'Zählung durchführen
    i&=StartWert&

    while i&<=StartWert&+10000

        settext hText&,@str$(i&)
        inc i&

    endwhile

    'Rückgabewert übermitteln
    @sendmessage(hAufrufer&,$1000,hText&,0)
    long ThreadRunning#,0=0'Flag für das aufrufende Programm dafür, dass der Thread läuft, löschen
    return 0

ENDPROC

'Multithreading-Beispiel mit XProfan-ThreadProc in C-DLL über Profan2Cpp
 $H windows.ph
declare hDLL%,uwp&,CProcAddr&
declare hText1&,hText2&,hText3&
declare s1$,s2$,s3$
declare hThread1&,hThread2&,hThread3&
declare ThreadRunning1&,ThreadRunning2&,ThreadRunning3&
cls ~getsyscolor(4)'Hauptfenster mit Hintergrundgrau erstellen (weil die Text-Dialogelemente in dieser Farbe gehalten sind)
usermessages $1000'mit dieser Message signalisiert ein Thread, dass er sich nun beendet (das kann zusätzlich mit den Flags ThreadRunningX& überprüft werden, was in diesem Beispiel aber nicht benutzt wird)
hText1&=@create("TEXT",%HWnd,"0",10,10,300,20)'hier wird Thread 1 reinschreiben
hText2&=@create("TEXT",%HWnd,"0",10,35,300,20)'hier wird Thread 2 reinschreiben
hText3&=@create("TEXT",%HWnd,"0",10,60,300,20)'hier wird Thread 3 reinschreiben
hDLL%=@usedll("MultithreadingBeispielC.dll")'in dieser DLL ist die Thread-Prozedur enthalten
'Threads starten
CProcAddr&=~GetProcAddress(hDLL%,"Count_C")'"echte" ProcAddr der in die DLL ausgelagerten Prozedur beziehen (mit direkten Profan-Prozeduren geht das nicht, sodass Profan selbst nicht multithreading-fähig ist)
s1$=@str$(%HWnd)+"²~³"+@str$(@addr(ThreadRunning1&))+"²~³"+@str$(hText1&)+"²~³1"'Übergabestring für Thread 1 mit dem Hauptfensterhandle, dem Flag ThreadRunning, dem Handle des Text-Dialogelements und dem Startwert füttern
hThread1&=~createthread(0,0,CProcAddr&,@addr(s1$),0,0)'Thread 1 starten
s2$=@str$(%HWnd)+"²~³"+@str$(@addr(ThreadRunning2&))+"²~³"+@str$(hText2&)+"²~³-10000"'Übergabestring für Thread 2 mit dem Hauptfensterhandle, dem Flag ThreadRunning, dem Handle des Text-Dialogelements und dem Startwert füttern
hThread2&=~createthread(0,0,CProcAddr&,@addr(s2$),0,0)'Thread 2 starten
s3$=@str$(%HWnd)+"²~³"+@str$(@addr(ThreadRunning3&))+"²~³"+@str$(hText3&)+"²~³12345678"'Übergabestring für Thread 3 mit dem Hauptfensterhandle, dem Flag ThreadRunning, dem Handle des Text-Dialogelements und dem Startwert füttern
hThread3&=~createthread(0,0,CProcAddr&,@addr(s3$),0,0)'Thread 3 starten
'Auf das Ende der Threads warten und reagieren

while (@gettext$(hText1&)<>"Fertig.") or (@gettext$(hText2&)<>"Fertig.") or (@gettext$(hText3&)<>"Fertig.")

    waitinput

    if %umessage=$1000'ein Thread signalisiert, dass er sich jetzt beendet und übergibt dabei sein Texthandle in &UwParam

        uwp&=&UwParam

        if uwp&=hText1&

            settext hText1&,"Fertig."

        elseif uwp&=hText2&

            settext hText2&,"Fertig."

        elseif uwp&=hText3&

            settext hText3&,"Fertig."

        endif

    endif

endwhile

waitinput'damit man das Ende mit 3x "Fertig." sieht
'aufräumen
~closehandle(hThread1&)
~closehandle(hThread2&)
~closehandle(hThread3&)
usermessages 0
freedll hDLL%
end

cls
// 3 threads per myThread-Proc
createThread(,,procAddr(myThread,1),,,)
createThread(,,procAddr(myThread,1),,,)
createThread(,,procAddr(myThread,1),,,)
waitinput

nproc myThread

    parameters data&
    //...
    return data&

endproc