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