delphi VCL组件同名继承
当我们在扩展一个 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.
以下为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.
效果图