Delphi 7 - 更改字体 sub-property 不是更新组件

Question

我在设计时遇到了我制作的 StringGrid 的问题。当更改名为 "Header" 的属性时，Invalidate 方法工作正常并且网格在 design-time 中重新绘制。但是，当添加 sub-property Font 时，在 desig-time 中更改 Header 的字体时网格不会更新。如果我在更改字体后单击网格或展开单元格，则会更新它。

这是我的代码：

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.

英语不是我的语言，很抱歉打字错误。感谢您的帮助。

Answer 1

当您为 Font 的子属性赋值时，网格不会更新，因为您没有分配 TFont.OnChange 事件处理程序来使网格在 [= =12=] 变化。

设置 Font 的各个子属性时，不会调用您的 SetFont() setter 方法。仅当设置 Font 属性本身时。 OnChange 事件是针对 Font 的个别更改而触发的，因此您需要一个事件处理程序。

您的代码中还有其他几个错误：

当您只需要 1 个构造函数时，您正在为 THeader 定义 2 个构造函数。
你没有实施THeader.Assign()复制任何东西。
您没有为 TStringGridEx.Header 属性定义 setter 方法。您正在获取调用者的输入 THeader 对象的所有权，而不是从中复制属性值，并泄漏您持有指针指向的前一个 THeader 对象。
您正在 AfterConstruction() 中处理您的 TStringGridEx 初始化，而不是在它所属的构造函数中。

试试这个：

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.

也就是说，您可以从 THeader 中删除 FColCount 和 FHeight 成员，因为无论如何它们都被委托给了 TStringGridEx，所以只需让 TStringGridEx 替你打理，不需要重复工作：

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.

Delphi 7 - 更改字体 sub-property 不是更新组件

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

properties

delphi-7

tstringgrid

object-inspector