From e8feb4830b2ba111630985a351758aabf67b2a7f Mon Sep 17 00:00:00 2001 From: blikblum Date: Mon, 4 Jun 2012 00:49:51 +0000 Subject: [PATCH] * Implement add TSpkCheckbox and TSpkRadiobutton plus misc fixes. patch by Werner Pamler with some changes git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@2447 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../spktoolbar/SpkGUITools/SpkGUITools.pas | 87 ++- .../spktoolbar/SpkToolbar/SpkToolbar.pas | 52 +- .../spktoolbar/SpkToolbar/spkt_Buttons.pas | 136 ++++- .../spktoolbar/SpkToolbar/spkt_Checkboxes.pas | 514 ++++++++++++++++++ .../spktoolbar/SpkToolbar/spkt_Items.pas | 58 +- .../spktoolbar/SpkToolbar/spkt_Pane.pas | 4 +- components/spktoolbar/SpkToolbar/spkt_Tab.pas | 16 +- .../spktoolbar/SpkToolbar/spkt_Types.pas | 48 +- .../spktoolbar/designtime/SpkToolbar.lrs | 46 ++ .../designtime/SpkToolbarEditor.pas | 25 +- .../designtime/spkte_EditWindow.pas | 86 ++- 11 files changed, 1005 insertions(+), 67 deletions(-) create mode 100644 components/spktoolbar/SpkToolbar/spkt_Checkboxes.pas create mode 100644 components/spktoolbar/designtime/SpkToolbar.lrs diff --git a/components/spktoolbar/SpkGUITools/SpkGUITools.pas b/components/spktoolbar/SpkGUITools/SpkGUITools.pas index 81ea0f216..24ede9499 100644 --- a/components/spktoolbar/SpkGUITools/SpkGUITools.pas +++ b/components/spktoolbar/SpkGUITools/SpkGUITools.pas @@ -1,4 +1,4 @@ -unit SpkGuiTools; +unit SpkGUITools; {$mode ObjFpc} {$H+} @@ -12,7 +12,7 @@ interface {$MESSAGE HINT 'W tym module konsekwentnie ka¿dy rect opisuje dok³adny prostok¹t (a nie, jak w przypadku WINAPI - bez dolnej i prawej krawêdzi)'} uses - LCLType, Graphics, SysUtils, Classes, Controls, SpkGraphTools, SpkMath; + LCLType, Graphics, SysUtils, Classes, Controls, StdCtrls, SpkGraphTools, SpkMath; type TCornerPos = (cpLeftTop, cpRightTop, cpLeftBottom, cpRightBottom); @@ -20,6 +20,9 @@ type TBackgroundKind = (bkSolid, bkVerticalGradient, bkHorizontalGradient, bkConcave); + TSpkCheckboxStyle = (cbsCheckbox, cbsRadioButton); + TSpkCheckboxState = (cbsIdle, cbsHotTrack, cbsPressed, cbsDisabled); + TGUITools = class(TObject) protected class procedure FillGradientRectangle(ACanvas: TCanvas; Rect: T2DIntRect; ColorFrom: TColor; @@ -287,6 +290,19 @@ type Point : T2DIntVector; ClipRect : T2DIntRect); overload; inline; + // Checkbox + class procedure DrawCheckbox(ACanvas: TCanvas; + x,y: Integer; + AState: TCheckboxState; + ACheckboxState: TSpkCheckboxState; + AStyle: TSpkCheckboxStyle); overload; + class procedure DrawCheckbox(ACanvas: TCanvas; + x,y: Integer; + AState: TCheckboxState; + ACheckboxState: TSpkCheckboxState; + AStyle: TSpkCheckboxStyle; + ClipRect: T2DIntRect); overload; + // Text tools class procedure DrawText(ABitmap : TBitmap; x, y : integer; @@ -371,7 +387,7 @@ end; implementation uses - LCLIntf, IntfGraphics, Math; + LCLIntf, IntfGraphics, Math, Themes; { TSpkGUITools } @@ -1452,7 +1468,7 @@ if (ABitmap.width=0) or (ABitmap.height=0) then exit; {$IFDEF EnhancedRecordSupport} -// ród³owy rect... +// ?ród³owy rect... OrgCornerRect:=T2DIntRect.create(Point.x, Point.y, Point.x + radius - 1, @@ -1461,7 +1477,7 @@ OrgCornerRect:=T2DIntRect.create(Point.x, // ...przycinamy do rozmiarów bitmapy BitmapRect:=T2DIntRect.create(0, 0, ABitmap.width-1, ABitmap.height-1); {$ELSE} -// ród³owy rect... +// ?ród³owy rect... OrgCornerRect.create(Point.x, Point.y, Point.x + radius - 1, @@ -1551,7 +1567,7 @@ if (ABitmap.width=0) or (ABitmap.height=0) then exit; {$IFDEF EnhancedRecordSupport} -// ród³owy rect... +// ?ród³owy rect... OrgCornerRect:=T2DIntRect.create(Point.x, Point.y, Point.x + radius - 1, @@ -1560,7 +1576,7 @@ OrgCornerRect:=T2DIntRect.create(Point.x, // ...przycinamy do rozmiarów bitmapy BitmapRect:=T2DIntRect.create(0, 0, ABitmap.width-1, ABitmap.height-1); {$ELSE} -// ród³owy rect... +// ?ród³owy rect... OrgCornerRect.create(Point.x, Point.y, Point.x + radius - 1, @@ -1643,7 +1659,7 @@ if Radius<1 then exit; {$IFDEF EnhancedRecordSupport} -// ród³owy rect... +// ?ród³owy rect... CornerRect:=T2DIntRect.create(Point.x, Point.y, Point.x + radius - 1, @@ -1657,7 +1673,7 @@ case CornerPos of cpRightBottom: Center:=T2DIntVector.Create(Point.x, Point.y); end; {$ELSE} -// ród³owy rect... +// ?ród³owy rect... CornerRect.create(Point.x, Point.y, Point.x + radius - 1, @@ -2852,4 +2868,57 @@ ImageList.Draw(ACanvas, Point.x, Point.y, ImageIndex, false); RestoreDC(ACanvas.Handle, DcStackPos); end; +class procedure TGUITools.DrawCheckbox(ACanvas:TCanvas; x,y: Integer; + AState: TCheckboxState; ACheckboxState:TSpkCheckboxState; + AStyle: TSpkCheckboxStyle; ClipRect:T2DIntRect); +var + UseOrgClipRgn: Boolean; + OrgRgn: HRGN; + ClipRgn: HRGN; + te: TThemedElementDetails; + Rect: TRect; +begin + SaveClipRgn(ACanvas.Handle, UseOrgClipRgn, OrgRgn); + ClipRgn := CreateRectRgn(ClipRect.left, ClipRect.Top, ClipRect.Right+1, ClipRect.Bottom+1); + if UseOrgClipRgn then + CombineRgn(ClipRgn, ClipRgn, OrgRgn, RGN_AND); + SelectClipRgn(ACanvas.Handle, ClipRgn); + DrawCheckbox(ACanvas, x,y, AState, ACheckboxState, AStyle); + RestoreClipRgn(ACanvas.Handle, UseOrgClipRgn, OrgRgn); + DeleteObject(ClipRgn); +end; + +class procedure TGUITools.DrawCheckbox(ACanvas: TCanvas; x,y: Integer; + AState: TCheckboxState; ACheckboxState: TSpkCheckboxState; + AStyle:TSpkCheckboxStyle); +const + UNTHEMED_FLAGS: array [TSpkCheckboxStyle, TCheckboxState] of Integer = ( + (DFCS_BUTTONCHECK, DFCS_BUTTONCHECK or DFCS_CHECKED, DFCS_BUTTONCHECK or DFCS_BUTTON3STATE), + (DFCS_BUTTONRADIO, DFCS_BUTTONRADIO or DFCS_CHECKED, DFCS_BUTTONRADIO or DFCS_BUTTON3STATE) + ); + THEMED_FLAGS: array [TSpkCheckboxStyle, TCheckboxState, TSpkCheckboxState] of TThemedButton = ( + ( (tbCheckboxUncheckedNormal, tbCheckboxUncheckedHot, tbCheckboxUncheckedPressed, tbCheckboxUncheckedDisabled), + (tbCheckboxCheckedNormal, tbCheckboxCheckedHot, tbCheckboxCheckedPressed, tbCheckboxCheckedDisabled), + (tbCheckboxMixedNormal, tbCheckboxMixedHot, tbCheckboxMixedPressed, tbCheckboxMixedDisabled) + ), + ( (tbRadioButtonUncheckedNormal, tbRadioButtonUncheckedHot, tbRadioButtonUncheckedPressed, tbRadioButtonUncheckedDisabled), + (tbRadioButtonCheckedNormal, tbRadioButtonCheckedHot, tbRadioButtonCheckedPressed, tbRadioButtonCheckedDisabled), + (tbRadioButtonCheckedNormal, tbRadioButtonCheckedHot, tbRadioButtonCheckedPressed, tbRadioButtonCheckedDisabled) + ) + ); +var + R: TRect; + w: Integer; + te: TThemedElementDetails; +begin + w := GetSystemMetrics(SM_CYMENUCHECK); + R := Bounds(x, y, w, w); + if ThemeServices.ThemesEnabled then begin + te := ThemeServices.GetElementDetails(THEMED_FLAGS[AStyle, AState, ACheckboxState]); + ThemeServices.DrawElement(ACanvas.Handle, te, R); + end else + DrawFrameControl( + ACanvas.Handle, R, DFC_BUTTON, UNTHEMED_FLAGS[AStyle, AState]); +end; + end. diff --git a/components/spktoolbar/SpkToolbar/SpkToolbar.pas b/components/spktoolbar/SpkToolbar/SpkToolbar.pas index bc6529e3b..aedb23dae 100644 --- a/components/spktoolbar/SpkToolbar/SpkToolbar.pas +++ b/components/spktoolbar/SpkToolbar/SpkToolbar.pas @@ -13,6 +13,31 @@ unit SpkToolbar; * * *******************************************************************************) +{ +changes by Werner Pamler --> version 0.2 (c) 2012: +* add TSpkCheckbox and TSpkRadiobutton (unit spkt_Checkboxes.pas) +* apply ImageIndex when assigning an action +* add property editor for image index + - use specialized ImageIndexPropertyEditor to link to the imagelist + - assign default values to ImageIndex properties + - use types TImageIndex instead of integer +* make sure that properties (caption, imageindex etc) are updated when the + action changes +* Fixed button state to change immediately after mouse-up from pressed to hover +* Found bug in ComponentEditor form causing "Class not found" error: added tabs, + panes, or items were nameless. Assigning a name by FDesigner.UniqueName fixed + the issue. +* Duplicate components after Cut & Paste because missing destruction of + components after deletion from internal list +* Naming issue of components added by designer (counter starting at 2, not 1) fixed +* Change default color of the SpkToolbar to clSkyBlue +* add component icon +* Add events for OnClick (Tab), and OnTabChanging and OnTabChange (Toolbar) + +- Still open: units of the added controls are not added to uses clause automatically + Note: add some other component to form and the missing units are added! +} + interface uses @@ -115,6 +140,10 @@ type TSpkToolbar = class; /// metryk i bufora w momencie, gdy u¿ytkownik przebudowuje zawartoœæ /// komponentu. FUpdating jest sterowana przez u¿ytkownika. FUpdating : boolean; + + FOnTabChanging: TNotifyEvent; + FOnTabChanged: TNotifyEvent; + protected /// Instancja obiektu wygl¹du, przechowuj¹cego kolory i czcionki /// u¿ywane podczas renderowania komponentu @@ -313,7 +342,7 @@ type TSpkToolbar = class; property Tabs : TSpkTabs read FTabs; published /// Kolor t³a komponentu - property Color : TColor read GetColor write SetColor; + property Color : TColor read GetColor write SetColor default clSkyBlue; /// Obiekt zawieraj¹cy atrybuty wygl¹du toolbara property Appearance : TSpkToolbarAppearance read FAppearance write SetAppearance; /// Wysokoœæ toolbara (tylko do odczytu) @@ -328,6 +357,10 @@ type TSpkToolbar = class; property LargeImages : TImageList read FLargeImages write SetLargeImages; /// Lista du¿ych obrazków w stanie "disabled" property DisabledLargeImages : TImageList read FDisabledLargeImages write SetDisabledLargeImages; + + // Events called before and after a different tab is selected + property OnTabChanging: TNotifyEvent read FOnTabChanging write FOnTabChanging; + property OnTabChanged: TNotifyEvent read FOnTabChanged write FOnTabChanged; end; implementation @@ -463,6 +496,7 @@ begin FTabs.Appearance:=FAppearance; FTabIndex:=-1; + Color := clSkyBlue; end; procedure TSpkToolbar.DefineProperties(Filer: TFiler); @@ -807,6 +841,9 @@ var Tab : TSpkTab; begin inherited; + if Operation <> opRemove then + exit; + if AComponent is TSpkTab then begin FreeingTab(AComponent as TSpkTab); @@ -849,6 +886,8 @@ end; procedure TSpkToolbar.NotifyItemsChanged; begin + if Assigned(FOnTabChanging) then FOnTabChanging(self); + // Poprawianie TabIndex o ile zachodzi taka potrzeba if not(AtLeastOneTabVisible) then FTabIndex:=-1 else @@ -866,6 +905,8 @@ begin if not(FInternalUpdating or FUpdating) then Repaint; + + if Assigned(FOnTabChanged) then FOnTabChanged(self); end; procedure TSpkToolbar.NotifyVisualsChanged; @@ -968,6 +1009,8 @@ end; procedure TSpkToolbar.SetTabIndex(const Value: integer); begin + if Assigned(FOnTabChanging) then FOnTabChanging(self); + if not(AtLeastOneTabVisible) then FTabIndex:=-1 else begin @@ -984,6 +1027,8 @@ begin if not(FInternalUpdating or FUpdating) then Repaint; + + if Assigned(FOnTabChanged) then FOnTabChanged(self); end; procedure TSpkToolbar.TabMouseDown(Button: TMouseButton; Shift: TShiftState; X, @@ -1016,9 +1061,11 @@ if AtLeastOneTabVisible then // zmieñ zaznaczenie. if (Button = mbLeft) and (SelTab<>-1) and (SelTab<>FTabIndex) then begin + if Assigned(FOnTabChanging) then FOnTabChanging(self); FTabIndex:=SelTab; SetMetricsInvalid; Repaint; + if Assigned(FOnTabChanged) then FOnTabChanged(self); end; end; @@ -1076,6 +1123,9 @@ begin if FInternalUpdating or FUpdating then exit; +if (FTabIndex > -1) then + FTabs[FTabIndex].ExecOnClick; + // Zak³adki nie potrzebuj¹ obs³ugi MouseUp. end; diff --git a/components/spktoolbar/SpkToolbar/spkt_Buttons.pas b/components/spktoolbar/SpkToolbar/spkt_Buttons.pas index 91a923c9c..e1bbec200 100644 --- a/components/spktoolbar/SpkToolbar/spkt_Buttons.pas +++ b/components/spktoolbar/SpkToolbar/spkt_Buttons.pas @@ -17,8 +17,8 @@ interface uses Graphics, Classes, Controls, Menus, ActnList, Math, - Dialogs, - SpkGuiTools, SpkGraphTools, SpkMath, + Dialogs, ImgList, Forms, + SpkGUITools, SpkGraphTools, SpkMath, spkt_Const, spkt_BaseItem, spkt_Exceptions, spkt_Tools; type TSpkButtonState = (bsIdle, @@ -38,11 +38,13 @@ type TSpkBaseButton = class; function IsOnExecuteLinked: Boolean; override; procedure SetCaption(const Value: string); override; procedure SetEnabled(Value: Boolean); override; + procedure SetImageIndex(Value: integer); override; procedure SetVisible(Value: Boolean); override; procedure SetOnExecute(Value: TNotifyEvent); override; public function IsCaptionLinked: Boolean; override; function IsEnabledLinked: Boolean; override; + function IsImageIndexLinked: Boolean; override; function IsVisibleLinked: Boolean; override; end; @@ -74,7 +76,10 @@ type TSpkBaseButton = class; // *** Obs³uga akcji *** - procedure ActionChange(Sender : TObject); + procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); virtual; + procedure DoActionChange(Sender: TObject); + procedure Click; virtual; + function GetDefaultCaption: String; virtual; // *** Gettery i settery *** @@ -82,9 +87,13 @@ type TSpkBaseButton = class; procedure SetDropdownMenu(const Value : TPopupMenu); procedure SetRect(const Value: T2DIntRect); override; procedure SetCaption(const Value : string); - procedure SetAction(const Value : TBasicAction); + procedure SetAction(const Value : TBasicAction); virtual; procedure SetButtonKind(const Value : TSpkButtonKind); function GetAction: TBasicAction; + + property ButtonKind : TSpkButtonKind read FButtonKind write SetButtonKind; + property DropdownMenu : TPopupMenu read FDropdownMenu write SetDropdownMenu; + public constructor Create(AOwner : TComponent); override; @@ -94,9 +103,10 @@ type TSpkBaseButton = class; procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; + + function GetRootComponent: TComponent; + published - property ButtonKind : TSpkButtonKind read FButtonKind write SetButtonKind; - property DropdownMenu : TPopupMenu read FDropdownMenu write SetDropdownMenu; property Caption : string read FCaption write SetCaption; property Action : TBasicAction read GetAction write SetAction; property OnClick : TNotifyEvent read FOnClick write FOnClick; @@ -106,11 +116,11 @@ type TSpkLargeButton = class(TSpkBaseButton) private procedure FindBreakPlace(s : string; out Position : integer; out Width : integer); protected - FLargeImageIndex : integer; + FLargeImageIndex: TImageIndex; procedure CalcRects; override; function GetDropdownPoint : T2DIntPoint; override; - procedure SetLargeImageIndex(const Value: integer); + procedure SetLargeImageIndex(const Value: TImageIndex); public constructor Create(AOwner : TComponent); override; function GetWidth : integer; override; @@ -119,13 +129,15 @@ type TSpkLargeButton = class(TSpkBaseButton) function GetSize : TSpkItemSize; override; procedure Draw(ABuffer : TBitmap; ClipRect : T2DIntRect); override; published - property LargeImageIndex : integer read FLargeImageIndex write SetLargeImageIndex; + property LargeImageIndex: TImageIndex read FLargeImageIndex write SetLargeImageIndex default -1; + property ButtonKind; + property DropdownMenu; end; type TSpkSmallButton = class(TSpkBaseButton) private protected - FImageIndex : integer; + FImageIndex : TImageIndex; FTableBehaviour : TSpkItemTableBehaviour; FGroupBehaviour : TSPkItemGroupBehaviour; @@ -135,7 +147,7 @@ type TSpkSmallButton = class(TSpkBaseButton) procedure CalcRects; override; function GetDropdownPoint : T2DIntPoint; override; procedure ConstructRects(var BtnRect, DropRect : T2DIntRect); - procedure SetImageIndex(const Value : integer); + procedure SetImageIndex(const Value : TImageIndex); procedure SetGroupBehaviour(const Value: TSpkItemGroupBehaviour); procedure SetHideFrameWhenIdle(const Value: boolean); procedure SetTableBehaviour(const Value: TSpkItemTableBehaviour); @@ -153,13 +165,15 @@ type TSpkSmallButton = class(TSpkBaseButton) property TableBehaviour : TSpkItemTableBehaviour read FTableBehaviour write SetTableBehaviour; property GroupBehaviour : TSpkItemGroupBehaviour read FGroupBehaviour write SetGroupBehaviour; property HideFrameWhenIdle : boolean read FHideFrameWhenIdle write SetHideFrameWhenIdle; - property ImageIndex : integer read FImageIndex write SetImageIndex; + property ImageIndex : TImageIndex read FImageIndex write SetImageIndex default -1; + property ButtonKind; + property DropdownMenu; end; implementation uses - LCLType, LCLIntf; + LCLType, LCLIntf, LCLProc, SysUtils, spkt_Pane; { TSpkButtonActionLink } @@ -189,6 +203,18 @@ begin (@TSpkBaseButton(FClient).OnClick = @Action.OnExecute); end; +function TSpkButtonActionLink.IsImageIndexLinked: Boolean; +begin + Result := (inherited IsImageIndexLinked) and + ( + ((FClient is TSpkSmallButton) + and (TSpkSmallButton(FClient).ImageIndex = (Action as TCustomAction).ImageIndex)) + or + ((FClient is TSpkLargeButton) + and (TSpkLargeButton(FClient).LargeImageIndex = (Action as TCustomAction).ImageIndex)) + ); +end; + function TSpkButtonActionLink.IsVisibleLinked: Boolean; begin result:=(inherited IsVisibleLinked) and @@ -206,6 +232,16 @@ begin if IsEnabledLinked then FClient.Enabled := Value; end; +procedure TSpkButtonActionLink.SetImageIndex(Value: integer); +begin + if IsImageIndexLinked then begin + if (FClient is TSpkSmallButton) then + (TSpkSmallButton(FClient)).ImageIndex := Value; + if (FClient is TSpkLargeButton) then + (TSpkLargeButton(FClient)).LargeImageIndex := Value; + end; +end; + procedure TSpkButtonActionLink.SetOnExecute(Value: TNotifyEvent); begin if IsOnExecuteLinked then FClient.OnClick := Value; @@ -218,26 +254,34 @@ end; { TSpkBaseButton } -procedure TSpkBaseButton.ActionChange(Sender: TObject); +procedure TSpkBaseButton.ActionChange(Sender: TObject; CheckDefaults: Boolean); begin if Sender is TCustomAction then with TCustomAction(Sender) do begin - if (Self.Caption = '') or (Self.Caption = 'Button') then + if not CheckDefaults or (Self.Caption = '') or (Self.Caption = GetDefaultCaption) then Self.Caption := Caption; - if (Self.Enabled = True) then + if not CheckDefaults or (Self.Enabled = True) then Self.Enabled := Enabled; - if (Self.Visible = True) then + if not CheckDefaults or (Self.Visible = True) then Self.Visible := Visible; - if not Assigned(Self.OnClick) then + if not CheckDefaults or not Assigned(Self.OnClick) then Self.OnClick := OnExecute; + if self is TSpkSmallButton then begin + if not CheckDefaults or (TSpkSmallButton(self).ImageIndex < 0) then + TSpkSmallButton(self).ImageIndex := ImageIndex; + end; + if self is TSpkLargeButton then begin + if not CheckDefaults or (TSpkLargeButton(self).LargeImageIndex < 0) then + TSpkLargeButton(Self).LargeImageIndex := ImageIndex; + end; end; end; constructor TSpkBaseButton.Create(AOwner : TComponent); begin inherited Create(AOwner); - FCaption:='Button'; + FCaption:=GetDefaultCaption; FButtonState:=bsIdle; FButtonKind:=bkButton; {$IFDEF EnhancedRecordSupport} @@ -251,6 +295,17 @@ begin FMouseActiveElement:=beNone; end; +procedure TSpkBaseButton.Click; +begin + if Assigned(FOnClick) then + FOnClick(self) +end; + +procedure TSpkBaseButton.DoActionChange(Sender: TObject); +begin + if Sender = Action then ActionChange(Sender, False); +end; + function TSpkBaseButton.GetAction: TBasicAction; begin if assigned(FActionLink) then @@ -258,6 +313,29 @@ if assigned(FActionLink) then result:=nil; end; +function TSpkBaseButton.GetDefaultCaption: String; +begin + result := 'Button'; +end; + +function TSpkBaseButton.GetRootComponent: TComponent; +var + pane: TSpkBaseItem; + tab: TSpkBaseItem; +begin + result := nil; + if Collection <> nil then + pane := TSpkBaseItem(Collection.RootComponent) + else + exit; + if (pane <> nil) and (pane.Collection <> nil) then + tab := TSpkBaseItem(pane.Collection.RootComponent) + else + exit; + if (tab <> nil) and (tab.Collection <> nil) then + result := tab.Collection.RootComponent; +end; + procedure TSpkBaseButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin @@ -478,8 +556,10 @@ if FEnabled then begin if FButtonKind in [bkButton, bkButtonDropdown] then begin - if assigned(FOnClick) then - FOnClick(self) + Click; + FButtonState:=bsBtnHottrack; + if assigned(FToolbarDispatch) then + FToolbarDispatch.NotifyVisualsChanged; end else if FButtonKind = bkDropdown then begin @@ -487,6 +567,9 @@ if FEnabled then begin DropPoint:=FToolbarDispatch.ClientToScreen(GetDropdownPoint); FDropdownMenu.Popup(DropPoint.x, DropPoint.y); + FButtonState:=bsBtnHottrack; + if assigned(FToolbarDispatch) then + FToolbarDispatch.NotifyVisualsChanged; end; end; end; @@ -502,6 +585,9 @@ if FEnabled then begin DropPoint:=FToolbarDispatch.ClientToScreen(GetDropdownPoint); FDropdownMenu.Popup(DropPoint.x, DropPoint.y); + FButtonState:=bsBtnHottrack; + if assigned(FToolbarDispatch) then + FToolbarDispatch.NotifyVisualsChanged; end; end; end; @@ -571,8 +657,8 @@ begin if FActionLink = nil then FActionLink := TSpkButtonActionLink.Create(self); FActionLink.Action := Value; - FActionLink.OnChange := ActionChange; - ActionChange(Value); + FActionLink.OnChange := DoActionChange; + ActionChange(Value, csLoading in Value.ComponentState); end; end; @@ -1552,7 +1638,7 @@ else result:=max(LARGEBUTTON_MIN_WIDTH, max(GlyphWidth, TextWidth)); end; -procedure TSpkLargeButton.SetLargeImageIndex(const Value: integer); +procedure TSpkLargeButton.SetLargeImageIndex(const Value: TImageIndex); begin FLargeImageIndex:=Value; @@ -2151,7 +2237,7 @@ begin FToolbarDispatch.NotifyVisualsChanged; end; -procedure TSpkSmallButton.SetImageIndex(const Value: integer); +procedure TSpkSmallButton.SetImageIndex(const Value: TImageIndex); begin FImageIndex:=Value; diff --git a/components/spktoolbar/SpkToolbar/spkt_Checkboxes.pas b/components/spktoolbar/SpkToolbar/spkt_Checkboxes.pas new file mode 100644 index 000000000..a338d93cc --- /dev/null +++ b/components/spktoolbar/SpkToolbar/spkt_Checkboxes.pas @@ -0,0 +1,514 @@ +unit spkt_Checkboxes; + +{$mode objfpc}{$H+} + +interface + +uses + Graphics, Classes, SysUtils, Controls, StdCtrls, ActnList, + SpkMath, SpkGUITools, spkt_BaseItem, spkt_Buttons; + +type + TSpkCustomCheckbox = class; + + TSpkCheckboxActionLink = class(TSpkButtonActionLink) + private + protected + procedure SetChecked(Value: Boolean); override; + public + function IsCheckedLinked: Boolean; override; + end; + + TSpkCustomCheckBox = class(TSPkBaseButton) + private + FState: TCheckboxState; // unchecked, checked, grayed + FCheckboxState: TSpkCheckboxState; // incl Hot, Pressed, Disabled + FHideFrameWhenIdle : boolean; + FTableBehaviour : TSpkItemTableBehaviour; + FGroupBehaviour : TSPkItemGroupBehaviour; + FCheckboxStyle: TSpkCheckboxStyle; + function GetChecked: Boolean; + procedure SetChecked(AValue: Boolean); + procedure SetGroupBehaviour(const Value: TSpkItemGroupBehaviour); + procedure SetTableBehaviour(const Value: TSpkItemTableBehaviour); + protected + procedure ActionChange(Sender : TObject); + procedure BtnStateToCheckboxState; + procedure CalcRects; override; + procedure Click; override; + procedure ConstructRect(var BtnRect: T2DIntRect); + function GetDefaultCaption: String; override; + procedure SetAction(const AValue: TBasicAction); override; + procedure SetEnabled(const AValue: Boolean); override; + procedure SetState(AValue: TCheckboxState); virtual; + public + constructor Create(AOwner: TComponent); override; + procedure Draw(ABuffer: TBitmap; ClipRect: T2DIntRect); override; + function GetGroupBehaviour : TSpkItemGroupBehaviour; override; + function GetSize: TSpkItemSize; override; + function GetTableBehaviour : TSpkItemTableBehaviour; override; + function GetWidth : integer; override; + procedure MouseLeave; override; + 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; + published + property Checked: Boolean read GetChecked write SetChecked; + property State: TCheckboxState read FState write SetState; + property TableBehaviour : TSpkItemTableBehaviour read FTableBehaviour write SetTableBehaviour; + property GroupBehaviour : TSpkItemGroupBehaviour read FGroupBehaviour write SetGroupBehaviour; + end; + + TSpkCheckbox = class(TSpkCustomCheckbox) + public + constructor Create(AOwner: TComponent); override; + end; + + TSpkRadioButton = class(TSpkCustomCheckbox) + protected + function GetDefaultCaption: String; override; + procedure SetState(AValue: TCheckboxState); override; + procedure UncheckSiblings; + public + constructor Create(AOwner: TComponent); override; + end; + + +implementation + +uses + LCLType, LCLIntf, Math, + SpkGraphTools, spkt_Const, spkt_Tools, spkt_Pane; + + +{ TSpkCheckboxActionLink } + +function TSpkCheckboxActionLink.IsCheckedLinked: Boolean; +var + cb: TSpkCustomCheckbox; +begin + cb := FClient as TSpkCustomCheckbox; + result := (inherited IsCheckedLinked) and + Assigned(cb) and (cb.Checked = (Action as TCustomAction).Checked); +end; + +procedure TSpkCheckboxActionLink.SetChecked(Value: Boolean); +var + cb: TSpkCustomCheckbox; +begin + if IsCheckedLinked then begin + cb := TSpkCustomCheckbox(FClient); + cb.Checked := Value; + end; +end; + + +{ TSpkCustomCheckbox } + +constructor TSpkCustomCheckbox.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + FHideFrameWhenIdle := true; + FTableBehaviour := tbContinuesRow; + FGroupBehaviour := gbSingleItem; + FCheckboxStyle := cbsCheckbox; + FState := cbUnchecked; +end; + +procedure TSpkCustomCheckbox.ActionChange(Sender: TObject); +begin + if Sender is TCustomAction then + with TCustomAction(Sender) do begin + if (Self.Caption = '') or (Self.Caption = GetDefaultCaption) then + Self.Caption := Caption; + if (Self.Enabled = True) then + Self.Enabled := Enabled; + if (Self.Visible = True) then + Self.Visible := Visible; + if not Assigned(Self.OnClick) then + Self.OnClick := OnExecute; + if (Self.Checked = false) then + Self.Checked := Checked; + end; +end; + +procedure TSpkCustomCheckbox.BtnStateToCheckboxState; +begin + if FEnabled then + case FButtonState of + bsIdle : FCheckboxState := cbsIdle; + bsBtnHotTrack : FCheckboxState := cbsHotTrack; + bsBtnPressed : FCheckboxState := cbsPressed; + end + else + FCheckboxState := cbsDisabled; +end; + +procedure TSpkCustomCheckbox.CalcRects; +var + RectVector : T2DIntVector; +begin + ConstructRect(FButtonRect); + {$IFDEF EnhancedRecordSupport} + FDropdownRect := T2DIntRect.Create(0, 0, 0, 0); + RectVector := T2DIntVector.Create(FRect.Left, FRect.Top); + {$ELSE} + FDropdownRect.Create(0, 0, 0, 0); + RectVector.Create(FRect.Left, FRect.Top); + {$ENDIF} + FButtonRect := FButtonRect + RectVector; +end; + +procedure TSpkCustomCheckbox.Click; +begin + if Enabled then begin + case FState of + cbGrayed : Checked := true; + cbChecked : Checked := false; + cbUnchecked : Checked := true; + end; + if not (csDesigning in ComponentState) and (FActionLink <> nil) then + FActionLink.Execute(Self) + else + if Assigned(FOnClick) and ((Action = nil) or (FOnClick <> Action.OnExecute)) then + FOnClick(Self); + end; +end; + +procedure TSpkCustomCheckbox.ConstructRect(var BtnRect: T2DIntRect); +var + BtnWidth : integer; + Bitmap : TBitmap; + TextWidth: Integer; +begin + {$IFDEF EnhancedRecordSupport} + BtnRect:=T2DIntRect.Create(0, 0, 0, 0); + {$ELSE} + BtnRect.Create(0, 0, 0, 0); + {$ENDIF} + + if not(Assigned(FToolbarDispatch)) then + exit; + if not(Assigned(FAppearance)) then + exit; + + Bitmap := FToolbarDispatch.GetTempBitmap; + if not(assigned(Bitmap)) then + exit; + + Bitmap.Canvas.Font.Assign(FAppearance.Element.CaptionFont); + TextWidth := Bitmap.Canvas.TextWidth(FCaption); + + BtnWidth := SMALLBUTTON_PADDING + SMALLBUTTON_GLYPH_WIDTH + + SMALLBUTTON_PADDING + TextWidth + SMALLBUTTON_PADDING; + BtnWidth := Max(SMALLBUTTON_MIN_WIDTH, BtnWidth); + + if FGroupBehaviour in [gbContinuesGroup, gbEndsGroup] then + BtnWidth := BtnWidth + SMALLBUTTON_HALF_BORDER_WIDTH + else + BtnWidth := BtnWidth + SMALLBUTTON_BORDER_WIDTH; + + // Prawa krawêdŸ przycisku + if (FGroupBehaviour in [gbBeginsGroup, gbContinuesGroup]) then + BtnWidth := BtnWidth + SMALLBUTTON_HALF_BORDER_WIDTH + else + BtnWidth := BtnWidth + SMALLBUTTON_BORDER_WIDTH; + + {$IFDEF EnhancedRecordSupport} + BtnRect := T2DIntRect.Create(0, 0, BtnWidth - 1, PANE_ROW_HEIGHT - 1); + {$ELSE} + BtnRect.Create(0, 0, BtnWidth - 1, PANE_ROW_HEIGHT - 1); + {$ENDIF} +end; + +procedure TSpkCustomCheckbox.Draw(ABuffer: TBitmap; ClipRect: T2DIntRect); +var + FontColor: TColor; + x, y: Integer; + h: Integer; +begin + if FToolbarDispatch = nil then + exit; + if FAppearance = nil then + exit; + if (FRect.Width < 2*LARGEBUTTON_RADIUS) or (FRect.Height < 2*LARGEBUTTON_RADIUS) then + exit; + + // Border + if (FButtonState = bsIdle) and (not(FHideFrameWhenIdle)) then begin + with FAppearance.Element do + TButtonTools.DrawButton( + ABuffer, + FButtonRect, + IdleFrameColor, + IdleInnerLightColor, + IdleInnerDarkColor, + IdleGradientFromColor, + IdleGradientToColor, + IdleGradientType, + (FGroupBehaviour in [gbContinuesGroup, gbEndsGroup]), + (FGroupBehaviour in [gbBeginsGroup, gbContinuesGroup]) or (FButtonKind = bkButtonDropdown), + false, + false, + SMALLBUTTON_RADIUS, + ClipRect + ); + end else + if (FButtonState=bsBtnHottrack) then begin + with FAppearance.Element do + TButtonTools.DrawButton( + ABuffer, + FButtonRect, + HotTrackFrameColor, + HotTrackInnerLightColor, + HotTrackInnerDarkColor, + HotTrackGradientFromColor, + HotTrackGradientToColor, + HotTrackGradientType, + (FGroupBehaviour in [gbContinuesGroup, gbEndsGroup]), + (FGroupBehaviour in [gbBeginsGroup, gbContinuesGroup]) or (FButtonKind = bkButtonDropdown), + false, + false, + SMALLBUTTON_RADIUS, + ClipRect + ); + end else + if (FButtonState = bsBtnPressed) then begin + with FAppearance.Element do + TButtonTools.DrawButton( + ABuffer, + FButtonRect, + ActiveFrameColor, + ActiveInnerLightColor, + ActiveInnerDarkColor, + ActiveGradientFromColor, + ActiveGradientToColor, + ActiveGradientType, + (FGroupBehaviour in [gbContinuesGroup, gbEndsGroup]), + (FGroupBehaviour in [gbBeginsGroup, gbContinuesGroup]) or (FButtonKind = bkButtonDropdown), + false, + false, + SMALLBUTTON_RADIUS, + ClipRect + ); + end; + + // Checkbox + h := GetSystemMetrics(SM_CYMENUCHECK); + if (FGroupBehaviour in [gbContinuesGroup, gbEndsGroup]) then + x := FButtonRect.Left + SMALLBUTTON_HALF_BORDER_WIDTH + SMALLBUTTON_PADDING + else + x := FButtonRect.Left + SMALLBUTTON_BORDER_WIDTH + SMALLBUTTON_PADDING; + y := FButtonRect.top + (FButtonRect.height - h) div 2; + + TGUITools.DrawCheckbox( + ABuffer.Canvas, + x,y, + FState, + FCheckboxState, + FCheckboxStyle, + ClipRect + ); + + // Text + ABuffer.Canvas.Font.Assign(FAppearance.Element.CaptionFont); + + FontColor := clNone; + if not(FEnabled) then + case FButtonState of + bsIdle : FontColor := TColorTools.ColorToGrayscale(FAppearance.Element.IdleCaptionColor); + bsBtnHottrack, + bsDropdownHottrack : FontColor := TColorTools.ColorToGrayscale(FAppearance.Element.HotTrackCaptionColor); + bsBtnPressed, + bsDropdownPressed : FontColor := TColorTools.ColorToGrayscale(FAppearance.ELement.ActiveCaptionColor); + end + else + case FButtonState of + bsIdle : FontColor := FAppearance.Element.IdleCaptionColor; + bsBtnHottrack, + bsDropdownHottrack : FontColor := FAppearance.Element.HotTrackCaptionColor; + bsBtnPressed, + bsDropdownPressed : FontColor := FAppearance.ELement.ActiveCaptionColor; + end; + + if (FGroupBehaviour in [gbContinuesGroup, gbEndsGroup]) then + x := FButtonRect.Left + SMALLBUTTON_HALF_BORDER_WIDTH + else + x := FButtonRect.Left + SMALLBUTTON_BORDER_WIDTH; + x := x + 2 * SMALLBUTTON_PADDING + SMALLBUTTON_GLYPH_WIDTH; + y := FButtonRect.Top + (FButtonRect.Height - ABuffer.Canvas.TextHeight('Wy')) div 2; + + TGUITools.DrawText( + ABuffer.Canvas, + x, + y, + FCaption, + FontColor, + ClipRect + ); +end; + +function TSpkCustomCheckbox.GetChecked: Boolean; +begin + result := (FState = cbChecked); +end; + +function TSpkCustomCheckbox.GetDefaultCaption: String; +begin + result := 'Checkbox'; +end; + +function TSpkCustomCheckbox.GetGroupBehaviour: TSpkItemGroupBehaviour; +begin + result := FGroupBehaviour; +end; + +function TSpkCustomCheckbox.GetSize: TSpkItemSize; +begin + result := isNormal; +end; + +function TSpkCustomCheckbox.GetTableBehaviour: TSpkItemTableBehaviour; +begin + result := FTableBehaviour; +end; + +function TSpkCustomCheckbox.GetWidth: integer; +var + BtnRect, DropRect : T2DIntRect; +begin + result := -1; + if FToolbarDispatch = nil then + exit; + if FAppearance = nil then + exit; + ConstructRect(BtnRect); + result := BtnRect.Right + 1; +end; + +procedure TSpkCustomCheckbox.MouseDown(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); +begin + inherited; + BtnStateToCheckboxState; +end; + +procedure TSpkCustomCheckbox.MouseLeave; +begin + inherited MouseLeave; + if FEnabled then + FCheckboxState := cbsIdle + else + FCheckboxState := cbsDisabled; +end; + +procedure TSpkCustomCheckbox.MouseMove(Shift: TShiftState; X, Y: Integer); +begin + inherited MouseMove(Shift, X, Y); + BtnStateToCheckboxState; +end; + +procedure TSpkCustomCheckbox.MouseUp(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); +begin + inherited MouseUp(Button, Shift, X, Y); + BtnStateToCheckboxState; +end; + +procedure TSpkCustomCheckbox.SetAction(const AValue: TBasicAction); +begin + if AValue = nil then begin + FActionLink.Free; + FActionLink := nil; + end else begin + if FActionLink = nil then + FActionLink := TSpkCheckboxActionLink.Create(self); + FActionLink.Action := AValue; + FActionLink.OnChange := @ActionChange; + ActionChange(AValue); + end; +end; + +procedure TSpkCustomCheckbox.SetChecked(AValue: Boolean); +begin + if AValue then + SetState(cbChecked) + else + SetState(cbUnchecked); +end; + +procedure TSpkCustomCheckbox.SetEnabled(const AValue: Boolean); +begin + inherited SetEnabled(AValue); + BtnStateToCheckboxState; +end; + +procedure TSpkCustomCheckbox.SetGroupBehaviour(const Value: TSpkItemGroupBehaviour); +begin + FGroupBehaviour := Value; + if Assigned(FToolbarDispatch) then + FToolbarDispatch.NotifyMetricsChanged; +end; + +procedure TSpkCustomCheckbox.SetState(AValue:TCheckboxState); +begin + if AValue <> FState then begin + FState := AValue; + if Assigned(FToolbarDispatch) then + FToolbarDispatch.NotifyVisualsChanged; + end; +end; + +procedure TSpkCustomCheckbox.SetTableBehaviour(const Value: TSpkItemTableBehaviour); +begin + FTableBehaviour := Value; + if Assigned(FToolbarDispatch) then + FToolbarDispatch.NotifyMetricsChanged; +end; + + +{ TSpkCheckbox } + +constructor TSpkCheckbox.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + FCheckboxStyle := cbsCheckbox; +end; + + +{ TSpkRadioButton } +constructor TSpkRadioButton.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + FCheckboxStyle := cbsRadioButton; +end; + +function TSpkRadioButton.GetDefaultCaption: string; +begin + result := 'RadioButton'; +end; + +procedure TSpkRadioButton.SetState(AValue: TCheckboxState); +begin + inherited SetState(AValue); + if (AValue = cbChecked) then + UncheckSiblings; +end; + +procedure TSpkRadioButton.UncheckSiblings; +var + i: Integer; + pane: TSpkPane; +begin + if (Parent is TSpkPane) then begin + pane := TSpkPane(Parent); + for i:=0 to pane.Items.Count-1 do + if (pane.items[i] is TSpkRadioButton) and (pane.items[i] <> self) then + TSpkRadioButton(pane.items[i]).State := cbUnchecked; + end; +end; + +end. + diff --git a/components/spktoolbar/SpkToolbar/spkt_Items.pas b/components/spktoolbar/SpkToolbar/spkt_Items.pas index eddc62962..c0647250d 100644 --- a/components/spktoolbar/SpkToolbar/spkt_Items.pas +++ b/components/spktoolbar/SpkToolbar/spkt_Items.pas @@ -17,7 +17,7 @@ interface uses Classes, Controls, SysUtils, Dialogs, spkt_Appearance, spkt_Dispatch, spkt_BaseItem, spkt_Types, - spkt_Buttons; + spkt_Buttons, spkt_Checkboxes; type TSpkItems = class(TSpkCollection) private @@ -43,6 +43,8 @@ type TSpkItems = class(TSpkCollection) function AddLargeButton : TSpkLargeButton; function AddSmallButton : TSpkSmallButton; + function AddCheckbox: TSpkCheckbox; + function AddRadioButton: TSpkRadioButton; // *** Reakcja na zmiany listy *** procedure Notify(Item: TComponent; Operation : TOperation); override; @@ -83,7 +85,7 @@ result.Parent:=Parent; if FRootComponent<>nil then begin - i:=1; + i:=0; while FRootComponent.Owner.FindComponent('SpkLargeButton'+inttostr(i))<>nil do inc(i); @@ -115,7 +117,7 @@ result.Parent:=Parent; if FRootComponent<>nil then begin - i:=1; + i:=0; while FRootComponent.Owner.FindComponent('SpkSmallButton'+inttostr(i))<>nil do inc(i); @@ -125,6 +127,56 @@ if FRootComponent<>nil then AddItem(result); end; +function TSpkItems.AddCheckbox: TSpkCheckbox; +var + Owner, Parent : TComponent; + i: Integer; +begin + if FRootComponent <> nil then begin + Owner := FRootComponent.Owner; + Parent := FRootComponent; + end else begin + Owner := nil; + Parent := nil; + end; + result := TSpkCheckbox.Create(Owner); + result.Parent := Parent; + + if FRootComponent <> nil then begin + i := 0; + while FRootComponent.Owner.FindComponent('SpkCheckbox'+IntToStr(i)) <> nil do + inc(i); + result.Name := 'SpkCheckbox' + IntToStr(i); + end; + + AddItem(result); +end; + +function TSpkItems.AddRadioButton: TSpkRadioButton; +var + Owner, Parent : TComponent; + i: Integer; +begin + if FRootComponent <> nil then begin + Owner := FRootComponent.Owner; + Parent := FRootComponent; + end else begin + Owner := nil; + Parent := nil; + end; + result := TSpkRadioButton.Create(Owner); + result.Parent := Parent; + + if FRootComponent <> nil then begin + i := 0; + while FRootComponent.Owner.FindComponent('SpkRadioButton'+IntToStr(i)) <> nil do + inc(i); + result.Name := 'SpkRadioButton' + IntToStr(i); + end; + + AddItem(result); +end; + constructor TSpkItems.Create(RootComponent : TComponent); begin inherited Create(RootComponent); diff --git a/components/spktoolbar/SpkToolbar/spkt_Pane.pas b/components/spktoolbar/SpkToolbar/spkt_Pane.pas index 5616e867d..4f9285fc8 100644 --- a/components/spktoolbar/SpkToolbar/spkt_Pane.pas +++ b/components/spktoolbar/SpkToolbar/spkt_Pane.pas @@ -929,7 +929,7 @@ result.Parent:=Parent; if FRootComponent<>nil then begin - i:=1; + i:=0; while FRootComponent.Owner.FindComponent('SpkPane'+inttostr(i))<>nil do inc(i); @@ -985,7 +985,7 @@ result.Parent:=Parent; if FRootComponent<>nil then begin - i:=1; + i:=0; while FRootComponent.Owner.FindComponent('SpkPane'+inttostr(i))<>nil do inc(i); diff --git a/components/spktoolbar/SpkToolbar/spkt_Tab.pas b/components/spktoolbar/SpkToolbar/spkt_Tab.pas index d510540d6..1b02cf14c 100644 --- a/components/spktoolbar/SpkToolbar/spkt_Tab.pas +++ b/components/spktoolbar/SpkToolbar/spkt_Tab.pas @@ -48,6 +48,9 @@ type TSpkTab = class; FMouseHoverElement : TSpkMouseTabElement; FMouseActiveElement : TSpkMouseTabElement; + + FOnClick: TNotifyEvent; + protected FToolbarDispatch : TSpkBaseToolbarDispatch; FCaption : string; @@ -109,6 +112,8 @@ type TSpkTab = class; // *** Obs³uga elementów *** procedure FreeingPane(APane : TSpkPane); + procedure ExecOnClick; + property ToolbarDispatch : TSpkBaseToolbarDispatch read FToolbarDispatch write SetToolbarDispatch; property Appearance : TSpkToolbarAppearance read FAppearance write SetAppearance; @@ -123,6 +128,7 @@ type TSpkTab = class; property Caption : string read FCaption write SetCaption; property OverrideAppearance : boolean read FOverrideAppearance write SetOverrideAppearance; property Visible : boolean read FVisible write SetVisible; + property OnClick: TNotifyEvent read FOnClick write FOnClick; end; type TSpkTabs = class(TSpkCollection) @@ -301,6 +307,12 @@ if AtLeastOnePaneVisible then end; end; +procedure TSpkTab.ExecOnClick; +begin + if Assigned(FOnClick) then + FOnClick(self); +end; + function TSpkTab.FindPaneAt(x, y: integer): integer; var i : integer; @@ -625,7 +637,7 @@ result.Parent:=Parent; if FRootComponent<>nil then begin - i:=1; + i:=0; while FRootComponent.Owner.FindComponent('SpkTab'+inttostr(i))<>nil do inc(i); @@ -681,7 +693,7 @@ result.Parent:=Parent; if FRootComponent<>nil then begin - i:=1; + i:=0; while FRootComponent.Owner.FindComponent('SpkTab'+inttostr(i))<>nil do inc(i); diff --git a/components/spktoolbar/SpkToolbar/spkt_Types.pas b/components/spktoolbar/SpkToolbar/spkt_Types.pas index 34f45399e..137763d72 100644 --- a/components/spktoolbar/SpkToolbar/spkt_Types.pas +++ b/components/spktoolbar/SpkToolbar/spkt_Types.pas @@ -19,26 +19,6 @@ uses Controls, Classes, ContNrs, SysUtils, Dialogs, type TSpkListState = (lsNeedsProcessing, lsReady); -type TSpkComponent = class(TComponent) - private - protected - FParent : TComponent; - - // *** Gettery i settery *** - function GetParent: TComponent; - procedure SetParent(const Value: TComponent); - public - // *** Konstruktor *** - constructor Create(AOwner : TComponent); override; - - // *** Obs³uga parenta *** - function HasParent : boolean; override; - function GetParentComponent : TComponent; override; - procedure SetParentComponent(Value : TComponent); override; - - property Parent : TComponent read GetParent write SetParent; - end; - type TSpkCollection = class(TPersistent) private protected @@ -79,6 +59,29 @@ type TSpkCollection = class(TPersistent) property ListState : TSpkListState read FListState; property Items[index : integer] : TComponent read GetItems; default; + property RootComponent: TComponent read FRootComponent; + end; + +type TSpkComponent = class(TComponent) + private + protected + FParent : TComponent; + FCollection: TSpkCollection; + + // *** Gettery i settery *** + function GetParent: TComponent; + procedure SetParent(const Value: TComponent); + public + // *** Konstruktor *** + constructor Create(AOwner : TComponent); override; + + // *** Obs³uga parenta *** + function HasParent : boolean; override; + function GetParentComponent : TComponent; override; + procedure SetParentComponent(Value : TComponent); override; + + property Parent : TComponent read GetParent write SetParent; + property Collection: TSpkCollection read FCollection; end; implementation @@ -93,6 +96,9 @@ begin Notify(AItem, opInsert); FList.Add(AItem); +if AItem is TSpkComponent then + TSpkComponent(AItem).FCollection := self; + Update; end; @@ -166,6 +172,8 @@ if (index<0) or (index>FList.Count) then Notify(AItem, opInsert); FList.Insert(index, AItem); +if AItem is TSpkComponent then + TSpkComponent(AItem).FCollection := self; Update; end; diff --git a/components/spktoolbar/designtime/SpkToolbar.lrs b/components/spktoolbar/designtime/SpkToolbar.lrs new file mode 100644 index 000000000..1d60ef387 --- /dev/null +++ b/components/spktoolbar/designtime/SpkToolbar.lrs @@ -0,0 +1,46 @@ +LazarusResources.Add('TSpkToolbar','PNG',[ + #137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0#24#0#0#0#24#8#6#0#0#0#224'w='#248#0 + +#0#0#9'pHYs'#0#0#11#19#0#0#11#19#1#0#154#156#24#0#0#3#219'IDATH'#199#181#149 + +'Kh\U'#24#199#127#231#190#239#220#206'L'#6#146'&'#230'Q'#139#212'$5bDj'#165#8 + +'nt'#227#3'|'#128#221#9#238#173#27'W'#226#162#130'T'#9#149'n$'#11'w'#214#130 + +'"'#136#129#174'E(n'#130#10'jj'#147#182'&'#26#161'M'#155#201'8'#175'Lf'#238 + +#157#251'8'#199#197'$3I3i'#210#133#223#238#156#239#241'?'#223#255'{'#28#177 + +'RX?9'#191#156#127'kf'#182't'#134#3#200#235#167'r'#211'{*'#21#168'mG'#203#212 + +#251#141'&'#246#216#204'l'#233#204'{oN'#208#227#25#247#13'~'#246#226#28'E'#14 + +#239#253#16'q'#207'9'#134'vD'#165' '#145#138'r'#161#194'b)b(cRmD'#164'R6G'#7 + +'2'#187#157#129#229#229#21'\'#207#163#176'Z'#161'o8G'#181'Xg'#244#209#193#29 + +#166'm'#128'D*'#146'D'#209'h'#132'X'#182#197#221#226#6#249#213#10'%e2'#212 + +#151'F'#235#2#176'^'#221#160'\'#174#179#209'TX5'#31')'#229'.'#155'6'#128#148 + +#138'D*'#250#6'{'#233#3' '#3'c'#131#155#217')'#18#181#27'`'#242#201#177'}kf' + +#156#255#250#247'K'#0#186#6'A'#148#236#235#240#227#236'M'#30'D'#12#128#143 + +#222#158'$'#174#255'M}'#249#194'}'#141'?x'#241#13#156#254#231#15#28#252#236 + +#197#185#14'E'#245#229#11#28'{'#230#253#182'2'#140'%'#150#161#237'pX'#250'i' + +#234#129#0'v'#212'`K'#174'\'#205'Q'#174#134#184#166#6'J!'#132'b)'#31#241#206 + +#171'a'#171#25#18'E3'#146#4#139'70n'#255#133#159#191#139#138#18#204#23'^'#193 + +'}h'#8#219#212#208'u'#177#19#160'Z'#15#219#23#183'J'#138#19#199's'#12#247'8' + +#248'M0'#13#201#247'3+'#157'V'#23#130#248#223'5'#178#27'k'#232'G'#143#208#148 + +'1'#217#235#215'Y'#155#250#16#235#252'4'#194#242#0#168#249'a'#7#160#30#196'x' + +'@y'#225'S'#132#248#24']'#23'8'#166'DJ'#133#31'J'#12#203#162#188'p'#14#128'j' + +'#"'#254'u'#150'L'#237#14#13#175#143#148#16'D##'#196#151#191#163'|m'#142'x' + +#242#233'M'#138#147#14#128'T'#157#30'lF'#9#223#254#6#131'n'#157'(Q\'#253'Gp' + +#219'w;'#181#137'$'#229#245'&'#217#249'9'#226'X'#167#186'x'#131#244#137'g' + +#169')'#240'+'#1'v'#212#154#133#173#152#198'V'#218#219#7'ND>~a'#131#151#159 + +#211#201#223#177'X'#168#216#228'2)'#138#181#26'B'#128#152'<'#201#234#229'/' + +#24'x'#233'5'#140'GF'#137#252#128'5'#205'fd'#226#9#132#232'R'#228#173#187'\n' + +#128'LA'#177'Z'#172'0'#144')'#241#199#188'F'#214#238#225#136#19#131#158#1'j' + +#8'!'#176#15#15'P{'#247#28#133'K'#211#196#127#222'$86N'#255'g_b'#185#169#246 + +'c'#133#18#219'3h'#1'DI'#154#211#199#191'B{'#172'['#195#165#1#208#4'hB'#144 + +#30#127#156#244''''#159#239#178#218'Z)R'#208#157#162#185#159'-'#156#180'F' + +#226'K'#148'.'#208#140#150'nb'#210'lwQ'#20#4#228#235#17'q# '#155#203#16#249 + +'>'#229'@'#242#212'h'#127#155#13#209#141'"'#0#199#241#8#209#232#233#21'X'#150 + +'@'#25#130#212'!'#13'e'#247#0#191#160#9'p'#29#19'/L'#8#29#19']%H'#211'd8m' + +#177#173#253#219#172#24#219#225#140#220'8'#227#167#186#175#246#237#142#158 + +#231#224'y'#206'>3,vg '#140#204#190#163#175#9'q'#160#21'!'#186#213'`'#169#181 + +'X'#15#228#200#129#222#191#9#144'(Ech'#138'z'#173#140'n'#24#232#154#192#188 + +'g'#209#1#160'{'#16#238#29'4N$'#134#174#181#255#231'6'#128'R'#130'D8'#172#148 + +'L'#210#25#151'('#150'DA'#19#203'Ka!'#137'6?'#163'$'#168#17'h>'#135#204#214 + +'zI9&'#145'T'#200'0'#193'v-'#130'f'#200#216#195#189'[|'#239#158#131#254#190 + +#12'B@,!15l'#215'"j'#134#168'D'#161#27#2#215'5'#9#164#134'c'#130#235'Hb)1'#1 + +#219'sh'#198#9#134#225'p+_e'#164'?'#219#161#234#202#181#162#250#230#135'%' + +#254'/'#249#15'Q'#18#144#245'C'#140#131#200#0#0#0#0'IEND'#174'B`'#130 +]); diff --git a/components/spktoolbar/designtime/SpkToolbarEditor.pas b/components/spktoolbar/designtime/SpkToolbarEditor.pas index 593ad9eb5..8d234bfb4 100644 --- a/components/spktoolbar/designtime/SpkToolbarEditor.pas +++ b/components/spktoolbar/designtime/SpkToolbarEditor.pas @@ -4,9 +4,9 @@ unit SpkToolbarEditor; interface -uses Forms, Controls, Classes, ComponentEditors, PropEdits, LazarusPackageIntf, LazIdeIntf, TypInfo, Dialogs, - SysUtils, - spkToolbar, spkt_Tab, spkt_Pane, spkt_Appearance, +uses Forms, Controls, Classes, ComponentEditors, PropEdits, LazarusPackageIntf, LazIdeIntf, TypInfo, Dialogs, + SysUtils, ImgList, GraphPropEdits, + spkToolbar, spkt_Tab, spkt_Buttons, spkte_EditWindow, spkte_AppearanceEditor; const PROPERTY_CONTENTS_NAME = 'Contents'; @@ -84,6 +84,11 @@ type TSpkToolbarEditor = class(TComponentEditor) function GetVerbCount: Integer; override; end; +type TSpkImageIndexPropertyEditor = class(TImageIndexPropertyEditor) + protected + function GetImageList: TCustomImageList; override; + end; + var EditWindow : TfrmEditWindow; implementation @@ -309,6 +314,20 @@ begin EditWindow.RefreshNames; end; +{ TSpkImageIndexPropertyEditor } + +function TSpkImageIndexPropertyEditor.GetImagelist: TCustomImageList; +var + Instance: TPersistent; +begin + Result := nil; + Instance := GetComponent(0); + if (Instance is TSpkLargeButton) then + Result := TSpkLargeButton(Instance).Images + else if (Instance is TSpkSmallButton) then + Result := TSpkSmallButton(Instance).Images; +end; + { TSpkToolbarAppearanceEditor } procedure TSpkToolbarAppearanceEditor.Edit; diff --git a/components/spktoolbar/designtime/spkte_EditWindow.pas b/components/spktoolbar/designtime/spkte_EditWindow.pas index f78245177..5b434867a 100644 --- a/components/spktoolbar/designtime/spkte_EditWindow.pas +++ b/components/spktoolbar/designtime/spkte_EditWindow.pas @@ -14,6 +14,12 @@ type TCreateItemFunc = function(Pane : TSpkPane) : TSpkBaseItem; type TfrmEditWindow = class(TForm) + aAddCheckbox: TAction; + aAddRadioButton: TAction; + MenuItem1: TMenuItem; + MenuItem2: TMenuItem; + MenuItem3: TMenuItem; + MenuItem4: TMenuItem; tvStructure: TTreeView; ilTreeImages: TImageList; tbToolBar: TToolBar; @@ -67,6 +73,9 @@ type procedure aAddLargeButtonExecute(Sender: TObject); procedure aRemoveItemExecute(Sender: TObject); procedure aAddSmallButtonExecute(Sender: TObject); + procedure aAddCheckboxExecute(Sender: TObject); + procedure aAddRadioButtonExecute(Sender: TObject); + procedure tvStructureDeletion(Sender:TObject; Node:TTreeNode); procedure tvStructureKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure FormActivate(Sender: TObject); @@ -151,6 +160,7 @@ if Obj is TSpkTab then begin Tab:=TSpkTab(Obj); Pane:=Tab.Panes.Add; + Pane.Name := FDesigner.UniqueName(Pane.ClassName); NewNode:=tvStructure.Items.AddChild(Node, Pane.Caption); NewNode.Data:=Pane; NewNode.ImageIndex:=1; @@ -168,6 +178,7 @@ if Obj is TSpkPane then Tab:=TSpkTab(Node.Parent.Data); Pane:=Tab.Panes.Add; + Pane.Name := FDesigner.UniqueName(Pane.ClassName); NewNode:=tvStructure.Items.AddChild(Node.Parent, Pane.Caption); NewNode.Data:=Pane; NewNode.ImageIndex:=1; @@ -185,6 +196,7 @@ if Obj is TSpkBaseItem then Tab:=TSpkTab(Node.Parent.Parent.Data); Pane:=Tab.Panes.Add; + Pane.Name := FDesigner.UniqueName(Pane.ClassName); NewNode:=tvStructure.Items.AddChild(Node.Parent.Parent, Pane.Caption); NewNode.Data:=Pane; NewNode.ImageIndex:=1; @@ -212,6 +224,30 @@ if (FToolbar=nil) or (FDesigner=nil) then AddItem(@CreateSmallButton); end; +function CreateCheckbox(Pane: TSpkPane): TSpkBaseItem; +begin + result := Pane.Items.AddCheckbox; +end; + +procedure TfrmEditWindow.aAddCheckboxExecute(Sender: TObject); +begin + if (FToolbar = nil) or (FDesigner = nil) then + exit; + AddItem(@CreateCheckbox); +end; + +function CreateRadioButton(Pane: TSpkPane): TSpkBaseItem; +begin + result := Pane.Items.AddRadioButton; +end; + +procedure TfrmEditWindow.aAddRadioButtonExecute(Sender: TObject); +begin + if (FToolbar = nil) or (FDesigner = nil) then + exit; + AddItem(@CreateRadioButton); +end; + procedure TfrmEditWindow.aAddTabExecute(Sender: TObject); var Node : TTreeNode; @@ -222,6 +258,7 @@ if (FToolbar=nil) or (FDesigner=nil) then exit; Tab:=FToolbar.Tabs.Add; +Tab.Name := FDesigner.UniqueName(Tab.ClassName); Node:=tvStructure.Items.AddChild(nil, Tab.Caption); Node.Data:=Tab; Node.ImageIndex:=0; @@ -257,6 +294,7 @@ if Obj is TSpkPane then begin Pane:=TSpkPane(Obj); Item:=CreateItemFunc(Pane); + Item.Name := FDesigner.UniqueName(Item.ClassName); s:=GetItemCaption(Item); NewNode:=tvStructure.Items.AddChild(Node, s); NewNode.Data:=Item; @@ -275,6 +313,7 @@ if Obj is TSpkBaseItem then Pane:=TSpkPane(Node.Parent.Data); Item:=CreateItemFunc(Pane); + Item.Name := FDesigner.UniqueName(Item.ClassName); s:=GetItemCaption(Item); NewNode:=tvStructure.Items.AddChild(Node.Parent, s); NewNode.Data:=Item; @@ -502,6 +541,8 @@ if (FToolbar=nil) or (FDesigner=nil) then aRemovePane.Enabled:=false; aAddLargeButton.Enabled:=false; aAddSmallButton.Enabled:=false; + aAddCheckbox.Enabled := false; + aAddRadioButton.Enabled := false; aRemoveItem.Enabled:=false; aMoveUp.Enabled:=false; aMoveDown.Enabled:=false; @@ -519,6 +560,8 @@ else aRemovePane.Enabled:=false; aAddLargeButton.Enabled:=false; aAddSmallButton.Enabled:=false; + aAddCheckbox.Enabled := false; + aAddRadioButton.Enabled := false; aRemoveItem.Enabled:=false; aMoveUp.Enabled:=false; aMoveDown.Enabled:=false; @@ -542,6 +585,8 @@ else aRemovePane.Enabled:=false; aAddLargeButton.Enabled:=false; aAddSmallButton.Enabled:=false; + aAddCheckbox.Enabled := false; + aAddRadioButton.Enabled := false; aRemoveItem.Enabled:=false; index:=FToolbar.Tabs.IndexOf(Tab); @@ -566,6 +611,8 @@ else aRemovePane.Enabled:=true; aAddLargeButton.Enabled:=true; aAddSmallButton.Enabled:=true; + aAddCheckbox.Enabled := true; + aAddRadiobutton.Enabled := true; aRemoveItem.Enabled:=false; index:=Tab.Panes.IndexOf(Pane); @@ -591,6 +638,8 @@ else aRemovePane.Enabled:=false; aAddLargeButton.Enabled:=true; aAddSmallButton.Enabled:=true; + aAddCheckbox.Enabled := true; + aAddRadioButton.Enabled := true; aRemoveItem.Enabled:=true; index:=Pane.Items.IndexOf(Item); @@ -843,9 +892,14 @@ var itemnode: TTreeNode; Obj: TSpkBaseItem; s: string; + node: TTreeNode; begin Caption:='Editing TSpkToolbar contents'; + + // Clear tree, but don't remove existing toolbar children from the form + tvStructure.OnDeletion := nil; tvStructure.Items.Clear; + tvStructure.OnDeletion := tvStructureDeletion; if (FToolbar<>nil) and (FDesigner<>nil) then begin @@ -878,8 +932,18 @@ begin end; end; - if tvStructure.Items.Count > 0 then - tvStructure.Items[0].Selected := true; + if (tvStructure.Items.Count > 0) and (FToolbar.TabIndex > -1) then begin + node := tvStructure.Items[0]; + while (node <> nil) do begin + if TSpkTab(node.Data) = FToolbar.Tabs[FToolbar.TabIndex] then break; + node := node.GetNextSibling; + end; + if (node <> nil) then begin + node.Selected := true; + node.Expand(true); + end; + end; + CheckActionsAvailability; end; @@ -1003,6 +1067,24 @@ if assigned(Node) then CheckActionsAvailability; end; +procedure TfrmEditWindow.tvStructureDeletion(Sender:TObject; Node:TTreeNode); +var + RunNode: TTreeNode; + index: Integer; + comp: TSpkComponent; +begin + if Node = nil then + exit; + // Recursively delete children and destroy their data + RunNode := Node.GetFirstChild; + while RunNode <> nil do begin + RunNode.Delete; + RunNode := RunNode.GetNextSibling; + end; + // Destroy node's data + TSpkComponent(Node.Data).Free; +end; + procedure TfrmEditWindow.tvStructureEdited(Sender: TObject; Node: TTreeNode; var S: string); var