TechQA.

Delphi 7 - Changing font sub-property is not updating component

462 views Asked by At

I'm having problems in design time with a StringGrid I've made. When a property called "Header" is changed, the Invalidate method works fine and the Grid is repainted in design-time. However, when a sub-property Font is added, the Grid does not update when Header's font is changed in desig-time. If I click on Grid or expand a cell after changing font, then it is updated.

Here is my code:

unit GridsEx;

interface

uses
  Windows, SysUtils, Classes, Controls, Grids, Graphics, Dialogs;

const
  CONST_CELL_PADDING = 4;

type
  TStringGridEx = class;

  THeader = class(TPersistent)
  private
    FGrid: TStringGridEx;
    FColCount: Longint;
    FColor: TColor;
    FFont: TFont;
    FHeight: Integer;

    procedure SetColor(Value: TColor);
    procedure SetColCount(Value: Longint);
    procedure SetHeight(Value: Integer);
    procedure SetFont(Value: TFont);
  protected

  public
    constructor Create; overload;
    constructor Create(const AGrid: TStringGridEx); overload;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
  published
    property ColCount: Longint read FColCount write SetColCount;
    property Color: TColor read FColor write SetColor;
    property Font: TFont read FFont write SetFont;
    property Height: Integer read FHeight write SetHeight;
  end;

  TStringGridEx = class(TStringGrid)
  private
    FHeader: THeader;
  protected
    procedure DrawCell(ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); override;

    property ColCount;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure AfterConstruction; override;
  published
    property Header: THeader read FHeader write FHeader;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Additional', [TStringGridEx]);
end;

{ THeader }

constructor THeader.Create;
begin
  FColor := clBtnFace;
  FColCount := 3;
  FFont := TFont.Create;
  FFont.Name := 'Tahoma';
  FFont.Size := 9;
  FFont.Color := clNavy;
  FHeight := 22;
end;

procedure THeader.Assign(Source: TPersistent);
begin
  inherited;

end;

constructor THeader.Create(const AGrid: TStringGridEx);
begin
  Self.Create;
  FGrid := AGrid;
end;

procedure THeader.SetColCount(Value: Longint);
begin
  if (Value <> FColCount) then
  begin
    if (Value < 1) then Value := 1;

    FColCount := Value;
    FGrid.ColCount := FColCount;
    FGrid.Invalidate;
  end;
end;

procedure THeader.SetColor(Value: TColor);
begin
  if (Value <> FColor) then
  begin
    FColor := Value;
    FGrid.Invalidate;
  end;
end;

procedure THeader.SetHeight(Value: Integer);
begin
  if (Value <> FHeight) then
  begin
    if (Value < 0) then Value := 0;

    FHeight := Value;
    FGrid.RowHeights[0] := FHeight;
    FGrid.Invalidate;
  end;  
end;

destructor THeader.Destroy;
begin
  FreeAndNil(FFont);
  inherited;
end;

procedure THeader.SetFont(Value: TFont);
begin
  FFont.Assign(Value);
  FGrid.Invalidate;
end;

{ TStringGridEx }

procedure TStringGridEx.AfterConstruction;
begin
  inherited;
  FHeader := THeader.Create(Self);
  ColCount := FHeader.ColCount;
  RowHeights[0] := FHeader.Height;
end;

constructor TStringGridEx.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  DefaultDrawing := False;
  DefaultRowHeight := 20;
  //Ctl3D := False;
  FixedCols := 0;
  FixedRows := 1;

  Cells[0, 0] := 'Serial';
  Cells[1, 0] := 'Name';

  Cells[0, 1] := '00001';
  Cells[1, 1] := 'Lorem Ipsum';
end;

destructor TStringGridEx.Destroy;
begin
  FreeAndNil(FHeader);
  inherited;
end;

procedure TStringGridEx.DrawCell(ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
var
  TextRect: TRect;
  TextFormat: Cardinal;
begin
  inherited;

  Canvas.Brush.Style := bsSolid;
  Canvas.Brush.Color := clWindow;

  if (ARow = 0) then
  begin
    Canvas.Brush.Color := FHeader.Color;
    Canvas.Font.Assign(FHeader.Font);
  end;

  Canvas.FillRect(Rect);

  TextFormat := DT_SINGLELINE or DT_VCENTER or DT_LEFT or DT_END_ELLIPSIS;
  TextRect := Rect;
  TextRect.Left := TextRect.Left + (CONST_CELL_PADDING);

  DrawText(Canvas.Handle, PAnsiChar(Cells[ACol, ARow]), Length(Cells[ACol, ARow]), TextRect, TextFormat);
end;

end.

English is not my language, so sorry for typos. Appreciate your help.

properties delphi-7 tstringgrid object-inspector
Original Q&A
1

There are 1 answers

3
Remy Lebeau On BEST ANSWER

The grid doesn't update when you assign values to the Font's sub-properties because you are not assigning a TFont.OnChange event handler to invalidate the grid when any aspect of the Font changes.

Your SetFont() setter method does not get called when setting the Font's individual sub-properties. Only when setting the Font property itself. The OnChange event is fired for individual changes to the Font, so you need an event handler for it.

There are also several other bugs in your code:

  • you are defining 2 constructors for THeader when you only need 1 constructor.

  • you are not implementing THeader.Assign() to copy anything.

  • you are not defining a setter method for the TStringGridEx.Header property. You are taking ownership of the caller's input THeader object instead of copying property values from it, and leaking the previous THeader object that you were holding a pointer to.

  • you are handling your TStringGridEx initialization in AfterConstruction() instead of in the constructor, where it belongs.

Try this:

unit GridsEx;

interface

uses
  Windows, SysUtils, Classes, Controls, Grids, Graphics, Dialogs;

const
  CONST_CELL_PADDING = 4;

type
  TStringGridEx = class;

  THeader = class(TPersistent)
  private
    FGrid: TStringGridEx;
    FColCount: Longint;
    FColor: TColor;
    FFont: TFont;
    FHeight: Integer;
    procedure FontChanged(Sender: TObject);
    procedure SetColor(Value: TColor);
    procedure SetColCount(Value: Longint);
    procedure SetHeight(Value: Integer);
    procedure SetFont(Value: TFont);
  public
    constructor Create(const AGrid: TStringGridEx);
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
  published
    property ColCount: Longint read FColCount write SetColCount;
    property Color: TColor read FColor write SetColor;
    property Font: TFont read FFont write SetFont;
    property Height: Integer read FHeight write SetHeight;
  end;

  TStringGridEx = class(TStringGrid)
  private
    FHeader: THeader;
    procedure SetHeader(AValue: THeader);
  protected
    procedure DrawCell(ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); override;
    property ColCount;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Header: THeader read FHeader write SetHeader;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Additional', [TStringGridEx]);
end;

{ THeader }

procedure THeader.Assign(Source: TPersistent);
var
  H: THeader;
begin
  if Source is THeader then
  begin
    H := THeader(Source);
    ColCount := H.ColCount;
    Color := H.Color;
    Font := H.Font;
    Height := H.Height;
  end else
    inherited;
end;

constructor THeader.Create(const AGrid: TStringGridEx);
begin
  inherited Create;
  FGrid := AGrid;
  FColor := clBtnFace;
  FColCount := 3;
  FFont := TFont.Create;
  FFont.Name := 'Tahoma';
  FFont.Size := 9;
  FFont.Color := clNavy;
  FFont.OnChange := FontChanged;
  FHeight := 22;
end;

destructor THeader.Destroy;
begin
  FFont.Free;
  inherited;
end;

procedure THeader.FontChanged(Sender: TObject);
begin
  FGrid.Invalidate;
end;

procedure THeader.SetColCount(Value: Longint);
begin
  if (Value < 1) then Value := 1;
  if (Value <> FColCount) then
  begin
    FColCount := Value;
    FGrid.ColCount := FColCount;
    FGrid.Invalidate;
  end;
end;

procedure THeader.SetColor(Value: TColor);
begin
  if (Value <> FColor) then
  begin
    FColor := Value;
    FGrid.Invalidate;
  end;
end;

procedure THeader.SetHeight(Value: Integer);
begin
  if (Value < 0) then Value := 0;
  if (Value <> FHeight) then
  begin
    FHeight := Value;
    FGrid.RowHeights[0] := FHeight;
    FGrid.Invalidate;
  end;  
end;

procedure THeader.SetFont(Value: TFont);
begin
  FFont.Assign(Value);
end;

{ TStringGridEx }

constructor TStringGridEx.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  FHeader := THeader.Create(Self);

  DefaultDrawing := False;
  DefaultRowHeight := 20;
  //Ctl3D := False;
  FixedCols := 0;
  FixedRows := 1;

  ColCount := FHeader.ColCount;
  RowHeights[0] := FHeader.Height;

  Cells[0, 0] := 'Serial';
  Cells[1, 0] := 'Name';

  Cells[0, 1] := '00001';
  Cells[1, 1] := 'Lorem Ipsum';
end;

destructor TStringGridEx.Destroy;
begin
  FHeader.Free;
  inherited;
end;

procedure TStringGridEx.DrawCell(ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
var
  TextRect: TRect;
  TextFormat: Cardinal;
  S: string;
begin
  inherited;

  Canvas.Brush.Style := bsSolid;
  Canvas.Brush.Color := clWindow;

  if (ARow = 0) then
  begin
    Canvas.Brush.Color := FHeader.Color;
    Canvas.Font.Assign(FHeader.Font);
  end;

  Canvas.FillRect(Rect);

  TextFormat := DT_SINGLELINE or DT_VCENTER or DT_LEFT or DT_END_ELLIPSIS;
  TextRect := Rect;
  TextRect.Left := TextRect.Left + (CONST_CELL_PADDING);

  S := Cells[ACol, ARow];
  DrawText(Canvas.Handle, PChar(S), Length(S), TextRect, TextFormat);
end;

procedure TStringGridEx.SetHeader(AValue: THeader);
begin
  FHeader.Assign(AValue);
end;

end.

That being said, you can remove the FColCount and FHeight members from THeader since they are delegated to TStringGridEx anyway, so just let TStringGridEx take care of them for you, you don't need to duplicate the work unnecessarily:

unit GridsEx;

interface

uses
  Windows, SysUtils, Classes, Controls, Grids, Graphics, Dialogs;

const
  CONST_CELL_PADDING = 4;

type
  TStringGridEx = class;

  THeader = class(TPersistent)
  private
    FGrid: TStringGridEx;
    FColor: TColor;
    FFont: TFont;
    procedure FontChanged(Sender: TObject);
    function GetColCount: Longint;
    function GetHeight: Integer;
    procedure SetColor(Value: TColor);
    procedure SetColCount(Value: Longint);
    procedure SetHeight(Value: Integer);
    procedure SetFont(Value: TFont);
  public
    constructor Create(const AGrid: TStringGridEx);
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
  published
    property ColCount: Longint read GetColCount write SetColCount;
    property Color: TColor read FColor write SetColor;
    property Font: TFont read FFont write SetFont;
    property Height: Integer read GetHeight write SetHeight;
  end;

  TStringGridEx = class(TStringGrid)
  private
    FHeader: THeader;
    procedure SetHeader(AValue: THeader);
  protected
    procedure DrawCell(ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property ColCount default 3;
    property Header: THeader read FHeader write SetHeader;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Additional', [TStringGridEx]);
end;

{ THeader }

procedure THeader.Assign(Source: TPersistent);
var
  H: THeader;
begin
  if Source is THeader then
  begin
    H := THeader(Source);
    ColCount := H.ColCount;
    Color := H.Color;
    Font := H.Font;
    Height := H.Height;
  end else
    inherited;
end;

constructor THeader.Create(const AGrid: TStringGridEx);
begin
  inherited Create;
  FGrid := AGrid;
  FColor := clBtnFace;
  FFont := TFont.Create;
  FFont.Name := 'Tahoma';
  FFont.Size := 9;
  FFont.Color := clNavy;
  FFont.OnChange := FontChanged;
end;

destructor THeader.Destroy;
begin
  FFont.Free;
  inherited;
end;

procedure THeader.FontChanged(Sender: TObject);
begin
  FGrid.Invalidate;
end;

function THeader.GetColCount: Longint;
begin
  Result := FGrid.ColCount;
end;

function THeader.GetHeight: Integer;
begin
  Result := FGrid.RowHeights[0];
end;

procedure THeader.SetColCount(Value: Longint);
begin
  FGrid.ColCount := Value;
end;

procedure THeader.SetColor(Value: TColor);
begin
  if (Value <> FColor) then
  begin
    FColor := Value;
    FGrid.Invalidate;
  end;
end;

procedure THeader.SetHeight(Value: Integer);
begin
  FGrid.RowHeights[0] := Value;
end;

procedure THeader.SetFont(Value: TFont);
begin
  FFont.Assign(Value);
end;

{ TStringGridEx }

constructor TStringGridEx.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  FHeader := THeader.Create(Self);

  DefaultDrawing := False;
  DefaultRowHeight := 20;
  //Ctl3D := False;
  FixedCols := 0;
  FixedRows := 1;

  ColCount := 3;
  RowHeights[0] := 22;

  Cells[0, 0] := 'Serial';
  Cells[1, 0] := 'Name';

  Cells[0, 1] := '00001';
  Cells[1, 1] := 'Lorem Ipsum';
end;

destructor TStringGridEx.Destroy;
begin
  FHeader.Free;
  inherited;
end;

procedure TStringGridEx.DrawCell(ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
var
  TextRect: TRect;
  TextFormat: Cardinal;
  S: string;
begin
  inherited;

  Canvas.Brush.Style := bsSolid;
  Canvas.Brush.Color := clWindow;

  if (ARow = 0) then
  begin
    Canvas.Brush.Color := FHeader.Color;
    Canvas.Font.Assign(FHeader.Font);
  end;

  Canvas.FillRect(Rect);

  TextFormat := DT_SINGLELINE or DT_VCENTER or DT_LEFT or DT_END_ELLIPSIS;
  TextRect := Rect;
  TextRect.Left := TextRect.Left + (CONST_CELL_PADDING);

  S := Cells[ACol, ARow];
  DrawText(Canvas.Handle, PChar(S), Length(S), TextRect, TextFormat);
end;

procedure TStringGridEx.SetHeader(AValue: THeader);
begin
  FHeader.Assign(AValue);
end;

end.

Related Questions in PROPERTIES

Related Questions in DELPHI-7

Related Questions in TSTRINGGRID

Related Questions in OBJECT-INSPECTOR

Popular Questions

Popular Tags

javascript python java c# php android html jquery c++ css ios sql mysql r reactjs node.js arrays c asp.net json python-3.x ruby-on-rails .net sql-server swift django angular objective-c pandas excel

Trending Questions