支持自绘画的属性编辑器(2)

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