Aktywacja TFont w komponenecie

Witam.

Tak dodaje nowy parametr do komponentu.

  TdCustomGrid = class(TCustomControl)
  private
   ...
        FFixedFont : TFont; // Fonty dla Fixed
    ...
  end;

    property FixedFont: TFont read FFixedFont write SetFixedFont stored IsFixedFontStored;
   .....

    procedure SetFixedFont(const Value: TFont);
    function  IsFixedFontStored: Boolean;
   ......

function TdCustomGrid.IsFixedFontStored: Boolean;
begin
     Result := not ParentFont and not DesktopFont;
end;

procedure TdCustomGrid.SetFixedFont(const Value: TFont);
begin
     FFixedFont.Assign(Value);
     Repaint;
end;

constructor TdCustomGrid.Create(AOwner: TComponent);
begin
    .....
    FFixedFont := TFont.Create;
    .....
end;

Jeżeli w FixedFont zmieniam parametry w Object Inspector to brak reakcji na formatce w trakcie działania programu i poglądu ( edytorze ).
Dopiero jak zmieniam jakiegokolwiek parametr w Font który jest w tym samym komponencie to zmiany
dokonane w FixedFont są widoczne na formatce i w działającym programie.

Co jeszcze muszę dodać by ten problem znikł. XE10

Pozdrawiam
Janusz

procedure TdCustomGrid.SetFixedFont(const Value: TFont);
begin
  FFixedFont.Assign(Value);
  Repaint;
end;

Ten Repaint nie zostaje wywołany, bo z tego co pamiętam, tak działa VCL (LCL w sumie też).

Jeśli pole FFont ma wywoływać jakąś akcję po zmianie swojej zawartości, to możesz podłączyć własne zdarzenie do FFixedFont.OnChange. To powinno w zupełności wystarczyć.

Możesz też nadpisać metodę FFixedFont.Assign, w której sprawdź czy obiekt z parametru posiada inne dane i jeśli tak, odpal jakąś swoją metodę (albo OnChange). Tutaj pole do popisu jest szersze, bo możesz określić to które pole ma inną wartość.

Czyli potrzebujesz takiego zabiegu:

type
  TdCustomGrid = class(TCustomControl)
  private
    FFixedFont: TFont;
  private
    procedure FixedFontChange(ASender: TObject);
  {..}
  public
    constructor Create(AOwner: TComponent); override;
  {..}
  end;
  
  
procedure TdCustomGrid.FixedFontChanged(ASender: TObject);
begin
  Invalidate();
end;

constructor TdCustomGrid.Create(AOwner: TComponent);
begin
  FFixedFont := TFont.Create();
  FFixedFont.OnChange := FixedFontChange;
end;

W metodzie FixedFontChange możesz wykonać różne dodatkowe czynności, nie tylko zmusić kontrolkę do przemalowania.

Poza tym, nigdy nie wołaj Repaint bezpośrednio. Używaj Invalidate, które odmaluje komponent tylko wtedy, gdy jest możliwe. Jeśli z jakiegoś powodu komponent nie może być odmalowany to Invalidate to wyłapie, a Repaint rzuci wyjątek. Jeśli chcesz i masz dostęp do źródeł VCL to sprawdź sobie czym się różni ich kod.

Ciekawe " to Invalidate to wyłapie, a Repaint rzuci wyjątek. ".

Fragment z oryginalnego komponentu.

procedure TdCustomGrid.SetGradientEndColor(Value: TColor);
begin
  if Value <> FGradientEndColor then
  begin
    FGradientEndColor := Value;
    if HandleAllocated then Repaint;
  end;
end;

procedure TdCustomGrid.SetGradientStartColor(Value: TColor);
begin
  if Value <> FGradientStartColor then
  begin
    FGradientStartColor := Value;
    if HandleAllocated then Repaint;
  end;
end;

Ale nie działa.
Przypominam jak zmienię cokolwiek w Font to zaczyna działać wszystko.

Przeoczyłem dalszą część Twojego pierwszego posta… Zignoruj to co napisałem w poprzednim poście. :/

dasej napisał(a):

Ciekawe " to Invalidate to wyłapie, a Repaint rzuci wyjątek. ".

Jak widać, w tym oryginalnym mutatorze sprawdzany jest HandleAllocated, a Ty go w swoim nie sprawdzasz, więc poleciałby wyjątek przy Repaint.

Przypominam jak zmienię cokolwiek w Font to zaczyna działać wszystko.

W takim razie sprawdź co się wykonuje w Font po jego zmianie – coś musi być inicjowane przy pierwszej modyfikacji. Możesz debugować ten komponent?

private
    procedure CMTextChanged(var Msg: TMessage); message CM_TEXTCHANGED;
    procedure CMFontChanged(var Msg: TMessage); message CM_FONTCHANGED;
	
	
procedure TCMButton.CMFontChanged(var Msg: TMessage);
begin
 Invalidate;
end;

procedure TCMButton.CMTextChanged(var Msg: TMessage);
begin
 Invalidate;
end;

Wstawiłem to do class [ TgGrid = class(TdDrawGrid) ] ale nie pomogło.
A w class [ TdCustomGrid = class(TCustomControl) ] już to jest dodane i posiada taki zapis

procedure TdCustomGrid.CMFontChanged(var Message: TMessage);
begin
  if FInplaceEdit <> nil then FInplaceEdit.Font := Font;
  inherited;
end;

@dasej: to dotyczy ustawienia fontu w osadzonej kontrolce, jeśli właściwość tej głównej została zmieniona.

Sprawdziłeś co się wykonuje po zmianie właściwości TdCustomGrid.Font? Tam znajdziesz odpowiedź.

W TdCustomGrid = class(TCustomControl) nie ma TdCustomGrid.Font
Jedyna wzmianka o fontach jest w

  TdDrawGrid = class(TdCustomDrawGrid)
  published
    property Font;

powyżej jest TdCustomDrawGrid = class(TdCustomGrid)

@dasej: TdDrawGrid dziedziczy właściwość Font z klasy bazowej (tu: TdCustomDrawGrid), więc sprawdź co jest wykonywane właśnie w niej. Jeśli TdCustomDrawGrid też ją dziedziczy ze swojej bazowej to idź głębiej, przy okazji sprawdzając, gdzie i w jaki sposób jest ona używana. W ten sposób znajdziesz to czego szukasz.

Spróbuj też ustawić ParentFont na False w konstruktorze TdDrawGrid.

Dzięki za pomoc. Na razie temat mnie przerasta.
Problem załatwiłem trochę po partyzancku.

constructor TgGrid.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Initialize;

  Font.Color := clBlue; // tuu2
  Font.Color := clBlack;

Teraz komponent reaguje na każdą zmianę kolorów tuż po położeniu na formatce.

dasej napisał(a):

Na razie temat mnie przerasta.

Przerasta Cię zmiana wartości właściwości w oknie Inspektora Obiektów?

Nie.

Rozwiązanie problemu.
Brak mi koncepcji co mam z tym zrobić.
Kładę komponent na formie i do momenty kiedy nie zmienię jakiegoś parametru w Font to
pozostałe nie TFont nie reagują na zmianę.

FixedFont nie zadziała jak nie dokonam jakiejś zmiany w Font.

Komponent na dzień dzisiejszy wygląda tak.

Ma wybudowanych kilka stylów koloru. I zaszytą obsługę MySQL oraz import i exsport csv, oraz kilka innych drobiazgów.

@dasej: może inaczej. W jaki sposób komponent wykorzystuje Twoją właściwość FixedFont? Używa jej w OnDrawCell lub czymś podobnym?

procedure TdCustomGrid.DrawCellBackground(const ARect: TRect; AColor: TColor;
                                         AState: TGridDrawState; ACol, ARow: Integer);
const States: array[Boolean, Boolean] of Cardinal = ((HIS_NORMAL, HIS_PRESSED), (HIS_HOT, HIS_PRESSED));
var   LRect, ClipRect: TRect;

begin
  LRect := ARect;

// FIX -oSafrad : Title Color
  if (FInternalDrawingStyle = gdsThemed) and (gdFixed in AState) then
//  if (FInternalDrawingStyle = gdsThemed) and (gdFixed in AState) and (AColor = clBtnFace) then
  begin
    ClipRect := LRect; // Theme styl
    if Win32MajorVersion >= 6 then InflateRect(LRect, 1, 1);
    Inc(LRect.Bottom);
    DrawThemeBackground(ThemeServices.Theme[teHeader], Canvas.Handle,
                     HP_HEADERITEM, States[(gdHotTrack in AState), (gdPressed in AState)],
                                                  LRect, {$IFNDEF CLR}@{$ENDIF}ClipRect);
    Canvas.Brush.Style := bsClear;
  end
  else
  begin  //  kolory i rysowanie Fixed
// FIX -oSafrad : Title Color
    if (FInternalDrawingStyle = gdsGradient) and (gdFixed in AState) then
//    if (FInternalDrawingStyle = gdsGradient) and (gdFixed in AState) and (AColor = clBtnFace) then
    begin
      if not (goFixedVertLine in Options) then Inc(LRect.Right);  // linie pionowe i poziome
      if not (goFixedHorzLine in Options) then Inc(LRect.Bottom);


      // rysowanie gradiandu dla Fixed =======================================
      if (gdHotTrack in AState) or (gdPressed in AState) then
      begin
        if (gdPressed in AState) then
           GradientFillCanvas(Canvas, FGradientEndColor, FGradientStartColor, LRect, gdVertical)
        else
           GradientFillCanvas(Canvas, GetHighlightColor(FGradientStartColor),
                      GetHighlightColor(FGradientEndColor), LRect, gdVertical);
      end
      else GradientFillCanvas(Canvas, FGradientStartColor, FGradientEndColor, LRect, gdVertical);
      Canvas.Font := FFixedFont; //// dołożone fixed.font.color
      Canvas.Brush.Style := bsClear;
    end

Dlaczego font ustalasz w zdarzeniu, które służy malowaniu tła?

Umieściłem to w DrawCells

  procedure DrawCells(ACol, ARow: Longint; StartX, StartY, StopX, StopY: Integer;
                      AColor: TColor; IncludeDrawState: TGridDrawState);
  var
    CurCol, CurRow: Longint;
    AWhere, Where, TempRect: TRect;
    DrawState: TGridDrawState;
    Focused: Boolean;
  begin
    CurRow := ARow;
    Where.Top := StartY;
    while (Where.Top < StopY) and (CurRow < RowCount) do
    begin
      CurCol := ACol;
      Where.Left := StartX;
      Where.Bottom := Where.Top + RowHeights[CurRow];
      while (Where.Left < StopX) and (CurCol < ColCount) do
      begin
        Where.Right := Where.Left + ColWidths[CurCol];
//        if (Where.Right > Where.Left) and RectVisible(Canvas.Handle, Where) then
        if (Where.Right > Where.Left) then
        begin
          DrawState := IncludeDrawState;
          if (CurCol = FHotTrackCell.Coord.X) and (CurRow = FHotTrackCell.Coord.Y) then
          begin
            if (goFixedHotTrack in Options) then Include(DrawState, gdHotTrack);
            if FHotTrackCell.Pressed then Include(DrawState, gdPressed);
          end;
          Focused := IsActiveControl;
          if Focused and (CurRow = Row) and (CurCol = Col)  then
          begin
            SetCaretPos(Where.Left, Where.Top);
            Include(DrawState, gdFocused);
          end;
          if PointInGridRect(CurCol, CurRow, Sel) then
            Include(DrawState, gdSelected);
// FIX -oSafrad : Editable cell border
//          if not (gdFocused in DrawState) or not (goEditing in Options) or
//            not FEditorMode or (csDesigning in ComponentState) then
          begin
            if DefaultDrawing or (csDesigning in ComponentState) then
            begin
              Canvas.Font := Self.Font;
              if (gdSelected in DrawState) and (not (gdFocused in DrawState) or
                                   ([goDrawFocusSelected, goRowSelect] * Options <> [])) then
                DrawCellHighlight(Where, DrawState, CurCol, CurRow)
              else
                DrawCellBackground(Where, AColor, DrawState, CurCol, CurRow);
            end;
            AWhere := Where;

@dasej: a w którym miejscu malowany jest tekst w komórce?

To co pokazujesz (w dodatku obcięte…) dotyczy malowania tła, a nie tekstu.

  procedure DrawCells(ACol, ARow: Longint; StartX, StartY, StopX, StopY: Integer;
                      AColor: TColor; IncludeDrawState: TGridDrawState);
  var
    CurCol, CurRow: Longint;
    AWhere, Where, TempRect: TRect;
    DrawState: TGridDrawState;
    Focused: Boolean;
  begin
    CurRow := ARow;
    Where.Top := StartY;
    while (Where.Top < StopY) and (CurRow < RowCount) do
    begin
      CurCol := ACol;
      Where.Left := StartX;
      Where.Bottom := Where.Top + RowHeights[CurRow];
      while (Where.Left < StopX) and (CurCol < ColCount) do
      begin
        Where.Right := Where.Left + ColWidths[CurCol];
//        if (Where.Right > Where.Left) and RectVisible(Canvas.Handle, Where) then
        if (Where.Right > Where.Left) then
        begin
          DrawState := IncludeDrawState;
          if (CurCol = FHotTrackCell.Coord.X) and (CurRow = FHotTrackCell.Coord.Y) then
          begin
            if (goFixedHotTrack in Options) then Include(DrawState, gdHotTrack);
            if FHotTrackCell.Pressed then Include(DrawState, gdPressed);
          end;
          Focused := IsActiveControl;
          if Focused and (CurRow = Row) and (CurCol = Col)  then
          begin
            SetCaretPos(Where.Left, Where.Top);
            Include(DrawState, gdFocused);
          end;
          if PointInGridRect(CurCol, CurRow, Sel) then
            Include(DrawState, gdSelected);
// FIX -oSafrad : Editable cell border
//          if not (gdFocused in DrawState) or not (goEditing in Options) or
//            not FEditorMode or (csDesigning in ComponentState) then
          begin
            if DefaultDrawing or (csDesigning in ComponentState) then
            begin
              Canvas.Font := Self.Font;
              if (gdSelected in DrawState) and (not (gdFocused in DrawState) or
                                   ([goDrawFocusSelected, goRowSelect] * Options <> [])) then
                DrawCellHighlight(Where, DrawState, CurCol, CurRow)
              else
                DrawCellBackground(Where, AColor, DrawState, CurCol, CurRow);
            end;
            AWhere := Where;
            if (gdPressed in DrawState) then
            begin
              Inc(AWhere.Top);
              Inc(AWhere.Left);
            end;

            DrawCell(CurCol, CurRow, AWhere, DrawState);
            if (FixedType = grDisabled) then
            if DefaultDrawing and (gdFixed in DrawState) and Ctl3D and
                               ((FrameFlags1 or FrameFlags2) <> 0) and
                            (FInternalDrawingStyle = gdsClassic) and not (gdPressed in DrawState) then
              begin
                  TempRect := Where;
                  if (FrameFlags1 and BF_RIGHT) = 0 then Inc(TempRect.Right, DrawInfo.Horz.EffectiveLineWidth)
                    else
                      if (FrameFlags1 and BF_BOTTOM) = 0 then Inc(TempRect.Bottom, DrawInfo.Vert.EffectiveLineWidth);
                  DrawEdge(Canvas.Handle, TempRect, BDR_RAISEDOUTER, FrameFlags1);
                  DrawEdge(Canvas.Handle, TempRect, BDR_RAISEDOUTER, FrameFlags2);
              end;

            if DefaultDrawing and not (csDesigning in ComponentState) and (gdFocused in DrawState) and
                       ([goEditing, goAlwaysShowEditor] * Options <>  [goEditing, goAlwaysShowEditor])
                                 and not (goRowSelect in Options) then
            begin
              TempRect := Where;
              if (FInternalDrawingStyle = gdsThemed) and (Win32MajorVersion >= 6) then
                                               InflateRect(TempRect, -1, -1);
              Canvas.Brush.Style := bsSolid;
              if not UseRightToLeftAlignment then DrawFocusRect(Canvas.Handle, TempRect)
              else
              begin
                AWhere := TempRect;
                AWhere.Left := TempRect.Right;
                AWhere.Right := TempRect.Left;
                DrawFocusRect(Canvas.Handle, AWhere);
              end;
            end;
          end;
        end;
        Where.Left := Where.Right + DrawInfo.Horz.EffectiveLineWidth;
        Inc(CurCol);
      end;
      Where.Top := Where.Bottom + DrawInfo.Vert.EffectiveLineWidth;
      Inc(CurRow);
    end;
  end;

Poniżej fragment procedure TdCustomGrid.Paint;

    DrawCells(0, 0, 0, 0, Horz.FixedBoundary, Vert.FixedBoundary, LFixedColor,[gdFixed]);
    DrawCells(LeftCol, 0, Horz.FixedBoundary - FColOffset, 0, Horz.GridBoundary,
                                              Vert.FixedBoundary, LFixedColor, [gdFixed]);
    DrawCells(0, TopRow, 0, Vert.FixedBoundary, Horz.FixedBoundary,
                                                Vert.GridBoundary, LFixedColor, [gdFixed]);
    DrawCells(LeftCol, TopRow, Horz.FixedBoundary - FColOffset,
                        Vert.FixedBoundary, Horz.GridBoundary, Vert.GridBoundary, FInternalColor, []);

Wcześniej jest rysowana sam ( pusta ) siatka. Po przejściu tych czerech linii na ekranie jest już wszystko narysowane i wypełnione.

Sporo tego kodu, ale nigdzie nie widzę malowania tekstu – to ci heca. Czyli wychodzi na to, że zajmuje się tym metoda DrawCell, której należy najpierw przygotować font. Skoro tak, to poniższe powinno załatwić sprawę:

procedure DrawCells(ACol, ARow: Longint; StartX, StartY, StopX, StopY: Integer;
{..}                AColor: TColor; IncludeDrawState: TGridDrawState);
begin
  if not DefaultDrawing {1} then
    Canvas.Font := FFixedFont;
    
  {..}

[1] Tu określ zestaw warunków, po których spełnieniu ma zostać użyty font z pola FFixedFont. Domyślam się, że po ustawieniu DefaultDrawing na False ma być użyty własny font, więc to co wyżej powinno wystarczyć.

Cały kod jest wyciągnięty ze środowiska, a DefaultDrawing działa tak jak widać na foto