cxoi.pas

delphi的的三方控件

    if (L < MinValue) or (L > MaxValue) then L := MaxValue;
  Result := GetEnumName(GetPropType, L);
end;

procedure TcxEnumProperty.GetValues(Proc: TGetStrProc);
var
  I: Integer;
  EnumType: PTypeInfo;
begin
  EnumType := GetPropType;
  with GetTypeData(EnumType)^ do
    for I := MinValue to MaxValue do
      Proc(GetEnumName(EnumType, I));
end;

procedure TcxEnumProperty.SetValue(const Value: string);
var
  I: Integer;
begin
  I := GetEnumValue(GetPropType, Value);
  if I < 0 then raise EcxPropertyError.Create(SInvalidPropertyValue);
  SetOrdValue(I);
end;

{ TcxBoolProperty  }

function TcxBoolProperty.GetValue: string;
begin
  if GetOrdValue = 0 then
    Result := 'False'
  else
    Result := 'True';
end;

procedure TcxBoolProperty.GetValues(Proc: TGetStrProc);
begin
  Proc('False');
  Proc('True');
end;

procedure TcxBoolProperty.SetValue(const Value: string);
var
  I: Integer;
begin
  if CompareText(Value, 'False') = 0 then
    I := 0
  else 
    if CompareText(Value, 'True') = 0 then
      I := 1
    else
      I := StrToInt(Value);
  SetOrdValue(I);
end;

{ TInt64Property }

function TcxInt64Property.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 TcxInt64Property.GetEditLimit: Integer;
begin
  Result := 63;
end;

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

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

{ TcxFloatProperty }

function TcxFloatProperty.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 TcxFloatProperty.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 TcxFloatProperty.SetValue(const Value: string);
begin
  SetFloatValue(StrToFloat(Value));
end;

{ TcxStringProperty }

function TcxStringProperty.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 TcxStringProperty.GetEditLimit: Integer;
begin
  if GetPropType^.Kind = tkString then
    Result := GetTypeData(GetPropType)^.MaxLength
  else
    Result := 255;
end;

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

procedure TcxStringProperty.SetValue(const Value: string);
begin
  SetStrValue(Value);
end;

{ TcxComponentNameProperty }

function TcxComponentNameProperty.GetAttributes: TcxPropertyAttributes;
begin
  Result := [];
end;

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

{ TcxSetElementProperty }

constructor TcxSetElementProperty.Create(APropList: PcxInstPropList;
  APropCount: Integer; AElement: Integer);
begin
  FPropList := APropList;
  FPropCount := APropCount;
  FElement := AElement;
end;

destructor TcxSetElementProperty.Destroy;
begin
end;

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

function TcxSetElementProperty.GetAttributes: TcxPropertyAttributes;
begin
  Result := [ipaMultiSelect, ipaValueList, ipaSortList, ipaRevertable];
end;

function TcxSetElementProperty.GetName: string;
begin
  Result := GetEnumName(GetTypeData(GetPropType)^.CompType^, FElement);
end;

function TcxSetElementProperty.GetValue: string;
var
  S: TcxIntegerSet;
begin
  Integer(S) := GetOrdValue;
  if FElement in S then
    Result := 'True'
  else
    Result := 'False';
end;

procedure TcxSetElementProperty.GetValues(Proc: TGetStrProc);
begin
  Proc('False');
  Proc('True');
end;

procedure TcxSetElementProperty.SetValue(const Value: string);
var
  S: TcxIntegerSet;
begin
  Integer(S) := GetOrdValue;
  if CompareText(Value, 'True') = 0 then
    Include(S, FElement)
  else
    Exclude(S, FElement);
  SetOrdValue(Integer(S));
end;

function TcxSetElementProperty.IsDefaultValue: Boolean;
var
  S1, S2: TcxIntegerSet;
  HasStoredProc: Integer;
  ProcAsInt: Integer;
begin
  Result := inherited IsDefaultValue;
  if not Result then
  begin
    ProcAsInt := Integer(PPropInfo(GetPropInfo)^.StoredProc);
    HasStoredProc := ProcAsInt and $FFFFFF00;
    if HasStoredProc = 0 then
    begin
      Integer(S1) := PPropInfo(GetPropInfo)^.Default;
      Integer(S2) := GetOrdValue;
      Result := not ((FElement in S1) xor (FElement in S2));
    end;
  end;
end;

{ TcxSetProperty }

function TcxSetProperty.GetAttributes: TcxPropertyAttributes;
begin
  Result := [ipaMultiSelect, ipaSubProperties, ipaReadOnly, ipaRevertable];
end;

procedure TcxSetProperty.GetProperties(AOwner: TComponent; Proc: TcxGetPropEditProc);
var
  I: Integer;
begin
  with GetTypeData(GetTypeData(GetPropType)^.CompType^)^ do
    for I := MinValue to MaxValue do
      Proc(TcxSetElementProperty.Create(FPropList, FPropCount, I));
end;

function TcxSetProperty.GetValue: string;
var
  S: TcxIntegerSet;
  TypeInfo: PTypeInfo;
  I: Integer;
begin
  Integer(S) := GetOrdValue;
  TypeInfo := GetTypeData(GetPropType)^.CompType^;
  Result := '[';
  for I := 0 to SizeOf(Integer) * 8 - 1 do
    if I in S then
    begin
      if Length(Result) <> 1 then Result := Result + ',';
      Result := Result + GetEnumName(TypeInfo, I);
    end;
  Result := Result + ']';
end;

{ TcxClassProperty }

function TcxClassProperty.GetAttributes: TcxPropertyAttributes;
begin
  Result := [ipaMultiSelect, ipaSubProperties, ipaReadOnly];
end;

procedure TcxClassProperty.GetProperties(AOwner: TComponent; Proc: TcxGetPropEditProc);
var
  Components: TcxComponentList;
  I: Integer;
begin
  Components := TcxComponentList.Create;
  try
    for I := 0 to PropCount - 1 do
      if TComponent(GetOrdValueAt(I)) <> nil then
        Components.Add(TComponent(GetOrdValueAt(I)));
    cxGetComponentProperties(AOwner, FInspector, Components, tkProperties, Proc);
  finally
    Components.Free;
  end;
end;

function TcxClassProperty.GetValue: string;
begin
  FmtStr(Result, '(%s)', [GetPropType^.Name]);
end;

{ TcxComponentProperty }

function TcxComponentProperty.GetAttributes: TcxPropertyAttributes;
begin
  Result := [ipaMultiSelect, ipaValueList, ipaSortList, ipaRevertable];
end;

function TcxComponentProperty.GetEditLimit: Integer;
begin
  Result := 127;
end;

function TcxComponentProperty.GetValue: string;
begin
  if TComponent(GetOrdValue) <> nil then
    Result := GetFullName(TComponent(GetOrdValue))
  else
    Result := '';
end;

procedure TcxComponentProperty.GetValues(Proc: TGetStrProc);

  procedure AddProc(AComponent: TComponent);
  var
    i: Integer;
  begin
    for i := 0 to AComponent.ComponentCount - 1 do
    begin
      if IsValidComponent(AComponent.Components[i]) then
        Proc(GetFullName(AComponent.Components[i]));
      AddProc(AComponent.Components[i]);
    end;
  end;

var
  AOwner: TComponent;
begin
  if FOwner <> nil then
  begin
    AOwner := FOwner;
    while AOwner.Owner <> nil do
      AOwner := AOwner.Owner;
    AddProc(AOwner);
  end
  else
    AddProc(Application);
end;

procedure TcxComponentProperty.SetValue(const Value: string);
var
  Component: TComponent;

  function GetComponentByName(const AName: string): TComponent;

     procedure CheckOwner(AOwner: TComponent);
     var
       I: Integer;
       AComponent: TComponent;
     begin
       if Result <> nil then Exit;
       for I := 0 to AOwner.ComponentCount - 1 do
       begin
         AComponent := AOwner.Components[I];
         if SameText(GetFullName(AComponent), AName) then
         begin
           Result := AComponent;
           break;
         end
         else
           CheckOwner(AComponent);
       end;
     end;

  var
    AOwner: TComponent;
  begin
    Result := nil;
    AOwner := FOwner;
    while AOwner.Owner <> nil do
      AOwner := AOwner.Owner;
    CheckOwner(AOwner);
  end;

begin
  if Value = '' then
    Component := nil
  else
  begin
    Component := GetComponentByName(Value);
    if not (Component is GetTypeData(GetPropType)^.ClassType) then
      raise EcxPropertyError.Create(SInvalidPropertyValue);
  end;
  SetOrdValue(Longint(Component));
end;

function TcxComponentProperty.IsValidComponent(AComponent: TComponent): Boolean;
begin
  Result := (AComponent.Name <> '') and (AComponent is GetTypeData(GetPropType)^.ClassType);
end;

function TcxComponentProperty.GetFullName(AComponent: TComponent): string;
begin
  Result := AComponent.Name;
  while (AComponent.Name <> '') and (AComponent.Owner <> nil) do
  begin
    AComponent := AComponent.Owner;
    if AComponent.Name <> '' then
      Result := AComponent.Name + '.' + Result;
  end;
end;

{ TcxFontNameProperty }

function TcxFontNameProperty.GetAttributes: TcxPropertyAttributes;
begin
  Result := [ipaMultiSelect, ipaValueList, ipaSortList, ipaRevertable];
end;

procedure TcxFontNameProperty.GetValues(Proc: TGetStrProc);
var
  I: Integer;
begin
  for I := 0 to Screen.Fonts.Count - 1 do
    Proc(Screen.Fonts[I]);
end;

{ TcxFontCharsetProperty }

function TcxFontCharsetProperty.GetAttributes: TcxPropertyAttributes;
begin
  Result := [ipaMultiSelect, ipaSortList, ipaValueList];
end;

function TcxFontCharsetProperty.GetValue: string;
begin
  if not CharsetToIdent(TFontCharset(GetOrdValue), Result) then
    FmtStr(Result, '%d', [GetOrdV