2

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

我的任务详细信息： 我在数据库中存储了 >1.000.000 个对象（多边形、矩形和圆形）。用户应该能够通过 Type/Position ... 选择和绘制元素。用户选择的元素数量从 1 到存储在数据库中的最大元素数量不等。

绘制大量多边形 (>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;

最好的，迈克尔

4

0 回答 0