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; // FActionLink:TActionLink; function GetAction: TBasicAction; function GetAutoSize: boolean; 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 OnActionChanges(Sender: TObject); procedure SetAction(const AValue: TBasicAction); procedure SetAutoSize(const AValue: boolean); 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 AutoSize:boolean read GetAutoSize write SetAutoSize default true; 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(TCollection) 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; 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 DoAutoSize; Override; 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); 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; 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 OnResize; property OnStartDrag; end; implementation uses Math, RxTBRSetup, LCLProc, vclutils, Dialogs, typinfo, rxdconst, GraphType; 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 FShowCaption 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, gdeDisabled); 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 FShowCaption 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 := clBtnText; 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; begin 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; 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 FShowCaption then begin TextSize:=Canvas.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; 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(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; 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; 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 FToolbarItems[i].FButton.Align:=BtnAl2Align[AValue]; 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; 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); 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; end; end; end; Invalidate; end; procedure TToolPanel.SetToolBarStyle(const AValue: TToolBarStyle); begin if FToolBarStyle=AValue then exit; FToolBarStyle:=AValue; if FToolBarStyle = tbsWindowsXP then SetOptions(FOptions + [tpFlatBtns]); 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.Align:=BtnAl2Align[FButtonAllign]; 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 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.DoAutoSize; var i, H:integer; begin if not AutoSizeCanStart then exit; if csDesigning in ComponentState then exit; if Items.Count > 0 then begin try H:=0; for i:=0 to Items.Count-1 do if Assigned(Items[i].FButton) and Items[i].FButton.HandleObjectShouldBeVisible then H:=Max(H, Items[i].Height); if H>0 then begin H:=H +BorderWidth * 2; SetBoundsKeepBase(Left,Top,Width,H,true); ReAlignToolBtn; end; finally end // Exclude(FControlFlags,cfAutoSizeNeeded); end else inherited DoAutoSize; 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; begin if csDesigning in ComponentState then begin for i:=0 to FToolbarItems.Count - 1 do FToolbarItems[i].UpdateLeftAfterLoad; end; inherited Loaded; end; constructor TToolPanel.Create(AOwner: TComponent); begin inherited Create(AOwner); FArrowBmp:=CreateArrowBitmap; AutoSize:=true; FToolbarItems:=TToolbarItems.Create(Self); Align:=alTop; Height:=DefButtonHeight; FPropertyStorageLink:=TPropertyStorageLink.Create; FPropertyStorageLink.OnSave:=@OnIniSave; FPropertyStorageLink.OnLoad:=@OnIniLoad; FDefButtonWidth:=DefButtonWidth; FDefButtonHeight:=DefButtonHeight; FToolBarStyle:=tbsStandart; BorderWidth:=4; ControlStyle:=ControlStyle - [csSetCaption]; 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; { 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; 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.FShowCaption<>AValue then begin FButton.FShowCaption:=AValue; 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.FShowCaption; 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; begin inherited Create(ACollection); 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.FShowCaption:=false; FButton.FAutoSize:=true; FButton.FOwnerItem:=Self; FButton.FFullPush:=true; // if not (csLoading in TToolbarItems(ACollection).FToolPanel.ComponentState) then // FButton.Align:=BtnAl2Align[TToolbarItems(ACollection).FToolPanel.ButtonAllign]; { 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; 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; end.