1476 lines
42 KiB
ObjectPascal

{ rxtoolbar unit
Copyright (C) 2005-2017 Lagunov Aleksey alexs75@yandex.ru and Lazarus team
original conception from rx library for Delphi (c)
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published by
the Free Software Foundation; either version 2 of the License, or (at your
option) any later version with the following modification:
As a special exception, the copyright holders of this library give you
permission to link this library with independent modules to produce an
executable, regardless of the license terms of these independent modules,and
to copy and distribute the resulting executable under terms of your choice,
provided that you also meet, for each linked independent module, the terms
and conditions of the license of that module. An independent module is a
module which is not derived from or based on this library. If you modify
this library, you may extend this exception to your version of the library,
but you are not obligated to do so. If you do not wish to do so, delete this
exception statement from your version.
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. See the GNU Library General Public License
for more details.
You should have received a copy of the GNU Library General Public License
along with this library; if not, write to the Free Software Foundation,
Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
}
unit rxtoolbar;
{$I rx.inc}
interface
uses
Classes, SysUtils, LCLType, LCLIntf, Buttons, Controls, ExtCtrls, ActnList,
PropertyStorage, Menus, Forms, types, Graphics;
const
DefButtonWidth = 24;
DefButtonHeight = 23;
const
DropDownExtraBtnWidth = 15;
type
TToolPanel = class;
TToolbarItem = class;
TToolbarButtonStyle = (tbrButton, tbrCheck, tbrDropDown, tbrSeparator,
tbrDivider, tbrDropDownExtra);
TToolBarStyle = (tbsStandart, tbsWindowsXP, tbsNative);
TToolButtonAllign = (tbaNone, tbaLeft, tbaRignt);
TToolPanelOption = (tpFlatBtns, tpTransparentBtns, tpStretchBitmap,
tpCustomizable, tpGlyphPopup, tpCaptionPopup);
TToolPanelOptions = set of TToolPanelOption;
{ TToolbarButtonActionLink }
TToolbarButtonActionLink = class(TSpeedButtonActionLink)
protected
procedure SetImageIndex(Value: Integer); override;
function IsImageIndexLinked: Boolean; override;
procedure SetEnabled(Value: Boolean); override;
procedure SetCaption(const Value: string); override;
end;
TToolbarButtonActionLinkClass = class of TToolbarButtonActionLink;
{ TToolbarButton }
TToolbarButton = class(TCustomSpeedButton)
private
FDesign:boolean;
FDesignX,
FDesignY:integer;
FDrag:boolean;
FImageList:TImageList;
FImageListSelected:TImageList;
FDropDownMenu:TPopupMenu;
// FShowCaption:boolean;
FToolbarButtonStyle:TToolbarButtonStyle;
FLastDrawFlagsA:integer;
//FAutoSize:boolean;
FOwnerItem:TToolbarItem;
FFullPush:boolean;
function IsDesignMode:boolean;
procedure PaintSeparator;
protected
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure MouseLeave; override;
procedure Paint; override;
procedure Click; override;
procedure UpdateState(InvalidateOnChange: boolean); override;
procedure SetDesign(AValue:boolean; AToolbarItem:TToolbarItem);
//procedure SetAutoSize(AValue:boolean);
procedure UpdateSize;
procedure SetEnabled(NewEnabled: boolean); override;
function GetActionLinkClass: TControlActionLinkClass; override;
function GetDrawFlagsA: integer;
public
procedure SetBounds(aLeft, aTop, aWidth, aHeight: integer); override;
destructor Destroy; override;
end;
{ TToolbarItem }
TToolbarItem = class(TCollectionItem)
private
FButton: TToolbarButton;
FSaveLeft:integer;
function GetAction: TBasicAction;
function GetButtonStyle: TToolbarButtonStyle;
function GetDropDownMenu: TPopupMenu;
function GetGroupIndex: Integer;
function GetHeight: Integer;
function GetLayout: TButtonLayout;
function GetLeft: Integer;
function GetShowCaption: boolean;
function GetTag: Longint;
function GetTop: Integer;
function GetVisible: boolean;
function GetWidth: Integer;
procedure SetAction(const AValue: TBasicAction);
procedure SetButtonStyle(const AValue: TToolbarButtonStyle);
procedure SetDropDownMenu(const AValue: TPopupMenu);
procedure SetGroupIndex(const AValue: Integer);
procedure SetHeight(const AValue: Integer);
procedure SetLayout(const AValue: TButtonLayout);
procedure SetLeft(const AValue: Integer);
procedure SetShowCaption(const AValue: boolean);
procedure SetTag(const AValue: Longint);
procedure SetTop(const AValue: Integer);
procedure SetVisible(const AValue: boolean);
procedure SetWidth(const AValue: Integer);
procedure UpdateLeftAfterLoad;
protected
function GetDisplayName: string; override;
public
constructor Create(ACollection: TCollection); override;
destructor Destroy; override;
published
property Action:TBasicAction read GetAction write SetAction;
property Visible:boolean read GetVisible write SetVisible;
property Left: Integer read GetLeft write SetLeft;
property Height: Integer read GetHeight write SetHeight;
property Top: Integer read GetTop write SetTop;
property Width: Integer read GetWidth write SetWidth;
property DropDownMenu: TPopupMenu read GetDropDownMenu write SetDropDownMenu;
property ShowCaption:boolean read GetShowCaption write SetShowCaption;
property GroupIndex: Integer read GetGroupIndex write SetGroupIndex default 0;
property Layout: TButtonLayout read GetLayout write SetLayout default blGlyphLeft;
property ButtonStyle:TToolbarButtonStyle read GetButtonStyle write SetButtonStyle default tbrButton;
property Tag: Longint read GetTag write SetTag default 0;
end;
{ TToolbarItems }
TToolbarItems = class(TOwnedCollection)
private
FToolPanel:TToolPanel;
function GetByActionName(ActionName: string): TToolbarItem;
function GetToolbarItem(Index: Integer): TToolbarItem;
procedure SetToolbarItem(Index: Integer; const AValue: TToolbarItem);
public
constructor Create(ToolPanel: TToolPanel);
property Items[Index: Integer]: TToolbarItem read GetToolbarItem write SetToolbarItem; default;
property ByActionName[ActionName:string]:TToolbarItem read GetByActionName;
end;
{ TToolPanel }
TToolPanel = class(TCustomPanel)
private
FButtonAllign: TToolButtonAllign;
FCustomizeShortCut: boolean;
FImageList: TImageList;
FImageListSelected: TImageList;
FOptions: TToolPanelOptions;
FPropertyStorageLink:TPropertyStorageLink;
FToolbarItems:TToolbarItems;
FDefButtonWidth:integer;
FDefButtonHeight:integer;
FToolBarStyle: TToolBarStyle;
FVersion: Integer;
FArrowBmp:TBitmap;
function GetBtnHeight: Integer;
function GetBtnWidth: Integer;
function GetItems: TToolbarItems;
function GetPropertyStorage: TCustomPropertyStorage;
procedure SetBtnHeight(const AValue: Integer);
procedure SetBtnWidth(const AValue: Integer);
procedure SetButtonAllign(const AValue: TToolButtonAllign);
procedure SetImageList(const AValue: TImageList);
procedure SetImageListSelected(const AValue: TImageList);
procedure SetItems(const AValue: TToolbarItems);
procedure SetOptions(const AValue: TToolPanelOptions);
procedure SetPropertyStorage(const AValue: TCustomPropertyStorage);
procedure OnIniSave(Sender: TObject);
procedure OnIniLoad(Sender: TObject);
procedure SetToolBarStyle(const AValue: TToolBarStyle);
procedure ReAlignToolBtn;
protected
FCustomizer:TForm;
procedure Notification(AComponent: TComponent;
Operation: TOperation); override;
procedure SetCustomizing(AValue:boolean);
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure RequestAlign; override;
procedure Loaded; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Customize(HelpCtx: Longint);
procedure SetBounds(aLeft, aTop, aWidth, aHeight: integer); override;
published
property Items:TToolbarItems read GetItems write SetItems;
property ImageList:TImageList read FImageList write SetImageList;
property ImageListSelected:TImageList read FImageListSelected write SetImageListSelected;
property PropertyStorage:TCustomPropertyStorage read GetPropertyStorage write SetPropertyStorage;
property BtnWidth: Integer read GetBtnWidth write SetBtnWidth default DefButtonWidth;
property BtnHeight: Integer read GetBtnHeight write SetBtnHeight default DefButtonHeight;
property ToolBarStyle:TToolBarStyle read FToolBarStyle write SetToolBarStyle default tbsStandart;
property Options:TToolPanelOptions read FOptions write SetOptions;
property Version: Integer read FVersion write FVersion default 0;
property ButtonAllign:TToolButtonAllign read FButtonAllign write SetButtonAllign default tbaLeft;
property CustomizeShortCut:boolean read FCustomizeShortCut write FCustomizeShortCut;
property Align;
property Alignment;
property Anchors;
//property AutoSize;
property BorderSpacing;
property BevelInner;
property BevelOuter;
property BevelWidth;
property BorderWidth;
property BorderStyle;
property ChildSizing;
property ClientHeight;
property ClientWidth;
property Color;
property Constraints;
property DragMode;
property Enabled;
property Font;
property FullRepaint;
property ParentColor;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property TabOrder;
property TabStop;
property Visible;
property OnClick;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnMouseWheel;
property OnMouseWheelDown;
property OnMouseWheelUp;
property OnResize;
property OnStartDrag;
end;
implementation
uses Math, RxTBRSetup, LCLProc, rxlclutils, Dialogs, typinfo, rxdconst, GraphType,
LResources;
const
BtnAl2Align:array [TToolButtonAllign] of TAlign = (alNone, alLeft, alRight);
{ TToolbarButton }
function TToolbarButton.IsDesignMode: boolean;
begin
Result:=(Assigned(Parent) and (csDesigning in Parent.ComponentState)) or (FDesign);
end;
procedure TToolbarButton.PaintSeparator;
var
PaintRect: TRect;
X, H:integer;
begin
PaintRect:=ClientRect;
Canvas.Brush.Color := Color;
Canvas.FillRect(PaintRect);
if FToolbarButtonStyle = tbrSeparator then
begin
X:=Width div 2 - 1;
H:=TToolPanel(Parent).Height;
if X>0 then
begin
Canvas.Pen.Color:=clBtnShadow;
Canvas.Line(X, 1, X, H);
Canvas.Pen.Color:=clWindow;
Canvas.Line(X+1, 1, X+1, H);
end;
end;
end;
procedure TToolbarButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
Y: Integer);
begin
if IsDesignMode then
begin
FDrag:=true;
FDesignX:=Max(X-1, 1);
FDesignY:=Max(Y-1, 1);
end
else
begin
FFullPush:=X < (Width - DropDownExtraBtnWidth - 5);
inherited MouseDown(Button, Shift, X, Y);
end;
end;
procedure TToolbarButton.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
if IsDesignMode and FDrag then
begin
Top:=Max(0, Min(Y+Top-FDesignY, Parent.Height - Height));
Left:=Max(0, Min(X+Left-FDesignX, Parent.Width - Width));
end
else
begin
// FFullPuch:=(X-Left) < (Width - DropDownExtraBtnWidth);
inherited MouseMove(Shift, X, Y);
end
end;
procedure TToolbarButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
Y: Integer);
begin
if IsDesignMode then
begin
FDrag:=false;
Top:=4;
end
else
inherited MouseUp(Button, Shift, X, Y);
end;
procedure TToolbarButton.MouseLeave;
begin
inherited MouseLeave;
FFullPush:=true;
end;
procedure TToolbarButton.Paint;
var
PaintRect, PaintRect1: TRect;
GlyphWidth, GlyphHeight: Integer;
Offset, OffsetCap: TPoint;
ClientSize, TotalSize, TextSize: TSize;
//BrushStyle : TBrushStyle;
M, S : integer;
TXTStyle : TTextStyle;
SIndex : Longint;
TMP : String;
begin
if FToolbarButtonStyle in [tbrSeparator, tbrDivider] then
begin
PaintSeparator;
exit;
end;
inherited Paint;
UpdateState(false);
if (not Assigned(Action)) or (TToolbarItems(FOwnerItem.Collection).FToolPanel.FToolBarStyle = tbsNative) then
exit;
PaintRect:=ClientRect;
if (Action is TCustomAction) and Assigned(FImageList) and
(TCustomAction(Action).ImageIndex>-1) and
(TCustomAction(Action).ImageIndex < FImageList.Count) then
begin
FLastDrawFlagsA:=GetDrawFlagsA;
// FLastDrawFlagsA:=GetDrawDetails;
if not Transparent then
begin
Canvas.Brush.Color := Color;
Canvas.FillRect(PaintRect);
end;
if FLastDrawFlagsA <> 0 then
begin
if TToolbarItems(FOwnerItem.Collection).FToolPanel.FToolBarStyle = tbsWindowsXP then
begin
if FToolbarButtonStyle = tbrDropDownExtra then
begin
PaintRect1:=PaintRect;
Dec(PaintRect1.Right, DropDownExtraBtnWidth);
if FFullPush then
begin
DrawButtonFrameXP(Canvas, PaintRect1, (FLastDrawFlagsA and DFCS_PUSHED) <> 0,
(FLastDrawFlagsA and DFCS_FLAT) <> 0);
end
else
DrawButtonFrameXP(Canvas, PaintRect1, false,
(FLastDrawFlagsA and DFCS_FLAT) <> 0);
;
PaintRect1:=PaintRect;
PaintRect1.Left:=PaintRect1.Right - DropDownExtraBtnWidth;
DrawButtonFrameXP(Canvas, PaintRect1, (FLastDrawFlagsA and DFCS_PUSHED) <> 0,
(FLastDrawFlagsA and DFCS_FLAT) <> 0);
end
else
DrawButtonFrameXP(Canvas, PaintRect, (FLastDrawFlagsA and DFCS_PUSHED) <> 0,
(FLastDrawFlagsA and DFCS_FLAT) <> 0)
end
else
begin
if FToolbarButtonStyle = tbrDropDownExtra then
begin
PaintRect1:=PaintRect;
Dec(PaintRect1.Right, DropDownExtraBtnWidth);
if FFullPush then
begin
DrawButtonFrame(Canvas, PaintRect1, (FLastDrawFlagsA and DFCS_PUSHED) <> 0,
(FLastDrawFlagsA and DFCS_FLAT) <> 0);
end
else
begin
DrawButtonFrame(Canvas, PaintRect1, false,
(FLastDrawFlagsA and DFCS_FLAT) <> 0);
end;
PaintRect1:=PaintRect;
PaintRect1.Left:=PaintRect1.Right - DropDownExtraBtnWidth;
DrawButtonFrame(Canvas, PaintRect1, (FLastDrawFlagsA and DFCS_PUSHED) <> 0,
(FLastDrawFlagsA and DFCS_FLAT) <> 0);
end
else
DrawButtonFrame(Canvas, PaintRect, (FLastDrawFlagsA and DFCS_PUSHED) <> 0,
(FLastDrawFlagsA and DFCS_FLAT) <> 0);
end;
end;
if FToolbarButtonStyle = tbrDropDownExtra then
begin
Canvas.Draw(PaintRect.Right - 10, Height div 2, TToolbarItems(FOwnerItem.Collection).FToolPanel.FArrowBmp);
Dec(PaintRect.Right, DropDownExtraBtnWidth);
end;
GlyphWidth:= FImageList.Width;
GlyphHeight:=FImageList.Height;
ClientSize.cx:= PaintRect.Right - PaintRect.Left;
ClientSize.cy:= PaintRect.Bottom - PaintRect.Top;
if (Caption <> '') and ShowCaption then
begin
TMP := Caption;
SIndex := DeleteAmpersands(TMP);
TextSize:= Canvas.TextExtent(TMP);
(* If SIndex > 0 then
If SIndex <= Length(TMP) then
begin
FShortcut := Ord(TMP[SIndex]);
end;*)
end
else
begin
TextSize.cx:= 0;
TextSize.cy:= 0;
end;
if (GlyphWidth = 0) or (GlyphHeight = 0) or (TextSize.cx = 0) or (TextSize.cy = 0) then
S:= 0
else
S:= Spacing;
// Calculate caption and glyph layout
if Margin = -1 then
begin
if S = -1 then
begin
TotalSize.cx:= TextSize.cx + GlyphWidth;
TotalSize.cy:= TextSize.cy + GlyphHeight;
if Layout in [blGlyphLeft, blGlyphRight] then
M:= (ClientSize.cx - TotalSize.cx) div 3
else
M:= (ClientSize.cy - TotalSize.cy) div 3;
S:= M;
end
else
begin
TotalSize.cx:= GlyphWidth + S + TextSize.cx;
TotalSize.cy:= GlyphHeight + S + TextSize.cy;
if Layout in [blGlyphLeft, blGlyphRight] then
M:= (ClientSize.cx - TotalSize.cx + 1) div 2
else
M:= (ClientSize.cy - TotalSize.cy + 1) div 2
end;
end
else
begin
if S = -1 then
begin
TotalSize.cx:= ClientSize.cx - (Margin + GlyphWidth);
TotalSize.cy:= ClientSize.cy - (Margin + GlyphHeight);
if Layout in [blGlyphLeft, blGlyphRight] then
S:= (TotalSize.cx - TextSize.cx) div 2
else
S:= (TotalSize.cy - TextSize.cy) div 2;
end;
M:= Margin
end;
case Layout of
blGlyphLeft :
begin
Offset.X:= M;
Offset.Y:= (ClientSize.cy - GlyphHeight + 1) div 2;
OffsetCap.X:= Offset.X + GlyphWidth + S;
OffsetCap.Y:= (ClientSize.cy - TextSize.cy) div 2;
end;
blGlyphRight : begin
Offset.X:= ClientSize.cx - M - GlyphWidth;
Offset.Y:= (ClientSize.cy - GlyphHeight + 1) div 2;
OffsetCap.X:= Offset.X - S - TextSize.cx;
OffsetCap.Y:= (ClientSize.cy - TextSize.cy) div 2;
end;
blGlyphTop : begin
Offset.X:= (ClientSize.cx - GlyphWidth + 1) div 2;
Offset.Y:= M;
OffsetCap.X:= (ClientSize.cx - TextSize.cx + 1) div 2;
OffsetCap.Y:= Offset.Y + GlyphHeight + S;
end;
blGlyphBottom : begin
Offset.X:= (ClientSize.cx - GlyphWidth + 1) div 2;
Offset.Y:= ClientSize.cy - M - GlyphHeight;
OffsetCap.X:= (ClientSize.cx - TextSize.cx + 1) div 2;
OffsetCap.Y:= Offset.Y - S - TextSize.cy;
end;
end;
if ((FLastDrawFlagsA and DFCS_FLAT) <> 0) and ((FLastDrawFlagsA and DFCS_PUSHED) = 0)
and (tpGlyphPopup in TToolbarItems(FOwnerItem.Collection).FToolPanel.Options) and FFullPush then
begin
// FImageList.Draw(Canvas, Offset.X, Offset.Y, TCustomAction(Action).ImageIndex, false);
FImageList.Draw(Canvas, Offset.X, Offset.Y, TCustomAction(Action).ImageIndex, gdeShadowed);
Dec(Offset.X, 2);
Dec(Offset.Y, 2);
end;
if Assigned(FImageListSelected) and (FImageListSelected.Count>TCustomAction(Action).ImageIndex) and
((FLastDrawFlagsA and DFCS_FLAT) <> 0) and ((FLastDrawFlagsA and DFCS_PUSHED) = 0) then
FImageListSelected.Draw(Canvas, Offset.X, Offset.Y, TCustomAction(Action).ImageIndex, TCustomAction(Action).Enabled)
else
FImageList.Draw(Canvas, Offset.X, Offset.Y, TCustomAction(Action).ImageIndex, TCustomAction(Action).Enabled);
end;
if (Caption <> '') and ShowCaption then
begin
TXTStyle := Canvas.TextStyle;
TXTStyle.Opaque := False;
TXTStyle.Clipping := True;
TXTStyle.ShowPrefix := True;
TXTStyle.Alignment := taLeftJustify;
TXTStyle.Layout := tlTop;
TXTStyle.SystemFont := Canvas.Font.IsDefault;//Match System Default Style
With PaintRect, OffsetCap do
begin
Left := Left + X;
Top := Top + Y;
end;
If not Enabled then
begin
Canvas.Font.Color := clBtnHighlight;
OffsetRect(PaintRect, 1, 1);
Canvas.TextRect(PaintRect, PaintRect.Left, PaintRect.Top, Caption, TXTStyle);
Canvas.Font.Color := clBtnShadow;
OffsetRect(PaintRect, -1, -1);
end
else
begin
Canvas.Font.Color := clWindowText;
if ((FLastDrawFlagsA and DFCS_FLAT) <> 0) and ((FLastDrawFlagsA and DFCS_PUSHED) = 0) and (TToolPanel(Parent).FToolBarStyle <> tbsWindowsXP)
and (tpCaptionPopup in TToolbarItems(FOwnerItem.Collection).FToolPanel.Options) then
OffsetRect(PaintRect, -2, -2);
end;
Canvas.TextRect(PaintRect, PaintRect.Left, PaintRect.Top, Caption, TXTStyle);
end;
end;
procedure TToolbarButton.Click;
var
P:TPoint;
begin
if (csDesigning in ComponentState) or FDesign then exit;
if FToolbarButtonStyle = tbrDropDown then
begin
if Assigned(FDropDownMenu) then
begin
P.X:=0;
P.Y:=Height;
P:=ClientToScreen(P);
FDropDownMenu.PopUp(P.X, P.Y);
end;
end
else
if (FToolbarButtonStyle = tbrDropDownExtra) and (not FFullPush) then
begin
if Assigned(FDropDownMenu) then
begin
P.X:=Width - DropDownExtraBtnWidth;
P.Y:=Height;
P:=ClientToScreen(P);
FDropDownMenu.PopUp(P.X, P.Y);
end;
end
else
inherited Click;
end;
procedure TToolbarButton.UpdateState(InvalidateOnChange: boolean);
var
OldState: TButtonState;
begin
OldState:=FState;
inherited UpdateState(InvalidateOnChange);
if InvalidateOnChange and ((FState<>OldState) or (FLastDrawFlagsA<>GetDrawFlagsA)) then
Invalidate;
end;
procedure TToolbarButton.SetDesign(AValue:boolean; AToolbarItem:TToolbarItem);
begin
FDesign:=AValue;
if FDesign then
begin
Enabled:=true;
Flat:=false;
end
else
begin
Flat:=tpFlatBtns in TToolbarItems(AToolbarItem.Collection).FToolPanel.Options;
ActionChange(Action, true);
end;
end;
{
procedure TToolbarButton.SetAutoSize(AValue: boolean);
begin
FAutoSize:=AValue;
if csLoading in ComponentState then exit;
UpdateSize;
//Invalidate;
end;
}
procedure TToolbarButton.UpdateSize;
var
AWidth:integer;
begin
{ if csLoading in TToolbarItems(FOwnerItem.Collection).FToolPanel.ComponentState then exit;
if Assigned(TToolbarItems(FOwnerItem.Collection).FToolPanel.FImageList) then
begin
AWidth:=TToolbarItems(FOwnerItem.Collection).FToolPanel.FImageList.Width + 8;
if ShowCaption then
AWidth:= AWidth + Canvas.TextWidth(Caption) + Spacing;
end
else
AWidth:=Canvas.TextWidth(Caption);}
SetBounds(Left, Top, Width, Height);
Invalidate;
end;
procedure TToolbarButton.SetEnabled(NewEnabled: boolean);
begin
if FToolbarButtonStyle = tbrDropDown then
NewEnabled :=true;
if (not NewEnabled) and Enabled then
begin
FState := bsDisabled;
MouseLeave;
// Flat:=false;
end;
inherited SetEnabled(NewEnabled);
end;
function TToolbarButton.GetActionLinkClass: TControlActionLinkClass;
begin
Result:=TToolbarButtonActionLink;
end;
function TToolbarButton.GetDrawFlagsA: integer;
begin
// if flat and not mouse in control and not down, don't draw anything
if (Flat and not MouseInControl and not (FState in [bsDown, bsExclusive])) or (not Enabled) then
begin
Result := 0;
end
else
begin
Result:=DFCS_BUTTONPUSH;
if FState in [bsDown, bsExclusive] then
inc(Result,DFCS_PUSHED);
if not Enabled then
inc(Result,DFCS_INACTIVE);
if Flat then
inc(Result,DFCS_FLAT);
end;
end;
procedure TToolbarButton.SetBounds(aLeft, aTop, aWidth, aHeight: integer);
var
TextSize:TSize;
ImgH, ImgW:integer;
tmpCanvas: TCanvas;
begin
if Assigned(Parent) and not (csLoading in TToolPanel(Parent).ComponentState) then
begin
if FToolbarButtonStyle in [tbrSeparator, tbrDivider] then
begin
aWidth:=7;
if Assigned(FImageList) then
aHeight:=FImageList.Height+8
else
aHeight:=TToolPanel(Parent).BtnHeight;
end
else
//if FAutoSize and Assigned(Canvas) then
begin
if Assigned(FImageList) then
begin
ImgW:=FImageList.Width+8;
ImgH:=FImageList.Height+8;
end
else
begin
ImgH:=TToolPanel(Parent).BtnHeight;
ImgW:=TToolPanel(Parent).BtnWidth;
end;
if FToolbarButtonStyle = tbrDropDownExtra then
begin
ImgW:=ImgW + DropDownExtraBtnWidth;
end;
if aLeft < TToolPanel(Parent).BorderWidth then
aLeft:=TToolPanel(Parent).BorderWidth;
if ShowCaption then
begin
tmpCanvas := GetWorkingCanvas(Canvas);
try
TextSize:=tmpCanvas.TextExtent(Caption);
if (Layout in [blGlyphLeft, blGlyphRight]) and Assigned(FImageList) then
begin
aWidth:=ImgW + 4 + TextSize.cx;
aHeight:=Max(TextSize.cy + 8, ImgH);
end
else
begin
aWidth:=Max(8 + TextSize.cx, ImgW);
aHeight:=ImgH + TextSize.cy + 4;
end;
if aHeight < TToolPanel(Parent).BtnHeight then
aHeight:=TToolPanel(Parent).BtnHeight;
finally
if TmpCanvas<>Canvas then
FreeWorkingCanvas(tmpCanvas);
end;
end
else
begin
aWidth:=Max(ImgW, TToolPanel(Parent).BtnWidth);
aHeight:=Max(ImgH, TToolPanel(Parent).BtnHeight);;
end;
end;
// if IsDesignMode then
aTop:=TToolPanel(Parent).BorderWidth;
end;
inherited SetBounds(aLeft, aTop, aWidth, aHeight);
end;
destructor TToolbarButton.Destroy;
begin
if Assigned(FOwnerItem) then
begin
FOwnerItem.FButton:=nil;
FOwnerItem.Free;
end;
inherited Destroy;
end;
{ TToolbarItems }
function TToolbarItems.GetToolbarItem(Index: Integer): TToolbarItem;
begin
result := TToolbarItem( inherited Items[Index] );
end;
function TToolbarItems.GetByActionName(ActionName: string): TToolbarItem;
var
i:integer;
begin
Result:=nil;
for i:=0 to Count-1 do
if Assigned(Items[i].Action) and (Items[i].Action.Name = ActionName) then
begin
Result:=Items[i];
end;
end;
procedure TToolbarItems.SetToolbarItem(Index: Integer;
const AValue: TToolbarItem);
begin
Items[Index].Assign( AValue );
end;
constructor TToolbarItems.Create(ToolPanel: TToolPanel);
begin
inherited Create(ToolPanel, TToolbarItem);
FToolPanel:=ToolPanel;
end;
{ TToolPanel }
function TToolPanel.GetItems: TToolbarItems;
begin
Result:=FToolbarItems;
end;
function TToolPanel.GetBtnHeight: Integer;
begin
Result:=FDefButtonHeight;
end;
function TToolPanel.GetBtnWidth: Integer;
begin
Result:=FDefButtonWidth;
end;
function TToolPanel.GetPropertyStorage: TCustomPropertyStorage;
begin
Result:=FPropertyStorageLink.Storage;
end;
procedure TToolPanel.SetBtnHeight(const AValue: Integer);
var
i:integer;
begin
if FDefButtonHeight<>AValue then
begin
FDefButtonHeight:=AValue;
if csLoading in ComponentState then exit;
for i:=0 to FToolbarItems.Count - 1 do
FToolbarItems[i].FButton.UpdateSize;
end;
end;
procedure TToolPanel.SetBtnWidth(const AValue: Integer);
var
i:integer;
begin
if FDefButtonWidth<>AValue then
begin
FDefButtonWidth:=AValue;
if csLoading in ComponentState then exit;
for i:=0 to FToolbarItems.Count - 1 do
FToolbarItems[i].FButton.UpdateSize;
end;
end;
procedure TToolPanel.SetButtonAllign(const AValue: TToolButtonAllign);
var
i:integer;
begin
if FButtonAllign=AValue then exit;
FButtonAllign:=AValue;
if not (csLoading in ComponentState) then
for i:=0 to FToolbarItems.Count - 1 do
begin
// if Assigned(FToolbarItems[i]) then
// if Assigned(FToolbarItems[i].FButton) then
FToolbarItems[i].FButton.Align:=BtnAl2Align[AValue];
end;
end;
procedure TToolPanel.SetImageList(const AValue: TImageList);
var
i:integer;
begin
if FImageList=AValue then exit;
FImageList:=AValue;
for i:=0 to FToolbarItems.Count - 1 do
FToolbarItems[i].FButton.FImageList:=AValue;
ReAlignToolBtn;
end;
procedure TToolPanel.SetImageListSelected(const AValue: TImageList);
var
i:integer;
begin
if FImageListSelected=AValue then exit;
FImageListSelected:=AValue;
for i:=0 to FToolbarItems.Count - 1 do
FToolbarItems[i].FButton.FImageListSelected:=AValue;
end;
procedure TToolPanel.SetItems(const AValue: TToolbarItems);
begin
FToolbarItems.Assign(AValue);
end;
procedure TToolPanel.SetOptions(const AValue: TToolPanelOptions);
var
i:integer;
begin
if FOptions=AValue then exit;
FOptions:=AValue;
for i:=0 to FToolbarItems.Count - 1 do
begin
FToolbarItems[i].FButton.Transparent:=tpTransparentBtns in FOptions;
FToolbarItems[i].FButton.Flat:=tpFlatBtns in FOptions;
end;
Invalidate;
end;
procedure TToolPanel.SetPropertyStorage(const AValue: TCustomPropertyStorage);
begin
FPropertyStorageLink.Storage:=AValue;
end;
procedure TToolPanel.OnIniSave(Sender: TObject);
var
i:integer;
S, S1:string;
tpo:TToolPanelOptions;
tpo1:integer absolute tpo;
begin
S:=Owner.Name+'.'+Name;
FPropertyStorageLink.Storage.WriteInteger(S+sVersion, FVersion);
FPropertyStorageLink.Storage.WriteInteger(S+sShowHint, ord(ShowHint));
tpo:=FOptions;
FPropertyStorageLink.Storage.WriteString(S+sOptions, SetToString(GetPropInfo(Self, 'Options'), tpo1));
FPropertyStorageLink.Storage.WriteString(S+sToolBarStyle, GetEnumProp(Self, 'ToolBarStyle'));
FPropertyStorageLink.Storage.WriteString(S+sButtonAllign, GetEnumProp(Self, 'ButtonAllign'));
FPropertyStorageLink.Storage.WriteInteger(S+sCount, FToolbarItems.Count);
S:=S+sItem;
for i:=0 to FToolbarItems.Count-1 do
begin
S1:=S+IntToStr(i);
if Assigned(FToolbarItems[i].Action) then
begin
FPropertyStorageLink.Storage.WriteString(S1+sAction, FToolbarItems[i].Action.Name);
FPropertyStorageLink.Storage.WriteInteger(S1+sVisible, ord(FToolbarItems[i].Visible));
FPropertyStorageLink.Storage.WriteInteger(S1+sShowCaption, ord(FToolbarItems[i].ShowCaption));
FPropertyStorageLink.Storage.WriteInteger(S1+sTop, FToolbarItems[i].Top);
FPropertyStorageLink.Storage.WriteInteger(S1+sLeft, FToolbarItems[i].Left);
FPropertyStorageLink.Storage.WriteInteger(S1+sWidth, FToolbarItems[i].Width);
if FCustomizeShortCut and Assigned(FToolbarItems[i].Action) then
FPropertyStorageLink.Storage.WriteString(S1+sShortCut, ShortCutToText(TCustomAction(FToolbarItems[i].Action).ShortCut));
end;
end;
end;
procedure TToolPanel.OnIniLoad(Sender: TObject);
var
i, ACount:integer;
S, S1, AActionName, S2:string;
AItem:TToolbarItem;
tpo:TToolPanelOptions;
tpo1:integer absolute tpo;
begin
S:=Owner.Name+'.'+Name;
ACount:=FPropertyStorageLink.Storage.ReadInteger(S+sVersion, FVersion); //Check cfg version
if ACount = FVersion then
begin
ShowHint:=FPropertyStorageLink.Storage.ReadInteger(S+sShowHint, ord(ShowHint))<>0;
tpo:=FOptions;
tpo1:=StringToSet(GetPropInfo(Self, 'Options'), FPropertyStorageLink.Storage.ReadString(S+sOptions, SetToString(GetPropInfo(Self, 'Options'), tpo1)));
SetOptions(tpo);
SetEnumProp(Self, 'ToolBarStyle', FPropertyStorageLink.Storage.ReadString(S+sToolBarStyle, GetEnumProp(Self, 'ToolBarStyle')));
SetEnumProp(Self, 'ButtonAllign', FPropertyStorageLink.Storage.ReadString(S+sButtonAllign, GetEnumProp(Self, 'ButtonAllign')));
ACount:=FPropertyStorageLink.Storage.ReadInteger(S+sCount, 0);
S:=S+sItem;
for i:=0 to ACount-1 do
begin
S1:=S+IntToStr(i);
AActionName:=FPropertyStorageLink.Storage.ReadString(S1+sAction, '');
AItem:=FToolbarItems.ByActionName[AActionName];
if Assigned(AItem) then
begin
AItem.Top:=FPropertyStorageLink.Storage.ReadInteger(S1+sTop, AItem.Top);
AItem.Left:=FPropertyStorageLink.Storage.ReadInteger(S1+sLeft, AItem.Left);
AItem.Width:=FPropertyStorageLink.Storage.ReadInteger(S1+sWidth, AItem.Width);
AItem.Visible:=FPropertyStorageLink.Storage.ReadInteger(S1+sVisible, ord(AItem.Visible)) <> 0;
AItem.ShowCaption:=FPropertyStorageLink.Storage.ReadInteger(S1+sShowCaption, ord(AItem.ShowCaption)) <> 0;
if FCustomizeShortCut and Assigned(AItem.Action) then
begin
S2:=FPropertyStorageLink.Storage.ReadString(S1+sShortCut, ShortCutToText(TCustomAction(AItem.Action).ShortCut));
TCustomAction(AItem.Action).ShortCut:=TextToShortCut(S2);
end;
end;
end;
end;
Invalidate;
end;
procedure TToolPanel.SetToolBarStyle(const AValue: TToolBarStyle);
begin
if FToolBarStyle=AValue then exit;
FToolBarStyle:=AValue;
{
if FToolBarStyle = tbsNative then
BorderWidth:=1
else
BorderWidth:=4;
}
if FToolBarStyle = tbsWindowsXP then
begin
BorderWidth:=4;
SetOptions(FOptions + [tpFlatBtns]);
end
else
begin
BorderWidth:=1
end;
Invalidate;
end;
procedure TToolPanel.ReAlignToolBtn;
var
i, L:integer;
begin
L:=BorderWidth;
for i:=0 to FToolbarItems.Count - 1 do
begin
FToolbarItems[i].FButton.Left:=L;
FToolbarItems[i].FButton.UpdateSize;
L:=L + FToolbarItems[i].FButton.Width;
end;
end;
procedure TToolPanel.Notification(AComponent: TComponent; Operation: TOperation);
var
i:integer;
begin
inherited Notification(AComponent, Operation);
if Operation = opRemove then
begin
if AComponent = FImageList then
SetImageList(nil)
else
if AComponent = FImageListSelected then
SetImageListSelected(nil)
else
if AComponent is TPopupMenu then
begin
for i:=0 to FToolbarItems.Count - 1 do
if FToolbarItems[i].DropDownMenu = AComponent then
FToolbarItems[i].DropDownMenu:=nil;
end
else
if AComponent is TBasicAction then
begin
for i:=0 to FToolbarItems.Count - 1 do
if FToolbarItems[i].Action = AComponent then
FToolbarItems[i].Action:=nil;
end;
end;
end;
procedure TToolPanel.SetCustomizing(AValue: boolean);
var
i:integer;
begin
for i:=0 to FToolbarItems.Count - 1 do
FToolbarItems[i].FButton.SetDesign(AValue, FToolbarItems[i]);
end;
procedure TToolPanel.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
Y: Integer);
begin
inherited MouseUp(Button, Shift, X, Y);
if (Button = mbRight) and (ssCtrl in Shift) and (tpCustomizable in FOptions) then
Customize(HelpContext);
end;
procedure TToolPanel.RequestAlign;
{var
i, L:integer;}
begin
inherited RequestAlign;
if (Parent = nil) or (csDestroying in ComponentState) or (csLoading in ComponentState) {or (not Parent.HandleAllocated) }then
exit;
// if not Parent.HandleAllocated then exit;
// ReAlignToolBtn;}
end;
procedure TToolPanel.Loaded;
var
i, L:integer;
B:TToolbarItem;
begin
{ if csDesigning in ComponentState then
begin
for i:=0 to FToolbarItems.Count - 1 do
FToolbarItems[i].UpdateLeftAfterLoad;
end; }
inherited Loaded;
for i:=0 to FToolbarItems.Count - 1 do
begin
B:=FToolbarItems[i];
B.UpdateLeftAfterLoad;
B.FButton.Align:=BtnAl2Align[FButtonAllign];
end;
SetCustomizing(false);
//ReAlignToolBtn;
end;
constructor TToolPanel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FArrowBmp:=CreateArrowBitmap;
FCustomizeShortCut:=false;
AutoSize:=false;
FButtonAllign:=tbaLeft;
FToolbarItems:=TToolbarItems.Create(Self);
if Assigned(AOwner) and not (csLoading in AOwner.ComponentState) then
Align:=alTop;
Height:=DefButtonHeight;
FPropertyStorageLink:=TPropertyStorageLink.Create;
FPropertyStorageLink.OnSave:=@OnIniSave;
FPropertyStorageLink.OnLoad:=@OnIniLoad;
FDefButtonWidth:=DefButtonWidth;
FDefButtonHeight:=DefButtonHeight;
FToolBarStyle:=tbsStandart;
BorderWidth:=4;
ControlStyle:=ControlStyle - [csSetCaption] + [csAcceptsControls];
Caption:='';
end;
destructor TToolPanel.Destroy;
begin
if Assigned(FCustomizer) then
begin
TToolPanelSetupForm(FCustomizer).FToolPanel:=nil;
FreeAndNil(FCustomizer);
end;
FreeAndNil(FToolbarItems);
FreeAndNil(FPropertyStorageLink);
FreeAndNil(FArrowBmp);
inherited Destroy;
end;
procedure TToolPanel.Customize(HelpCtx: Longint);
begin
if not Assigned(FCustomizer) then
FCustomizer:=TToolPanelSetupForm.CreateSetupForm(Self);
FCustomizer.HelpContext:=HelpCtx;
FCustomizer.Show;
SetCustomizing(true);
end;
procedure TToolPanel.SetBounds(aLeft, aTop, aWidth, aHeight: integer);
begin
if not (csLoading in ComponentState) then
begin
if Assigned(FImageList) then
aHeight:=FImageList.Height+8 + Max(BorderWidth, 4) * 2
else
aHeight:=FDefButtonHeight + BorderWidth * 2;
end;
inherited SetBounds(aLeft, aTop, aWidth, aHeight);
end;
{ TToolbarItem }
procedure TToolbarItem.SetAction(const AValue: TBasicAction);
begin
if FButton.Action<>AValue then
begin
{ if Assigned(FButton.Action) then
FButton.Action.UnRegisterChanges(FActionLink);}
FButton.Action:=AValue;
if csLoading in TToolbarItems(Collection).FToolPanel.ComponentState then exit;
FButton.UpdateSize;
{ if Assigned(AValue) then
AValue.RegisterChanges(FActionLink);}
end;
end;
{procedure TToolbarItem.SetAutoSize(const AValue: boolean);
begin
if FButton.FAutoSize<>AValue then
FButton.SetAutoSize(AValue);
end;
}
procedure TToolbarItem.SetButtonStyle(const AValue: TToolbarButtonStyle);
begin
if FButton.FToolbarButtonStyle<>AValue then
begin
FButton.FToolbarButtonStyle:=AValue;
{ if AValue = tbrDropDown then
FButton.Enabled :=true;}
FButton.UpdateSize;
FButton.Invalidate;
end;
end;
procedure TToolbarItem.SetDropDownMenu(const AValue: TPopupMenu);
begin
if FButton.FDropDownMenu<>AValue then
begin
FButton.FDropDownMenu:=AValue;
FButton.Invalidate;
end;
end;
procedure TToolbarItem.SetGroupIndex(const AValue: Integer);
begin
FButton.GroupIndex:=AValue;
end;
procedure TToolbarItem.SetHeight(const AValue: Integer);
begin
FButton.Height:=AValue;
end;
procedure TToolbarItem.SetLayout(const AValue: TButtonLayout);
begin
FButton.Layout:=AValue;
FButton.UpdateSize;
end;
procedure TToolbarItem.SetLeft(const AValue: Integer);
begin
if csLoading in TToolbarItems(Collection).FToolPanel.ComponentState then
FSaveLeft:=AValue
else
FButton.Left:=AValue;
end;
procedure TToolbarItem.SetShowCaption(const AValue: boolean);
begin
if FButton.ShowCaption<>AValue then
begin
FButton.ShowCaption:=AValue;
if not (csLoading in TToolbarItems(Collection).FToolPanel.ComponentState) then
FButton.UpdateSize;
// FButton.Invalidate;
end;
end;
procedure TToolbarItem.SetTag(const AValue: Longint);
begin
FButton.Tag:=AValue;
end;
procedure TToolbarItem.SetTop(const AValue: Integer);
begin
FButton.Top:=AValue;
end;
function TToolbarItem.GetAction: TBasicAction;
begin
Result:=FButton.Action;
end;
{
function TToolbarItem.GetAutoSize: boolean;
begin
Result:=FButton.FAutoSize;
end;
}
function TToolbarItem.GetButtonStyle: TToolbarButtonStyle;
begin
Result:=FButton.FToolbarButtonStyle;
end;
function TToolbarItem.GetDropDownMenu: TPopupMenu;
begin
Result:=FButton.FDropDownMenu;
end;
function TToolbarItem.GetGroupIndex: Integer;
begin
Result:=FButton.GroupIndex;
end;
function TToolbarItem.GetHeight: Integer;
begin
Result:=FButton.Height;
end;
function TToolbarItem.GetLayout: TButtonLayout;
begin
Result:=FButton.Layout;
end;
function TToolbarItem.GetLeft: Integer;
begin
Result:=FButton.Left;
end;
function TToolbarItem.GetShowCaption: boolean;
begin
Result:=FButton.ShowCaption;
end;
function TToolbarItem.GetTag: Longint;
begin
Result:=FButton.Tag;
end;
function TToolbarItem.GetTop: Integer;
begin
Result:=FButton.Top;
end;
function TToolbarItem.GetVisible: boolean;
begin
Result:=FButton.Visible;
end;
function TToolbarItem.GetWidth: Integer;
begin
Result:=FButton.Width;
end;
procedure TToolbarItem.SetVisible(const AValue: boolean);
begin
if FButton.Visible<>AValue then
begin
FButton.Visible:=AValue;
FButton.Invalidate;
end;
end;
procedure TToolbarItem.SetWidth(const AValue: Integer);
begin
FButton.Width:=AValue;
end;
procedure TToolbarItem.UpdateLeftAfterLoad;
begin
FButton.Left:=FSaveLeft;
end;
function TToolbarItem.GetDisplayName: string;
begin
if ButtonStyle in [tbrSeparator, tbrDivider] then
begin
Result:='Separator'
end
else
if Assigned(Action) then
begin
if (Action is TCustomAction) then
Result:=TCustomAction(Action).Name + ' - ' +TCustomAction(Action).Caption
else
Result:=TCustomAction(Action).Name;
end
else
Result:=inherited GetDisplayName;
end;
constructor TToolbarItem.Create(ACollection: TCollection);
var
i, W:integer;
TB:TToolPanel;
begin
inherited Create(ACollection);
TB:=TToolbarItems(ACollection).FToolPanel;
FButton:=TToolbarButton.Create(TToolbarItems(ACollection).FToolPanel);
FButton.Align:=BtnAl2Align[TToolbarItems(ACollection).FToolPanel.ButtonAllign];
FButton.Parent:=TToolbarItems(ACollection).FToolPanel;
FButton.FImageList:=TToolbarItems(ACollection).FToolPanel.ImageList;
FButton.Flat:=tpFlatBtns in TToolbarItems(ACollection).FToolPanel.Options;
FButton.Transparent:=tpTransparentBtns in TToolbarItems(ACollection).FToolPanel.Options;
FButton.ShowCaption:=false;
FButton.AutoSize:=false;
FButton.FOwnerItem:=Self;
FButton.FFullPush:=true;
FButton.ParentColor:=true;
// if not (csLoading in TToolbarItems(ACollection).FToolPanel.ComponentState) then
// FButton.Align:=BtnAl2Align[TToolbarItems(ACollection).FToolPanel.ButtonAllign];
if (not (csLoading in TB.ComponentState)) and (csDesigning in TB.ComponentState) then
begin
if TToolbarItems(ACollection).FToolPanel.ButtonAllign = tbaLeft then
begin
W:=0;
for i:=0 to ACollection.Count - 1 do
begin
W:=Max(W, TToolbarItems(ACollection).Items[I].Width + TToolbarItems(ACollection).Items[I].Left);
end;
Left:=W+1;
end;
end;
end;
destructor TToolbarItem.Destroy;
begin
FButton.FOwnerItem:=nil;
FreeAndNil(FButton);
inherited Destroy;
end;
{ TToolbarButtonActionLink }
procedure TToolbarButtonActionLink.SetImageIndex(Value: Integer);
begin
FClient.Invalidate;
end;
function TToolbarButtonActionLink.IsImageIndexLinked: Boolean;
begin
Result:=true;
end;
procedure TToolbarButtonActionLink.SetEnabled(Value: Boolean);
begin
if (FClient as TToolbarButton).FToolbarButtonStyle = tbrDropDown then
FClient.Enabled:=true
else
inherited SetEnabled(Value);
end;
procedure TToolbarButtonActionLink.SetCaption(const Value: string);
begin
inherited SetCaption(Value);
(FClient as TToolbarButton).UpdateSize;
end;
initialization
//DebugLn('controls.pp - initialization');
RegisterPropertyToSkip(TToolbarButton, 'AutoSize', 'Old stile AutoSize in button', '');
RegisterPropertyToSkip(TToolbarItem, 'AutoSize', 'Old stile AutoSize in button', '');
RegisterPropertyToSkip(TToolPanel, 'AutoSize', 'Old stile AutoSize in button', '');
end.