Einzelnen Beitrag anzeigen

BerndS

Registriert seit: 8. Mär 2006
Ort: Jüterbog
480 Beiträge
 
Delphi 11 Alexandria
 
#4

AW: TTreeView wird durch TActionMainMenuBar deutlich langsamer

  Alt 28. Mär 2019, 07:26
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;
Bernd

Geändert von BerndS (28. Mär 2019 um 07:36 Uhr)
  Mit Zitat antworten Zitat