Einzelnen Beitrag anzeigen

Benutzerbild von Flocke
Flocke

Registriert seit: 9. Jun 2005
Ort: Unna
1.172 Beiträge
 
Delphi 10.2 Tokyo Professional
 
#3

Re: Bei Komponenten einen Untereintrag (Font -> Size) änd

  Alt 12. Jul 2007, 20:55
Hier mal eine allgemeine Routine, die du mit voll qualifizierten Eigenschaftsnamen füttern kannst:
Delphi-Quellcode:
uses
  TypInfo;

{ Interne Routine für beide Varianten von SetPropertyByName }
procedure SetNestedProp(Obj: TObject; Prop: string; Value: Variant);
var
  p: Integer;
  i: PPropInfo;
begin
  repeat
    p := Pos('.', Prop);
    if p = 0 then
    begin
      i := GetPropInfo(Obj, Prop);
      if i <> nil then
        SetPropValue(Obj, i, Value);
      Obj := nil;
    end
    else
    begin
      // GetObjectProp liefert nil, falls die
      // Eigenschaft nicht gefunden wird.
      Obj := GetObjectProp(Obj, Copy(Prop, 1, p - 1));
      Delete(Prop, 1, p);
    end;
  until Obj = nil;
end;

{ Variante 1: <ClassName> ist der Klassenname, Vererbung wird nicht
  berücksichtigt. <PropertyName> kann Punkte enthalten, die Eigenschaften
  von Eigenschaften bezeichnen (z.B. Font.Size). <ChildrenOnly> gibt an,
  ob die Eigenschaft frühestens bei Unterkomponenten gesetzt werden soll.
}

procedure SetPropertyByName(Component: TComponent;
  const ClassName, PropertyName: string; Value: Variant); overload;

  procedure SetRecursive(Obj: TComponent);
  var
    k: Integer;
  begin
    if Obj.ClassNameIs(ClassName) then
      SetNestedProp(Obj, PropertyName, Value);
    for k := 0 to Obj.ComponentCount - 1 do
      SetRecursive(Obj.Components[k]);
  end;

begin
  SetRecursive(Component);
end;

{ Variante 2: <BaseClass> ist die Basisklasse, Vererbung wird
  berücksichtigt. Ansonsten wie oben.
}

procedure SetPropertyByName(Component: TComponent; BaseClass: TClass;
  const PropertyName: string; Value: Variant); overload;

  procedure SetRecursive(Obj: TComponent);
  var
    k: Integer;
  begin
    if Obj is BaseClass then
      SetNestedProp(Obj, PropertyName, Value);
    for k := 0 to Obj.ComponentCount - 1 do
      SetRecursive(Obj.Components[k]);
  end;

begin
  SetRecursive(Component);
end;
Beispielhafte Aufrufe:
Delphi-Quellcode:
procedure TForm1.Button1Click(Sender: TObject);
begin
  // Bei allen Buttons die Schriftgröße auf 12 setzen
  SetPropertyByName(Self, 'TButton', 'Font.Size', 12);
  // Bei allen Checkboxen die Schriftart ändern
  SetPropertyByName(Self, 'TCheckBox', 'Font.Name', 'Times New Roman');
  // Bei allen Nachfahren von TCustomEdit (TEdit, TMemo, TRichEdit)
  // die Schriftfarbe ändern
  SetPropertyByName(Self, TCustomEdit, 'Font.Color', clRed);
  // Bei allen Nachfahren von TButtonControl (TButton, TCheckBox, TRadioButton)
  // den Schriftstil auf "kursiv" setzen.
  SetPropertyByName(Self, TButtonControl, 'Font.Style', '[fsItalic]');
  // Bei *ALLEN* Controls die Hintergrundfarbe auf Blau ändern
  SetPropertyByName(Self, TControl, 'Color', clBlue, True);
end;
Volker
Besucht meine Garage
Aktuell: RtfLabel 1.3d, PrintToFile 1.4
  Mit Zitat antworten Zitat