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[, ] := 'blue';
StringGrid1.CellsColor[, ] := c; c.TextColor := clred;
c.BackGroundColor := clgreen;
StringGrid1.cells[, ] := 'red';
StringGrid1.CellsColor[, ] := c; c.TextColor := clgray;
c.BackGroundColor := clnavy; StringGrid1.cells[, ] := 'yellow';
StringGrid1.CellsColor[, ] := c; end; procedure TForm1.Button2Click(Sender: TObject);
var
c: TCellColor;
begin c.TextColor := clred;
c.BackGroundColor := clolive; StringGrid1.cells[, ] := 'blue';
StringGrid1.CellsColor[, ] := c; c.TextColor := clblue; c.BackGroundColor := clMaroon;
StringGrid1.cells[, ] := 'red';
StringGrid1.CellsColor[, ] := c; c.TextColor := clgray;
c.BackGroundColor := clLime;
StringGrid1.cells[, ] := 'yellow';
StringGrid1.CellsColor[, ] := 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 := to ARow - do
begin
setlength(FCellColorArr[i], ACol);
for j := to ACol - 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
delphi VCL组件同名继承的更多相关文章
- CSDN论坛 > Delphi > VCL组件开发及应用 DBLookupComboBox用法
(1)DataSource属性 该属性用于连接要编辑数据的主表数据源(2)DataField属性 该属性用于指定要编辑的数据字段名(3)ListSource属性 . 该属性用于 ...
- Delphi的组件读写机制
Delphi的组件读写机制(一) 一.流式对象(Stream)和读写对象(Filer)的介绍在面向对象程序设计中,对象式数据管理占有很重要的地位.在Delphi中,对对象式数据管理的支持方式是其一大特 ...
- Delphi 第三方组件
TMS Component Pack v7.0.0.0 TMS Component Pack 版本为Delphi和C++ Builder提供了超过350个VCL组件,用以创建功能丰富的.现代的和原生W ...
- Delphi xe7组件和控件的安装方法
暂时我所遇到的所有控件安装方法大体与下面两种相同. 若有不同大家提出来,一起想办法解决. .dproj格式的组件安装方法: raise组件 安装详细步骤如下: 一.设置搜索路径1. 将本包中的文件连同 ...
- Blazor入门笔记(2)-分部类组件与组件的继承
1.前言 本文接自Blazor的组件(1)-从0构建一个组件 2.分部类组件 Razor组件你可理解为就是一个类名与文件名相同的类,因此,可以新建一个同名的partial类,将组件中@code里面的代 ...
- Hibernate缓存、组件、继承映射
Hibernate缓存.组件.继承映射 三种状态: 临时状态:不受session管理,没有提交到数据库:没有执行sql之前,new对象的时候: 持久化状态:受session管理,提交到数据库:正在执行 ...
- Z Order of Controls in Delphi VCL
Get and set the Z Order of controls at runtime in Delphi VCL. If you are looking for a FireMonkey so ...
- 与 QWidget 有关的 Qt 可视化组件的继承关系图
与 QWidget 有关的 Qt 可视化组件的继承关系图
- Delphi IdHttp组件+IdHttpServer组件实现文件下载服务
http://blog.csdn.net/xxkku521/article/details/16864759 Delphi IdHttp组件+IdHttpServer组件实现文件下载服务 2013- ...
随机推荐
- python-字符串应用
例1:用python程序将DNA的一条链翻译出来s1=’ATTACGGC‘ rule={'A':'T','T':'A','C':'G','G':'C'} s1='ATTACGGC' s2=[rule[ ...
- HDFS的设计
当数据集的大小超过一台独立的物理计算机的存储能力时,就有必要对它进行分区(partition)并存储到若干台单独的计算机上.管理网络中跨多台计算机存储的文件系统成为分布式文件系统(distribute ...
- JavaScript中有时候需要获取当前的时间戳
JavaScript中有时候需要获取当前的时间戳信息,下面列举了三种获取当前时间戳的方法,第一种方法只精确到秒,后两种方法精确到毫秒. 第一种方法 var timestamp1 = Date.pars ...
- Codeforces Round #280 (Div. 2) A , B , C
A. Vanya and Cubes time limit per test 1 second memory limit per test 256 megabytes input standard i ...
- python 矩阵分成上三角下三角和对角三个矩阵
diagonal Return specified diagonals. diagflat Create a 2-D array with the flattened input as a diago ...
- 电影_Z
1. 西施叨叨叨 西施叨叨叨 2015 第21期 : <<指环王>>系列, <<冰与火之歌>>系列(权力的游戏 将正统史诗奇幻剧搬在电视网上的首部电视剧 ...
- js工厂方法
工厂方法与简单工厂的区别在于工厂方法没有switch条件分支,实例化哪一个子类放到了客户端(可以利用反射),这样整个工厂和产品体系都没有修改的变化,而只是扩展的变化,这就完全符合了开放-封闭原则的精神 ...
- 井眼轨迹的三次样条插值 (vs + QT + coin3d)
井眼轨迹数据的测量值是离散的,根据某些测斜公式,我们可以计算出离散的三维的井眼轨迹坐标,但是真实的井眼轨迹是一条平滑的曲线,这就需要我们对测斜数据进行插值,使井眼轨迹变得平滑,我暂时决定使用三次样条进 ...
- 解决:cmd中运行monkeyrunner monkey_recorder.py报错: Can't open specified script file
看lynnLi的博客monkeyrunner之录制与回放(七),遇到了一个问题,我在cmd中输入monkeyrunner monkey_recorder.py,却报错了: 当时第一个感觉时,先到\sd ...
- cassandra——可以预料的查询,如果你的查询条件有一个是根据索引查询,那其它非索引非主键字段,可以通过加一个ALLOW FILTERING来过滤实现
cassandra的索引查询和排序 转自:http://zhaoyanblog.com/archives/499.html cassandra的索引查询和排序 cassandra的查询虽然很弱,但 ...