Komponente speichert Font-Property nicht mehr

[RBiniasch]

Hallo,

ich habe von TPanel abgeleitete Komponente gebaut, welche auf eine Änderung des Fonts reagieren muss (der wer weiß wievielte erweiterte Button 8) ).
Dafür habe ich im Konstruktor den Eintrag

Font.OnChange := OnFontChanged;

stehen. In 'OnFontChanged' passieren dann die spannenden Dinge.

Das Problem ist nun, wenn diese Zeile im Konstruktor steht speichert Delphi (7 und 2009) Änderungen am Font nicht mehr in der dfm-Datei. Zur Entwurfszeit ist alles ok, die Komponente reagiert auf die Änderungen und das Leben ist schön. Starte ich das Programm sind alle Änderungen vergessen. Ebenso beim neu Laden des Projektes oder Kopieren des Buttons.
Kommentiere ich die Zuweisung von 'OnFontChanged' aus funktioniert der Spaß wieder.
Steckt die Zuweisung im 'Loaded' landen Änderungen am Font wieder in der dfm, aber die Komponente reagiert zur Entwurfszeit nicht mehr auf Änderungen.

Falls wer bis hierher gelesen hat und noch einen Blick auf den Konstruktor werfen möchte, hier kommt er :

Delphi-Quellcode:

constructor TMQButton.Create(tcOwner: TComponent);
begin
  inherited;

  Width                := 90;
  Height               := 22;

  InitBMPs;
  
  F_toGraphics         := TtoGraphics.Create;

  F_toBorders          := TtoDrawFrame.Create;

  F_strBtnText         := EmptyStr;
  F_tcColorMain        := SB_DEF_COLOR_STD_MAIN;
  F_tcColorShade       := SB_DEF_COLOR_STD_SHADE;
  F_tcColorFrame       := SB_DEF_COLOR_STD_FRAME;
  F_tcColorActiveMain  := SB_DEF_COLOR_STD_SHADE;
  F_tcColorActiveShade := SB_DEF_COLOR_STD_MAIN;
  F_tcColorHotMain     := SB_DEF_COLOR_HOT_MAIN;
  F_tcColorHotShade    := SB_DEF_COLOR_HOT_SHADE;
  F_iGradientSteps     := 100;
  F_iEllipseHeight     := 0;
  F_iEllipseWidth      := 0;
  F_setBtnStates       := [bsBase];
  F_bDrawBorder        := TRUE;
  F_bActive            := FALSE;
  F_bShowHot           := FALSE;
  F_bStayDown          := FALSE;
  F_bDisableDblClick   := TRUE;

  BevelOuter           := bvNone;
  DoubleBuffered       := TRUE;

  F_tneOnMouseEnter    := nil;
  F_tneOnMouseLeave    := nil;

  Font.OnChange        := OnFontChanged;   // Hier passierts ...

  CreateBMPs;
  ChangeBtnState;
end;

Danke fürs Lesen und falls wer eine Idee hat, immer her damit
Ralf Biniasch

[RBiniasch]

Ha, gefunden 8)

Im Konstruktor von TControl befindet sich die Zeile

FFont.OnChange := FontChanged;

Wer also in einer von TControl abgeleiteten Klasse selbst dem Onchange des Fonts eine Funktion zuweißt ruiniert die Ereignisbehandlung des TControl ...

Ich habe meine Funktion durch folgende Einträge erweitert :

Delphi-Quellcode:

  ParentFont      := FALSE;
  DesktopFont     := FALSE;

  if Font.Height <> F_iFontHeight then
  begin
    ScalingFlags  := ScalingFlags + [sfFont];
    F_iFontHeight := Font.Height;
  end;
  Perform(CM_FONTCHANGED, 0, 0);

was der Funktion FontChanged entspricht. Allerdings greift das Control dort direkt auf die Feldvariablen FParentFont, FDesktopFont und FScalingflags zu und verwendet die Variable FFontHeight, welche ebenfalls als private deklariert und über keine Property zugänglich ist.
FFontHeight wird nur in dieser Funktion verwendet, daher habe ich es durch F_iFontHeight ersetzt.
Inwiefern das Auslösen der Setter von FParentFont und FDesktopFont ein Problem bergen könnte wird die Zeit zeigen. Wahrscheinlich ist es unkritisch.
FScalingflags hat keinen Setter so das es nur ein wenig Performance kostet, weil ich statt 'Include(FScalingFlags, sfFont)' das obige Konstrukt verwenden muss.

Und wofür das ganze Gemurkse? Nur weil die Entwickler bei Borland es bei der Programmierung des TControls nicht für nötig befunden haben, eine virtuelle Funktion OnChangeFont einzubauen. Sorry, aber das ist echt lausig ...

[Hawkeye219]

Hallo Ralf,

die VCL-Macher haben doch eine Möglichkeit der Erweiterung vorgesehen - du hast sie selbst erwähnt. Alles, was du meiner Meinung nach tun musst, ist eine Behandlung für die Nachricht CM_FONTCHANGED zu implementieren:

Delphi-Quellcode:

type
  TMQButton = class (TButton)
  private
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
  end;

procedure TMQButton.CMFontChanged(var Message: TMessage);
begin
  inherited;

  // hier kann jetzt dein Code folgen...
end;

Gruß Hawkeye