帮个忙，从VCL中将TToolBar和TToolButton抽取出来，重新封装成新的组件
本帖最后由 sinco449 于 2012-12-05 11:28:41 编辑 处于美观的考虑，需要对TToolBar进行改写，其实，也只是往TToolBar的GradientDrawButton函数里加了寥寥的8行代码而已：
---------------------------------------------
function TToolBar.GradientDrawButton(Button: TToolButton; State: TCustomDrawState;
var Flags: TTBCustomDrawFlags): Boolean;
const
cInset = 4;
var
FillColor: TColor;
EdgeColor: TColor;
R: TRect;
X: Integer;
Y: Integer;
Str: string;
ImageList: TCustomImageList;
begin
Result := False;
FBitmap.Canvas.Pen.Assign(Canvas.Pen);
FBitmap.Canvas.Brush.Assign(Canvas.Brush);
FBitmap.Canvas.Font.Assign(Canvas.Font);
ImageList := nil;

if gdoGradient in GradientDrawingOptions then
begin
FBitmap.SetSize(Width, Height);
if (FMenuButton <> nil) or (FTempMenu = nil) then // 新增加的代码行
begin // 新增加的代码行
GradientFillCanvas(FBitmap.Canvas, FGradientStartColor, FGradientEndColor,
ClientRect, GradientDirection);
end // 新增加的代码行
else // 新增加的代码行
begin // 新增加的代码行
GradientFillCanvas(FBitmap.Canvas, HotTrackColor, HotTrackColor, ClientRect, GradientDirection); // 新增加的代码行
end; // 新增加的代码行
FBitmap.Canvas.CopyRect(Rect(0, 0, Button.Width, Button.Height),
FBitmap.Canvas, Button.BoundsRect);
FBitmap.SetSize(Button.Width, Button.Height);
end
else
begin
FBitmap.SetSize(Button.Width, Button.Height);
FBitmap.Canvas.Brush.Color := Button.Color;
FBitmap.Canvas.Brush.Style := bsSolid;
FBitmap.Canvas.FillRect(FBitmap.Canvas.ClipRect);
end;

if (Button.Style = tbsButton) or (Button.Style = tbsCheck) or
(Button.Style = tbsDropDown) or (Button.Style = tbsTextButton) then
begin
if cdsHot in State then
ImageList := HotImages;
if not Button.Enabled then
ImageList := DisabledImages;
if ImageList = nil then
ImageList := Images;

if (cdsHot in State) or (Button.Down and Button.Enabled)

or ((FMenuButton = nil) and (FTempMenu <> nil))// 新增加的代码行
then
begin
if (gdoHotTrack in GradientDrawingOptions) then
begin
FillColor := HotTrackColor;
if cdsSelected in State then
FillColor := GetShadowColor(FillColor, -25);
EdgeColor := GetShadowColor(FillColor);

R := Rect(0, 0, Button.Width, Button.Height);

FBitmap.Canvas.Brush.Color := EdgeColor;
if Button.Style = tbsDropDown then
Dec(R.Right, cDropDownWidth - (FBitmap.Canvas.Pen.Width div 2));

FBitmap.Canvas.FillRect(R);
InflateRect(R, -FBitmap.Canvas.Pen.Width, -FBitmap.Canvas.Pen.Width);
FBitmap.Canvas.Brush.Color := FillColor;
FBitmap.Canvas.FillRect(R);
InflateRect(R, FBitmap.Canvas.Pen.Width, FBitmap.Canvas.Pen.Width);

if Button.Style = tbsDropDown then
begin
R.Left := R.Right;
Inc(R.Right, cDropDownWidth - (FBitmap.Canvas.Pen.Width div 2));
FBitmap.Canvas.Brush.Color := EdgeColor;
FBitmap.Canvas.FillRect(R);
InflateRect(R, -FBitmap.Canvas.Pen.Width, -FBitmap.Canvas.Pen.Width);
FBitmap.Canvas.Brush.Color := FillColor;
FBitmap.Canvas.FillRect(R);
end;
end
else
begin
if Button.Down then
begin
FillColor := cl3DDkShadow;
EdgeColor := cl3DLight;
end
else
begin
FillColor := cl3DLight;
EdgeColor := cl3DDkShadow;
end;

R := Rect(0, 0, Button.Width, Button.Height);

Frame3D(FBitmap.Canvas, R, FillColor, EdgeColor, Canvas.Pen.Width);

if Button.Style = tbsDropDown then
begin
FBitmap.Canvas.MoveTo(R.Right - cDropDownWidth, 0);
FBitmap.Canvas.LineTo(R.Right - cDropDownWidth, Button.Height);
end;
end;
end;

if (ImageList <> nil) and (Button.ImageIndex >= 0) and (Button.ImageIndex < ImageList.Count) or
((ImageList <> nil) and (Button.Style = tbsTextButton)) then
begin
if (ShowCaptions and List) or (AllowTextButtons and (Button.Style = tbsTextButton)) then
X := cInset
else
begin
X := (Button.Width - ImageList.Width) div 2;
if Button.Style = tbsDropDown then
Dec(X, cDropDownWidth div 2);
end;
if (List and not AllowTextButtons) or
(AllowTextButtons and (Button.Style = tbsTextButton)) then
Y := (Button.Height - ImageList.Height) div 2
else
Y := cInset;

ImageList.Draw(FBitmap.Canvas, X, Y, Button.ImageIndex,
dsTransparent, itImage, Button.Enabled or (csDesigning in ComponentState) or
(not Button.Enabled and (ImageList = DisabledImages)));
end;

if (Button.Style = tbsDropDown) then
begin
X := Button.Width - ((cDropDownWidth div 2) + (cDropDownWidth div 4));
Y := Button.Height div 2;

FBitmap.Canvas.Pen.Color := Button.Font.Color;
if not Button.Enabled then
FBitmap.Canvas.Pen.Color := clGrayText;

FBitmap.Canvas.Brush.Style := bsSolid;
DrawArrow(FBitmap.Canvas, sdDown, Point(X, Y), cDropDownWidth div 4);
end;

if (ShowCaptions and not AllowTextButtons) or
(AllowTextButtons and (Button.Style = tbsTextButton)) then
begin
FBitmap.Canvas.Brush.Style := bsClear;
if (ImageList <> nil) and List and ((Button.Style <> tbsTextButton) or

((Button.Style = tbsTextButton) and (Button.ImageIndex <> -1))) then
R.Left := ImageList.Width
else
R.Left := 0;
R.Right := Button.Width;

Str := Button.Caption;

if Button.Style = tbsDropDown then
Dec(R.Right, cDropDownWidth - (FBitmap.Canvas.Pen.Width div 2));
if (not List) and (ImageList <> nil) then
R.Top := ImageList.Height + cInset
else
R.Top := (Button.Height div 2) - (FBitmap.Canvas.TextHeight(Str) div 2);
R.Bottom := R.Top + FBitmap.Canvas.TextHeight(Str);

FBitmap.Canvas.Font.Color := Button.Font.Color;
if not Button.Enabled then
FBitmap.Canvas.Font.Color := clGrayText;

DrawText(FBitmap.Canvas.Handle, Str, Length(Str), R,
DT_END_ELLIPSIS or DT_NOCLIP or DT_VCENTER or DT_CENTER);
end;
end;

Canvas.Draw(Button.Left, Button.Top, FBitmap);
end;
---------------------------------
重编VCL是不可能的。
也试过从TToolBar派生出一个新的ToolBar组件（对GradientDrawButton进行override）但失败了，因为重写的GradientDrawButton还是要访问父类里的私有变量。
从TToolBar派生不行，那么就从TToolBar的父类TToolWindow派生吧，纯粹是复制代码，然后重新命名而已。于是，从ComCtrls.pas里将TToolBar和TToolButton抽取出来，放到一个单元文件里，重新命名为TYhToolBar和TYhToolButton（TToolButton也要同时抽取出来，是因为它和TToolBar是关联的）。按理说，这种方法应该是最安全的，可是新创建的组件TYhToolBar和MainMenu关联起来使用时，会出问题：二级菜单弹出后，将鼠标移动到二级菜单的任意一个选项上时，Delphi IDE就挂掉了，range check error。
[解决办法]
我就直接给Ttreenode增加了一个属性：dataString:string
只是每到新的ide需要折腾一番