compinsp.pas

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

  i: Integer;
  P: TProperty;
  FN: string;
begin
  Result:='';
  with FPropertyList do
  begin
    if ValidPropIndex(TheIndex) then
    begin
      Result:=Properties[TheIndex].DisplayValue;
      FN:=Properties[TheIndex].FullName;
      if TheIndex<>ItemIndex then
        with FPropertyLists do
          for i:=1 to Pred(PropertyListCount) do
          begin
            P:=PropertyLists[i].FindProperty(FN);
            if Assigned(P) then
              if P.DisplayValue<>Result then
              begin
                Result:='';
                Break;
              end;
          end;
    end;
    Result:=Translate(Result,True);
    if Assigned(OnGetValue) then OnGetValue(Self,TheIndex,Result);
  end;
end;

function TCustomComponentInspector.GetNextValue(TheIndex: Integer): string;
var
  SL: TStringList;
  I: Integer;
begin
  with FPropertyList,FProperties do
  begin
    if ValidPropIndex(TheIndex) then
    begin
      SL:=TStringList.Create;
      try
        GetValuesList(TheIndex,SL);
        SL.Sorted:=GetSortValuesList(TheIndex);
        I:=SL.IndexOf(GetValue(TheIndex));
        if I<>-1 then
        begin
          if I<Pred(SL.Count) then Inc(I)
          else I:=0;
          Result:=SL[I];
        end
        else Result:=GetValue(TheIndex);
      finally
        SL.Free;
      end;
    end
    else Result:='';
    if Assigned(OnGetNextValue) then OnGetNextValue(Self,TheIndex,Result);
  end;
end;

procedure TCustomComponentInspector.SetValue(TheIndex: Integer; const Value: string);
var
  i: Integer;
  P: TProperty;
  Val,Name: string;
  EnableDefault: Boolean;
begin
  with FPropertyList do
  begin
    EnableDefault:=True;
    Val:=Value;
    if Assigned(OnSetValue) then
      OnSetValue(Self,TheIndex,Val,EnableDefault);
    if EnableDefault and ValidPropIndex(TheIndex) then
    begin
      Val:=Translate(Val,False);
      Name:=Properties[TheIndex].FullName;
      for i:=0 to Pred(PropertyListCount) do
      begin
        P:=PropertyLists[i].FindProperty(Name);
        if Assigned(P) then P.AsString:=Val;
      end;
    end;
    Change(TheIndex);
  end;
end;

procedure TCustomComponentInspector.DragValue(TheIndex,Offset: Integer);
begin
  with FPropertyList do
    if ValidPropIndex(TheIndex) then
      with Properties[TheIndex] do SetEditedText(IntToStr(AsInteger+Offset));
end;

function TCustomComponentInspector.GetButtonType(TheIndex: Integer): TButtonType;
begin
  if GetEnableExternalEditor(TheIndex) then Result:=btDialog
  else Result:=btNone;
  with FPropertyList do
  begin
    if ValidPropIndex(TheIndex) then
      with Properties[TheIndex] do
        if Emulated then
        begin
//          if Assigned(OwnerProperty) and (OwnerProperty.TypeKind<>tkVariant) then
          if Assigned(OwnerProperty) then
            Result:=btDropDown;
        end
        else
          case TypeKind of
            tkString,tkLString,tkWString:
              if PropType=TypeInfo(TFontName) then Result:=btDropDown;
            tkEnumeration:
              if GetInplaceEditorType(TheIndex)<>ieCheckBox then
                Result:=btDropDown;
            tkClass:
              if IsType(TypeInfo(TCollection)) or
                IsType(TypeInfo(TMenuItem)) or
                IsType(TypeInfo(TTreeNodes)) or
                IsType(TypeInfo(TListItems)) then Result:=btDialog
              else
                if IsType(TypeInfo(TComponent)) then Result:=btDropDown;
            {$IFNDEF VERSION3}
            tkInterface: Result:=btDropDown;
            {$ENDIF}
            tkInteger:
              if (PropType=TypeInfo(TColor)) or
                (PropType=TypeInfo(TCursor)) or
                (PropType=TypeInfo(TFontCharset)) or
                (PropType=TypeInfo(TShortCut)) then Result:=btDropDown
              else Result:=btUpDown;
            tkMethod: Result:=btDropDown;
          end;
    if (Result<>btDialog) and GetReadOnly(TheIndex) then Result:=btNone;
    if Assigned(OnGetButtonType) then OnGetButtonType(Self,TheIndex,Result);
  end;
end;

function TCustomComponentInspector.GetInplaceEditorType(TheIndex: Integer): TInplaceEditorType;
begin
  with FPropertyList do
  begin
    if ValidPropIndex(TheIndex) then
      with Properties[TheIndex] do
        if (PropType=TypeInfo(Boolean)) and CheckBoxes then Result:=ieCheckBox
        else Result:=ieEdit
    else Result:=ieNone;
    if Assigned(OnGetInplaceEditorType) then OnGetInplaceEditorType(Self,TheIndex,Result);
  end;
end;

function TCustomComponentInspector.GetEnableExternalEditor(TheIndex: Integer): Boolean;
begin
  Result:=False;
  with FPropertyList do
  begin
    if ValidPropIndex(TheIndex) then
      with Properties[TheIndex] do
        case TypeKind of
          tkInteger: Result:=PropType=TypeInfo(TColor);
          tkClass:
            Result:=
              IsType(TypeInfo(TCollection)) or
              IsType(TypeInfo(TMenuItem)) or
              IsType(TypeInfo(TTreeNodes)) or
              IsType(TypeInfo(TListItems)) or
              IsType(TypeInfo(TFont)) or
              IsType(TypeInfo(TStrings)) or
              IsType(TypeInfo(TGraphic)) or
              IsType(TypeInfo(TPicture));
        end;
    if Assigned(OnGetEnableExternalEditor) then OnGetEnableExternalEditor(Self,TheIndex,Result);
  end;
end;

function TCustomComponentInspector.GetReadOnly(TheIndex: Integer): Boolean;
begin
  Result:=False;
  with FPropertyList do
  begin
    if ValidPropIndex(TheIndex) then
      with Properties[TheIndex] do
        if (TypeKind=tkClass) and not IsType(TypeInfo(TComponent)) then Result:=True;
    if Assigned(OnGetReadOnly) then OnGetReadOnly(Self,TheIndex,Result);
  end;
end;

function TCustomComponentInspector.GetExpandState(TheIndex: Integer): TExpandState;
begin
  Result:=esNone;
  with FPropertyList do
  begin
    if ValidPropIndex(TheIndex) then
      with Properties[TheIndex] do
        case TypeKind of
          tkVariant,tkSet:
            if (TheIndex<Pred(PropertyCount)) and (GetLevel(Succ(TheIndex))>Level) then Result:=esCollapse
            else Result:=esExpand;
          tkClass:
            if not (AsObject is TComponent) and (Properties.Count>0) then
              if (TheIndex<Pred(PropertyCount)) and (GetLevel(Succ(TheIndex))>Level) then Result:=esCollapse
              else Result:=esExpand;
        end;
    if Assigned(OnGetExpandState) then OnGetExpandState(Self,TheIndex,Result);
  end;
end;

function TCustomComponentInspector.GetLevel(TheIndex: Integer): Integer;
begin
  with FPropertyList do
  begin
    if ValidPropIndex(TheIndex) then Result:=Properties[TheIndex].Level
    else Result:=0;
    if Assigned(OnGetLevel) then OnGetLevel(Self,TheIndex,Result);
  end;
end;

procedure TCustomComponentInspector.GetValuesList(TheIndex: Integer; const Strings: TStrings);
var
  i: Integer;
begin
  with FPropertyList do
  begin
    if ValidPropIndex(TheIndex) and Assigned(Strings) then
    begin
      Properties[TheIndex].ValuesList(Strings);
      for i:=0 to Pred(Strings.Count) do Strings[i]:=Translate(Strings[i],True);
    end;
    if Assigned(OnGetValuesList) then OnGetValuesList(Self,TheIndex,Strings);
  end;
end;

function TCustomComponentInspector.GetSortValuesList(TheIndex: Integer): Boolean;
begin
  with FPropertyList do
  begin
    if ValidPropIndex(TheIndex) then
      with Properties[TheIndex] do
        Result:=(PropType=TypeInfo(TCursor)) or (TypeKind=tkMethod) or
          Assigned(OwnerProperty) and (OwnerProperty.TypeKind=tkVariant)
    else Result:=False;
    if Assigned(OnGetSortValuesList) then OnGetSortValuesList(Self,TheIndex,Result);
  end;
end;

function TCustomComponentInspector.GetSelectedValue(TheIndex: Integer): string;
begin
  Result:=GetValue(TheIndex);
  if Assigned(OnGetSelectedValue) then OnGetSelectedValue(Self,TheIndex,Result);
end;

function TCustomComponentInspector.GetAutoApply(TheIndex: Integer): Boolean;
begin
  with FPropertyList do
  begin
    if ValidPropIndex(TheIndex) then
      Result:=(Properties[TheIndex].TypeKind<>tkClass) or (Properties[TheIndex].IsType(TypeInfo(TComponent))) and
        (PropertyListCount=1) and (GetInplaceEditorType(TheIndex)<>ieCheckBox)
    else Result:=False;
    if Assigned(OnGetAutoApply) then OnGetAutoApply(Self,TheIndex,Result);
  end;
end;

function TCustomComponentInspector.CallEditor(TheIndex: Integer): Boolean;
var
  PC: TPropertyEditorClass;
  PE: TPropertyEditor;
  P: TProperty;
  EnableDefault: Boolean;
begin
  EnableDefault:=True;
  if Assigned(FOnCallEditor) then Result:=FOnCallEditor(Self,TheIndex,EnableDefault)
  else Result:=False;
  if EnableDefault then
  begin
    PC:=GetEditorClass(TheIndex);
    if Assigned(PC) then
      with FPropertyList do
      begin
        P:=Properties[TheIndex];
        if Assigned(P) then
        begin
          PE:=PC.Create(P);
          try
            Result:=PE.Execute;
            if Result then
            begin
              SetValue(TheIndex,P.AsString);
              FullUpdateNeeded;
            end;
          finally
            PE.Free;
            Update;
          end;
        end;
    end;
  end;
end;

procedure TCustomComponentInspector.Expand(TheIndex: Integer);
var
  i: Integer;
  EnableDefault: Boolean;
begin
  if GetExpandState(TheIndex)=esExpand then
    with FPropertyList do
    begin
      EnableDefault:=True;
      if Assigned(FOnBeforeExpand) then FOnBeforeExpand(Self,TheIndex,EnableDefault);
      if EnableDefault and ValidPropIndex(TheIndex) then
      begin
        with Properties[TheIndex],Properties do
        begin
          FExpanded.Add(FullName);
          for i:=Pred(Count) downto 0 do
          begin
            FProperties.Insert(Succ(TheIndex),Properties[i]);
            Items.Insert(Succ(TheIndex),Properties[i].Name);
          end;
        end;
        if Assigned(FOnAfterExpand) then FOnAfterExpand(Self,TheIndex);
      end;
    end;
end;

procedure TCustomComponentInspector.Collapse(TheIndex: Integer);
var
  L,i: Integer;
  EnableDefault: Boolean;
begin
  if GetExpandState(TheIndex)=esCollapse then
  begin
    with FPropertyList do
    begin
      EnableDefault:=True;
      if Assigned(FOnBeforeCollapse) then FOnBeforeCollapse(Self,TheIndex,EnableDefault);
      if EnableDefault and ValidPropIndex(TheIndex) then
      begin
        L:=Properties[TheIndex].Level;
        with FExpanded do
        begin
          i:=IndexOf(Properties[TheIndex].FullName);
          if i<>-1 then Delete(i);
        end;
        while (Succ(TheIndex)<PropertyCount) and (Properties[Succ(TheIndex)].Level>L) do
        begin
          FProperties.Delete(Succ(TheIndex));
          Items.Delete(Succ(TheIndex));
        end;
        if Assigned(FOnAfterCollapse) then FOnAfterCollapse(Self,TheIndex);
      end;
    end;
  end;
end;

procedure TCustomComponentInspector.SelectItem(TheIndex: Integer);
begin
  inherited;
  with FPropertyList do
    if ValidPropIndex(ItemIndex) then
      FSelectedProperty:=FPropertyList.Properties[ItemIndex].FullName;
end;

function TCustomComponentInspector.GetEditorClass(TheIndex: Integer): TPropertyEditorClass;
begin
  Result:=nil;
  with FPropertyList do
  begin
    if ValidPropIndex(TheIndex) then
      with Properties[TheIndex] do
        case TypeKind of
          tkInteger:
            if PropType=TypeInfo(TColor) then Result:=TColorPropertyEditor;
          tkClass:
            if IsType(TypeInfo(TCollection)) then Result:=TCollectionPropertyEditor
            else
              if IsType(TypeInfo(TMenuItem)) then Result:=TMenuPropertyEditor
              else
                if IsType(TypeInfo(TTreeNodes)) then Result:=TTreePropertyEditor
                else
                  if IsType(TypeInfo(TListItems)) then Result:=TListViewPropertyEditor
                  else
                    if IsType(TypeInfo(TFont)) then Result:=TFontPropertyEditor
                    else
                      if IsType(TypeInfo(TStrings)) then Result:=TStringsPropertyEditor
                      else
                        if IsType(TypeInfo(TPicture)) or IsType(TypeInfo(TGraphic)) then
                          Result:=TPicturePropertyEditor;
        end;
    if Assigned(FOnGetEditorClass) then FOnGetEditorClass(Self,TheIndex,Result);
  end;
end;

procedure TCustomComponentInspector.Compare(Prop1,Prop2: TProperty; var Result: Integer);
begin
  if Assigned(FOnCompare) then FOnCompare(Self,Prop1,Prop2,Result);
end;

procedure TCustomComponentInspector.Filter(Prop: TProperty; var Result: Boolean);
begin
  if Assigned(FOnFilter) then FOnFilter(Self,Prop,Result);
end;

procedure TCustomComponentInspector.Change(TheIndex: Integer);
begin
  if Assigned(FOnChange) then FOnChange(Self,TheIndex);
end;

constructor TCustomComponentInspector.Create(AOwner: TComponent);
begin
  inherited;
  FDictionary:=TStringList.Create;
  FMultiSelect:=True;
  FPropertyList:=TCompInspList.CreateWithOwner(Self);
  FNotificationControls:=TList.Create;
end;

destructor TCustomComponentInspector.Destroy;
begin
  FPropertyList.Free;
  FNotificationControls.Free;
  FDictionary.Free;
  inherited;
end;

procedure TCustomComponentInspector.AddInstance(AInstance: TComponent);
begin
  FPropertyList.AddInstance(AInstance);
  if Assigned(AInstance) and AInstance.InheritsFrom(TComponent) then
    FreeNotification(AInstance);
  if not Locked then UpdateList;
end;

procedure TCustomComponentInspector.DeleteInstance(AInstance: TComponent);
begin
  FPropertyList.DeleteInstance(AInstance);
  if not Locked then UpdateList;
end;

function TCustomComponentInspector.IndexOfInstance(AInstance: TComponent): Integer;
begin
  Result:=FPropertyList.IndexOfInstance(AInstance);
end;

procedure TCustomComponentInspector.AddNotification(TheControl: TControl);
begin
  with FNotificationControls do
    if IndexOf(TheControl)=-1 then Add(TheControl);
end;

procedure TCustomComponentInspector.DeleteNotification(TheControl: TControl);
var
  Index: Integer;
begin
  with FNotificationControls do
  begin
    Index:=IndexOf(TheControl);
    if Index<>-1 then Delete(Index);
  end;
end;

procedure TCustomComponentInspector.FillEventList(EventType: PTypeInfo; Strings: TStrings);
begin
  if Assigned(FOnFillEventList) then FOnFillEventList(Self,EventType,Strings);
end;

procedure TCustomComponentInspector.CustomizeInspector(Inspector: TComponentInspector);
begin
  if Assigned(FOnCustomizeInspector) then FOnCustomizeInspector(Self,Inspector);
end;

procedure TCustomComponentInspector.FullExpand;
var
  i: Integer;
begin
  i:=0;
  while i<ItemCount do
  begin
    if GetExpandState(i)=esExpand then Expand(i);
    Inc(i);
  end;
end;

end.