用Delphi完成自定义颜色对话框及其构件

在 开 发 证 券 分 析 软 件 中， 经 常 要 绘 制 各 种 股 票 的 分 析 曲 线。 为 了 使 得 软
件 的 功 能 更 加 方 便. 灵 活， 用 户 希 望 能 够 按 照 自 己 的 喜 好 自 定 义 各 种 曲 线 的
颜 色。 在 Ｗ Ｏ Ｒ Ｄ97 的[ 格 式] 菜 单 下 的 字 体 对 话 框 中 有 类 似 的 功 能。 当 用 户
单 击 字 体 对 话 框 中 的 颜 色 下 拉 框 时， 各 种 颜 色 的 简 单 图 案 和 字 体 的 颜 色 名
称 一 起 显 示 出 来， 这 样 处 理 的 结 果 显 然 比 只 提 供 一 个 装 有 颜 色 名 称 的 下 拉
框 效 果 要 好 的 多。

---- 一、 自 定 义 颜 色 对 话 框 的 实 现

---- 在Delphi 中， 我 们 可 以 使 用TComboBox 实 现 类 似 的 功 能。 在TcomboBox 构 件 中 有 一
个Style 属 性, 决 定TcomboBox 的 显 示 属 性。 通 常 可 选 取csDropDown, csSimple, csDropDownList,
csOwnerDrawFixed, csOwnerDrawVariable 等。 其 中 当 选 取csOwnerDrawFixed 时 表 示 创 建 一 个 自
画 下 拉 框， 下 拉 框 的 每 一 项 的 高 度 由ItemHeight 属 性 决 定。 并 且 必 须 在TcomboBox
的OnDrawItem 事 件 中 响 应 自 画 过 程。 OnDrawItem 的 定 义 为:

property OnDrawItem: TDrawItemEvent;
TDrawItemEvent = procedure
(Control: TWinControl; Index: Integer Rect:
TRect; State: TOwnerDrawState) of object;
其 中 的 三 个 参 数 的 含 义 为：
Control: 　 包 含 下 拉 框 的TComboBox
Index: 自 画 的 下 拉 框 在
TComboBox 的Items 属 性 中 的 索 引 号
Rect: 自 画 的 位 置
---- 因 此， 知 道 了 需 要 自 画 的 矩 形 的 位 置（Rect 参 数） 和 在TComboBox 中 的 索 引 号
（Index 参 数）， 我 们 可 以 使 用TcomboBox 的Canvas 属 性 在 其 画 布 上 自 画。

---- 具 体 的 实 现 过 程 如 下：

---- 1 ． 新 建 一 个 工 程 文 件， 设 置 其 默 认 窗 体 的 有 关 属 性 为：

---- Caption 自 定 义 下 拉 框

---- Name Form1

---- Position poScreenCenter

---- 2 ． 在 窗 体 中 放 置 两 个TcomboBox 构 件， 设 置 其 属 性 如 下：

---- Name Style ItemHeight OnDrawItem

---- ColorCombo1 csOwnerDrawFixed 20 ColorComboDrawItem

---- ColorCombo2 csOwnerDrawFixed 30 ColorComboDrawItem

---- 3 ． 双 击ColorCombo1 和ColorCombo2 的Items 属 性 旁 的 圆 点 按 纽， 在"String List Editor" 对 话 框
中 输 入

---- 黑 色

---- 蓝 色

---- 蓝 绿

---- 鲜 绿

---- 红 色

---- 黄 色

---- 等 各 种 颜 色 的 名 称

---- 4 ． 在ColorCombo1 的OnDrawItem 事 件 中 加 入 如 下 代 码

procedure TForm1.ColorComboDrawItem
(Control: TWinControl; Index: Integer;
Rect: TRect; State: OwnerDrawState);
var
TempColor :TColor; // 自 画 颜 色
TempBrushColor :TColor; // 临 时 颜 色
begin
with (Control as TComboBox) do
// 在Combo 的Canvas 上 自 画
begin
TempBrushColor:=Canvas.Brush.Color;
// 保 存 原 来 的 的 颜 色
Canvas.FillRect(Rect);
case Index of // 根 据Index 的 不 同，
定 义 不 同 自 画 的 颜 色
0: // 黑 色
TempColor:=clBlack;
1: // 蓝 色
TempColor:=clBlue;
2: // 蓝 绿
TempColor:=clAqua;
3: // 鲜 绿
TempColor:=clLime;
4： // 红 色
TempColor:=clRed;
5: // 黄 色
　 　 　 　 　 　 　 　 　 　 　 　 　 　TempColor:=clyellow;
// 可 以 在 此 加 入 对 其 它 颜 色 的 响 应
end;

Canvas.Brush.Color:=TempColor;
// 自 画 颜 色 矩 形
Canvas.Rectangle(Rect.Left+4,
Rect.Top+1,
(Rect.Right+Rect.Left) div 3,
Rect.Bottom-1);
Canvas.Brush.Color:=TempBrushColor;
// 显 示 与 颜 色 对 应 的 字 符 串
Canvas.TextOut((Rect.Left+Rect.Right) div 2,
Rect.Top+1,
Items[Index]);
end;
end;
---- 5 ． 保 存， 运 行 文 件， 我 们 可 以 看 到 和 Ｗ Ｏ Ｒ Ｄ 中 颜 色 下 拉 框 相 同 的 效 果
---- 有 兴 趣 的 读 者， 可 以 在 文 中 所 示 的 位 置 加 入 对 其 它 颜 色 处 理。

---- 以 上 程 序 在Delphi 3.0，4.0 上 通 过。

---- 二、 自 定 义 颜 色 对 话 框 构 件 的 编 写

---- 对 许 多Delphi 程 序 员 来 说， 如 何 编 写 自 己 的Delphi 构 件 还 是 比 较 陌 生 的， Delphi
构 件 实 际 上 是 从Tcomponent 类 继 承 发 展 而 来， 编 写 构 件 实 际 就 是 编 写 特 殊 的
类。 下 面 我 们 就 以 自 定 义 颜 色 对 话 框 为 例 介 绍 构 件 的 编 写。

---- 下 面TColorComboBox 是 从TcomboBox 类 继 承 来 的， 当 点 击 右 边 的 下 拉 箭 头 时 弹 出
和 下 拉items 对 应 的 各 种 颜 色 自 画 框。

---- 1. 选 中Component 菜 单 项 中 的New Component 选 项。 在Ancestor Type 框 中 选TcomboBox, 在Class
Name 框 中 填 入TColorComboBox, 在Palette Page 框 中 选Samples, 在Unit File Name 框 中 填 入
ColorComboBox.pas, 然 后 点 击OK 按 钮。

---- 2. 选 中Component 菜 单 项 中 的Install Component 选 项, 点 击Into new package, 在package name 框 中 写
入 路 径 和ColorComboDpk.dpk， 点 击ok, 生 成ColorComboDpk.bpl 文 件。

---- 3. 使 用Tools 菜 单 中 的Image Editor 来 创 建 编 辑 文 件ColorComBox.dcr, 为TColorComboBox 类 建
立 位 图。

---- 4. 在Create 中 加 入 对 字 体 大 小 高 度 的 规 定 及 对 控 件 的Style 属 性( 设 成
csOwnerDrawFixed) 的 规 定， 在Create 后 执 行 的CreateWnd 中 初 始 化 颜 色 的items, 如 果 不 需 要
那 么 多 颜 色 项， 可 以 以 后 在 生 成 控 件 的items 属 性 中 直 接 删 除 不 需 要 的 颜 色。

---- 5. 在DrawItem 事 件 中 加 入 颜 色 自 画 程 序， 此 事 件 在On DrawItem 之 前 发 生。

---- 实 现 程 序 如 下：

unit ColorComboBox;
interface
uses
Windows, Messages, SysUtils, Classes,
Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TColorComboBox = class(TComboBox)
private
{ Private declarations }
FOnDrawItem : TDrawItemEvent;
procedure DrawItem(Index: Integer; Rect: TRect;
State: TOwnerDrawState);override;
protected
{ Protected declarations }
public
{ Public declarations }
constructor Create(AOwner : TComponent);override;
procedure CreateWnd;override;
published
{ Published declarations }
property OnDrawItem : TDrawItemEvent
Read FOnDrawItem write FOnDrawItem;
end;
procedure Register;

implementation

procedure Register; // 注 册 构 件
begin
RegisterComponents('Samples', [TColorComboBox]);
end;

constructor TColorComboBox.Create
(AOwner : TComponent); // 构 件 的 初 始 化
begin
inherited Create(AOwner);
Style := csOwnerDrawFixed; // 构 件 的 初 始 类 型
ItemHeight := 20;
Font.Size := 10;
end;

procedure TColorComboBox.CreateWnd;
// 颜 色 构 件 的Items 属 性 初 始 化
begin
inherited CreateWnd;
Items.Clear;
Items.Add(' 黑 色');
Items.Add(' 蓝 色');
Items.Add(' 蓝 绿');
Items.Add(' 鲜 绿');
Items.Add(' 粉 红');
Items.Add(' 红 色');
Items.Add(' 黄 色');
Items.Add(' 白 色');
Items.Add(' 深 蓝');
Items.Add(' 青 色');
Items.Add(' 绿 色');
Items.Add(' 紫 色');
Items.Add(' 深 红');
Items.Add(' 深 黄');
Items.Add(' 深 灰');
Items.Add(' 银 色');
---- // 若 不 需 要 这 么 多 颜 色 可 在 构 件 的items 属 性 中 删 除 不 需 要 的 颜 色

---- end;

---- // 重 载DrawItem 过 程

procedure TColorComboBox.DrawItem
(Index: Integer; Rect: TRect;
State: TOwnerDrawState);
var
TempColor :TColor; // 自 画 颜 色
TempBrushColor :TColor; // 临 时 颜 色
begin // 本 构 件 的 默 认 自 画 设 置
TempBrushColor:=Canvas.Brush.Color;
// 保 存 原 来 的 的 颜 色
Canvas.FillRect(Rect);

if Items[index]=' 黑 色' then
TempColor := clBlack
else if Items[index]=' 蓝 色' then
TempColor := clBlue
else if Items[index]=' 蓝 绿' then
TempColor := clAqua
else if Items[index]=' 鲜 绿' then
TempColor := clLime
else if Items[index]=' 粉 红' then
TempColor := clFuchsia
else if Items[index]=' 红 色' then
TempColor := clRed
else if Items[index]=' 黄 色' then
TempColor := clYellow
else if Items[index]=' 白 色' then
TempColor := clWhite
else if Items[index]=' 深 蓝' then
TempColor := clNavy
else if Items[index]=' 青 色' then
TempColor := clTeal
else if Items[index]=' 绿 色' then
TempColor := clGreen
else if Items[index]=' 紫 色' then
TempColor := clPurple
else if Items[index]=' 深 红' then
TempColor := clMaroon
else if Items[index]=' 深 黄' then
TempColor := clOlive
else if Items[index]= ' 深 灰' then
TempColor := clGray
else if Items[index]=' 银 色' then
else TempColor := clSilver;

Canvas.Brush.Color:=TempColor;
// 自 画 颜 色 矩 形
Canvas.Rectangle(Rect.Left+4,
Rect.Top+1,
(Rect.Right+Rect.Left) div 3,
Rect.Bottom-1);
Canvas.Brush.Color:=TempBrushColor;
// 显 示 与 颜 色 对 应 的 字 符 串
Canvas.TextOut((Rect.Left+Rect.Right) div 2,
Rect.Top+1,
Items[Index]);
end;
end.
---- 此 控 件 可 以 在 所 有 需 要 颜 色 选 项 的 程 序 中 使 用 而 且 非 常 方 便 和 美 观， 并
且 使 编 程 节 省 很 多 时 间， 增 加 了 程 序 可 靠 性 和 可 读 性。

---- 三、 自 定 义 颜 色 对 话 框 构 件 的 使 用

---- 当 注 册 完 自 定 义 颜 色 构 件 后， 可 以 从Delphi 构 件 模 板 的Sample 页 中 选 择 自 定 义
颜 色 构 件, 和 使 用Delphi 本 身 构 件 没 有 区 别。

……