mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-05 14:39:05 +02:00
808 lines
23 KiB
PHP
808 lines
23 KiB
PHP
{%MainUnit ../comctrls.pp}
|
|
|
|
{ TToolButton
|
|
|
|
*****************************************************************************
|
|
* *
|
|
* This file is part of the Lazarus Component Library (LCL) *
|
|
* *
|
|
* See the file COPYING.modifiedLGPL, included in this distribution, *
|
|
* for details about the copyright. *
|
|
* *
|
|
* This program is distributed in the hope that it will be useful, *
|
|
* but WITHOUT ANY WARRANTY; without even the implied warranty of *
|
|
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
|
|
* *
|
|
*****************************************************************************
|
|
|
|
}
|
|
|
|
{ TToolButtonActionLink }
|
|
|
|
procedure TToolButtonActionLink.AssignClient(AClient: TObject);
|
|
begin
|
|
inherited AssignClient(AClient);
|
|
FClient := AClient as TToolButton;
|
|
end;
|
|
|
|
function TToolButtonActionLink.IsCheckedLinked: Boolean;
|
|
begin
|
|
Result := inherited IsCheckedLinked
|
|
and (TToolButton(FClient).Down = (Action as TCustomAction).Checked);
|
|
end;
|
|
|
|
function TToolButtonActionLink.IsImageIndexLinked: Boolean;
|
|
begin
|
|
Result := inherited IsImageIndexLinked
|
|
and (TToolButton(FClient).ImageIndex = (Action as TCustomAction).ImageIndex);
|
|
end;
|
|
|
|
procedure TToolButtonActionLink.SetChecked(Value: Boolean);
|
|
begin
|
|
if IsCheckedLinked then TToolButton(FClient).Down := Value;
|
|
end;
|
|
|
|
procedure TToolButtonActionLink.SetImageIndex(Value: Integer);
|
|
begin
|
|
DebugLn('TToolButtonActionLink.SetImageIndex A ',ClassName,' Client=',
|
|
TToolButton(FClient).Name,' IsImageIndexLinked=',
|
|
BoolToStr(IsImageIndexLinked),' Old=',
|
|
IntToStr(TToolButton(FClient).ImageIndex),' New=',IntToStr(Value));
|
|
if IsImageIndexLinked then TToolButton(FClient).ImageIndex := Value;
|
|
end;
|
|
|
|
{ TToolButton }
|
|
|
|
constructor TToolButton.Create(TheOwner: TComponent);
|
|
begin
|
|
inherited Create(TheOwner);
|
|
fCompStyle := csToolButton;
|
|
FImageIndex := -1;
|
|
FStyle := tbsButton;
|
|
ControlStyle := [csCaptureMouse, csSetCaption, csDesignNoSmoothResize];
|
|
SetInitialBounds(0,0,23,22);
|
|
end;
|
|
|
|
procedure TToolButton.MouseDown(Button: TMouseButton; Shift: TShiftState;
|
|
X, Y: Integer);
|
|
begin
|
|
//DebugLn('TToolButton.MouseDown ',Name,':',ClassName,' ',ord(Button),' ',X,',',Y);
|
|
if (Button=mbLeft) and (not (tbfPressed in FToolButtonFlags)) then begin
|
|
Include(FToolButtonFlags,tbfPressed);
|
|
Invalidate;
|
|
end;
|
|
|
|
inherited MouseDown(Button,Shift,X,Y);
|
|
|
|
if (Style=tbsDropDown) and (Button=mbLeft) and Enabled then begin
|
|
if (FToolBar<>nil) and (X>ClientWidth-FToolBar.FDropDownWidth) then begin
|
|
|
|
end else begin
|
|
Down := true;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TToolButton.MouseMove(Shift: TShiftState; X, Y: Integer);
|
|
begin
|
|
//DebugLn('TToolButton.MouseMove ',Name,':',ClassName,' ',X,',',Y);
|
|
inherited MouseMove(Shift, X, Y);
|
|
end;
|
|
|
|
procedure TToolButton.MouseUp(Button: TMouseButton; Shift: TShiftState;
|
|
X, Y: Integer);
|
|
var DropDownMenuDropped:boolean;
|
|
begin
|
|
//DebugLn('TToolButton.MouseUp ',Name,':',ClassName,' ',ord(Button),' ',X,',',Y);
|
|
if (Button=mbLeft) and (tbfPressed in FToolButtonFlags) then begin
|
|
Exclude(FToolButtonFlags,tbfPressed);
|
|
Invalidate;
|
|
end;
|
|
|
|
inherited MouseUp(Button, Shift, X, Y);
|
|
|
|
if (Button=mbLeft) then begin
|
|
DropDownMenuDropped:=false;
|
|
//DebugLn('TToolButton.MouseUp ',Name,':',ClassName,' ',Style=tbsCheck);
|
|
if (Style=tbsButton) then Down:=false;
|
|
if (Style=tbsDropDown) then begin
|
|
if (FToolBar<>nil) and FMouseInControl
|
|
and (X>ClientWidth-FToolBar.FDropDownWidth) then begin
|
|
DropDownMenuDropped:=CheckMenuDropdown;
|
|
end;
|
|
Down:=false;
|
|
end;
|
|
|
|
if FMouseInControl and not DropDownMenuDropped then begin
|
|
if (Style=tbsCheck) then Down:=not Down;
|
|
Click;
|
|
end;
|
|
end;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TToolButton.Notification(AComponent: TComponent;
|
|
Operation: TOperation);
|
|
begin
|
|
inherited Notification(AComponent, Operation);
|
|
if Operation = opRemove then begin
|
|
if AComponent = DropdownMenu then
|
|
DropdownMenu := nil
|
|
else if AComponent = MenuItem then
|
|
MenuItem := nil;
|
|
end;
|
|
end;
|
|
|
|
procedure TToolButton.Paint;
|
|
|
|
procedure DrawDropDownArrow(const DropDownButtonRect: TRect);
|
|
var
|
|
ArrowRect: TRect;
|
|
Points: array[1..3] of TPoint;
|
|
begin
|
|
ArrowRect:=DropDownButtonRect;
|
|
ArrowRect.Left:=DropDownButtonRect.Left+2;
|
|
ArrowRect.Right:=Max(DropDownButtonRect.Right-3,ArrowRect.Left);
|
|
ArrowRect.Top:=(DropDownButtonRect.Top+DropDownButtonRect.Bottom
|
|
+ArrowRect.Left-ArrowRect.Right) div 2;
|
|
ArrowRect.Bottom:=ArrowRect.Top-ArrowRect.Left+ArrowRect.Right;
|
|
Points[1]:=Point(ArrowRect.Left,ArrowRect.Top);
|
|
Points[2]:=Point((ArrowRect.Left+ArrowRect.Right) div 2,ArrowRect.Bottom);
|
|
Points[3]:=Point(ArrowRect.Right,ArrowRect.Top);
|
|
Canvas.Brush.Color:=clBlack;
|
|
Canvas.Pen.Color:=clBlack;
|
|
Canvas.Polygon(@Points[1],3,false);
|
|
end;
|
|
|
|
var
|
|
PaintRect: TRect;
|
|
ButtonRect: TRect;
|
|
DropDownButtonRect: TRect;
|
|
DividerRect: TRect;
|
|
TextSize: TSize;
|
|
TextPos: TPoint;
|
|
IconSize: TPoint;
|
|
IconPos: TPoint;
|
|
ImgList: TCustomImageList;
|
|
ImgIndex: integer;
|
|
TS: TTextStyle;
|
|
begin
|
|
//DebugLn(['TToolButton.Paint A ',DbgSName(Self),' FToolBar=',DbgSName(FToolBar),' ',ClientWidth,',',ClientHeight,' ',ord(Style)]);
|
|
if (FToolBar<>nil) and (ClientWidth>0) and (ClientHeight>0) then begin
|
|
PaintRect:=ClientRect; // the whole paint area
|
|
|
|
// calculate button area(s)
|
|
ButtonRect:=PaintRect;
|
|
FLastButtonDrawFlags:=GetButtonDrawFlags;
|
|
if (FLastButtonDrawFlags and DFCS_PUSHED) <> 0 then
|
|
OffsetRect(ButtonRect, 1, 1);
|
|
if Style=tbsDropDown then begin
|
|
DropDownButtonRect:=ButtonRect;
|
|
DropDownButtonRect.Left:=
|
|
Max(0,DropDownButtonRect.Right-FToolBar.FDropDownWidth);
|
|
ButtonRect.Right:=DropDownButtonRect.Left;
|
|
end;
|
|
|
|
// calculate text size
|
|
TextSize.cx:=0;
|
|
TextSize.cy:=0;
|
|
if (Style in [tbsButton,tbsDropDown,tbsCheck])
|
|
and (FToolBar.ShowCaptions) then begin
|
|
if (Caption<>'') then begin
|
|
TextSize:=Canvas.TextExtent(Caption);
|
|
end;
|
|
end;
|
|
|
|
// calculate icon size
|
|
IconSize:=Point(0,0);
|
|
GetCurrentIcon(ImgList,ImgIndex);
|
|
if (ImgList<>nil) then begin
|
|
IconSize:=Point(ImgList.Width,ImgList.Height);
|
|
if IconSize.y<=0 then IconSize.X:=0;
|
|
end;
|
|
|
|
// calculate text and icon position
|
|
TextPos:=Point(0,0);
|
|
IconPos:=Point(0,0);
|
|
if TextSize.cx>0 then begin
|
|
if IconSize.X>0 then begin
|
|
if FToolBar.List then begin
|
|
// icon left of text
|
|
IconPos.X:=(ButtonRect.Left+ButtonRect.Right-IconSize.x-TextSize.cx-2) div 2;
|
|
IconPos.Y:=(ButtonRect.Top+ButtonRect.Bottom-IconSize.y) div 2;
|
|
TextPos.X:=IconPos.X+IconSize.X+2;
|
|
TextPos.Y:=(ButtonRect.Top+ButtonRect.Bottom-TextSize.cy) div 2;
|
|
end else begin
|
|
// icon above text
|
|
IconPos.X:=(ButtonRect.Left+ButtonRect.Right-IconSize.x) div 2;
|
|
IconPos.Y:=(ButtonRect.Top+ButtonRect.Bottom-IconSize.y-TextSize.cy-2) div 2;
|
|
TextPos.X:=(ButtonRect.Left+ButtonRect.Right-TextSize.cx) div 2;
|
|
TextPos.Y:=IconPos.Y+IconSize.Y+2;
|
|
end;
|
|
end else begin
|
|
// only text
|
|
TextPos.X:=(ButtonRect.Left+ButtonRect.Right-TextSize.cx) div 2;
|
|
TextPos.Y:=(ButtonRect.Top+ButtonRect.Bottom-TextSize.cy) div 2;
|
|
end;
|
|
end else if IconSize.x>0 then begin
|
|
// only icon
|
|
IconPos.X:=(ButtonRect.Left+ButtonRect.Right-IconSize.x) div 2;
|
|
IconPos.Y:=(ButtonRect.Top+ButtonRect.Bottom-IconSize.y) div 2;
|
|
end;
|
|
|
|
// draw button
|
|
if (Style in [tbsButton,tbsDropDown,tbsCheck])
|
|
and (FLastButtonDrawFlags and DFCS_FLAT = 0) then begin
|
|
DrawFrameControl(Canvas.GetUpdatedHandle([csBrushValid,csPenValid]),
|
|
PaintRect{ButtonRect}, DFC_BUTTON, FLastButtonDrawFlags);
|
|
InflateRect(PaintRect, -2, -2);
|
|
end;
|
|
|
|
// draw dropdown button
|
|
if Style in [tbsDropDown] then begin
|
|
//DrawFrameControl(Canvas.GetUpdatedHandle([csBrushValid,csPenValid]),
|
|
// DropDownButtonRect, DFC_BUTTON, FLastButtonDrawFlags);
|
|
DrawDropDownArrow(DropDownButtonRect);
|
|
end;
|
|
|
|
// draw icon
|
|
if (ImgList<>nil) then begin
|
|
ImgList.Draw(Canvas,IconPos.X,IconPos.Y,ImgIndex,true);
|
|
end;
|
|
|
|
// draw text
|
|
if (TextSize.cx>0) then begin
|
|
TS := Canvas.TextStyle;
|
|
TS.Alignment:= taLeftJustify;
|
|
TS.Layout:= tlTop;
|
|
TS.Opaque:= false;
|
|
TS.Clipping:= false;
|
|
TS.SystemFont:=Canvas.Font.IsDefault;
|
|
TS.ShowPrefix:=true;
|
|
TS.Wordbreak:=false;
|
|
//DebugLn(['TToolButton.Paint Caption="',DbgStr(Caption),'" TextPos=',dbgs(TextPos),' PaintRect=',dbgs(PaintRect)]);
|
|
Canvas.TextRect(PaintRect, TextPos.X, TextPos.Y, Caption, TS);
|
|
end;
|
|
|
|
// draw separator (at runtime: just space, at designtime: a rectangle)
|
|
if (Style in [tbsSeparator,tbsDivider])
|
|
and (csDesigning in ComponentState) then begin
|
|
Canvas.Brush.Color:=clBackground;
|
|
Canvas.Pen.Color:=clBlack;
|
|
dec(PaintRect.Right);
|
|
dec(PaintRect.Bottom);
|
|
Canvas.FrameRect(PaintRect);
|
|
end;
|
|
|
|
// draw divider
|
|
if (Style in [tbsDivider]) then begin
|
|
DividerRect.Left:=((ButtonRect.Left+ButtonRect.Right) div 2)-1;
|
|
DividerRect.Right:=DividerRect.Left+2;
|
|
DividerRect.Top:=2;
|
|
DividerRect.Bottom:=Max(DividerRect.Top,PaintRect.Bottom-2);
|
|
DrawEdge(Canvas.Handle,DividerRect,EDGE_ETCHED,BF_LEFT);
|
|
end;
|
|
end;
|
|
|
|
inherited Paint;
|
|
end;
|
|
|
|
procedure TToolButton.Loaded;
|
|
begin
|
|
inherited Loaded;
|
|
CopyPropertiesFromMenuItem(FMenuItem);
|
|
end;
|
|
|
|
procedure TToolButton.SetAutoSize(const Value: Boolean);
|
|
begin
|
|
if Value = AutoSize then exit;
|
|
inherited SetAutoSize(Value);
|
|
RequestAlign;
|
|
end;
|
|
|
|
procedure TToolButton.SetToolBar(NewToolBar: TToolBar);
|
|
begin
|
|
if FToolBar = NewToolBar then exit;
|
|
Parent := NewToolBar;
|
|
end;
|
|
|
|
procedure TToolButton.ActionChange(Sender: TObject; CheckDefaults: Boolean);
|
|
var
|
|
NewAction: TCustomAction;
|
|
begin
|
|
inherited ActionChange(Sender, CheckDefaults);
|
|
if Sender is TCustomAction then begin
|
|
NewAction:=TCustomAction(Sender);
|
|
if (not CheckDefaults) or (not Down) then
|
|
Down := NewAction.Checked;
|
|
if (not CheckDefaults) or (ImageIndex<0) then
|
|
ImageIndex := NewAction.ImageIndex;
|
|
end;
|
|
end;
|
|
|
|
function TToolButton.GetActionLinkClass: TControlActionLinkClass;
|
|
begin
|
|
Result:=TToolButtonActionLink;
|
|
end;
|
|
|
|
procedure TToolButton.CopyPropertiesFromMenuItem(const Value: TMenuItem);
|
|
begin
|
|
if Value=nil then exit;
|
|
BeginUpdate;
|
|
Action := Value.Action;
|
|
Caption := Value.Caption;
|
|
Down := Value.Checked;
|
|
Enabled := Value.Enabled;
|
|
Hint := Value.Hint;
|
|
ImageIndex := Value.ImageIndex;
|
|
Visible := Value.Visible;
|
|
EndUpdate;
|
|
end;
|
|
|
|
procedure TToolButton.CMHitTest(var Message: TCMHitTest);
|
|
begin
|
|
if (not (Style in [tbsDivider, tbsSeparator])) or (DragKind = dkDock) then
|
|
Message.Result := 1
|
|
else
|
|
Message.Result := 0;
|
|
end;
|
|
|
|
procedure TToolButton.MouseEnter;
|
|
begin
|
|
//DebugLn('TToolButton.MouseEnter ',Name);
|
|
inherited MouseEnter;
|
|
SetMouseInControl(true);
|
|
end;
|
|
|
|
procedure TToolButton.MouseLeave;
|
|
begin
|
|
//DebugLn('TToolButton.MouseLeave ',Name);
|
|
inherited MouseLeave;
|
|
SetMouseInControl(false);
|
|
if (not MouseCapture) and (tbfPressed in FToolButtonFlags) then begin
|
|
Invalidate;
|
|
Exclude(FToolButtonFlags,tbfPressed);
|
|
end;
|
|
end;
|
|
|
|
procedure TToolButton.SetDown(Value: Boolean);
|
|
var
|
|
StartIndex, EndIndex: integer;
|
|
i: Integer;
|
|
CurButton: TToolButton;
|
|
begin
|
|
if Value = FDown then exit;
|
|
if (csLoading in ComponentState) then begin
|
|
FDown:=Value;
|
|
exit;
|
|
end;
|
|
|
|
//DebugLn('TToolButton.SetDown ',Style=tbsCheck,',',FDown,',',GroupAllUpAllowed);
|
|
if (Style=tbsCheck) and FDown and (not GroupAllUpAllowed) then
|
|
exit;
|
|
|
|
FDown := Value;
|
|
|
|
if (Style=tbsCheck) and FDown and Grouped then begin
|
|
DebugLn('TToolButton.SetDown B ');
|
|
// uncheck all other in the group
|
|
GetGroupBounds(StartIndex,EndIndex);
|
|
if StartIndex>=0 then begin
|
|
for i:=StartIndex to EndIndex do begin
|
|
CurButton:=FToolBar.Buttons[i];
|
|
if (CurButton<>Self) and (CurButton.FDown) then begin
|
|
CurButton.FDown:=false;
|
|
CurButton.Invalidate;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
Invalidate;
|
|
if FToolBar <> nil then
|
|
FToolBar.ToolButtonDown(Self,FDown);
|
|
end;
|
|
|
|
procedure TToolButton.SetDropdownMenu(Value: TPopupMenu);
|
|
begin
|
|
if Value = FDropdownMenu then exit;
|
|
FDropdownMenu := Value;
|
|
if Value <> nil then Value.FreeNotification(Self);
|
|
end;
|
|
|
|
procedure TToolButton.SetGrouped(Value: Boolean);
|
|
var
|
|
StartIndex, EndIndex: integer;
|
|
CheckedIndex: Integer;
|
|
i: Integer;
|
|
CurButton: TToolButton;
|
|
begin
|
|
if FGrouped = Value then exit;
|
|
FGrouped := Value;
|
|
if csLoading in ComponentState then exit;
|
|
|
|
// make sure, that only one button in a group is checked
|
|
while FGrouped and (Style=tbsCheck) and (FToolBar<>nil) do begin
|
|
GetGroupBounds(StartIndex,EndIndex);
|
|
if StartIndex>=0 then begin
|
|
CheckedIndex:=-1;
|
|
i:=StartIndex;
|
|
while i<=EndIndex do begin
|
|
CurButton:=FToolBar.Buttons[i];
|
|
if CurButton.Down then begin
|
|
if CheckedIndex<0 then
|
|
CheckedIndex:=i
|
|
else begin
|
|
CurButton.Down:=false;
|
|
// the last operation can change everything -> restart
|
|
break;
|
|
end;
|
|
end;
|
|
inc(i);
|
|
end;
|
|
if i>EndIndex then break;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TToolButton.SetImageIndex(Value: Integer);
|
|
begin
|
|
if FImageIndex = Value then exit;
|
|
//debugln('TToolButton.SetImageIndex ',Name,':',ClassName,' Old=',FImageIndex,' New=',Value);
|
|
FImageIndex := Value;
|
|
if FToolBar <> nil then begin
|
|
RefreshControl;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TToolButton.SetMarked(Value: Boolean);
|
|
begin
|
|
if FMarked = Value then exit;
|
|
FMarked := Value;
|
|
if FToolBar <> nil then
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TToolButton.SetIndeterminate(Value: Boolean);
|
|
begin
|
|
if FIndeterminate = Value then exit;
|
|
if Value then SetDown(False);
|
|
FIndeterminate := Value;
|
|
if FToolBar <> nil then
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TToolButton.SetMenuItem(Value: TMenuItem);
|
|
begin
|
|
if Value=FMenuItem then exit;
|
|
// copy values from menuitem
|
|
// is menuitem is still loading, skip this
|
|
if (Value <> nil) and (not (csLoading in Value.ComponentState)) then begin
|
|
CopyPropertiesFromMenuItem(Value);
|
|
end;
|
|
FMenuItem := Value;
|
|
end;
|
|
|
|
procedure TToolButton.SetStyle(Value: TToolButtonStyle);
|
|
begin
|
|
if FStyle = Value then exit;
|
|
FStyle := Value;
|
|
if Visible then
|
|
UpdateVisibleToolbar;
|
|
end;
|
|
|
|
procedure TToolButton.SetWrap(Value: Boolean);
|
|
begin
|
|
if FWrap = Value then exit;
|
|
FWrap := Value;
|
|
if FToolBar <> nil then
|
|
RefreshControl;
|
|
end;
|
|
|
|
procedure TToolButton.SetMouseInControl(NewMouseInControl: Boolean);
|
|
begin
|
|
//DebugLn('TToolButton.SetMouseInControl A ',Name,' Old=',FMouseInControl,' New=',NewMouseInControl);
|
|
if FMouseInControl=NewMouseInControl then exit;
|
|
FMouseInControl:=NewMouseInControl;
|
|
if (Style in [tbsDropDown,tbsButton]) and (not FMouseInControl) then
|
|
Down:=false;
|
|
//DebugLn('TToolButton.SetMouseInControl B ',Name,' Now=',FMouseInControl,' Down=',Down);
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TToolButton.BeginUpdate;
|
|
begin
|
|
Inc(FUpdateCount);
|
|
end;
|
|
|
|
procedure TToolButton.EndUpdate;
|
|
begin
|
|
Dec(FUpdateCount);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
procedure TToolButton.GetGroupBounds(var StartIndex, EndIndex: integer);
|
|
|
|
Return the index of the first and the last ToolButton in the group.
|
|
If no ToolBar then negative values are returned.
|
|
If not in a group then StartIndex=EndIndex.
|
|
------------------------------------------------------------------------------}
|
|
procedure TToolButton.GetGroupBounds(var StartIndex, EndIndex: integer);
|
|
var
|
|
CurButton: TToolButton;
|
|
begin
|
|
StartIndex:=Index;
|
|
EndIndex:=StartIndex;
|
|
if (Style<>tbsCheck) or (not Grouped) then exit;
|
|
while (StartIndex>0) do begin
|
|
CurButton:=FToolBar.Buttons[StartIndex-1];
|
|
if (CurButton<>nil) and (CurButton.Style=tbsCheck) and (CurButton.Grouped)
|
|
then
|
|
dec(StartIndex)
|
|
else
|
|
break;
|
|
end;
|
|
while (EndIndex<FToolBar.FButtons.Count-1) do begin
|
|
CurButton:=FToolBar.Buttons[EndIndex+1];
|
|
if (CurButton<>nil) and (CurButton.Style=tbsCheck) and (CurButton.Grouped)
|
|
then
|
|
inc(EndIndex)
|
|
else
|
|
break;
|
|
end;
|
|
end;
|
|
|
|
function TToolButton.GetIndex: Integer;
|
|
begin
|
|
if FToolBar <> nil then
|
|
Result := FToolBar.FButtons.IndexOf(Self)
|
|
else
|
|
Result := -1;
|
|
end;
|
|
|
|
function TToolButton.IsWidthStored: Boolean;
|
|
begin
|
|
Result := Style in [tbsSeparator, tbsDivider];
|
|
end;
|
|
|
|
procedure TToolButton.RefreshControl;
|
|
begin
|
|
UpdateControl;
|
|
end;
|
|
|
|
procedure TToolButton.UpdateControl;
|
|
begin
|
|
UpdateVisibleToolbar;
|
|
end;
|
|
|
|
function TToolButton.CheckMenuDropdown: Boolean;
|
|
begin
|
|
Result := (not (csDesigning in ComponentState))
|
|
and (((DropdownMenu<>nil) and (DropdownMenu.AutoPopup))
|
|
or (MenuItem<>nil))
|
|
and (FToolBar <> nil);
|
|
if Result then
|
|
Result:=FToolBar.CheckMenuDropdown(Self);
|
|
end;
|
|
|
|
procedure TToolButton.Click;
|
|
begin
|
|
inherited Click;
|
|
end;
|
|
|
|
procedure TToolButton.GetCurrentIcon(var ImageList: TCustomImageList;
|
|
var TheIndex: integer);
|
|
begin
|
|
ImageList:=nil;
|
|
TheIndex:=-1;
|
|
if (ImageIndex<0) or (FToolBar=nil) then exit;
|
|
|
|
if Style in [tbsButton,tbsDropDown,tbsCheck] then begin
|
|
TheIndex:=ImageIndex;
|
|
if Enabled and FMouseInControl then
|
|
// if mouse over button then use HotImages
|
|
ImageList:=FToolBar.HotImages
|
|
else if not Enabled then
|
|
// if button disabled then use HotImages
|
|
ImageList:=FToolBar.DisabledImages;
|
|
if (ImageList=nil) or (ImageList.Count<=ImageIndex) then begin
|
|
// if no special icon available, then try the default Images
|
|
ImageList:=FToolBar.Images;
|
|
if (ImageList=nil) or (ImageList.Count<=ImageIndex) then begin
|
|
// no icon available
|
|
ImageList:=nil;
|
|
TheIndex:=-1;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TToolButton.IsCheckedStored: Boolean;
|
|
begin
|
|
Result := (ActionLink = nil)
|
|
or (not TToolButtonActionLink(ActionLink).IsCheckedLinked);
|
|
end;
|
|
|
|
function TToolButton.IsImageIndexStored: Boolean;
|
|
begin
|
|
Result := (ActionLink = nil)
|
|
or (not TToolButtonActionLink(ActionLink).IsImageIndexLinked);
|
|
end;
|
|
|
|
procedure TToolButton.AssignTo(Dest: TPersistent);
|
|
begin
|
|
inherited AssignTo(Dest);
|
|
if Dest is TCustomAction then begin
|
|
TCustomAction(Dest).Checked := Down;
|
|
TCustomAction(Dest).ImageIndex := ImageIndex;
|
|
end;
|
|
end;
|
|
|
|
function TToolButton.GetButtonDrawFlags: integer;
|
|
begin
|
|
Result:=DFCS_BUTTONPUSH;
|
|
if FDown
|
|
or ((tbfPressed in FToolButtonFlags) and FMouseInControl) then
|
|
inc(Result,DFCS_PUSHED);
|
|
if not Enabled then inc(Result,DFCS_INACTIVE);
|
|
|
|
if (FToolBar<>nil) and FToolBar.Flat
|
|
and (not (csDesigning in ComponentState)) and (not FMouseInControl)
|
|
and (not FDown) then
|
|
inc(Result,DFCS_FLAT);
|
|
end;
|
|
|
|
procedure TToolButton.SetParent(AParent: TWinControl);
|
|
var
|
|
i: Integer;
|
|
NewWidth: Integer;
|
|
NewHeight: Integer;
|
|
begin
|
|
CheckNewParent(AParent);
|
|
if AParent=Parent then exit;
|
|
|
|
// remove from old button list
|
|
if FToolBar<>nil then
|
|
FToolBar.RemoveButton(Self);
|
|
FToolBar:=nil;
|
|
if AParent is TToolBar then begin
|
|
if Style in [tbsButton,tbsDropDown,tbsCheck] then
|
|
NewWidth:=TToolBar(AParent).ButtonWidth
|
|
else
|
|
NewWidth:=Width;
|
|
NewHeight:=TToolBar(AParent).ButtonHeight;
|
|
SetBoundsKeepBase(Left,Top,NewWidth,NewHeight,true);
|
|
end;
|
|
|
|
// inherited
|
|
inherited SetParent(AParent);
|
|
|
|
// add to new button list
|
|
if Parent is TToolBar then begin
|
|
FToolBar:=TToolBar(Parent);
|
|
i:=Index;
|
|
if i<0 then
|
|
FToolBar.AddButton(Self);
|
|
UpdateVisibleToolbar;
|
|
end;
|
|
//DebugLn('TToolButton.SetParent A ',Name,' NewIndex=',Index);
|
|
end;
|
|
|
|
procedure TToolButton.UpdateVisibleToolbar;
|
|
begin
|
|
//DebugLn('TToolButton.UpdateVisibleToolbar ',Parent is TToolBar);
|
|
if Parent is TToolBar then
|
|
TToolBar(Parent).UpdateVisibleBar;
|
|
end;
|
|
|
|
function TToolButton.GroupAllUpAllowed: boolean;
|
|
var
|
|
StartIndex, EndIndex: integer;
|
|
i: Integer;
|
|
CurButton: TToolButton;
|
|
begin
|
|
Result:=true;
|
|
if (Style=tbsCheck) and Grouped then begin
|
|
GetGroupBounds(StartIndex,EndIndex);
|
|
if (StartIndex>=0) then begin
|
|
// allow all up, if one button has AllowAllUp
|
|
Result:=false;
|
|
for i:=StartIndex to EndIndex do begin
|
|
CurButton:=FToolBar.Buttons[i];
|
|
if CurButton.AllowAllUp then begin
|
|
Result:=true;
|
|
break;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TToolButton.DialogChar(var Message: TLMKey): boolean;
|
|
begin
|
|
if IsAccel(Message.CharCode, Caption) and CanFocus then
|
|
begin
|
|
Click;
|
|
Result := true;
|
|
end else
|
|
Result := inherited;
|
|
end;
|
|
|
|
procedure TToolButton.CalculatePreferredSize(var PreferredWidth,
|
|
PreferredHeight: integer; WithThemeSpace: Boolean);
|
|
var
|
|
IconSize: TPoint;
|
|
TextSize: TSize;
|
|
TextPos: TPoint;
|
|
IconPos: TPoint;
|
|
ImgList: TCustomImageList;
|
|
ImgIndex: integer;
|
|
begin
|
|
if (FToolBar<>nil) then begin
|
|
PreferredWidth:=0;
|
|
PreferredHeight:=0;
|
|
|
|
// calculate text size
|
|
TextSize.cx:=0;
|
|
TextSize.cy:=0;
|
|
if (Style in [tbsButton,tbsDropDown,tbsCheck])
|
|
and (FToolBar.ShowCaptions) then begin
|
|
if (Caption<>'') then begin
|
|
if HandleAllocated then
|
|
TextSize:=Canvas.TextExtent(Caption);
|
|
end;
|
|
// add space around text
|
|
inc(TextSize.cx,4);
|
|
inc(TextSize.cy,4);
|
|
end;
|
|
|
|
// calculate icon size
|
|
IconSize:=Point(0,0);
|
|
GetCurrentIcon(ImgList,ImgIndex);
|
|
if (ImgList<>nil) then begin
|
|
IconSize:=Point(ImgList.Width,ImgList.Height);
|
|
if IconSize.y<=0 then IconSize.X:=0;
|
|
end;
|
|
|
|
// calculate text and icon position
|
|
TextPos:=Point(0,0);
|
|
IconPos:=Point(0,0);
|
|
if TextSize.cx>0 then begin
|
|
if IconSize.X>0 then begin
|
|
if FToolBar.List then begin
|
|
// icon left of text
|
|
TextPos.X:=IconPos.X+IconSize.X+2;
|
|
end else begin
|
|
// icon above text
|
|
TextPos.Y:=IconPos.Y+IconSize.Y+2;
|
|
end;
|
|
end else begin
|
|
// only text
|
|
end;
|
|
end else if IconSize.x>0 then begin
|
|
// only icon
|
|
end;
|
|
|
|
PreferredWidth:=Max(IconPos.X+IconSize.X,TextPos.X+TextSize.cx);
|
|
PreferredHeight:=Max(IconPos.Y+IconSize.Y,TextPos.Y+TextSize.cy);
|
|
//DebugLn(['TToolButton.CalculatePreferredSize Preferred=',PreferredWidth,',',PreferredHeight,' Icon=',IconPos.X,'+',IconSize.X,' Text=',TextPos.X,'+',TextSize.cx]);
|
|
//DebugLn(['TToolButton.CalculatePreferredSize Preferred=',PreferredWidth,',',PreferredHeight,' Icon=',IconPos.Y,'+',IconSize.Y,' Text=',TextPos.Y,'+',TextSize.cy]);
|
|
|
|
// add button frame
|
|
FLastButtonDrawFlags:=GetButtonDrawFlags;
|
|
if (Style in [tbsButton,tbsDropDown,tbsCheck])
|
|
and (FLastButtonDrawFlags and DFCS_FLAT = 0) then begin
|
|
inc(PreferredWidth,4);
|
|
inc(PreferredHeight,4);
|
|
end;
|
|
if Style=tbsDropDown then begin
|
|
inc(PreferredWidth,FToolBar.FDropDownWidth);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
// included by comctrls.pp
|
|
|