Graphics32 layers performance issues

Question

I developed an application in Delphi using graphics32 library. It involves adding layers to a ImgView32 control. It does all I want now, except that when the user adds more that 25-30 layers to the ImgView, the selected layer starts behaving badly. I mean, - when there are 30+ layers on the ImgView32 and I click on a layer, it takes about 2.5-2 seconds to actually select it. - Also when I try to move the layer, it moves abruptly

It appears that ImgViewChange is called way too many times when there are more layers. Same goes to PaintLayer. It gets called way too many times. How can I stop that from happening? How can I make the layers move graciously even when there are more that 30 layers added?

My code is as follows:

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;

So just click the button multiple times (30 times) and you will notice the eratic behaviour once you get to have 25-30 layers added. (Of course use the base code from the layers example of the library and add the above procedures)

Maybe a solution would be to disable somewhere the ImgViewChange event from firing. But I do not know where to do that... Or maybe I'm wrong.

Please give me a solution for this problem... because I can't think of anything...

EDIT Here is a screenshot that will explain better:

As you can see in the right side of the imgView, there are 3 editboxes. The first tells us that there are 25 layers added already. The other two are also self-explanatory. In the left side of the picture you can see the layers drawn there. They are all the same, drawn with the paintHandler from the code. So all the layers are identical

Now consider this scenario: no layer is selected, then I start clicking layers, the first 3 clicks, show me ImgViewChange=52 and Paint=26, for each of them. Then on my fourth click on a layer the values are those in the image displayed here. This does not make any sense. So ImgViewChanged is called 1952 times and the PaintHandler is called 976 times. There must be a bug somewhere... Please help me figure this out. take into consideration that those editboxes get filled in the code above. Also in this test project there is no other code that might do this crazy behavior. I wrote this test project with only the code that was neccessary to make it work. So the code is above, the behavior is in the picture.

EDIT After I added bmp32.BeginUpdate and bmp32.EndUpdate in the PaintHandler method, the number of repaints and imgViewChanges seem to have decreased, but not by much. Now I get ImgViewChange=1552 and PaintHandler=776. I'm not even sure that it's because my change, because these numbers seem almost random. I mean I have no idea why it happens, who triggers those events for regular number of times, and what happens when they are triggered so many more times?

When I add the layers to the imgView, all 25 of them, I leave them where they are added: in the center of the View. After they are all added, I start click-in on each and I drag them away from the center so they would all be visible.

Now, the first 15-20 layers that I click on and drag from the center, the 2 numbers that I monitor (number of times those two events get fired) is a lot lower that the numbers I get after the 20th layer that I want to drag from the center. And after they are all dispersed in the view, it begins: some layers are click-able in real-time, others take a while to get selected and my count of event-fires are through the roof.

EDIT

I found my problem. With this I reduced the number of events that get fired to the normal amount. So the solution was to add BeginUpdate and EndUpdate for the Assignment of the layer's bitmap... So in the PaintHandler I changed the code to:

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

And now my layers behave like they should. Thank you SilverWarrior for pointing me into the right direction. Please convert your comment into an answer so I can accept it.

Answer 1

The BeginUpdate/EndUpdate are beneficial to reduce the number of ImgViewChange events as documented here

OnChange is an abstract change notification event, which is called by some of the descendants of TCustomPaintBox32 immediately after changes have been made to their contents. In TCustomImage32, for example, this includes redirection of change notification events from the contained bitmap and from layers. This event, however, is not called by TCustomPaintBox32 control itself, unless you call the Changed method explicitly. Change notification may be disabled with BeginUpdate call and re-enabled with EndUpdate call.

However, there are other problems in your code:

1. In AddSpecialLineLayer() you create a new TBitmapLayer, set the size and location of its Bitmap and set its OnPaint handler to PaintGeamOrizHandler(). This is not a problem in itself, but it's the first step towards the real problem.

2. In PaintGeamOrizHandler() the main idea seems to be to draw some shapes, but the way it is done is very time consuming for no benefit. First you create a new TBitmap32. Then you draw the shapes on this bitmap. Then you assign it to the layers bitmap. Finally you free the bitmap just created. All of the shape drawing could instead have been done directly to the layers bitmap. The "temporary" bitmap is just a waist of CPU resources.

3. But another question is, why are the shapes drawn every time the layer needs to be painted? The bitmap of the TBitmapLayer is perfectly capable of retaining the shapes until you specifically need to change them. Instead you could have drawn the shapes in a separate procedure as a one time effort when you created the layer (and/or when you need to change the shapes).

You may also want to explore the documentation for paint stages and perhaps repaint optimizer