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

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

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

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

@ -15,36 +15,41 @@ unit spkt_BaseItem;
interface interface
uses Graphics, Classes, Controls, uses
Graphics, Classes, Controls,
SpkMath, spkt_Appearance, spkt_Dispatch, spkt_Types; SpkMath, spkt_Appearance, spkt_Dispatch, spkt_Types;
type TSpkItemSize = (isLarge, isNormal); type
TSpkItemSize = (isLarge, isNormal);
TSpkItemTableBehaviour = (tbBeginsRow, tbBeginsColumn, tbContinuesRow); TSpkItemTableBehaviour = (tbBeginsRow, tbBeginsColumn, tbContinuesRow);
TSpkItemGroupBehaviour = (gbSingleItem, gbBeginsGroup, gbContinuesGroup, gbEndsGroup); TSpkItemGroupBehaviour = (gbSingleItem, gbBeginsGroup, gbContinuesGroup, gbEndsGroup);
TSpkBaseItem = class abstract(TSpkComponent) TSpkBaseItem = class abstract(TSpkComponent)
private private
protected protected
FRect : T2DIntRect; FRect: T2DIntRect;
FToolbarDispatch : TSpkBaseToolbarDispatch; FToolbarDispatch: TSpkBaseToolbarDispatch;
FAppearance : TSpkToolbarAppearance; FAppearance: TSpkToolbarAppearance;
FImages : TImageList; FImages: TImageList;
FDisabledImages : TImageList; FDisabledImages: TImageList;
FLargeImages : TImageList; FLargeImages: TImageList;
FDisabledLargeImages : TImageList; FDisabledLargeImages: TImageList;
FVisible : boolean; FVisible: boolean;
FEnabled : boolean; FEnabled: boolean;
procedure SetVisible(const Value: boolean); virtual; procedure SetVisible(const Value: boolean); virtual;
procedure SetEnabled(const Value: boolean); virtual; procedure SetEnabled(const Value: boolean); virtual;
procedure SetRect(const Value: T2DIntRect); virtual; procedure SetRect(const Value: T2DIntRect); virtual;
procedure SetImages(const Value: TImageList); 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 SetLargeImages(const Value: TImageList); virtual;
procedure SetDisabledLargeImages(const Value: TImageList); virtual; procedure SetDisabledLargeImages(const Value: TImageList); virtual;
procedure SetAppearance(const Value: TSpkToolbarAppearance); procedure SetAppearance(const Value: TSpkToolbarAppearance);
public public
constructor Create(AOwner : TComponent); override; constructor Create(AOwner: TComponent); override;
destructor Destroy; override; destructor Destroy; override;
procedure MouseLeave; virtual; abstract; procedure MouseLeave; virtual; abstract;
@ -54,49 +59,51 @@ type TSpkItemSize = (isLarge, isNormal);
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); virtual; abstract; X, Y: Integer); virtual; abstract;
function GetWidth : integer; virtual; abstract; function GetWidth: integer; virtual; abstract;
function GetTableBehaviour : TSpkItemTableBehaviour; virtual; abstract; function GetTableBehaviour: TSpkItemTableBehaviour; virtual; abstract;
function GetGroupBehaviour : TSpkItemGroupBehaviour; virtual; abstract; function GetGroupBehaviour: TSpkItemGroupBehaviour; virtual; abstract;
function GetSize : TSpkItemSize; virtual; abstract; function GetSize: TSpkItemSize; virtual; abstract;
procedure Draw(ABuffer : TBitmap; ClipRect : T2DIntRect); virtual; abstract;
property ToolbarDispatch : TSpkBaseToolbarDispatch read FToolbarDispatch write FToolbarDispatch; procedure Draw(ABuffer: TBitmap; ClipRect: T2DIntRect); virtual; abstract;
property Appearance : TSpkToolbarAppearance read FAppearance write SetAppearance;
property Images : TImageList read FImages write SetImages; property ToolbarDispatch: TSpkBaseToolbarDispatch read FToolbarDispatch write FToolbarDispatch;
property DisabledImages : TImageList read FDisabledImages write SetDisabledImages; property Appearance: TSpkToolbarAppearance read FAppearance write SetAppearance;
property LargeImages : TImageList read FLargeImages write SetLargeImages; property Images: TImageList read FImages write SetImages;
property DisabledLargeImages : TImageList read FDisabledLargeImages write SetDisabledLargeImages; 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 published
property Visible : boolean read FVisible write SetVisible; property Visible: boolean read FVisible write SetVisible;
property Enabled : boolean read FEnabled write SetEnabled; property Enabled: boolean read FEnabled write SetEnabled;
end; end;
type TSpkBaseItemClass = class of TSpkBaseItem; TSpkBaseItemClass = class of TSpkBaseItem;
implementation implementation
{ TSpkBaseItem } { TSpkBaseItem }
constructor TSpkBaseItem.Create(AOwner : TComponent); constructor TSpkBaseItem.Create(AOwner: TComponent);
begin begin
inherited Create(AOwner); inherited Create(AOwner);
{$IFDEF EnhancedRecordSupport} {$IFDEF EnhancedRecordSupport}
FRect:=T2DIntRect.create(0, 0, 0, 0); FRect := T2DIntRect.Create(0, 0, 0, 0);
{$ELSE} {$ELSE}
FRect.create(0, 0, 0, 0); FRect.Create(0, 0, 0, 0);
{$ENDIF} {$ENDIF}
FToolbarDispatch:=nil; FToolbarDispatch := nil;
FAppearance:=nil; FAppearance := nil;
FImages:=nil; FImages := nil;
FDisabledImages:=nil; FDisabledImages := nil;
FLargeImages:=nil; FLargeImages := nil;
FDisabledLargeImages:=nil; FDisabledLargeImages := nil;
FVisible:=true; FVisible := true;
FEnabled:=true; FEnabled := true;
end; end;
destructor TSpkBaseItem.Destroy; destructor TSpkBaseItem.Destroy;
@ -108,8 +115,7 @@ end;
procedure TSpkBaseItem.SetAppearance(const Value: TSpkToolbarAppearance); procedure TSpkBaseItem.SetAppearance(const Value: TSpkToolbarAppearance);
begin begin
FAppearance := Value; FAppearance := Value;
if Assigned(FToolbarDispatch) then
if assigned(FToolbarDispatch) then
FToolbarDispatch.NotifyMetricsChanged; FToolbarDispatch.NotifyMetricsChanged;
end; end;
@ -120,14 +126,14 @@ end;
procedure TSpkBaseItem.SetDisabledLargeImages(const Value: TImageList); procedure TSpkBaseItem.SetDisabledLargeImages(const Value: TImageList);
begin begin
FDisabledLargeImages:=Value; FDisabledLargeImages := Value;
end; end;
procedure TSpkBaseItem.SetEnabled(const Value: boolean); procedure TSpkBaseItem.SetEnabled(const Value: boolean);
begin begin
if Value<>FEnabled then if Value <> FEnabled then
begin begin
FEnabled:=Value; FEnabled := Value;
if FToolbarDispatch<>nil then if FToolbarDispatch<>nil then
FToolbarDispatch.NotifyVisualsChanged; FToolbarDispatch.NotifyVisualsChanged;
end; end;
@ -150,10 +156,10 @@ end;
procedure TSpkBaseItem.SetVisible(const Value: boolean); procedure TSpkBaseItem.SetVisible(const Value: boolean);
begin begin
if Value<>FVisible then if Value <> FVisible then
begin begin
FVisible:=Value; FVisible := Value;
if FToolbarDispatch<>nil then if FToolbarDispatch <> nil then
FToolbarDispatch.NotifyMetricsChanged; FToolbarDispatch.NotifyMetricsChanged;
end; end;
end; end;

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

@ -21,19 +21,22 @@ uses
SpkGUITools, SpkGraphTools, SpkMath, SpkGUITools, SpkGraphTools, SpkMath,
spkt_Const, spkt_BaseItem, spkt_Exceptions, spkt_Tools; spkt_Const, spkt_BaseItem, spkt_Exceptions, spkt_Tools;
type TSpkButtonState = (bsIdle, type
TSpkButtonState = (
bsIdle,
bsBtnHottrack, bsBtnPressed, bsBtnHottrack, bsBtnPressed,
bsDropdownHottrack, bsDropdownPressed); bsDropdownHottrack, bsDropdownPressed
);
TSpkMouseButtonElement = (beNone, beButton, beDropdown); TSpkMouseButtonElement = (beNone, beButton, beDropdown);
TSpkButtonKind = (bkButton, bkButtonDropdown, bkDropdown); TSpkButtonKind = (bkButton, bkButtonDropdown, bkDropdown);
type TSpkBaseButton = class; TSpkBaseButton = class;
TSpkButtonActionLink = class(TActionLink) TSpkButtonActionLink = class(TActionLink)
private
protected protected
FClient : TSpkBaseButton; FClient: TSpkBaseButton;
procedure AssignClient(AClient: TObject); override; procedure AssignClient(AClient: TObject); override;
function IsOnExecuteLinked: Boolean; override; function IsOnExecuteLinked: Boolean; override;
procedure SetCaption(const Value: string); override; procedure SetCaption(const Value: string); override;
@ -53,52 +56,47 @@ type TSpkBaseButton = class;
TSpkBaseButton = class abstract(TSpkBaseItem) TSpkBaseButton = class abstract(TSpkBaseItem)
private private
FMouseHoverElement : TSpkMouseButtonElement; FMouseHoverElement: TSpkMouseButtonElement;
FMouseActiveElement : 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 protected
FCaption : string; FCaption: string;
FOnClick : TNotifyEvent; FOnClick: TNotifyEvent;
FActionLink: TSpkButtonActionLink;
FActionLink : TSpkButtonActionLink; FButtonState: TSpkButtonState;
FButtonRect: T2DIntRect;
FButtonState : TSpkButtonState; FDropdownRect: T2DIntRect;
FButtonKind: TSpkButtonKind;
FButtonRect : T2DIntRect; FDropdownMenu: TPopupMenu;
FDropdownRect : T2DIntRect;
FButtonKind : TSpkButtonKind;
FDropdownMenu : TPopupMenu;
// *** Obs³uga rysowania *** // *** Obs³uga rysowania ***
/// <summary>Zadaniem metody w odziedziczonych klasach jest obliczenie /// <summary>Zadaniem metody w odziedziczonych klasach jest obliczenie
/// rectów przycisku i menu dropdown w zale¿noœci od FButtonState</summary> /// rectów przycisku i menu dropdown w zale¿noœci od FButtonState</summary>
procedure CalcRects; virtual; abstract; procedure CalcRects; virtual; abstract;
function GetDropdownPoint: T2DIntPoint; virtual; abstract;
function GetDropdownPoint : T2DIntPoint; virtual; abstract;
// *** Obs³uga akcji *** // *** Obs³uga akcji ***
procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); virtual; procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); virtual;
procedure DoActionChange(Sender: TObject);
procedure Click; virtual; procedure Click; virtual;
procedure DoActionChange(Sender: TObject);
function GetDefaultCaption: String; virtual; function GetDefaultCaption: String; virtual;
// *** Gettery i settery *** // Getters and Setters
procedure SetEnabled(const Value: boolean); override;
procedure SetEnabled(const Value : boolean); override;
procedure SetDropdownMenu(const Value : TPopupMenu);
procedure SetRect(const Value: T2DIntRect); override; procedure SetRect(const Value: T2DIntRect); override;
procedure SetCaption(const Value : string); procedure SetAction(const Value: TBasicAction); virtual;
procedure SetAction(const Value : TBasicAction); virtual;
procedure SetButtonKind(const Value : TSpkButtonKind);
function GetAction: TBasicAction;
property ButtonKind : TSpkButtonKind read FButtonKind write SetButtonKind; property ButtonKind: TSpkButtonKind read FButtonKind write SetButtonKind;
property DropdownMenu : TPopupMenu read FDropdownMenu write SetDropdownMenu; property DropdownMenu: TPopupMenu read FDropdownMenu write SetDropdownMenu;
public public
constructor Create(AOwner : TComponent); override; constructor Create(AOwner: TComponent); override;
destructor Destroy; override; destructor Destroy; override;
procedure MouseLeave; override; procedure MouseLeave; override;
@ -111,9 +109,9 @@ type TSpkBaseButton = class;
function GetRootComponent: TComponent; function GetRootComponent: TComponent;
published published
property Caption : string read FCaption write SetCaption; property Action: TBasicAction read GetAction write SetAction;
property Action : TBasicAction read GetAction write SetAction; property Caption: string read FCaption write SetCaption;
property OnClick : TNotifyEvent read FOnClick write FOnClick; property OnClick: TNotifyEvent read FOnClick write FOnClick;
end; end;
@ -130,10 +128,10 @@ type TSpkBaseButton = class;
public public
constructor Create(AOwner: TComponent); override; constructor Create(AOwner: TComponent); override;
procedure Draw(ABuffer: TBitmap; ClipRect: T2DIntRect); override; procedure Draw(ABuffer: TBitmap; ClipRect: T2DIntRect); override;
function GetWidth: integer; override;
function GetTableBehaviour: TSpkItemTableBehaviour; override;
function GetGroupBehaviour: TSpkItemGroupBehaviour; override; function GetGroupBehaviour: TSpkItemGroupBehaviour; override;
function GetSize: TSpkItemSize; override; function GetSize: TSpkItemSize; override;
function GetTableBehaviour: TSpkItemTableBehaviour; override;
function GetWidth: integer; override;
published published
property LargeImageIndex: TImageIndex read FLargeImageIndex write SetLargeImageIndex default -1; property LargeImageIndex: TImageIndex read FLargeImageIndex write SetLargeImageIndex default -1;
property ButtonKind; property ButtonKind;
@ -151,31 +149,32 @@ type TSpkBaseButton = class;
FHideFrameWhenIdle: boolean; FHideFrameWhenIdle: boolean;
FShowCaption: boolean; FShowCaption: boolean;
procedure ConstructRects(out BtnRect, DropRect: T2DIntRect); procedure ConstructRects(out BtnRect, DropRect: T2DIntRect);
procedure SetImageIndex(const Value: TImageIndex);
procedure SetGroupBehaviour(const Value: TSpkItemGroupBehaviour); procedure SetGroupBehaviour(const Value: TSpkItemGroupBehaviour);
procedure SetHideFrameWhenIdle(const Value: boolean); procedure SetHideFrameWhenIdle(const Value: boolean);
procedure SetTableBehaviour(const Value: TSpkItemTableBehaviour); procedure SetImageIndex(const Value: TImageIndex);
procedure SetShowCaption(const Value: boolean); procedure SetShowCaption(const Value: boolean);
procedure SetTableBehaviour(const Value: TSpkItemTableBehaviour);
protected protected
procedure CalcRects; override; procedure CalcRects; override;
function GetDropdownPoint: T2DIntPoint; override; function GetDropdownPoint: T2DIntPoint; override;
public public
constructor Create(AOwner: TComponent); override; constructor Create(AOwner: TComponent); override;
procedure Draw(ABuffer: TBitmap; ClipRect: T2DIntRect); override; procedure Draw(ABuffer: TBitmap; ClipRect: T2DIntRect); override;
function GetWidth: integer; override;
function GetTableBehaviour: TSpkItemTableBehaviour; override;
function GetGroupBehaviour: TSpkItemGroupBehaviour; override; function GetGroupBehaviour: TSpkItemGroupBehaviour; override;
function GetSize: TSpkItemSize; override; function GetSize: TSpkItemSize; override;
function GetTableBehaviour: TSpkItemTableBehaviour; override;
function GetWidth: integer; override;
published published
property ShowCaption: boolean read FShowCaption write SetShowCaption;
property TableBehaviour: TSpkItemTableBehaviour read FTableBehaviour write SetTableBehaviour;
property GroupBehaviour: TSpkItemGroupBehaviour read FGroupBehaviour write SetGroupBehaviour; property GroupBehaviour: TSpkItemGroupBehaviour read FGroupBehaviour write SetGroupBehaviour;
property HideFrameWhenIdle: boolean read FHideFrameWhenIdle write SetHideFrameWhenIdle; property HideFrameWhenIdle: boolean read FHideFrameWhenIdle write SetHideFrameWhenIdle;
property ImageIndex: TImageIndex read FImageIndex write SetImageIndex default -1; 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 ButtonKind;
property DropdownMenu; property DropdownMenu;
end; end;
implementation implementation
uses uses
@ -191,15 +190,13 @@ end;
function TSpkButtonActionLink.IsCaptionLinked: Boolean; function TSpkButtonActionLink.IsCaptionLinked: Boolean;
begin begin
Result := inherited IsCaptionLinked and Result := inherited IsCaptionLinked and Assigned(FClient) and
Assigned(FClient) and
(FClient.Caption = (Action as TCustomAction).Caption); (FClient.Caption = (Action as TCustomAction).Caption);
end; end;
function TSpkButtonActionLink.IsEnabledLinked: Boolean; function TSpkButtonActionLink.IsEnabledLinked: Boolean;
begin begin
Result := inherited IsEnabledLinked and Result := inherited IsEnabledLinked and Assigned(FClient) and
Assigned(FClient) and
(FClient.Enabled = (Action as TCustomAction).Enabled); (FClient.Enabled = (Action as TCustomAction).Enabled);
end; end;
@ -211,38 +208,40 @@ end;
function TSpkButtonActionLink.IsImageIndexLinked: Boolean; function TSpkButtonActionLink.IsImageIndexLinked: Boolean;
begin begin
Result := (inherited IsImageIndexLinked) and Result := inherited IsImageIndexLinked;
( if (FClient is TSpkSmallButton) then
((FClient is TSpkSmallButton) Result := Result and (TSpkSmallButton(FClient).ImageIndex = (Action as TCustomAction).ImageIndex)
and (TSpkSmallButton(FClient).ImageIndex = (Action as TCustomAction).ImageIndex)) else
or if (FClient is TSpkLargeButton) then
((FClient is TSpkLargeButton) Result := Result and (TSpkLargeButton(FClient).LargeImageIndex = (Action as TCustomAction).ImageIndex)
and (TSpkLargeButton(FClient).LargeImageIndex = (Action as TCustomAction).ImageIndex)) else
); Result := false;
end; end;
function TSpkButtonActionLink.IsVisibleLinked: Boolean; function TSpkButtonActionLink.IsVisibleLinked: Boolean;
begin begin
Result := inherited IsVisibleLinked and Result := inherited IsVisibleLinked and Assigned(FClient) and
Assigned(FClient) and
(FClient.Visible = (Action as TCustomAction).Visible); (FClient.Visible = (Action as TCustomAction).Visible);
end; end;
procedure TSpkButtonActionLink.SetCaption(const Value: string); procedure TSpkButtonActionLink.SetCaption(const Value: string);
begin begin
if IsCaptionLinked then FClient.Caption := Value; if IsCaptionLinked then
FClient.Caption := Value;
end; end;
procedure TSpkButtonActionLink.SetEnabled(Value: Boolean); procedure TSpkButtonActionLink.SetEnabled(Value: Boolean);
begin begin
if IsEnabledLinked then FClient.Enabled := Value; if IsEnabledLinked then
FClient.Enabled := Value;
end; end;
procedure TSpkButtonActionLink.SetImageIndex(Value: integer); procedure TSpkButtonActionLink.SetImageIndex(Value: integer);
begin begin
if IsImageIndexLinked then begin if IsImageIndexLinked then begin
if (FClient is TSpkSmallButton) then if (FClient is TSpkSmallButton) then
(TSpkSmallButton(FClient)).ImageIndex := Value; (TSpkSmallButton(FClient)).ImageIndex := Value
else
if (FClient is TSpkLargeButton) then if (FClient is TSpkLargeButton) then
(TSpkLargeButton(FClient)).LargeImageIndex := Value; (TSpkLargeButton(FClient)).LargeImageIndex := Value;
end; end;
@ -250,16 +249,42 @@ end;
procedure TSpkButtonActionLink.SetOnExecute(Value: TNotifyEvent); procedure TSpkButtonActionLink.SetOnExecute(Value: TNotifyEvent);
begin begin
if IsOnExecuteLinked then FClient.OnClick := Value; if IsOnExecuteLinked then
FClient.OnClick := Value;
end; end;
procedure TSpkButtonActionLink.SetVisible(Value: Boolean); procedure TSpkButtonActionLink.SetVisible(Value: Boolean);
begin begin
if IsVisibleLinked then FClient.Visible := Value; if IsVisibleLinked then
FClient.Visible := Value;
end; end;
{ TSpkBaseButton } { 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); procedure TSpkBaseButton.ActionChange(Sender: TObject; CheckDefaults: Boolean);
begin begin
if Sender is TCustomAction then if Sender is TCustomAction then
@ -284,29 +309,6 @@ begin
end; end;
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; procedure TSpkBaseButton.Click;
begin begin
if Assigned(FOnClick) then if Assigned(FOnClick) then
@ -315,19 +317,21 @@ end;
procedure TSpkBaseButton.DoActionChange(Sender: TObject); procedure TSpkBaseButton.DoActionChange(Sender: TObject);
begin begin
if Sender = Action then ActionChange(Sender, False); if Sender = Action then
ActionChange(Sender, False);
end; end;
function TSpkBaseButton.GetAction: TBasicAction; function TSpkBaseButton.GetAction: TBasicAction;
begin begin
if assigned(FActionLink) then if Assigned(FActionLink) then
result:=FActionLink.Action else Result := FActionLink.Action
result:=nil; else
Result := nil;
end; end;
function TSpkBaseButton.GetDefaultCaption: String; function TSpkBaseButton.GetDefaultCaption: String;
begin begin
result := 'Button'; Result := 'Button';
end; end;
function TSpkBaseButton.GetRootComponent: TComponent; function TSpkBaseButton.GetRootComponent: TComponent;
@ -348,10 +352,10 @@ begin
result := tab.Collection.RootComponent; result := tab.Collection.RootComponent;
end; end;
procedure TSpkBaseButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X, procedure TSpkBaseButton.MouseDown(Button: TMouseButton; Shift: TShiftState;
Y: Integer); X, Y: Integer);
begin begin
if FEnabled then if FEnabled then
begin begin
// Przyciski reaguj¹ tylko na lewy przycisk myszy // Przyciski reaguj¹ tylko na lewy przycisk myszy
if Button <> mbLeft then if Button <> mbLeft then
@ -359,19 +363,19 @@ if FEnabled then
if FMouseActiveElement = beButton then if FMouseActiveElement = beButton then
begin begin
if FButtonState<>bsBtnPressed then if FButtonState <> bsBtnPressed then
begin begin
FButtonState:=bsBtnPressed; FButtonState := bsBtnPressed;
if assigned(FToolbarDispatch) then if Assigned(FToolbarDispatch) then
FToolbarDispatch.NotifyVisualsChanged; FToolbarDispatch.NotifyVisualsChanged;
end; end;
end else end else
if FMouseActiveElement = beDropdown then if FMouseActiveElement = beDropdown then
begin begin
if FButtonState<>bsDropdownPressed then if FButtonState <> bsDropdownPressed then
begin begin
FButtonState:=bsDropdownPressed; FButtonState := bsDropdownPressed;
if assigned(FToolbarDispatch) then if Assigned(FToolbarDispatch) then
FToolbarDispatch.NotifyVisualsChanged; FToolbarDispatch.NotifyVisualsChanged;
end; end;
end else end else
@ -379,37 +383,34 @@ if FEnabled then
begin begin
if FMouseHoverElement = beButton then if FMouseHoverElement = beButton then
begin begin
FMouseActiveElement:=beButton; FMouseActiveElement := beButton;
if FButtonState <> bsBtnPressed then
if FButtonState<>bsBtnPressed then
begin begin
FButtonState:=bsBtnPressed; FButtonState := bsBtnPressed;
if FToolbarDispatch<>nil then if FToolbarDispatch <> nil then
FToolbarDispatch.NotifyVisualsChanged; FToolbarDispatch.NotifyVisualsChanged;
end; end;
end else end else
if FMouseHoverElement = beDropdown then if FMouseHoverElement = beDropdown then
begin begin
FMouseActiveElement:=beDropdown; FMouseActiveElement := beDropdown;
if FButtonState <> bsDropdownPressed then
if FButtonState<>bsDropdownPressed then
begin begin
FButtonState:=bsDropdownPressed; FButtonState := bsDropdownPressed;
if FToolbarDispatch<>nil then if FToolbarDispatch <> nil then
FToolbarDispatch.NotifyVisualsChanged; FToolbarDispatch.NotifyVisualsChanged;
end; end;
end; end;
end; end;
end end // if FEnabled
else else
begin begin
FMouseHoverElement:=beNone; FMouseHoverElement := beNone;
FMouseActiveElement:=beNone; FMouseActiveElement := beNone;
if FButtonState<>bsIdle then if FButtonState <> bsIdle then
begin begin
FButtonState:=bsIdle; FButtonState := bsIdle;
if Assigned(FToolbarDispatch) then
if assigned(FToolbarDispatch) then
FToolbarDispatch.NotifyVisualsChanged; FToolbarDispatch.NotifyVisualsChanged;
end; end;
end; end;
@ -417,7 +418,7 @@ end;
procedure TSpkBaseButton.MouseLeave; procedure TSpkBaseButton.MouseLeave;
begin begin
if FEnabled then if FEnabled then
begin begin
if FMouseActiveElement = beNone then if FMouseActiveElement = beNone then
begin begin
@ -430,77 +431,78 @@ if FEnabled then
// Placeholder, gdyby zasz³a potrzeba obs³ugi tego zdarzenia // Placeholder, gdyby zasz³a potrzeba obs³ugi tego zdarzenia
end; end;
end; end;
if FButtonState <> bsIdle then
if FButtonState<>bsIdle then
begin begin
FButtonState:=bsIdle; FButtonState := bsIdle;
if assigned(FToolbarDispatch) then if Assigned(FToolbarDispatch) then
FToolbarDispatch.NotifyVisualsChanged; FToolbarDispatch.NotifyVisualsChanged;
end; end;
end end // if FEnabled
else else
begin begin
FMouseHoverElement:=beNone; FMouseHoverElement := beNone;
FMouseActiveElement:=beNone; FMouseActiveElement := beNone;
if FButtonState<>bsIdle then if FButtonState <> bsIdle then
begin begin
FButtonState:=bsIdle; FButtonState := bsIdle;
if Assigned(FToolbarDispatch) then
if assigned(FToolbarDispatch) then
FToolbarDispatch.NotifyVisualsChanged; FToolbarDispatch.NotifyVisualsChanged;
end; end;
end; end;
end; end;
procedure TSpkBaseButton.MouseMove(Shift: TShiftState; X, Y: Integer); procedure TSpkBaseButton.MouseMove(Shift: TShiftState; X, Y: Integer);
var
var NewMouseHoverElement : TSpkMouseButtonElement; NewMouseHoverElement: TSpkMouseButtonElement;
begin begin
if FEnabled then if FEnabled then
begin begin
{$IFDEF EnhancedRecordSupport} {$IFDEF EnhancedRecordSupport}
if FButtonRect.Contains(T2DIntPoint.Create(X,Y)) then if FButtonRect.Contains(T2DIntPoint.Create(X,Y)) then
{$ELSE} {$ELSE}
if FButtonRect.Contains(X,Y) then if FButtonRect.Contains(X,Y)
{$ENDIF} {$ENDIF}
NewMouseHoverElement:=beButton else then
NewMouseHoverElement := beButton
else
if (FButtonKind = bkButtonDropdown) and if (FButtonKind = bkButtonDropdown) and
{$IFDEF EnhancedRecordSupport} {$IFDEF EnhancedRecordSupport}
(FDropdownRect.Contains(T2DIntPoint.Create(X,Y))) then (FDropdownRect.Contains(T2DIntPoint.Create(X,Y))) then
{$ELSE} {$ELSE}
(FDropdownRect.Contains(X,Y)) then (FDropdownRect.Contains(X,Y))
{$ENDIF} {$ENDIF}
NewMouseHoverElement:=beDropdown else then
NewMouseHoverElement:=beNone; NewMouseHoverElement := beDropdown
else
NewMouseHoverElement := beNone;
if FMouseActiveElement = beButton then if FMouseActiveElement = beButton then
begin begin
if (NewMouseHoverElement = beNone) and (FButtonState<>bsIdle) then if (NewMouseHoverElement = beNone) and (FButtonState <> bsIdle) then
begin begin
FButtonState:=bsIdle; FButtonState := bsIdle;
if FToolbarDispatch<>nil then if FToolbarDispatch <> nil then
FToolbarDispatch.NotifyVisualsChanged; FToolbarDispatch.NotifyVisualsChanged;
end else end else
if (NewMouseHoverElement = beButton) and (FButtonState<>bsBtnPressed) then if (NewMouseHoverElement = beButton) and (FButtonState <> bsBtnPressed) then
begin begin
FButtonState:=bsBtnPressed; FButtonState := bsBtnPressed;
if FToolbarDispatch<>nil then if FToolbarDispatch <> nil then
FToolbarDispatch.NotifyVisualsChanged; FToolbarDispatch.NotifyVisualsChanged;
end; end;
end else end else
if FMouseActiveElement = beDropdown then if FMouseActiveElement = beDropdown then
begin begin
if (NewMouseHoverElement = beNone) and (FButtonState<>bsIdle) then if (NewMouseHoverElement = beNone) and (FButtonState <> bsIdle) then
begin begin
FButtonState:=bsIdle; FButtonState := bsIdle;
if FToolbarDispatch<>nil then if FToolbarDispatch <> nil then
FToolbarDispatch.NotifyVisualsChanged; FToolbarDispatch.NotifyVisualsChanged;
end else end else
if (NewMouseHoverElement = beDropdown) and (FButtonState<>bsDropdownPressed) then if (NewMouseHoverElement = beDropdown) and (FButtonState <> bsDropdownPressed) then
begin begin
FButtonState:=bsDropdownPressed; FButtonState := bsDropdownPressed;
if FToolbarDispatch<>nil then if FToolbarDispatch <> nil then
FToolbarDispatch.NotifyVisualsChanged; FToolbarDispatch.NotifyVisualsChanged;
end; end;
end else end else
@ -508,57 +510,54 @@ if FEnabled then
begin begin
// Z uwagi na uproszczon¹ obs³ugê myszy w przycisku, nie ma potrzeby // Z uwagi na uproszczon¹ obs³ugê myszy w przycisku, nie ma potrzeby
// informowaæ poprzedniego elementu o tym, ¿e mysz opuœci³a jego obszar. // informowaæ poprzedniego elementu o tym, ¿e mysz opuœci³a jego obszar.
if NewMouseHoverElement = beButton then if NewMouseHoverElement = beButton then
begin begin
if FButtonState<>bsBtnHottrack then if FButtonState <> bsBtnHottrack then
begin begin
FButtonState:=bsBtnHottrack; FButtonState := bsBtnHottrack;
if FToolbarDispatch<>nil then if FToolbarDispatch <> nil then
FToolbarDispatch.NotifyVisualsChanged; FToolbarDispatch.NotifyVisualsChanged;
end; end;
end else end else
if NewMouseHoverElement = beDropdown then if NewMouseHoverElement = beDropdown then
begin begin
if FButtonState<>bsDropdownHottrack then if FButtonState <> bsDropdownHottrack then
begin begin
FButtonState:=bsDropdownHottrack; FButtonState := bsDropdownHottrack;
if FToolbarDispatch<>nil then if FToolbarDispatch <> nil then
FToolbarDispatch.NotifyVisualsChanged; FToolbarDispatch.NotifyVisualsChanged;
end; end;
end; end;
end; end;
FMouseHoverElement:=NewMouseHoverElement; FMouseHoverElement := NewMouseHoverElement;
end end // if FEnabled
else else
begin begin
FMouseHoverElement:=beNone; FMouseHoverElement := beNone;
FMouseActiveElement:=beNone; FMouseActiveElement := beNone;
if FButtonState<>bsIdle then if FButtonState <> bsIdle then
begin begin
FButtonState:=bsIdle; FButtonState := bsIdle;
if Assigned(FToolbarDispatch) then
if assigned(FToolbarDispatch) then
FToolbarDispatch.NotifyVisualsChanged; FToolbarDispatch.NotifyVisualsChanged;
end; end;
end; end;
end; end;
procedure TSpkBaseButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X, procedure TSpkBaseButton.MouseUp(Button: TMouseButton; Shift: TShiftState;
Y: Integer); X, Y: Integer);
var
var ClearActive : boolean; ClearActive: boolean;
DropPoint: T2DIntPoint; DropPoint: T2DIntPoint;
begin begin
if FEnabled then if FEnabled then
begin begin
// Przyciski reaguj¹ tylko na lewy przycisk myszy // Przyciski reaguj¹ tylko na lewy przycisk myszy
if Button <> mbLeft then if Button <> mbLeft then
exit; exit;
ClearActive:=not(ssLeft in Shift); ClearActive := not (ssLeft in Shift);
if FMouseActiveElement = beButton then if FMouseActiveElement = beButton then
begin begin
@ -569,18 +568,18 @@ if FEnabled then
if FButtonKind in [bkButton, bkButtonDropdown] then if FButtonKind in [bkButton, bkButtonDropdown] then
begin begin
Click; Click;
FButtonState:=bsBtnHottrack; FButtonState := bsBtnHottrack;
if assigned(FToolbarDispatch) then if Assigned(FToolbarDispatch) then
FToolbarDispatch.NotifyVisualsChanged; FToolbarDispatch.NotifyVisualsChanged;
end else end else
if FButtonKind = bkDropdown then if FButtonKind = bkDropdown then
begin begin
if assigned(FDropdownMenu) then if Assigned(FDropdownMenu) then
begin begin
DropPoint:=FToolbarDispatch.ClientToScreen(GetDropdownPoint); DropPoint := FToolbarDispatch.ClientToScreen(GetDropdownPoint);
FDropdownMenu.Popup(DropPoint.x, DropPoint.y); FDropdownMenu.Popup(DropPoint.x, DropPoint.y);
FButtonState:=bsBtnHottrack; FButtonState := bsBtnHottrack;
if assigned(FToolbarDispatch) then if Assigned(FToolbarDispatch) then
FToolbarDispatch.NotifyVisualsChanged; FToolbarDispatch.NotifyVisualsChanged;
end; end;
end; end;
@ -590,40 +589,38 @@ if FEnabled then
begin begin
// Zdarzenie zadzia³a tylko wtedy, gdy przycisk myszy zosta³ puszczony nad // Zdarzenie zadzia³a tylko wtedy, gdy przycisk myszy zosta³ puszczony nad
// przyciskiem DropDown // przyciskiem DropDown
if FMouseHoverElement = beDropDown then if FMouseHoverElement = beDropDown then
begin begin
if assigned(FDropdownMenu) then if Assigned(FDropdownMenu) then
begin begin
DropPoint:=FToolbarDispatch.ClientToScreen(GetDropdownPoint); DropPoint := FToolbarDispatch.ClientToScreen(GetDropdownPoint);
FDropdownMenu.Popup(DropPoint.x, DropPoint.y); FDropdownMenu.Popup(DropPoint.x, DropPoint.y);
FButtonState:=bsBtnHottrack; FButtonState := bsBtnHottrack;
if assigned(FToolbarDispatch) then if Assigned(FToolbarDispatch) then
FToolbarDispatch.NotifyVisualsChanged; FToolbarDispatch.NotifyVisualsChanged;
end; end;
end; end;
end; end;
if (ClearActive) and (FMouseActiveElement<>FMouseHoverElement) then if ClearActive and (FMouseActiveElement <> FMouseHoverElement) then
begin begin
// Z uwagi na uproszczon¹ obs³ugê, nie ma potrzeby informowaæ poprzedniego // Z uwagi na uproszczon¹ obs³ugê, nie ma potrzeby informowaæ poprzedniego
// elementu o tym, ¿e mysz opuœci³a jego obszar. // elementu o tym, ¿e mysz opuœci³a jego obszar.
if FMouseHoverElement = beButton then if FMouseHoverElement = beButton then
begin begin
if FButtonState<>bsBtnHottrack then if FButtonState <> bsBtnHottrack then
begin begin
FButtonState:=bsBtnHottrack; FButtonState := bsBtnHottrack;
if assigned(FToolbarDispatch) then if Assigned(FToolbarDispatch) then
FToolbarDispatch.NotifyVisualsChanged; FToolbarDispatch.NotifyVisualsChanged;
end; end;
end else end else
if FMouseHoverElement = beDropdown then if FMouseHoverElement = beDropdown then
begin begin
if FButtonState<>bsDropdownHottrack then if FButtonState <> bsDropdownHottrack then
begin begin
FButtonState:=bsDropdownHottrack; FButtonState := bsDropdownHottrack;
if assigned(FToolbarDispatch) then if Assigned(FToolbarDispatch) then
FToolbarDispatch.NotifyVisualsChanged; FToolbarDispatch.NotifyVisualsChanged;
end; end;
end else end else
@ -631,8 +628,8 @@ if FEnabled then
begin begin
if FButtonState <> bsIdle then if FButtonState <> bsIdle then
begin begin
FButtonState:=bsIdle; FButtonState := bsIdle;
if assigned(FToolbarDispatch) then if Assigned(FToolbarDispatch) then
FToolbarDispatch.NotifyVisualsChanged; FToolbarDispatch.NotifyVisualsChanged;
end; end;
end; end;
@ -642,16 +639,15 @@ if FEnabled then
begin begin
FMouseActiveElement:=beNone; FMouseActiveElement:=beNone;
end; end;
end end // if FEnabled
else else
begin begin
FMouseHoverElement:=beNone; FMouseHoverElement := beNone;
FMouseActiveElement:=beNone; FMouseActiveElement := beNone;
if FButtonState<>bsIdle then if FButtonState <> bsIdle then
begin begin
FButtonState:=bsIdle; FButtonState := bsIdle;
if Assigned(FToolbarDispatch) then
if assigned(FToolbarDispatch) then
FToolbarDispatch.NotifyVisualsChanged; FToolbarDispatch.NotifyVisualsChanged;
end; end;
end; end;
@ -722,6 +718,7 @@ begin
CalcRects; CalcRects;
end; end;
{ TSpkLargeButton } { TSpkLargeButton }
procedure TSpkLargeButton.CalcRects; procedure TSpkLargeButton.CalcRects;
@ -1128,6 +1125,16 @@ end;
{ TSpkSmallButton } { TSpkSmallButton }
constructor TSpkSmallButton.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FImageIndex := -1;
FTableBehaviour := tbContinuesRow;
FGroupBehaviour := gbSingleItem;
FHideFrameWhenIdle := false;
FShowCaption := true;
end;
procedure TSpkSmallButton.CalcRects; procedure TSpkSmallButton.CalcRects;
var var
RectVector: T2DIntVector; RectVector: T2DIntVector;
@ -1143,144 +1150,140 @@ begin
end; end;
procedure TSpkSmallButton.ConstructRects(out BtnRect, DropRect: T2DIntRect); procedure TSpkSmallButton.ConstructRects(out BtnRect, DropRect: T2DIntRect);
var
var BtnWidth : integer; BtnWidth: integer;
DropdownWidth: Integer; DropdownWidth: Integer;
Bitmap : TBitmap; Bitmap: TBitmap;
TextWidth: Integer; TextWidth: Integer;
AdditionalPadding: Boolean; AdditionalPadding: Boolean;
begin begin
{$IFDEF EnhancedRecordSupport} {$IFDEF EnhancedRecordSupport}
BtnRect:=T2DIntRect.Create(0, 0, 0, 0); BtnRect := T2DIntRect.Create(0, 0, 0, 0);
DropRect:=T2DIntRect.Create(0, 0, 0, 0); DropRect := T2DIntRect.Create(0, 0, 0, 0);
{$ELSE} {$ELSE}
BtnRect.Create(0, 0, 0, 0); BtnRect.Create(0, 0, 0, 0);
DropRect.Create(0, 0, 0, 0); DropRect.Create(0, 0, 0, 0);
{$ENDIF} {$ENDIF}
if not(assigned(FToolbarDispatch)) then if not Assigned(FToolbarDispatch) then
exit; exit;
if not(assigned(FAppearance)) then if not Assigned(FAppearance) then
exit; exit;
Bitmap:=FToolbarDispatch.GetTempBitmap; Bitmap := FToolbarDispatch.GetTempBitmap;
if not(assigned(Bitmap)) then if not Assigned(Bitmap) then
exit; 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; BtnWidth := 0;
AdditionalPadding:=false; AdditionalPadding := false;
// Ikona // Ikona
if FImageIndex<>-1 then if FImageIndex <> -1 then
begin begin
BtnWidth:=BtnWidth + SmallButtonPadding + SmallButtonGlyphWidth; BtnWidth := BtnWidth + SmallButtonPadding + SmallButtonGlyphWidth;
AdditionalPadding:=true; AdditionalPadding := true;
end; end;
// Tekst // Tekst
if FShowCaption then if FShowCaption then
begin begin
Bitmap.Canvas.Font.assign(FAppearance.Element.CaptionFont); Bitmap.Canvas.Font.Assign(FAppearance.Element.CaptionFont);
TextWidth:=Bitmap.Canvas.TextWidth(FCaption); TextWidth := Bitmap.Canvas.TextWidth(FCaption);
BtnWidth:=BtnWidth + SmallButtonPadding + TextWidth; BtnWidth := BtnWidth + SmallButtonPadding + TextWidth;
AdditionalPadding:=true; AdditionalPadding := true;
end; end;
// Padding za tekstem lub ikon¹ // Padding za tekstem lub ikon¹
if AdditionalPadding then if AdditionalPadding then
BtnWidth:=BtnWidth + SmallButtonPadding; BtnWidth := BtnWidth + SmallButtonPadding;
// Szerokoœæ zawartoœci przycisku musi wynosiæ co najmniej SMALLBUTTON_MIN_WIDTH // Szerokoœæ zawartoœci przycisku musi wynosiæ co najmniej SMALLBUTTON_MIN_WIDTH
BtnWidth := Max(SmallButtonMinWidth, BtnWidth); BtnWidth := Max(SmallButtonMinWidth, BtnWidth);
// *** Dropdown *** // *** Dropdown ***
case FButtonKind of case FButtonKind of
bkButton: begin bkButton:
begin
// Lewa krawêdŸ przycisku // Lewa krawêdŸ przycisku
if FGroupBehaviour in [gbContinuesGroup, gbEndsGroup] then if FGroupBehaviour in [gbContinuesGroup, gbEndsGroup] then
BtnWidth:=BtnWidth + SmallButtonHalfBorderWidth else BtnWidth := BtnWidth + SmallButtonHalfBorderWidth
BtnWidth:=BtnWidth + SmallButtonBorderWidth; else
BtnWidth := BtnWidth + SmallButtonBorderWidth;
// Prawa krawêdŸ przycisku // Prawa krawêdŸ przycisku
if (FGroupBehaviour in [gbBeginsGroup, gbContinuesGroup]) then if (FGroupBehaviour in [gbBeginsGroup, gbContinuesGroup]) then
BtnWidth:=BtnWidth + SmallButtonHalfBorderWidth else BtnWidth := BtnWidth + SmallButtonHalfBorderWidth
BtnWidth:=BtnWidth + SmallButtonBorderWidth; else
BtnWidth := BtnWidth + SmallButtonBorderWidth;
{$IFDEF EnhancedRecordSupport} {$IFDEF EnhancedRecordSupport}
BtnRect:=T2DIntRect.Create(0, 0, BtnWidth - 1, SpkLayoutSizes.PANE_ROW_HEIGHT - 1); BtnRect := T2DIntRect.Create(0, 0, BtnWidth - 1, SpkLayoutSizes.PANE_ROW_HEIGHT - 1);
DropRect:=T2DIntRect.Create(0, 0, 0, 0); DropRect := T2DIntRect.Create(0, 0, 0, 0);
{$ELSE} {$ELSE}
BtnRect.Create(0, 0, BtnWidth - 1, PaneRowHeight - 1); BtnRect.Create(0, 0, BtnWidth - 1, PaneRowHeight - 1);
DropRect.Create(0, 0, 0, 0); DropRect.Create(0, 0, 0, 0);
{$ENDIF} {$ENDIF}
end; end;
bkButtonDropdown: begin
bkButtonDropdown:
begin
// Lewa krawêdŸ przycisku // Lewa krawêdŸ przycisku
if FGroupBehaviour in [gbContinuesGroup, gbEndsGroup] then if FGroupBehaviour in [gbContinuesGroup, gbEndsGroup] then
BtnWidth:=BtnWidth + SmallButtonHalfBorderWidth else BtnWidth := BtnWidth + SmallButtonHalfBorderWidth
BtnWidth:=BtnWidth + SmallButtonBorderWidth; else
BtnWidth := BtnWidth + SmallButtonBorderWidth;
// Prawa krawêdŸ przycisku // Prawa krawêdŸ przycisku
BtnWidth:=BtnWidth + SmallButtonHalfBorderWidth; BtnWidth := BtnWidth + SmallButtonHalfBorderWidth;
// Lewa krawêdŸ i zawartoœæ pola dropdown // Lewa krawêdŸ i zawartoœæ pola dropdown
DropdownWidth := SmallButtonHalfBorderWidth + SmallButtonDropdownWidth; DropdownWidth := SmallButtonHalfBorderWidth + SmallButtonDropdownWidth;
// Prawa krawêdŸ pola dropdown // Prawa krawêdŸ pola dropdown
if (FGroupBehaviour in [gbBeginsGroup, gbContinuesGroup]) then if (FGroupBehaviour in [gbBeginsGroup, gbContinuesGroup]) then
DropdownWidth:=DropdownWidth + SmallButtonHalfBorderWidth else DropdownWidth := DropdownWidth + SmallButtonHalfBorderWidth
DropdownWidth:=DropdownWidth + SmallButtonBorderWidth; else
DropdownWidth := DropdownWidth + SmallButtonBorderWidth;
{$IFDEF EnhancedRecordSupport} {$IFDEF EnhancedRecordSupport}
BtnRect:=T2DIntRect.Create(0, 0, BtnWidth - 1, PaneRowHeightT - 1); BtnRect := T2DIntRect.Create(0, 0, BtnWidth - 1, PaneRowHeightT - 1);
DropRect:=T2DIntRect.Create(BtnRect.right+1, DropRect := T2DIntRect.Create(BtnRect.Right+1, 0, BtnRect.Right+DropdownWidth, PaneRowHeight - 1);
0,
BtnRect.right+DropdownWidth,
PaneRowHeight - 1);
{$ELSE} {$ELSE}
BtnRect.Create(0, 0, BtnWidth - 1, PaneRowHeight - 1); BtnRect.Create(0, 0, BtnWidth - 1, PaneRowHeight - 1);
DropRect.Create(BtnRect.right+1, 0, DropRect.Create(BtnRect.Right+1, 0, BtnRect.Right+DropdownWidth, PaneRowHeight - 1);
BtnRect.right+DropdownWidth, PaneRowHeight - 1);
{$ENDIF} {$ENDIF}
end; end;
bkDropdown: begin
bkDropdown:
begin
// Lewa krawêdŸ przycisku // Lewa krawêdŸ przycisku
if FGroupBehaviour in [gbContinuesGroup, gbEndsGroup] then if FGroupBehaviour in [gbContinuesGroup, gbEndsGroup] then
BtnWidth:=BtnWidth + SmallButtonHalfBorderWidth else BtnWidth := BtnWidth + SmallButtonHalfBorderWidth
BtnWidth:=BtnWidth + SmallButtonBorderWidth; else
BtnWidth := BtnWidth + SmallButtonBorderWidth;
// Prawa krawêdŸ przycisku // Prawa krawêdŸ przycisku
if (FGroupBehaviour in [gbBeginsGroup, gbContinuesGroup]) then if (FGroupBehaviour in [gbBeginsGroup, gbContinuesGroup]) then
BtnWidth:=BtnWidth + SmallButtonHalfBorderWidth else BtnWidth := BtnWidth + SmallButtonHalfBorderWidth
BtnWidth:=BtnWidth + SmallButtonBorderWidth; else
BtnWidth := BtnWidth + SmallButtonBorderWidth;
// Dodatkowy obszar na dropdown + miejsce na œrodkow¹ krawêdŸ, // Dodatkowy obszar na dropdown + miejsce na œrodkow¹ krawêdŸ,
// dla kompatybilnoœci wymiarów z dkButtonDropdown // dla kompatybilnoœci wymiarów z dkButtonDropdown
BtnWidth:=BtnWidth + SmallButtonBorderWidth + SmallButtonDropdownWidth; BtnWidth := BtnWidth + SmallButtonBorderWidth + SmallButtonDropdownWidth;
{$IFDEF EnhancedRecordSupport} {$IFDEF EnhancedRecordSupport}
BtnRect:=T2DIntRect.Create(0, 0, BtnWidth - 1, PaneRowHeight - 1); BtnRect := T2DIntRect.Create(0, 0, BtnWidth - 1, PaneRowHeight - 1);
DropRect:=T2DIntRect.Create(0, 0, 0, 0); DropRect := T2DIntRect.Create(0, 0, 0, 0);
{$ELSE} {$ELSE}
BtnRect.Create(0, 0, BtnWidth - 1, PaneRowHeight - 1); BtnRect.Create(0, 0, BtnWidth - 1, PaneRowHeight - 1);
DropRect.Create(0, 0, 0, 0); DropRect.Create(0, 0, 0, 0);
{$ENDIF} {$ENDIF}
end; end;
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); procedure TSpkSmallButton.Draw(ABuffer: TBitmap; ClipRect: T2DIntRect);
@ -1581,7 +1584,7 @@ end;
procedure TSpkSmallButton.SetImageIndex(const Value: TImageIndex); procedure TSpkSmallButton.SetImageIndex(const Value: TImageIndex);
begin begin
FImageIndex:=Value; FImageIndex := Value;
if Assigned(FToolbarDispatch) then if Assigned(FToolbarDispatch) then
FToolbarDispatch.NotifyMetricsChanged; FToolbarDispatch.NotifyMetricsChanged;
end; end;

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

@ -12,7 +12,6 @@ type
TSpkCustomCheckbox = class; TSpkCustomCheckbox = class;
TSpkCheckboxActionLink = class(TSpkButtonActionLink) TSpkCheckboxActionLink = class(TSpkButtonActionLink)
private
protected protected
procedure SetChecked(Value: Boolean); override; procedure SetChecked(Value: Boolean); override;
public public
@ -98,7 +97,8 @@ procedure TSpkCheckboxActionLink.SetChecked(Value: Boolean);
var var
cb: TSpkCustomCheckbox; cb: TSpkCustomCheckbox;
begin begin
if IsCheckedLinked then begin if IsCheckedLinked then
begin
cb := TSpkCustomCheckbox(FClient); cb := TSpkCustomCheckbox(FClient);
cb.Checked := Value; cb.Checked := Value;
end; end;
@ -120,7 +120,8 @@ end;
procedure TSpkCustomCheckbox.ActionChange(Sender: TObject); procedure TSpkCustomCheckbox.ActionChange(Sender: TObject);
begin begin
if Sender is TCustomAction then if Sender is TCustomAction then
with TCustomAction(Sender) do begin with TCustomAction(Sender) do
begin
if (Self.Caption = '') or (Self.Caption = GetDefaultCaption) then if (Self.Caption = '') or (Self.Caption = GetDefaultCaption) then
Self.Caption := Caption; Self.Caption := Caption;
if (Self.Enabled = True) then if (Self.Enabled = True) then
@ -148,7 +149,7 @@ end;
procedure TSpkCustomCheckbox.CalcRects; procedure TSpkCustomCheckbox.CalcRects;
var var
RectVector : T2DIntVector; RectVector: T2DIntVector;
begin begin
ConstructRect(FButtonRect); ConstructRect(FButtonRect);
{$IFDEF EnhancedRecordSupport} {$IFDEF EnhancedRecordSupport}
@ -179,12 +180,12 @@ end;
procedure TSpkCustomCheckbox.ConstructRect(var BtnRect: T2DIntRect); procedure TSpkCustomCheckbox.ConstructRect(var BtnRect: T2DIntRect);
var var
BtnWidth : integer; BtnWidth: integer;
Bitmap : TBitmap; Bitmap: TBitmap;
TextWidth: Integer; TextWidth: Integer;
begin begin
{$IFDEF EnhancedRecordSupport} {$IFDEF EnhancedRecordSupport}
BtnRect:=T2DIntRect.Create(0, 0, 0, 0); BtnRect := T2DIntRect.Create(0, 0, 0, 0);
{$ELSE} {$ELSE}
BtnRect.Create(0, 0, 0, 0); BtnRect.Create(0, 0, 0, 0);
{$ENDIF} {$ENDIF}
@ -195,7 +196,7 @@ begin
exit; exit;
Bitmap := FToolbarDispatch.GetTempBitmap; Bitmap := FToolbarDispatch.GetTempBitmap;
if not(assigned(Bitmap)) then if not Assigned(Bitmap) then
exit; exit;
Bitmap.Canvas.Font.Assign(FAppearance.Element.CaptionFont); Bitmap.Canvas.Font.Assign(FAppearance.Element.CaptionFont);
@ -246,7 +247,8 @@ begin
end; end;
// Border // Border
if (FButtonState = bsIdle) and (not(FHideFrameWhenIdle)) then begin if (FButtonState = bsIdle) and (not(FHideFrameWhenIdle)) then
begin
with FAppearance.Element do with FAppearance.Element do
TButtonTools.DrawButton( TButtonTools.DrawButton(
ABuffer, ABuffer,
@ -265,7 +267,8 @@ begin
ClipRect ClipRect
); );
end else end else
if (FButtonState=bsBtnHottrack) then begin if (FButtonState=bsBtnHottrack) then
begin
with FAppearance.Element do with FAppearance.Element do
TButtonTools.DrawButton( TButtonTools.DrawButton(
ABuffer, ABuffer,
@ -284,7 +287,8 @@ begin
ClipRect ClipRect
); );
end else end else
if (FButtonState = bsBtnPressed) then begin if (FButtonState = bsBtnPressed) then
begin
with FAppearance.Element do with FAppearance.Element do
TButtonTools.DrawButton( TButtonTools.DrawButton(
ABuffer, ABuffer,
@ -305,11 +309,13 @@ begin
end; end;
// Checkbox // Checkbox
if ThemeServices.ThemesEnabled then begin if ThemeServices.ThemesEnabled then
begin
te := ThemeServices.GetElementDetails(tbCheckboxCheckedNormal); te := ThemeServices.GetElementDetails(tbCheckboxCheckedNormal);
h := ThemeServices.GetDetailSize(te).cy; h := ThemeServices.GetDetailSize(te).cy;
end else end else
h := GetSystemMetrics(SM_CYMENUCHECK); h := GetSystemMetrics(SM_CYMENUCHECK);
if (FGroupBehaviour in [gbContinuesGroup, gbEndsGroup]) then if (FGroupBehaviour in [gbContinuesGroup, gbEndsGroup]) then
x := FButtonRect.Left + SmallButtonHalfBorderWidth + SmallButtonPadding x := FButtonRect.Left + SmallButtonHalfBorderWidth + SmallButtonPadding
else else
@ -350,40 +356,40 @@ end;
function TSpkCustomCheckbox.GetChecked: Boolean; function TSpkCustomCheckbox.GetChecked: Boolean;
begin begin
result := (FState = cbChecked); Result := (FState = cbChecked);
end; end;
function TSpkCustomCheckbox.GetDefaultCaption: String; function TSpkCustomCheckbox.GetDefaultCaption: String;
begin begin
result := 'Checkbox'; Result := 'Checkbox';
end; end;
function TSpkCustomCheckbox.GetGroupBehaviour: TSpkItemGroupBehaviour; function TSpkCustomCheckbox.GetGroupBehaviour: TSpkItemGroupBehaviour;
begin begin
result := FGroupBehaviour; Result := FGroupBehaviour;
end; end;
function TSpkCustomCheckbox.GetSize: TSpkItemSize; function TSpkCustomCheckbox.GetSize: TSpkItemSize;
begin begin
result := isNormal; Result := isNormal;
end; end;
function TSpkCustomCheckbox.GetTableBehaviour: TSpkItemTableBehaviour; function TSpkCustomCheckbox.GetTableBehaviour: TSpkItemTableBehaviour;
begin begin
result := FTableBehaviour; Result := FTableBehaviour;
end; end;
function TSpkCustomCheckbox.GetWidth: integer; function TSpkCustomCheckbox.GetWidth: integer;
var var
BtnRect, DropRect : T2DIntRect; BtnRect, DropRect: T2DIntRect;
begin begin
result := -1; Result := -1;
if FToolbarDispatch = nil then if FToolbarDispatch = nil then
exit; exit;
if FAppearance = nil then if FAppearance = nil then
exit; exit;
ConstructRect(BtnRect); ConstructRect(BtnRect);
result := BtnRect.Right + 1; Result := BtnRect.Right + 1;
end; end;
procedure TSpkCustomCheckbox.MouseDown(Button: TMouseButton; Shift: TShiftState; procedure TSpkCustomCheckbox.MouseDown(Button: TMouseButton; Shift: TShiftState;
@ -452,7 +458,8 @@ end;
procedure TSpkCustomCheckbox.SetState(AValue:TCheckboxState); procedure TSpkCustomCheckbox.SetState(AValue:TCheckboxState);
begin begin
if AValue <> FState then begin if AValue <> FState then
begin
FState := AValue; FState := AValue;
if Assigned(FToolbarDispatch) then if Assigned(FToolbarDispatch) then
FToolbarDispatch.NotifyVisualsChanged; FToolbarDispatch.NotifyVisualsChanged;
@ -477,6 +484,7 @@ end;
{ TSpkRadioButton } { TSpkRadioButton }
constructor TSpkRadioButton.Create(AOwner: TComponent); constructor TSpkRadioButton.Create(AOwner: TComponent);
begin begin
inherited Create(AOwner); inherited Create(AOwner);
@ -485,7 +493,7 @@ end;
function TSpkRadioButton.GetDefaultCaption: string; function TSpkRadioButton.GetDefaultCaption: string;
begin begin
result := 'RadioButton'; Result := 'RadioButton';
end; end;
procedure TSpkRadioButton.SetState(AValue: TCheckboxState); procedure TSpkRadioButton.SetState(AValue: TCheckboxState);
@ -500,7 +508,8 @@ var
i: Integer; i: Integer;
pane: TSpkPane; pane: TSpkPane;
begin begin
if (Parent is TSpkPane) then begin if (Parent is TSpkPane) then
begin
pane := TSpkPane(Parent); pane := TSpkPane(Parent);
for i:=0 to pane.Items.Count-1 do for i:=0 to pane.Items.Count-1 do
if (pane.items[i] is TSpkRadioButton) and (pane.items[i] <> self) then 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); procedure SpkInitLayoutConsts(FromDPI: Integer; ToDPI: Integer = 0);
begin begin
if not(DPI_AWARE) then if not(DPI_AWARE) then
ToDPI := FromDPI; ToDPI := FromDPI;
@ -391,21 +390,21 @@ initialization
// Sprawdzanie poprawnoœci // Sprawdzanie poprawnoœci
// £uk du¿ego przycisku // £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 // Tafla, wersja z jednym wierszem
assert(PANE_ROW_HEIGHT + Assert(PANE_ROW_HEIGHT +
PANE_ONE_ROW_TOPPADDING + PANE_ONE_ROW_TOPPADDING +
PANE_ONE_ROW_BOTTOMPADDING <= MAX_ELEMENT_HEIGHT); PANE_ONE_ROW_BOTTOMPADDING <= MAX_ELEMENT_HEIGHT);
// Tafla, wersja z dwoma wierszami // Tafla, wersja z dwoma wierszami
assert(2*PANE_ROW_HEIGHT + Assert(2*PANE_ROW_HEIGHT +
PANE_TWO_ROWS_TOPPADDING + PANE_TWO_ROWS_TOPPADDING +
PANE_TWO_ROWS_VSPACER + PANE_TWO_ROWS_VSPACER +
PANE_TWO_ROWS_BOTTOMPADDING <= MAX_ELEMENT_HEIGHT); PANE_TWO_ROWS_BOTTOMPADDING <= MAX_ELEMENT_HEIGHT);
// Tafla, wersja z trzema wierszami // Tafla, wersja z trzema wierszami
assert(3*PANE_ROW_HEIGHT + Assert(3*PANE_ROW_HEIGHT +
PANE_THREE_ROWS_TOPPADDING + PANE_THREE_ROWS_TOPPADDING +
2*PANE_THREE_ROWS_VSPACER + 2*PANE_THREE_ROWS_VSPACER +
PANE_THREE_ROWS_BOTTOMPADDING <= MAX_ELEMENT_HEIGHT); PANE_THREE_ROWS_BOTTOMPADDING <= MAX_ELEMENT_HEIGHT);

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

@ -15,31 +15,29 @@ unit spkt_Dispatch;
interface interface
uses Classes, Controls, Graphics, uses
Classes, Controls, Graphics,
SpkMath; SpkMath;
type TSpkBaseDispatch = class abstract(TObject) type
TSpkBaseDispatch = class abstract(TObject)
private private
protected protected
public public
end; end;
type TSpkBaseAppearanceDispatch = class abstract(TSpkBaseDispatch) TSpkBaseAppearanceDispatch = class abstract(TSpkBaseDispatch)
private
protected
public public
procedure NotifyAppearanceChanged; virtual; abstract; procedure NotifyAppearanceChanged; virtual; abstract;
end; end;
type TSpkBaseToolbarDispatch = class abstract(TSpkBaseAppearanceDispatch) TSpkBaseToolbarDispatch = class abstract(TSpkBaseAppearanceDispatch)
private
protected
public public
procedure NotifyItemsChanged; virtual; abstract; procedure NotifyItemsChanged; virtual; abstract;
procedure NotifyMetricsChanged; virtual; abstract; procedure NotifyMetricsChanged; virtual; abstract;
procedure NotifyVisualsChanged; virtual; abstract; procedure NotifyVisualsChanged; virtual; abstract;
function GetTempBitmap : TBitmap; virtual; abstract; function GetTempBitmap: TBitmap; virtual; abstract;
function ClientToScreen(Point : T2DIntPoint) : T2DIntPoint; virtual; abstract; function ClientToScreen(Point: T2DIntPoint): T2DIntPoint; virtual; abstract;
end; end;
implementation implementation

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

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

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

@ -15,44 +15,47 @@ unit spkt_Items;
interface interface
uses Classes, Controls, SysUtils, Dialogs, uses
Classes, Controls, SysUtils, Dialogs,
spkt_Appearance, spkt_Dispatch, spkt_BaseItem, spkt_Types, spkt_Appearance, spkt_Dispatch, spkt_BaseItem, spkt_Types,
spkt_Buttons, spkt_Checkboxes; spkt_Buttons, spkt_Checkboxes;
type TSpkItems = class(TSpkCollection) type
TSpkItems = class(TSpkCollection)
private private
FToolbarDispatch : TSpkBaseToolbarDispatch; FToolbarDispatch: TSpkBaseToolbarDispatch;
FAppearance : TSpkToolbarAppearance; FAppearance: TSpkToolbarAppearance;
FImages : TImageList; FImages: TImageList;
FDisabledImages : TImageList; FDisabledImages: TImageList;
FLargeImages : TImageList; FLargeImages: TImageList;
FDisabledLargeImages : TImageList; FDisabledLargeImages: TImageList;
// *** Gettery i settery *** // *** Gettery i settery ***
procedure SetToolbarDispatch(const Value: TSpkBaseToolbarDispatch); procedure SetToolbarDispatch(const Value: TSpkBaseToolbarDispatch);
function GetItems(index: integer): TSpkBaseItem; reintroduce; function GetItems(AIndex: integer): TSpkBaseItem; reintroduce;
procedure SetAppearance(const Value: TSpkToolbarAppearance); procedure SetAppearance(const Value: TSpkToolbarAppearance);
procedure SetImages(const Value: TImageList); procedure SetImages(const Value: TImageList);
procedure SetDisabledImages(const Value : TImageList); procedure SetDisabledImages(const Value: TImageList);
procedure SetLargeImages(const Value : TImageList); procedure SetLargeImages(const Value: TImageList);
procedure SetDisabledLargeImages(const Value : TImageList); procedure SetDisabledLargeImages(const Value: TImageList);
public public
function AddLargeButton : TSpkLargeButton; function AddLargeButton: TSpkLargeButton;
function AddSmallButton : TSpkSmallButton; function AddSmallButton: TSpkSmallButton;
function AddCheckbox: TSpkCheckbox; function AddCheckbox: TSpkCheckbox;
function AddRadioButton: TSpkRadioButton; function AddRadioButton: TSpkRadioButton;
// *** Reakcja na zmiany listy *** // *** Reakcja na zmiany listy ***
procedure Notify(Item: TComponent; Operation : TOperation); override; procedure Notify(Item: TComponent; Operation: TOperation); override;
procedure Update; override; procedure Update; override;
property Items[index : integer] : TSpkBaseItem read GetItems; default; property Items[index: integer]: TSpkBaseItem read GetItems; default;
property ToolbarDispatch : TSpkBaseToolbarDispatch read FToolbarDispatch write SetToolbarDispatch; property ToolbarDispatch: TSpkBaseToolbarDispatch read FToolbarDispatch write SetToolbarDispatch;
property Appearance : TSpkToolbarAppearance read FAppearance write SetAppearance; property Appearance: TSpkToolbarAppearance read FAppearance write SetAppearance;
property Images : TImageList read FImages write SetImages; property Images: TImageList read FImages write SetImages;
property DisabledImages : TImageList read FDisabledImages write SetDisabledImages; property DisabledImages: TImageList read FDisabledImages write SetDisabledImages;
property LargeImages : TImageList read FLargeImages write SetLargeImages; property LargeImages: TImageList read FLargeImages write SetLargeImages;
property DisabledLargeImages : TImageList read FDisabledLargeImages write SetDisabledLargeImages; property DisabledLargeImages: TImageList read FDisabledLargeImages write SetDisabledLargeImages;
end; end;
implementation implementation
@ -87,47 +90,45 @@ begin
AddItem(Result); AddItem(Result);
end; end;
function TSpkItems.GetItems(index: integer): TSpkBaseItem; function TSpkItems.GetItems(AIndex: integer): TSpkBaseItem;
begin begin
result:=TSpkBaseItem(inherited Items[index]); Result := TSpkBaseItem(inherited Items[AIndex]);
end; end;
procedure TSpkItems.Notify(Item: TComponent; procedure TSpkItems.Notify(Item: TComponent; Operation: TOperation);
Operation : TOperation);
begin begin
inherited Notify(Item, Operation); inherited Notify(Item, Operation);
case Operation of case Operation of
opInsert: begin opInsert:
begin
// Ustawienie dyspozytora na nil spowoduje, ¿e podczas // Ustawienie dyspozytora na nil spowoduje, ¿e podczas
// przypisywania w³asnoœci nie bêd¹ wo³ane metody Notify* // 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; opRemove:
TSpkBaseItem(Item).Images:=FImages; if not (csDestroying in Item.ComponentState) then
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
begin begin
TSpkBaseItem(Item).ToolbarDispatch:=nil; TSpkBaseItem(Item).ToolbarDispatch := nil;
TSpkBaseItem(Item).Appearance:=nil; TSpkBaseItem(Item).Appearance := nil;
TSpkBaseItem(Item).Images:=nil; TSpkBaseItem(Item).Images := nil;
TSpkBaseItem(Item).DisabledImages:=nil; TSpkBaseItem(Item).DisabledImages := nil;
TSpkBaseItem(Item).LargeImages:=nil; TSpkBaseItem(Item).LargeImages := nil;
TSpkBaseItem(Item).DisabledLargeImages:=nil; TSpkBaseItem(Item).DisabledLargeImages := nil;
end;
end; end;
end; end;
end; end;
procedure TSpkItems.SetAppearance(const Value: TSpkToolbarAppearance); procedure TSpkItems.SetAppearance(const Value: TSpkToolbarAppearance);
var
var i: Integer; i: Integer;
begin begin
FAppearance := Value; FAppearance := Value;
for i := 0 to Count - 1 do for i := 0 to Count - 1 do
@ -135,9 +136,8 @@ begin
end; end;
procedure TSpkItems.SetDisabledImages(const Value: TImageList); procedure TSpkItems.SetDisabledImages(const Value: TImageList);
var
var i: Integer; i: Integer;
begin begin
FDisabledImages := Value; FDisabledImages := Value;
for i := 0 to Count - 1 do for i := 0 to Count - 1 do
@ -145,9 +145,8 @@ begin
end; end;
procedure TSpkItems.SetDisabledLargeImages(const Value: TImageList); procedure TSpkItems.SetDisabledLargeImages(const Value: TImageList);
var
var i: Integer; i: Integer;
begin begin
FDisabledLargeImages := Value; FDisabledLargeImages := Value;
for i := 0 to Count - 1 do for i := 0 to Count - 1 do
@ -155,9 +154,8 @@ begin
end; end;
procedure TSpkItems.SetImages(const Value: TImageList); procedure TSpkItems.SetImages(const Value: TImageList);
var
var i: Integer; i: Integer;
begin begin
FImages := Value; FImages := Value;
for i := 0 to Count - 1 do for i := 0 to Count - 1 do
@ -165,9 +163,8 @@ begin
end; end;
procedure TSpkItems.SetLargeImages(const Value: TImageList); procedure TSpkItems.SetLargeImages(const Value: TImageList);
var
var i: Integer; i: Integer;
begin begin
FLargeImages := Value; FLargeImages := Value;
for i := 0 to Count - 1 do for i := 0 to Count - 1 do
@ -175,9 +172,8 @@ begin
end; end;
procedure TSpkItems.SetToolbarDispatch(const Value: TSpkBaseToolbarDispatch); procedure TSpkItems.SetToolbarDispatch(const Value: TSpkBaseToolbarDispatch);
var
var i : integer; i : integer;
begin begin
FToolbarDispatch := Value; FToolbarDispatch := Value;
for i := 0 to Count - 1 do for i := 0 to Count - 1 do
@ -187,8 +183,7 @@ end;
procedure TSpkItems.Update; procedure TSpkItems.Update;
begin begin
inherited Update; inherited Update;
if Assigned(FToolbarDispatch) then
if assigned(FToolbarDispatch) then
FToolbarDispatch.NotifyItemsChanged; FToolbarDispatch.NotifyItemsChanged;
end; 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 uses
Graphics, SysUtils, SpkMath, SpkGUITools; Graphics, SysUtils, SpkMath, SpkGUITools;
type TButtonTools = class sealed(TObject) type
private TButtonTools = class sealed(TObject)
protected
public public
class procedure DrawButton(Bitmap: TBitmap; class procedure DrawButton(Bitmap: TBitmap;
Rect: T2DIntRect; Rect: T2DIntRect;
@ -46,13 +45,12 @@ class procedure TButtonTools.DrawButton(Bitmap: TBitmap;
Rect: T2DIntRect; FrameColor, InnerLightColor, InnerDarkColor, GradientFrom, Rect: T2DIntRect; FrameColor, InnerLightColor, InnerDarkColor, GradientFrom,
GradientTo: TColor; GradientKind: TBackgroundKind; LeftEdgeOpen, GradientTo: TColor; GradientKind: TBackgroundKind; LeftEdgeOpen,
RightEdgeOpen, TopEdgeOpen, BottomEdgeOpen: boolean; Radius: integer; RightEdgeOpen, TopEdgeOpen, BottomEdgeOpen: boolean; Radius: integer;
ClipRect : T2DIntRect); ClipRect: T2DIntRect);
var var
x1, x2, y1, y2: integer; x1, x2, y1, y2: integer;
LeftClosed, TopClosed, RightClosed, BottomClosed: byte; LeftClosed, TopClosed, RightClosed, BottomClosed: byte;
begin 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; (Rect.Width < 2*Radius) or (Rect.Height < 2*Radius) then exit;
if LeftEdgeOpen then LeftClosed := 0 else LeftClosed := 1; 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 interface
uses Controls, Classes, ContNrs, SysUtils, Dialogs, uses
Controls, Classes, ContNrs, SysUtils, Dialogs,
spkt_Exceptions; spkt_Exceptions;
type TSpkListState = (lsNeedsProcessing, lsReady); type
TSpkListState = (lsNeedsProcessing, lsReady);
type TSpkCollection = class(TPersistent) TSpkCollection = class(TPersistent)
private
protected protected
FList : TFPObjectList; FList: TFPObjectList;
FNames : TStringList; FNames: TStringList;
FListState : TSpkListState; FListState: TSpkListState;
FRootComponent : TComponent; FRootComponent: TComponent;
// *** Metody reakcji na zmiany w liœcie *** // *** Metody reakcji na zmiany w liœcie ***
// *** Methods responding to changes in list *** // *** Methods responding to changes in list ***
procedure Notify(Item : TComponent; Operation : TOperation); virtual; procedure Notify(Item: TComponent; Operation: TOperation); virtual;
procedure Update; virtual; procedure Update; virtual;
// *** Wewnêtrzne metody dodawania i wstawiania elementów *** // *** Wewnêtrzne metody dodawania i wstawiania elementów ***
@ -37,19 +38,20 @@ type TSpkCollection = class(TPersistent)
// *** Internal methods for adding and inserting elements *** // *** Internal methods for adding and inserting elements ***
// *** Getters and setters *** // *** Getters and setters ***
function GetItems(index: integer): TComponent; virtual; function GetItems(AIndex: integer): TComponent; virtual;
public public
// *** Konstruktor, destruktor *** // *** Konstruktor, destruktor ***
constructor Create(RootComponent : TComponent); reintroduce; virtual; constructor Create(ARootComponent : TComponent); reintroduce; virtual;
destructor Destroy; override; destructor Destroy; override;
// *** Obs³uga listy *** // *** Obs³uga listy ***
// *** List operations *** // *** List operations ***
procedure AddItem(AItem: TComponent); procedure AddItem(AItem: TComponent);
procedure InsertItem(index: integer; AItem: TComponent); procedure InsertItem(AIndex: integer; AItem: TComponent);
procedure Clear; procedure Clear;
function Count: integer; function Count: integer;
procedure Delete(index: integer); virtual; procedure Delete(AIndex: integer); virtual;
function IndexOf(Item: TComponent) : integer; function IndexOf(Item: TComponent) : integer;
procedure Remove(Item: TComponent); virtual; procedure Remove(Item: TComponent); virtual;
procedure RemoveReference(Item: TComponent); procedure RemoveReference(Item: TComponent);
@ -62,38 +64,54 @@ type TSpkCollection = class(TPersistent)
procedure ReadNames(Reader: TReader); virtual; procedure ReadNames(Reader: TReader); virtual;
procedure ProcessNames(Owner: TComponent); virtual; procedure ProcessNames(Owner: TComponent); virtual;
property ListState : TSpkListState read FListState; property ListState: TSpkListState read FListState;
property Items[index : integer] : TComponent read GetItems; default; property Items[index: integer] : TComponent read GetItems; default;
property RootComponent: TComponent read FRootComponent; property RootComponent: TComponent read FRootComponent;
end; end;
type TSpkComponent = class(TComponent) TSpkComponent = class(TComponent)
private
protected protected
FParent : TComponent; FParent: TComponent;
FCollection: TSpkCollection; FCollection: TSpkCollection;
public public
// *** Obs³uga parenta *** // *** Obs³uga parenta ***
// *** Parent operations *** // *** Parent operations ***
function HasParent : boolean; override; function HasParent: boolean; override;
function GetParentComponent : TComponent; override; function GetParentComponent: TComponent; override;
procedure SetParentComponent(Value : 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; property Collection: TSpkCollection read FCollection;
end; end;
implementation implementation
{ TSpkCollection } { 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); procedure TSpkCollection.AddItem(AItem: TComponent);
begin begin
// Ta metoda mo¿e byæ wywo³ywana bez przetworzenia nazw (w szczególnoœci, metoda // Ta metoda mo¿e byæ wywo³ywana bez przetworzenia nazw (w szczególnoœci, metoda
// przetwarzaj¹ca nazwy korzysta z AddItem) // przetwarzaj¹ca nazwy korzysta z AddItem)
// This method can be recalling untreated names (in particular, the method // This method can be recalling untreated names (in particular, the method
// uses the name przetwarzaj¹ca AddItem) --- ??? // uses the name przetwarzaj¹ca AddItem) --- ???
Notify(AItem, opInsert); Notify(AItem, opInsert);
FList.Add(AItem); FList.Add(AItem);
@ -112,49 +130,31 @@ end;
function TSpkCollection.Count: integer; function TSpkCollection.Count: integer;
begin begin
result := FList.Count; Result := FList.Count;
end; end;
constructor TSpkCollection.Create(RootComponent : TComponent); procedure TSpkCollection.Delete(AIndex: integer);
begin begin
inherited Create; if (AIndex < 0) or (AIndex >= FList.count) then
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
raise InternalException.Create('TSpkCollection.Delete: Illegal index!'); raise InternalException.Create('TSpkCollection.Delete: Illegal index!');
//raise InternalException.Create('TSpkCollection.Delete: Nieprawid³owy indeks!');
Notify(TComponent(FList[index]), opRemove); Notify(TComponent(FList[AIndex]), opRemove);
FList.Delete(index); FList.Delete(AIndex);
Update; Update;
end; end;
destructor TSpkCollection.Destroy;
begin
FNames.Destroy;
FList.Destroy;
inherited;
end;
procedure TSpkCollection.Exchange(item1, item2: integer); procedure TSpkCollection.Exchange(item1, item2: integer);
begin begin
FList.Exchange(item1, item2); FList.Exchange(item1, item2);
Update; Update;
end; end;
function TSpkCollection.GetItems(index: integer): TComponent; function TSpkCollection.GetItems(AIndex: integer): TComponent;
begin 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: Illegal index!');
//raise InternalException.create('TSpkCollection.GetItems: Nieprawid³owy indeks!');
result := TComponent(FList[index]); Result := TComponent(FList[AIndex]);
end; end;
function TSpkCollection.IndexOf(Item: TComponent): integer; function TSpkCollection.IndexOf(Item: TComponent): integer;
@ -162,14 +162,13 @@ begin
result := FList.IndexOf(Item); result := FList.IndexOf(Item);
end; end;
procedure TSpkCollection.InsertItem(index: integer; AItem: TComponent); procedure TSpkCollection.InsertItem(AIndex: integer; AItem: TComponent);
begin 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: Illegal index!');
//raise InternalException.Create('TSpkCollection.Insert: Nieprawid³owy indeks!');
Notify(AItem, opInsert); Notify(AItem, opInsert);
FList.Insert(index, AItem); FList.Insert(AIndex, AItem);
if AItem is TSpkComponent then if AItem is TSpkComponent then
TSpkComponent(AItem).FCollection := self; TSpkComponent(AItem).FCollection := self;
Update; Update;
@ -181,7 +180,6 @@ begin
(indexTo < 0) or (indexTo >= FList.Count) (indexTo < 0) or (indexTo >= FList.Count)
then then
raise InternalException.Create('TSpkCollection.Delete: Illegal index!'); raise InternalException.Create('TSpkCollection.Delete: Illegal index!');
//raise InternalException.Create('TSpkCollection.Move: Nieprawid³owy indeks!');
FList.Move(IndexFrom, IndexTo); FList.Move(IndexFrom, IndexTo);
Update; Update;
@ -242,7 +240,7 @@ end;
procedure TSpkCollection.Update; procedure TSpkCollection.Update;
begin begin
// //
end; end;
procedure TSpkCollection.WriteNames(Writer: TWriter); procedure TSpkCollection.WriteNames(Writer: TWriter);
@ -255,16 +253,17 @@ begin
Writer.WriteListEnd; Writer.WriteListEnd;
end; end;
{ TSpkComponent } { TSpkComponent }
function TSpkComponent.GetParentComponent: TComponent; function TSpkComponent.GetParentComponent: TComponent;
begin begin
result := FParent; Result := FParent;
end; end;
function TSpkComponent.HasParent: boolean; function TSpkComponent.HasParent: boolean;
begin begin
result := FParent<>nil; Result := (FParent <> nil);
end; end;
procedure TSpkComponent.SetParentComponent(Value: TComponent); 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 interface
uses 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, Dialogs, ExtCtrls, StdCtrls, ComCtrls, Buttons, Spin,
SpkGUITools, SpkXMLParser, SpkGUITools, SpkXMLParser, SpkToolbar,
spkt_Buttons, spkt_BaseItem, spkt_Pane, spkt_Types, spkt_Tab, SpkToolbar, spkt_Buttons, spkt_Pane, spkt_Tab, spkt_Appearance;
spkt_Appearance;
type type