Paint Polygons Multithreading delphi

Question

For quite some time I tried to improve the speed of my painting program. Unfortunately I just achieved some small improvements by using the OmnithreadLibrary and also by parallelizing the painting process and the loading process of Objects.

My Task in detail: I stored >1.000.000 Objects in my Database ( Polygons, Rectangles and also Circles). The user should be able to select and paint elements by Type/Position ... . The selected number of Elements from the user varies from 1 to the max Number of Elements stored in the Database.

Painting a big number of Polygons (>100000) is time consuming. Currently I achieved with my code an improvement of 25%.

How would you speed up the painting process? Where is the mistake? I would be very grateful for any advice. :)

My Code in detail Start loading Objects from SQL DB into an ElementArray. This is done by several loading threads. After loading the first Object, the painting thread begins to transform the Data into an Array of TPoints. Converting Data and also Painting Data is done in several Threads. All processes with one exception (Merging Bitmaps) runs parallel.

  procedure TbmpthreadForm.StartPaintingPolygons(Sender: TObject);
  var
    elementsPerThread: Integer;
  begin
    // 1. Load Data from Database by multithreaded sql queries
    // EVery single thread loads the same number of elements

    For begin CreateTask(loadTask, IntToStr(i)).MonitorWith(otlMonitor1)
      .SetParameter('SQL', sqlStr[i]).Run;
  end;

  // Save all Array indices in queue
  dynamicQueue := TOmniBaseQueue.Create(655365, 4);
  // CREATE QUERIES WITH SAME INSTANCE COUNT And Start load DB Objects
  for
  begin
    CreateTask(loadTask, IntToStr(i)).MonitorWith(otlMonitor1)
      .SetParameter('SQL', sqlStr).Run;
  end;

  // START MULTITHREADED PAINT PROCESS
  // Single Thread -> Single BMP -> Merge BMPs
  Parallel.ParallelTask.NumTasks(4).OnStop(
    procedure
    begin
      masterBitmap.SaveToFile('c:\temp\myimage.bmp');
    end).Execute(
    procedure
    var
      value: TOmniValue;
      k: Integer;
      threadBitMap: TBITMAP;
    begin

      threadNum.value := threadNum.value + 1;
      threadBitMap := TBITMAP.Create;

      repeat
        // ELEMENT IN QUEUE???? YES-> Paint ELEMENT
        if dynamicQueue.TryDequeue(value) then
        begin
          k := value.AsInteger;
          PaintSingleObject(elementList[k], threadBitMap);
        end;
      until (flag and dynamicQueue.IsEmpty);
      // Merge all Bitmaps, after painting all objects
      canvas.lock;
      BitBlt(masterBitmap.canvas.Handle, 0, 0, masterBitmap.Width,
        masterBitmap.Height, threadBitMap.canvas.Handle, 0, 0, SRCAND);
      canvas.unlock;
      threadBitMap.Free;
    end);
  end;

LOADING THE Database is done in a few seconds. Painting Process is the bottle neck!

    procedure TbmpthreadForm.PaintSingleObject(DS: TObjectTableRecord;
    threadBMP: TBITMAP);
    var
      i, j: Integer;
      MyPoly: TPolygon;
      aTFPolygon: TFPolygon;
      OldPen, NewPen: HPen;
    begin
      SetPenParameters(threadBMP.canvas, DS, line_pixel, NewPen, OldPen);
      ...
      // Convert a Polygon from string
        StringToPolygon(AnsiString(DS.ObjectOutLineString), aTFPolygon);
      // Convert Real Position Value to Pixel Value
      ... MyPoly[j] := TransformLengthToPixel(P2RWMatrix, aTFPolygon[i])
      // now Select BrushSetting ...
        threadBMP.Canvas.Polygon(aPoly);
    end;
    Paint_ObjectLabels(threadBMP.canvas, DS, aUnit);
  end;

Best, Michael