Blocage dans un DoParallel
Bonjour,
Pour un besoin particulier, je cherche à dénombrer le nombre de couleurs et leurs quantités dans une image qui fait 4000 X 200 pixels.
Pour optimiser le traitement, j’ai utilisé la méthode DoParallel, mais hélas arrivé a 120 lignes de traitées, le programme se bloque sans que je comprenne ou et surtout pourquoi !
Je vous soumets mon code dans l'espoir que vous y trouviez l’énormité que j'y aurai mise ou me dire quelle est la meilleure manière de trouver ou cela bloque ;)
Code:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94
|
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Image1: TImage;
Label1: TLabel;
Label2: TLabel;
ListBox1: TListBox;
Panel1: TPanel;
Panel2: TPanel;
ScrollBox1: TScrollBox;
ValueListEditor1: TValueListEditor;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
procedure ControleUneLigne(Index: PtrInt; Data: Pointer; Item: TMultiThreadProcItem);
procedure CompteurDeLignes;
public
iCpt: Integer;
MaCS: TRTLCriticalSection;
end;
/////////////////////////////////////////////////////////////////////////////////////////////////
procedure TForm1.Button1Click(Sender: TObject);
var
SL: TStringList;
begin
iCpt := 0;
SL := TStringList.create;
try
InitCriticalSection(MaCS);
ProcThreadPool.DoParallel(@ControleUneLigne, 0, Image1.Picture.Height - 1, SL); // , ProcThreadPool.MaxThreadCount);
DoneCriticalSection(MaCS);
ValueListEditor1.Strings.CommaText := SL.CommaText;
ListBox1.Items.CommaText := SL.CommaText;
finally
SL.Free;
end;
Label2.Caption := 'Contrôle des couleurs terminés';
end;
procedure TForm1.ControleUneLigne(Index: PtrInt; Data: Pointer; Item: TMultiThreadProcItem);
var
X: DWord;
L: PRGBQUAD;
S: String;
I: Integer;
SL: TStringList;
begin
SL := TStringList(Data);
L := PRGBQUAD(Image1.Picture.PNG.RawImage.GetLineStart(Index));
For X := 0 to Image1.Picture.Width - 1 do
begin
S := ColorToString(RGBToColor(L^.rgbRed, L^.rgbGreen, L^.rgbBlue));
I := SL.IndexOfName(S);
if I = -1 then
begin
SL.Add(S + '=1');
end
else
begin
EnterCriticalSection(MaCS);
try
SL.ValueFromIndex[I] := IntToStr(SL.ValueFromIndex[I].ToInteger + 1);
finally
LeaveCriticalSection(MaCS);
end;
end;
Inc(L);
end;
TThread.Synchronize(CurrentThread, @CompteurDeLignes);
end;
procedure TForm1.CompteurDeLignes;
begin
Inc(iCpt);
Label2.Caption := IntToStr(iCpt);
Application.ProcessMessages;
end; |