designeditors.pas

关于USB的一段源码,大家可以试下,第一次上传

    else if SameText(FLookingFor.Name, Component.Name) then
    begin
      FDoneLooking := True;
    end
    else
    begin

      if (FAncestor = nil) and (Component <> Designer.Root)
        and IsProxyClass(Component.ClassType) then
      begin
        TempAncestor := Designer.FindRootAncestor(Component.ClassName);
        if TempAncestor <> nil then
        begin
          FAncestor := TempAncestor;
          FRootAncestor := TComponent(FAncestor);
        end;

{        InlineRoot := ActiveDesigner.OpenRootClass(Component.ClassName);
        if InlineRoot <> nil then
        begin
          FAncestor := InlineRoot.GetRoot;
          FRootAncestor := TComponent(FAncestor);
        end;
        }
      // use IDesigner.FindRootAncestor
      end;

      // Component.WriteState(Self); // This is simulated below, inline
      OldAncestorList := FAncestorList;
      OldRoot := FRoot;
      OldRootAncestor := FRootAncestor;
      try
        FAncestorList := nil;
  //        if the instance isn't a TActiveXControl...
  //        if not IgnoreChildren then
          try
            if (FAncestor <> nil) and (FAncestor is TComponent) then
            begin
              if csInline in TComponent(FAncestor).ComponentState then
                FRootAncestor := TComponent(FAncestor);
              FAncestorList := TList.Create;
              TComponentHack(FAncestor).GetChildren(AddAncestor, FRootAncestor);
            end;
            if csInline in Component.ComponentState then
              FRoot := Component;
            TComponentHack(Component).GetChildren(WriteComponentSimulation, FRoot);
          finally
            FAncestorList.Free;
          end;
      finally
        FAncestorList := OldAncestorList;
        if not FDoneLooking then
        begin
          FRoot := OldRoot;
          FRootAncestor := OldRootAncestor;
        end;
      end;
    end;
  finally
    if not FDoneLooking then
    begin
      // Only restore the ancestor if we were not done looking.
      // This way, we can continue up the chaing looking for the
      // component
      FAncestor := OldAncestor;
      FRootAncestor := OldRootAncestor;
    end
  end;
end;

function TPropertyEditor.GetIsDefault: Boolean;
  function CheckProperties(AnObject: TObject): Boolean;
  var
    PropList: PPropList;
    PropInfo: PPropInfo;
    I, Count: Integer;
  begin
    Result := True;
    // Go through each of the properties on the object
    Count := GetTypeData(AnObject.ClassInfo)^.PropCount;
    if Count > 0 then
    begin
      GetMem(PropList, Count * SizeOf(Pointer));
      try
        GetPropInfos(AnObject.ClassInfo, PropList);
        for I := 0 to Count - 1 do
        begin
          PropInfo := PropList^[I];
          if PropInfo = nil then
            Break;
          if not IsDefaultPropertyValue(AnObject, PropInfo, GetLookupInfo) then
          begin
            Result := False;
            Break;
          end;
        end;
      finally
        FreeMem(PropList, Count * SizeOf(Pointer));
      end;
    end;
  end;

var
  FirstInstance: TObject;
  FirstPropInfo: PPropInfo;

  SubObject: TObject;
  OldAncestor: TPersistent;
  
begin
  Result := True;
  if PropCount > 0 then
  begin
    // if they are not all equal, then they aren't all the default (at least one..)
    if not AllEqual then
    begin
      Result := False;
      Exit;
    end;

    FirstInstance := FPropList^[0].Instance;
    FirstPropInfo := FPropList^[0].PropInfo;
    if IsStoredProp(FirstInstance, FirstPropInfo) then
    begin
      // TWriter.WriteDescendent simulation
      if (Designer.AncestorDesigner <> nil) then
      begin
        FRootAncestor := Designer.AncestorDesigner.Root;
        FAncestor := FRootAncestor;
      end
      else
      begin
        FRootAncestor := nil;
        FAncestor := nil;
      end;
      FRoot := Designer.Root;

      if FirstInstance is TComponent then
      begin
        FLookingFor := TComponent(FirstInstance);
        // Only lookup the component if it was introduced in an ancestor form/frame
        if csAncestor in FLookingFor.ComponentState then
        begin
          FDoneLooking := False;
          WriteComponentSimulation(FRoot);
        end
        else
        begin
          FRootAncestor := nil;
          FAncestor := nil;
        end;
      end
      else
      begin
        // In this case, we will not look up the ancestor (there really
        // isn't one - take columns on tlistview as an example)
        FRootAncestor := nil;
        FAncestor := nil;
      end;

      Result := IsDefaultPropertyValue(FirstInstance, FirstPropInfo, GetLookupInfo);
      if not Result then
      begin
        if FirstPropInfo^.PropType^.Kind = tkClass then
        begin
          // If it was a class/object then we need to recursivly check that
          // object to see if it has all default properties.
          SubObject := GetObjectProp(FirstInstance, FirstPropInfo);

          OldAncestor := FAncestor;
          try
            if AncestorIsValid(FAncestor, FRoot, FRootAncestor) then
              FAncestor := TPersistent(GetOrdProp(FAncestor, FirstPropInfo));
            Result := CheckProperties(SubObject);
          finally
            FAncestor := OldAncestor;
          end;

          if SubObject is TCollection then
          begin
            if not AncestorIsValid(FAncestor, FRoot, FRootAncestor) or
              not CollectionsEqual(TCollection(SubObject),
                TCollection(GetOrdProp(FAncestor, FirstPropInfo)),
                  FRoot, FRootAncestor) then
                  Result := False;
          end;
        end;
      end;
    end;
  end;
end;

procedure TPropertyEditor.AddAncestor(Component: TComponent);
begin
  FAncestorList.Add(Component);
end;

procedure TPropertyEditor.GetLookupInfo(var Ancestor: TPersistent;
  var Root, LookupRoot, RootAncestor: TComponent);
begin
  Ancestor := FAncestor;
  Root := FRoot;
  LookupRoot := FRoot; // Same in this case 
  RootAncestor := FRootAncestor;  
end;

{ TOrdinalProperty }

function TOrdinalProperty.AllEqual: Boolean;
var
  I: Integer;
  V: Longint;
begin
  Result := False;
  if PropCount > 1 then
  begin
    V := GetOrdValue;
    for I := 1 to PropCount - 1 do
      if GetOrdValueAt(I) <> V then Exit;
  end;
  Result := True;
end;

function TOrdinalProperty.GetEditLimit: Integer;
begin
  Result := 63;
end;

{ TIntegerProperty }

function TIntegerProperty.GetValue: string;
begin
  with GetTypeData(GetPropType)^ do
    if OrdType = otULong then // unsigned
      Result := IntToStr(Cardinal(GetOrdValue))
    else
      Result := IntToStr(GetOrdValue);
end;

procedure TIntegerProperty.SetValue(const Value: String);

  procedure Error(const Args: array of const);
  begin
    raise EPropertyError.CreateResFmt(@SOutOfRange, Args);
  end;

var
  L: Int64;
begin
  L := StrToInt64(Value);
  with GetTypeData(GetPropType)^ do
    if OrdType = otULong then
    begin   // unsigned compare and reporting needed
      if (L < Cardinal(MinValue)) or (L > Cardinal(MaxValue)) then
        // bump up to Int64 to get past the %d in the format string
        Error([Int64(Cardinal(MinValue)), Int64(Cardinal(MaxValue))]);
    end
    else if (L < MinValue) or (L > MaxValue) then
      Error([MinValue, MaxValue]);
  SetOrdValue(L);
end;

{ TCharProperty }

function TCharProperty.GetValue: string;
var
  Ch: Char;
begin
  Ch := Chr(GetOrdValue);
  if Ch in [#33..#127] then
    Result := Ch else
    FmtStr(Result, '#%d', [Ord(Ch)]);
end;

procedure TCharProperty.SetValue(const Value: string);
var
  L: Longint;
begin
  if Length(Value) = 0 then L := 0 else
    if Length(Value) = 1 then L := Ord(Value[1]) else
      if Value[1] = '#' then L := StrToInt(Copy(Value, 2, Maxint)) else
        raise EPropertyError.CreateRes(@SInvalidPropertyValue);
  with GetTypeData(GetPropType)^ do
    if (L < MinValue) or (L > MaxValue) then
      raise EPropertyError.CreateResFmt(@SOutOfRange, [MinValue, MaxValue]);
  SetOrdValue(L);
end;

{ TEnumProperty }

function TEnumProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paMultiSelect, paValueList, paSortList, paRevertable];
end;

function TEnumProperty.GetValue: string;
var
  L: Longint;
begin
  L := GetOrdValue;
  with GetTypeData(GetPropType)^ do
    if (L < MinValue) or (L > MaxValue) then L := MaxValue;
  Result := GetEnumName(GetPropType, L);
end;

procedure TEnumProperty.GetValues(Proc: TGetStrProc);
var
  I: Integer;
  EnumType: PTypeInfo;
begin
  EnumType := GetPropType;
  with GetTypeData(EnumType)^ do
  begin
    if MinValue < 0 then  // longbool/wordbool/bytebool
    begin
      Proc(GetEnumName(EnumType, 0));
      Proc(GetEnumName(EnumType, 1));
    end
    else
      for I := MinValue to MaxValue do Proc(GetEnumName(EnumType, I));
  end;
end;

procedure TEnumProperty.SetValue(const Value: string);
var
  I: Integer;
begin
  I := GetEnumValue(GetPropType, Value);
  with GetTypeData(GetPropType)^ do
    if (I < MinValue) or (I > MaxValue) then
      raise EPropertyError.CreateRes(@SInvalidPropertyValue);
  SetOrdValue(I);
end;

{ TBoolProperty  }
{!!
function TBoolProperty.GetValue: string;
begin
  Result := BooleanIdents[GetOrdValue <> 0];
end;

procedure TBoolProperty.GetValues(Proc: TGetStrProc);
begin
  Proc(BooleanIdents[False]);
  Proc(BooleanIdents[True]);
end;

procedure TBoolProperty.SetValue(const Value: string);
var
  I: Integer;
begin
  if SameText(Value, BooleanIdents[False]) then
    I := 0
  else if SameText(Value, BooleanIdents[True]) then
    I := -1
  else
    I := StrToInt(Value);
  SetOrdValue(I);
end;
}
{ TInt64Property }

function TInt64Property.AllEqual: Boolean;
var
  I: Integer;
  V: Int64;
begin
  Result := False;
  if PropCount > 1 then
  begin
    V := GetInt64Value;
    for I := 1 to PropCount - 1 do
      if GetInt64ValueAt(I) <> V then Exit;
  end;
  Result := True;
end;

function TInt64Property.GetEditLimit: Integer;
begin
  Result := 63;
end;

function TInt64Property.GetValue: string;
begin
  Result := IntToStr(GetInt64Value);
end;

procedure TInt64Property.SetValue(const Value: string);
begin
  SetInt64Value(StrToInt64(Value));
end;

{ TFloatProperty }

function TFloatProperty.AllEqual: Boolean;
var
  I: Integer;
  V: Extended;
begin
  Result := False;
  if PropCount > 1 then
  begin
    V := GetFloatValue;
    for I := 1 to PropCount - 1 do
      if GetFloatValueAt(I) <> V then Exit;
  end;
  Result := True;
end;

function TFloatProperty.GetValue: string;
const
  Precisions: array[TFloatType] of Integer = (7, 15, 18, 18, 18);
begin
  Result := FloatToStrF(GetFloatValue, ffGeneral,
    Precisions[GetTypeData(GetPropType)^.FloatType], 0);
end;

procedure TFloatProperty.SetValue(const Value: string);
begin
  SetFloatValue(StrToFloat(Value));
end;

{ TStringProperty }

function TStringProperty.AllEqual: Boolean;
var
  I: Integer;
  V: string;
begin
  Result := False;
  if PropCount > 1 then
  begin
    V := GetStrValue;
    for I := 1 to PropCount - 1 do
      if GetStrValueAt(I) <> V then Exit;
  end;
  Result := True;
end;

function TStringProperty.GetEditLimit: Integer;
begin
  if GetPropType^.Kind = tkString then
    Result := GetTypeData(GetPropType)^.MaxLength
  else
    Result := inherited GetEditLimit;
end;

function TStringProperty.GetValue: string;
begin
  Result := GetStrValue;
end;

procedure TStringProperty.SetValue(const Value: string);