Graphics32图层性能问题

Question

我使用graphics32库在Delphi中开发了一个应用程序。它涉及向ImgView32控件添加图层。它完成了我现在想做的所有事情，除了当用户向ImgView添加更多25-30个图层时，所选图层开始表现不佳。我的意思是， - 当ImgView32上有30多个图层并且我点击一个图层时，实际选择它需要大约2.5-2秒。 - 当我尝试移动图层时，它会突然移动

当有更多图层时，看起来ImgViewChange的调用次数太多了。同样适用于PaintLayer。它被称为方式太多次了。 我怎么能阻止这种情况发生？即使添加了30多层，我怎样才能使图层优雅地移动？

我的代码如下：

procedure TMainForm.LayerMouseDown(Sender: TObject; Buttons: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  cronstart:=now;
  if Sender <> nil then
  begin
    Selection := TPositionedLayer(Sender);
  end
  else
  begin
  end;
  cronstop:=now;
  Memo1.Lines.Add('LayerMouseDown:'+FloatToStr((cronstop-cronstart)*secsperDay)+'sec');
end;

procedure TMainForm.AddSpecialLineLayer(tip:string);
var
  B: TBitmapLayer;
  P: TPoint;
  W, H: Single;
begin
      B := TBitmapLayer.Create(ImgView.Layers);
      with B do
      try
        Bitmap.SetSize(100,100);
        Bitmap.DrawMode := dmBlend;

        with ImgView.GetViewportRect do
          P := ImgView.ControlToBitmap(GR32.Point((Right + Left) div 2, (Top + Bottom) div 2));

        W := Bitmap.Width * 0.5;
        H := Bitmap.Height * 0.5;

        with ImgView.Bitmap do
          Location := GR32.FloatRect(P.X - W, P.Y - H, P.X + W, P.Y + H);

        Scaled := True;
        OnMouseDown := LayerMouseDown;
        B.OnPaint := PaintGeamOrizHandler

      except
        Free;
        raise;
      end;
      Selection := B;
end;

procedure TMainForm.PaintGeamOrizHandler(Sender: TObject;Buffer: TBitmap32);
var
  bmp32:TBitmap32;
  R:TRect;
  usa2:single;
  latime,inaltime,usa:Single;
  inaltime2, latime2:single;
begin
  cronstart:=now;
  if Sender is TBitmapLayer then
    with TBitmapLayer(Sender).GetAdjustedLocation do
    begin
      bmp32:=TBitmap32.Create;
      try
            R := MakeRect(TBitmapLayer(Sender).GetAdjustedLocation);
            bmp32.DrawMode:=dmblend;
            bmp32.SetSize(Round(Right-Left), Round(Bottom-Top));

            latime:=Round((Right-Left));
            inaltime:=Round((Bottom-Top));
            usa:=60;
            usa2:=usa / 2;
            with TLine32.Create do
              try
                  EndStyle := esClosed;
                  JoinStyle := jsMitered;
                  inaltime2:=inaltime / 2;
                  latime2:=latime / 2;

                  SetPoints([FixedPoint(latime2-usa2,inaltime2), FixedPoint(latime2+usa2,inaltime2)]);
                  Draw(bmp32, 13, clWhite32);
                  SetPoints(GetOuterEdge);
                  Draw(bmp32, 1.5, clBlack32);

                  SetPoints([FixedPoint(latime2-usa2-3,inaltime2), FixedPoint(latime2-usa2,inaltime2)]);
                  Draw(bmp32, 5, clBlack32);

                  SetPoints([FixedPoint(latime2-usa2-3-7,inaltime2), FixedPoint(latime2-usa2-3,inaltime2)]);
                  Draw(bmp32, 7, clWhite32);
                  SetPoints(GetOuterEdge);
                  Draw(bmp32, 1.5, clBlack32);

                  SetPoints([FixedPoint(latime2+usa2,inaltime2), FixedPoint(latime2+usa2+3,inaltime2)]);
                  Draw(bmp32, 5, clBlack32);

                  SetPoints([FixedPoint(latime2+usa2+3+7,inaltime2), FixedPoint(latime2+usa2+3,inaltime2)]);
                  Draw(bmp32, 7, clWhite32);
                  SetPoints(GetOuterEdge);
                  Draw(bmp32, 1.5, clBlack32);

              finally
                Free;
              end;
            (Sender as TBitmapLayer).Bitmap.Assign(bmp32);
      finally
        bmp32.Free;
      end;
    end;
  cronstop:=now;
  Memo1.Lines.Add('PaintLayer:'+FloatToStr((cronstop-cronstart)*secsperDay)+'sec');    
end;

procedure TMainForm.SetSelection(Value: TPositionedLayer);
begin
  if Value<>nil then
  begin
    if Value <> FSelection then
    begin
                  if RBLayer <> nil then
                  begin
                    RBLayer.ChildLayer := nil;
                    RBLayer.LayerOptions := LOB_NO_UPDATE;
                  end;
                  FSelection := Value;
                  if Value <> nil then
                  begin
                        if RBLayer = nil then
                        begin
                          RBLayer := TRubberBandLayer.Create(ImgView.Layers);
                          RBLayer.MinHeight := 1;
                          RBLayer.MinWidth := 1;
                        end
                        else
                          RBLayer.BringToFront;
                        RBLayer.ChildLayer := Value;
                        RBLayer.LayerOptions := LOB_VISIBLE or LOB_MOUSE_EVENTS or LOB_NO_UPDATE;
                        RBLayer.OnResizing := RBResizing;
                  end;
    end;
  end;
end;


procedure TMainForm.RBResizing(Sender: TObject;
  const OldLocation: TFloatRect; var NewLocation: TFloatRect;
  DragState: TRBDragState; Shift: TShiftState);
var
  w, h, cx, cy: Single;
  nw, nh: Single;
begin
cronstart:=now;
  if DragState = dsMove then Exit; // we are interested only in scale operations
  if Shift = [] then Exit; // special processing is not required

  if ssCtrl in Shift then
  begin
    { make changes symmetrical }

    with OldLocation do
    begin
      cx := (Left + Right) / 2;
      cy := (Top + Bottom) / 2;
      w := Right - Left;
      h := Bottom - Top;
    end;

    with NewLocation do
    begin
      nw := w / 2;
      nh := h / 2;
      case DragState of
        dsSizeL: nw := cx - Left;
        dsSizeT: nh := cy - Top;
        dsSizeR: nw := Right - cx;
        dsSizeB: nh := Bottom - cy;
        dsSizeTL: begin nw := cx - Left; nh := cy - Top; end;
        dsSizeTR: begin nw := Right - cx; nh := cy - Top; end;
        dsSizeBL: begin nw := cx - Left; nh := Bottom - cy; end;
        dsSizeBR: begin nw := Right - cx; nh := Bottom - cy; end;
      end;
      if nw < 2 then nw := 2;
      if nh < 2 then nh := 2;
      Left := cx - nw;
      Right := cx + nw;
      Top := cy - nh;
      Bottom := cy + nh;
    end;
  end;
  cronstop:=now;
  Memo1.Lines.Add('RBResizing:'+FloatToStr((cronstop-cronstart)*secsperDay)+'sec');
end;


procedure TMainForm.ImgViewChange(Sender: TObject);
var
  wid,hei:Integer;
begin
  Edit1.Text:=IntToStr(StrToInt(Edit1.Text)+1);
  cronstart:=now;
  if Selection = nil then
  begin
  end
  else
  begin
        wid:=Round(Selection.Location.Right-Selection.Location.Left);
        hei:=Round(Selection.Location.Bottom-Selection.Location.Top);
//        SelectLayerPan(Selection.Index);
  end;
  cronstop:=now;
  Memo1.Lines.Add('ImgViewChange:'+FloatToStr((cronstop-cronstart)*secsperDay)+'sec');
end;

procedure TMainForm.ImgViewMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer);
begin
  Edit1.Text:='0';
  cronstart:=now;
  if Layer = nil then
  begin
                  if Assigned(FSelection) then
                      begin
                          Selection := nil;
                            RBLayer.Visible:=false;
                        end;
  end
  else
  begin
//                  SelectLayerPan(layer.Index);
  end;
  cronstop:=now;
  Memo1.Lines.Add('imgViewMouseDown:'+FloatToStr((cronstop-cronstart)*secsperDay)+'sec');
end;


procedure TMainForm.ImgViewPaintStage(Sender: TObject; Buffer: TBitmap32;
  StageNum: Cardinal);
const            //0..1
  Colors: array [Boolean] of TColor32 = ($FFFFFFFF, $FFB0B0B0);
var
  R: TRect;
  I, J: Integer;
  OddY: Integer;
  TilesHorz, TilesVert: Integer;
  TileX, TileY: Integer;
  TileHeight, TileWidth: Integer;
begin
  TileHeight := 13;
  TileWidth := 13;

  TilesHorz := Buffer.Width div TileWidth;
  TilesVert := Buffer.Height div TileHeight;
  TileY := 0;

  for J := 0 to TilesVert do
  begin
    TileX := 0;
    OddY := J and $1;
    for I := 0 to TilesHorz do
    begin
      R.Left := TileX;
      R.Top := TileY;
      R.Right := TileX + TileWidth;
      R.Bottom := TileY + TileHeight;
      Buffer.FillRectS(R, Colors[I and $1 = OddY]);
      Inc(TileX, TileWidth);
    end;
    Inc(TileY, TileHeight);
  end;
end;




procedure TMainForm.Button1Click(Sender: TObject);
begin
  Edit1.Text:='0';
   MainForm.AddSpecialLineLayer('geams'); //orizontal
end;

因此，只需单击该按钮多次（30次），一旦您添加了25-30个图层，您就会注意到这种不稳定的行为。 （当然使用库的图层示例中的基本代码并添加上述过程）

也许解决方案是禁用ImgViewChange事件触发的某个地方。但我不知道该怎么做......或者我错了。

请为我解决这个问题...因为我无法想到任何事情......

修改 这是一个更好地解释的屏幕截图：

正如您在imgView的右侧所看到的，有3个编辑框。第一个告诉我们已经添加了25个图层。另外两个也是不言自明的。 在图片的左侧，您可以看到在那里绘制的图层。它们都是相同的，使用代码中的paintHandler绘制。所以所有层都是相同的

现在考虑这种情况：没有选择任何图层，然后我开始点击图层，前三次点击，显示ImgViewChange = 52和Paint = 26，每个图层。然后在我第四次点击图层时，值是这里显示的图像中的值。这没有任何意义。 所以ImgViewChanged被称为1952次，而PaintHandler被称为976次。某处肯定有错误...... 请帮我解决这个问题。考虑到上面的代码填写了那些编辑框。同样在这个测试项目中，没有其他代码可以做这种疯狂的行为。我编写了这个测试项目，只使用了必要的代码才能使它工作。所以代码在上面，行为在图片中。

修改 在PaintHandler方法中添加了bmp32.BeginUpdate和bmp32.EndUpdate后，重绘和imgViewChanges的数量似乎减少了，但不是很多。现在我得到ImgViewChange = 1552和PaintHandler = 776。 我甚至不确定是因为我的改变，因为这些数字看起来几乎是随机的。我的意思是我不知道它为什么会发生，谁会定期触发这些事件，以及触发这么多次后会发生什么？

当我将图层添加到imgView时，所有25个图层，我将它们留在添加它们的位置：在视图的中心。在它们全部添加之后，我开始点击每个，然后将它们从中心拖出，这样它们就会全部可见。

现在，我点击并从中心拖动的前15-20个图层，我监控的2个数字（这两个事件被触发的次数）比我在第20层之后得到的数字要低很多我想从中心拖出来。在它们全部分散在视图中之后，它开始了：一些图层可以实时点击，其他图层需要一段时间才能被选中，我的事件发生次数都在屋顶上。

修改

我发现了我的问题。 有了这个，我将被解雇的事件数量减少到正常数量。因此，解决方案是为图层位图的分配添加BeginUpdate和EndUpdate ... 所以在PaintHandler中我将代码更改为：

  (Sender as TBitmapLayer).BeginUpdate;
  (Sender as TBitmapLayer).Bitmap.Assign(bmp32);
  (Sender as TBitmapLayer).EndUpdate;

现在我的图层表现得像他们应该的那样。感谢SilverWarrior指出我正确的方向。请将您的评论转换为答案，以便我接受。

Answer 1

BeginUpdate / EndUpdate有助于减少ImgViewChange事件的数量，如记录here

  

OnChange是一个抽象更改通知事件，由其调用   一些TCustomPaintBox32的后代在更改后立即出现   已经制作了他们的内容。以TCustomImage32为例，这个   包括从包含的重定向更改通知事件   位图和图层。但是，此事件不会被调用   TCustomPaintBox32控制自己，除非你调用Changed方法   明确。可以使用BeginUpdate调用禁用更改通知   并使用EndUpdate调用重新启用。

但是，您的代码还存在其他问题：

1. 在AddSpecialLineLayer()中，您可以创建新的TBitmapLayer，设置其Bitmap的大小和位置，并将其OnPaint处理程序设置为PaintGeamOrizHandler()。这本身不是问题，但它是迈向真正问题的第一步。

2. 在PaintGeamOrizHandler()中，主要的想法似乎是绘制一些形状，但它的完成方式是非常耗时的，没有任何好处。 首先，您创建一个新的TBitmap32。然后在此位图上绘制形状。然后将其分配给图层位图。最后，释放刚刚创建的位图。 相反，所有的形状绘图都可以直接对图层位图进行。 ＆＃34;临时＆＃34;位图只是CPU资源的一部分。

3. 但另一个问题是，为什么每次需要绘制图层时都会绘制形状？ TBitmapLayer的位图完全能够保留形状，直到您特别需要更改它们。相反，当您创建图层时（和/或需要更改形状时），您可以在单独的过程中绘制形状作为一次性工作。

您可能还想浏览paint stages和repaint optimizer

的文档