compinsp.pas

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

end;

function TCompInspList.GetProperty(Index: Integer): TProperty;
begin
  if ValidPropIndex(Index) then Result:=TProperty(FProperties[Index])
  else Result:=nil;
end;

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

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

procedure TCompInspList.Clear;
var
  i: Integer;
begin
  with FPropertyLists do
  begin
    for i:=0 to Pred(Count) do TPropertyList(FPropertyLists[i]).Free;
    Clear;
  end;
  FProperties.Clear;
end;

constructor TCompInspList.CreateWithOwner(AOwner: TCustomComponentInspector);
begin
  inherited;
  FOwner:=AOwner;
  FPropertyLists:=TList.Create;
  FProperties:=TList.Create;
  FExpanded:=TStringList.Create;
end;

destructor TCompInspList.Destroy;
begin
  Clear;
  FPropertyLists.Free;
  FProperties.Free;
  FExpanded.Free;
  inherited;
end;

procedure TCompInspList.Update;

var
  i,j: Integer;
  Found: Boolean;
  P: TProperty;
  ClassList: TList;

  procedure ExpandProperty(Index: Integer; P: TProperty);
  var
    i: Integer;
  begin
    if FExpanded.IndexOf(P.FullName)<>-1 then
      with P.Properties do
        for i:=Pred(Count) downto 0 do
        begin
          if FExpanded.IndexOf(Properties[i].FullName)<>-1 then ExpandProperty(Index,Properties[i]);
          if Filter(Properties[i]) then FProperties.Insert(Succ(Index),Properties[i]);
        end;
  end;

begin
  ClassList:=TList.Create;
  try
    FProperties.Clear;
    if ValidListIndex(0) then
      with PropertyLists[0] do
        for i:=0 to Pred(Count) do
        begin
          if Filter(Properties[i]) then FProperties.Add(Properties[i]);
          ExpandProperty(Pred(FProperties.Count),Properties[i]);
        end;
    if PropertyListCount>1 then
    begin
      i:=0;
      while i<PropertyCount do
      begin
        Found:=AnsiUpperCase(Properties[i].FullName)<>'NAME';
        if Found then
        begin
          ClassList.Clear;
          for j:=0 to Pred(PropertyListCount) do
            if Properties[i].Custom then Found:=RegisteredProperty(PropertyLists[j].Instance.ClassType,Properties[i].Name)
            else
            begin
              if ClassList.IndexOf(PropertyLists[j].Instance.ClassType)=-1 then
              begin
                ClassList.Add(PropertyLists[j].Instance.ClassType);
                P:=PropertyLists[j].FindProperty(Properties[i].FullName);
                if not Properties[i].IsCompatible(P) then
                begin
                  Found:=False;
                  Break;
                end;
              end;
            end;
        end;
        if not Found then FProperties.Delete(i)
        else Inc(i);
      end;
    end;
    FOwner.ItemCount:=FProperties.Count;
  finally
    ClassList.Free;
  end;
end;

procedure TCompInspList.AddInstance(AInstance: TComponent);
var
  Index: Integer;
  PL: TCompInspPropertyList;
begin
  if not (Owner as TCustomComponentInspector).FMultiSelect then Instance:=AInstance
  else
    if Assigned(AInstance) then
    begin
      Index:=IndexOfInstance(AInstance);
      with FPropertyLists do
        if Index=-1 then
        begin
          PL:=TCompInspPropertyList.CreateWithOwner(nil,Self);
          PL.Instance:=AInstance;
          Add(PL);
        end;
      Update;             
    end;
end;

procedure TCompInspList.DeleteInstance(AInstance: TComponent);
var
  Index: Integer;
begin
  Index:=IndexOfInstance(AInstance);
  if Index<>-1 then
    with FPropertyLists do
    begin
      TPropertyList(FPropertyLists[Index]).Free;
      Delete(Index);
      Update;
    end;
  Update;
end;

function TCompInspList.IndexOfInstance(AInstance: TComponent): Integer;
var
  i: Integer;
begin
  Result:=-1;
  with FPropertyLists do
    for i:=0 to Pred(Count) do
      if TPropertyList(FPropertyLists[i]).Instance=AInstance then Result:=i;
end;

function TCompInspList.ValidListIndex(Index: Integer): Boolean;
begin
  with FPropertyLists do
    Result:=(Index>=0) and (Index<Count);
end;

function TCompInspList.ValidPropIndex(Index: Integer): Boolean;
begin
  with FProperties do
    Result:=(Index>=0) and (Index<Count);
end;

procedure TCustomComponentInspector.SetMultiSelectProperty(const Value: Boolean);
begin
  FMultiSelect:=Value;
  //if not FMultiSelect then Instance:=nil;
end;

procedure TCustomComponentInspector.SetDictionary(const Value: TStrings);
begin
  FDictionary.Assign(Value);
end;

procedure TCustomComponentInspector.SetDictionaryFile(const Value: string);
begin
  if FDictionaryFile<>Value then
  begin
    FDictionaryFile:=Value;
    UpdateDictionary;
    Invalidate;
  end;
end;

procedure TCustomComponentInspector.SetRoot(const Value: TComponent);
begin
  FPropertyList.Root:=Value;
  if not Locked then UpdateList;
end;

function TCustomComponentInspector.GetRoot: TComponent;
begin
  Result:=FPropertyList.Root;
end;

function TCustomComponentInspector.IndexOfPropertyName(AFullName: string): Integer;
var
  i: Integer;
begin
  Result:=-1;
  for i:=0 to Pred(ItemCount) do
    if AnsiUpperCase(Properties[i].FullName)=AnsiUpperCase(AFullName) then
    begin
      Result:=i;
      Break;
    end;
end;

procedure TCustomComponentInspector.SelectProperty(AFullName: string);
begin
  ItemIndex:=IndexOfPropertyName(AFullName);
end;

function TCustomComponentInspector.IndexOfProperty(P: TProperty): Integer;
var
  i: Integer;
begin
  Result:=-1;
  for i:=0 to Pred(ItemCount) do
    if Properties[i]=P then
    begin
      Result:=i;
      Break;
    end;
end;

procedure TCustomComponentInspector.SetInstance(const Value: TComponent);
begin
  FPropertyList.Instance:=Value;
  if Assigned(Value) and Value.InheritsFrom(TComponent) then
    FreeNotification(Value);
  UpdateList;
end;

function TCustomComponentInspector.GetInstance: TComponent;
begin
  Result:=FPropertyList.Instance;
end;

function TCustomComponentInspector.GetInstanceCount: Integer;
begin
  Result:=FPropertyList.InstanceCount;
end;

function TCustomComponentInspector.GetArrayInstance(Index: Integer): TComponent;
begin
  Result:=FPropertyList.Instances[Index];
end;

function TCustomComponentInspector.GetMode: TCompInspMode;
begin
  Result:=FPropertyList.Mode;
end;

procedure TCustomComponentInspector.SetMode(const Value: TCompInspMode);
begin
  if Mode<>Value then
  begin
    FPropertyList.Mode:=Value;
    UpdateList;
    SetSelectionPos(ItemIndex,True);
  end;
end;

function TCustomComponentInspector.GetPropertyCount: Integer;
begin
  Result:=FPropertyList.PropertyCount;
end;

function TCustomComponentInspector.GetProperty(TheIndex: Integer): TProperty;
begin
  Result:=FPropertyList.Properties[TheIndex];
end;

procedure TCustomComponentInspector.UpdateList;
begin
  FullUpdateNeeded;
  Update;
  ItemCount:=FPropertyList.PropertyCount;
  ItemIndex:=GetDefaultIndex;
end;

procedure TCustomComponentInspector.UpdateDictionary;
var
  S: string;
begin
  if FDictionaryFile<>'' then
  begin
    if ExtractFilePath(FDictionaryFile)='' then
    begin
      S:=ExtractFilePath(Application.ExeName);
      if S[Length(S)]<>'\' then S:=S+'\';
      S:=S+FDictionaryFile;
    end
    else S:=FDictionaryFile;
    with TIniFile.Create(S) do
    try
      ReadSectionValues('GOIDICT',FDictionary);
    finally
      Free;
    end;
  end;
end;

function TCustomComponentInspector.Translate(const Value: string; Direction: Boolean): string;
var
  i: Integer;
begin
  if Value<>'' then
  begin
    with FDictionary do
      if Direction then Result:=Values[Value]
      else
      begin
        Result:='';
        for i:=0 to Pred(Count) do
          if lstrcmpi(PChar(Values[Names[i]]),PChar(Value))=0 then
          begin
            Result:=Names[i];
            Break;
          end;
      end;
    if Result='' then Result:=Value;
  end
  else Result:='';
end;

procedure TCustomComponentInspector.Update;
var
  i: Integer;
begin
  inherited;
  Lock;
  try
    with FNotificationControls do
      for i:=0 to Pred(Count) do
        TControl(FNotificationControls[i]).Perform(CM_OIUPDATED,0,0);
  finally
    Unlock;
  end;
end;

procedure TCustomComponentInspector.ClearExpanded;
begin
  with FPropertyList do
  begin
    FExpanded.Clear;
    Update;
  end;
end;

procedure TCustomComponentInspector.RefreshList;
var
  i: Integer;
begin
  with FPropertyList do
    for i:=0 to Pred(PropertyListCount) do PropertyLists[i].Update;
  FPropertyList.Update;
  ItemCount:=FPropertyList.PropertyCount;
  SelectProperty(FSelectedProperty);
  Invalidate;
end;

procedure TCustomComponentInspector.CreateWnd;
begin
  ItemCount:=FPropertyList.PropertyCount;
  inherited;
end;

procedure TCustomComponentInspector.Notification(AComponent: TComponent; Operation: TOperation);
begin
  if (Operation=opRemove) and not (csDestroying in ComponentState) then
  begin
    if FPropertyList.IndexOfInstance(AComponent)<>-1 then
    begin
      FPropertyList.DeleteInstance(AComponent);
      if HandleAllocated then UpdateList;
    end;
    if AComponent is TControl then DeleteNotification(TControl(AComponent));
  end;
  inherited;
end;

function TCustomComponentInspector.GetDefaultIndex: Integer;
var
  i: Integer;
begin
  Result:=0;
  if FSelectedProperty<>'' then
    with FPropertyList do
      for i:=0 to Pred(FProperties.Count) do
        if TProperty(FProperties[i]).FullName=FSelectedProperty then
        begin
          Result:=i;
          Break;
        end;
end;

function TCustomComponentInspector.GetPopupItemWidth(ListBox: TListBox; TheIndex: Integer): Integer;
begin
  Result:=inherited GetPopupItemWidth(ListBox,TheIndex);
  with FPropertyList do
    if ValidPropIndex(TheIndex) and (Properties[TheIndex].PropType=TypeInfo(TColor)) then Inc(Result,ItemHeight-2);
end;

procedure TCustomComponentInspector.DrawPopupItem(ListBox: TListBox; ListItemIndex: Integer; R: TRect; TheIndex: Integer);
var
  IR: TRect;
  OldColor: TColor;
begin
  with FPropertyList do
    if ValidPropIndex(TheIndex) and (Properties[TheIndex].PropType=TypeInfo(TColor)) then
      with ListBox,Canvas,R do
      begin
        FillRect(R);
        Pen.Color:=clWindowText;
        OldColor:=Brush.Color;
        try
          Brush.Color:=StringToColor(Translate(Items[ListItemIndex],False));
        except
          Brush.Color:=clWindow;
        end;
        IR:=R;
        InflateRect(IR,-2,-2);
        with IR do
        begin
          Dec(Bottom);
          Right:=Left+(Bottom-Top);
          Rectangle(Left,Top,Right,Bottom);
        end;
        Brush.Color:=OldColor;
        Inc(Left,ItemHeight-1);
        DrawText(Handle,PChar(Items[ListItemIndex]),-1,R,DT_SINGLELINE or DT_VCENTER);
      end
    else inherited;
end;

procedure TCustomComponentInspector.DrawPropertyValue(TheCanvas: TCanvas; TheIndex: Integer; R: TRect);
var
  IR: TRect;
begin
  with FPropertyList do
    if ValidPropIndex(TheIndex) and (Properties[TheIndex].PropType=TypeInfo(TColor)) then
      with TheCanvas,R do
      begin
        FillRect(R);
        Pen.Color:=clWindowText;
        Brush.Color:=Properties[TheIndex].AsInteger;
        IR:=R;
        InflateRect(IR,-2,-2);
        with IR do
        begin
          Dec(Bottom);
          Right:=Left+(Bottom-Top);
          Rectangle(Left,Top,Right,Bottom);
        end;
        Inc(Left,ItemHeight-2);
      end;
  inherited;
end;

function TCustomComponentInspector.GetName(TheIndex: Integer): string;
begin
  with FPropertyList do
  begin
    if ValidPropIndex(TheIndex) then Result:=Properties[TheIndex].Name
    else Result:='';
    Result:=Translate(Result,True);
    if Assigned(OnGetName) then OnGetName(Self,TheIndex,Result);
  end;
end;

function TCustomComponentInspector.GetValue(TheIndex: Integer): string;
var