pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

SpkToolbar: Apply conventional source formatting

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5383 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2016-11-26 23:56:34 +00:00
parent 6f72dd9582
commit 49c250890f
15 changed files with 2452 additions and 2521 deletions
Download Patch File Download Diff File Expand all files Collapse all files

32
components/spktoolbar/SpkToolbar/SpkToolbar.pas
View File

@@ -418,11 +418,13 @@ type
property OnTabChanged: TNotifyEvent read FOnTabChanged write FOnTabChanged;
end;
implementation
uses
LCLIntf, Themes;
{ TSpkToolbarDispatch }
function TSpkToolbarDispatch.ClientToScreen(Point: T2DIntPoint): T2DIntPoint;
@@ -478,21 +480,20 @@ begin
FToolbar.NotifyVisualsChanged;
end;
{ TSpkToolbar }
function TSpkToolbar.AtLeastOneTabVisible: boolean;
var
i: integer;
TabVisible: boolean;
begin
Result := FTabs.Count > 0;
if Result then
begin
TabVisible := False;
i := FTabs.Count - 1;
while (i >= 0) and not (TabVisible) do
while (i >= 0) and not TabVisible do
begin
TabVisible := FTabs[i].Visible;
Dec(i);
@@ -588,7 +589,6 @@ end;
procedure TSpkToolbar.DefineProperties(Filer: TFiler);
begin
inherited DefineProperties(Filer);
Filer.DefineProperty('Tabs', FTabs.ReadNames, FTabs.WriteNames, True);
end;
@@ -596,13 +596,11 @@ destructor TSpkToolbar.Destroy;
begin
// Release the fields
FTabs.Free;
FAppearance.Free;
// Release the internal fields
FTemporary.Free;
FBuffer.Free;
FToolbarDispatch.Free;
{$IFDEF DELAYRUNTIMER}
@@ -615,7 +613,6 @@ end;
procedure TSpkToolbar.EndUpdate;
begin
FUpdating := False;
ValidateMetrics;
ValidateBuffer;
Repaint;
@@ -638,8 +635,6 @@ var
i: integer;
begin
inherited;
if FTabs.Count > 0 then
for i := 0 to FTabs.Count - 1 do
Proc(FTabs.Items[i]);
end;
@@ -681,9 +676,7 @@ begin
InternalBeginUpdate;
if FTabs.ListState = lsNeedsProcessing then
begin
FTabs.ProcessNames(self.Owner);
end;
InternalEndUpdate;
@@ -975,7 +968,6 @@ end;
procedure TSpkToolbar.NotifyAppearanceChanged;
begin
SetMetricsInvalid;
if not (FInternalUpdating or FUpdating) then
Repaint;
end;
@@ -983,7 +975,6 @@ end;
procedure TSpkToolbar.NotifyMetricsChanged;
begin
SetMetricsInvalid;
if not (FInternalUpdating or FUpdating) then
Repaint;
end;
@@ -1025,7 +1016,6 @@ end;
procedure TSpkToolbar.NotifyVisualsChanged;
begin
SetBufferInvalid;
if not (FInternalUpdating or FUpdating) then
Repaint;
end;
@@ -1081,7 +1071,6 @@ procedure TSpkToolbar.SetColor(const Value: TColor);
begin
inherited Color := Value;
SetBufferInvalid;
if not (FInternalUpdating or FUpdating) then
Repaint;
end;
@@ -1091,7 +1080,6 @@ begin
FDisabledImages := Value;
FTabs.DisabledImages := Value;
SetMetricsInvalid;
if not (FInternalUpdating or FUpdating) then
Repaint;
end;
@@ -1101,7 +1089,6 @@ begin
FDisabledLargeImages := Value;
FTabs.DisabledLargeImages := Value;
SetMetricsInvalid;
if not (FInternalUpdating or FUpdating) then
Repaint;
end;
@@ -1111,7 +1098,6 @@ begin
FImages := Value;
FTabs.Images := Value;
SetMetricsInvalid;
if not (FInternalUpdating or FUpdating) then
Repaint;
end;
@@ -1121,7 +1107,6 @@ begin
FLargeImages := Value;
FTabs.LargeImages := Value;
SetMetricsInvalid;
if not (FInternalUpdating or FUpdating) then
Repaint;
end;
@@ -1272,14 +1257,12 @@ begin
if (FTabIndex > -1) then
FTabs[FTabIndex].ExecOnClick;
//Tabs don't need MouseUp
end;
procedure TSpkToolbar.SetAppearance(const Value: TSpkToolbarAppearance);
begin
FAppearance.Assign(Value);
SetBufferInvalid;
if not (FInternalUpdating or FUpdating) then
Repaint;
@@ -1316,6 +1299,7 @@ procedure TSpkToolbar.ValidateBuffer;
FocusedAppearance.Tab.GradientFromColor,
FocusedAppearance.Tab.GradientToColor,
FocusedAppearance.Tab.GradientType);
TGuiTools.DrawAARoundCorner(FBuffer,
{$IFDEF EnhancedRecordSupport}
T2DIntPoint.Create(0, ToolbarTabCaptionsHeight),
@@ -1325,6 +1309,7 @@ procedure TSpkToolbar.ValidateBuffer;
ToolbarCornerRadius,
cpLeftTop,
FocusedAppearance.Tab.BorderColor);
TGuiTools.DrawAARoundCorner(FBuffer,
{$IFDEF EnhancedRecordSupport}
T2DIntPoint.Create(self.Width - ToolbarCornerRadius, ToolbarTabCaptionsHeight),
@@ -1334,6 +1319,7 @@ procedure TSpkToolbar.ValidateBuffer;
ToolbarCornerRadius,
cpRightTop,
FocusedAppearance.Tab.BorderColor);
TGuiTools.DrawAARoundCorner(FBuffer,
{$IFDEF EnhancedRecordSupport}
T2DIntPoint.Create(0, self.Height - ToolbarCornerRadius),
@@ -1343,6 +1329,7 @@ procedure TSpkToolbar.ValidateBuffer;
ToolbarCornerRadius,
cpLeftBottom,
FocusedAppearance.Tab.BorderColor);
TGuiTools.DrawAARoundCorner(FBuffer,
{$IFDEF EnhancedRecordSupport}
T2DIntPoint.Create(self.Width - ToolbarCornerRadius, self.Height - ToolbarCornerRadius),
@@ -1352,11 +1339,14 @@ procedure TSpkToolbar.ValidateBuffer;
ToolbarCornerRadius,
cpRightBottom,
FocusedAppearance.Tab.BorderColor);
TGuiTools.DrawVLine(FBuffer, 0, ToolbarTabCaptionsHeight +
ToolbarCornerRadius, self.Height - ToolbarCornerRadius,
FocusedAppearance.Tab.BorderColor);
TGuiTools.DrawHLine(FBuffer, ToolbarCornerRadius, self.Width - ToolbarCornerRadius,
self.Height - 1, FocusedAppearance.Tab.BorderColor);
TGuiTools.DrawVLine(FBuffer, self.Width - 1, ToolbarTabCaptionsHeight +
ToolbarCornerRadius, self.Height - ToolbarCornerRadius,
FocusedAppearance.Tab.BorderColor);

211
components/spktoolbar/SpkToolbar/spkt_Appearance.pas
View File

@@ -14,13 +14,16 @@ unit spkt_Appearance;
interface
uses Graphics, Classes, Forms, SysUtils,
uses
Graphics, Classes, Forms, SysUtils,
SpkGUITools, SpkXMLParser, SpkXMLTools,
spkt_Dispatch, spkt_Exceptions, spkt_Const;
type
TSpkPaneStyle = (psRectangleFlat, psRectangleEtched, psRectangleRaised,
psDividerFlat, psDividerEtched, psDividerRaised);
TSpkPaneStyle = (
psRectangleFlat, psRectangleEtched, psRectangleRaised,
psDividerFlat, psDividerEtched, psDividerRaised
);
TSpkElementStyle = (esRounded, esRectangle);
@@ -30,17 +33,18 @@ type
spkMetroLight, spkMetroDark
);
{ TSpkTabAppearance }
TSpkTabAppearance = class(TPersistent)
private
FDispatch: TSpkBaseAppearanceDispatch;
protected
FTabHeaderFont: TFont;
FBorderColor: TColor;
FGradientFromColor: TColor;
FGradientToColor: TColor;
FGradientType: TBackgroundKind;
FInactiveHeaderFontColor: TColor;
// Getter & setter methods
procedure SetHeaderFont(const Value: TFont);
procedure SetBorderColor(const Value: TColor);
@@ -53,13 +57,15 @@ type
// *** Konstruktor, destruktor, assign ***
// <remarks>Appearance musi mieæ assign, bo wystêpuje jako w³asnoœæ
// opublikowana.</remarks>
procedure Assign(Source: TPersistent); override;
constructor Create(ADispatch: TSpkBaseAppearanceDispatch);
destructor Destroy; override;
procedure Assign(Source: TPersistent); override;
procedure LoadFromXML(Node: TSpkXMLNode);
procedure SaveToPascal(AList: TStrings);
procedure SaveToXML(Node: TSpkXMLNode);
procedure LoadFromXML(Node: TSpkXMLNode);
destructor Destroy; override;
procedure Reset(AStyle: TSpkStyle = spkOffice2007Blue);
published
property TabHeaderFont: TFont read FTabHeaderFont write SetHeaderFont;
property BorderColor: TColor read FBorderColor write SetBorderColor;
@@ -69,10 +75,12 @@ type
property InactiveTabHeaderFontColor: TColor read FInactiveHeaderFontColor write SetInactiveHeaderFontColor;
end;
type TSpkPaneAppearance = class(TPersistent)
{ TSpkPaneAppearance }
TSpkPaneAppearance = class(TPersistent)
private
FDispatch: TSpkBaseAppearanceDispatch;
protected
FCaptionFont: TFont;
FBorderDarkColor: TColor;
FBorderLightColor: TColor;
@@ -91,14 +99,17 @@ type TSpkPaneAppearance = class(TPersistent)
procedure SetGradientType(const Value: TBackgroundKind);
procedure SetHotTrackBrightnessChange(const Value: Integer);
procedure SetStyle(const Value: TSpkPaneStyle);
public
constructor Create(ADispatch: TSpkBaseAppearanceDispatch);
destructor Destroy; override;
procedure Assign(Source: TPersistent); override;
procedure LoadFromXML(Node: TSpkXMLNode);
procedure SaveToPascal(AList: TStrings);
procedure SaveToXML(Node: TSpkXMLNode);
procedure LoadFromXML(Node: TSpkXMLNode);
procedure Reset(AStyle: TSpkStyle = spkOffice2007Blue);
published
property BorderDarkColor: TColor read FBorderDarkColor write SetBorderDarkColor;
property BorderLightColor: TColor read FBorderLightColor write SetBorderLightColor;
@@ -111,6 +122,8 @@ type TSpkPaneAppearance = class(TPersistent)
property Style: TSpkPaneStyle read FStyle write SetStyle default psRectangleEtched;
end;
{ TSpkElementAppearance }
TSpkElementAppearance = class(TPersistent)
private
FDispatch: TSpkBaseAppearanceDispatch;
@@ -162,14 +175,17 @@ type TSpkPaneAppearance = class(TPersistent)
procedure SetIdleInnerDarkColor(const Value: TColor);
procedure SetIdleInnerLightColor(const Value: TColor);
procedure SetStyle(const Value: TSpkElementStyle);
public
constructor Create(ADispatch: TSpkBaseAppearanceDispatch);
destructor Destroy; override;
procedure Assign(Source: TPersistent); override;
procedure LoadFromXML(Node: TSpkXMLNode);
procedure SaveToPascal(AList: TStrings);
procedure SaveToXML(Node: TSpkXMLNode);
procedure LoadFromXML(Node: TSpkXMLNode);
procedure Reset(AStyle: TSpkStyle = spkOffice2007Blue);
published
property CaptionFont: TFont read FCaptionFont write SetCaptionFont;
property IdleFrameColor: TColor read FIdleFrameColor write SetIdleFrameColor;
@@ -197,12 +213,14 @@ type TSpkPaneAppearance = class(TPersistent)
property Style: TSpkElementStyle read FStyle write SetStyle;
end;
type TSpkToolbarAppearance = class;
{ TSpkToolbarAppearance }
TSpkToolbarAppearance = class;
TSpkToolbarAppearanceDispatch = class(TSpkBaseAppearanceDispatch)
private
FToolbarAppearance: TSpkToolbarAppearance;
protected
public
constructor Create(AToolbarAppearance: TSpkToolbarAppearance);
procedure NotifyAppearanceChanged; override;
@@ -218,8 +236,6 @@ type TSpkToolbarAppearance = class;
procedure SetElementAppearance(const Value: TSpkElementAppearance);
procedure SetPaneAppearance(const Value: TSpkPaneAppearance);
procedure SetTabAppearance(const Value: TSpkTabAppearance);
protected
//
public
constructor Create(ADispatch: TSpkBaseAppearanceDispatch); reintroduce;
destructor Destroy; override;
@@ -263,6 +279,20 @@ end;
{ TSpkBaseToolbarAppearance }
constructor TSpkTabAppearance.Create(ADispatch: TSpkBaseAppearanceDispatch);
begin
inherited Create;
FDispatch := ADispatch;
FTabHeaderFont := TFont.Create;
Reset;
end;
destructor TSpkTabAppearance.Destroy;
begin
FTabHeaderFont.Free;
inherited;
end;
procedure TSpkTabAppearance.Assign(Source: TPersistent);
var
SrcAppearance: TSpkTabAppearance;
@@ -280,31 +310,14 @@ begin
if FDispatch <> nil then
FDispatch.NotifyAppearanceChanged;
end else
raise AssignException.create('TSpkToolbarAppearance.Assign: Nie mogê przypisaæ obiektu '+Source.ClassName+' do TSpkToolbarAppearance!');
end;
constructor TSpkTabAppearance.Create(
ADispatch: TSpkBaseAppearanceDispatch);
begin
inherited Create;
FDispatch:=ADispatch;
FTabHeaderFont:=TFont.Create;
Reset;
end;
destructor TSpkTabAppearance.Destroy;
begin
FTabHeaderFont.Free;
inherited;
raise AssignException.Create('TSpkToolbarAppearance.Assign: Nie mogê przypisaæ obiektu '+Source.ClassName+' do TSpkToolbarAppearance!');
end;
procedure TSpkTabAppearance.LoadFromXML(Node: TSpkXMLNode);
var
Subnode: TSpkXMLNode;
begin
if not(assigned(Node)) then
if not Assigned(Node) then
exit;
Subnode := Node['TabHeaderFont',false];
@@ -312,19 +325,19 @@ begin
TSpkXMLTools.Load(Subnode, FTabHeaderFont);
Subnode := Node['BorderColor',false];
if assigned(Subnode) then
if Assigned(Subnode) then
FBorderColor := Subnode.TextAsColor;
Subnode := Node['GradientFromColor',false];
if assigned(Subnode) then
if Assigned(Subnode) then
FGradientFromColor := Subnode.TextAsColor;
Subnode := Node['GradientToColor',false];
if assigned(Subnode) then
if Assigned(Subnode) then
FGradientToColor := Subnode.TextAsColor;
Subnode := Node['GradientType',false];
if assigned(Subnode) then
if Assigned(Subnode) then
FGradientType := TBackgroundKind(Subnode.TextAsInteger);
Subnode := Node['InactiveTabHeaderFontColor', false];
@@ -453,7 +466,7 @@ end;
procedure TSpkTabAppearance.SetHeaderFont(const Value: TFont);
begin
FTabHeaderFont.assign(Value);
FTabHeaderFont.Assign(Value);
if FDispatch <> nil then
FDispatch.NotifyAppearanceChanged;
end;
@@ -466,9 +479,24 @@ begin
end;
{ TSpkPaneAppearance }
constructor TSpkPaneAppearance.Create(ADispatch: TSpkBaseAppearanceDispatch);
begin
inherited Create;
FDispatch := ADispatch;
FCaptionFont := TFont.Create;
FHotTrackBrightnessChange := 20;
FStyle := psRectangleEtched;
Reset;
end;
destructor TSpkPaneAppearance.Destroy;
begin
FCaptionFont.Free;
inherited Destroy;
end;
procedure TSpkPaneAppearance.Assign(Source: TPersistent);
var
SrcAppearance: TSpkPaneAppearance;
@@ -493,22 +521,6 @@ begin
raise AssignException.create('TSpkPaneAppearance.Assign: Nie mogê przypisaæ obiektu '+Source.ClassName+' do TSpkPaneAppearance!');
end;
constructor TSpkPaneAppearance.Create(ADispatch: TSpkBaseAppearanceDispatch);
begin
inherited Create;
FDispatch := ADispatch;
FCaptionFont := TFont.Create;
FHotTrackBrightnessChange := 20;
FStyle := psRectangleEtched;
Reset;
end;
destructor TSpkPaneAppearance.Destroy;
begin
FCaptionFont.Free;
inherited Destroy;
end;
procedure TSpkPaneAppearance.LoadFromXML(Node: TSpkXMLNode);
var
Subnode: TSpkXMLNode;
@@ -735,6 +747,21 @@ end;
{ TSpkElementAppearance }
constructor TSpkElementAppearance.Create(ADispatch: TSpkBaseAppearanceDispatch);
begin
inherited Create;
FDispatch := ADispatch;
FCaptionFont := TFont.Create;
FHotTrackBrightnessChange := 40;
Reset;
end;
destructor TSpkElementAppearance.Destroy;
begin
FCaptionFont.Free;
inherited Destroy;
end;
procedure TSpkElementAppearance.Assign(Source: TPersistent);
var
SrcAppearance: TSpkElementAppearance;
@@ -774,21 +801,6 @@ begin
raise AssignException.create('TSpkElementAppearance.Assign: Nie mogê przypisaæ obiektu '+Source.ClassName+' do TSpkElementAppearance!');
end;
constructor TSpkElementAppearance.Create(ADispatch: TSpkBaseAppearanceDispatch);
begin
inherited Create;
FDispatch := ADispatch;
FCaptionFont := TFont.Create;
FHotTrackBrightnessChange := 40;
Reset;
end;
destructor TSpkElementAppearance.Destroy;
begin
FCaptionFont.Free;
inherited Destroy;
end;
procedure TSpkElementAppearance.LoadFromXML(Node: TSpkXMLNode);
var
Subnode: TSpkXMLNode;
@@ -1323,6 +1335,7 @@ begin
FDispatch.NotifyAppearanceChanged;
end;
{ TSpkToolbarAppearanceDispatch }
constructor TSpkToolbarAppearanceDispatch.Create(
@@ -1338,26 +1351,9 @@ if FToolbarAppearance<>nil then
FToolbarAppearance.NotifyAppearanceChanged;
end;
{ TSpkToolbarAppearance }
procedure TSpkToolbarAppearance.Assign(Source: TPersistent);
var
Src: TSpkToolbarAppearance;
begin
if Source is TSpkToolbarAppearance then
begin
Src := TSpkToolbarAppearance(Source);
self.FTab.Assign(Src.Tab);
self.FPane.Assign(Src.Pane);
self.FElement.Assign(Src.Element);
if FDispatch <> nil then
FDispatch.NotifyAppearanceChanged;
end else
raise AssignException.create('TSpkToolbarAppearance.Assign: Nie mogê przypisaæ obiektu '+Source.ClassName+' do TSpkToolbarAppearance!');
end;
constructor TSpkToolbarAppearance.Create(ADispatch : TSpkBaseAppearanceDispatch);
begin
inherited Create;
@@ -1377,34 +1373,51 @@ begin
inherited;
end;
procedure TSpkToolbarAppearance.Assign(Source: TPersistent);
var
Src: TSpkToolbarAppearance;
begin
if Source is TSpkToolbarAppearance then
begin
Src := TSpkToolbarAppearance(Source);
self.FTab.Assign(Src.Tab);
self.FPane.Assign(Src.Pane);
self.FElement.Assign(Src.Element);
if FDispatch <> nil then
FDispatch.NotifyAppearanceChanged;
end else
raise AssignException.create('TSpkToolbarAppearance.Assign: Nie mogê przypisaæ obiektu '+Source.ClassName+' do TSpkToolbarAppearance!');
end;
procedure TSpkToolbarAppearance.LoadFromXML(Node: TSpkXMLNode);
var Subnode : TSpkXMLNode;
var
Subnode: TSpkXMLNode;
begin
Tab.Reset;
Pane.Reset;
Element.Reset;
if not(assigned(Node)) then
if not Assigned(Node) then
exit;
Subnode := Node['Tab', false];
if assigned(Subnode) then
if Assigned(Subnode) then
Tab.LoadFromXML(Subnode);
Subnode := Node['Pane', false];
if assigned(Subnode) then
if Assigned(Subnode) then
Pane.LoadFromXML(Subnode);
Subnode := Node['Element', false];
if assigned(Subnode) then
if Assigned(Subnode) then
Element.LoadFromXML(Subnode);
end;
procedure TSpkToolbarAppearance.NotifyAppearanceChanged;
begin
if assigned(FDispatch) then
if Assigned(FDispatch) then
FDispatch.NotifyAppearanceChanged;
end;
@@ -1423,7 +1436,7 @@ begin
FTab.SaveToPascal(AList);
FPane.SaveToPascal(AList);
FElement.SaveToPascal(AList);
AList.ADd('end;');
AList.Add('end;');
end;
procedure TSpkToolbarAppearance.SaveToXML(Node: TSpkXMLNode);

22
components/spktoolbar/SpkToolbar/spkt_BaseItem.pas
View File

@@ -15,11 +15,15 @@ unit spkt_BaseItem;
interface
uses Graphics, Classes, Controls,
uses
Graphics, Classes, Controls,
SpkMath, spkt_Appearance, spkt_Dispatch, spkt_Types;
type TSpkItemSize = (isLarge, isNormal);
type
TSpkItemSize = (isLarge, isNormal);
TSpkItemTableBehaviour = (tbBeginsRow, tbBeginsColumn, tbContinuesRow);
TSpkItemGroupBehaviour = (gbSingleItem, gbBeginsGroup, gbContinuesGroup, gbEndsGroup);
TSpkBaseItem = class abstract(TSpkComponent)
@@ -43,6 +47,7 @@ type TSpkItemSize = (isLarge, isNormal);
procedure SetLargeImages(const Value: TImageList); virtual;
procedure SetDisabledLargeImages(const Value: TImageList); virtual;
procedure SetAppearance(const Value: TSpkToolbarAppearance);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
@@ -58,6 +63,7 @@ type TSpkItemSize = (isLarge, isNormal);
function GetTableBehaviour: TSpkItemTableBehaviour; virtual; abstract;
function GetGroupBehaviour: TSpkItemGroupBehaviour; virtual; abstract;
function GetSize: TSpkItemSize; virtual; abstract;
procedure Draw(ABuffer: TBitmap; ClipRect: T2DIntRect); virtual; abstract;
property ToolbarDispatch: TSpkBaseToolbarDispatch read FToolbarDispatch write FToolbarDispatch;
@@ -66,14 +72,15 @@ type TSpkItemSize = (isLarge, isNormal);
property DisabledImages: TImageList read FDisabledImages write SetDisabledImages;
property LargeImages: TImageList read FLargeImages write SetLargeImages;
property DisabledLargeImages: TImageList read FDisabledLargeImages write SetDisabledLargeImages;
property Rect: T2DIntRect read FRect write SetRect;
published
property Visible: boolean read FVisible write SetVisible;
property Enabled: boolean read FEnabled write SetEnabled;
end;
type TSpkBaseItemClass = class of TSpkBaseItem;
TSpkBaseItemClass = class of TSpkBaseItem;
implementation
@@ -84,9 +91,9 @@ begin
inherited Create(AOwner);
{$IFDEF EnhancedRecordSupport}
FRect:=T2DIntRect.create(0, 0, 0, 0);
FRect := T2DIntRect.Create(0, 0, 0, 0);
{$ELSE}
FRect.create(0, 0, 0, 0);
FRect.Create(0, 0, 0, 0);
{$ENDIF}
FToolbarDispatch := nil;
@@ -108,8 +115,7 @@ end;
procedure TSpkBaseItem.SetAppearance(const Value: TSpkToolbarAppearance);
begin
FAppearance := Value;
if assigned(FToolbarDispatch) then
if Assigned(FToolbarDispatch) then
FToolbarDispatch.NotifyMetricsChanged;
end;

305
components/spktoolbar/SpkToolbar/spkt_Buttons.pas
View File

@@ -21,19 +21,22 @@ uses
SpkGUITools, SpkGraphTools, SpkMath,
spkt_Const, spkt_BaseItem, spkt_Exceptions, spkt_Tools;
type TSpkButtonState = (bsIdle,
type
TSpkButtonState = (
bsIdle,
bsBtnHottrack, bsBtnPressed,
bsDropdownHottrack, bsDropdownPressed);
bsDropdownHottrack, bsDropdownPressed
);
TSpkMouseButtonElement = (beNone, beButton, beDropdown);
TSpkButtonKind = (bkButton, bkButtonDropdown, bkDropdown);
type TSpkBaseButton = class;
TSpkBaseButton = class;
TSpkButtonActionLink = class(TActionLink)
private
protected
FClient: TSpkBaseButton;
procedure AssignClient(AClient: TObject); override;
function IsOnExecuteLinked: Boolean; override;
procedure SetCaption(const Value: string); override;
@@ -55,44 +58,39 @@ type TSpkBaseButton = class;
private
FMouseHoverElement: TSpkMouseButtonElement;
FMouseActiveElement: TSpkMouseButtonElement;
// Getters and Setters
function GetAction: TBasicAction;
procedure SetCaption(const Value: string);
procedure SetButtonKind(const Value: TSpkButtonKind);
procedure SetDropdownMenu(const Value: TPopupMenu);
protected
FCaption: string;
FOnClick: TNotifyEvent;
FActionLink: TSpkButtonActionLink;
FButtonState: TSpkButtonState;
FButtonRect: T2DIntRect;
FDropdownRect: T2DIntRect;
FButtonKind: TSpkButtonKind;
FDropdownMenu: TPopupMenu;
// *** Obs³uga rysowania ***
/// <summary>Zadaniem metody w odziedziczonych klasach jest obliczenie
/// rectów przycisku i menu dropdown w zale¿noœci od FButtonState</summary>
procedure CalcRects; virtual; abstract;
function GetDropdownPoint: T2DIntPoint; virtual; abstract;
// *** Obs³uga akcji ***
procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); virtual;
procedure DoActionChange(Sender: TObject);
procedure Click; virtual;
procedure DoActionChange(Sender: TObject);
function GetDefaultCaption: String; virtual;
// *** Gettery i settery ***
// Getters and Setters
procedure SetEnabled(const Value: boolean); override;
procedure SetDropdownMenu(const Value : TPopupMenu);
procedure SetRect(const Value: T2DIntRect); override;
procedure SetCaption(const Value : string);
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;
@@ -111,8 +109,8 @@ type TSpkBaseButton = class;
function GetRootComponent: TComponent;
published
property Caption : string read FCaption write SetCaption;
property Action: TBasicAction read GetAction write SetAction;
property Caption: string read FCaption write SetCaption;
property OnClick: TNotifyEvent read FOnClick write FOnClick;
end;
@@ -130,10 +128,10 @@ type TSpkBaseButton = class;
public
constructor Create(AOwner: TComponent); override;
procedure Draw(ABuffer: TBitmap; ClipRect: T2DIntRect); override;
function GetWidth: integer; override;
function GetTableBehaviour: TSpkItemTableBehaviour; override;
function GetGroupBehaviour: TSpkItemGroupBehaviour; override;
function GetSize: TSpkItemSize; override;
function GetTableBehaviour: TSpkItemTableBehaviour; override;
function GetWidth: integer; override;
published
property LargeImageIndex: TImageIndex read FLargeImageIndex write SetLargeImageIndex default -1;
property ButtonKind;
@@ -151,31 +149,32 @@ type TSpkBaseButton = class;
FHideFrameWhenIdle: boolean;
FShowCaption: boolean;
procedure ConstructRects(out BtnRect, DropRect: T2DIntRect);
procedure SetImageIndex(const Value: TImageIndex);
procedure SetGroupBehaviour(const Value: TSpkItemGroupBehaviour);
procedure SetHideFrameWhenIdle(const Value: boolean);
procedure SetTableBehaviour(const Value: TSpkItemTableBehaviour);
procedure SetImageIndex(const Value: TImageIndex);
procedure SetShowCaption(const Value: boolean);
procedure SetTableBehaviour(const Value: TSpkItemTableBehaviour);
protected
procedure CalcRects; override;
function GetDropdownPoint: T2DIntPoint; override;
public
constructor Create(AOwner: TComponent); override;
procedure Draw(ABuffer: TBitmap; ClipRect: T2DIntRect); override;
function GetWidth: integer; override;
function GetTableBehaviour: TSpkItemTableBehaviour; override;
function GetGroupBehaviour: TSpkItemGroupBehaviour; override;
function GetSize: TSpkItemSize; override;
function GetTableBehaviour: TSpkItemTableBehaviour; override;
function GetWidth: integer; override;
published
property ShowCaption: boolean read FShowCaption write SetShowCaption;
property TableBehaviour: TSpkItemTableBehaviour read FTableBehaviour write SetTableBehaviour;
property GroupBehaviour: TSpkItemGroupBehaviour read FGroupBehaviour write SetGroupBehaviour;
property HideFrameWhenIdle: boolean read FHideFrameWhenIdle write SetHideFrameWhenIdle;
property ImageIndex: TImageIndex read FImageIndex write SetImageIndex default -1;
property ShowCaption: boolean read FShowCaption write SetShowCaption;
property TableBehaviour: TSpkItemTableBehaviour read FTableBehaviour write SetTableBehaviour;
property ButtonKind;
property DropdownMenu;
end;
implementation
uses
@@ -191,15 +190,13 @@ end;
function TSpkButtonActionLink.IsCaptionLinked: Boolean;
begin
Result := inherited IsCaptionLinked and
Assigned(FClient) and
Result := inherited IsCaptionLinked and Assigned(FClient) and
(FClient.Caption = (Action as TCustomAction).Caption);
end;
function TSpkButtonActionLink.IsEnabledLinked: Boolean;
begin
Result := inherited IsEnabledLinked and
Assigned(FClient) and
Result := inherited IsEnabledLinked and Assigned(FClient) and
(FClient.Enabled = (Action as TCustomAction).Enabled);
end;
@@ -211,38 +208,40 @@ 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))
);
Result := inherited IsImageIndexLinked;
if (FClient is TSpkSmallButton) then
Result := Result and (TSpkSmallButton(FClient).ImageIndex = (Action as TCustomAction).ImageIndex)
else
if (FClient is TSpkLargeButton) then
Result := Result and (TSpkLargeButton(FClient).LargeImageIndex = (Action as TCustomAction).ImageIndex)
else
Result := false;
end;
function TSpkButtonActionLink.IsVisibleLinked: Boolean;
begin
Result := inherited IsVisibleLinked and
Assigned(FClient) and
Result := inherited IsVisibleLinked and Assigned(FClient) and
(FClient.Visible = (Action as TCustomAction).Visible);
end;
procedure TSpkButtonActionLink.SetCaption(const Value: string);
begin
if IsCaptionLinked then FClient.Caption := Value;
if IsCaptionLinked then
FClient.Caption := Value;
end;
procedure TSpkButtonActionLink.SetEnabled(Value: Boolean);
begin
if IsEnabledLinked then FClient.Enabled := Value;
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;
(TSpkSmallButton(FClient)).ImageIndex := Value
else
if (FClient is TSpkLargeButton) then
(TSpkLargeButton(FClient)).LargeImageIndex := Value;
end;
@@ -250,16 +249,42 @@ end;
procedure TSpkButtonActionLink.SetOnExecute(Value: TNotifyEvent);
begin
if IsOnExecuteLinked then FClient.OnClick := Value;
if IsOnExecuteLinked then
FClient.OnClick := Value;
end;
procedure TSpkButtonActionLink.SetVisible(Value: Boolean);
begin
if IsVisibleLinked then FClient.Visible := Value;
if IsVisibleLinked then
FClient.Visible := Value;
end;
{ TSpkBaseButton }
constructor TSpkBaseButton.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FCaption := GetDefaultCaption;
FButtonState := bsIdle;
FButtonKind := bkButton;
{$IFDEF EnhancedRecordSupport}
FButtonRect := T2DIntRect.Create(0, 0, 1, 1);
FDropdownRect := T2DIntRect.Create(0, 0, 1, 1);
{$ELSE}
FButtonRect.Create(0, 0, 1, 1);
FDropdownRect.Create(0, 0, 1, 1);
{$ENDIF}
FMouseHoverElement := beNone;
FMouseActiveElement := beNone;
end;
destructor TSpkBaseButton.Destroy;
begin
FreeAndNil(FActionLink);
inherited Destroy;
end;
procedure TSpkBaseButton.ActionChange(Sender: TObject; CheckDefaults: Boolean);
begin
if Sender is TCustomAction then
@@ -284,29 +309,6 @@ begin
end;
end;
constructor TSpkBaseButton.Create(AOwner : TComponent);
begin
inherited Create(AOwner);
FCaption:=GetDefaultCaption;
FButtonState:=bsIdle;
FButtonKind:=bkButton;
{$IFDEF EnhancedRecordSupport}
FButtonRect:=T2DIntRect.Create(0, 0, 1, 1);
FDropdownRect:=T2DIntRect.Create(0, 0, 1, 1);
{$ELSE}
FButtonRect.Create(0, 0, 1, 1);
FDropdownRect.Create(0, 0, 1, 1);
{$ENDIF}
FMouseHoverElement:=beNone;
FMouseActiveElement:=beNone;
end;
destructor TSpkBaseButton.Destroy;
begin
FreeAndNil(FActionLink);
inherited Destroy;
end;
procedure TSpkBaseButton.Click;
begin
if Assigned(FOnClick) then
@@ -315,19 +317,21 @@ end;
procedure TSpkBaseButton.DoActionChange(Sender: TObject);
begin
if Sender = Action then ActionChange(Sender, False);
if Sender = Action then
ActionChange(Sender, False);
end;
function TSpkBaseButton.GetAction: TBasicAction;
begin
if assigned(FActionLink) then
result:=FActionLink.Action else
result:=nil;
if Assigned(FActionLink) then
Result := FActionLink.Action
else
Result := nil;
end;
function TSpkBaseButton.GetDefaultCaption: String;
begin
result := 'Button';
Result := 'Button';
end;
function TSpkBaseButton.GetRootComponent: TComponent;
@@ -348,8 +352,8 @@ begin
result := tab.Collection.RootComponent;
end;
procedure TSpkBaseButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
Y: Integer);
procedure TSpkBaseButton.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
if FEnabled then
begin
@@ -362,7 +366,7 @@ if FEnabled then
if FButtonState <> bsBtnPressed then
begin
FButtonState := bsBtnPressed;
if assigned(FToolbarDispatch) then
if Assigned(FToolbarDispatch) then
FToolbarDispatch.NotifyVisualsChanged;
end;
end else
@@ -371,7 +375,7 @@ if FEnabled then
if FButtonState <> bsDropdownPressed then
begin
FButtonState := bsDropdownPressed;
if assigned(FToolbarDispatch) then
if Assigned(FToolbarDispatch) then
FToolbarDispatch.NotifyVisualsChanged;
end;
end else
@@ -380,7 +384,6 @@ if FEnabled then
if FMouseHoverElement = beButton then
begin
FMouseActiveElement := beButton;
if FButtonState <> bsBtnPressed then
begin
FButtonState := bsBtnPressed;
@@ -391,7 +394,6 @@ if FEnabled then
if FMouseHoverElement = beDropdown then
begin
FMouseActiveElement := beDropdown;
if FButtonState <> bsDropdownPressed then
begin
FButtonState := bsDropdownPressed;
@@ -400,7 +402,7 @@ if FEnabled then
end;
end;
end;
end
end // if FEnabled
else
begin
FMouseHoverElement := beNone;
@@ -408,8 +410,7 @@ else
if FButtonState <> bsIdle then
begin
FButtonState := bsIdle;
if assigned(FToolbarDispatch) then
if Assigned(FToolbarDispatch) then
FToolbarDispatch.NotifyVisualsChanged;
end;
end;
@@ -430,14 +431,13 @@ if FEnabled then
// Placeholder, gdyby zasz³a potrzeba obs³ugi tego zdarzenia
end;
end;
if FButtonState <> bsIdle then
begin
FButtonState := bsIdle;
if assigned(FToolbarDispatch) then
if Assigned(FToolbarDispatch) then
FToolbarDispatch.NotifyVisualsChanged;
end;
end
end // if FEnabled
else
begin
FMouseHoverElement := beNone;
@@ -445,33 +445,35 @@ else
if FButtonState <> bsIdle then
begin
FButtonState := bsIdle;
if assigned(FToolbarDispatch) then
if Assigned(FToolbarDispatch) then
FToolbarDispatch.NotifyVisualsChanged;
end;
end;
end;
procedure TSpkBaseButton.MouseMove(Shift: TShiftState; X, Y: Integer);
var NewMouseHoverElement : TSpkMouseButtonElement;
var
NewMouseHoverElement: TSpkMouseButtonElement;
begin
if FEnabled then
begin
{$IFDEF EnhancedRecordSupport}
if FButtonRect.Contains(T2DIntPoint.Create(X,Y)) then
{$ELSE}
if FButtonRect.Contains(X,Y) then
if FButtonRect.Contains(X,Y)
{$ENDIF}
NewMouseHoverElement:=beButton else
then
NewMouseHoverElement := beButton
else
if (FButtonKind = bkButtonDropdown) and
{$IFDEF EnhancedRecordSupport}
(FDropdownRect.Contains(T2DIntPoint.Create(X,Y))) then
{$ELSE}
(FDropdownRect.Contains(X,Y)) then
(FDropdownRect.Contains(X,Y))
{$ENDIF}
NewMouseHoverElement:=beDropdown else
then
NewMouseHoverElement := beDropdown
else
NewMouseHoverElement := beNone;
if FMouseActiveElement = beButton then
@@ -508,7 +510,6 @@ if FEnabled then
begin
// Z uwagi na uproszczon¹ obs³ugê myszy w przycisku, nie ma potrzeby
// informowaæ poprzedniego elementu o tym, ¿e mysz opuœci³a jego obszar.
if NewMouseHoverElement = beButton then
begin
if FButtonState <> bsBtnHottrack then
@@ -530,7 +531,7 @@ if FEnabled then
end;
FMouseHoverElement := NewMouseHoverElement;
end
end // if FEnabled
else
begin
FMouseHoverElement := beNone;
@@ -538,19 +539,17 @@ else
if FButtonState <> bsIdle then
begin
FButtonState := bsIdle;
if assigned(FToolbarDispatch) then
if Assigned(FToolbarDispatch) then
FToolbarDispatch.NotifyVisualsChanged;
end;
end;
end;
procedure TSpkBaseButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
Y: Integer);
var ClearActive : boolean;
procedure TSpkBaseButton.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
var
ClearActive: boolean;
DropPoint: T2DIntPoint;
begin
if FEnabled then
begin
@@ -570,17 +569,17 @@ if FEnabled then
begin
Click;
FButtonState := bsBtnHottrack;
if assigned(FToolbarDispatch) then
if Assigned(FToolbarDispatch) then
FToolbarDispatch.NotifyVisualsChanged;
end else
if FButtonKind = bkDropdown then
begin
if assigned(FDropdownMenu) then
if Assigned(FDropdownMenu) then
begin
DropPoint := FToolbarDispatch.ClientToScreen(GetDropdownPoint);
FDropdownMenu.Popup(DropPoint.x, DropPoint.y);
FButtonState := bsBtnHottrack;
if assigned(FToolbarDispatch) then
if Assigned(FToolbarDispatch) then
FToolbarDispatch.NotifyVisualsChanged;
end;
end;
@@ -590,31 +589,29 @@ if FEnabled then
begin
// Zdarzenie zadzia³a tylko wtedy, gdy przycisk myszy zosta³ puszczony nad
// przyciskiem DropDown
if FMouseHoverElement = beDropDown then
begin
if assigned(FDropdownMenu) then
if Assigned(FDropdownMenu) then
begin
DropPoint := FToolbarDispatch.ClientToScreen(GetDropdownPoint);
FDropdownMenu.Popup(DropPoint.x, DropPoint.y);
FButtonState := bsBtnHottrack;
if assigned(FToolbarDispatch) then
if Assigned(FToolbarDispatch) then
FToolbarDispatch.NotifyVisualsChanged;
end;
end;
end;
if (ClearActive) and (FMouseActiveElement<>FMouseHoverElement) then
if ClearActive and (FMouseActiveElement <> FMouseHoverElement) then
begin
// Z uwagi na uproszczon¹ obs³ugê, nie ma potrzeby informowaæ poprzedniego
// elementu o tym, ¿e mysz opuœci³a jego obszar.
if FMouseHoverElement = beButton then
begin
if FButtonState <> bsBtnHottrack then
begin
FButtonState := bsBtnHottrack;
if assigned(FToolbarDispatch) then
if Assigned(FToolbarDispatch) then
FToolbarDispatch.NotifyVisualsChanged;
end;
end else
@@ -623,7 +620,7 @@ if FEnabled then
if FButtonState <> bsDropdownHottrack then
begin
FButtonState := bsDropdownHottrack;
if assigned(FToolbarDispatch) then
if Assigned(FToolbarDispatch) then
FToolbarDispatch.NotifyVisualsChanged;
end;
end else
@@ -632,7 +629,7 @@ if FEnabled then
if FButtonState <> bsIdle then
begin
FButtonState := bsIdle;
if assigned(FToolbarDispatch) then
if Assigned(FToolbarDispatch) then
FToolbarDispatch.NotifyVisualsChanged;
end;
end;
@@ -642,7 +639,7 @@ if FEnabled then
begin
FMouseActiveElement:=beNone;
end;
end
end // if FEnabled
else
begin
FMouseHoverElement := beNone;
@@ -650,8 +647,7 @@ else
if FButtonState <> bsIdle then
begin
FButtonState := bsIdle;
if assigned(FToolbarDispatch) then
if Assigned(FToolbarDispatch) then
FToolbarDispatch.NotifyVisualsChanged;
end;
end;
@@ -722,6 +718,7 @@ begin
CalcRects;
end;
{ TSpkLargeButton }
procedure TSpkLargeButton.CalcRects;
@@ -1128,6 +1125,16 @@ end;
{ TSpkSmallButton }
constructor TSpkSmallButton.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FImageIndex := -1;
FTableBehaviour := tbContinuesRow;
FGroupBehaviour := gbSingleItem;
FHideFrameWhenIdle := false;
FShowCaption := true;
end;
procedure TSpkSmallButton.CalcRects;
var
RectVector: T2DIntVector;
@@ -1143,13 +1150,12 @@ begin
end;
procedure TSpkSmallButton.ConstructRects(out BtnRect, DropRect: T2DIntRect);
var BtnWidth : integer;
var
BtnWidth: integer;
DropdownWidth: Integer;
Bitmap: TBitmap;
TextWidth: Integer;
AdditionalPadding: Boolean;
begin
{$IFDEF EnhancedRecordSupport}
BtnRect := T2DIntRect.Create(0, 0, 0, 0);
@@ -1159,13 +1165,13 @@ BtnRect.Create(0, 0, 0, 0);
DropRect.Create(0, 0, 0, 0);
{$ENDIF}
if not(assigned(FToolbarDispatch)) then
if not Assigned(FToolbarDispatch) then
exit;
if not(assigned(FAppearance)) then
if not Assigned(FAppearance) then
exit;
Bitmap := FToolbarDispatch.GetTempBitmap;
if not(assigned(Bitmap)) then
if not Assigned(Bitmap) then
exit;
// *** Niezale¿nie od rodzaju, musi byæ miejsce dla ikony i/lub tekstu ***
@@ -1183,7 +1189,7 @@ if FImageIndex<>-1 then
// Tekst
if FShowCaption then
begin
Bitmap.Canvas.Font.assign(FAppearance.Element.CaptionFont);
Bitmap.Canvas.Font.Assign(FAppearance.Element.CaptionFont);
TextWidth := Bitmap.Canvas.TextWidth(FCaption);
BtnWidth := BtnWidth + SmallButtonPadding + TextWidth;
@@ -1199,15 +1205,18 @@ BtnWidth := Max(SmallButtonMinWidth, BtnWidth);
// *** Dropdown ***
case FButtonKind of
bkButton: begin
bkButton:
begin
// Lewa krawêdŸ przycisku
if FGroupBehaviour in [gbContinuesGroup, gbEndsGroup] then
BtnWidth:=BtnWidth + SmallButtonHalfBorderWidth else
BtnWidth := BtnWidth + SmallButtonHalfBorderWidth
else
BtnWidth := BtnWidth + SmallButtonBorderWidth;
// Prawa krawêdŸ przycisku
if (FGroupBehaviour in [gbBeginsGroup, gbContinuesGroup]) then
BtnWidth:=BtnWidth + SmallButtonHalfBorderWidth else
BtnWidth := BtnWidth + SmallButtonHalfBorderWidth
else
BtnWidth := BtnWidth + SmallButtonBorderWidth;
{$IFDEF EnhancedRecordSupport}
@@ -1218,10 +1227,13 @@ case FButtonKind of
DropRect.Create(0, 0, 0, 0);
{$ENDIF}
end;
bkButtonDropdown: begin
bkButtonDropdown:
begin
// Lewa krawêdŸ przycisku
if FGroupBehaviour in [gbContinuesGroup, gbEndsGroup] then
BtnWidth:=BtnWidth + SmallButtonHalfBorderWidth else
BtnWidth := BtnWidth + SmallButtonHalfBorderWidth
else
BtnWidth := BtnWidth + SmallButtonBorderWidth;
// Prawa krawêdŸ przycisku
@@ -1232,30 +1244,31 @@ case FButtonKind of
// Prawa krawêdŸ pola dropdown
if (FGroupBehaviour in [gbBeginsGroup, gbContinuesGroup]) then
DropdownWidth:=DropdownWidth + SmallButtonHalfBorderWidth else
DropdownWidth := DropdownWidth + SmallButtonHalfBorderWidth
else
DropdownWidth := DropdownWidth + SmallButtonBorderWidth;
{$IFDEF EnhancedRecordSupport}
BtnRect := T2DIntRect.Create(0, 0, BtnWidth - 1, PaneRowHeightT - 1);
DropRect:=T2DIntRect.Create(BtnRect.right+1,
0,
BtnRect.right+DropdownWidth,
PaneRowHeight - 1);
DropRect := T2DIntRect.Create(BtnRect.Right+1, 0, BtnRect.Right+DropdownWidth, PaneRowHeight - 1);
{$ELSE}
BtnRect.Create(0, 0, BtnWidth - 1, PaneRowHeight - 1);
DropRect.Create(BtnRect.right+1, 0,
BtnRect.right+DropdownWidth, PaneRowHeight - 1);
DropRect.Create(BtnRect.Right+1, 0, BtnRect.Right+DropdownWidth, PaneRowHeight - 1);
{$ENDIF}
end;
bkDropdown: begin
bkDropdown:
begin
// Lewa krawêdŸ przycisku
if FGroupBehaviour in [gbContinuesGroup, gbEndsGroup] then
BtnWidth:=BtnWidth + SmallButtonHalfBorderWidth else
BtnWidth := BtnWidth + SmallButtonHalfBorderWidth
else
BtnWidth := BtnWidth + SmallButtonBorderWidth;
// Prawa krawêdŸ przycisku
if (FGroupBehaviour in [gbBeginsGroup, gbContinuesGroup]) then
BtnWidth:=BtnWidth + SmallButtonHalfBorderWidth else
BtnWidth := BtnWidth + SmallButtonHalfBorderWidth
else
BtnWidth := BtnWidth + SmallButtonBorderWidth;
// Dodatkowy obszar na dropdown + miejsce na œrodkow¹ krawêdŸ,
@@ -1273,16 +1286,6 @@ case FButtonKind of
end;
end;
constructor TSpkSmallButton.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FImageIndex := -1;
FTableBehaviour := tbContinuesRow;
FGroupBehaviour := gbSingleItem;
FHideFrameWhenIdle := false;
FShowCaption := true;
end;
procedure TSpkSmallButton.Draw(ABuffer: TBitmap; ClipRect: T2DIntRect);
var
fontColor: TColor;

45
components/spktoolbar/SpkToolbar/spkt_Checkboxes.pas
View File

@@ -12,7 +12,6 @@ type
TSpkCustomCheckbox = class;
TSpkCheckboxActionLink = class(TSpkButtonActionLink)
private
protected
procedure SetChecked(Value: Boolean); override;
public
@@ -98,7 +97,8 @@ procedure TSpkCheckboxActionLink.SetChecked(Value: Boolean);
var
cb: TSpkCustomCheckbox;
begin
if IsCheckedLinked then begin
if IsCheckedLinked then
begin
cb := TSpkCustomCheckbox(FClient);
cb.Checked := Value;
end;
@@ -120,7 +120,8 @@ end;
procedure TSpkCustomCheckbox.ActionChange(Sender: TObject);
begin
if Sender is TCustomAction then
with TCustomAction(Sender) do begin
with TCustomAction(Sender) do
begin
if (Self.Caption = '') or (Self.Caption = GetDefaultCaption) then
Self.Caption := Caption;
if (Self.Enabled = True) then
@@ -195,7 +196,7 @@ begin
exit;
Bitmap := FToolbarDispatch.GetTempBitmap;
if not(assigned(Bitmap)) then
if not Assigned(Bitmap) then
exit;
Bitmap.Canvas.Font.Assign(FAppearance.Element.CaptionFont);
@@ -246,7 +247,8 @@ begin
end;
// Border
if (FButtonState = bsIdle) and (not(FHideFrameWhenIdle)) then begin
if (FButtonState = bsIdle) and (not(FHideFrameWhenIdle)) then
begin
with FAppearance.Element do
TButtonTools.DrawButton(
ABuffer,
@@ -265,7 +267,8 @@ begin
ClipRect
);
end else
if (FButtonState=bsBtnHottrack) then begin
if (FButtonState=bsBtnHottrack) then
begin
with FAppearance.Element do
TButtonTools.DrawButton(
ABuffer,
@@ -284,7 +287,8 @@ begin
ClipRect
);
end else
if (FButtonState = bsBtnPressed) then begin
if (FButtonState = bsBtnPressed) then
begin
with FAppearance.Element do
TButtonTools.DrawButton(
ABuffer,
@@ -305,11 +309,13 @@ begin
end;
// Checkbox
if ThemeServices.ThemesEnabled then begin
if ThemeServices.ThemesEnabled then
begin
te := ThemeServices.GetElementDetails(tbCheckboxCheckedNormal);
h := ThemeServices.GetDetailSize(te).cy;
end else
h := GetSystemMetrics(SM_CYMENUCHECK);
if (FGroupBehaviour in [gbContinuesGroup, gbEndsGroup]) then
x := FButtonRect.Left + SmallButtonHalfBorderWidth + SmallButtonPadding
else
@@ -350,40 +356,40 @@ end;
function TSpkCustomCheckbox.GetChecked: Boolean;
begin
result := (FState = cbChecked);
Result := (FState = cbChecked);
end;
function TSpkCustomCheckbox.GetDefaultCaption: String;
begin
result := 'Checkbox';
Result := 'Checkbox';
end;
function TSpkCustomCheckbox.GetGroupBehaviour: TSpkItemGroupBehaviour;
begin
result := FGroupBehaviour;
Result := FGroupBehaviour;
end;
function TSpkCustomCheckbox.GetSize: TSpkItemSize;
begin
result := isNormal;
Result := isNormal;
end;
function TSpkCustomCheckbox.GetTableBehaviour: TSpkItemTableBehaviour;
begin
result := FTableBehaviour;
Result := FTableBehaviour;
end;
function TSpkCustomCheckbox.GetWidth: integer;
var
BtnRect, DropRect: T2DIntRect;
begin
result := -1;
Result := -1;
if FToolbarDispatch = nil then
exit;
if FAppearance = nil then
exit;
ConstructRect(BtnRect);
result := BtnRect.Right + 1;
Result := BtnRect.Right + 1;
end;
procedure TSpkCustomCheckbox.MouseDown(Button: TMouseButton; Shift: TShiftState;
@@ -452,7 +458,8 @@ end;
procedure TSpkCustomCheckbox.SetState(AValue:TCheckboxState);
begin
if AValue <> FState then begin
if AValue <> FState then
begin
FState := AValue;
if Assigned(FToolbarDispatch) then
FToolbarDispatch.NotifyVisualsChanged;
@@ -477,6 +484,7 @@ end;
{ TSpkRadioButton }
constructor TSpkRadioButton.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
@@ -485,7 +493,7 @@ end;
function TSpkRadioButton.GetDefaultCaption: string;
begin
result := 'RadioButton';
Result := 'RadioButton';
end;
procedure TSpkRadioButton.SetState(AValue: TCheckboxState);
@@ -500,7 +508,8 @@ var
i: Integer;
pane: TSpkPane;
begin
if (Parent is TSpkPane) then 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

9
components/spktoolbar/SpkToolbar/spkt_Const.pas
View File

@@ -266,7 +266,6 @@ uses
procedure SpkInitLayoutConsts(FromDPI: Integer; ToDPI: Integer = 0);
begin
if not(DPI_AWARE) then
ToDPI := FromDPI;
@@ -391,21 +390,21 @@ initialization
// Sprawdzanie poprawnoœci
// £uk du¿ego przycisku
assert(LARGEBUTTON_RADIUS * 2 <= LARGEBUTTON_DROPDOWN_FIELD_SIZE);
Assert(LARGEBUTTON_RADIUS * 2 <= LARGEBUTTON_DROPDOWN_FIELD_SIZE);
// Tafla, wersja z jednym wierszem
assert(PANE_ROW_HEIGHT +
Assert(PANE_ROW_HEIGHT +
PANE_ONE_ROW_TOPPADDING +
PANE_ONE_ROW_BOTTOMPADDING <= MAX_ELEMENT_HEIGHT);
// Tafla, wersja z dwoma wierszami
assert(2*PANE_ROW_HEIGHT +
Assert(2*PANE_ROW_HEIGHT +
PANE_TWO_ROWS_TOPPADDING +
PANE_TWO_ROWS_VSPACER +
PANE_TWO_ROWS_BOTTOMPADDING <= MAX_ELEMENT_HEIGHT);
// Tafla, wersja z trzema wierszami
assert(3*PANE_ROW_HEIGHT +
Assert(3*PANE_ROW_HEIGHT +
PANE_THREE_ROWS_TOPPADDING +
2*PANE_THREE_ROWS_VSPACER +
PANE_THREE_ROWS_BOTTOMPADDING <= MAX_ELEMENT_HEIGHT);

14
components/spktoolbar/SpkToolbar/spkt_Dispatch.pas
View File

@@ -15,25 +15,23 @@ unit spkt_Dispatch;
interface
uses Classes, Controls, Graphics,
uses
Classes, Controls, Graphics,
SpkMath;
type TSpkBaseDispatch = class abstract(TObject)
type
TSpkBaseDispatch = class abstract(TObject)
private
protected
public
end;
type TSpkBaseAppearanceDispatch = class abstract(TSpkBaseDispatch)
private
protected
TSpkBaseAppearanceDispatch = class abstract(TSpkBaseDispatch)
public
procedure NotifyAppearanceChanged; virtual; abstract;
end;
type TSpkBaseToolbarDispatch = class abstract(TSpkBaseAppearanceDispatch)
private
protected
TSpkBaseToolbarDispatch = class abstract(TSpkBaseAppearanceDispatch)
public
procedure NotifyItemsChanged; virtual; abstract;
procedure NotifyMetricsChanged; virtual; abstract;

6
components/spktoolbar/SpkToolbar/spkt_Exceptions.pas
View File

@@ -14,9 +14,11 @@ unit spkt_Exceptions;
interface
uses SysUtils;
uses
SysUtils;
type InternalException = class(Exception);
type
InternalException = class(Exception);
AssignException = class(Exception);
RuntimeException = class(Exception);
ListException = class(Exception);

57
components/spktoolbar/SpkToolbar/spkt_Items.pas
View File

@@ -15,11 +15,13 @@ unit spkt_Items;
interface
uses Classes, Controls, SysUtils, Dialogs,
uses
Classes, Controls, SysUtils, Dialogs,
spkt_Appearance, spkt_Dispatch, spkt_BaseItem, spkt_Types,
spkt_Buttons, spkt_Checkboxes;
type TSpkItems = class(TSpkCollection)
type
TSpkItems = class(TSpkCollection)
private
FToolbarDispatch: TSpkBaseToolbarDispatch;
FAppearance: TSpkToolbarAppearance;
@@ -30,12 +32,13 @@ type TSpkItems = class(TSpkCollection)
// *** Gettery i settery ***
procedure SetToolbarDispatch(const Value: TSpkBaseToolbarDispatch);
function GetItems(index: integer): TSpkBaseItem; reintroduce;
function GetItems(AIndex: integer): TSpkBaseItem; reintroduce;
procedure SetAppearance(const Value: TSpkToolbarAppearance);
procedure SetImages(const Value: TImageList);
procedure SetDisabledImages(const Value: TImageList);
procedure SetLargeImages(const Value: TImageList);
procedure SetDisabledLargeImages(const Value: TImageList);
public
function AddLargeButton: TSpkLargeButton;
function AddSmallButton: TSpkSmallButton;
@@ -87,22 +90,21 @@ begin
AddItem(Result);
end;
function TSpkItems.GetItems(index: integer): TSpkBaseItem;
function TSpkItems.GetItems(AIndex: integer): TSpkBaseItem;
begin
result:=TSpkBaseItem(inherited Items[index]);
Result := TSpkBaseItem(inherited Items[AIndex]);
end;
procedure TSpkItems.Notify(Item: TComponent;
Operation : TOperation);
procedure TSpkItems.Notify(Item: TComponent; Operation: TOperation);
begin
inherited Notify(Item, Operation);
case Operation of
opInsert: begin
opInsert:
begin
// Ustawienie dyspozytora na nil spowoduje, ¿e podczas
// przypisywania w³asnoœci nie bêd¹ wo³ane metody Notify*
TSpkBaseItem(Item).ToolbarDispatch := nil;
TSpkBaseItem(Item).Appearance := FAppearance;
TSpkBaseItem(Item).Images := FImages;
TSpkBaseItem(Item).DisabledImages := FDisabledImages;
@@ -110,7 +112,8 @@ begin
TSpkBaseItem(Item).DisabledLargeImages := FDisabledLargeImages;
TSpkBaseItem(Item).ToolbarDispatch := FToolbarDispatch;
end;
opRemove: begin
opRemove:
if not (csDestroying in Item.ComponentState) then
begin
TSpkBaseItem(Item).ToolbarDispatch := nil;
@@ -122,12 +125,10 @@ begin
end;
end;
end;
end;
procedure TSpkItems.SetAppearance(const Value: TSpkToolbarAppearance);
var i: Integer;
var
i: Integer;
begin
FAppearance := Value;
for i := 0 to Count - 1 do
@@ -135,9 +136,8 @@ begin
end;
procedure TSpkItems.SetDisabledImages(const Value: TImageList);
var i: Integer;
var
i: Integer;
begin
FDisabledImages := Value;
for i := 0 to Count - 1 do
@@ -145,9 +145,8 @@ begin
end;
procedure TSpkItems.SetDisabledLargeImages(const Value: TImageList);
var i: Integer;
var
i: Integer;
begin
FDisabledLargeImages := Value;
for i := 0 to Count - 1 do
@@ -155,9 +154,8 @@ begin
end;
procedure TSpkItems.SetImages(const Value: TImageList);
var i: Integer;
var
i: Integer;
begin
FImages := Value;
for i := 0 to Count - 1 do
@@ -165,9 +163,8 @@ begin
end;
procedure TSpkItems.SetLargeImages(const Value: TImageList);
var i: Integer;
var
i: Integer;
begin
FLargeImages := Value;
for i := 0 to Count - 1 do
@@ -175,9 +172,8 @@ begin
end;
procedure TSpkItems.SetToolbarDispatch(const Value: TSpkBaseToolbarDispatch);
var i : integer;
var
i : integer;
begin
FToolbarDispatch := Value;
for i := 0 to Count - 1 do
@@ -187,8 +183,7 @@ end;
procedure TSpkItems.Update;
begin
inherited Update;
if assigned(FToolbarDispatch) then
if Assigned(FToolbarDispatch) then
FToolbarDispatch.NotifyItemsChanged;
end;

359
components/spktoolbar/SpkToolbar/spkt_Pane.pas
View File

@@ -15,14 +15,16 @@ unit spkt_Pane;
interface
uses Graphics, Controls, Classes, SysUtils, Math, Dialogs,
uses
Graphics, Controls, Classes, SysUtils, Math, Dialogs,
SpkGraphTools, SpkGUITools, SpkMath,
spkt_Appearance, spkt_Const, spkt_Dispatch, spkt_Exceptions,
spkt_BaseItem, spkt_Items, spkt_Types;
type TSpkPaneState = (psIdle, psHover);
type
TSpkPaneState = (psIdle, psHover);
type TSpkMousePaneElementType = (peNone, pePaneArea, peItem);
TSpkMousePaneElementType = (peNone, pePaneArea, peItem);
TSpkMousePaneElement = record
ElementType: TSpkMousePaneElementType;
@@ -30,17 +32,17 @@ type TSpkMousePaneElementType = (peNone, pePaneArea, peItem);
end;
T2DIntRectArray = array of T2DIntRect;
TSpkPaneItemsLayout = record
Rects: T2DIntRectArray;
Width: integer;
end;
type TSpkPane = class;
TSpkPane = class;
TSpkPane = class(TSpkComponent)
private
FPaneState: TSpkPaneState;
FMouseHoverElement: TSpkMousePaneElement;
FMouseActiveElement: TSpkMousePaneElement;
protected
@@ -73,6 +75,7 @@ type TSpkPane = class;
procedure SetDisabledLargeImages(const Value: TImageList);
procedure SetRect(ARect : T2DIntRect);
procedure SetToolbarDispatch(const Value: TSpkBaseToolbarDispatch);
public
// *** Konstruktor, destruktor ***
constructor Create(AOwner: TComponent); override;
@@ -80,11 +83,9 @@ type TSpkPane = class;
// *** Obs³uga gryzonia ***
procedure MouseLeave;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure MouseMove(Shift: TShiftState; X, Y: Integer);
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
// *** Geometria i rysowanie ***
function GetWidth: integer;
@@ -102,12 +103,13 @@ type TSpkPane = class;
property LargeImages: TImageList read FLargeImages write SetLargeImages;
property DisabledLargeImages: TImageList read FDisabledLargeImages write SetDisabledLargeImages;
property Items: TSpkItems read FItems;
published
property Caption: string read FCaption write SetCaption;
property Visible: boolean read FVisible write SetVisible;
end;
type TSpkPanes = class(TSpkCollection)
TSpkPanes = class(TSpkCollection)
private
protected
FToolbarDispatch: TSpkBaseToolbarDispatch;
@@ -119,16 +121,17 @@ type TSpkPanes = class(TSpkCollection)
// *** Gettery i settery ***
procedure SetToolbarDispatch(const Value: TSpkBaseToolbarDispatch);
function GetItems(index: integer): TSpkPane; reintroduce;
function GetItems(AIndex: integer): TSpkPane; reintroduce;
procedure SetAppearance(const Value: TSpkToolbarAppearance);
procedure SetImages(const Value: TImageList);
procedure SetDisabledImages(const Value: TImageList);
procedure SetLargeImages(const Value: TImageList);
procedure SetDisabledLargeImages(const Value: TImageList);
public
// *** Dodawanie i wstawianie elementów ***
function Add: TSpkPane;
function Insert(index : integer) : TSpkPane;
function Insert(AIndex: integer): TSpkPane;
// *** Reakcja na zmiany listy ***
procedure Notify(Item: TComponent; Operation: TOperation); override;
@@ -143,42 +146,11 @@ type TSpkPanes = class(TSpkCollection)
property DisabledLargeImages: TImageList read FDisabledLargeImages write SetDisabledLargeImages;
end;
implementation
{ TSpkPane }
procedure TSpkPane.SetRect(ARect: T2DIntRect);
var Pt : T2DIntPoint;
i : integer;
Layout : TSpkPaneItemsLayout;
begin
FRect:=ARect;
// Obliczamy layout
Layout:=GenerateLayout;
{$IFDEF EnhancedRecordSupport}
Pt:=T2DIntPoint.create(ARect.left + SpkLayoutSizes.PANE_BORDER_SIZE + SpkLayoutSizes.PANE_LEFT_PADDING, ARect.top + SpkLayoutSizes.PANE_BORDER_SIZE);
{$ELSE}
Pt.create(ARect.left + PaneBorderSize + PaneLeftPadding, ARect.top + PaneBorderSize);
{$ENDIF}
if length(Layout.Rects)>0 then
begin
for i := 0 to high(Layout.Rects) do
FItems[i].Rect:=Layout.Rects[i] + Pt;
end;
end;
procedure TSpkPane.SetToolbarDispatch(const Value: TSpkBaseToolbarDispatch);
begin
FToolbarDispatch := Value;
FItems.ToolbarDispatch:=FToolbarDispatch;
end;
constructor TSpkPane.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
@@ -191,9 +163,9 @@ begin
FCaption := 'Pane';
{$IFDEF EnhancedRecordSupport}
FRect:=T2DIntRect.create(0,0,0,0);
FRect := T2DIntRect.Create(0,0,0,0);
{$ELSE}
FRect.create(0,0,0,0);
FRect.Create(0,0,0,0);
{$ENDIF}
FToolbarDispatch := nil;
FAppearance := nil;
@@ -209,20 +181,52 @@ begin
FItems.Appearance := FAppearance;
end;
procedure TSpkPane.DefineProperties(Filer: TFiler);
begin
inherited DefineProperties(Filer);
Filer.DefineProperty('Items',FItems.ReadNames,FItems.WriteNames,true);
end;
destructor TSpkPane.Destroy;
begin
FItems.Free;
inherited Destroy;
end;
procedure TSpkPane.SetRect(ARect: T2DIntRect);
var
Pt: T2DIntPoint;
i: integer;
Layout: TSpkPaneItemsLayout;
begin
FRect := ARect;
// Obliczamy layout
Layout := GenerateLayout;
{$IFDEF EnhancedRecordSupport}
Pt := T2DIntPoint.Create(
{$ELSE}
Pt.Create(
{$ENDIF}
ARect.Left + PaneBorderSize + PaneLeftPadding,
ARect.Top + PaneBorderSize
);
if Length(Layout.Rects) > 0 then
begin
for i := 0 to High(Layout.Rects) do
FItems[i].Rect:=Layout.Rects[i] + Pt;
end;
end;
procedure TSpkPane.SetToolbarDispatch(const Value: TSpkBaseToolbarDispatch);
begin
FToolbarDispatch := Value;
FItems.ToolbarDispatch := FToolbarDispatch;
end;
procedure TSpkPane.DefineProperties(Filer: TFiler);
begin
inherited DefineProperties(Filer);
Filer.DefineProperty('Items', FItems.ReadNames, FItems.WriteNames, true);
end;
procedure TSpkPane.Draw(ABuffer: TBitmap; ClipRect: T2DIntRect);
var
x: Integer;
@@ -238,6 +242,7 @@ begin
// * Brak dyspozytora
if FToolbarDispatch = nil then
exit;
// * Brak appearance
if FAppearance = nil then
exit;
@@ -429,13 +434,12 @@ begin
// Elementy
for i := 0 to FItems.Count - 1 do
if FItems[i].Visible then
Fitems[i].Draw(ABuffer, ClipRect);
FItems[i].Draw(ABuffer, ClipRect);
end;
function TSpkPane.FindItemAt(x, y: integer): integer;
var i : integer;
var
i: integer;
begin
result := -1;
i := FItems.count-1;
@@ -448,7 +452,7 @@ while (i>=0) and (result=-1) do
{$ELSE}
if FItems[i].Rect.Contains(x,y) then
{$ENDIF}
result:=i;
Result := i;
end;
dec(i);
end;
@@ -460,12 +464,12 @@ FItems.RemoveReference(AItem);
end;
function TSpkPane.GenerateLayout: TSpkPaneItemsLayout;
type TLayoutRow = array of integer;
type
TLayoutRow = array of integer;
TLayoutColumn = array of TLayoutRow;
TLayout = array of TLayoutColumn;
var Layout : TLayout;
var
Layout: TLayout;
CurrentColumn: integer;
CurrentRow: integer;
CurrentItem: integer;
@@ -480,30 +484,29 @@ var Layout : TLayout;
rows: Integer;
ItemWidth: Integer;
tmpRect: T2DIntRect;
begin
setlength(result.Rects,FItems.count);
result.Width:=0;
SetLength(Result.Rects, FItems.count);
Result.Width := 0;
if FItems.count=0 then
if FItems.Count = 0 then
exit;
// Notatka: algorytm jest skonstruowany w ten sposób, ¿e trójka: CurrentColumn,
// CurrentRow oraz CurrentItem wskazuje na element, którego jeszcze nie
// ma (zaraz za ostatnio dodanym elementem).
setlength(Layout,1);
SetLength(Layout, 1);
CurrentColumn := 0;
setlength(Layout[CurrentColumn],1);
SetLength(Layout[CurrentColumn], 1);
CurrentRow := 0;
setlength(Layout[CurrentColumn][CurrentRow],0);
SetLength(Layout[CurrentColumn][CurrentRow], 0);
CurrentItem := 0;
ForceNewColumn := false;
for i := 0 to FItems.count - 1 do
for i := 0 to FItems.Count - 1 do
begin
ItemTableBehaviour := FItems[i].GetTableBehaviour;
ItemSize := FItems[i].GetSize;
@@ -518,13 +521,13 @@ for i := 0 to FItems.count - 1 do
// Jeœli ju¿ jesteœmy na pocz¹tku nowej kolumny, nie ma nic do roboty.
if (CurrentRow <> 0) or (CurrentItem <> 0) then
begin
setlength(Layout, length(Layout)+1);
CurrentColumn:=high(Layout);
SetLength(Layout, Length(Layout)+1);
CurrentColumn := High(Layout);
setlength(Layout[CurrentColumn], 1);
SetLength(Layout[CurrentColumn], 1);
CurrentRow := 0;
setlength(Layout[CurrentColumn][CurrentRow],0);
SetLength(Layout[CurrentColumn][CurrentRow], 0);
CurrentItem := 0;
end;
end else
@@ -534,19 +537,19 @@ for i := 0 to FItems.count - 1 do
// Jeœli ju¿ jesteœmy na pocz¹tku nowego wiersza, nie ma nic do roboty.
if CurrentItem <> 0 then
begin
setlength(Layout[CurrentColumn], length(Layout[CurrentColumn])+1);
SetLength(Layout[CurrentColumn], Length(Layout[CurrentColumn])+1);
inc(CurrentRow);
CurrentItem := 0;
end;
end;
ForceNewColumn:=ItemSize = isLarge;
ForceNewColumn := (ItemSize = isLarge);
// Jeœli element jest widoczny, dodajemy go w aktualnej kolumnie i aktualnym
// wierszu.
if FItems[i].Visible then
begin
setlength(Layout[CurrentColumn][CurrentRow], length(Layout[CurrentColumn][CurrentRow])+1);
SetLength(Layout[CurrentColumn][CurrentRow], Length(Layout[CurrentColumn][CurrentRow])+1);
Layout[CurrentColumn][CurrentRow][CurrentItem] := i;
inc(CurrentItem);
@@ -559,18 +562,17 @@ for i := 0 to FItems.count - 1 do
// Najpierw wype³niamy je pustymi danymi, które zape³ni¹ miejsce elementów
// niewidocznych.
{$IFDEF EnhancedRecordSupport}
for i := 0 to FItems.count - 1 do
result.Rects[i]:=T2DIntRect.create(-1, -1, -1, -1);
for i := 0 to FItems.Count - 1 do
Result.Rects[i] := T2DIntRect.Create(-1, -1, -1, -1);
{$ELSE}
for i := 0 to FItems.count - 1 do
result.Rects[i].create(-1, -1, -1, -1);
for i := 0 to FItems.Count - 1 do
Result.Rects[i].Create(-1, -1, -1, -1);
{$ENDIF}
MaxRowX := 0;
// Teraz iterujemy po layoucie, ustalaj¹c recty.
if length(Layout)>0 then
for c := 0 to high(Layout) do
for c := 0 to High(Layout) do
begin
if c>0 then
begin
@@ -584,14 +586,12 @@ if length(Layout)>0 then
ColumnX := LastX;
rows:=length(Layout[c]);
if rows>0 then
rows := Length(Layout[c]);
for r := 0 to rows - 1 do
begin
LastX := ColumnX;
if length(Layout[c][r])>0 then
for i := 0 to high(Layout[c][r]) do
for i := 0 to High(Layout[c][r]) do
begin
ItemGroupBehaviour := FItems[Layout[c][r][i]].GetGroupBehaviour;
ItemSize := FItems[Layout[c][r][i]].GetSize;
@@ -599,12 +599,12 @@ if length(Layout)>0 then
if ItemSize = isLarge then
begin
tmpRect.top:=PaneFullRowTopPadding;
tmpRect.bottom:=tmpRect.top + PaneFullRowHeight - 1;
tmpRect.left:=LastX;
tmpRect.right:=LastX + ItemWidth - 1;
tmpRect.Top := PaneFullRowTopPadding;
tmpRect.Bottom := tmpRect.Top + PaneFullRowHeight - 1;
tmpRect.Left := LastX;
tmpRect.Right := LastX + ItemWidth - 1;
LastX:=tmpRect.right + 1;
LastX := tmpRect.Right + 1;
if LastX > MaxRowX then
MaxRowX := LastX;
end
@@ -613,50 +613,47 @@ if length(Layout)>0 then
if ItemGroupBehaviour in [gbContinuesGroup, gbEndsGroup] then
begin
tmpRect.Left := LastX;
tmpRect.right:=tmpRect.Left + ItemWidth - 1;
tmpRect.Right := tmpRect.Left + ItemWidth - 1;
end
else
begin
// Jeœli element nie jest pierwszy, musi zostaæ
// odsuniêty marginesem od poprzedniego
if i>0 then
tmpRect.Left:=LastX + PaneGroupSpacer else
tmpRect.Left := LastX + PaneGroupSpacer
else
tmpRect.Left := LastX;
tmpRect.right:=tmpRect.Left + ItemWidth - 1;
tmpRect.Right := tmpRect.Left + ItemWidth - 1;
end;
{$REGION 'Obliczanie tmpRect.top i bottom'}
case rows of
1 : begin
tmpRect.top:=PaneOneRowTopPadding;
tmpRect.bottom:=tmpRect.top + PaneRowHeight - 1;
tmpRect.Top := PaneOneRowTopPadding;
tmpRect.Bottom := tmpRect.Top + PaneRowHeight - 1;
end;
2 : begin
case r of
2 : case r of
0 : begin
tmpRect.top:=PaneTwoRowsTopPadding;
tmpRect.bottom:=tmpRect.top + PaneRowHeight - 1;
tmpRect.Top := PaneTwoRowsTopPadding;
tmpRect.Bottom := tmpRect.top + PaneRowHeight - 1;
end;
1 : begin
tmpRect.top:=PaneTwoRowsTopPadding + PaneRowHeight + PaneTwoRowsVSpacer;
tmpRect.bottom:=tmpRect.top + PaneRowHeight - 1;
tmpRect.Top := PaneTwoRowsTopPadding + PaneRowHeight + PaneTwoRowsVSpacer;
tmpRect.Bottom := tmpRect.top + PaneRowHeight - 1;
end;
end;
end;
3 : begin
case r of
3 : case r of
0 : begin
tmpRect.top:=PaneThreeRowsTopPadding;
tmpRect.bottom:=tmpRect.top + PaneRowHeight - 1;
tmpRect.Top := PaneThreeRowsTopPadding;
tmpRect.Bottom := tmpRect.Top + PaneRowHeight - 1;
end;
1 : begin
tmpRect.top:=PaneThreeRowsTopPadding + PaneRowHeight + PaneThreeRowsVSpacer;
tmpRect.bottom:=tmpRect.top + PaneRowHeight - 1;
tmpRect.Top := PaneThreeRowsTopPadding + PaneRowHeight + PaneThreeRowsVSpacer;
tmpRect.Bottom := tmpRect.Top + PaneRowHeight - 1;
end;
2 : begin
tmpRect.top:=PaneThreeRowsTopPadding + 2 * PaneRowHeight + 2 * PaneThreeRowsVSpacer;
tmpRect.bottom:=tmpRect.top + PaneRowHeight - 1;
end;
tmpRect.Top := PaneThreeRowsTopPadding + 2 * PaneRowHeight + 2 * PaneThreeRowsVSpacer;
tmpRect.Bottom := tmpRect.Top + PaneRowHeight - 1;
end;
end;
end;
@@ -681,23 +678,20 @@ var
i: Integer;
begin
inherited;
if FItems.Count>0 then
for i := 0 to FItems.Count - 1 do
Proc(FItems.Items[i]);
end;
function TSpkPane.GetWidth: integer;
var tmpBitmap : TBitmap;
var
tmpBitmap: TBitmap;
PaneCaptionWidth, PaneElementsWidth: integer;
TextW: integer;
ElementsW: integer;
Layout: TSpkPaneItemsLayout;
begin
// Przygotowywanie...
result:=-1;
Result := -1;
if FToolbarDispatch = nil then
exit;
if FAppearance = nil then
@@ -706,7 +700,7 @@ if FAppearance=nil then
tmpBitmap := FToolbarDispatch.GetTempBitmap;
if tmpBitmap = nil then
exit;
tmpBitmap.Canvas.font.assign(FAppearance.Pane.CaptionFont);
tmpBitmap.Canvas.Font.Assign(FAppearance.Pane.CaptionFont);
// *** Minimalna szerokoϾ tafli (tekstu) ***
TextW := tmpBitmap.Canvas.TextWidth(FCaption);
@@ -718,7 +712,7 @@ ElementsW:=Layout.Width;
PaneElementsWidth := PaneBorderSize + PaneLeftPadding + ElementsW + PaneRightPadding + PaneBorderSize;
// *** Ustawianie szerokoœci tafli ***
result:=max(PaneCaptionWidth, PaneElementsWidth);
Result := Max(PaneCaptionWidth, PaneElementsWidth);
end;
procedure TSpkPane.Loaded;
@@ -728,8 +722,8 @@ begin
FItems.ProcessNames(self.Owner);
end;
procedure TSpkPane.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
Y: Integer);
procedure TSpkPane.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
if FMouseActiveElement.ElementType = peItem then
begin
@@ -748,7 +742,6 @@ if FMouseActiveElement.ElementType = peNone then
begin
FMouseActiveElement.ElementType := peItem;
FMouseActiveElement.ElementIndex := FMouseHoverElement.ElementIndex;
FItems[FMouseHoverElement.ElementIndex].MouseDown(Button, Shift, X, Y);
end
else
@@ -761,7 +754,6 @@ if FMouseActiveElement.ElementType = peNone then
begin
FMouseActiveElement.ElementType := pePaneArea;
FMouseActiveElement.ElementIndex := -1;
// Placeholder, jeœli zajdzie potrzeba obs³ugi tego zdarzenia.
end;
end;
@@ -790,16 +782,15 @@ FMouseHoverElement.ElementIndex:=-1;
if FPaneState <> psIdle then
begin
FPaneState := psIdle;
if assigned(FToolbarDispatch) then
if Assigned(FToolbarDispatch) then
FToolbarDispatch.NotifyVisualsChanged;
end;
end;
procedure TSpkPane.MouseMove(Shift: TShiftState; X, Y: Integer);
var i : integer;
var
i: integer;
NewMouseHoverElement: TSpkMousePaneElement;
begin
// MouseMove jest wywo³ywany tylko, gdy tafla jest aktywna, b¹dŸ gdy
// mysz rusza siê wewn¹trz jej obszaru. Wobec tego zawsze nale¿y
@@ -808,19 +799,19 @@ begin
if FPaneState = psIdle then
begin
FPaneState := psHover;
if assigned(FToolbarDispatch) then
if Assigned(FToolbarDispatch) then
FToolbarDispatch.NotifyVisualsChanged;
end;
// Szukamy obiektu pod mysz¹
i:=FindItemAt(x, y);
i := FindItemAt(X, Y);
if i <> -1 then
begin
NewMouseHoverElement.ElementType := peItem;
NewMouseHoverElement.ElementIndex := i;
end else
if (X>=FRect.left) and (Y>=FRect.top) and
(X<=FRect.right) and (Y<=FRect.bottom) then
if (X >= FRect.Left) and (Y >= FRect.Top) and
(X <= FRect.Right) and (Y <= FRect.Bottom) then
begin
NewMouseHoverElement.ElementType := pePaneArea;
NewMouseHoverElement.ElementIndex := -1;
@@ -871,11 +862,10 @@ if FMouseActiveElement.ElementType = peNone then
FMouseHoverElement := NewMouseHoverElement;
end;
procedure TSpkPane.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
Y: Integer);
var ClearActive : boolean;
procedure TSpkPane.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
var
ClearActive: boolean;
begin
ClearActive := not (ssLeft in Shift) and not (ssMiddle in Shift) and not (ssRight in Shift);
@@ -917,7 +907,7 @@ if ClearActive and
if FPaneState <> psIdle then
begin
FPaneState := psIdle;
if assigned(FToolbarDispatch) then
if Assigned(FToolbarDispatch) then
FToolbarDispatch.NotifyVisualsChanged;
end;
end;
@@ -939,7 +929,7 @@ end;
procedure TSpkPane.SetCaption(const Value: string);
begin
FCaption := Value;
if assigned(FToolbarDispatch) then
if Assigned(FToolbarDispatch) then
FToolbarDispatch.NotifyMetricsChanged;
end;
@@ -970,11 +960,11 @@ end;
procedure TSpkPane.SetVisible(const Value: boolean);
begin
FVisible := Value;
if assigned(FToolbarDispatch) then
if Assigned(FToolbarDispatch) then
FToolbarDispatch.NotifyItemsChanged;
end;
{ TSpkPanes }
function TSpkPanes.Add: TSpkPane;
@@ -984,57 +974,53 @@ begin
AddItem(Result);
end;
function TSpkPanes.GetItems(index: integer): TSpkPane;
function TSpkPanes.GetItems(AIndex: integer): TSpkPane;
begin
result:=TSpkPane(inherited Items[index]);
Result := TSpkPane(inherited Items[AIndex]);
end;
function TSpkPanes.Insert(index: integer): TSpkPane;
var Owner, Parent : TComponent;
function TSpkPanes.Insert(AIndex: integer): TSpkPane;
var
lOwner, lParent: TComponent;
i: Integer;
begin
if (index<0) or (index>self.Count) then
raise InternalException.create('TSpkPanes.Insert: Nieprawid³owy indeks!');
if (AIndex < 0) or (AIndex > self.Count) then
raise InternalException.Create('TSpkPanes.Insert: Nieprawid³owy indeks!');
if FRootComponent<>nil then
begin
Owner:=FRootComponent.Owner;
Parent:=FRootComponent;
lOwner := FRootComponent.Owner;
lParent := FRootComponent;
end
else
begin
Owner:=nil;
Parent:=nil;
lOwner := nil;
lParent := nil;
end;
result:=TSpkPane.Create(Owner);
result.Parent:=Parent;
Result := TSpkPane.Create(lOwner);
Result.Parent := lParent;
if FRootComponent <> nil then
begin
i := 0;
while FRootComponent.Owner.FindComponent('SpkPane'+inttostr(i))<>nil do
while FRootComponent.Owner.FindComponent('SpkPane'+IntToStr(i)) <> nil do
inc(i);
result.Name:='SpkPane'+inttostr(i);
Result.Name := 'SpkPane' + IntToStr(i);
end;
InsertItem(index,result);
InsertItem(AIndex, Result);
end;
procedure TSpkPanes.Notify(Item: TComponent;
Operation : TOperation);
procedure TSpkPanes.Notify(Item: TComponent; Operation: TOperation);
begin
inherited Notify(Item, Operation);
case Operation of
opInsert: begin
opInsert:
begin
// Ustawienie dyspozytora na nil spowoduje, ¿e podczas
// przypisywania w³asnoœci nie bêd¹ wo³ane metody Notify*
TSpkPane(Item).ToolbarDispatch := nil;
TSpkPane(Item).Appearance := FAppearance;
TSpkPane(Item).Images := FImages;
TSpkPane(Item).DisabledImages := FDisabledImages;
@@ -1042,7 +1028,7 @@ begin
TSpkPane(Item).DisabledLargeImages := FDisabledLargeImages;
TSpkPane(Item).ToolbarDispatch := FToolbarDispatch;
end;
opRemove: begin
opRemove:
if not(csDestroying in Item.ComponentState) then
begin
TSpkPane(Item).ToolbarDispatch := nil;
@@ -1054,15 +1040,13 @@ begin
end;
end;
end;
end;
procedure TSpkPanes.SetImages(const Value: TImageList);
var
I: Integer;
begin
FImages := Value;
if self.Count>0 then
for I := 0 to self.count - 1 do
for I := 0 to self.Count - 1 do
Items[i].Images := Value;
end;
@@ -1071,63 +1055,52 @@ var
I: Integer;
begin
FLargeImages := Value;
if self.Count>0 then
for I := 0 to self.count - 1 do
for I := 0 to self.Count - 1 do
Items[i].LargeImages := Value;
end;
procedure TSpkPanes.SetToolbarDispatch(const Value: TSpkBaseToolbarDispatch);
var i : integer;
var
i: integer;
begin
FToolbarDispatch := Value;
if self.Count>0 then
for i := 0 to self.count - 1 do
for i := 0 to self.Count - 1 do
Items[i].ToolbarDispatch := FToolbarDispatch;
end;
procedure TSpkPanes.SetAppearance(const Value: TSpkToolbarAppearance);
var i: Integer;
var
i: Integer;
begin
FAppearance := Value;
if self.Count>0 then
for i := 0 to self.count - 1 do
for i := 0 to self.Count - 1 do
Items[i].Appearance := FAppearance;
if FToolbarDispatch <> nil then
FToolbarDispatch.NotifyMetricsChanged;
end;
procedure TSpkPanes.SetDisabledImages(const Value: TImageList);
var I: Integer;
var
I: Integer;
begin
FDisabledImages := Value;
if self.Count>0 then
for I := 0 to self.count - 1 do
for I := 0 to self.Count - 1 do
Items[i].DisabledImages := Value;
end;
procedure TSpkPanes.SetDisabledLargeImages(const Value: TImageList);
var
I: Integer;
begin
FDisabledLargeImages := Value;
if self.Count>0 then
for I := 0 to self.count - 1 do
for I := 0 to self.Count - 1 do
Items[i].DisabledLargeImages := Value;
end;
procedure TSpkPanes.Update;
begin
inherited Update;
if assigned(FToolbarDispatch) then
if Assigned(FToolbarDispatch) then
FToolbarDispatch.NotifyItemsChanged;
end;

337
components/spktoolbar/SpkToolbar/spkt_Tab.pas
View File

@@ -15,12 +15,14 @@ unit spkt_Tab;
interface
uses Graphics, Controls, Classes, SysUtils,
uses
Graphics, Controls, Classes, SysUtils,
SpkMath,
spkt_Appearance, spkt_Const, spkt_Dispatch, spkt_Exceptions,
spkt_Pane, spkt_Types;
type TSpkTab = class;
type
TSpkTab = class;
TSpkMouseTabElementType = (etNone, etTabArea, etPane);
@@ -32,7 +34,6 @@ type TSpkTab = class;
TSpkTabAppearanceDispatch = class(TSpkBaseAppearanceDispatch)
private
FTab: TSpkTab;
protected
public
// *** Konstruktor ***
constructor Create(ATab: TSpkTab);
@@ -45,10 +46,8 @@ type TSpkTab = class;
private
FAppearanceDispatch: TSpkTabAppearanceDispatch;
FAppearance: TSpkToolbarAppearance;
FMouseHoverElement: TSpkMouseTabElement;
FMouseActiveElement: TSpkMouseTabElement;
FOnClick: TNotifyEvent;
protected
@@ -57,10 +56,8 @@ type TSpkTab = class;
FVisible: boolean;
FOverrideAppearance: boolean;
FCustomAppearance: TSpkToolbarAppearance;
FPanes: TSpkPanes;
FRect: T2DIntRect;
FImages: TImageList;
FDisabledImages: TImageList;
FLargeImages: TImageList;
@@ -89,6 +86,7 @@ type TSpkTab = class;
procedure SetDisabledLargeImages(const Value: TImageList);
procedure SetRect(ARect: T2DIntRect);
procedure SetToolbarDispatch(const Value: TSpkBaseToolbarDispatch);
public
// *** Konstruktor, destruktor ***
constructor Create(AOwner: TComponent); override;
@@ -100,11 +98,9 @@ type TSpkTab = class;
// *** Obs³uga gryzonia ***
procedure MouseLeave;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure MouseMove(Shift: TShiftState; X, Y: Integer);
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
// *** Obs³uga zdarzeñ dyspozytora ***
procedure NotifyAppearanceChanged;
@@ -116,13 +112,13 @@ type TSpkTab = class;
property ToolbarDispatch: TSpkBaseToolbarDispatch read FToolbarDispatch write SetToolbarDispatch;
property Appearance: TSpkToolbarAppearance read FAppearance write SetAppearance;
property Panes: TSpkPanes read FPanes;
property Rect: T2DIntRect read FRect write SetRect;
property Images: TImageList read FImages write SetImages;
property DisabledImages: TImageList read FDisabledImages write SetDisabledImages;
property LargeImages: TImageList read FLargeImages write SetLargeImages;
property DisabledLargeImages: TImageList read FDisabledLargeImages write SetDisabledLargeImages;
published
property CustomAppearance: TSpkToolbarAppearance read FCustomAppearance write SetCustomAppearance;
property Caption: string read FCaption write SetCaption;
@@ -131,8 +127,7 @@ type TSpkTab = class;
property OnClick: TNotifyEvent read FOnClick write FOnClick;
end;
type TSpkTabs = class(TSpkCollection)
private
TSpkTabs = class(TSpkCollection)
protected
FToolbarDispatch: TSpkBaseToolbarDispatch;
FAppearance: TSpkToolbarAppearance;
@@ -140,9 +135,8 @@ type TSpkTabs = class(TSpkCollection)
FDisabledImages: TImageList;
FLargeImages: TImageList;
FDisabledLargeImages: TImageList;
procedure SetToolbarDispatch(const Value: TSpkBaseToolbarDispatch);
function GetItems(index: integer): TSpkTab; reintroduce;
function GetItems(AIndex: integer): TSpkTab; reintroduce;
procedure SetAppearance(const Value: TSpkToolbarAppearance);
procedure SetImages(const Value: TImageList);
procedure SetDisabledImages(const Value: TImageList);
@@ -150,8 +144,7 @@ type TSpkTabs = class(TSpkCollection)
procedure SetDisabledLargeImages(const Value: TImageList);
public
function Add: TSpkTab;
function Insert(index : integer) : TSpkTab;
function Insert(AIndex: integer): TSpkTab;
procedure Notify(Item: TComponent; Operation: TOperation); override;
procedure Update; override;
@@ -164,6 +157,7 @@ type TSpkTabs = class(TSpkCollection)
property DisabledLargeImages: TImageList read FDisabledLargeImages write SetDisabledLargeImages;
end;
implementation
{ TSpkTabDispatch }
@@ -176,124 +170,110 @@ end;
procedure TSpkTabAppearanceDispatch.NotifyAppearanceChanged;
begin
if assigned(FTab) then
if Assigned(FTab) then
FTab.NotifyAppearanceChanged;
end;
{ TSpkTab }
function TSpkTab.AtLeastOnePaneVisible: boolean;
var i : integer;
PaneVisible : boolean;
begin
result:=FPanes.count>0;
if result then
begin
PaneVisible:=false;
i:=FPanes.count-1;
while (i>=0) and not(PaneVisible) do
begin
PaneVisible:=FPanes[i].Visible;
dec(i);
end;
result:=result and PaneVisible;
end;
end;
procedure TSpkTab.SetRect(ARect: T2DIntRect);
var x, i : integer;
tw : integer;
tmpRect : T2DIntRect;
begin
FRect:=ARect;
if AtLeastOnePaneVisible then
begin
x:=ARect.left;
for i := 0 to FPanes.count - 1 do
if FPanes[i].Visible then
begin
tw:=FPanes[i].GetWidth;
tmpRect.Left:=x;
tmpRect.top:=ARect.Top;
tmpRect.right:=x + tw - 1;
tmpRect.bottom:=ARect.bottom;
FPanes[i].Rect:=tmpRect;
x:=x + tw + TabPaneHSpacing;
end
else
begin
{$IFDEF EnhancedRecordSupport}
FPanes[i].Rect:=T2DIntRect.create(-1,-1,-1,-1);
{$ELSE}
FPanes[i].Rect.create(-1,-1,-1,-1);
{$ENDIF}
end;
end;
end;
procedure TSpkTab.SetToolbarDispatch(const Value: TSpkBaseToolbarDispatch);
begin
FToolbarDispatch := Value;
FPanes.ToolbarDispatch:=FToolbarDispatch;
end;
constructor TSpkTab.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FAppearanceDispatch:=TSpkTabAppearanceDispatch.create(self);
FAppearanceDispatch := TSpkTabAppearanceDispatch.Create(self);
FMouseHoverElement.ElementType := etNone;
FMouseHoverElement.ElementIndex := -1;
FMouseActiveElement.ElementType := etNone;
FMouseActiveElement.ElementIndex := -1;
FCaption := 'Tab';
FVisible := true;
FCustomAppearance := TSpkToolbarAppearance.Create(FAppearanceDispatch);
FPanes := TSpkPanes.Create(self);
FPanes.ToolbarDispatch := FToolbarDispatch;
{$IFDEF EnhancedRecordSupport}
FRect:=T2DIntRect.create(0,0,0,0);
FRect := T2DIntRect.Create(0,0,0,0);
{$ELSE}
FRect.create(0,0,0,0);
FRect.Create(0,0,0,0);
{$ENDIF}
SetPaneAppearance;
end;
procedure TSpkTab.DefineProperties(Filer: TFiler);
begin
inherited DefineProperties(Filer);
Filer.DefineProperty('Panes',FPanes.ReadNames,FPanes.WriteNames,true);
end;
destructor TSpkTab.Destroy;
begin
FPanes.Free;
FCustomAppearance.Free;
FAppearanceDispatch.Free;
inherited Destroy;
end;
procedure TSpkTab.Draw(ABuffer: TBitmap; AClipRect: T2DIntRect);
var LocalClipRect : T2DIntRect;
function TSpkTab.AtLeastOnePaneVisible: boolean;
var
i: integer;
PaneVisible: boolean;
begin
Result := (FPanes.Count > 0);
if Result then
begin
PaneVisible := false;
i := FPanes.Count - 1;
while (i >= 0) and not PaneVisible do
begin
PaneVisible := FPanes[i].Visible;
dec(i);
end;
Result := Result and PaneVisible;
end;
end;
procedure TSpkTab.SetRect(ARect: T2DIntRect);
var
x, i: integer;
tw: integer;
tmpRect: T2DIntRect;
begin
FRect := ARect;
if AtLeastOnePaneVisible then
begin
x := ARect.left;
for i := 0 to FPanes.Count - 1 do
if FPanes[i].Visible then
begin
tw := FPanes[i].GetWidth;
tmpRect.Left := x;
tmpRect.Top := ARect.Top;
tmpRect.Right := x + tw - 1;
tmpRect.Bottom := ARect.bottom;
FPanes[i].Rect := tmpRect;
x := x + tw + TabPaneHSpacing;
end
else
begin
{$IFDEF EnhancedRecordSupport}
FPanes[i].Rect := T2DIntRect.Create(-1,-1,-1,-1);
{$ELSE}
FPanes[i].Rect.Create(-1,-1,-1,-1);
{$ENDIF}
end;
end;
end;
procedure TSpkTab.SetToolbarDispatch(const Value: TSpkBaseToolbarDispatch);
begin
FToolbarDispatch := Value;
FPanes.ToolbarDispatch := FToolbarDispatch;
end;
procedure TSpkTab.DefineProperties(Filer: TFiler);
begin
inherited DefineProperties(Filer);
Filer.DefineProperty('Panes', FPanes.ReadNames, FPanes.WriteNames, true);
end;
procedure TSpkTab.Draw(ABuffer: TBitmap; AClipRect: T2DIntRect);
var
LocalClipRect: T2DIntRect;
i: integer;
begin
if AtLeastOnePaneVisible then
for i := 0 to FPanes.Count - 1 do
@@ -311,22 +291,21 @@ begin
end;
function TSpkTab.FindPaneAt(x, y: integer): integer;
var i : integer;
var
i: integer;
begin
result:=-1;
i:=FPanes.count-1;
while (i>=0) and (result=-1) do
Result := -1;
i := FPanes.Count - 1;
while (i >= 0) and (Result = -1) do
begin
if FPanes[i].Visible then
begin
{$IFDEF EnhancedRecordSupport}
if FPanes[i].Rect.Contains(T2DIntVector.create(x,y)) then
if FPanes[i].Rect.Contains(T2DIntVector.Create(x,y)) then
{$ELSE}
if FPanes[i].Rect.Contains(x,y) then
{$ENDIF}
result:=i;
Result := i;
end;
dec(i);
end;
@@ -338,13 +317,10 @@ FPanes.RemoveReference(APane);
end;
procedure TSpkTab.GetChildren(Proc: TGetChildProc; Root: TComponent);
var i: Integer;
var
i: Integer;
begin
inherited;
if FPanes.Count>0 then
for i := 0 to FPanes.Count - 1 do
Proc(FPanes.Items[i]);
end;
@@ -352,13 +328,12 @@ end;
procedure TSpkTab.Loaded;
begin
inherited;
if FPanes.ListState = lsNeedsProcessing then
FPanes.ProcessNames(self.Owner);
end;
procedure TSpkTab.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
Y: Integer);
procedure TSpkTab.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
if FMouseActiveElement.ElementType = etPane then
begin
@@ -377,7 +352,6 @@ if FMouseActiveElement.ElementType = etNone then
begin
FMouseActiveElement.ElementType := etPane;
FMouseActiveElement.ElementIndex := FMouseHoverElement.ElementIndex;
FPanes[FMouseHoverElement.ElementIndex].MouseDown(Button, Shift, X, Y);
end
else
@@ -390,7 +364,6 @@ if FMouseActiveElement.ElementType = etNone then
begin
FMouseActiveElement.ElementType := etTabArea;
FMouseActiveElement.ElementIndex := -1;
// Placeholder, jeœli zajdzie potrzeba obs³ugi tego zdarzenia.
end;
end;
@@ -416,13 +389,12 @@ FMouseHoverElement.ElementIndex:=-1;
end;
procedure TSpkTab.MouseMove(Shift: TShiftState; X, Y: Integer);
var i : integer;
var
i: integer;
NewMouseHoverElement: TSpkMouseTabElement;
begin
// Szukamy obiektu pod mysz¹
i:=FindPaneAt(x, y);
i := FindPaneAt(X, Y);
if i <> -1 then
begin
NewMouseHoverElement.ElementType := etPane;
@@ -484,9 +456,8 @@ end;
procedure TSpkTab.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
Y: Integer);
var ClearActive : boolean;
var
ClearActive: boolean;
begin
ClearActive := not (ssLeft in Shift) and not (ssMiddle in Shift) and not (ssRight in Shift);
@@ -534,13 +505,13 @@ end;
procedure TSpkTab.NotifyAppearanceChanged;
begin
if assigned(FToolbarDispatch) then
if Assigned(FToolbarDispatch) then
FToolbarDispatch.NotifyAppearanceChanged;
end;
procedure TSpkTab.SetCustomAppearance(const Value: TSpkToolbarAppearance);
begin
FCustomAppearance.assign(Value);
FCustomAppearance.Assign(Value);
end;
procedure TSpkTab.SetDisabledImages(const Value: TImageList);
@@ -570,9 +541,7 @@ end;
procedure TSpkTab.SetAppearance(const Value: TSpkToolbarAppearance);
begin
FAppearance := Value;
SetPaneAppearance;
if FToolbarDispatch <> nil then
FToolbarDispatch.NotifyMetricsChanged;
end;
@@ -580,16 +549,14 @@ end;
procedure TSpkTab.SetCaption(const Value: string);
begin
FCaption := Value;
if assigned(FToolbarDispatch) then
if Assigned(FToolbarDispatch) then
FToolbarDispatch.NotifyMetricsChanged;
end;
procedure TSpkTab.SetOverrideAppearance(const Value: boolean);
begin
FOverrideAppearance := Value;
SetPaneAppearance;
if FToolbarDispatch <> nil then
FToolbarDispatch.NotifyMetricsChanged;
end;
@@ -597,9 +564,9 @@ end;
procedure TSpkTab.SetPaneAppearance;
begin
if FOverrideAppearance then
FPanes.Appearance:=FCustomAppearance else
FPanes.Appearance := FCustomAppearance
else
FPanes.Appearance := FAppearance;
// Metoda pe³ni rolê makra - dlatego nie powiadamia dyspozytora o zmianie.
end;
@@ -610,6 +577,7 @@ begin
FToolbarDispatch.NotifyItemsChanged;
end;
{ TSpkTabs }
function TSpkTabs.Add: TSpkTab;
@@ -619,56 +587,54 @@ begin
AddItem(Result);
end;
function TSpkTabs.GetItems(index: integer): TSpkTab;
function TSpkTabs.GetItems(AIndex: integer): TSpkTab;
begin
result:=TSpkTab(inherited Items[index]);
Result := TSpkTab(inherited Items[AIndex]);
end;
function TSpkTabs.Insert(index: integer): TSpkTab;
var Owner, Parent : TComponent;
function TSpkTabs.Insert(AIndex: integer): TSpkTab;
var
lOwner, lParent: TComponent;
i: Integer;
begin
if (index<0) or (index>=self.Count) then
if (AIndex < 0) or (AIndex >= self.Count) then
raise InternalException.create('TSpkTabs.Insert: Nieprawid³owy indeks!');
if FRootComponent<>nil then
begin
Owner:=FRootComponent.Owner;
Parent:=FRootComponent;
lOwner := FRootComponent.Owner;
lParent := FRootComponent;
end
else
begin
Owner:=nil;
Parent:=nil;
lOwner := nil;
lParent := nil;
end;
result:=TSpkTab.create(Owner);
result.Parent:=Parent;
Result := TSpkTab.create(lOwner);
Result.Parent := lParent;
if FRootComponent<>nil then
begin
i := 0;
while FRootComponent.Owner.FindComponent('SpkTab'+inttostr(i))<>nil do
while FRootComponent.Owner.FindComponent('SpkTab'+IntToStr(i)) <> nil do
inc(i);
result.Name:='SpkTab'+inttostr(i);
Result.Name := 'SpkTab' + IntToStr(i);
end;
InsertItem(index, result);
InsertItem(AIndex, Result);
end;
procedure TSpkTabs.Notify(Item: TComponent;
Operation : TOperation);
procedure TSpkTabs.Notify(Item: TComponent; Operation: TOperation);
begin
inherited Notify(Item, Operation);
case Operation of
opInsert: begin
opInsert:
begin
// Ustawienie dyspozytora na nil spowoduje, ¿e podczas
// przypisywania w³asnoœci nie bêd¹ wo³ane metody Notify*
TSpkTab(Item).ToolbarDispatch := nil;
TSpkTab(Item).Appearance := self.FAppearance;
TSpkTab(Item).Images := self.FImages;
TSpkTab(Item).DisabledImages := self.FDisabledImages;
@@ -676,7 +642,7 @@ begin
TSpkTab(Item).DisabledLargeImages := self.FDisabledLargeImages;
TSpkTab(Item).ToolbarDispatch := self.FToolbarDispatch;
end;
opRemove: begin
opRemove:
if not(csDestroying in Item.ComponentState) then
begin
TSpkTab(Item).ToolbarDispatch := nil;
@@ -688,77 +654,58 @@ begin
end;
end;
end;
end;
procedure TSpkTabs.SetAppearance(const Value: TSpkToolbarAppearance);
var i: Integer;
var
i: Integer;
begin
FAppearance := Value;
if self.count>0 then
for i := 0 to self.count - 1 do
for i := 0 to self.Count - 1 do
self.Items[i].Appearance := FAppearance;
end;
procedure TSpkTabs.SetDisabledImages(const Value: TImageList);
var i: Integer;
var
i: Integer;
begin
FDisabledImages := Value;
if self.Count>0 then
for i := 0 to self.count - 1 do
for i := 0 to self.Count - 1 do
Items[i].DisabledImages := Value;
end;
procedure TSpkTabs.SetDisabledLargeImages(const Value: TImageList);
var i: Integer;
var
i: Integer;
begin
FDisabledLargeImages := Value;
if self.Count>0 then
for i := 0 to self.count - 1 do
Items[i].DisabledLargeImages := Value;
end;
procedure TSpkTabs.SetImages(const Value: TImageList);
var i: Integer;
var
i: Integer;
begin
FImages := Value;
if self.Count>0 then
for i := 0 to self.count - 1 do
for i := 0 to self.Count - 1 do
Items[i].Images := Value;
end;
procedure TSpkTabs.SetLargeImages(const Value: TImageList);
var i: Integer;
var
i: Integer;
begin
FLargeImages := Value;
if self.Count>0 then
for i := 0 to self.count - 1 do
for i := 0 to self.Count - 1 do
Items[i].LargeImages := Value;
end;
procedure TSpkTabs.SetToolbarDispatch(const Value: TSpkBaseToolbarDispatch);
var i : integer;
var
i: integer;
begin
FToolbarDispatch := Value;
if self.Count>0 then
for i := 0 to self.count - 1 do
for i := 0 to self.Count - 1 do
self.Items[i].ToolbarDispatch := FToolbarDispatch;
end;
@@ -766,7 +713,7 @@ procedure TSpkTabs.Update;
begin
inherited Update;
if assigned(FToolbarDispatch) then
if Assigned(FToolbarDispatch) then
FToolbarDispatch.NotifyItemsChanged;
end;

6
components/spktoolbar/SpkToolbar/spkt_Tools.pas
View File

@@ -18,9 +18,8 @@ interface
uses
Graphics, SysUtils, SpkMath, SpkGUITools;
type TButtonTools = class sealed(TObject)
private
protected
type
TButtonTools = class sealed(TObject)
public
class procedure DrawButton(Bitmap: TBitmap;
Rect: T2DIntRect;
@@ -47,7 +46,6 @@ class procedure TButtonTools.DrawButton(Bitmap: TBitmap;
GradientTo: TColor; GradientKind: TBackgroundKind; LeftEdgeOpen,
RightEdgeOpen, TopEdgeOpen, BottomEdgeOpen: boolean; Radius: integer;
ClipRect: T2DIntRect);
var
x1, x2, y1, y2: integer;
LeftClosed, TopClosed, RightClosed, BottomClosed: byte;

85
components/spktoolbar/SpkToolbar/spkt_Types.pas
View File

@@ -14,13 +14,14 @@ unit spkt_Types;
interface
uses Controls, Classes, ContNrs, SysUtils, Dialogs,
uses
Controls, Classes, ContNrs, SysUtils, Dialogs,
spkt_Exceptions;
type TSpkListState = (lsNeedsProcessing, lsReady);
type
TSpkListState = (lsNeedsProcessing, lsReady);
type TSpkCollection = class(TPersistent)
private
TSpkCollection = class(TPersistent)
protected
FList: TFPObjectList;
FNames: TStringList;
@@ -37,19 +38,20 @@ type TSpkCollection = class(TPersistent)
// *** Internal methods for adding and inserting elements ***
// *** Getters and setters ***
function GetItems(index: integer): TComponent; virtual;
function GetItems(AIndex: integer): TComponent; virtual;
public
// *** Konstruktor, destruktor ***
constructor Create(RootComponent : TComponent); reintroduce; virtual;
constructor Create(ARootComponent : TComponent); reintroduce; virtual;
destructor Destroy; override;
// *** Obs³uga listy ***
// *** List operations ***
procedure AddItem(AItem: TComponent);
procedure InsertItem(index: integer; AItem: TComponent);
procedure InsertItem(AIndex: integer; AItem: TComponent);
procedure Clear;
function Count: integer;
procedure Delete(index: integer); virtual;
procedure Delete(AIndex: integer); virtual;
function IndexOf(Item: TComponent) : integer;
procedure Remove(Item: TComponent); virtual;
procedure RemoveReference(Item: TComponent);
@@ -67,8 +69,7 @@ type TSpkCollection = class(TPersistent)
property RootComponent: TComponent read FRootComponent;
end;
type TSpkComponent = class(TComponent)
private
TSpkComponent = class(TComponent)
protected
FParent: TComponent;
FCollection: TSpkCollection;
@@ -83,10 +84,27 @@ type TSpkComponent = class(TComponent)
property Collection: TSpkCollection read FCollection;
end;
implementation
{ TSpkCollection }
constructor TSpkCollection.Create(ARootComponent: TComponent);
begin
inherited Create;
FRootComponent := ARootComponent;
FNames := TStringList.Create;
FList := TFPObjectList.Create(False);
FListState := lsReady;
end;
destructor TSpkCollection.Destroy;
begin
FNames.Free;
FList.Free;
inherited;
end;
procedure TSpkCollection.AddItem(AItem: TComponent);
begin
// Ta metoda mo¿e byæ wywo³ywana bez przetworzenia nazw (w szczególnoœci, metoda
@@ -112,49 +130,31 @@ end;
function TSpkCollection.Count: integer;
begin
result := FList.Count;
Result := FList.Count;
end;
constructor TSpkCollection.Create(RootComponent : TComponent);
procedure TSpkCollection.Delete(AIndex: integer);
begin
inherited Create;
FRootComponent := RootComponent;
FNames := TStringList.create;
FList := TFPObjectList.create(False);
FListState := lsReady;
end;
procedure TSpkCollection.Delete(index: integer);
begin
if (index < 0) or (index >= FList.count) then
if (AIndex < 0) or (AIndex >= FList.count) then
raise InternalException.Create('TSpkCollection.Delete: Illegal index!');
//raise InternalException.Create('TSpkCollection.Delete: Nieprawid³owy indeks!');
Notify(TComponent(FList[index]), opRemove);
FList.Delete(index);
Notify(TComponent(FList[AIndex]), opRemove);
FList.Delete(AIndex);
Update;
end;
destructor TSpkCollection.Destroy;
begin
FNames.Destroy;
FList.Destroy;
inherited;
end;
procedure TSpkCollection.Exchange(item1, item2: integer);
begin
FList.Exchange(item1, item2);
Update;
end;
function TSpkCollection.GetItems(index: integer): TComponent;
function TSpkCollection.GetItems(AIndex: integer): TComponent;
begin
if (index < 0) or (index >= FList.Count) then
if (AIndex < 0) or (AIndex >= FList.Count) then
raise InternalException.Create('TSpkCollection.Delete: Illegal index!');
//raise InternalException.create('TSpkCollection.GetItems: Nieprawid³owy indeks!');
result := TComponent(FList[index]);
Result := TComponent(FList[AIndex]);
end;
function TSpkCollection.IndexOf(Item: TComponent): integer;
@@ -162,14 +162,13 @@ begin
result := FList.IndexOf(Item);
end;
procedure TSpkCollection.InsertItem(index: integer; AItem: TComponent);
procedure TSpkCollection.InsertItem(AIndex: integer; AItem: TComponent);
begin
if (index < 0) or (index > FList.Count) then
if (AIndex < 0) or (AIndex > FList.Count) then
raise InternalException.Create('TSpkCollection.Delete: Illegal index!');
//raise InternalException.Create('TSpkCollection.Insert: Nieprawid³owy indeks!');
Notify(AItem, opInsert);
FList.Insert(index, AItem);
FList.Insert(AIndex, AItem);
if AItem is TSpkComponent then
TSpkComponent(AItem).FCollection := self;
Update;
@@ -181,7 +180,6 @@ begin
(indexTo < 0) or (indexTo >= FList.Count)
then
raise InternalException.Create('TSpkCollection.Delete: Illegal index!');
//raise InternalException.Create('TSpkCollection.Move: Nieprawid³owy indeks!');
FList.Move(IndexFrom, IndexTo);
Update;
@@ -255,16 +253,17 @@ begin
Writer.WriteListEnd;
end;
{ TSpkComponent }
function TSpkComponent.GetParentComponent: TComponent;
begin
result := FParent;
Result := FParent;
end;
function TSpkComponent.HasParent: boolean;
begin
result := FParent<>nil;
Result := (FParent <> nil);
end;
procedure TSpkComponent.SetParentComponent(Value: TComponent);

BIN
components/spktoolbar/demos/basic/Project1.res
View File

Binary file not shown.

7
components/spktoolbar/designtime/spkte_AppearanceEditor.pas
View File

@@ -5,11 +5,10 @@ unit spkte_AppearanceEditor;
interface
uses
LCLIntf, LCLType, LMessages, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
LCLIntf, LCLType, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, ComCtrls, Buttons, Spin,
SpkGUITools, SpkXMLParser,
spkt_Buttons, spkt_BaseItem, spkt_Pane, spkt_Types, spkt_Tab, SpkToolbar,
spkt_Appearance;
SpkGUITools, SpkXMLParser, SpkToolbar,
spkt_Buttons, spkt_Pane, spkt_Tab, spkt_Appearance;
type