Paint Polygons Multithreading delphi

Question

很长一段时间以来，我都试图提高绘画程序的速度。不幸的是，我刚刚通过使用OmnithreadLibrary以及并行化绘制过程和Objects的加载过程实现了一些小的改进。

我的任务详情 我在我的数据库中存储了＆gt; 1.000.000个对象（多边形，矩形和圆圈）。用户应该能够按类型/位置选择和绘制元素.... 用户选择的元素数量从1到数据库中存储的最大元素数量不等。

绘制大量多边形（＆gt; 100000）非常耗时。目前我用我的代码实现了25％的改进。

你会如何加快绘画过程？哪里出错了？ 我会非常感谢任何建议。 ：）

我的代码详细 开始将SQL DB中的对象加载到ElementArray中。这是由几个加载线程完成的。加载第一个Object后，绘制线程开始将Data转换为TPoints数组。转换数据和绘制数据在几个线程中完成。具有一个例外（合并位图）的所有进程并行运行。

  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;

加载数据库只需几秒钟即可完成。绘画过程就是瓶颈！

    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;

最佳， 迈克尔