Modifikace interního chování IDE programově - změna property ProjectTree

Kolega si mi dnes stěžoval, že ho štve chování IDE ve stromu projektů, kdy při dvojkliku mezi projekty, nebo i na unitě dojde k zabalení nebo rozbalení uzlu. Jelikož je to určitě varianta VirtualTreeView, že by stačilo vypustit z TreeOptions.MiscOptions hodnotu toToggleOnDblClick.

Vzpomněl jsem si, že jsem dříve ve starších Delphi použival háček, kdy jsem natvrdo změnil velikost fontu v ObjectInspektoru protože se zvětšilo rozlišení a zhoršil se zrak. Mimochodem Quick Delphi plugin to change font size in the Object Inspector (vytvořte si balíček a přidejte do něj tu jednotku).

Pokud se zavede balíček, volá se procedure Register a lze procházet objekty IDE a pokud znáte co chcete změnit, tak máte šanci.

Otazkou tedy zůstává jen jak najít to co je třeba změnit. A zde přichází ke slovu nástroje na procházení objektů IDE, třeba IDE Explorer (ale jsou i další).

IDE explorer - hlavní okno je AppBuilder

Na obrázku lze najít požadovaný control (ProjectTree2) a je to opravdu TVirtualStringTree. Teď ho jen najít za běhu. Program je modifikací předchozího kódu.

unit Main;

interface

procedure Register;

implementation

uses
  System.RTTI, System.TypInfo, Vcl.Forms, Vcl.Controls;

function GetOIForm: TForm;
var
  i: Integer;
begin
  Result:=nil;
  for i:=0 to Screen.FormCount-1 do
    if Screen.Forms[i].Name='ProjectManagerForm' then
    begin
      Result:=Screen.Forms[i];
      Break;
    end;
end;

function GetChildControl(AParent: TWinControl; AName: string): TWinControl;
var
  i: Integer;
begin
  Result:=nil;
  if not Assigned(AParent) then
    Exit;
  for i:=0 to AParent.ControlCount-1 do
    if AParent.Controls[i].Name=AName then
    begin
      Result:=TWinControl(AParent.Controls[i]);
      Break;
    end;
end;
function GetOIControl: TControl;
var
  OIForm: TForm;
begin
  OIForm:=GetOIForm;
  Result:=GetChildControl(OIForm,'ProjectTree2');
end;

procedure Register;
var
  OI: TControl;
  ctx: TRttiContext;
  p1,p2: TRttiProperty;
  v1,v2: TValue;
begin
  OI:=GetOIControl;
  if not Assigned(OI) then
    Exit;
  ctx:=TRttiContext.Create;
  try
    p1:=ctx.GetType(OI.ClassInfo).GetProperty('TreeOptions');
    p2:=ctx.GetType(p1.PropertyType.Handle).GetProperty('MiscOptions');
    v1:=p2.GetValue(p1.GetValue(OI).AsObject);
    TValue.Make(StringToSet(v1.TypeInfo,
        '[toAcceptOLEDrop,toFullRepaintOnResize,toInitOnSave,toWheelPanning]'),v1.TypeInfo,v2);
    p2.SetValue(p1.GetValue(OI).AsObject,v2);
  finally
    ctx.Free;
  end;
end;

end.

Principiálně se mezi okny oplikace hledá okno "ProjectManagerForm" a pak se v tom okně hledá control "ProjectTree2" (viz screenshot). Tím se získal inkriminovaný VirtualTreeView a teď začíná ta legrace.

Jelikož IDE používá jinou verzi stromu než je veřejně dostupná (a IMHO ho nepublikuje), je třeba zapomenout na přetypování na zdrojáky, které máme k dispozici a jít na to přes RTTI. Toto neplatí pokud je prvek, který chceme modifikovat nějaký standartní.

Takže zbytek kódu v Register je modifikace přes RTTI s největším zákysem na StringToSet. Předpokládám, že to někdo dokáže jednodušejí, já jsem doufal ve variantu jako

SetSetProp(OI, 'TreeOptions.MiscOptions', 
    '[toAcceptOLEDrop,toFullRepaintOnResize,toInitOnSave,toWheelPanning]');

ale bez úspěchu.

Stáhnout: Zdrojový kód