das unten angehängte Beispielprogramm zeigt folgendes Verhalten :
a) Nach dem Start des Programms wird ein Window-Timer wirksam, der alle 333ms eine Ausgabe in die Liste macht.
b) Nach Klick des Buttons werden 100 einfache Threads erzeugt, die gleich nach Create und kurz vor Ende je eine Ausgabe in dieselbe Liste machen.
Für sich betrachtet funktionieren a und b.
Während b allerdings aktiv ist (also noch Threads laufen), werden fast immer keine Ausgaben von a) mehr gemacht. Gelegentlich, wirklich selten, kommt noch eine timer-Ausgabe.
Warum ist das so bzw was mache ich falsch?
Das Programm ist nur unter Windows getestet.
Auf sehr schnellen Rechnern tritt das Phänomen ggf nur auf, wenn der Wert bei "threads(i)\n=1000" etwas erhöht wird.
Losgelöst vom oben beschriebenen Problem habe ich zum Modul auch noch eine Frage:
FreeStructure für die Eventdaten ist in der Behandlungsroutine AddEvent().
Wenn Events verloren gehen, findet das nicht statt.
Wie macht man das besser?
Code: Alles auswählen
; Module ProtList
EnableExplicit
; -------------------------------------------------------------------------------------------------------
DeclareModule ProtList
Declare Create(Gadget.i, x.i, y.i, Width.i, Height.i, EventID_Add.i)
Declare Free(Gadget.i)
Declare Prot(gadget.i, z.s)
Declare ProtE(Gadget.i, z.s)
Declare SizeTime(gadget.i)
EndDeclareModule
; -------------------------------------------------------
Module ProtList
EnableExplicit
Structure TProtList
Gadget.i
EventID_Add.i
startzeit.i
EndStructure
Structure TEventAdd
Gadget.i
line.s
EndStructure
; -------------------------------------------------------
Procedure.s mtt(num.q)
Protected tmp$
Protected.s ms, sec
ms=RSet(Str(num%1000),3,"0")
sec=RSet(Str(num/1000),6,"0")
tmp$=RSet(Str(num/3481000),2,"0")+":"
num%3481000
tmp$+RSet(Str(num/59000),2,"0")+":"
num%59000
tmp$+RSet(Str(num/1000),2,"0")
tmp$+"."+RSet(Str(num),3,"0")
ProcedureReturn sec+"."+ms
EndProcedure
Procedure.s GetZeit(*data.TProtList, zeit.i)
Define.q vergangen
vergangen=zeit-*data\startzeit
ProcedureReturn mtt(vergangen)
EndProcedure
; -------------------------------------------------------
Procedure Prot(gadget.i, z.s)
Protected *data.TProtList
*data = AllocateStructure(TProtList)
With *data
*data=GetGadgetData(gadget)
AddGadgetItem(\Gadget,CountGadgetItems(\Gadget),GetZeit(*data,ElapsedMilliseconds()) + Chr(10) + z)
SetGadgetState(\Gadget,CountGadgetItems(\Gadget)-1)
SetGadgetItemColor(\Gadget,CountGadgetItems(\Gadget)-1,#PB_Gadget_BackColor,RGB(255,250,205),0)
EndWith
EndProcedure
Procedure ProtE(Gadget.i, z.s)
Protected *data.TProtList
Protected *li.TEventAdd
*data=GetGadgetData(Gadget)
*li.TEventAdd=AllocateStructure(TEventAdd)
*li\line=z
*li\Gadget=Gadget
PostEvent(*data\EventID_Add,0,0,*data\EventID_Add,*li)
EndProcedure
Procedure AddEvent()
Protected *erg.TEventAdd
*erg=EventData()
Prot(*erg\Gadget,*erg\line)
FreeStructure(*erg)
EndProcedure
Procedure.i Create(Gadget.i, x.i, y.i, Width.i, Height.i, EventID_Add.i)
Protected result.i, *data.TProtList
*data = AllocateStructure(TProtList)
With *data
If gadget=#PB_Any
result=ListIconGadget(#PB_Any, x, y, Width, Height,"Zeit",40, #PB_ListIcon_FullRowSelect + #PB_ListIcon_AlwaysShowSelection)
\Gadget=result
Else
result=ListIconGadget(Gadget, x, y, Width, Height,"Zeit",40, #PB_ListIcon_FullRowSelect + #PB_ListIcon_AlwaysShowSelection)
\Gadget=Gadget
EndIf
AddGadgetColumn(\Gadget,1,"Text",1000)
\EventID_Add=EventID_Add
BindEvent(\EventID_Add,@AddEvent())
\startzeit=ElapsedMilliseconds()
SetGadgetData(\Gadget,*data)
EndWith
ProcedureReturn result
EndProcedure
Procedure Free(Gadget.i)
Protected *data.TProtList
With *data
*data = GetGadgetData(Gadget)
If *data And *data\Gadget = Gadget
FreeStructure(*data)
EndIf
FreeGadget(Gadget)
EndWith
EndProcedure
Procedure SizeTime(gadget.i)
SendMessage_(GadgetID(gadget), #LVM_SETCOLUMNWIDTH,0,#LVSCW_AUTOSIZE_USEHEADER)
EndProcedure
EndModule
; *****************************************************************************
; *****************************************************************************
; zum Test ...
; *****************************************************************************
; *****************************************************************************
CompilerIf #PB_Compiler_IsMainFile
Enumeration
#Main
#MyList
#MyButton
#MyTimer
EndEnumeration
Enumeration #PB_Event_FirstCustomValue
#ProtList_Add
EndEnumeration
Structure TThreadData
ti.i
n.i
erg.i
laufzeit.i
EndStructure
Procedure threadTest(*data.TThreadData)
Protected.i i,j
Protected.i sum=0
*data\laufzeit=ElapsedMilliseconds()
ProtList::ProtE(#MyList,"Thread"+Str(*data\ti)+" : "+"Start")
For i=1 To *data\n
For j=1 To *data\n
sum+i+j
Next
Next
*data\erg=sum
*data\laufzeit=ElapsedMilliseconds()-*data\laufzeit
ProtList::ProtE(#MyList,"Thread"+Str(*data\ti)+" : "+"Ende")
EndProcedure
Procedure Main()
Protected.i Event, i
Protected Dim threads.TThreadData(100)
If OpenWindow(#Main, #PB_Ignore, #PB_Ignore, 700, 700, "Test" , #PB_Window_SystemMenu)
ProtList::Create(#MyList , 10, 10, 600, 600,#ProtList_Add)
ButtonGadget(#MyButton,620,100,50,50,"Go")
ProtList::Prot(#MyList,"Start")
ProtList::SizeTime(#MyList)
AddWindowTimer(#MAIN,#MyTimer,333)
Repeat
Event=WaitWindowEvent()
Select Event
Case #PB_Event_CloseWindow
Break
Case #PB_Event_Gadget
Select EventGadget()
Case #MyButton
For i=1 To 100
threads(i)\n=1000
threads(i)\ti=i
CreateThread(@threadTest(),@threads(i))
Next
EndSelect
Case #PB_Event_Timer
If EventTimer()=#MyTimer
ProtList::ProtE(#MyList,"-------------- timer event ---------------")
EndIf
EndSelect
ForEver
ProtList::Free(#MyList)
EndIf
EndProcedure
Main()
CompilerEndIf