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);

297
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,34 +279,11 @@ end;
{ TSpkBaseToolbarAppearance }
procedure TSpkTabAppearance.Assign(Source: TPersistent);
var
SrcAppearance: TSpkTabAppearance;
begin
if Source is TSpkTabAppearance then
begin
SrcAppearance:=TSpkTabAppearance(Source);
FTabHeaderFont.Assign(SrcAppearance.TabHeaderFont);
FBorderColor:=SrcAppearance.BorderColor;
FGradientFromColor:=SrcAppearance.GradientFromColor;
FGradientToColor:=SrcAppearance.GradientToColor;
FGradientType:=SrcAppearance.GradientType;
FInactiveHeaderFontColor := SrcAppearance.InactiveTabHeaderFontColor;
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);
constructor TSpkTabAppearance.Create(ADispatch: TSpkBaseAppearanceDispatch);
begin
inherited Create;
FDispatch:=ADispatch;
FTabHeaderFont:=TFont.Create;
FDispatch := ADispatch;
FTabHeaderFont := TFont.Create;
Reset;
end;
@@ -300,32 +293,52 @@ begin
inherited;
end;
procedure TSpkTabAppearance.Assign(Source: TPersistent);
var
SrcAppearance: TSpkTabAppearance;
begin
if Source is TSpkTabAppearance then
begin
SrcAppearance := TSpkTabAppearance(Source);
FTabHeaderFont.Assign(SrcAppearance.TabHeaderFont);
FBorderColor := SrcAppearance.BorderColor;
FGradientFromColor := SrcAppearance.GradientFromColor;
FGradientToColor := SrcAppearance.GradientToColor;
FGradientType := SrcAppearance.GradientType;
FInactiveHeaderFontColor := SrcAppearance.InactiveTabHeaderFontColor;
if FDispatch <> nil then
FDispatch.NotifyAppearanceChanged;
end else
raise AssignException.Create('TSpkToolbarAppearance.Assign: Nie mogê przypisaæ obiektu '+Source.ClassName+' do TSpkToolbarAppearance!');
end;
procedure TSpkTabAppearance.LoadFromXML(Node: TSpkXMLNode);
var
Subnode : TSpkXMLNode;
Subnode: TSpkXMLNode;
begin
if not(assigned(Node)) then
if not Assigned(Node) then
exit;
Subnode:=Node['TabHeaderFont',false];
Subnode := Node['TabHeaderFont',false];
if Assigned(Subnode) then
TSpkXMLTools.Load(Subnode, FTabHeaderFont);
Subnode:=Node['BorderColor',false];
if assigned(Subnode) then
FBorderColor:=Subnode.TextAsColor;
Subnode := Node['BorderColor',false];
if Assigned(Subnode) then
FBorderColor := Subnode.TextAsColor;
Subnode:=Node['GradientFromColor',false];
if assigned(Subnode) then
FGradientFromColor:=Subnode.TextAsColor;
Subnode := Node['GradientFromColor',false];
if Assigned(Subnode) then
FGradientFromColor := Subnode.TextAsColor;
Subnode:=Node['GradientToColor',false];
if assigned(Subnode) then
FGradientToColor:=Subnode.TextAsColor;
Subnode := Node['GradientToColor',false];
if Assigned(Subnode) then
FGradientToColor := Subnode.TextAsColor;
Subnode:=Node['GradientType',false];
if assigned(Subnode) then
FGradientType:=TBackgroundKind(Subnode.TextAsInteger);
Subnode := Node['GradientType',false];
if Assigned(Subnode) then
FGradientType := TBackgroundKind(Subnode.TextAsInteger);
Subnode := Node['InactiveTabHeaderFontColor', false];
if Assigned(Subnode) then
@@ -404,20 +417,20 @@ begin
if not(assigned(Node)) then
exit;
Subnode:=Node['TabHeaderFont',true];
Subnode := Node['TabHeaderFont',true];
TSpkXMLTools.Save(Subnode, FTabHeaderFont);
Subnode:=Node['BorderColor',true];
Subnode.TextAsColor:=FBorderColor;
Subnode := Node['BorderColor',true];
Subnode.TextAsColor := FBorderColor;
Subnode:=Node['GradientFromColor',true];
Subnode.TextAsColor:=FGradientFromColor;
Subnode := Node['GradientFromColor',true];
Subnode.TextAsColor := FGradientFromColor;
Subnode:=Node['GradientToColor',true];
Subnode.TextAsColor:=FGradientToColor;
Subnode := Node['GradientToColor',true];
Subnode.TextAsColor := FGradientToColor;
Subnode:=Node['GradientType',true];
Subnode.TextAsInteger:=integer(FGradientType);
Subnode := Node['GradientType',true];
Subnode.TextAsInteger := integer(FGradientType);
Subnode := Node['InactiveTabHeaderFontColor', true];
Subnode.TextAsColor := FInactiveHeaderFontColor;
@@ -426,35 +439,35 @@ end;
procedure TSpkTabAppearance.SetBorderColor(const Value: TColor);
begin
FBorderColor := Value;
if FDispatch<>nil then
if FDispatch <> nil then
FDispatch.NotifyAppearanceChanged;
end;
procedure TSpkTabAppearance.SetGradientFromColor(const Value: TColor);
begin
FGradientFromColor := Value;
if FDispatch<>nil then
if FDispatch <> nil then
FDispatch.NotifyAppearanceChanged;
end;
procedure TSpkTabAppearance.SetGradientToColor(const Value: TColor);
begin
FGradientToColor := Value;
if FDispatch<>nil then
if FDispatch <> nil then
FDispatch.NotifyAppearanceChanged;
end;
procedure TSpkTabAppearance.SetGradientType(const Value: TBackgroundKind);
begin
FGradientType := Value;
if FDispatch<>nil then
if FDispatch <> nil then
FDispatch.NotifyAppearanceChanged;
end;
procedure TSpkTabAppearance.SetHeaderFont(const Value: TFont);
begin
FTabHeaderFont.assign(Value);
if FDispatch<>nil then
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(
@@ -1334,12 +1347,32 @@ end;
procedure TSpkToolbarAppearanceDispatch.NotifyAppearanceChanged;
begin
if FToolbarAppearance<>nil then
if FToolbarAppearance <> nil then
FToolbarAppearance.NotifyAppearanceChanged;
end;
{ TSpkToolbarAppearance }
constructor TSpkToolbarAppearance.Create(ADispatch : TSpkBaseAppearanceDispatch);
begin
inherited Create;
FDispatch := ADispatch;
FAppearanceDispatch := TSpkToolbarAppearanceDispatch.Create(self);
FTab := TSpkTabAppearance.Create(FAppearanceDispatch);
FPane := TSpkPaneAppearance.create(FAppearanceDispatch);
FElement := TSpkElementAppearance.create(FAppearanceDispatch);
end;
destructor TSpkToolbarAppearance.Destroy;
begin
FElement.Free;
FPane.Free;
FTab.Free;
FAppearanceDispatch.Free;
inherited;
end;
procedure TSpkToolbarAppearance.Assign(Source: TPersistent);
var
Src: TSpkToolbarAppearance;
@@ -1358,53 +1391,33 @@ begin
raise AssignException.create('TSpkToolbarAppearance.Assign: Nie mogê przypisaæ obiektu '+Source.ClassName+' do TSpkToolbarAppearance!');
end;
constructor TSpkToolbarAppearance.Create(ADispatch : TSpkBaseAppearanceDispatch);
begin
inherited Create;
FDispatch:=ADispatch;
FAppearanceDispatch:=TSpkToolbarAppearanceDispatch.Create(self);
FTab:=TSpkTabAppearance.Create(FAppearanceDispatch);
FPane:=TSpkPaneAppearance.create(FAppearanceDispatch);
FElement:=TSpkElementAppearance.create(FAppearanceDispatch);
end;
destructor TSpkToolbarAppearance.Destroy;
begin
FElement.Free;
FPane.Free;
FTab.Free;
FAppearanceDispatch.Free;
inherited;
end;
procedure TSpkToolbarAppearance.LoadFromXML(Node: TSpkXMLNode);
var Subnode : TSpkXMLNode;
var
Subnode: TSpkXMLNode;
begin
Tab.Reset;
Pane.Reset;
Element.Reset;
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
Subnode := Node['Tab', false];
if Assigned(Subnode) then
Tab.LoadFromXML(Subnode);
Subnode:=Node['Pane',false];
if assigned(Subnode) then
Subnode := Node['Pane', false];
if Assigned(Subnode) then
Pane.LoadFromXML(Subnode);
Subnode:=Node['Element',false];
if assigned(Subnode) then
Subnode := Node['Element', false];
if Assigned(Subnode) then
Element.LoadFromXML(Subnode);
end;
procedure TSpkToolbarAppearance.NotifyAppearanceChanged;
begin
if assigned(FDispatch) then
if Assigned(FDispatch) then
FDispatch.NotifyAppearanceChanged;
end;
@@ -1423,20 +1436,20 @@ begin
FTab.SaveToPascal(AList);
FPane.SaveToPascal(AList);
FElement.SaveToPascal(AList);
AList.ADd('end;');
AList.Add('end;');
end;
procedure TSpkToolbarAppearance.SaveToXML(Node: TSpkXMLNode);
var
Subnode: TSpkXMLNode;
begin
Subnode:=Node['Tab',true];
Subnode := Node['Tab',true];
FTab.SaveToXML(Subnode);
Subnode:=Node['Pane',true];
Subnode := Node['Pane',true];
FPane.SaveToXML(Subnode);
Subnode:=Node['Element',true];
Subnode := Node['Element',true];
FElement.SaveToXML(Subnode);
end;

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

@@ -15,36 +15,41 @@ 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)
private
protected
FRect : T2DIntRect;
FToolbarDispatch : TSpkBaseToolbarDispatch;
FAppearance : TSpkToolbarAppearance;
FImages : TImageList;
FDisabledImages : TImageList;
FLargeImages : TImageList;
FDisabledLargeImages : TImageList;
FVisible : boolean;
FEnabled : boolean;
FRect: T2DIntRect;
FToolbarDispatch: TSpkBaseToolbarDispatch;
FAppearance: TSpkToolbarAppearance;
FImages: TImageList;
FDisabledImages: TImageList;
FLargeImages: TImageList;
FDisabledLargeImages: TImageList;
FVisible: boolean;
FEnabled: boolean;
procedure SetVisible(const Value: boolean); virtual;
procedure SetEnabled(const Value: boolean); virtual;
procedure SetRect(const Value: T2DIntRect); virtual;
procedure SetImages(const Value: TImageList); virtual;
procedure SetDisabledImages(const Value : TImageList); virtual;
procedure SetDisabledImages(const Value: TImageList); virtual;
procedure SetLargeImages(const Value: TImageList); virtual;
procedure SetDisabledLargeImages(const Value: TImageList); virtual;
procedure SetAppearance(const Value: TSpkToolbarAppearance);
public
constructor Create(AOwner : TComponent); override;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure MouseLeave; virtual; abstract;
@@ -54,49 +59,51 @@ type TSpkItemSize = (isLarge, isNormal);
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); virtual; abstract;
function GetWidth : integer; virtual; abstract;
function GetTableBehaviour : TSpkItemTableBehaviour; virtual; abstract;
function GetGroupBehaviour : TSpkItemGroupBehaviour; virtual; abstract;
function GetSize : TSpkItemSize; virtual; abstract;
procedure Draw(ABuffer : TBitmap; ClipRect : T2DIntRect); virtual; abstract;
function GetWidth: integer; virtual; abstract;
function GetTableBehaviour: TSpkItemTableBehaviour; virtual; abstract;
function GetGroupBehaviour: TSpkItemGroupBehaviour; virtual; abstract;
function GetSize: TSpkItemSize; virtual; abstract;
property ToolbarDispatch : TSpkBaseToolbarDispatch read FToolbarDispatch write FToolbarDispatch;
property Appearance : TSpkToolbarAppearance read FAppearance write SetAppearance;
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;
procedure Draw(ABuffer: TBitmap; ClipRect: T2DIntRect); virtual; abstract;
property ToolbarDispatch: TSpkBaseToolbarDispatch read FToolbarDispatch write FToolbarDispatch;
property Appearance: TSpkToolbarAppearance read FAppearance write SetAppearance;
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;
property Rect: T2DIntRect read FRect write SetRect;
property Rect : T2DIntRect read FRect write SetRect;
published
property Visible : boolean read FVisible write SetVisible;
property Enabled : boolean read FEnabled write SetEnabled;
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
{ TSpkBaseItem }
constructor TSpkBaseItem.Create(AOwner : TComponent);
constructor TSpkBaseItem.Create(AOwner: TComponent);
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;
FAppearance:=nil;
FImages:=nil;
FDisabledImages:=nil;
FLargeImages:=nil;
FDisabledLargeImages:=nil;
FVisible:=true;
FEnabled:=true;
FToolbarDispatch := nil;
FAppearance := nil;
FImages := nil;
FDisabledImages := nil;
FLargeImages := nil;
FDisabledLargeImages := nil;
FVisible := true;
FEnabled := true;
end;
destructor TSpkBaseItem.Destroy;
@@ -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;
@@ -120,14 +126,14 @@ end;
procedure TSpkBaseItem.SetDisabledLargeImages(const Value: TImageList);
begin
FDisabledLargeImages:=Value;
FDisabledLargeImages := Value;
end;
procedure TSpkBaseItem.SetEnabled(const Value: boolean);
begin
if Value<>FEnabled then
if Value <> FEnabled then
begin
FEnabled:=Value;
FEnabled := Value;
if FToolbarDispatch<>nil then
FToolbarDispatch.NotifyVisualsChanged;
end;
@@ -150,10 +156,10 @@ end;
procedure TSpkBaseItem.SetVisible(const Value: boolean);
begin
if Value<>FVisible then
if Value <> FVisible then
begin
FVisible:=Value;
if FToolbarDispatch<>nil then
FVisible := Value;
if FToolbarDispatch <> nil then
FToolbarDispatch.NotifyMetricsChanged;
end;
end;

567
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;
FClient: TSpkBaseButton;
procedure AssignClient(AClient: TObject); override;
function IsOnExecuteLinked: Boolean; override;
procedure SetCaption(const Value: string); override;
@@ -53,52 +56,47 @@ type TSpkBaseButton = class;
TSpkBaseButton = class abstract(TSpkBaseItem)
private
FMouseHoverElement : TSpkMouseButtonElement;
FMouseActiveElement : TSpkMouseButtonElement;
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;
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;
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 ***
procedure SetEnabled(const Value : boolean); override;
procedure SetDropdownMenu(const Value : TPopupMenu);
// Getters and Setters
procedure SetEnabled(const Value: boolean); override;
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;
procedure SetAction(const Value: TBasicAction); virtual;
property ButtonKind : TSpkButtonKind read FButtonKind write SetButtonKind;
property DropdownMenu : TPopupMenu read FDropdownMenu write SetDropdownMenu;
property ButtonKind: TSpkButtonKind read FButtonKind write SetButtonKind;
property DropdownMenu: TPopupMenu read FDropdownMenu write SetDropdownMenu;
public
constructor Create(AOwner : TComponent); override;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure MouseLeave; override;
@@ -111,9 +109,9 @@ type TSpkBaseButton = class;
function GetRootComponent: TComponent;
published
property Caption : string read FCaption write SetCaption;
property Action : TBasicAction read GetAction write SetAction;
property OnClick : TNotifyEvent read FOnClick write FOnClick;
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,10 +352,10 @@ 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
if FEnabled then
begin
// Przyciski reaguj¹ tylko na lewy przycisk myszy
if Button <> mbLeft then
@@ -359,19 +363,19 @@ if FEnabled then
if FMouseActiveElement = beButton then
begin
if FButtonState<>bsBtnPressed then
if FButtonState <> bsBtnPressed then
begin
FButtonState:=bsBtnPressed;
if assigned(FToolbarDispatch) then
FButtonState := bsBtnPressed;
if Assigned(FToolbarDispatch) then
FToolbarDispatch.NotifyVisualsChanged;
end;
end else
if FMouseActiveElement = beDropdown then
begin
if FButtonState<>bsDropdownPressed then
if FButtonState <> bsDropdownPressed then
begin
FButtonState:=bsDropdownPressed;
if assigned(FToolbarDispatch) then
FButtonState := bsDropdownPressed;
if Assigned(FToolbarDispatch) then
FToolbarDispatch.NotifyVisualsChanged;
end;
end else
@@ -379,37 +383,34 @@ if FEnabled then
begin
if FMouseHoverElement = beButton then
begin
FMouseActiveElement:=beButton;
if FButtonState<>bsBtnPressed then
FMouseActiveElement := beButton;
if FButtonState <> bsBtnPressed then
begin
FButtonState:=bsBtnPressed;
if FToolbarDispatch<>nil then
FButtonState := bsBtnPressed;
if FToolbarDispatch <> nil then
FToolbarDispatch.NotifyVisualsChanged;
end;
end else
if FMouseHoverElement = beDropdown then
begin
FMouseActiveElement:=beDropdown;
if FButtonState<>bsDropdownPressed then
FMouseActiveElement := beDropdown;
if FButtonState <> bsDropdownPressed then
begin
FButtonState:=bsDropdownPressed;
if FToolbarDispatch<>nil then
FButtonState := bsDropdownPressed;
if FToolbarDispatch <> nil then
FToolbarDispatch.NotifyVisualsChanged;
end;
end;
end;
end
else
end // if FEnabled
else
begin
FMouseHoverElement:=beNone;
FMouseActiveElement:=beNone;
if FButtonState<>bsIdle then
FMouseHoverElement := beNone;
FMouseActiveElement := beNone;
if FButtonState <> bsIdle then
begin
FButtonState:=bsIdle;
if assigned(FToolbarDispatch) then
FButtonState := bsIdle;
if Assigned(FToolbarDispatch) then
FToolbarDispatch.NotifyVisualsChanged;
end;
end;
@@ -417,7 +418,7 @@ end;
procedure TSpkBaseButton.MouseLeave;
begin
if FEnabled then
if FEnabled then
begin
if FMouseActiveElement = beNone then
begin
@@ -430,77 +431,78 @@ if FEnabled then
// Placeholder, gdyby zasz³a potrzeba obs³ugi tego zdarzenia
end;
end;
if FButtonState<>bsIdle then
if FButtonState <> bsIdle then
begin
FButtonState:=bsIdle;
if assigned(FToolbarDispatch) then
FButtonState := bsIdle;
if Assigned(FToolbarDispatch) then
FToolbarDispatch.NotifyVisualsChanged;
end;
end
else
end // if FEnabled
else
begin
FMouseHoverElement:=beNone;
FMouseActiveElement:=beNone;
if FButtonState<>bsIdle then
FMouseHoverElement := beNone;
FMouseActiveElement := beNone;
if FButtonState <> bsIdle then
begin
FButtonState:=bsIdle;
if assigned(FToolbarDispatch) then
FButtonState := bsIdle;
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
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
NewMouseHoverElement:=beNone;
then
NewMouseHoverElement := beDropdown
else
NewMouseHoverElement := beNone;
if FMouseActiveElement = beButton then
begin
if (NewMouseHoverElement = beNone) and (FButtonState<>bsIdle) then
if (NewMouseHoverElement = beNone) and (FButtonState <> bsIdle) then
begin
FButtonState:=bsIdle;
if FToolbarDispatch<>nil then
FButtonState := bsIdle;
if FToolbarDispatch <> nil then
FToolbarDispatch.NotifyVisualsChanged;
end else
if (NewMouseHoverElement = beButton) and (FButtonState<>bsBtnPressed) then
if (NewMouseHoverElement = beButton) and (FButtonState <> bsBtnPressed) then
begin
FButtonState:=bsBtnPressed;
if FToolbarDispatch<>nil then
FButtonState := bsBtnPressed;
if FToolbarDispatch <> nil then
FToolbarDispatch.NotifyVisualsChanged;
end;
end else
if FMouseActiveElement = beDropdown then
begin
if (NewMouseHoverElement = beNone) and (FButtonState<>bsIdle) then
if (NewMouseHoverElement = beNone) and (FButtonState <> bsIdle) then
begin
FButtonState:=bsIdle;
if FToolbarDispatch<>nil then
FButtonState := bsIdle;
if FToolbarDispatch <> nil then
FToolbarDispatch.NotifyVisualsChanged;
end else
if (NewMouseHoverElement = beDropdown) and (FButtonState<>bsDropdownPressed) then
if (NewMouseHoverElement = beDropdown) and (FButtonState <> bsDropdownPressed) then
begin
FButtonState:=bsDropdownPressed;
if FToolbarDispatch<>nil then
FButtonState := bsDropdownPressed;
if FToolbarDispatch <> nil then
FToolbarDispatch.NotifyVisualsChanged;
end;
end else
@@ -508,57 +510,54 @@ 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
if FButtonState <> bsBtnHottrack then
begin
FButtonState:=bsBtnHottrack;
if FToolbarDispatch<>nil then
FButtonState := bsBtnHottrack;
if FToolbarDispatch <> nil then
FToolbarDispatch.NotifyVisualsChanged;
end;
end else
if NewMouseHoverElement = beDropdown then
begin
if FButtonState<>bsDropdownHottrack then
if FButtonState <> bsDropdownHottrack then
begin
FButtonState:=bsDropdownHottrack;
if FToolbarDispatch<>nil then
FButtonState := bsDropdownHottrack;
if FToolbarDispatch <> nil then
FToolbarDispatch.NotifyVisualsChanged;
end;
end;
end;
FMouseHoverElement:=NewMouseHoverElement;
end
else
FMouseHoverElement := NewMouseHoverElement;
end // if FEnabled
else
begin
FMouseHoverElement:=beNone;
FMouseActiveElement:=beNone;
if FButtonState<>bsIdle then
FMouseHoverElement := beNone;
FMouseActiveElement := beNone;
if FButtonState <> bsIdle then
begin
FButtonState:=bsIdle;
if assigned(FToolbarDispatch) then
FButtonState := bsIdle;
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
if FEnabled then
begin
// Przyciski reaguj¹ tylko na lewy przycisk myszy
if Button <> mbLeft then
exit;
ClearActive:=not(ssLeft in Shift);
ClearActive := not (ssLeft in Shift);
if FMouseActiveElement = beButton then
begin
@@ -569,18 +568,18 @@ if FEnabled then
if FButtonKind in [bkButton, bkButtonDropdown] then
begin
Click;
FButtonState:=bsBtnHottrack;
if assigned(FToolbarDispatch) then
FButtonState := bsBtnHottrack;
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);
DropPoint := FToolbarDispatch.ClientToScreen(GetDropdownPoint);
FDropdownMenu.Popup(DropPoint.x, DropPoint.y);
FButtonState:=bsBtnHottrack;
if assigned(FToolbarDispatch) then
FButtonState := bsBtnHottrack;
if Assigned(FToolbarDispatch) then
FToolbarDispatch.NotifyVisualsChanged;
end;
end;
@@ -590,40 +589,38 @@ 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);
DropPoint := FToolbarDispatch.ClientToScreen(GetDropdownPoint);
FDropdownMenu.Popup(DropPoint.x, DropPoint.y);
FButtonState:=bsBtnHottrack;
if assigned(FToolbarDispatch) then
FButtonState := bsBtnHottrack;
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
if FButtonState <> bsBtnHottrack then
begin
FButtonState:=bsBtnHottrack;
if assigned(FToolbarDispatch) then
FButtonState := bsBtnHottrack;
if Assigned(FToolbarDispatch) then
FToolbarDispatch.NotifyVisualsChanged;
end;
end else
if FMouseHoverElement = beDropdown then
begin
if FButtonState<>bsDropdownHottrack then
if FButtonState <> bsDropdownHottrack then
begin
FButtonState:=bsDropdownHottrack;
if assigned(FToolbarDispatch) then
FButtonState := bsDropdownHottrack;
if Assigned(FToolbarDispatch) then
FToolbarDispatch.NotifyVisualsChanged;
end;
end else
@@ -631,8 +628,8 @@ if FEnabled then
begin
if FButtonState <> bsIdle then
begin
FButtonState:=bsIdle;
if assigned(FToolbarDispatch) then
FButtonState := bsIdle;
if Assigned(FToolbarDispatch) then
FToolbarDispatch.NotifyVisualsChanged;
end;
end;
@@ -642,16 +639,15 @@ if FEnabled then
begin
FMouseActiveElement:=beNone;
end;
end
else
end // if FEnabled
else
begin
FMouseHoverElement:=beNone;
FMouseActiveElement:=beNone;
if FButtonState<>bsIdle then
FMouseHoverElement := beNone;
FMouseActiveElement := beNone;
if FButtonState <> bsIdle then
begin
FButtonState:=bsIdle;
if assigned(FToolbarDispatch) then
FButtonState := bsIdle;
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,144 +1150,140 @@ begin
end;
procedure TSpkSmallButton.ConstructRects(out BtnRect, DropRect: T2DIntRect);
var BtnWidth : integer;
var
BtnWidth: integer;
DropdownWidth: Integer;
Bitmap : TBitmap;
Bitmap: TBitmap;
TextWidth: Integer;
AdditionalPadding: Boolean;
begin
{$IFDEF EnhancedRecordSupport}
BtnRect:=T2DIntRect.Create(0, 0, 0, 0);
DropRect:=T2DIntRect.Create(0, 0, 0, 0);
{$ELSE}
BtnRect.Create(0, 0, 0, 0);
DropRect.Create(0, 0, 0, 0);
{$ENDIF}
{$IFDEF EnhancedRecordSupport}
BtnRect := T2DIntRect.Create(0, 0, 0, 0);
DropRect := T2DIntRect.Create(0, 0, 0, 0);
{$ELSE}
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
Bitmap := FToolbarDispatch.GetTempBitmap;
if not Assigned(Bitmap) then
exit;
// *** Niezale¿nie od rodzaju, musi byæ miejsce dla ikony i/lub tekstu ***
// *** Niezale¿nie od rodzaju, musi byæ miejsce dla ikony i/lub tekstu ***
BtnWidth:=0;
AdditionalPadding:=false;
BtnWidth := 0;
AdditionalPadding := false;
// Ikona
if FImageIndex<>-1 then
// Ikona
if FImageIndex <> -1 then
begin
BtnWidth:=BtnWidth + SmallButtonPadding + SmallButtonGlyphWidth;
AdditionalPadding:=true;
BtnWidth := BtnWidth + SmallButtonPadding + SmallButtonGlyphWidth;
AdditionalPadding := true;
end;
// Tekst
if FShowCaption then
// Tekst
if FShowCaption then
begin
Bitmap.Canvas.Font.assign(FAppearance.Element.CaptionFont);
TextWidth:=Bitmap.Canvas.TextWidth(FCaption);
Bitmap.Canvas.Font.Assign(FAppearance.Element.CaptionFont);
TextWidth := Bitmap.Canvas.TextWidth(FCaption);
BtnWidth:=BtnWidth + SmallButtonPadding + TextWidth;
AdditionalPadding:=true;
BtnWidth := BtnWidth + SmallButtonPadding + TextWidth;
AdditionalPadding := true;
end;
// Padding za tekstem lub ikon¹
if AdditionalPadding then
BtnWidth:=BtnWidth + SmallButtonPadding;
// Padding za tekstem lub ikon¹
if AdditionalPadding then
BtnWidth := BtnWidth + SmallButtonPadding;
// Szerokoœæ zawartoœci przycisku musi wynosiæ co najmniej SMALLBUTTON_MIN_WIDTH
BtnWidth := Max(SmallButtonMinWidth, BtnWidth);
// Szerokoœæ zawartoœci przycisku musi wynosiæ co najmniej SMALLBUTTON_MIN_WIDTH
BtnWidth := Max(SmallButtonMinWidth, BtnWidth);
// *** Dropdown ***
case FButtonKind of
bkButton: begin
// *** Dropdown ***
case FButtonKind of
bkButton:
begin
// Lewa krawêdŸ przycisku
if FGroupBehaviour in [gbContinuesGroup, gbEndsGroup] then
BtnWidth:=BtnWidth + SmallButtonHalfBorderWidth else
BtnWidth:=BtnWidth + SmallButtonBorderWidth;
BtnWidth := BtnWidth + SmallButtonHalfBorderWidth
else
BtnWidth := BtnWidth + SmallButtonBorderWidth;
// Prawa krawêdŸ przycisku
if (FGroupBehaviour in [gbBeginsGroup, gbContinuesGroup]) then
BtnWidth:=BtnWidth + SmallButtonHalfBorderWidth else
BtnWidth:=BtnWidth + SmallButtonBorderWidth;
BtnWidth := BtnWidth + SmallButtonHalfBorderWidth
else
BtnWidth := BtnWidth + SmallButtonBorderWidth;
{$IFDEF EnhancedRecordSupport}
BtnRect:=T2DIntRect.Create(0, 0, BtnWidth - 1, SpkLayoutSizes.PANE_ROW_HEIGHT - 1);
DropRect:=T2DIntRect.Create(0, 0, 0, 0);
BtnRect := T2DIntRect.Create(0, 0, BtnWidth - 1, SpkLayoutSizes.PANE_ROW_HEIGHT - 1);
DropRect := T2DIntRect.Create(0, 0, 0, 0);
{$ELSE}
BtnRect.Create(0, 0, BtnWidth - 1, PaneRowHeight - 1);
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 + SmallButtonBorderWidth;
BtnWidth := BtnWidth + SmallButtonHalfBorderWidth
else
BtnWidth := BtnWidth + SmallButtonBorderWidth;
// Prawa krawêdŸ przycisku
BtnWidth:=BtnWidth + SmallButtonHalfBorderWidth;
BtnWidth := BtnWidth + SmallButtonHalfBorderWidth;
// Lewa krawêdŸ i zawartoœæ pola dropdown
DropdownWidth := SmallButtonHalfBorderWidth + SmallButtonDropdownWidth;
// Prawa krawêdŸ pola dropdown
if (FGroupBehaviour in [gbBeginsGroup, gbContinuesGroup]) then
DropdownWidth:=DropdownWidth + SmallButtonHalfBorderWidth else
DropdownWidth:=DropdownWidth + SmallButtonBorderWidth;
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);
BtnRect := T2DIntRect.Create(0, 0, BtnWidth - 1, PaneRowHeightT - 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 + SmallButtonBorderWidth;
BtnWidth := BtnWidth + SmallButtonHalfBorderWidth
else
BtnWidth := BtnWidth + SmallButtonBorderWidth;
// Prawa krawêdŸ przycisku
if (FGroupBehaviour in [gbBeginsGroup, gbContinuesGroup]) then
BtnWidth:=BtnWidth + SmallButtonHalfBorderWidth else
BtnWidth:=BtnWidth + SmallButtonBorderWidth;
BtnWidth := BtnWidth + SmallButtonHalfBorderWidth
else
BtnWidth := BtnWidth + SmallButtonBorderWidth;
// Dodatkowy obszar na dropdown + miejsce na œrodkow¹ krawêdŸ,
// dla kompatybilnoœci wymiarów z dkButtonDropdown
BtnWidth:=BtnWidth + SmallButtonBorderWidth + SmallButtonDropdownWidth;
BtnWidth := BtnWidth + SmallButtonBorderWidth + SmallButtonDropdownWidth;
{$IFDEF EnhancedRecordSupport}
BtnRect:=T2DIntRect.Create(0, 0, BtnWidth - 1, PaneRowHeight - 1);
DropRect:=T2DIntRect.Create(0, 0, 0, 0);
BtnRect := T2DIntRect.Create(0, 0, BtnWidth - 1, PaneRowHeight - 1);
DropRect := T2DIntRect.Create(0, 0, 0, 0);
{$ELSE}
BtnRect.Create(0, 0, BtnWidth - 1, PaneRowHeight - 1);
DropRect.Create(0, 0, 0, 0);
{$ENDIF}
end;
end;
end;
constructor TSpkSmallButton.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FImageIndex := -1;
FTableBehaviour := tbContinuesRow;
FGroupBehaviour := gbSingleItem;
FHideFrameWhenIdle := false;
FShowCaption := true;
end;
end;
procedure TSpkSmallButton.Draw(ABuffer: TBitmap; ClipRect: T2DIntRect);
@@ -1581,7 +1584,7 @@ end;
procedure TSpkSmallButton.SetImageIndex(const Value: TImageIndex);
begin
FImageIndex:=Value;
FImageIndex := Value;
if Assigned(FToolbarDispatch) then
FToolbarDispatch.NotifyMetricsChanged;
end;

55
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
@@ -148,7 +149,7 @@ end;
procedure TSpkCustomCheckbox.CalcRects;
var
RectVector : T2DIntVector;
RectVector: T2DIntVector;
begin
ConstructRect(FButtonRect);
{$IFDEF EnhancedRecordSupport}
@@ -179,12 +180,12 @@ end;
procedure TSpkCustomCheckbox.ConstructRect(var BtnRect: T2DIntRect);
var
BtnWidth : integer;
Bitmap : TBitmap;
BtnWidth: integer;
Bitmap: TBitmap;
TextWidth: Integer;
begin
{$IFDEF EnhancedRecordSupport}
BtnRect:=T2DIntRect.Create(0, 0, 0, 0);
BtnRect := T2DIntRect.Create(0, 0, 0, 0);
{$ELSE}
BtnRect.Create(0, 0, 0, 0);
{$ENDIF}
@@ -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;
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);

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

@@ -15,31 +15,29 @@ 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;
procedure NotifyVisualsChanged; virtual; abstract;
function GetTempBitmap : TBitmap; virtual; abstract;
function ClientToScreen(Point : T2DIntPoint) : T2DIntPoint; virtual; abstract;
function GetTempBitmap: TBitmap; virtual; abstract;
function ClientToScreen(Point: T2DIntPoint): T2DIntPoint; virtual; abstract;
end;
implementation

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);

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

@@ -15,44 +15,47 @@ 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;
FImages : TImageList;
FDisabledImages : TImageList;
FLargeImages : TImageList;
FDisabledLargeImages : TImageList;
FToolbarDispatch: TSpkBaseToolbarDispatch;
FAppearance: TSpkToolbarAppearance;
FImages: TImageList;
FDisabledImages: TImageList;
FLargeImages: TImageList;
FDisabledLargeImages: TImageList;
// *** 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);
procedure SetDisabledImages(const Value: TImageList);
procedure SetLargeImages(const Value: TImageList);
procedure SetDisabledLargeImages(const Value: TImageList);
public
function AddLargeButton : TSpkLargeButton;
function AddSmallButton : TSpkSmallButton;
function AddLargeButton: TSpkLargeButton;
function AddSmallButton: TSpkSmallButton;
function AddCheckbox: TSpkCheckbox;
function AddRadioButton: TSpkRadioButton;
// *** Reakcja na zmiany listy ***
procedure Notify(Item: TComponent; Operation : TOperation); override;
procedure Notify(Item: TComponent; Operation: TOperation); override;
procedure Update; override;
property Items[index : integer] : TSpkBaseItem read GetItems; default;
property ToolbarDispatch : TSpkBaseToolbarDispatch read FToolbarDispatch write SetToolbarDispatch;
property Appearance : TSpkToolbarAppearance read FAppearance write SetAppearance;
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;
property Items[index: integer]: TSpkBaseItem read GetItems; default;
property ToolbarDispatch: TSpkBaseToolbarDispatch read FToolbarDispatch write SetToolbarDispatch;
property Appearance: TSpkToolbarAppearance read FAppearance write SetAppearance;
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;
end;
implementation
@@ -87,47 +90,45 @@ 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).ToolbarDispatch := nil;
TSpkBaseItem(Item).Appearance := FAppearance;
TSpkBaseItem(Item).Images := FImages;
TSpkBaseItem(Item).DisabledImages := FDisabledImages;
TSpkBaseItem(Item).LargeImages := FLargeImages;
TSpkBaseItem(Item).DisabledLargeImages := FDisabledLargeImages;
TSpkBaseItem(Item).ToolbarDispatch := FToolbarDispatch;
end;
TSpkBaseItem(Item).Appearance:=FAppearance;
TSpkBaseItem(Item).Images:=FImages;
TSpkBaseItem(Item).DisabledImages:=FDisabledImages;
TSpkBaseItem(Item).LargeImages:=FLargeImages;
TSpkBaseItem(Item).DisabledLargeImages:=FDisabledLargeImages;
TSpkBaseItem(Item).ToolbarDispatch:=FToolbarDispatch;
end;
opRemove: begin
if not(csDestroying in Item.ComponentState) then
opRemove:
if not (csDestroying in Item.ComponentState) then
begin
TSpkBaseItem(Item).ToolbarDispatch:=nil;
TSpkBaseItem(Item).Appearance:=nil;
TSpkBaseItem(Item).Images:=nil;
TSpkBaseItem(Item).DisabledImages:=nil;
TSpkBaseItem(Item).LargeImages:=nil;
TSpkBaseItem(Item).DisabledLargeImages:=nil;
end;
TSpkBaseItem(Item).ToolbarDispatch := nil;
TSpkBaseItem(Item).Appearance := nil;
TSpkBaseItem(Item).Images := nil;
TSpkBaseItem(Item).DisabledImages := nil;
TSpkBaseItem(Item).LargeImages := nil;
TSpkBaseItem(Item).DisabledLargeImages := nil;
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;

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

File diff suppressed because it is too large Load Diff

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

File diff suppressed because it is too large Load Diff

10
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;
@@ -46,13 +45,12 @@ class procedure TButtonTools.DrawButton(Bitmap: TBitmap;
Rect: T2DIntRect; FrameColor, InnerLightColor, InnerDarkColor, GradientFrom,
GradientTo: TColor; GradientKind: TBackgroundKind; LeftEdgeOpen,
RightEdgeOpen, TopEdgeOpen, BottomEdgeOpen: boolean; Radius: integer;
ClipRect : T2DIntRect);
ClipRect: T2DIntRect);
var
x1, x2, y1, y2: integer;
LeftClosed, TopClosed, RightClosed, BottomClosed: byte;
begin
if (Rect.Width <6 ) or (Rect.Height < 6) or
if (Rect.Width < 6) or (Rect.Height < 6) or
(Rect.Width < 2*Radius) or (Rect.Height < 2*Radius) then exit;
if LeftEdgeOpen then LeftClosed := 0 else LeftClosed := 1;

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

@@ -14,22 +14,23 @@ 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;
FListState : TSpkListState;
FRootComponent : TComponent;
FList: TFPObjectList;
FNames: TStringList;
FListState: TSpkListState;
FRootComponent: TComponent;
// *** Metody reakcji na zmiany w liœcie ***
// *** Methods responding to changes in list ***
procedure Notify(Item : TComponent; Operation : TOperation); virtual;
procedure Notify(Item: TComponent; Operation: TOperation); virtual;
procedure Update; virtual;
// *** Wewnêtrzne metody dodawania i wstawiania elementów ***
@@ -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);
@@ -62,38 +64,54 @@ type TSpkCollection = class(TPersistent)
procedure ReadNames(Reader: TReader); virtual;
procedure ProcessNames(Owner: TComponent); virtual;
property ListState : TSpkListState read FListState;
property Items[index : integer] : TComponent read GetItems; default;
property ListState: TSpkListState read FListState;
property Items[index: integer] : TComponent read GetItems; default;
property RootComponent: TComponent read FRootComponent;
end;
type TSpkComponent = class(TComponent)
private
TSpkComponent = class(TComponent)
protected
FParent : TComponent;
FParent: TComponent;
FCollection: TSpkCollection;
public
// *** Obs³uga parenta ***
// *** Parent operations ***
function HasParent : boolean; override;
function GetParentComponent : TComponent; override;
procedure SetParentComponent(Value : TComponent); override;
function HasParent: boolean; override;
function GetParentComponent: TComponent; override;
procedure SetParentComponent(Value: TComponent); override;
property Parent : TComponent read FParent write SetParentComponent;
property Parent: TComponent read FParent write SetParentComponent;
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
// przetwarzaj¹ca nazwy korzysta z AddItem)
// Ta metoda mo¿e byæ wywo³ywana bez przetworzenia nazw (w szczególnoœci, metoda
// przetwarzaj¹ca nazwy korzysta z AddItem)
// This method can be recalling untreated names (in particular, the method
// uses the name przetwarzaj¹ca AddItem) --- ???
// This method can be recalling untreated names (in particular, the method
// uses the name przetwarzaj¹ca AddItem) --- ???
Notify(AItem, opInsert);
FList.Add(AItem);
@@ -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;
@@ -242,7 +240,7 @@ end;
procedure TSpkCollection.Update;
begin
//
//
end;
procedure TSpkCollection.WriteNames(Writer: TWriter);
@@ -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