如何从TToolBar类派生出一个新的ToolBar控件?
已经通过修改TToolBar的源码达到了以上的目的,但这样不方便,想将这种修改通过从TToolBar派生出新的ToolBar控件来实现。对写VCL控件不熟悉,现在遇到好多问题,比如如何在派生类里访问父类的私有变量。
procedure TToolBar.ClearTempMenu;
var
I: Integer;
Item: TMenuItem;
myset: TCustomDrawState;
Flags: TTBCustomDrawFlags;
begin
myset := [];
Flags := [];
if (FMenuButton <> nil) then
GradientDrawButton(FMenuButton, myset, Flags); // new code
if (FButtonMenu <> nil) and (FMenuButton <> nil) and
(FMenuButton.MenuItem <> nil) and (FTempMenu <> nil) then
begin
for I := FTempMenu.Items.Count - 1 downto 0 do
begin
Item := FTempMenu.Items[I];
FTempMenu.Items.Delete(I);
FButtonMenu.Insert(0, Item);
end;
FTempMenu.Free;
FTempMenu := nil;
FMenuButton := nil;
FButtonMenu := nil;
end;
end;
function TToolBar.CheckMenuDropdown(Button: TToolButton): Boolean;
var
Hook: Boolean;
Menu: TMenu;
Item: TMenuItem;
I: Integer;
ParentMenu: TMenu;
APoint: TPoint;
LMonitor: TMonitor;
myset: TCustomDrawState;
Flags: TTBCustomDrawFlags;
begin
Result := False;
if Button = nil then
Exit;
FCaptureChangeCancels := False;
try
if Button.DropdownMenu <> nil then
FTempMenu := Button.DropdownMenu
else if Button.MenuItem <> nil then
begin
Button.MenuItem.Click;
ClearTempMenu;
FTempMenu := TPopupMenu.Create(Self);
ParentMenu := Button.MenuItem.GetParentMenu;
if ParentMenu <> nil then
FTempMenu.BiDiMode := ParentMenu.BiDiMode;
FTempMenu.HelpContext := Button.MenuItem.HelpContext;
FTempMenu.TrackButton := tbLeftButton;
Menu := Button.MenuItem.GetParentMenu;
if Menu <> nil then
FTempMenu.Images := Menu.Images;
FButtonMenu := Button.MenuItem;
for I := FButtonMenu.Count - 1 downto 0 do
begin
Item := FButtonMenu.Items[I];
FButtonMenu.Delete(I);
FTempMenu.Items.Insert(0, Item);
end;
end
else
Exit;
SendCancelMode(nil);
FTempMenu.PopupComponent := Self;
Hook := Button.Grouped or (Button.MenuItem <> nil);
if Hook then
begin
MenuButtonIndex := Button.Index;
MenuToolBar := Self;
InitToolMenuHooks;
end;
Perform(TB_SETHOTITEM, -1, 0);
try
APoint := Button.ClientToScreen(Point(0, Button.ClientHeight));
if FTempMenu.IsRightToLeft then
Inc(APoint.X, Button.Width);
FMenuDropped := True;
LMonitor := Screen.MonitorFromPoint(APoint);
if (LMonitor <> nil) and
((GetSystemMetrics(SM_CYMENU) * FTempMenu.Items.Count) + APoint.Y > LMonitor.Height) then
Dec(APoint.Y, Button.Height);
if GetComCtlVersion = ComCtlVersionIE5 then
Button.Invalidate;
myset := [cdsHot, cdsSelected];
Flags := [];
GradientDrawButton(Button, myset, Flags); // new code
FTempMenu.Popup(APoint.X, APoint.Y);
finally
if Hook then ReleaseToolMenuHooks;
end;
FMenuButton := Button;
if StillModal then
Perform(TB_SETHOTITEM, Button.Index, 0);
Result := True;
finally
PostMessage(Handle, CN_DROPDOWNCLOSED, 0, 0);
end;
end;
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
if (FMenuButton <> nil) or (FTempMenu = nil) then // new code
begin
FBitmap.SetSize(Width, Height);
GradientFillCanvas(FBitmap.Canvas, FGradientStartColor, FGradientEndColor,
ClientRect, GradientDirection);
FBitmap.Canvas.CopyRect(Rect(0, 0, Button.Width, Button.Height),
FBitmap.Canvas, Button.BoundsRect);
FBitmap.SetSize(Button.Width, Button.Height);
end;
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) 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;