Mise à jour des polices récursivement sur un formulaire Delphi

Question

J'essaie d'itérer tous les contrôles d'un formulaire et d'activer le lissage des polices ClearType. Quelque chose comme ceci:

procedure TForm4.UpdateControls(AParent: TWinControl); 
var 
    I: Integer; 
    ACtrl: TControl; 
    tagLOGFONT: TLogFont; 
begin 
    for I := 0 to AParent.ControlCount-1 do 
    begin 
    ACtrl:= AParent.Controls[I]; 

    // if ParentFont=False, update the font here... 

    if ACtrl is TWinControl then 
     UpdateControls(Ctrl as TWinControl); 
    end; 
end; 

Maintenant, est-il un moyen facile de vérifier si ACtrl ont une propriété Font pour que je puisse passer le Font.Handle à somethink comme:

GetObject(ACtrl.Font.Handle, SizeOf(TLogFont), @tagLOGFONT); 
tagLOGFONT.lfQuality := 5; 
ACtrl.Font.Handle := CreateFontIndirect(tagLOGFONT); 

Merci à l'avance.

Answer 1

Vous utilisez l'unité TypInfo, plus particulièrement les méthodes IsPublishedProp et GetOrdProp.

Dans votre cas, ce serait quelque chose comme:

if IsPublishedProp(ACtrl, 'Font') then 
    ModifyFont(TFont(GetOrdProp(ACtrl, 'Font'))) 

Un fragment d'un de mes bibliothèques qui devraient vous mettre sur la bonne voie:

function ContainsNonemptyControl(controlParent: TWinControl; 
    const requiredControlNamePrefix: string; 
    const ignoreControls: string = ''): boolean; 
var 
    child : TControl; 
    iControl: integer; 
    ignored : TStringList; 
    obj  : TObject; 
begin 
    Result := true; 
    if ignoreControls = '' then 
    ignored := nil 
    else begin 
    ignored := TStringList.Create; 
    ignored.Text := ignoreControls; 
    end; 
    try 
    for iControl := 0 to controlParent.ControlCount-1 do begin 
     child := controlParent.Controls[iControl]; 
     if (requiredControlNamePrefix = '') or 
     SameText(requiredControlNamePrefix, Copy(child.Name, 1, 
      Length(requiredControlNamePrefix))) then 
     if (not assigned(ignored)) or (ignored.IndexOf(child.Name) < 0) then 
     if IsPublishedProp(child, 'Text') and (GetStrProp(child, 'Text') <> '') then 
     Exit 
     else if IsPublishedProp(child, 'Lines') then begin 
     obj := TObject(cardinal(GetOrdProp(child, 'Lines'))); 
     if (obj is TStrings) and (Unwrap(TStrings(obj).Text, child) <> '') then 
      Exit; 
     end; 
    end; //for iControl 
    finally FreeAndNil(ignored); end; 
    Result := false; 
end; { ContainsNonemptyControl } 

Answer 2

Il n'y a pas besoin d'utiliser RTTI pour ça. Chaque descendant TControl a une propriété Font. Au niveau TControl sa visibilité est protégée mais vous pouvez utiliser cette solution de contournement pour y accéder:

type 
    THackControl = class(TControl); 

ModifyFont(THackControl(AParent.Controls[I]).Font); 

Answer 3

Une autre chose intéressante à mentionner. Chaque contrôle a une propriété ParentFont, qui - si elle est définie - permet au choix de la police du formulaire de se répercuter sur chaque contrôle. J'ai tendance à m'assurer que ParentFont est défini sur true dans la mesure du possible, ce qui facilite également le traitement des formulaires de thème en fonction du système d'exploitation actuel.

De toute façon, vous ne devriez certainement pas avoir besoin de faire quoi que ce soit pour activer le lissage ClearType? Cela devrait se faire automatiquement si vous utilisez une police TrueType et que l'utilisateur a activé l'effet Cleartype.

Answer 4

Voici un exemple de C++ Builder TOndrej's answer:

struct THackControl : TControl 
{ 
    __fastcall virtual THackControl(Classes::TComponent* AOwner); 
    TFont* Font() { return TControl::Font; }; 
}; 

for(int ControlIdx = 0; ControlIdx < ControlCount; ++ControlIdx) 
{ 
    ((THackControl*)Controls[ControlIdx])->Font()->Color = clRed; 
}