Bei Komponenten einen Untereintrag (Font -> Size) ändern

[litotes]

Hallo,

ich beiß mir grade die Zähne aus am Problem, die Schriftgröße von Buttons (TJvSpeedbuttons) zu ändern.

Eigentlich habe ich den passenden Code (von Marabu (Danke!))
schon gefunden, aber der klappt eben nicht ganz:

Delphi-Quellcode:

procedure SetProperty(c: TComponent; cClass, cName: String; cValue: Variant); 
var 
  i: Integer; 
  ppi: PPropInfo; 
begin 
  if SameText(c.ClassName, cClass) then 
  begin 
    ppi := GetPropInfo(c, cName); 
    if Assigned(ppi) then 
      SetPropValue(c, cName, cValue); 
  end; 
  for i := 0 to Pred(c.ComponentCount) do 
    SetProperty(c.Components[i], cClass, cName, cValue); 
end;

Mit dem Abruf:
SetProperty(Application, 'TJvSpeedbutton', 'Color', clRed); kann ich die Farbe ändern, klappt also super.

Aber eben die 'Size' von 'Font' nicht, da die ja ein Untereintrag ist!

Geht das gar nicht so? Oder wie müsste der Befehl denn aussehen?

SetProperty(Application, 'TButton', 'Font', 10); <- hier müsste ja noch 'size' stehen, also:

SetProperty(Application, 'TButton', 'Font', 'size', 10) o. ä.

Wie kann man das machen?

Für Hilfe bin ich sehr dankbar... nach 2 Tagen ist der Frust doch recht groß!


litotes

[mkinzler]

Du mußt das rekursiv für das Font-Objekt machen.

[Flocke]

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;

[litotes]

Hallo,

erstmal vielen, vielen Dank an Flocke für den fertigen Code!

Leider compiliert er nicht, und zwar folgenden Teil:

Delphi-Quellcode:

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;

Und zwar beschwert er sich über die Zeile:
SetPropValue(Obj, i, Value); Fehlermeldung: Inkompatible Typen: String und PPropInfo.

Da ich den Code leider nicht so gut verstehe, um darin
erfolgreich herumzuwerkeln (bin noch Anfänger), die Fragen:

Was kann ich da tun? Muss ich da einen Typecast machen, und wenn ja, wie?
Kompiliert er bei euch? Bei Flocke?

Vielen Dank,

litotes

[Flocke]

Bei mir compilierts (D2007), die Funktion ist überladen.
Ändere einfach mal folgende Zeile:
SetPropValue(Obj, Prop, Value);

[litotes]

Herzlichen Dank Flocke!

Jetzt kompilierts...
Kannst du mir auch noch den Unterschied erklären?

Litotes

[Flocke]

Zitat von litotes:

Kannst du mir auch noch den Unterschied erklären?

In meiner TypInfo.pas gibt's zwei überladene Varianten von SetPropValue, eine bekommt einen String als zweiten Parameter (den Namen der Eigenschaft) und die andere einen PPropInfo-Zeiger (die internen Informationen über die Eigenschaft).

Die Variante mit dem String-Parameter ruft bei mir eigentlich nur die andere Variante auf und übergibt als Parameter das Ergebnis von GetPropInfo. Da wir das schon haben, ist es natürlich effizienter das direkt zu übergeben, anstatt die Klasse nochmal anhand des Namens suchen zu lassen.

Ich habe gerade noch einmal nachgeschaut: die überladene Funktion mit PPropInfo-Parameter gibt's seit Delphi 2005, bis einschließlich Delphi 7 gab's nur die Variante mit dem String-Parameter.