You've already forked lazarus-ccr
* 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
This commit is contained in:
blikblum
@ -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.
|
||||
|
||||
@ -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.</summary>
|
||||
FUpdating : boolean;
|
||||
|
||||
FOnTabChanging: TNotifyEvent;
|
||||
FOnTabChanged: TNotifyEvent;
|
||||
|
||||
protected
|
||||
/// <summary>Instancja obiektu wygl¹du, przechowuj¹cego kolory i czcionki
|
||||
/// u¿ywane podczas renderowania komponentu</summary>
|
||||
@ -313,7 +342,7 @@ type TSpkToolbar = class;
|
||||
property Tabs : TSpkTabs read FTabs;
|
||||
published
|
||||
/// <summary>Kolor t³a komponentu</summary>
|
||||
property Color : TColor read GetColor write SetColor;
|
||||
property Color : TColor read GetColor write SetColor default clSkyBlue;
|
||||
/// <summary>Obiekt zawieraj¹cy atrybuty wygl¹du toolbara</summary>
|
||||
property Appearance : TSpkToolbarAppearance read FAppearance write SetAppearance;
|
||||
/// <summary>WysokoϾ toolbara (tylko do odczytu)</summary>
|
||||
@ -328,6 +357,10 @@ type TSpkToolbar = class;
|
||||
property LargeImages : TImageList read FLargeImages write SetLargeImages;
|
||||
/// <summary>Lista du¿ych obrazków w stanie "disabled"</summary>
|
||||
property DisabledLargeImages : TImageList read FDisabledLargeImages write SetDisabledLargeImages;
|
||||
|
||||
// <summary>Events called before and after a different tab is selected</summary>
|
||||
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;
|
||||
|
||||
|
||||
@ -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;
|
||||
|
||||
|
||||
514
components/spktoolbar/SpkToolbar/spkt_Checkboxes.pas
Normal file
514
components/spktoolbar/SpkToolbar/spkt_Checkboxes.pas
Normal file
@ -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.
|
||||
|
||||
@ -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);
|
||||
|
||||
@ -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);
|
||||
|
||||
|
||||
@ -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);
|
||||
|
||||
|
||||
@ -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;
|
||||
|
||||
46
components/spktoolbar/designtime/SpkToolbar.lrs
Normal file
46
components/spktoolbar/designtime/SpkToolbar.lrs
Normal file
@ -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
|
||||
]);
|
||||
@ -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;
|
||||
|
||||
@ -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
|
||||
|
||||
Reference in New Issue
Block a user