type
TVisualFontProperty = class(TFontProperty)
public
procedure PropDrawValue(Canvas: TCanvas;
const Rect: TRect; Selected: Boolean); override;
end;

// 替换乏味的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;

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;

// 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;

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;