TTreeView wird durch TActionMainMenuBar deutlich langsamer

[TurboMagic]

Da es eine Demo von dir gibt könntes du dieses Problem auch gerne in quality.embarcadero.com einstellen und dann die Report Nummer hier posten.

[BerndS]

Ich habe die Hooks noch mal genauer angeschaut. Die Verzögerung wird in der Vcl.ActnMenus durch TMenuList.Notify durch CallWindowHook ausgelöst sobald das erste Menü dort eingefügt wird.

Auf die schnelle habe ich die Unit Vcl.ActnMenus um die procedure EnableDisableMenuListHooks erweitert.

Delphi-Quellcode:

procedure EnableDisableMenuListHooks(AEnable: Boolean);
begin
  if Assigned(MenuList) and (MenuList.Count > 0) then
    if AEnable then
    begin
      if MenuCallWndHook = 0 then
      MenuCallWndHook := SetWindowsHookEx(WH_CALLWNDPROC,
        {$IFNDEF CLR}@{$ENDIF}CallWindowHook, 0, GetCurrentThreadID);
    end
    else
      if (MenuCallWndHook <> 0) then
      begin
        UnHookWindowsHookEx(MenuCallWndHook);
        MenuCallWndHook := 0;
      end;
end;

Diese rufe ich dann hier auf und die Verzögerungen sind weg (Ohne Debugger).

Delphi-Quellcode:

procedure TfmTestTreeview.btClick(Sender: TObject);
  procedure AddNodes(ACount,  NL: Integer; ANode: TTreeNode);
  var
    N: TTreeNode;
    I: Integer;
    S: string;
  begin
    for I := 1 to ACount do
    begin
      if Assigned(ANode) then
      begin
        N := tv.Items.AddChild(ANode, 'Node ' + NL.ToString + '.' + I.ToString);
        if N.Level < 3 then
          AddNodes(10, I, N)
        else
          Break;
      end
      else
      begin
        N := tv.Items.Add(nil, 'Node ' + I.ToString);
        AddNodes(10, I, N);
      end;
    end;
  end;

var
  TC: Cardinal;
  E: Extended;
begin
  tv.Items.Clear;
  EnableDisableMenuListHooks(False);
  try
    tv.Items.BeginUpdate;
    try
      bt.Enabled := False;
      TC := GetTickCount;
      AddNodes(20, 0, nil);
      TC := GetTickCount - TC;
      if cbAMMB.Checked then
        FTCM := TC
      else
        FTC := TC;
      lTC.Caption := TC.ToString + ' ticks';
      if (FTC > 0) and (FTCM > 0) then
      begin
        E := FTCM / FTC;
        lTC.Caption := lTC.Caption + ' ( ohne ' + FTC.ToString + ' ticks ' + FloatToStr(RoundTo(E, - 1)) + ' x langsamer)';
      end;
    finally
      tv.Items.EndUpdate;
      bt.Enabled := True;
    end;
  finally
    EnableDisableMenuListHooks(True);
  end;
end;

[TurboMagic]

Bitte Problem samt Lösungsansatz inQP erfassen, damit hoffentlich alle in einer zukünftigen Version von einem offiziellen Bugfix profitieren. Danke!

[BerndS]

Leider sind meine Englisch Kenntnisse nicht die besten. Mein Lösung ist auch nicht optimal, da es nicht automatisch geht.
Aber ich werde mal versuchen meinen ersten QP zu erstellen.

[BerndS]

Ich habe es mit Googles Hilfe in QP hinzugefügt. RSP-24106

[TurboMagic]

Danke. Habe dafür gestimmt.