> {quote:title=Norm Carlberg wrote:}{quote}
> Can a toolbutton be both style tbsTEXTBUTTON and tbsDROPDOWN and if so how?
> Turbo Delphi 2006 Professional.
>
> Norm
I've got Delphi 2007 Win32. Here's what I did:
- Copied the ComCtrls.pas file to my library files location
- Modified the file (see patch file listing below)
- Included the modified ComCtrls.pas file in my project
This gives you the runtime ability to include the [tbsxTextButton] extended style along side the tbsCheck, tbsDropDown etc standard styles.
Note: In this implementation StylesEx needs to be set at runtime. Maybe someone else has the time to modify things so that the property is available at design time and a local copy of ComCtrls not be required (maybe via Class Helpers?)
G.
patch file listing:
{code}
--- C:/Program Files/CodeGear/RAD Studio/5.0/source/Win32/vcl/ComCtrls.pas Thu Dec 16 15:59:56 2010
+++ K:/Library/VCLPatches/ComCtrls.pas Thu Dec 16 15:55:32 2010
@@ -6,6 +6,15 @@
{ }
{*******************************************************}
+{
+ GF 16/12/2010
+ - patched TToolBar and TToolButton to add StylesEx property to TToolButton.
+ this allows a [tbsxTextButton] to be added to the button in parallel to
+ the standard button style. This allows you to combine showing captions
+ along with button styles (ie tbsCheck, tbsDropDown etc).
+ The StylesEx ex parameter needs to be set at runtime.
+}
+
unit ComCtrls;
{$R-,T-,H+,X+}
@@ -2895,6 +2904,10 @@
TToolButtonActionLinkClass = class of TToolButtonActionLink;
+ // GF added
+ TToolButtonStyleEx = (tbsxTextButton);
+ TToolButtonStylesEx = set of TToolButtonStyleEx;
+
TToolButton = class(TGraphicControl)
private
FAllowAllUp: Boolean;
@@ -2910,6 +2923,7 @@
FWrap: Boolean;
FStyle: TToolButtonStyle;
FUpdateCount: Integer;
+ FStylesEx: TToolButtonStylesEx; // GF added
function GetButtonState: Byte;
function GetIndex: Integer;
function IsCheckedStored: Boolean;
@@ -2948,12 +2962,21 @@
procedure SetToolBar(AToolBar: TToolBar);
procedure UpdateControl; virtual;
procedure ValidateContainer(AComponent: TComponent); override;
+
+ // GF added
+ function getStylesEx : TToolButtonStylesEx;
+ procedure setStylesEx(const in_value: TToolButtonStylesEx);
+
public
constructor Create(AOwner: TComponent); override;
function CheckMenuDropdown: Boolean; dynamic;
procedure Click; override;
procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
property Index: Integer read GetIndex;
+
+ // GF added
+ function styleShowCaptions : boolean;
+
published
property Action;
property AllowAllUp: Boolean read FAllowAllUp write FAllowAllUp default False;
@@ -2977,6 +3000,10 @@
property Wrap: Boolean read FWrap write SetWrap default False;
property ShowHint;
property Style: TToolButtonStyle read FStyle write SetStyle default tbsButton;
+ property StylesEx : TToolButtonStylesEx read getStylesEx write setStylesEx default [];
+
property Visible;
property Width stored IsWidthStored;
property OnClick;
@@ -17020,8 +17047,8 @@
begin
inherited;
UpdateControl;
- if not (csLoading in ComponentState) and (FToolBar <> nil) and
- (FToolBar.ShowCaptions or (FToolBar.AllowTextButtons and (FStyle = tbsTextButton))) then
+ if not (csLoading in ComponentState) and (FToolBar <> nil) and
+ (FToolBar.ShowCaptions or (FToolBar.AllowTextButtons and styleShowCaptions)) then // GF modified
begin
FToolBar.FButtonWidth := 0;
FToolBar.FButtonHeight := 0;
@@ -17180,7 +17207,7 @@
FAutoSize := Value;
UpdateControl;
if not (csLoading in ComponentState) and (FToolBar <> nil) and
- (FToolBar.ShowCaptions or (FToolBar.AllowTextButtons and (FStyle = tbsTextButton))) then
+ (FToolBar.ShowCaptions or (FToolBar.AllowTextButtons and styleShowCaptions)) then // GF modified
begin
FToolBar.FButtonWidth := 0;
FToolBar.FButtonHeight := 0;
@@ -17282,7 +17309,7 @@
RefreshControl;
FToolBar.Perform(TB_CHANGEBITMAP, Index, Value);
if FToolBar.Transparent or FToolBar.Flat then Invalidate;
- if not (csLoading in ComponentState) and (Style = tbsTextButton) then
+ if not (csLoading in ComponentState) and styleShowCaptions then // GF modified
FToolBar.RecreateButtons;
end;
end;
@@ -17335,7 +17362,7 @@
Invalidate;
if not (csLoading in ComponentState) and (FToolBar <> nil) then
begin
- if FToolBar.ShowCaptions or (FToolBar.AllowTextButtons and (FStyle = tbsTextButton)) then
+ if FToolBar.ShowCaptions or (FToolBar.AllowTextButtons and styleShowCaptions) then // GF modified
begin
FToolBar.FButtonWidth := 0;
FToolBar.FButtonHeight := 0;
@@ -17481,6 +17508,51 @@
end;
end;
+function TToolButton.getStylesEx : TToolButtonStylesEx;
+begin
+ // GF added
+ Result := FStylesEx;
+end;
+
+procedure TToolButton.setStylesEx(const in_value: TToolButtonStylesEx);
+begin
+ // GF added
+ if (FStylesEx = in_value) then exit;
+
+ FStylesEx := in_value;
+
+ Invalidate;
+ if not (csLoading in ComponentState) and (FToolBar <> nil) then
+ begin
+ if FToolBar.ShowCaptions or (FToolBar.AllowTextButtons and styleShowCaptions) then // GF modified
+ begin
+ FToolBar.FButtonWidth := 0;
+ FToolBar.FButtonHeight := 0;
+ FToolBar.RecreateButtons
+ end
+ else
+ begin
+ if Style in [tbsDivider, tbsSeparator] then
+ RefreshControl
+ else
+ if Style = tbsDropDown then
+ FToolbar.RecreateButtons
+ else
+ UpdateControl;
+ FToolBar.ResizeButtons;
+ FToolbar.RepositionButtons(Index);
+ end;
+ FToolBar.AdjustSize;
+ end;
+end;
+
+function TToolButton.styleShowCaptions : boolean;
+begin
+ // GF added
+ Result := ((FStyle = tbsTextButton) or (tbsxTextButton in FStylesEx));
+end;
+
+
procedure TToolButton.SetEnableDropdown(Value: Boolean);
begin
if FEnableDropdown <> Value then
@@ -17921,13 +17993,15 @@
with Button do
begin
fsStyle := ButtonStyles[Style];
+ if (tbsxTextButton in StylesEx) then // GF added
+ fsStyle := fsStyle or BTNS_SHOWTEXT;
if AutoSize and (GetComCtlVersion >= ComCtlVersionIE4) then
fsStyle := fsStyle or TBSTYLE_AUTOSIZE;
end;
Button.fsState := GetButtonState;
if FGrouped then Button.fsStyle := Button.fsStyle or TBSTYLE_GROUP;
Button.dwData := Longint(Control);
- if ShowCaptions or (AllowTextButtons and (Style = tbsTextButton)) then
+ if ShowCaptions or (AllowTextButtons and styleShowCaptions) then // GF modified
begin
if Caption <> '' then
CaptionText := Caption
@@ -17953,7 +18027,7 @@
else
begin
FillChar(Button, SizeOf(Button), 0);
- Button.fsStyle := ButtonStyles[tbsSeparator];
+ Button.fsStyle := ButtonStyles[tbsSeparator];
Button.iBitmap := Control.Width;
Button.idCommand := -1;
if not Control.Visible and not (csDesigning in Control.ComponentState) then
@@ -17995,13 +18069,14 @@
with Button do
begin
cx := Width;
- fsStyle := ButtonStyles[Style];
+ fsStyle := ButtonStyles[Style];
+ if (tbsxTextButton in StylesEx) then fsStyle := fsStyle or BTNS_SHOWTEXT; // GF added
if AutoSize then fsStyle := fsStyle or TBSTYLE_AUTOSIZE;
if Grouped then Button.fsStyle := Button.fsStyle or TBSTYLE_GROUP;
end;
Button.fsState := GetButtonState;
Button.lParam := Longint(Control);
- if ShowCaptions or (AllowTextButtons and (Style = tbsTextButton)) then
+ if ShowCaptions or (AllowTextButtons and styleShowCaptions) then // GF modified
begin
if Caption <> '' then
CaptionText := Caption
@@ -19130,7 +19205,7 @@
if Enabled and Showing and (ShowCaptions or AllowTextButtons) and ContainsActiveControl then
begin
Button := FindButtonFromAccel(Message.CharCode);
- if (Button <> nil) and (not AllowTextButtons or (Button.Style = tbsTextButton)) then
+ if (Button <> nil) and (not AllowTextButtons or Button.styleShowCaptions) then // GF modified
begin
{ Display a drop-down menu after hitting the accelerator key if IE3
is installed. Otherwise, fire the OnClick event for IE4. We do this
@@ -19693,7 +19768,7 @@
end;
if (Button.Style = tbsButton) or (Button.Style = tbsCheck) or
- (Button.Style = tbsDropDown) or (Button.Style = tbsTextButton) then
+ (Button.Style = tbsDropDown) or Button.styleShowCaptions then // GF modified
begin
if cdsHot in State then
ImageList := HotImages;
@@ -19760,9 +19835,9 @@
end;
if (ImageList <> nil) and (Button.ImageIndex >= 0) and (Button.ImageIndex < ImageList.Count) or
- ((ImageList <> nil) and (Button.Style = tbsTextButton)) then
+ ((ImageList <> nil) and Button.styleShowCaptions) then // GF modified
begin
- if (ShowCaptions and List) or (AllowTextButtons and (Button.Style = tbsTextButton)) then
+ if (ShowCaptions and List) or (AllowTextButtons and Button.styleShowCaptions) then // GF modified
X := cInset
else
begin
@@ -19770,8 +19845,8 @@
if Button.Style = tbsDropDown then
Dec(X, cDropDownWidth div 2);
end;
- if (List and not AllowTextButtons) or
- (AllowTextButtons and (Button.Style = tbsTextButton)) then
+ if (List and not AllowTextButtons) or
+ (AllowTextButtons and Button.styleShowCaptions) then // GF modified
Y := (Button.Height - ImageList.Height) div 2
else
Y := cInset;
@@ -19794,12 +19869,12 @@
DrawArrow(FBitmap.Canvas, sdDown, Point(X, Y), cDropDownWidth div 4);
end;
- if (ShowCaptions and not AllowTextButtons) or
- (AllowTextButtons and (Button.Style = tbsTextButton)) then
+ if (ShowCaptions and not AllowTextButtons) or
+ (AllowTextButtons and Button.styleShowCaptions) then // GF modified
begin
FBitmap.Canvas.Brush.Style := bsClear;
- if (ImageList <> nil) and List and ((Button.Style <> tbsTextButton) or
- ((Button.Style = tbsTextButton) and (Button.ImageIndex <> -1))) then
+ if (ImageList <> nil) and List and (not Button.styleShowCaptions or // GF modified
+ (Button.styleShowCaptions and (Button.ImageIndex <> -1))) then // GF modified
R.Left := ImageList.Width
else
R.Left := 0;
@@ -20343,13 +20418,17 @@
cchText := StrLen(pszText);
StrLCopy(Buffer, PChar(Title), MaxLen);
Buffer[Length(Title) + 1] := #0;
- if ShowCaptions or (AllowTextButtons and (FStyle = tbsTextButton)) then
+ if ShowCaptions or (AllowTextButtons and styleShowCaptions) then // GF modified
tbButton.iString := Self.Perform(TB_ADDSTRING, 0, Longint(@Buffer))
else
tbButton.iString := -1;
tbButton.idCommand := Index;
tbButton.iBitmap := ImageIndex;
tbButton.fsStyle := ButtonStyles[Style];
+ if (tbsxTextButton in StylesEx) then // GF added
+ begin
+ tbButton.fsStyle := tbButton.fsStyle or BTNS_SHOWTEXT;
+ end;
tbButton.fsState := GetButtonState;
tbButton.dwData := Integer(NewButton);
end;
{code}
Edited by: Graeme Foot on Dec 15, 2010 7:05 PM - listing didn't work so well, trying it again