compinsp.pas

类似Delphi Ide的对象查看器 可以在RUNTIME时使用

  begin
    FRoot:=Value;
    if not (csDesigning in ComponentState) then RefreshTree;
  end;
end;

procedure TCustomComponentTree.SetIsEnumComponent(const Value: Boolean);
begin
  if FIsEnumComponent<>Value then
  begin
    FIsEnumComponent:=Value;
    if not (csDesigning in ComponentState) then RefreshTree;
  end;
end;

procedure TCustomComponentTree.SetInstance(const Value: TComponent);
begin
  if FInstance<>Value then
  begin
    FInstance:=Value;
    if not (csDesigning in ComponentState) then Selected:=GetComponentNode(Value);
  end;
end;

procedure TCustomComponentTree.SetComponentInspector(const Value: TCustomComponentInspector);
begin
  if Value<>FComponentInspector then
  begin
    if Assigned(FComponentInspector) then FComponentInspector.DeleteNotification(Self);
    FComponentInspector:=Value;
    if Assigned(FComponentInspector) then FComponentInspector.AddNotification(Self);
  end;
end;

procedure TCustomComponentTree.SetShowNonVisual(const Value: Boolean);
begin
  if FShowNonVisual<>Value then
  begin
    FShowNonVisual:=Value;
    if not (csDesigning in ComponentState) then RefreshTree;
  end;
end;

procedure TCustomComponentTree.Loaded;
begin
  inherited;
  if not (csDesigning in ComponentState) then
  begin
    RefreshTree;
    Selected:=GetComponentNode(FInstance);
    FFilled:=True;
  end;
end;

procedure TCustomComponentTree.Notification(AComponent: TComponent; Operation: TOperation);
var
  Node: TTreeNode;
begin
  if not (csDestroying in ComponentState) then
  begin
    if (Operation=opRemove) and (AComponent=FComponentInspector) and Assigned(FComponentInspector) then
    begin
      FComponentInspector.DeleteNotification(Self);
      FComponentInspector:=nil;
    end;
    if not (csDesigning in ComponentState) and (Operation=opRemove) and (ComponentState=[]) and FFilled then
    begin
      Node:=GetComponentNode(AComponent);
      if Assigned(Node) then Node.Free;
    end;
  end;
  inherited;
end;

procedure TCustomComponentTree.Change(Node: TTreeNode);
begin
  inherited;
  if Assigned(Selected) then SelectInstance(Selected.Data)
  else SelectInstance(nil);
end;

procedure TCustomComponentTree.Edit(const Item: TTVItem);

var
  S: string;
  Node: TTreeNode;

  function GetNodeFromItem(const Item: TTVItem): TTreeNode;
  begin
    with Item do
      if (state and TVIF_PARAM)<>0 then Result:=Pointer(lParam)
      else Result:=Items.GetNode(hItem);
  end;

begin
  with Item do
    if Assigned(pszText) then
    begin
      S:=pszText;
      Node:=GetNodeFromItem(Item);
      EditText(Node.Data,S);
      if Node<>nil then Node.Text:=S;
    end;
end;

function TCustomComponentTree.Filter(AComponent: TComponent): Boolean;
begin
  Result:=(AComponent<>Self) and (FShowNonVisual or (AComponent is TControl));
  if Assigned(FOnFilter) then FOnFilter(Self,AComponent,Result);
end;

function TCustomComponentTree.GetText(AComponent: TComponent): string;
begin
  Result:=AComponent.Name;
  if Assigned(FOnGetText) then FOnGetText(Self,AComponent,Result);
end;

procedure TCustomComponentTree.EditText(AComponent: TComponent; var AText: string);
begin
  if Assigned(FOnEditText) then FOnEditText(Self,AComponent,AText);
end;

procedure TCustomComponentTree.SelectInstance(AComponent: TComponent);
begin
  FInstance:=AComponent;
  if Assigned(FOnSelect) then FOnSelect(Self,FInstance);
  if Assigned(FComponentInspector) then
  begin
    FIgnoreUpdate:=True;
    if Assigned(FInstance) and (FInstance<>FComponentInspector.Instance) then
      FComponentInspector.Instance:=FInstance;
  end;
end;

procedure TCustomComponentTree.CMOIUpdated(var Message: TMessage);
begin
  if not FIgnoreUpdate then
  begin
    if Assigned(FComponentInspector) then
      with FComponentInspector do
        if InstanceCount=1 then Self.Instance:=Instance
        else Self.Instance:=nil;
    Update;
  end;
  FIgnoreUpdate:=False;
end;

function TCustomComponentTree.GetComponentImage(AComponent: TComponent): Integer;
begin
  Result:=-1;
  if Assigned(FOnComponentImage) then FOnComponentImage(Self,AComponent,Result);
end;

function TCustomComponentTree.GetComponentNode(AComponent: TComponent): TTreeNode;

  procedure FindComponent(RootNode: TTreeNode);
  var
    i: Integer;
  begin
    if not Assigned(Result) then
      if RootNode.Data=AComponent then Result:=RootNode
      else
        with RootNode do
          for i:=0 to Pred(Count) do FindComponent(Item[i])
  end;

begin
  Result:=nil;
  if Items.Count>0 then FindComponent(Items[0]);
end;

procedure TCustomComponentTree.AddComponent(AComponent: TComponent);
var
  Node: TTreeNode;
begin
  if not Assigned(GetComponentNode(AComponent)) and Filter(AComponent) then
  begin
    if AComponent is TControl then Node:=GetComponentNode(TControl(AComponent).Parent)
    else Node:=GetComponentNode(AComponent.Owner);
    Items.AddChildObject(Node,GetText(AComponent),AComponent).ImageIndex:=GetComponentImage(AComponent);
  end;
end;

procedure TCustomComponentTree.DeleteComponent(AComponent: TComponent);
var
  Node: TTreeNode;
begin
  if not Assigned(GetComponentNode(AComponent)) and Filter(AComponent) then
  begin
    if AComponent is TControl then Node:=GetComponentNode(TControl(AComponent).Parent)
    else Node:=GetComponentNode(AComponent.Owner);
    Items.AddChildObject(Node,AComponent.Name,AComponent);
  end;
end;

procedure TCustomComponentTree.EnumComponent(comp:TComponent;N: TTreeNode);
var
  j,m:integer;
  pl:TpropertyList;
  p:Tproperty;
  Node: TTreeNode;
begin
  if Assigned(comp) then
  begin
    pl:=TpropertyList.Create(nil);
    pl.Instance:=Comp;
    if pl.Count>0 then
    begin
      for j:=0 to pl.Count-1 do
      begin
        p:=pl.Properties[j];
        if (p.TypeKind=tkClass) and (p.AsObject is TCollection) and (TCollection(p.AsObject).Count>0) then
        begin
          if n=nil then
          begin
            if Comp is TControl then Node:=GetComponentNode(TControl(Comp))
            else Node:=GetComponentNode(Comp);
          end else Node:=N;
          Node.DeleteChildren;
          Node:=items.AddChild(Node,p.Name);
          for m:=0 to TCollection(p.AsObject).Count-1 do
          begin
            items.AddChildObject(Node,p.Name+'['+inttostr(m)+']',TCollection(p.AsObject).Items[m]);
            EnumComponent(TComponent(TCollection(p.AsObject).Items[m]),Node);
          end;
        end;
      end;
    end;
  end;
end;

procedure TCustomComponentTree.RefreshTree;
var
  i: Integer;
begin
  Items.Clear;
  if Assigned(Root) then
  begin
    Items.AddObject(nil,Root.Name,Root);
    with Root do
      for i:=0 to Pred(ComponentCount) do
      begin
        AddComponent(Components[i]);
        EnumComponent(Components[i],nil);
      end;
  end;
end;

procedure TCustomComponentComboBox.SetRoot(const Value: TComponent);
begin
  FRoot:=Value;
  RefreshList;
  Update;
end;

function TCustomComponentComboBox.GetInstance: TComponent;
begin
  if Assigned(Parent) then
    with Items do
      if (ItemIndex>=0) and (ItemIndex<Count) then
        Result:=TComponent(Items.Objects[ItemIndex])
      else Result:=nil
  else Result:=nil;
end;

procedure TCustomComponentComboBox.SetInstance(const Value: TComponent);
begin
  if Assigned(Parent) then
    ItemIndex:=Items.IndexOfObject(Value);
end;

procedure TCustomComponentComboBox.SetComponentInspector(const Value: TCustomComponentInspector);
begin
  if Value<>FComponentInspector then
  begin
    if Assigned(FComponentInspector) then FComponentInspector.DeleteNotification(Self);
    FComponentInspector:=Value;
    if Assigned(FComponentInspector) then FComponentInspector.AddNotification(Self);
  end;
end;

procedure TCustomComponentComboBox.CreateWnd;
begin
  inherited;
  RefreshList;
end;

procedure TCustomComponentComboBox.Change;
begin
  inherited;
  if Assigned(FComponentInspector) and (Instance<>FComponentInspector.Instance) then
    FComponentInspector.Instance:=Instance;
end;

procedure TCustomComponentComboBox.Notification(AComponent: TComponent; Operation: TOperation);
begin
  if (Operation=opRemove) and (AComponent=FComponentInspector) and Assigned(FComponentInspector) then
  begin
    FComponentInspector.DeleteNotification(Self);
    if FComponentInspector<>nil then
      FComponentInspector:=nil;
  end;
  inherited;
end;

function TCustomComponentComboBox.TranslateComponent(AComponent: TComponent): TComponent;
begin
  Result:=AComponent;
end;

function TCustomComponentComboBox.Filter(AComponent: TComponent): Boolean;
begin
  Result:=True;
  if Assigned(FOnFilter) then FOnFilter(Self,AComponent,Result);
end;

function TCustomComponentComboBox.GetComponentText(AComponent: TComponent): string;
var
  N: string;
begin
  if Assigned(AComponent) then
    with AComponent do
    begin
      N:=Name;
      if N='' then N:='(noname)';
      Result:=Format('%s: %s',[N,ClassName]);
    end
  else Result:='';
  if Assigned(FOnGetComponentText) then FOnGetComponentText(Self,AComponent,Result);
end;

procedure TCustomComponentComboBox.CMOIUpdated(var Message: TMessage);
begin
  {$IFNDEF GOINOCOMBOAUTOREFRESH}
  RefreshList;
  {$ENDIF}
  if Assigned(FComponentInspector) then
    with FComponentInspector do
      if InstanceCount=1 then Self.Instance:=Instance
      else Self.Instance:=nil;
  Invalidate;
end;

constructor TCustomComponentComboBox.Create(AOwner: TComponent);
begin
  inherited;
  Style:=csDropDownList;
end;

procedure TCustomComponentComboBox.RefreshList;
var
  i: Integer;
  Component: TComponent;
begin
  with Items do
  begin
    Clear;
    BeginUpdate;
    if Assigned(FRoot) then
      with FRoot do
      begin
        Component:=TranslateComponent(FRoot);
        if Filter(Component) then
          AddObject(GetComponentText(Component),Component);
        for i:=0 to Pred(ComponentCount) do
          if Filter(Components[i]) then
            with Components[i] do
            begin
              Component:=TranslateComponent(FRoot.Components[i]);
              AddObject(GetComponentText(Component),Component);
            end;
      end;
    EndUpdate;
  end;
end;

constructor TCompInspProperty.CreateWithOwner(AOwner: TPropertyList; ARoot,AInstance: TComponent; APropInfo: PPropInfo; APropData: TCustomPropData; ACompInspList: TCompInspList);
begin
  FCompInspList:=ACompInspList;
  inherited Create(AOwner,ARoot,AInstance,APropInfo,APropData);
end;

function TCompInspProperty.CreatePropertyList: TPropertyList;
begin
  Result:=TCompInspPropertyList.CreateWithOwner(Self,FCompInspList);
end;

procedure TCompInspPropertyList.SetMode(const Value: TCompInspMode);
begin
  if FMode<>Value then
  begin
    FMode:=Value;
    Update;
  end;
end;

constructor TCompInspPropertyList.CreateWithOwner(AOwner: TProperty; ACompInspList: TCompInspList);
begin
  inherited Create(AOwner);
  FCompInspList:=ACompInspList;
  Mode:=FCompInspList.Mode;
  Root:=FCompInspList.Root;
end;

function TCompInspPropertyList.CreateProperty(APropInfo: PPropInfo; APropData: TCustomPropData): TProperty;
begin
  Result:=TCompInspProperty.CreateWithOwner(Self,Root,Instance,APropInfo,APropData,FCompInspList);
end;

function TCompInspPropertyList.Compare(P1,P2: TProperty): Integer;
begin
  Result:=inherited Compare(P1,P2);
  if Assigned(CompInspList) and Assigned(CompInspList.Owner) then
    CompInspList.Owner.Compare(P1,P2,Result);
end;

function TCompInspPropertyList.Filter(P: TProperty): Boolean;
begin
  Result:=((P.TypeKind=tkMethod) xor (FMode=imProperties)) and ((P.TypeKind=tkClass) or (P.Custom or Assigned(P.SetProc) and Assigned(P.GetProc)));
  if Assigned(CompInspList) and Assigned(CompInspList.Owner) then
    CompInspList.Owner.Filter(P,Result);
end;

procedure TCompInspList.SetRoot(const Value: TComponent);
begin
  if FRoot<>Value then
  begin
    FRoot:=Value;
    Update;
  end;
end;

function TCompInspList.GetInstance: TComponent;
begin
  if ValidListIndex(0) then Result:=PropertyLists[0].Instance
  else Result:=nil;
end;

procedure TCompInspList.SetInstance(const Value: TComponent);
var
  i: Integer;
  PL: TCompInspPropertyList;
begin
  if (Owner as TCustomComponentInspector).FMultiSelect then
  begin
    AddInstance(Value);
    i:=0;
    while i<InstanceCount do
      if Instances[i]<>Value then DeleteInstance(Instances[i])
      else Inc(i);
  end
  else
  begin
    while InstanceCount>0 do DeleteInstance(Instances[0]);
    PL:=TCompInspPropertyList.CreateWithOwner(nil,Self);
    PL.Instance:=Value;
    FPropertyLists.Add(PL);
    Update;
  end;
end;

function TCompInspList.GetInstanceCount: Integer;
begin
  Result:=FPropertyLists.Count;
end;

function TCompInspList.GetArrayInstance(Index: Integer): TComponent;
begin
  if ValidListIndex(Index) then Result:=TCompInspPropertyList(FPropertyLists[Index]).Instance
  else Result:=nil;
end;

procedure TCompInspList.SetMode(const Value: TCompInspMode);
var
  i: Integer;
begin
  FMode:=Value;
  for i:=0 to Pred(PropertyListCount) do
    PropertyLists[i].Mode:=FMode;
  Update;
end;

function TCompInspList.GetPropertyCount: Integer;
begin
  Result:=FProperties.Count;