1

I am trying to use multithreading in Delphi XE. The task is following I have to create 4 threads. Each thread draw colored circle in Paintbox at predefined area, For example FIRST thread draw only red circles in first quoter of the Paintbox, the SECOND thread draw only yellow circles in the second quoter, and so on.

I have defined following class

const
  NumberOfIterations = 100000;
  NumberOfTreads = 4;

TCalcThread = class(TThread)
private
  FIdx: Integer;
  FHits: Cardinal;
  V: array of Integer;
  xPaintBox1: TPaintBox;
protected
  procedure Execute; override;
public
  constructor Create(Idx: Integer; vPaintBox: TPaintBox);
  property Hits: Cardinal read FHits;
end;

In main code I do the following:

procedure TForm11.Button1Click(Sender: TObject);
var
  thrarr: array[0..NumberOfTreads - 1] of TCalcThread;
  hndarr: array[0..NumberOfTreads - 1] of THandle;
  i, a, t: Integer;
  x, y: Integer;
begin
 caption := '';

 PaintBox1.Canvas.Brush.Color := clWhite;
 PaintBox1.Canvas.fillrect(PaintBox1.Canvas.ClipRect);

 for i := 0 to NumberOfTreads - 1 do
 begin
   thrarr[i] := TCalcThread.Create(i, PaintBox1);
   hndarr[i] := thrarr[i].Handle;
 end;

 WaitForMultipleObjects(NumberOfTreads, @hndarr, True, INFINITE);

 for i := 0 to NumberOfTreads - 1 do
   thrarr[i].Free;
end;

The thread Create and Execute methods are defined as following:

constructor TCalcThread.Create(Idx: Integer; vPaintBox: TPaintBox);
begin
  FIdx := Idx;
  FHits := 0;
  xPaintBox1 := vPaintBox;

  case FIdx of
    0: xPaintBox1.Canvas.Pen.Color := clRed;
    1: xPaintBox1.Canvas.Pen.Color := clYellow;
    2: xPaintBox1.Canvas.Pen.Color := clBlue;
    3: xPaintBox1.Canvas.Pen.Color := clMoneyGreen;
  end;

  xPaintBox1.Canvas.Brush.Color := xPaintBox1.Canvas.Pen.Color;
  inherited Create(False);
end;

procedure TCalcThread.Execute;
var
  i, start, finish: Integer;
  x, y: Integer;
begin
  start := (NumberOfIterations div NumberOfTreads) * FIdx;
  finish := start + (NumberOfIterations div NumberOfTreads) - 1;

  for i := start to finish do
  begin
    case FIdx of
    0: begin
         x := Random(200) + 1;
       end;
    1: begin
         x := Random(200) + 201;
       end;
    2: begin
         x := Random(200) + 401;
       end;
    3: begin
         x := Random(200) + 601;
       end;
    end;

    y := Random((xPaintBox1.height )) + 1;
    xPaintBox1.Canvas.Ellipse(X - 5, Y - 5, X + 5, Y + 5);
  end;
end;

As a result I am getting a few circles in three areas with the same color, and a lot of circles in one area (the same color). What I am doing wrong?

Delphi Coder
  • 1,723
  • 1
  • 14
  • 25
  • 4
    You cannot access VCL (visual) controls from threads without using `Synchronize`. Read the documentation, or the huge comment block that the IDE adds for you automatically when you use File->New->Other->Delphi Files->Thread Object, or the dozens of existing posts here about using threads, all of which provide that information. (As does the threading example that is installed in the Samples project on every Delphi installation.) – Ken White Oct 18 '14 at 23:46
  • In addition even TCanvas is not thread save, so if e.g. bitmaps are created in a thread context the results can be currupted. – bummi Oct 18 '14 at 23:50
  • And you have to set the colour in the synchronized part. – LU RD Oct 18 '14 at 23:50
  • 3
    Ironically, the thread demo in the Samples folder even demonstrates *drawing in a TPaintBox with threads* properly. :-) – Ken White Oct 19 '14 at 00:34
  • 1
    Even without the multiple vcl threading crimes, there is also the crime of painting outside OnPaint. – David Heffernan Oct 19 '14 at 03:23
  • @Ken White. Thank you for your answers. Especially for first one. :) – Saidamin Usmanov Oct 19 '14 at 17:41
  • I've removed your edit, because adding an answer to your question is not proper here. If you want to add an answer, do so in the space marked "Your Answer" below - [answering your own question is allowed here](http://stackoverflow.com/help/self-answer). If you don't want to write an answer yourself, you can always just delete the question or wait to see if someone else posts one. – Ken White Oct 19 '14 at 19:45
  • @KenWhite, ok, will be more careful next time – Saidamin Usmanov Oct 20 '14 at 01:07

0 Answers0