自绘画的属性编辑器

属性编辑器对于大多数 Delphi 程序员来说无疑是很熟悉的，在对象编辑器的内核中有着大量的属性编辑器，每个对象编辑器中的属性都对应一个属性编辑器类的实例。

Delphi5 中提供了一些新的高级特性，使我们能够定义新的属性编辑器，为以有的属性提供新的功能，或者设定和显示新的控件的新的属性的显示方法。在 Delphi5 以前，对象编辑器只能够以文本的形式显示属性值。在 Delphi 5 中给属性编辑器提供了新的特性，使我们能够以任何形式显示属性的名称和值，如下图所示如果属性有一个下拉列表，我们就可以为每一个列表项添加一个图标。下面我们就来研究一下如何实现属性编辑器的自绘画的功能。

属性编辑刷新器

所有的属性编辑器都是从 TpropertyEditor 继承下来的。我们可以为特定的属性类型、属性名或控件注册一个属性编辑器。对象编辑器检查每一个要显示的属性的名称和类型，选择合适的属性编辑器类。然后它会创建这个类的一个实例（每个属性对应一个实例）。当我们选择了另一个控件，对象编辑器会释放全部的属性编辑器对象，然后为新的控件创建新的对象。

属性编辑器可以决定如何显示属性的值以及用户如何设定一个新的属性值。比如， TintegerProperty 调用 IntToStr 函数以字符串的形式显示整数值并用 StrToInt 函数来转换用户输入的新值。 当用户输入了一个新的属性值时， TcolorProperty 同样使用一个整型值来表示，但把整数解释为颜色，并尽可能地映射颜色值为一个名称（如 clBlack 或 clBtnFace) 。

 

一个属性编辑器实现上述功能是通过重载 TpropertyEditor 的一个或多个方法来实现的。绝大多数的属性编辑器需要重载 GetValue 方法， GetValue 方法获得属性值的字符串形式。以及 SetValue 方法， SetValue 方法把一个字符串转化为属性值。要想了解关于编写属性编辑器的进一步信息，需要仔细研究 DsgnIntf.pas 文件（在 Delphi5\Source\Toolsapi 目录下）以及 Delphi 5 在线帮助（在 "property editors, creating" 部分里 ) 。

基础步骤

要实现一个最基本的自绘画属性编辑器，我们只需要重载 TpropertyEdiotr 的 PropDrawValue 方法。比如如前面图中所见到的， TcolorProperty 属性重载了 PropDrawValue 方法在颜色名前显示一个对应于相应颜色的彩色小方块。为了理解如何使用 PropDrawValue 方法，我们为 Tfont 对象写一个新的属性编辑器，新的编辑器将会用当前字体名对应的字体来显示 Tfont 对应的属性。

Delphi 本身已经提供了一个属性编辑器 TfontProperty ，它在对象编辑器中添加了一个省略按钮，用户可以点击按钮调出标准的 Windows 字体选择对话框来设定字体的属性。我们可以直接从 TfontProperty 继承新的编辑器，类的声明如下：

 

type

 TVisualFontProperty = class (TFontProperty)

  public

    procedure PropDrawValue(Canvas: TCanvas;

      const Rect: TRect; Selected: Boolean); override ;

  end ;

当对象编辑器需要显示属性值的时候， IDE 会调用 PropDrawValue 方法来画属性值。 Delphi 传递一个画布对象（ Canvas ）及绘画区域来供程序画属性值。 Selected 参数现在还没用，我们可以忽略它。

注意 ： Delphi 并不会为给定的绘画区域设定剪裁区域，也就是说我们必须严格按照给定的区域绘画，如果超出界限，会把别的属性值给覆盖掉。

TvisualFontProperty 对象的唯一任务就是选择相应于 Font 名字的字体来画属性值。它设定字体的名称，样式以及颜色（当颜色不同于背景色的时候），字体的大小显示保留不动，以免使用非常大或非常小的字体大小画值的时候会出现的问题。下面就是 PropDrawValue 的实现部分：

// 替换乏味的 Tfont 属性值的显示方式，用选定的字体样式

// 和字体来画相应的属性值，用户可能会选择比较大的字体

// 尺寸，所以这里保留字体大小不动，只有当字体颜色不同

// 于背景色的时候，才用相应的颜色画，否则前景背景一样

// 的话就无法看到字体的属性值了

procedure TVisualFontProperty.PropDrawValue(

 Canvas: TCanvas; const Rect: TRect; Selected: Boolean);

var

 Font: TFont;

begin

 Font := TFont(GetOrdValue);

  if Font <> nil then begin

    if ColorToRGB(Font.Color) <> ColorToRGB(clBtnFace) then

     Canvas.Font.Color := Font.Color;

   Canvas.Font.Name := Font.Name;

   Canvas.Font.Style := Font.Style;

  end ;

  inherited ;

end ;

另外我们重载 GetValue 方法来提供更多的信息，比如字体名和大小。  

function TVisualFontProperty.GetValue: string ;

var

 Font: TFont;

begin

 Font := TFont(GetOrdValue);

  if Font = nil then

   Result := inherited GetValue

  else

    Result := Format( '%s, %d' , [Font.Name, Font.Size]);

end ;

我们可以画任何东西到画布上，比如图标和位图的属性编辑器是 TgraphicProperty 。它显示把图标属性显示为一个乏味的字符串 "TIcon" 。 我们可以把图标属性显示为对应的图标，这样的界面更加友好。这里我们继承一个 TvisualGraphicProperty 对象重载 PropDrawValue 来实现这一功能。

Tpicture 属性的情况也是类似的，所以我们用一个公用的过程 DrawGraphic 来实现， DraGraphic 缩放图形对象使之符合对象编辑器可用空间的大小，同时它维持原来的宽高比，缩放图像为最小的可能的尺寸。对于图标来说，由于 Windows 不能缩放图标，所以 DrawGraphic 调用 StretchIcon 过程把图标画到位图上，然后缩放位图。下面是过程代码：  

// Windows 不能缩放图标，所以如果图标大小不匹配的话，

// 把它画到一个临时的位图上，然后缩放位图。

procedure StretchIcon(Canvas: TCanvas;

  const Rect: TRect; Icon: TIcon);

var

 Bitmap: TBitmap;

begin

 Bitmap := TBitmap.Create;

  try

   Bitmap.Height := Icon.Height;

   Bitmap.Width  := Icon.Width;

   Bitmap.Canvas.Brush.Color := clBtnFace;

   Bitmap.Canvas.FillRect(Rect);

   Bitmap.Canvas.Draw(0, 0, Icon);

   Canvas.StretchDraw(Rect, Bitmap);

  finally

   Bitmap.Free;

  end ;

end ;

 

procedure DrawGraphic(Canvas: TCanvas; const Rect: TRect;

 Graphic: TGraphic; const Value: string );

var

 R: TRect;

 HeightRatio, WidthRatio: Single;

begin

 Canvas.FillRect(Rect);

  // 缩放图像使其符合给定空间大小，

 // 同时保持图像宽高比不变

 HeightRatio := (Rect.Bottom - Rect.Top) / Graphic.Height;

 WidthRatio  := (Rect.Right - Rect.Left) / Graphic.Width;

 R := Rect;

  if HeightRatio < WidthRatio then

   R.Right := R.Left + Trunc(Graphic.Width * HeightRatio)

  else

   R.Bottom := R.Top + Trunc(Graphic.Height * WidthRatio);

  if (Graphic is TIcon) and

     ((HeightRatio > 1) or (WidthRatio > 1)) then

   StretchIcon(Canvas, R, TIcon(Graphic))

  else

Canvas.StretchDraw(R, Graphic);

  // 在图像的右边，让继承的编辑器画缺省的文本，比如" Ticon "

 R.Left := R.Right;

 R.Right := Rect.Right;

 R.Top := Rect.Top;

 R.Bottom := Rect.Bottom;

 Canvas.TextRect(R, R.Left+1, R.Top+1, Value);

end ;

我们在 DrawGraphic 过程中写了主要的代码，所以 PropDrawValue 就显得简单多了，主要的作用是确保属性有一个有效的图形对象，如果没有就调用继承的方法来处理。代码如下：

 

procedure TVisualGraphicProperty.PropDrawValue(

 Canvas: TCanvas; const Rect: TRect; Selected: Boolean);

var

 Graphic: TGraphic;

begin

 Graphic := TGraphic(GetOrdValue);

  if (Graphic = nil ) or Graphic.Empty or

     (Graphic.Height = 0) or (Graphic.Width = 0) then

    inherited

  else

   DrawGraphic(Canvas, Rect, Graphic, GetVisualValue);

end ;

自绘画的名字

我们可以重载 PropDrawName 方法，它同 PropDrawValue 方法工作方式类似，只不过一个是画值，一个是画名称。大多数属性的名字不需要任何特殊的处理，对于 BoldFace 属性的名字来说，把名字加粗可以便于用户了解 BoldFace 属性的情况。下面的代码显示了 TboldComponentNameProperty 类的如何实现 PropDrawName 方法的。  

type

 TBoldComponentNameProperty =

    class (TComponentNameProperty)

  public

    procedure PropDrawName(Canvas: TCanvas;

      const Rect: TRect; Selected: Boolean); override ;

  end ;

 

procedure TBoldComponentNameProperty.PropDrawName(

  Canvas: TCanvas; const Rect: TRect; Selected: Boolean);

var

 Style: TFontStyles;

begin

 Style := Canvas.Font.Style;

 Canvas.Font.Style := Canvas.Font.Style + [fsBold];

  try

    inherited ;

  finally

    // 恢复字体的样式以便 Delphi 正确的画属性值

   Canvas.Font.Style := Style;

  end ;

end ;

下拉列表

一个属性编辑器可能会拥有一个下拉列表框，用户可以通过选择列表项来改变属性值。 Delphi 5 使用了自绘画的特性来改进 Tcolor 和 Tcursor 属性的界面友好性，我们也可以作同样的事情，通过重载 ListDrawValue ， ListMeasureHeight 和 ListMeasureWidth 方法可以很容易的做到。下面是这几个方法的声明：

procedure ListDrawValue( const Value: string ;

 Canvas: TCanvas; const Rect: TRect; Selected: Boolean);

procedure ListMeasureHeight( const Value: string ;

 Canvas: TCanvas; var Height: Integer);

procedure ListMeasureWidth( const Value: string ;

 Canvas: TCanvas; var Width: Integer);

ListDrawValue 方法类似于 PropDrawValue 方法，但它的 Selected 是有意义的，表示用户已经选择了这个列表项。 Delphi 会根据 Selected 参数自动设定画布的颜色为合适的值，所以通常情况下我们可以忽略这个参数。 Value 参数是要显示的字符串， Delphi 调用 GetValue 方法来获得这些字符串，

在对象编辑器显示列表框之前，它会调用 ListMeasureHeight 和 ListMeasureWidth 方法来获得每个列表项的尺寸，我们可以设定 Height 和 Width 参数来获得想要得到的高度和宽度。下拉列表框使用全部列表项中最大的尺寸，然后显示相同区域大小的列表项。

当用户滚动列表框时， Delphi 调用 ListDrawValue 方法来画心新的可见的列表项。用户可能会前后滚动多次，如果列表项很多，每次重绘需要很多时间的话，我们应该建立一个临时的位图，把列表项先画到位图上，然后在 ListDrawValue 方法中快速显示位图。这实际上就是双缓冲技术。

下面的例子是一个扩展的集合类型属性，下拉列表显示全部的集合元素，并在每个集合元素旁边添加一个复选框。复选框是通过位图来模仿的，属性编辑器先取得复选框位图，并在不同情况下显示打叉和未打叉的位图。全局变量 Checked 和 Unchecked 保存这两个位图 为 Tbitmap 类型。下面的代码显示了 TSetPropertyEx. 类是如何实现自绘画集合类型的：

// 在下拉列表框的每一个列表项旁边画一个复选框

procedure TSetPropertyEx.ListDrawValue( const Value: string ;

 Canvas: TCanvas; const Rect: TRect; Selected: Boolean);

var

 IsChecked: Boolean;

 OrdValue: Integer;

begin

 OrdValue := GetOrdValue;

 IsChecked := GetEnumValue(EnumInfo, Value) in

               TIntegerSet(OrdValue);

 Canvas.FillRect(Rect);

 Canvas.TextRect(Rect, Rect.Left + Checked.Width + 2,

                 Rect.Top + 1, Value);

  if IsChecked then

   Canvas.Draw(Rect.Left + 1, Rect.Top + 1, Checked)

  else

   Canvas.Draw(Rect.Left + 1, Rect.Top + 1, Unchecked);

end ;

 

procedure TSetPropertyEx.ListMeasureHeight(

  const Value: string ; Canvas: TCanvas;

  var Height: Integer);

begin

  if Height < Checked.Height then

   Height := Checked.Height;

end ;

 

procedure TSetPropertyEx.ListMeasureWidth(

  const Value: string ; Canvas: TCanvas;

  var Width: Integer);

begin

 Width := Width + Checked.Width + 2;

end ;

类似于显示集合元素，对于布耳类型的属性我们也可以加一个复选框。下面我们要实现 TBooleanPropertyEx 属性编辑器对布耳类型进行了扩展，对于不同的布耳类型，比如 ByteBool, WordBool 和 LongBool 属性的实现方式是类似的，当时需要不同的属性编辑器。下面就是 TbooleanPropertyEx 的实现代码，对于复选框如何相应消息，有点小问题，因为通常我们是希望单击实现复选框切换状态， Delphi 不支持单击，我们只好使用双击了（估计在 Delphi 6 中属性编辑器可能会支持单击），注意双击会调用属性编辑器的 Edit 方法。对于集合元素或布耳属性，双击可以切换属性值。估计在 Delphi 6 中属性编辑器可能会支持单击。  

// 根据 True 或者 False 来画一个复选框及布耳值的文本标签

procedure DrawBoolCheckBox(Canvas: TCanvas;

  const Rect: TRect; const Value: string );

begin

 Canvas.FillRect(Rect);

 Canvas.TextRect(Rect, Rect.Left + Checked.Width + 2,

                 Rect.Top + 1, Value);

  if Value = BooleanIdents[False] then

   Canvas.Draw(Rect.Left + 1, Rect.Top + 1, UnChecked)

  else

   Canvas.Draw(Rect.Left + 1, Rect.Top + 1, Checked);

end ;

 

{ TSetElementPropertyEx }

// 每个列表项旁边显示一个复选框，用户必须双击

// 而不是单击才能切换复选框状态

procedure TSetElementPropertyEx.PropDrawValue(

 Canvas: TCanvas; const Rect: TRect; Selected: Boolean);

begin

 DrawBoolCheckBox(Canvas, Rect, Value);

end ;

 

{ TBoolPropertyEx }

// 为 ByteBool, WordBool 和 LongBool 类型显示复选框

procedure TBoolPropertyEx.PropDrawValue(Canvas: TCanvas;

  const Rect: TRect; Selected: Boolean);

begin

 DrawBoolCheckBox(Canvas, Rect, Value);

end ;

使用属性编辑器

最后我们需要作的就是注册这些新的属性编辑器，大多数的编辑器比较容易注册，但是新的集合类属性编辑器存在一个问题，每一个集合都是一个独立的类型，我们必须分别为每个集合类型注册一遍属性编辑器。幸运的是， Delphi 有一个不为人知的特性就是允许为所有的集合类型注册同一个属性编辑器。同通常的为单独一个类型注册属性编辑器不同的是，我们可以通过提供一个属性映射函数来实现注册，这个函数把对象和属性信息作为参数，然后返回属性编辑器类或是 nil 。这种情况下，映射函数校验属性类型，并为所有属性类型是 tkSet 的属性返回新的集合属性编辑器。下面是注册过程的代码：  

// 为全部的集合属性注册一个统一的属性编辑器

function SetMapper(Obj: TPersistent; PropInfo: PPropInfo):

 TPropertyEditorClass;

begin

  if PropInfo.PropType^.Kind = tkSet then

   Result := TSetPropertyEx

  else

   Result := nil ;

end ;

 

procedure Register ;

begin

 RegisterPropertyEditor(TypeInfo(TFont), nil , '' ,

   TVisualFontProperty);

 RegisterPropertyEditor(TypeInfo(TGraphic), nil , '' ,

   TVisualGraphicProperty);

 RegisterPropertyEditor(TypeInfo(TComponentName),

   TComponent, 'Name' , TBoldComponentNameProperty);

 RegisterPropertyEditor(TypeInfo(Boolean), nil , '' ,

   TBooleanPropertyEx);

 RegisterPropertyEditor(TypeInfo(ByteBool), nil , '' ,

   TBoolPropertyEx);

 RegisterPropertyEditor(TypeInfo(WordBool), nil , '' ,

   TBoolPropertyEx);

 RegisterPropertyEditor(TypeInfo(LongBool), nil , '' ,

   TBoolPropertyEx);

 RegisterPropertyMapper(SetMapper);

end ;

写完注册代码后，我们要作的只是把新的属性编辑器添加到包中，然后在 Delphi 中安装。关闭所有的窗体，确保原来的属性编辑器全部被释放。新建一个窗体，我们就可以看到如下图所示的属性编辑器了，看起来还是很漂亮的

 

其它新的属性编辑器特性

这里我们主要讲了自绘画的属性编辑器，但 Delphi 5 还提供了许多其它的新特性，感兴趣的朋友可以自己进行一下研究。  

比如新增的 GetVisualValue 方法类似于 GetValue 方法，但它可以用来返回一个比简单转换的字符串更有意义的描述字符串（但不能用来编辑）。有的时候，我们可能想用更有意义的字符串，而不是简单的转换来表示属性值，这时我们通过重载 GetVisualValue 方法来返回一个用于显示的字符串，用 GetValue 方法来返回一个用于编辑的字符串。

还有一个新的标志 paFullWidthName 置位的话，对象编辑器会完全显示属性名，而不会给属性值留出空间。第一眼的印象是这好象是一个很奇怪的特性，但很多控件都有类似于 About 的属性（尤其是商业控件），这些属性（是 PaDialog 类型的）只是在左边显示一个带省略号的按钮。 点击属性编辑器只是显示一个关于的对话框，它没有什么特别有意义的值，这时 paFullWidthName 标志就有用了，重载 PropDrawName 方法我们可以把自己公司的 Logo, 显示在属性名的旁边。  

最后，我想要发发牢骚， Borland 的这些新的特性从来就没有很好的文档（这点上 borland 比微软可是差了好几个数量级），所以要想研究的话，只能是多看看 Delphi 带的源代码了：（，不过不管怎么说，使用这些新的特性我们可以作出非常 Cool 的编辑界面来，这才是我们最关心的。