delphi VCL组件同名继承

Posted 2021-01-12 lackey

当我们在扩展一个 vcl 组件功能的时候，既想保留IDE中能拖动大小与直接设置属性的功能，又想减少写创建与释放代码和安装扩展后新组件的麻烦，那么本文中的方法，就非常实用了。

以给TStringGrid的单元格加上颜色功能为例，先看如何调用:

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Grids, uColorGrid;

type

  TStringGrid = class(uColorGrid.TStringGrid); // 此句必备！

  TForm1 = class(TForm)
    StringGrid1: TStringGrid;
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
{ TStringGrid }

procedure TForm1.Button1Click(Sender: TObject);
var
  c: TCellColor;
begin

  // 设置颜色要在改变表格的行列数之后

  c.TextColor := clblue;
  c.BackGroundColor := clyellow;

  StringGrid1.cells[2, 1] := ‘blue‘;
  StringGrid1.CellsColor[2, 1] := c;

  c.TextColor := clred;
  c.BackGroundColor := clgreen;
  StringGrid1.cells[3, 1] := ‘red‘;
  StringGrid1.CellsColor[3, 1] := c;

  c.TextColor := clgray;
  c.BackGroundColor := clnavy;

  StringGrid1.cells[4, 1] := ‘yellow‘;
  StringGrid1.CellsColor[4, 1] := c;

end;

procedure TForm1.Button2Click(Sender: TObject);
var
  c: TCellColor;
begin

  c.TextColor := clred;
  c.BackGroundColor := clolive;

  StringGrid1.cells[2, 1] := ‘blue‘;
  StringGrid1.CellsColor[2, 1] := c;

  c.TextColor := clblue;

  c.BackGroundColor := clMaroon;
  StringGrid1.cells[3, 1] := ‘red‘;
  StringGrid1.CellsColor[3, 1] := c;

  c.TextColor := clgray;
  c.BackGroundColor := clLime;
  StringGrid1.cells[4, 1] := ‘yellow‘;
  StringGrid1.CellsColor[4, 1] := c;

end;

end.

unit1.pas

以下为TStringGrid扩展功能的代码

unit uColorGrid;

interface

uses
  Winapi.Windows, System.SysUtils, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Grids;

type

  TCellColor = record
    TextColor: TColor; // 格子文字的颜色
    BackGroundColor: TColor; // 格子背景的颜色
    ColorChanged: boolean;
  end;

  TCellColorArr = array of array of TCellColor;

  TStringGrid = class(Vcl.Grids.TStringGrid)
  private
    FCellColorArr: TCellColorArr; // 记录单元格颜色
    function GetCellsColor(ACol, ARow: integer): TCellColor;
    procedure SetCellsColor(ACol, ARow: integer; const Value: TCellColor);
    procedure InitCellsColor(ACol, ARow: integer);
  protected
    procedure SizeChanged(OldColCount, OldRowCount: Longint); override; // 在此过程中调整颜色记录数组的大小
    procedure DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState); override;
  public
    constructor Create(AOwner: TComponent); override;
    property CellsColor[ACol, ARow: integer]: TCellColor read GetCellsColor write SetCellsColor;
  end;

implementation

constructor TStringGrid.Create(AOwner: TComponent);
begin
  inherited;
  InitCellsColor(ColCount, RowCount);
end;

procedure TStringGrid.DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState);
var
  CC: TCellColor;
  oldBrush: Tbrush;
  oldPen: tpen;
  oldFont: tfont;
begin
  CC := FCellColorArr[ARow, ACol];
  if CC.ColorChanged then
  begin
    oldBrush := self.Canvas.Brush;
    oldPen := self.Canvas.Pen;
    oldFont := self.Canvas.Font;
    Canvas.Font.Color := CC.TextColor; // 文字颜色
    Canvas.Brush.Color := CC.BackGroundColor; // 背景色
    inherited;
    Canvas.Brush := oldBrush;
    Canvas.Pen := oldPen;
    Canvas.Font := oldFont;
  end
  else
    inherited;
end;

function TStringGrid.GetCellsColor(ACol, ARow: integer): TCellColor;
begin
  result := FCellColorArr[ARow, ACol];
end;

procedure TStringGrid.InitCellsColor(ACol, ARow: integer);
var
  i, j: integer;
begin
  setlength(FCellColorArr, ARow);
  for i := 0 to ARow - 1 do
  begin
    setlength(FCellColorArr[i], ACol);
    for j := 0 to ACol - 1 do
    begin
      FCellColorArr[i, j].ColorChanged := false; //初始化
    end;
  end;

end;

procedure TStringGrid.SetCellsColor(ACol, ARow: integer; const Value: TCellColor);
begin
  FCellColorArr[ARow, ACol] := Value;
  FCellColorArr[ARow, ACol].ColorChanged := true;
end;

procedure TStringGrid.SizeChanged(OldColCount, OldRowCount: Longint);
begin
  inherited;
  InitCellsColor(ColCount, RowCount);
end;

end.

uColorGrid.pas

本文示例代码下载

效果图

参考文章：https://www.cnblogs.com/delphi7456/p/5349619.html