From 49c250890f20ef242160446c9a1f382cf08a03f1 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Sat, 26 Nov 2016 23:56:34 +0000 Subject: [PATCH] SpkToolbar: Apply conventional source formatting git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5383 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../spktoolbar/SpkToolbar/SpkToolbar.pas | 36 +- .../spktoolbar/SpkToolbar/spkt_Appearance.pas | 747 ++++----- .../spktoolbar/SpkToolbar/spkt_BaseItem.pas | 162 +- .../spktoolbar/SpkToolbar/spkt_Buttons.pas | 1105 ++++++------- .../spktoolbar/SpkToolbar/spkt_Checkboxes.pas | 55 +- .../spktoolbar/SpkToolbar/spkt_Const.pas | 9 +- .../spktoolbar/SpkToolbar/spkt_Dispatch.pas | 44 +- .../spktoolbar/SpkToolbar/spkt_Exceptions.pas | 12 +- .../spktoolbar/SpkToolbar/spkt_Items.pas | 157 +- .../spktoolbar/SpkToolbar/spkt_Pane.pas | 1425 ++++++++--------- components/spktoolbar/SpkToolbar/spkt_Tab.pas | 981 ++++++------ .../spktoolbar/SpkToolbar/spkt_Tools.pas | 42 +- .../spktoolbar/SpkToolbar/spkt_Types.pas | 191 ++- .../spktoolbar/demos/basic/Project1.res | Bin 138936 -> 138932 bytes .../designtime/spkte_AppearanceEditor.pas | 7 +- 15 files changed, 2452 insertions(+), 2521 deletions(-) diff --git a/components/spktoolbar/SpkToolbar/SpkToolbar.pas b/components/spktoolbar/SpkToolbar/SpkToolbar.pas index 439b1b9d9..3fcc4afc0 100644 --- a/components/spktoolbar/SpkToolbar/SpkToolbar.pas +++ b/components/spktoolbar/SpkToolbar/SpkToolbar.pas @@ -418,11 +418,13 @@ type property OnTabChanged: TNotifyEvent read FOnTabChanged write FOnTabChanged; end; + implementation uses LCLIntf, Themes; + { TSpkToolbarDispatch } function TSpkToolbarDispatch.ClientToScreen(Point: T2DIntPoint): T2DIntPoint; @@ -478,21 +480,20 @@ begin FToolbar.NotifyVisualsChanged; end; + { TSpkToolbar } function TSpkToolbar.AtLeastOneTabVisible: boolean; - var i: integer; TabVisible: boolean; - begin Result := FTabs.Count > 0; if Result then begin TabVisible := False; i := FTabs.Count - 1; - while (i >= 0) and not (TabVisible) do + while (i >= 0) and not TabVisible do begin TabVisible := FTabs[i].Visible; Dec(i); @@ -588,7 +589,6 @@ end; procedure TSpkToolbar.DefineProperties(Filer: TFiler); begin inherited DefineProperties(Filer); - Filer.DefineProperty('Tabs', FTabs.ReadNames, FTabs.WriteNames, True); end; @@ -596,13 +596,11 @@ destructor TSpkToolbar.Destroy; begin // Release the fields FTabs.Free; - FAppearance.Free; // Release the internal fields FTemporary.Free; FBuffer.Free; - FToolbarDispatch.Free; {$IFDEF DELAYRUNTIMER} @@ -615,7 +613,6 @@ end; procedure TSpkToolbar.EndUpdate; begin FUpdating := False; - ValidateMetrics; ValidateBuffer; Repaint; @@ -638,10 +635,8 @@ var i: integer; begin inherited; - - if FTabs.Count > 0 then - for i := 0 to FTabs.Count - 1 do - Proc(FTabs.Items[i]); + for i := 0 to FTabs.Count - 1 do + Proc(FTabs.Items[i]); end; function TSpkToolbar.GetColor: TColor; @@ -681,9 +676,7 @@ begin InternalBeginUpdate; if FTabs.ListState = lsNeedsProcessing then - begin FTabs.ProcessNames(self.Owner); - end; InternalEndUpdate; @@ -975,7 +968,6 @@ end; procedure TSpkToolbar.NotifyAppearanceChanged; begin SetMetricsInvalid; - if not (FInternalUpdating or FUpdating) then Repaint; end; @@ -983,7 +975,6 @@ end; procedure TSpkToolbar.NotifyMetricsChanged; begin SetMetricsInvalid; - if not (FInternalUpdating or FUpdating) then Repaint; end; @@ -1025,7 +1016,6 @@ end; procedure TSpkToolbar.NotifyVisualsChanged; begin SetBufferInvalid; - if not (FInternalUpdating or FUpdating) then Repaint; end; @@ -1081,7 +1071,6 @@ procedure TSpkToolbar.SetColor(const Value: TColor); begin inherited Color := Value; SetBufferInvalid; - if not (FInternalUpdating or FUpdating) then Repaint; end; @@ -1091,7 +1080,6 @@ begin FDisabledImages := Value; FTabs.DisabledImages := Value; SetMetricsInvalid; - if not (FInternalUpdating or FUpdating) then Repaint; end; @@ -1101,7 +1089,6 @@ begin FDisabledLargeImages := Value; FTabs.DisabledLargeImages := Value; SetMetricsInvalid; - if not (FInternalUpdating or FUpdating) then Repaint; end; @@ -1111,7 +1098,6 @@ begin FImages := Value; FTabs.Images := Value; SetMetricsInvalid; - if not (FInternalUpdating or FUpdating) then Repaint; end; @@ -1121,7 +1107,6 @@ begin FLargeImages := Value; FTabs.LargeImages := Value; SetMetricsInvalid; - if not (FInternalUpdating or FUpdating) then Repaint; end; @@ -1272,14 +1257,12 @@ begin if (FTabIndex > -1) then FTabs[FTabIndex].ExecOnClick; - //Tabs don't need MouseUp end; procedure TSpkToolbar.SetAppearance(const Value: TSpkToolbarAppearance); begin FAppearance.Assign(Value); - SetBufferInvalid; if not (FInternalUpdating or FUpdating) then Repaint; @@ -1316,6 +1299,7 @@ procedure TSpkToolbar.ValidateBuffer; FocusedAppearance.Tab.GradientFromColor, FocusedAppearance.Tab.GradientToColor, FocusedAppearance.Tab.GradientType); + TGuiTools.DrawAARoundCorner(FBuffer, {$IFDEF EnhancedRecordSupport} T2DIntPoint.Create(0, ToolbarTabCaptionsHeight), @@ -1325,6 +1309,7 @@ procedure TSpkToolbar.ValidateBuffer; ToolbarCornerRadius, cpLeftTop, FocusedAppearance.Tab.BorderColor); + TGuiTools.DrawAARoundCorner(FBuffer, {$IFDEF EnhancedRecordSupport} T2DIntPoint.Create(self.Width - ToolbarCornerRadius, ToolbarTabCaptionsHeight), @@ -1334,6 +1319,7 @@ procedure TSpkToolbar.ValidateBuffer; ToolbarCornerRadius, cpRightTop, FocusedAppearance.Tab.BorderColor); + TGuiTools.DrawAARoundCorner(FBuffer, {$IFDEF EnhancedRecordSupport} T2DIntPoint.Create(0, self.Height - ToolbarCornerRadius), @@ -1343,6 +1329,7 @@ procedure TSpkToolbar.ValidateBuffer; ToolbarCornerRadius, cpLeftBottom, FocusedAppearance.Tab.BorderColor); + TGuiTools.DrawAARoundCorner(FBuffer, {$IFDEF EnhancedRecordSupport} T2DIntPoint.Create(self.Width - ToolbarCornerRadius, self.Height - ToolbarCornerRadius), @@ -1352,11 +1339,14 @@ procedure TSpkToolbar.ValidateBuffer; ToolbarCornerRadius, cpRightBottom, FocusedAppearance.Tab.BorderColor); + TGuiTools.DrawVLine(FBuffer, 0, ToolbarTabCaptionsHeight + ToolbarCornerRadius, self.Height - ToolbarCornerRadius, FocusedAppearance.Tab.BorderColor); + TGuiTools.DrawHLine(FBuffer, ToolbarCornerRadius, self.Width - ToolbarCornerRadius, self.Height - 1, FocusedAppearance.Tab.BorderColor); + TGuiTools.DrawVLine(FBuffer, self.Width - 1, ToolbarTabCaptionsHeight + ToolbarCornerRadius, self.Height - ToolbarCornerRadius, FocusedAppearance.Tab.BorderColor); diff --git a/components/spktoolbar/SpkToolbar/spkt_Appearance.pas b/components/spktoolbar/SpkToolbar/spkt_Appearance.pas index e32294273..2a6639c0b 100644 --- a/components/spktoolbar/SpkToolbar/spkt_Appearance.pas +++ b/components/spktoolbar/SpkToolbar/spkt_Appearance.pas @@ -14,13 +14,16 @@ unit spkt_Appearance; interface -uses Graphics, Classes, Forms, SysUtils, - SpkGUITools, SpkXMLParser, SpkXMLTools, - spkt_Dispatch, spkt_Exceptions, spkt_Const; +uses + Graphics, Classes, Forms, SysUtils, + SpkGUITools, SpkXMLParser, SpkXMLTools, + spkt_Dispatch, spkt_Exceptions, spkt_Const; type - TSpkPaneStyle = (psRectangleFlat, psRectangleEtched, psRectangleRaised, - psDividerFlat, psDividerEtched, psDividerRaised); + TSpkPaneStyle = ( + psRectangleFlat, psRectangleEtched, psRectangleRaised, + psDividerFlat, psDividerEtched, psDividerRaised + ); TSpkElementStyle = (esRounded, esRectangle); @@ -30,210 +33,223 @@ type spkMetroLight, spkMetroDark ); + + { TSpkTabAppearance } + TSpkTabAppearance = class(TPersistent) - private - FDispatch: TSpkBaseAppearanceDispatch; - protected - FTabHeaderFont: TFont; - FBorderColor: TColor; - FGradientFromColor: TColor; - FGradientToColor: TColor; - FGradientType: TBackgroundKind; - FInactiveHeaderFontColor: TColor; + private + FDispatch: TSpkBaseAppearanceDispatch; + FTabHeaderFont: TFont; + FBorderColor: TColor; + FGradientFromColor: TColor; + FGradientToColor: TColor; + FGradientType: TBackgroundKind; + FInactiveHeaderFontColor: TColor; + // Getter & setter methods + procedure SetHeaderFont(const Value: TFont); + procedure SetBorderColor(const Value: TColor); + procedure SetGradientFromColor(const Value: TColor); + procedure SetGradientToColor(const Value: TColor); + procedure SetGradientType(const Value: TBackgroundKind); + procedure SetInactiveHeaderFontColor(const Value: TColor); - // Getter & setter methods - procedure SetHeaderFont(const Value: TFont); - procedure SetBorderColor(const Value: TColor); - procedure SetGradientFromColor(const Value: TColor); - procedure SetGradientToColor(const Value: TColor); - procedure SetGradientType(const Value: TBackgroundKind); - procedure SetInactiveHeaderFontColor(const Value: TColor); + public + // *** Konstruktor, destruktor, assign *** + // Appearance musi mieæ assign, bo wystêpuje jako w³asnoœæ + // opublikowana. + constructor Create(ADispatch: TSpkBaseAppearanceDispatch); + destructor Destroy; override; + procedure Assign(Source: TPersistent); override; - public - // *** Konstruktor, destruktor, assign *** - // Appearance musi mieæ assign, bo wystêpuje jako w³asnoœæ - // opublikowana. - procedure Assign(Source: TPersistent); override; - constructor Create(ADispatch: TSpkBaseAppearanceDispatch); - procedure SaveToPascal(AList: TStrings); - procedure SaveToXML(Node: TSpkXMLNode); - procedure LoadFromXML(Node: TSpkXMLNode); - destructor Destroy; override; - procedure Reset(AStyle: TSpkStyle = spkOffice2007Blue); - published - property TabHeaderFont: TFont read FTabHeaderFont write SetHeaderFont; - property BorderColor: TColor read FBorderColor write SetBorderColor; - property GradientFromColor: TColor read FGradientFromColor write SetGradientFromColor; - property GradientToColor: TColor read FGradientToColor write SetGradientToColor; - property GradientType: TBackgroundKind read FGradientType write SetGradientType; - property InactiveTabHeaderFontColor: TColor read FInactiveHeaderFontColor write SetInactiveHeaderFontColor; - end; + procedure LoadFromXML(Node: TSpkXMLNode); + procedure SaveToPascal(AList: TStrings); + procedure SaveToXML(Node: TSpkXMLNode); + procedure Reset(AStyle: TSpkStyle = spkOffice2007Blue); -type TSpkPaneAppearance = class(TPersistent) - private - FDispatch: TSpkBaseAppearanceDispatch; - protected - FCaptionFont: TFont; - FBorderDarkColor: TColor; - FBorderLightColor: TColor; - FCaptionBgColor: TColor; - FGradientFromColor: TColor; - FGradientToColor: TColor; - FGradientType: TBackgroundKind; - FHotTrackBrightnessChange: Integer; - FStyle: TSpkPaneStyle; - procedure SetCaptionBgColor(const Value: TColor); - procedure SetCaptionFont(const Value: TFont); - procedure SetBorderDarkColor(const Value: TColor); - procedure SetBorderLightColor(const Value: TColor); - procedure SetGradientFromColor(const Value: TColor); - procedure SetGradientToColor(const Value: TColor); - procedure SetGradientType(const Value: TBackgroundKind); - procedure SetHotTrackBrightnessChange(const Value: Integer); - procedure SetStyle(const Value: TSpkPaneStyle); - public - constructor Create(ADispatch: TSpkBaseAppearanceDispatch); - destructor Destroy; override; - procedure Assign(Source: TPersistent); override; - procedure SaveToPascal(AList: TStrings); - procedure SaveToXML(Node: TSpkXMLNode); - procedure LoadFromXML(Node: TSpkXMLNode); - procedure Reset(AStyle: TSpkStyle = spkOffice2007Blue); - published - property BorderDarkColor: TColor read FBorderDarkColor write SetBorderDarkColor; - property BorderLightColor: TColor read FBorderLightColor write SetBorderLightColor; - property CaptionBgColor: TColor read FCaptionBgColor write SetCaptionBgColor; - property CaptionFont: TFont read FCaptionFont write SetCaptionFont; - property GradientFromColor: TColor read FGradientFromColor write SetGradientFromColor; - property GradientToColor: TColor read FGradientToColor write SetGradientToColor; - property GradientType: TBackgroundKind read FGradientType write SetGradientType; - property HotTrackBrightnessChange: Integer read FHotTrackBrightnessChange write SetHotTrackBrightnessChange default 20; - property Style: TSpkPaneStyle read FStyle write SetStyle default psRectangleEtched; - end; + published + property TabHeaderFont: TFont read FTabHeaderFont write SetHeaderFont; + property BorderColor: TColor read FBorderColor write SetBorderColor; + property GradientFromColor: TColor read FGradientFromColor write SetGradientFromColor; + property GradientToColor: TColor read FGradientToColor write SetGradientToColor; + property GradientType: TBackgroundKind read FGradientType write SetGradientType; + property InactiveTabHeaderFontColor: TColor read FInactiveHeaderFontColor write SetInactiveHeaderFontColor; + end; - TSpkElementAppearance = class(TPersistent) - private - FDispatch: TSpkBaseAppearanceDispatch; - FCaptionFont: TFont; - FIdleFrameColor: TColor; - FIdleGradientFromColor: TColor; - FIdleGradientToColor: TColor; - FIdleGradientType: TBackgroundKind; - FIdleInnerLightColor: TColor; - FIdleInnerDarkColor: TColor; - FIdleCaptionColor: TColor; - FHotTrackFrameColor: TColor; - FHotTrackGradientFromColor: TColor; - FHotTrackGradientToColor: TColor; - FHotTrackGradientType: TBackgroundKind; - FHotTrackInnerLightColor: TColor; - FHotTrackInnerDarkColor: TColor; - FHotTrackCaptionColor: TColor; - FHotTrackBrightnessChange: Integer; - FActiveFrameColor: TColor; - FActiveGradientFromColor: TColor; - FActiveGradientToColor: TColor; - FActiveGradientType: TBackgroundKind; - FActiveInnerLightColor: TColor; - FActiveInnerDarkColor: TColor; - FActiveCaptionColor: TColor; - FStyle: TSpkElementStyle; - procedure SetActiveCaptionColor(const Value: TColor); - procedure SetActiveFrameColor(const Value: TColor); - procedure SetActiveGradientFromColor(const Value: TColor); - procedure SetActiveGradientToColor(const Value: TColor); - procedure SetActiveGradientType(const Value: TBackgroundKind); - procedure SetActiveInnerDarkColor(const Value: TColor); - procedure SetActiveInnerLightColor(const Value: TColor); - procedure SetCaptionFont(const Value: TFont); - procedure SetHotTrackCaptionColor(const Value: TColor); - procedure SetHotTrackFrameColor(const Value: TColor); - procedure SetHotTrackGradientFromColor(const Value: TColor); - procedure SetHotTrackGradientToColor(const Value: TColor); - procedure SetHotTrackGradientType(const Value: TBackgroundKind); - procedure SetHotTrackInnerDarkColor(const Value: TColor); - procedure SetHotTrackInnerLightColor(const Value: TColor); - procedure SetHotTrackBrightnessChange(const Value: Integer); - procedure SetIdleCaptionColor(const Value: TColor); - procedure SetIdleFrameColor(const Value: TColor); - procedure SetIdleGradientFromColor(const Value: TColor); - procedure SetIdleGradientToColor(const Value: TColor); - procedure SetIdleGradientType(const Value: TBackgroundKind); - procedure SetIdleInnerDarkColor(const Value: TColor); - procedure SetIdleInnerLightColor(const Value: TColor); - procedure SetStyle(const Value: TSpkElementStyle); - public - constructor Create(ADispatch: TSpkBaseAppearanceDispatch); - destructor Destroy; override; - procedure Assign(Source: TPersistent); override; - procedure SaveToPascal(AList: TStrings); - procedure SaveToXML(Node: TSpkXMLNode); - procedure LoadFromXML(Node: TSpkXMLNode); - procedure Reset(AStyle: TSpkStyle = spkOffice2007Blue); - published - property CaptionFont: TFont read FCaptionFont write SetCaptionFont; - property IdleFrameColor: TColor read FIdleFrameColor write SetIdleFrameColor; - property IdleGradientFromColor: TColor read FIdleGradientFromColor write SetIdleGradientFromColor; - property IdleGradientToColor: TColor read FIdleGradientToColor write SetIdleGradientToColor; - property IdleGradientType: TBackgroundKind read FIdleGradientType write SetIdleGradientType; - property IdleInnerLightColor: TColor read FIdleInnerLightColor write SetIdleInnerLightColor; - property IdleInnerDarkColor: TColor read FIdleInnerDarkColor write SetIdleInnerDarkColor; - property IdleCaptionColor: TColor read FIdleCaptionColor write SetIdleCaptionColor; - property HotTrackFrameColor: TColor read FHotTrackFrameColor write SetHotTrackFrameColor; - property HotTrackGradientFromColor: TColor read FHotTrackGradientFromColor write SetHotTrackGradientFromColor; - property HotTrackGradientToColor: TColor read FHotTrackGradientToColor write SetHotTrackGradientToColor; - property HotTrackGradientType: TBackgroundKind read FHotTrackGradientType write SetHotTrackGradientType; - property HotTrackInnerLightColor: TColor read FHotTrackInnerLightColor write SetHotTrackInnerLightColor; - property HotTrackInnerDarkColor: TColor read FHotTrackInnerDarkColor write SetHotTrackInnerDarkColor; - property HotTrackCaptionColor: TColor read FHotTrackCaptionColor write SetHotTrackCaptionColor; - property HotTrackBrightnessChange: Integer read FHotTrackBrightnessChange write SetHotTrackBrightnessChange default 20; - property ActiveFrameColor: TColor read FActiveFrameColor write SetActiveFrameColor; - property ActiveGradientFromColor: TColor read FActiveGradientFromColor write SetActiveGradientFromColor; - property ActiveGradientToColor: TColor read FActiveGradientToColor write SetActiveGradientToColor; - property ActiveGradientType: TBackgroundKind read FActiveGradientType write SetActiveGradientType; - property ActiveInnerLightColor: TColor read FActiveInnerLightColor write SetActiveInnerLightColor; - property ActiveInnerDarkColor: TColor read FActiveInnerDarkColor write SetActiveInnerDarkColor; - property ActiveCaptionColor: TColor read FActiveCaptionColor write SetActiveCaptionColor; - property Style: TSpkElementStyle read FStyle write SetStyle; - end; -type TSpkToolbarAppearance = class; + { TSpkPaneAppearance } - TSpkToolbarAppearanceDispatch = class(TSpkBaseAppearanceDispatch) - private - FToolbarAppearance: TSpkToolbarAppearance; - protected - public - constructor Create(AToolbarAppearance: TSpkToolbarAppearance); - procedure NotifyAppearanceChanged; override; - end; + TSpkPaneAppearance = class(TPersistent) + private + FDispatch: TSpkBaseAppearanceDispatch; + FCaptionFont: TFont; + FBorderDarkColor: TColor; + FBorderLightColor: TColor; + FCaptionBgColor: TColor; + FGradientFromColor: TColor; + FGradientToColor: TColor; + FGradientType: TBackgroundKind; + FHotTrackBrightnessChange: Integer; + FStyle: TSpkPaneStyle; + procedure SetCaptionBgColor(const Value: TColor); + procedure SetCaptionFont(const Value: TFont); + procedure SetBorderDarkColor(const Value: TColor); + procedure SetBorderLightColor(const Value: TColor); + procedure SetGradientFromColor(const Value: TColor); + procedure SetGradientToColor(const Value: TColor); + procedure SetGradientType(const Value: TBackgroundKind); + procedure SetHotTrackBrightnessChange(const Value: Integer); + procedure SetStyle(const Value: TSpkPaneStyle); - TSpkToolbarAppearance = class(TPersistent) - private - FAppearanceDispatch: TSpkToolbarAppearanceDispatch; - FTab: TSpkTabAppearance; - FPane: TSpkPaneAppearance; - FElement: TSpkElementAppearance; - FDispatch: TSpkBaseAppearanceDispatch; - procedure SetElementAppearance(const Value: TSpkElementAppearance); - procedure SetPaneAppearance(const Value: TSpkPaneAppearance); - procedure SetTabAppearance(const Value: TSpkTabAppearance); - protected - // - public - constructor Create(ADispatch: TSpkBaseAppearanceDispatch); reintroduce; - destructor Destroy; override; - procedure Assign(Source: TPersistent); override; - procedure NotifyAppearanceChanged; - procedure Reset(AStyle: TSpkStyle = spkOffice2007Blue); - procedure SaveToPascal(AList: TStrings); - procedure SaveToXML(Node: TSpkXMLNode); - procedure LoadFromXML(Node: TSpkXMLNode); - published - property Tab: TSpkTabAppearance read FTab write SetTabAppearance; - property Pane: TSpkPaneAppearance read FPane write SetPaneAppearance; - property Element: TSpkElementAppearance read FElement write SetElementAppearance; - end; + public + constructor Create(ADispatch: TSpkBaseAppearanceDispatch); + destructor Destroy; override; + procedure Assign(Source: TPersistent); override; + + procedure LoadFromXML(Node: TSpkXMLNode); + procedure SaveToPascal(AList: TStrings); + procedure SaveToXML(Node: TSpkXMLNode); + procedure Reset(AStyle: TSpkStyle = spkOffice2007Blue); + + published + property BorderDarkColor: TColor read FBorderDarkColor write SetBorderDarkColor; + property BorderLightColor: TColor read FBorderLightColor write SetBorderLightColor; + property CaptionBgColor: TColor read FCaptionBgColor write SetCaptionBgColor; + property CaptionFont: TFont read FCaptionFont write SetCaptionFont; + property GradientFromColor: TColor read FGradientFromColor write SetGradientFromColor; + property GradientToColor: TColor read FGradientToColor write SetGradientToColor; + property GradientType: TBackgroundKind read FGradientType write SetGradientType; + property HotTrackBrightnessChange: Integer read FHotTrackBrightnessChange write SetHotTrackBrightnessChange default 20; + property Style: TSpkPaneStyle read FStyle write SetStyle default psRectangleEtched; + end; + + + { TSpkElementAppearance } + TSpkElementAppearance = class(TPersistent) + private + FDispatch: TSpkBaseAppearanceDispatch; + FCaptionFont: TFont; + FIdleFrameColor: TColor; + FIdleGradientFromColor: TColor; + FIdleGradientToColor: TColor; + FIdleGradientType: TBackgroundKind; + FIdleInnerLightColor: TColor; + FIdleInnerDarkColor: TColor; + FIdleCaptionColor: TColor; + FHotTrackFrameColor: TColor; + FHotTrackGradientFromColor: TColor; + FHotTrackGradientToColor: TColor; + FHotTrackGradientType: TBackgroundKind; + FHotTrackInnerLightColor: TColor; + FHotTrackInnerDarkColor: TColor; + FHotTrackCaptionColor: TColor; + FHotTrackBrightnessChange: Integer; + FActiveFrameColor: TColor; + FActiveGradientFromColor: TColor; + FActiveGradientToColor: TColor; + FActiveGradientType: TBackgroundKind; + FActiveInnerLightColor: TColor; + FActiveInnerDarkColor: TColor; + FActiveCaptionColor: TColor; + FStyle: TSpkElementStyle; + procedure SetActiveCaptionColor(const Value: TColor); + procedure SetActiveFrameColor(const Value: TColor); + procedure SetActiveGradientFromColor(const Value: TColor); + procedure SetActiveGradientToColor(const Value: TColor); + procedure SetActiveGradientType(const Value: TBackgroundKind); + procedure SetActiveInnerDarkColor(const Value: TColor); + procedure SetActiveInnerLightColor(const Value: TColor); + procedure SetCaptionFont(const Value: TFont); + procedure SetHotTrackCaptionColor(const Value: TColor); + procedure SetHotTrackFrameColor(const Value: TColor); + procedure SetHotTrackGradientFromColor(const Value: TColor); + procedure SetHotTrackGradientToColor(const Value: TColor); + procedure SetHotTrackGradientType(const Value: TBackgroundKind); + procedure SetHotTrackInnerDarkColor(const Value: TColor); + procedure SetHotTrackInnerLightColor(const Value: TColor); + procedure SetHotTrackBrightnessChange(const Value: Integer); + procedure SetIdleCaptionColor(const Value: TColor); + procedure SetIdleFrameColor(const Value: TColor); + procedure SetIdleGradientFromColor(const Value: TColor); + procedure SetIdleGradientToColor(const Value: TColor); + procedure SetIdleGradientType(const Value: TBackgroundKind); + procedure SetIdleInnerDarkColor(const Value: TColor); + procedure SetIdleInnerLightColor(const Value: TColor); + procedure SetStyle(const Value: TSpkElementStyle); + + public + constructor Create(ADispatch: TSpkBaseAppearanceDispatch); + destructor Destroy; override; + procedure Assign(Source: TPersistent); override; + + procedure LoadFromXML(Node: TSpkXMLNode); + procedure SaveToPascal(AList: TStrings); + procedure SaveToXML(Node: TSpkXMLNode); + procedure Reset(AStyle: TSpkStyle = spkOffice2007Blue); + + published + property CaptionFont: TFont read FCaptionFont write SetCaptionFont; + property IdleFrameColor: TColor read FIdleFrameColor write SetIdleFrameColor; + property IdleGradientFromColor: TColor read FIdleGradientFromColor write SetIdleGradientFromColor; + property IdleGradientToColor: TColor read FIdleGradientToColor write SetIdleGradientToColor; + property IdleGradientType: TBackgroundKind read FIdleGradientType write SetIdleGradientType; + property IdleInnerLightColor: TColor read FIdleInnerLightColor write SetIdleInnerLightColor; + property IdleInnerDarkColor: TColor read FIdleInnerDarkColor write SetIdleInnerDarkColor; + property IdleCaptionColor: TColor read FIdleCaptionColor write SetIdleCaptionColor; + property HotTrackFrameColor: TColor read FHotTrackFrameColor write SetHotTrackFrameColor; + property HotTrackGradientFromColor: TColor read FHotTrackGradientFromColor write SetHotTrackGradientFromColor; + property HotTrackGradientToColor: TColor read FHotTrackGradientToColor write SetHotTrackGradientToColor; + property HotTrackGradientType: TBackgroundKind read FHotTrackGradientType write SetHotTrackGradientType; + property HotTrackInnerLightColor: TColor read FHotTrackInnerLightColor write SetHotTrackInnerLightColor; + property HotTrackInnerDarkColor: TColor read FHotTrackInnerDarkColor write SetHotTrackInnerDarkColor; + property HotTrackCaptionColor: TColor read FHotTrackCaptionColor write SetHotTrackCaptionColor; + property HotTrackBrightnessChange: Integer read FHotTrackBrightnessChange write SetHotTrackBrightnessChange default 20; + property ActiveFrameColor: TColor read FActiveFrameColor write SetActiveFrameColor; + property ActiveGradientFromColor: TColor read FActiveGradientFromColor write SetActiveGradientFromColor; + property ActiveGradientToColor: TColor read FActiveGradientToColor write SetActiveGradientToColor; + property ActiveGradientType: TBackgroundKind read FActiveGradientType write SetActiveGradientType; + property ActiveInnerLightColor: TColor read FActiveInnerLightColor write SetActiveInnerLightColor; + property ActiveInnerDarkColor: TColor read FActiveInnerDarkColor write SetActiveInnerDarkColor; + property ActiveCaptionColor: TColor read FActiveCaptionColor write SetActiveCaptionColor; + property Style: TSpkElementStyle read FStyle write SetStyle; + end; + + + { TSpkToolbarAppearance } + + TSpkToolbarAppearance = class; + + TSpkToolbarAppearanceDispatch = class(TSpkBaseAppearanceDispatch) + private + FToolbarAppearance: TSpkToolbarAppearance; + public + constructor Create(AToolbarAppearance: TSpkToolbarAppearance); + procedure NotifyAppearanceChanged; override; + end; + + TSpkToolbarAppearance = class(TPersistent) + private + FAppearanceDispatch: TSpkToolbarAppearanceDispatch; + FTab: TSpkTabAppearance; + FPane: TSpkPaneAppearance; + FElement: TSpkElementAppearance; + FDispatch: TSpkBaseAppearanceDispatch; + procedure SetElementAppearance(const Value: TSpkElementAppearance); + procedure SetPaneAppearance(const Value: TSpkPaneAppearance); + procedure SetTabAppearance(const Value: TSpkTabAppearance); + public + constructor Create(ADispatch: TSpkBaseAppearanceDispatch); reintroduce; + destructor Destroy; override; + procedure Assign(Source: TPersistent); override; + procedure NotifyAppearanceChanged; + procedure Reset(AStyle: TSpkStyle = spkOffice2007Blue); + procedure SaveToPascal(AList: TStrings); + procedure SaveToXML(Node: TSpkXMLNode); + procedure LoadFromXML(Node: TSpkXMLNode); + published + property Tab: TSpkTabAppearance read FTab write SetTabAppearance; + property Pane: TSpkPaneAppearance read FPane write SetPaneAppearance; + property Element: TSpkElementAppearance read FElement write SetElementAppearance; + end; procedure SetDefaultFont(AFont: TFont); @@ -263,34 +279,11 @@ end; { TSpkBaseToolbarAppearance } -procedure TSpkTabAppearance.Assign(Source: TPersistent); -var - SrcAppearance: TSpkTabAppearance; -begin - if Source is TSpkTabAppearance then - begin - SrcAppearance:=TSpkTabAppearance(Source); - FTabHeaderFont.Assign(SrcAppearance.TabHeaderFont); - FBorderColor:=SrcAppearance.BorderColor; - FGradientFromColor:=SrcAppearance.GradientFromColor; - FGradientToColor:=SrcAppearance.GradientToColor; - FGradientType:=SrcAppearance.GradientType; - FInactiveHeaderFontColor := SrcAppearance.InactiveTabHeaderFontColor; - - if FDispatch<>nil then - FDispatch.NotifyAppearanceChanged; - end else - raise AssignException.create('TSpkToolbarAppearance.Assign: Nie mogê przypisaæ obiektu '+Source.ClassName+' do TSpkToolbarAppearance!'); -end; - -constructor TSpkTabAppearance.Create( - ADispatch: TSpkBaseAppearanceDispatch); +constructor TSpkTabAppearance.Create(ADispatch: TSpkBaseAppearanceDispatch); begin inherited Create; - FDispatch:=ADispatch; - - FTabHeaderFont:=TFont.Create; - + FDispatch := ADispatch; + FTabHeaderFont := TFont.Create; Reset; end; @@ -300,32 +293,52 @@ begin inherited; end; +procedure TSpkTabAppearance.Assign(Source: TPersistent); +var + SrcAppearance: TSpkTabAppearance; +begin + if Source is TSpkTabAppearance then + begin + SrcAppearance := TSpkTabAppearance(Source); + FTabHeaderFont.Assign(SrcAppearance.TabHeaderFont); + FBorderColor := SrcAppearance.BorderColor; + FGradientFromColor := SrcAppearance.GradientFromColor; + FGradientToColor := SrcAppearance.GradientToColor; + FGradientType := SrcAppearance.GradientType; + FInactiveHeaderFontColor := SrcAppearance.InactiveTabHeaderFontColor; + + if FDispatch <> nil then + FDispatch.NotifyAppearanceChanged; + end else + raise AssignException.Create('TSpkToolbarAppearance.Assign: Nie mogê przypisaæ obiektu '+Source.ClassName+' do TSpkToolbarAppearance!'); +end; + procedure TSpkTabAppearance.LoadFromXML(Node: TSpkXMLNode); var - Subnode : TSpkXMLNode; + Subnode: TSpkXMLNode; begin - if not(assigned(Node)) then + if not Assigned(Node) then exit; - Subnode:=Node['TabHeaderFont',false]; + Subnode := Node['TabHeaderFont',false]; if Assigned(Subnode) then TSpkXMLTools.Load(Subnode, FTabHeaderFont); - Subnode:=Node['BorderColor',false]; - if assigned(Subnode) then - FBorderColor:=Subnode.TextAsColor; + Subnode := Node['BorderColor',false]; + if Assigned(Subnode) then + FBorderColor := Subnode.TextAsColor; - Subnode:=Node['GradientFromColor',false]; - if assigned(Subnode) then - FGradientFromColor:=Subnode.TextAsColor; + Subnode := Node['GradientFromColor',false]; + if Assigned(Subnode) then + FGradientFromColor := Subnode.TextAsColor; - Subnode:=Node['GradientToColor',false]; - if assigned(Subnode) then - FGradientToColor:=Subnode.TextAsColor; + Subnode := Node['GradientToColor',false]; + if Assigned(Subnode) then + FGradientToColor := Subnode.TextAsColor; - Subnode:=Node['GradientType',false]; - if assigned(Subnode) then - FGradientType:=TBackgroundKind(Subnode.TextAsInteger); + Subnode := Node['GradientType',false]; + if Assigned(Subnode) then + FGradientType := TBackgroundKind(Subnode.TextAsInteger); Subnode := Node['InactiveTabHeaderFontColor', false]; if Assigned(Subnode) then @@ -404,20 +417,20 @@ begin if not(assigned(Node)) then exit; - Subnode:=Node['TabHeaderFont',true]; + Subnode := Node['TabHeaderFont',true]; TSpkXMLTools.Save(Subnode, FTabHeaderFont); - Subnode:=Node['BorderColor',true]; - Subnode.TextAsColor:=FBorderColor; + Subnode := Node['BorderColor',true]; + Subnode.TextAsColor := FBorderColor; - Subnode:=Node['GradientFromColor',true]; - Subnode.TextAsColor:=FGradientFromColor; + Subnode := Node['GradientFromColor',true]; + Subnode.TextAsColor := FGradientFromColor; - Subnode:=Node['GradientToColor',true]; - Subnode.TextAsColor:=FGradientToColor; + Subnode := Node['GradientToColor',true]; + Subnode.TextAsColor := FGradientToColor; - Subnode:=Node['GradientType',true]; - Subnode.TextAsInteger:=integer(FGradientType); + Subnode := Node['GradientType',true]; + Subnode.TextAsInteger := integer(FGradientType); Subnode := Node['InactiveTabHeaderFontColor', true]; Subnode.TextAsColor := FInactiveHeaderFontColor; @@ -426,36 +439,36 @@ end; procedure TSpkTabAppearance.SetBorderColor(const Value: TColor); begin FBorderColor := Value; - if FDispatch<>nil then - FDispatch.NotifyAppearanceChanged; + if FDispatch <> nil then + FDispatch.NotifyAppearanceChanged; end; procedure TSpkTabAppearance.SetGradientFromColor(const Value: TColor); begin FGradientFromColor := Value; - if FDispatch<>nil then - FDispatch.NotifyAppearanceChanged; + if FDispatch <> nil then + FDispatch.NotifyAppearanceChanged; end; procedure TSpkTabAppearance.SetGradientToColor(const Value: TColor); begin FGradientToColor := Value; - if FDispatch<>nil then - FDispatch.NotifyAppearanceChanged; + if FDispatch <> nil then + FDispatch.NotifyAppearanceChanged; end; procedure TSpkTabAppearance.SetGradientType(const Value: TBackgroundKind); begin FGradientType := Value; - if FDispatch<>nil then - FDispatch.NotifyAppearanceChanged; + if FDispatch <> nil then + FDispatch.NotifyAppearanceChanged; end; procedure TSpkTabAppearance.SetHeaderFont(const Value: TFont); begin - FTabHeaderFont.assign(Value); - if FDispatch<>nil then - FDispatch.NotifyAppearanceChanged; + FTabHeaderFont.Assign(Value); + if FDispatch <> nil then + FDispatch.NotifyAppearanceChanged; end; procedure TSpkTabAppearance.SetInactiveHeaderFontColor(const Value: TColor); @@ -466,9 +479,24 @@ begin end; - { TSpkPaneAppearance } +constructor TSpkPaneAppearance.Create(ADispatch: TSpkBaseAppearanceDispatch); +begin + inherited Create; + FDispatch := ADispatch; + FCaptionFont := TFont.Create; + FHotTrackBrightnessChange := 20; + FStyle := psRectangleEtched; + Reset; +end; + +destructor TSpkPaneAppearance.Destroy; +begin + FCaptionFont.Free; + inherited Destroy; +end; + procedure TSpkPaneAppearance.Assign(Source: TPersistent); var SrcAppearance: TSpkPaneAppearance; @@ -493,22 +521,6 @@ begin raise AssignException.create('TSpkPaneAppearance.Assign: Nie mogê przypisaæ obiektu '+Source.ClassName+' do TSpkPaneAppearance!'); end; -constructor TSpkPaneAppearance.Create(ADispatch: TSpkBaseAppearanceDispatch); -begin - inherited Create; - FDispatch := ADispatch; - FCaptionFont := TFont.Create; - FHotTrackBrightnessChange := 20; - FStyle := psRectangleEtched; - Reset; -end; - -destructor TSpkPaneAppearance.Destroy; -begin - FCaptionFont.Free; - inherited Destroy; -end; - procedure TSpkPaneAppearance.LoadFromXML(Node: TSpkXMLNode); var Subnode: TSpkXMLNode; @@ -680,49 +692,49 @@ procedure TSpkPaneAppearance.SetBorderLightColor(const Value: TColor); begin FBorderLightColor := Value; if FDispatch <> nil then - FDispatch.NotifyAppearanceChanged; + FDispatch.NotifyAppearanceChanged; end; procedure TSpkPaneAppearance.SetCaptionBgColor(const Value: TColor); begin FCaptionBgColor := Value; if FDispatch <> nil then - FDispatch.NotifyAppearanceChanged; + FDispatch.NotifyAppearanceChanged; end; procedure TSpkPaneAppearance.SetCaptionFont(const Value: TFont); begin FCaptionFont.Assign(Value); if FDispatch <> nil then - FDispatch.NotifyAppearanceChanged; + FDispatch.NotifyAppearanceChanged; end; procedure TSpkPaneAppearance.SetGradientFromColor(const Value: TColor); begin FGradientFromColor := Value; if FDispatch <> nil then - FDispatch.NotifyAppearanceChanged; + FDispatch.NotifyAppearanceChanged; end; procedure TSpkPaneAppearance.SetGradientToColor(const Value: TColor); begin FGradientToColor := Value; if FDispatch <> nil then - FDispatch.NotifyAppearanceChanged; + FDispatch.NotifyAppearanceChanged; end; procedure TSpkPaneAppearance.SetGradientType(const Value: TBackgroundKind); begin FGradientType := Value; if FDispatch <> nil then - FDispatch.NotifyAppearanceChanged; + FDispatch.NotifyAppearanceChanged; end; procedure TSpkPaneAppearance.SetHotTrackBrightnessChange(const Value: Integer); begin FHotTrackBrightnessChange := Value; if FDispatch <> nil then - FDispatch.NotifyAppearanceChanged; + FDispatch.NotifyAppearanceChanged; end; procedure TSpkPaneAppearance.SetStyle(const Value: TSpkPaneStyle); @@ -735,6 +747,21 @@ end; { TSpkElementAppearance } +constructor TSpkElementAppearance.Create(ADispatch: TSpkBaseAppearanceDispatch); +begin + inherited Create; + FDispatch := ADispatch; + FCaptionFont := TFont.Create; + FHotTrackBrightnessChange := 40; + Reset; +end; + +destructor TSpkElementAppearance.Destroy; +begin + FCaptionFont.Free; + inherited Destroy; +end; + procedure TSpkElementAppearance.Assign(Source: TPersistent); var SrcAppearance: TSpkElementAppearance; @@ -774,21 +801,6 @@ begin raise AssignException.create('TSpkElementAppearance.Assign: Nie mogê przypisaæ obiektu '+Source.ClassName+' do TSpkElementAppearance!'); end; -constructor TSpkElementAppearance.Create(ADispatch: TSpkBaseAppearanceDispatch); -begin - inherited Create; - FDispatch := ADispatch; - FCaptionFont := TFont.Create; - FHotTrackBrightnessChange := 40; - Reset; -end; - -destructor TSpkElementAppearance.Destroy; -begin - FCaptionFont.Free; - inherited Destroy; -end; - procedure TSpkElementAppearance.LoadFromXML(Node: TSpkXMLNode); var Subnode: TSpkXMLNode; @@ -1159,126 +1171,126 @@ procedure TSpkElementAppearance.SetActiveCaptionColor(const Value: TColor); begin FActiveCaptionColor := Value; if FDispatch <> nil then - FDispatch.NotifyAppearanceChanged; + FDispatch.NotifyAppearanceChanged; end; procedure TSpkElementAppearance.SetActiveFrameColor(const Value: TColor); begin FActiveFrameColor := Value; if FDispatch <> nil then - FDispatch.NotifyAppearanceChanged; + FDispatch.NotifyAppearanceChanged; end; procedure TSpkElementAppearance.SetActiveGradientFromColor(const Value: TColor); begin FActiveGradientFromColor := Value; if FDispatch <> nil then - FDispatch.NotifyAppearanceChanged; + FDispatch.NotifyAppearanceChanged; end; procedure TSpkElementAppearance.SetActiveGradientToColor(const Value: TColor); begin FActiveGradientToColor := Value; if FDispatch <> nil then - FDispatch.NotifyAppearanceChanged; + FDispatch.NotifyAppearanceChanged; end; procedure TSpkElementAppearance.SetActiveGradientType(const Value: TBackgroundKind); begin FActiveGradientType := Value; if FDispatch <> nil then - FDispatch.NotifyAppearanceChanged; + FDispatch.NotifyAppearanceChanged; end; procedure TSpkElementAppearance.SetActiveInnerDarkColor(const Value: TColor); begin FActiveInnerDarkColor := Value; if FDispatch <> nil then - FDispatch.NotifyAppearanceChanged; + FDispatch.NotifyAppearanceChanged; end; procedure TSpkElementAppearance.SetActiveInnerLightColor(const Value: TColor); begin FActiveInnerLightColor := Value; if FDispatch <> nil then - FDispatch.NotifyAppearanceChanged; + FDispatch.NotifyAppearanceChanged; end; procedure TSpkElementAppearance.SetCaptionFont(const Value: TFont); begin FCaptionFont.Assign(Value); if FDispatch <> nil then - FDispatch.NotifyAppearanceChanged; + FDispatch.NotifyAppearanceChanged; end; procedure TSpkElementAppearance.SetHotTrackBrightnessChange(const Value: Integer); begin FHotTrackBrightnessChange := Value; if FDispatch <> nil then - FDispatch.NotifyAppearanceChanged; + FDispatch.NotifyAppearanceChanged; end; procedure TSpkElementAppearance.SetHotTrackCaptionColor(const Value: TColor); begin FHotTrackCaptionColor := Value; if FDispatch <> nil then - FDispatch.NotifyAppearanceChanged; + FDispatch.NotifyAppearanceChanged; end; procedure TSpkElementAppearance.SetHotTrackFrameColor(const Value: TColor); begin FHotTrackFrameColor := Value; if FDispatch <> nil then - FDispatch.NotifyAppearanceChanged; + FDispatch.NotifyAppearanceChanged; end; procedure TSpkElementAppearance.SetHotTrackGradientFromColor(const Value: TColor); begin FHotTrackGradientFromColor := Value; if FDispatch <> nil then - FDispatch.NotifyAppearanceChanged; + FDispatch.NotifyAppearanceChanged; end; procedure TSpkElementAppearance.SetHotTrackGradientToColor(const Value: TColor); begin FHotTrackGradientToColor := Value; if FDispatch <> nil then - FDispatch.NotifyAppearanceChanged; + FDispatch.NotifyAppearanceChanged; end; procedure TSpkElementAppearance.SetHotTrackGradientType(const Value: TBackgroundKind); begin FHotTrackGradientType := Value; if FDispatch <> nil then - FDispatch.NotifyAppearanceChanged; + FDispatch.NotifyAppearanceChanged; end; procedure TSpkElementAppearance.SetHotTrackInnerDarkColor(const Value: TColor); begin FHotTrackInnerDarkColor := Value; if FDispatch <> nil then - FDispatch.NotifyAppearanceChanged; + FDispatch.NotifyAppearanceChanged; end; procedure TSpkElementAppearance.SetHotTrackInnerLightColor(const Value: TColor); begin FHotTrackInnerLightColor := Value; if FDispatch <> nil then - FDispatch.NotifyAppearanceChanged; + FDispatch.NotifyAppearanceChanged; end; procedure TSpkElementAppearance.SetIdleCaptionColor(const Value: TColor); begin FIdleCaptionColor := Value; if FDispatch <> nil then - FDispatch.NotifyAppearanceChanged; + FDispatch.NotifyAppearanceChanged; end; procedure TSpkElementAppearance.SetIdleFrameColor(const Value: TColor); begin FIdleFrameColor := Value; if FDispatch <> nil then - FDispatch.NotifyAppearanceChanged; + FDispatch.NotifyAppearanceChanged; end; procedure TSpkElementAppearance.SetIdleGradientFromColor(const Value: TColor); @@ -1292,28 +1304,28 @@ procedure TSpkElementAppearance.SetIdleGradientToColor(const Value: TColor); begin FIdleGradientToColor := Value; if FDispatch <> nil then - FDispatch.NotifyAppearanceChanged; + FDispatch.NotifyAppearanceChanged; end; procedure TSpkElementAppearance.SetIdleGradientType(const Value: TBackgroundKind); begin FIdleGradientType := Value; if FDispatch <> nil then - FDispatch.NotifyAppearanceChanged; + FDispatch.NotifyAppearanceChanged; end; procedure TSpkElementAppearance.SetIdleInnerDarkColor(const Value: TColor); begin FIdleInnerDarkColor := Value; if FDispatch <> nil then - FDispatch.NotifyAppearanceChanged; + FDispatch.NotifyAppearanceChanged; end; procedure TSpkElementAppearance.SetIdleInnerLightColor(const Value: TColor); begin FIdleInnerLightColor := Value; if FDispatch <> nil then - FDispatch.NotifyAppearanceChanged; + FDispatch.NotifyAppearanceChanged; end; procedure TSpkElementAppearance.SetStyle(const Value: TSpkElementStyle); @@ -1323,6 +1335,7 @@ begin FDispatch.NotifyAppearanceChanged; end; + { TSpkToolbarAppearanceDispatch } constructor TSpkToolbarAppearanceDispatch.Create( @@ -1334,12 +1347,32 @@ end; procedure TSpkToolbarAppearanceDispatch.NotifyAppearanceChanged; begin -if FToolbarAppearance<>nil then +if FToolbarAppearance <> nil then FToolbarAppearance.NotifyAppearanceChanged; end; + { TSpkToolbarAppearance } +constructor TSpkToolbarAppearance.Create(ADispatch : TSpkBaseAppearanceDispatch); +begin + inherited Create; + FDispatch := ADispatch; + FAppearanceDispatch := TSpkToolbarAppearanceDispatch.Create(self); + FTab := TSpkTabAppearance.Create(FAppearanceDispatch); + FPane := TSpkPaneAppearance.create(FAppearanceDispatch); + FElement := TSpkElementAppearance.create(FAppearanceDispatch); +end; + +destructor TSpkToolbarAppearance.Destroy; +begin + FElement.Free; + FPane.Free; + FTab.Free; + FAppearanceDispatch.Free; + inherited; +end; + procedure TSpkToolbarAppearance.Assign(Source: TPersistent); var Src: TSpkToolbarAppearance; @@ -1354,57 +1387,37 @@ begin if FDispatch <> nil then FDispatch.NotifyAppearanceChanged; - end else - raise AssignException.create('TSpkToolbarAppearance.Assign: Nie mogê przypisaæ obiektu '+Source.ClassName+' do TSpkToolbarAppearance!'); -end; - -constructor TSpkToolbarAppearance.Create(ADispatch : TSpkBaseAppearanceDispatch); -begin - inherited Create; - 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 else + raise AssignException.create('TSpkToolbarAppearance.Assign: Nie mogê przypisaæ obiektu '+Source.ClassName+' do TSpkToolbarAppearance!'); end; procedure TSpkToolbarAppearance.LoadFromXML(Node: TSpkXMLNode); - -var Subnode : TSpkXMLNode; - +var + Subnode: TSpkXMLNode; begin -Tab.Reset; -Pane.Reset; -Element.Reset; + Tab.Reset; + Pane.Reset; + Element.Reset; -if not(assigned(Node)) then - exit; + if not Assigned(Node) then + exit; -Subnode:=Node['Tab',false]; -if assigned(Subnode) then - Tab.LoadFromXML(Subnode); + Subnode := Node['Tab', false]; + if Assigned(Subnode) then + Tab.LoadFromXML(Subnode); -Subnode:=Node['Pane',false]; -if assigned(Subnode) then - Pane.LoadFromXML(Subnode); + Subnode := Node['Pane', false]; + if Assigned(Subnode) then + Pane.LoadFromXML(Subnode); -Subnode:=Node['Element',false]; -if assigned(Subnode) then - Element.LoadFromXML(Subnode); + Subnode := Node['Element', false]; + if Assigned(Subnode) then + Element.LoadFromXML(Subnode); end; procedure TSpkToolbarAppearance.NotifyAppearanceChanged; begin - if assigned(FDispatch) then + if Assigned(FDispatch) then FDispatch.NotifyAppearanceChanged; end; @@ -1423,20 +1436,20 @@ begin FTab.SaveToPascal(AList); FPane.SaveToPascal(AList); FElement.SaveToPascal(AList); - AList.ADd('end;'); + AList.Add('end;'); end; procedure TSpkToolbarAppearance.SaveToXML(Node: TSpkXMLNode); var Subnode: TSpkXMLNode; begin - Subnode:=Node['Tab',true]; + Subnode := Node['Tab',true]; FTab.SaveToXML(Subnode); - Subnode:=Node['Pane',true]; + Subnode := Node['Pane',true]; FPane.SaveToXML(Subnode); - Subnode:=Node['Element',true]; + Subnode := Node['Element',true]; FElement.SaveToXML(Subnode); end; diff --git a/components/spktoolbar/SpkToolbar/spkt_BaseItem.pas b/components/spktoolbar/SpkToolbar/spkt_BaseItem.pas index e6da1d1ec..f9772b878 100644 --- a/components/spktoolbar/SpkToolbar/spkt_BaseItem.pas +++ b/components/spktoolbar/SpkToolbar/spkt_BaseItem.pas @@ -15,88 +15,95 @@ unit spkt_BaseItem; interface -uses Graphics, Classes, Controls, - SpkMath, spkt_Appearance, spkt_Dispatch, spkt_Types; +uses + Graphics, Classes, Controls, + SpkMath, spkt_Appearance, spkt_Dispatch, spkt_Types; -type TSpkItemSize = (isLarge, isNormal); - TSpkItemTableBehaviour = (tbBeginsRow, tbBeginsColumn, tbContinuesRow); - TSpkItemGroupBehaviour = (gbSingleItem, gbBeginsGroup, gbContinuesGroup, gbEndsGroup); +type + TSpkItemSize = (isLarge, isNormal); - TSpkBaseItem = class abstract(TSpkComponent) - private - protected - FRect : T2DIntRect; - FToolbarDispatch : TSpkBaseToolbarDispatch; - FAppearance : TSpkToolbarAppearance; - FImages : TImageList; - FDisabledImages : TImageList; - FLargeImages : TImageList; - FDisabledLargeImages : TImageList; - FVisible : boolean; - FEnabled : boolean; + TSpkItemTableBehaviour = (tbBeginsRow, tbBeginsColumn, tbContinuesRow); - procedure SetVisible(const Value: boolean); virtual; - procedure SetEnabled(const Value: boolean); virtual; - procedure SetRect(const Value: T2DIntRect); virtual; - procedure SetImages(const Value: TImageList); virtual; - procedure SetDisabledImages(const Value : TImageList); virtual; - procedure SetLargeImages(const Value: TImageList); virtual; - procedure SetDisabledLargeImages(const Value: TImageList); virtual; - procedure SetAppearance(const Value: TSpkToolbarAppearance); - public - constructor Create(AOwner : TComponent); override; - destructor Destroy; override; + TSpkItemGroupBehaviour = (gbSingleItem, gbBeginsGroup, gbContinuesGroup, gbEndsGroup); - procedure MouseLeave; virtual; abstract; - procedure MouseDown(Button: TMouseButton; Shift: TShiftState; - X, Y: Integer); virtual; abstract; - procedure MouseMove(Shift: TShiftState; X, Y: Integer); virtual; abstract; - procedure MouseUp(Button: TMouseButton; Shift: TShiftState; - X, Y: Integer); virtual; abstract; + TSpkBaseItem = class abstract(TSpkComponent) + private + protected + FRect: T2DIntRect; + FToolbarDispatch: TSpkBaseToolbarDispatch; + FAppearance: TSpkToolbarAppearance; + FImages: TImageList; + FDisabledImages: TImageList; + FLargeImages: TImageList; + FDisabledLargeImages: TImageList; + FVisible: boolean; + FEnabled: boolean; - function GetWidth : integer; virtual; abstract; - function GetTableBehaviour : TSpkItemTableBehaviour; virtual; abstract; - function GetGroupBehaviour : TSpkItemGroupBehaviour; virtual; abstract; - function GetSize : TSpkItemSize; virtual; abstract; - procedure Draw(ABuffer : TBitmap; ClipRect : T2DIntRect); virtual; abstract; + procedure SetVisible(const Value: boolean); virtual; + procedure SetEnabled(const Value: boolean); virtual; + procedure SetRect(const Value: T2DIntRect); virtual; + procedure SetImages(const Value: TImageList); virtual; + procedure SetDisabledImages(const Value: TImageList); virtual; + procedure SetLargeImages(const Value: TImageList); virtual; + procedure SetDisabledLargeImages(const Value: TImageList); virtual; + procedure SetAppearance(const Value: TSpkToolbarAppearance); - property ToolbarDispatch : TSpkBaseToolbarDispatch read FToolbarDispatch write FToolbarDispatch; - property Appearance : TSpkToolbarAppearance read FAppearance write SetAppearance; - property Images : TImageList read FImages write SetImages; - property DisabledImages : TImageList read FDisabledImages write SetDisabledImages; - property LargeImages : TImageList read FLargeImages write SetLargeImages; - property DisabledLargeImages : TImageList read FDisabledLargeImages write SetDisabledLargeImages; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; - property Rect : T2DIntRect read FRect write SetRect; - published - property Visible : boolean read FVisible write SetVisible; - property Enabled : boolean read FEnabled write SetEnabled; - end; + procedure MouseLeave; virtual; abstract; + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); virtual; abstract; + procedure MouseMove(Shift: TShiftState; X, Y: Integer); virtual; abstract; + procedure MouseUp(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); virtual; abstract; + + function GetWidth: integer; virtual; abstract; + function GetTableBehaviour: TSpkItemTableBehaviour; virtual; abstract; + function GetGroupBehaviour: TSpkItemGroupBehaviour; virtual; abstract; + function GetSize: TSpkItemSize; virtual; abstract; + + procedure Draw(ABuffer: TBitmap; ClipRect: T2DIntRect); virtual; abstract; + + property ToolbarDispatch: TSpkBaseToolbarDispatch read FToolbarDispatch write FToolbarDispatch; + property Appearance: TSpkToolbarAppearance read FAppearance write SetAppearance; + property Images: TImageList read FImages write SetImages; + property DisabledImages: TImageList read FDisabledImages write SetDisabledImages; + property LargeImages: TImageList read FLargeImages write SetLargeImages; + property DisabledLargeImages: TImageList read FDisabledLargeImages write SetDisabledLargeImages; + property Rect: T2DIntRect read FRect write SetRect; + + published + property Visible: boolean read FVisible write SetVisible; + property Enabled: boolean read FEnabled write SetEnabled; + end; + + TSpkBaseItemClass = class of TSpkBaseItem; -type TSpkBaseItemClass = class of TSpkBaseItem; implementation { TSpkBaseItem } -constructor TSpkBaseItem.Create(AOwner : TComponent); +constructor TSpkBaseItem.Create(AOwner: TComponent); begin inherited Create(AOwner); {$IFDEF EnhancedRecordSupport} - FRect:=T2DIntRect.create(0, 0, 0, 0); + FRect := T2DIntRect.Create(0, 0, 0, 0); {$ELSE} - FRect.create(0, 0, 0, 0); + FRect.Create(0, 0, 0, 0); {$ENDIF} - FToolbarDispatch:=nil; - FAppearance:=nil; - FImages:=nil; - FDisabledImages:=nil; - FLargeImages:=nil; - FDisabledLargeImages:=nil; - FVisible:=true; - FEnabled:=true; + FToolbarDispatch := nil; + FAppearance := nil; + FImages := nil; + FDisabledImages := nil; + FLargeImages := nil; + FDisabledLargeImages := nil; + FVisible := true; + FEnabled := true; end; destructor TSpkBaseItem.Destroy; @@ -108,9 +115,8 @@ end; procedure TSpkBaseItem.SetAppearance(const Value: TSpkToolbarAppearance); begin FAppearance := Value; - - if assigned(FToolbarDispatch) then - FToolbarDispatch.NotifyMetricsChanged; + if Assigned(FToolbarDispatch) then + FToolbarDispatch.NotifyMetricsChanged; end; procedure TSpkBaseItem.SetDisabledImages(const Value: TImageList); @@ -120,17 +126,17 @@ end; procedure TSpkBaseItem.SetDisabledLargeImages(const Value: TImageList); begin -FDisabledLargeImages:=Value; + FDisabledLargeImages := Value; end; procedure TSpkBaseItem.SetEnabled(const Value: boolean); begin - if Value<>FEnabled then - begin - FEnabled:=Value; - if FToolbarDispatch<>nil then - FToolbarDispatch.NotifyVisualsChanged; - end; + if Value <> FEnabled then + begin + FEnabled := Value; + if FToolbarDispatch<>nil then + FToolbarDispatch.NotifyVisualsChanged; + end; end; procedure TSpkBaseItem.SetImages(const Value: TImageList); @@ -150,12 +156,12 @@ end; procedure TSpkBaseItem.SetVisible(const Value: boolean); begin - if Value<>FVisible then - begin - FVisible:=Value; - if FToolbarDispatch<>nil then - FToolbarDispatch.NotifyMetricsChanged; - end; + if Value <> FVisible then + begin + FVisible := Value; + if FToolbarDispatch <> nil then + FToolbarDispatch.NotifyMetricsChanged; + end; end; end. diff --git a/components/spktoolbar/SpkToolbar/spkt_Buttons.pas b/components/spktoolbar/SpkToolbar/spkt_Buttons.pas index 229892877..d44b492b2 100644 --- a/components/spktoolbar/SpkToolbar/spkt_Buttons.pas +++ b/components/spktoolbar/SpkToolbar/spkt_Buttons.pas @@ -17,164 +17,163 @@ interface uses Graphics, Classes, Controls, Menus, ActnList, Math, - Dialogs, ImgList, Forms, - SpkGUITools, SpkGraphTools, SpkMath, - spkt_Const, spkt_BaseItem, spkt_Exceptions, spkt_Tools; + Dialogs, ImgList, Forms, + SpkGUITools, SpkGraphTools, SpkMath, + spkt_Const, spkt_BaseItem, spkt_Exceptions, spkt_Tools; -type TSpkButtonState = (bsIdle, - bsBtnHottrack, bsBtnPressed, - bsDropdownHottrack, bsDropdownPressed); - TSpkMouseButtonElement = (beNone, beButton, beDropdown); - TSpkButtonKind = (bkButton, bkButtonDropdown, bkDropdown); +type + TSpkButtonState = ( + bsIdle, + bsBtnHottrack, bsBtnPressed, + bsDropdownHottrack, bsDropdownPressed + ); -type TSpkBaseButton = class; + TSpkMouseButtonElement = (beNone, beButton, beDropdown); - TSpkButtonActionLink = class(TActionLink) - private - protected - FClient : TSpkBaseButton; + TSpkButtonKind = (bkButton, bkButtonDropdown, bkDropdown); - procedure AssignClient(AClient: TObject); override; - function IsOnExecuteLinked: Boolean; override; - procedure SetCaption(const Value: string); override; - procedure SetEnabled(Value: Boolean); override; - procedure SetImageIndex(Value: integer); override; - procedure SetVisible(Value: Boolean); override; - procedure SetOnExecute(Value: TNotifyEvent); override; - public - function IsCaptionLinked: Boolean; override; - function IsEnabledLinked: Boolean; override; - function IsImageIndexLinked: Boolean; override; - function IsVisibleLinked: Boolean; override; - end; + TSpkBaseButton = class; + + TSpkButtonActionLink = class(TActionLink) + protected + FClient: TSpkBaseButton; + procedure AssignClient(AClient: TObject); override; + function IsOnExecuteLinked: Boolean; override; + procedure SetCaption(const Value: string); override; + procedure SetEnabled(Value: Boolean); override; + procedure SetImageIndex(Value: integer); override; + procedure SetVisible(Value: Boolean); override; + procedure SetOnExecute(Value: TNotifyEvent); override; + public + function IsCaptionLinked: Boolean; override; + function IsEnabledLinked: Boolean; override; + function IsImageIndexLinked: Boolean; override; + function IsVisibleLinked: Boolean; override; + end; - { TSpkBaseButton } + { TSpkBaseButton } - TSpkBaseButton = class abstract(TSpkBaseItem) - private - FMouseHoverElement : TSpkMouseButtonElement; - FMouseActiveElement : TSpkMouseButtonElement; - protected - FCaption : string; - FOnClick : TNotifyEvent; + TSpkBaseButton = class abstract(TSpkBaseItem) + private + FMouseHoverElement: TSpkMouseButtonElement; + FMouseActiveElement: TSpkMouseButtonElement; - FActionLink : TSpkButtonActionLink; + // Getters and Setters + function GetAction: TBasicAction; + procedure SetCaption(const Value: string); + procedure SetButtonKind(const Value: TSpkButtonKind); + procedure SetDropdownMenu(const Value: TPopupMenu); - FButtonState : TSpkButtonState; + protected + FCaption: string; + FOnClick: TNotifyEvent; + FActionLink: TSpkButtonActionLink; + FButtonState: TSpkButtonState; + FButtonRect: T2DIntRect; + FDropdownRect: T2DIntRect; + FButtonKind: TSpkButtonKind; + FDropdownMenu: TPopupMenu; - FButtonRect : T2DIntRect; - FDropdownRect : T2DIntRect; + // *** Obs³uga rysowania *** + /// Zadaniem metody w odziedziczonych klasach jest obliczenie + /// rectów przycisku i menu dropdown w zale¿noœci od FButtonState + procedure CalcRects; virtual; abstract; + function GetDropdownPoint: T2DIntPoint; virtual; abstract; - FButtonKind : TSpkButtonKind; - FDropdownMenu : TPopupMenu; + // *** Obs³uga akcji *** + procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); virtual; + procedure Click; virtual; + procedure DoActionChange(Sender: TObject); + function GetDefaultCaption: String; virtual; - // *** Obs³uga rysowania *** + // Getters and Setters + procedure SetEnabled(const Value: boolean); override; + procedure SetRect(const Value: T2DIntRect); override; + procedure SetAction(const Value: TBasicAction); virtual; - /// Zadaniem metody w odziedziczonych klasach jest obliczenie - /// rectów przycisku i menu dropdown w zale¿noœci od FButtonState - procedure CalcRects; virtual; abstract; + property ButtonKind: TSpkButtonKind read FButtonKind write SetButtonKind; + property DropdownMenu: TPopupMenu read FDropdownMenu write SetDropdownMenu; - function GetDropdownPoint : T2DIntPoint; virtual; abstract; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; - // *** Obs³uga akcji *** + procedure MouseLeave; override; + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); override; + procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; + procedure MouseUp(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); override; - procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); virtual; - procedure DoActionChange(Sender: TObject); - procedure Click; virtual; - function GetDefaultCaption: String; virtual; + function GetRootComponent: TComponent; - // *** Gettery i settery *** - - procedure SetEnabled(const Value : boolean); override; - procedure SetDropdownMenu(const Value : TPopupMenu); - procedure SetRect(const Value: T2DIntRect); override; - procedure SetCaption(const Value : string); - procedure SetAction(const Value : TBasicAction); virtual; - procedure SetButtonKind(const Value : TSpkButtonKind); - function GetAction: TBasicAction; - - property ButtonKind : TSpkButtonKind read FButtonKind write SetButtonKind; - property DropdownMenu : TPopupMenu read FDropdownMenu write SetDropdownMenu; - - public - constructor Create(AOwner : TComponent); override; - destructor Destroy; override; - - procedure MouseLeave; override; - procedure MouseDown(Button: TMouseButton; Shift: TShiftState; - X, Y: Integer); override; - procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; - procedure MouseUp(Button: TMouseButton; Shift: TShiftState; - X, Y: Integer); override; - - function GetRootComponent: TComponent; - - published - property Caption : string read FCaption write SetCaption; - property Action : TBasicAction read GetAction write SetAction; - property OnClick : TNotifyEvent read FOnClick write FOnClick; - end; + published + property Action: TBasicAction read GetAction write SetAction; + property Caption: string read FCaption write SetCaption; + property OnClick: TNotifyEvent read FOnClick write FOnClick; + end; - { TSpkLargeButton } + { TSpkLargeButton } - TSpkLargeButton = class(TSpkBaseButton) - private - FLargeImageIndex: TImageIndex; - procedure FindBreakPlace(s: string; out Position: integer; out Width: integer); - procedure SetLargeImageIndex(const Value: TImageIndex); - protected - procedure CalcRects; override; - function GetDropdownPoint : T2DIntPoint; override; - public - constructor Create(AOwner: TComponent); override; - procedure Draw(ABuffer: TBitmap; ClipRect: T2DIntRect); override; - function GetWidth: integer; override; - function GetTableBehaviour: TSpkItemTableBehaviour; override; - function GetGroupBehaviour: TSpkItemGroupBehaviour; override; - function GetSize: TSpkItemSize; override; - published - property LargeImageIndex: TImageIndex read FLargeImageIndex write SetLargeImageIndex default -1; - property ButtonKind; - property DropdownMenu; - end; + TSpkLargeButton = class(TSpkBaseButton) + private + FLargeImageIndex: TImageIndex; + procedure FindBreakPlace(s: string; out Position: integer; out Width: integer); + procedure SetLargeImageIndex(const Value: TImageIndex); + protected + procedure CalcRects; override; + function GetDropdownPoint : T2DIntPoint; override; + public + constructor Create(AOwner: TComponent); override; + procedure Draw(ABuffer: TBitmap; ClipRect: T2DIntRect); override; + function GetGroupBehaviour: TSpkItemGroupBehaviour; override; + function GetSize: TSpkItemSize; override; + function GetTableBehaviour: TSpkItemTableBehaviour; override; + function GetWidth: integer; override; + published + property LargeImageIndex: TImageIndex read FLargeImageIndex write SetLargeImageIndex default -1; + property ButtonKind; + property DropdownMenu; + end; - { TSpkSmallButton } + { TSpkSmallButton } + + TSpkSmallButton = class(TSpkBaseButton) + private + FImageIndex: TImageIndex; + FTableBehaviour: TSpkItemTableBehaviour; + FGroupBehaviour: TSPkItemGroupBehaviour; + FHideFrameWhenIdle: boolean; + FShowCaption: boolean; + procedure ConstructRects(out BtnRect, DropRect: T2DIntRect); + procedure SetGroupBehaviour(const Value: TSpkItemGroupBehaviour); + procedure SetHideFrameWhenIdle(const Value: boolean); + procedure SetImageIndex(const Value: TImageIndex); + procedure SetShowCaption(const Value: boolean); + procedure SetTableBehaviour(const Value: TSpkItemTableBehaviour); + protected + procedure CalcRects; override; + function GetDropdownPoint: T2DIntPoint; override; + public + constructor Create(AOwner: TComponent); override; + procedure Draw(ABuffer: TBitmap; ClipRect: T2DIntRect); override; + function GetGroupBehaviour: TSpkItemGroupBehaviour; override; + function GetSize: TSpkItemSize; override; + function GetTableBehaviour: TSpkItemTableBehaviour; override; + function GetWidth: integer; override; + published + property GroupBehaviour: TSpkItemGroupBehaviour read FGroupBehaviour write SetGroupBehaviour; + property HideFrameWhenIdle: boolean read FHideFrameWhenIdle write SetHideFrameWhenIdle; + property ImageIndex: TImageIndex read FImageIndex write SetImageIndex default -1; + property ShowCaption: boolean read FShowCaption write SetShowCaption; + property TableBehaviour: TSpkItemTableBehaviour read FTableBehaviour write SetTableBehaviour; + property ButtonKind; + property DropdownMenu; + end; - TSpkSmallButton = class(TSpkBaseButton) - private - FImageIndex: TImageIndex; - FTableBehaviour: TSpkItemTableBehaviour; - FGroupBehaviour: TSPkItemGroupBehaviour; - FHideFrameWhenIdle: boolean; - FShowCaption: boolean; - procedure ConstructRects(out BtnRect, DropRect: T2DIntRect); - procedure SetImageIndex(const Value: TImageIndex); - procedure SetGroupBehaviour(const Value: TSpkItemGroupBehaviour); - procedure SetHideFrameWhenIdle(const Value: boolean); - procedure SetTableBehaviour(const Value: TSpkItemTableBehaviour); - procedure SetShowCaption(const Value: boolean); - protected - procedure CalcRects; override; - function GetDropdownPoint: T2DIntPoint; override; - public - constructor Create(AOwner: TComponent); override; - procedure Draw(ABuffer: TBitmap; ClipRect: T2DIntRect); override; - function GetWidth: integer; override; - function GetTableBehaviour: TSpkItemTableBehaviour; override; - function GetGroupBehaviour: TSpkItemGroupBehaviour; override; - function GetSize: TSpkItemSize; override; - published - property ShowCaption: boolean read FShowCaption write SetShowCaption; - property TableBehaviour: TSpkItemTableBehaviour read FTableBehaviour write SetTableBehaviour; - property GroupBehaviour: TSpkItemGroupBehaviour read FGroupBehaviour write SetGroupBehaviour; - property HideFrameWhenIdle: boolean read FHideFrameWhenIdle write SetHideFrameWhenIdle; - property ImageIndex: TImageIndex read FImageIndex write SetImageIndex default -1; - property ButtonKind; - property DropdownMenu; - end; implementation @@ -191,58 +190,58 @@ end; function TSpkButtonActionLink.IsCaptionLinked: Boolean; begin - Result := inherited IsCaptionLinked and - Assigned(FClient) and + Result := inherited IsCaptionLinked and Assigned(FClient) and (FClient.Caption = (Action as TCustomAction).Caption); end; function TSpkButtonActionLink.IsEnabledLinked: Boolean; begin - Result := inherited IsEnabledLinked and - Assigned(FClient) and - (FClient.Enabled = (Action as TCustomAction).Enabled); + Result := inherited IsEnabledLinked and Assigned(FClient) and + (FClient.Enabled = (Action as TCustomAction).Enabled); end; function TSpkButtonActionLink.IsOnExecuteLinked: Boolean; begin Result := inherited IsOnExecuteLinked and - (@TSpkBaseButton(FClient).OnClick = @Action.OnExecute); + (@TSpkBaseButton(FClient).OnClick = @Action.OnExecute); end; function TSpkButtonActionLink.IsImageIndexLinked: Boolean; begin - Result := (inherited IsImageIndexLinked) and - ( - ((FClient is TSpkSmallButton) - and (TSpkSmallButton(FClient).ImageIndex = (Action as TCustomAction).ImageIndex)) - or - ((FClient is TSpkLargeButton) - and (TSpkLargeButton(FClient).LargeImageIndex = (Action as TCustomAction).ImageIndex)) - ); + Result := inherited IsImageIndexLinked; + if (FClient is TSpkSmallButton) then + Result := Result and (TSpkSmallButton(FClient).ImageIndex = (Action as TCustomAction).ImageIndex) + else + if (FClient is TSpkLargeButton) then + Result := Result and (TSpkLargeButton(FClient).LargeImageIndex = (Action as TCustomAction).ImageIndex) + else + Result := false; end; function TSpkButtonActionLink.IsVisibleLinked: Boolean; begin - Result := inherited IsVisibleLinked and - Assigned(FClient) and + Result := inherited IsVisibleLinked and Assigned(FClient) and (FClient.Visible = (Action as TCustomAction).Visible); end; procedure TSpkButtonActionLink.SetCaption(const Value: string); begin - if IsCaptionLinked then FClient.Caption := Value; + if IsCaptionLinked then + FClient.Caption := Value; end; procedure TSpkButtonActionLink.SetEnabled(Value: Boolean); begin - if IsEnabledLinked then FClient.Enabled := Value; + if IsEnabledLinked then + FClient.Enabled := Value; end; procedure TSpkButtonActionLink.SetImageIndex(Value: integer); begin if IsImageIndexLinked then begin if (FClient is TSpkSmallButton) then - (TSpkSmallButton(FClient)).ImageIndex := Value; + (TSpkSmallButton(FClient)).ImageIndex := Value + else if (FClient is TSpkLargeButton) then (TSpkLargeButton(FClient)).LargeImageIndex := Value; end; @@ -250,16 +249,42 @@ end; procedure TSpkButtonActionLink.SetOnExecute(Value: TNotifyEvent); begin - if IsOnExecuteLinked then FClient.OnClick := Value; + if IsOnExecuteLinked then + FClient.OnClick := Value; end; procedure TSpkButtonActionLink.SetVisible(Value: Boolean); begin - if IsVisibleLinked then FClient.Visible := Value; + if IsVisibleLinked then + FClient.Visible := Value; end; + { TSpkBaseButton } +constructor TSpkBaseButton.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + FCaption := GetDefaultCaption; + FButtonState := bsIdle; + FButtonKind := bkButton; + {$IFDEF EnhancedRecordSupport} + FButtonRect := T2DIntRect.Create(0, 0, 1, 1); + FDropdownRect := T2DIntRect.Create(0, 0, 1, 1); + {$ELSE} + FButtonRect.Create(0, 0, 1, 1); + FDropdownRect.Create(0, 0, 1, 1); + {$ENDIF} + FMouseHoverElement := beNone; + FMouseActiveElement := beNone; +end; + +destructor TSpkBaseButton.Destroy; +begin + FreeAndNil(FActionLink); + inherited Destroy; +end; + procedure TSpkBaseButton.ActionChange(Sender: TObject; CheckDefaults: Boolean); begin if Sender is TCustomAction then @@ -284,29 +309,6 @@ begin end; end; -constructor TSpkBaseButton.Create(AOwner : TComponent); -begin - inherited Create(AOwner); - FCaption:=GetDefaultCaption; - FButtonState:=bsIdle; - FButtonKind:=bkButton; - {$IFDEF EnhancedRecordSupport} - FButtonRect:=T2DIntRect.Create(0, 0, 1, 1); - FDropdownRect:=T2DIntRect.Create(0, 0, 1, 1); - {$ELSE} - FButtonRect.Create(0, 0, 1, 1); - FDropdownRect.Create(0, 0, 1, 1); - {$ENDIF} - FMouseHoverElement:=beNone; - FMouseActiveElement:=beNone; -end; - -destructor TSpkBaseButton.Destroy; -begin - FreeAndNil(FActionLink); - inherited Destroy; -end; - procedure TSpkBaseButton.Click; begin if Assigned(FOnClick) then @@ -315,19 +317,21 @@ end; procedure TSpkBaseButton.DoActionChange(Sender: TObject); begin - if Sender = Action then ActionChange(Sender, False); + if Sender = Action then + ActionChange(Sender, False); end; function TSpkBaseButton.GetAction: TBasicAction; begin -if assigned(FActionLink) then - result:=FActionLink.Action else - result:=nil; + if Assigned(FActionLink) then + Result := FActionLink.Action + else + Result := nil; end; function TSpkBaseButton.GetDefaultCaption: String; begin - result := 'Button'; + Result := 'Button'; end; function TSpkBaseButton.GetRootComponent: TComponent; @@ -348,313 +352,305 @@ begin result := tab.Collection.RootComponent; end; -procedure TSpkBaseButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X, - Y: Integer); +procedure TSpkBaseButton.MouseDown(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); begin -if FEnabled then - begin - // Przyciski reaguj¹ tylko na lewy przycisk myszy - if Button <> mbLeft then + if FEnabled then + begin + // Przyciski reaguj¹ tylko na lewy przycisk myszy + if Button <> mbLeft then exit; - if FMouseActiveElement = beButton then + if FMouseActiveElement = beButton then + begin + if FButtonState <> bsBtnPressed then begin - if FButtonState<>bsBtnPressed then - begin - FButtonState:=bsBtnPressed; - if assigned(FToolbarDispatch) then - FToolbarDispatch.NotifyVisualsChanged; - end; - end else - if FMouseActiveElement = beDropdown then - begin - if FButtonState<>bsDropdownPressed then - begin - FButtonState:=bsDropdownPressed; - if assigned(FToolbarDispatch) then - FToolbarDispatch.NotifyVisualsChanged; - end; - end else - if FMouseActiveElement = beNone then + FButtonState := bsBtnPressed; + if Assigned(FToolbarDispatch) then + FToolbarDispatch.NotifyVisualsChanged; + end; + end else + if FMouseActiveElement = beDropdown then + begin + if FButtonState <> bsDropdownPressed then begin + FButtonState := bsDropdownPressed; + if Assigned(FToolbarDispatch) then + FToolbarDispatch.NotifyVisualsChanged; + end; + end else + if FMouseActiveElement = beNone then + begin if FMouseHoverElement = beButton then - begin - FMouseActiveElement:=beButton; - - if FButtonState<>bsBtnPressed then - begin - FButtonState:=bsBtnPressed; - if FToolbarDispatch<>nil then - FToolbarDispatch.NotifyVisualsChanged; - end; - end else - if FMouseHoverElement = beDropdown then - begin - FMouseActiveElement:=beDropdown; - - if FButtonState<>bsDropdownPressed then - begin - FButtonState:=bsDropdownPressed; - if FToolbarDispatch<>nil then - FToolbarDispatch.NotifyVisualsChanged; - end; - end; - end; - end -else - begin - FMouseHoverElement:=beNone; - FMouseActiveElement:=beNone; - if FButtonState<>bsIdle then begin - FButtonState:=bsIdle; - - if assigned(FToolbarDispatch) then - FToolbarDispatch.NotifyVisualsChanged; + FMouseActiveElement := beButton; + if FButtonState <> bsBtnPressed then + begin + FButtonState := bsBtnPressed; + if FToolbarDispatch <> nil then + FToolbarDispatch.NotifyVisualsChanged; + end; + end else + if FMouseHoverElement = beDropdown then + begin + FMouseActiveElement := beDropdown; + if FButtonState <> bsDropdownPressed then + begin + FButtonState := bsDropdownPressed; + if FToolbarDispatch <> nil then + FToolbarDispatch.NotifyVisualsChanged; + end; end; - end; + end; + end // if FEnabled + else + begin + FMouseHoverElement := beNone; + FMouseActiveElement := beNone; + if FButtonState <> bsIdle then + begin + FButtonState := bsIdle; + if Assigned(FToolbarDispatch) then + FToolbarDispatch.NotifyVisualsChanged; + end; + end; end; procedure TSpkBaseButton.MouseLeave; begin -if FEnabled then - begin - if FMouseActiveElement = beNone then - begin + if FEnabled then + begin + if FMouseActiveElement = beNone then + begin if FMouseHoverElement = beButton then - begin - // Placeholder, gdyby zasz³a potrzeba obs³ugi tego zdarzenia - end else + begin + // Placeholder, gdyby zasz³a potrzeba obs³ugi tego zdarzenia + end else if FMouseHoverElement = beDropdown then - begin - // Placeholder, gdyby zasz³a potrzeba obs³ugi tego zdarzenia - end; - end; - - if FButtonState<>bsIdle then begin - FButtonState:=bsIdle; - if assigned(FToolbarDispatch) then - FToolbarDispatch.NotifyVisualsChanged; + // Placeholder, gdyby zasz³a potrzeba obs³ugi tego zdarzenia end; - end -else - begin - FMouseHoverElement:=beNone; - FMouseActiveElement:=beNone; - if FButtonState<>bsIdle then - begin - FButtonState:=bsIdle; - - if assigned(FToolbarDispatch) then - FToolbarDispatch.NotifyVisualsChanged; - end; - end; + end; + if FButtonState <> bsIdle then + begin + FButtonState := bsIdle; + if Assigned(FToolbarDispatch) then + FToolbarDispatch.NotifyVisualsChanged; + end; + end // if FEnabled + else + begin + FMouseHoverElement := beNone; + FMouseActiveElement := beNone; + if FButtonState <> bsIdle then + begin + FButtonState := bsIdle; + if Assigned(FToolbarDispatch) then + FToolbarDispatch.NotifyVisualsChanged; + end; + end; end; procedure TSpkBaseButton.MouseMove(Shift: TShiftState; X, Y: Integer); - -var NewMouseHoverElement : TSpkMouseButtonElement; - +var + NewMouseHoverElement: TSpkMouseButtonElement; begin -if FEnabled then - begin - {$IFDEF EnhancedRecordSupport} - if FButtonRect.Contains(T2DIntPoint.Create(X,Y)) then - {$ELSE} - if FButtonRect.Contains(X,Y) then - {$ENDIF} - NewMouseHoverElement:=beButton else - if (FButtonKind = bkButtonDropdown) and + if FEnabled then + begin + {$IFDEF EnhancedRecordSupport} + if FButtonRect.Contains(T2DIntPoint.Create(X,Y)) then + {$ELSE} + if FButtonRect.Contains(X,Y) + {$ENDIF} + then + NewMouseHoverElement := beButton + else + if (FButtonKind = bkButtonDropdown) and {$IFDEF EnhancedRecordSupport} (FDropdownRect.Contains(T2DIntPoint.Create(X,Y))) then {$ELSE} - (FDropdownRect.Contains(X,Y)) then + (FDropdownRect.Contains(X,Y)) {$ENDIF} - NewMouseHoverElement:=beDropdown else - NewMouseHoverElement:=beNone; + then + NewMouseHoverElement := beDropdown + else + NewMouseHoverElement := beNone; - if FMouseActiveElement = beButton then + if FMouseActiveElement = beButton then + begin + if (NewMouseHoverElement = beNone) and (FButtonState <> bsIdle) then begin - if (NewMouseHoverElement = beNone) and (FButtonState<>bsIdle) then - begin - FButtonState:=bsIdle; - if FToolbarDispatch<>nil then - FToolbarDispatch.NotifyVisualsChanged; - end else - if (NewMouseHoverElement = beButton) and (FButtonState<>bsBtnPressed) then - begin - FButtonState:=bsBtnPressed; - if FToolbarDispatch<>nil then - FToolbarDispatch.NotifyVisualsChanged; - end; + FButtonState := bsIdle; + if FToolbarDispatch <> nil then + FToolbarDispatch.NotifyVisualsChanged; end else - if FMouseActiveElement = beDropdown then + if (NewMouseHoverElement = beButton) and (FButtonState <> bsBtnPressed) then begin - if (NewMouseHoverElement = beNone) and (FButtonState<>bsIdle) then - begin - FButtonState:=bsIdle; - if FToolbarDispatch<>nil then - FToolbarDispatch.NotifyVisualsChanged; - end else - if (NewMouseHoverElement = beDropdown) and (FButtonState<>bsDropdownPressed) then - begin - FButtonState:=bsDropdownPressed; - if FToolbarDispatch<>nil then - FToolbarDispatch.NotifyVisualsChanged; - end; + FButtonState := bsBtnPressed; + if FToolbarDispatch <> nil then + FToolbarDispatch.NotifyVisualsChanged; + end; + end else + if FMouseActiveElement = beDropdown then + begin + if (NewMouseHoverElement = beNone) and (FButtonState <> bsIdle) then + begin + FButtonState := bsIdle; + if FToolbarDispatch <> nil then + FToolbarDispatch.NotifyVisualsChanged; end else - if FMouseActiveElement = beNone then + if (NewMouseHoverElement = beDropdown) and (FButtonState <> bsDropdownPressed) then begin + FButtonState := bsDropdownPressed; + if FToolbarDispatch <> nil then + FToolbarDispatch.NotifyVisualsChanged; + end; + end else + if FMouseActiveElement = beNone then + begin // Z uwagi na uproszczon¹ obs³ugê myszy w przycisku, nie ma potrzeby // informowaæ poprzedniego elementu o tym, ¿e mysz opuœci³a jego obszar. - if NewMouseHoverElement = beButton then - begin - if FButtonState<>bsBtnHottrack then - begin - FButtonState:=bsBtnHottrack; - if FToolbarDispatch<>nil then - FToolbarDispatch.NotifyVisualsChanged; - end; - end else - if NewMouseHoverElement = beDropdown then - begin - if FButtonState<>bsDropdownHottrack then - begin - FButtonState:=bsDropdownHottrack; - if FToolbarDispatch<>nil then - FToolbarDispatch.NotifyVisualsChanged; - end; - end; - end; - - FMouseHoverElement:=NewMouseHoverElement; - end -else - begin - FMouseHoverElement:=beNone; - FMouseActiveElement:=beNone; - if FButtonState<>bsIdle then begin - FButtonState:=bsIdle; - - if assigned(FToolbarDispatch) then - FToolbarDispatch.NotifyVisualsChanged; + if FButtonState <> bsBtnHottrack then + begin + FButtonState := bsBtnHottrack; + if FToolbarDispatch <> nil then + FToolbarDispatch.NotifyVisualsChanged; + end; + end else + if NewMouseHoverElement = beDropdown then + begin + if FButtonState <> bsDropdownHottrack then + begin + FButtonState := bsDropdownHottrack; + if FToolbarDispatch <> nil then + FToolbarDispatch.NotifyVisualsChanged; + end; end; - end; + end; + + FMouseHoverElement := NewMouseHoverElement; + end // if FEnabled + else + begin + FMouseHoverElement := beNone; + FMouseActiveElement := beNone; + if FButtonState <> bsIdle then + begin + FButtonState := bsIdle; + if Assigned(FToolbarDispatch) then + FToolbarDispatch.NotifyVisualsChanged; + end; + end; end; -procedure TSpkBaseButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X, - Y: Integer); - -var ClearActive : boolean; +procedure TSpkBaseButton.MouseUp(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); +var + ClearActive: boolean; DropPoint: T2DIntPoint; - begin -if FEnabled then - begin - // Przyciski reaguj¹ tylko na lewy przycisk myszy - if Button <> mbLeft then + if FEnabled then + begin + // Przyciski reaguj¹ tylko na lewy przycisk myszy + if Button <> mbLeft then exit; - ClearActive:=not(ssLeft in Shift); + ClearActive := not (ssLeft in Shift); - if FMouseActiveElement = beButton then - begin + if FMouseActiveElement = beButton then + begin // Zdarzenie zadzia³a tylko wtedy, gdy przycisk myszy zosta³ puszczony nad // przyciskiem if FMouseHoverElement = beButton then - begin - if FButtonKind in [bkButton, bkButtonDropdown] then - begin - Click; - FButtonState:=bsBtnHottrack; - if assigned(FToolbarDispatch) then - FToolbarDispatch.NotifyVisualsChanged; - end else - if FButtonKind = bkDropdown then - begin - if assigned(FDropdownMenu) then - begin - DropPoint:=FToolbarDispatch.ClientToScreen(GetDropdownPoint); - FDropdownMenu.Popup(DropPoint.x, DropPoint.y); - FButtonState:=bsBtnHottrack; - if assigned(FToolbarDispatch) then - FToolbarDispatch.NotifyVisualsChanged; - end; - end; - end; - end else - if FMouseActiveElement = beDropDown then begin + if FButtonKind in [bkButton, bkButtonDropdown] then + begin + Click; + FButtonState := bsBtnHottrack; + if Assigned(FToolbarDispatch) then + FToolbarDispatch.NotifyVisualsChanged; + end else + if FButtonKind = bkDropdown then + begin + if Assigned(FDropdownMenu) then + begin + DropPoint := FToolbarDispatch.ClientToScreen(GetDropdownPoint); + FDropdownMenu.Popup(DropPoint.x, DropPoint.y); + FButtonState := bsBtnHottrack; + if Assigned(FToolbarDispatch) then + FToolbarDispatch.NotifyVisualsChanged; + end; + end; + end; + end else + if FMouseActiveElement = beDropDown then + begin // Zdarzenie zadzia³a tylko wtedy, gdy przycisk myszy zosta³ puszczony nad // przyciskiem DropDown - if FMouseHoverElement = beDropDown then - begin - if assigned(FDropdownMenu) then - begin - DropPoint:=FToolbarDispatch.ClientToScreen(GetDropdownPoint); - FDropdownMenu.Popup(DropPoint.x, DropPoint.y); - FButtonState:=bsBtnHottrack; - if assigned(FToolbarDispatch) then - FToolbarDispatch.NotifyVisualsChanged; - end; - end; - end; - - if (ClearActive) and (FMouseActiveElement<>FMouseHoverElement) then begin + if Assigned(FDropdownMenu) then + begin + DropPoint := FToolbarDispatch.ClientToScreen(GetDropdownPoint); + FDropdownMenu.Popup(DropPoint.x, DropPoint.y); + FButtonState := bsBtnHottrack; + if Assigned(FToolbarDispatch) then + FToolbarDispatch.NotifyVisualsChanged; + end; + end; + end; + + if ClearActive and (FMouseActiveElement <> FMouseHoverElement) then + begin // Z uwagi na uproszczon¹ obs³ugê, nie ma potrzeby informowaæ poprzedniego // elementu o tym, ¿e mysz opuœci³a jego obszar. - if FMouseHoverElement = beButton then - begin - if FButtonState<>bsBtnHottrack then - begin - FButtonState:=bsBtnHottrack; - if assigned(FToolbarDispatch) then - FToolbarDispatch.NotifyVisualsChanged; - end; - end else + begin + if FButtonState <> bsBtnHottrack then + begin + FButtonState := bsBtnHottrack; + if Assigned(FToolbarDispatch) then + FToolbarDispatch.NotifyVisualsChanged; + end; + end else if FMouseHoverElement = beDropdown then - begin - if FButtonState<>bsDropdownHottrack then - begin - FButtonState:=bsDropdownHottrack; - if assigned(FToolbarDispatch) then - FToolbarDispatch.NotifyVisualsChanged; - end; - end else + begin + if FButtonState <> bsDropdownHottrack then + begin + FButtonState := bsDropdownHottrack; + if Assigned(FToolbarDispatch) then + FToolbarDispatch.NotifyVisualsChanged; + end; + end else if FMouseHoverElement = beNone then - begin - if FButtonState <> bsIdle then - begin - FButtonState:=bsIdle; - if assigned(FToolbarDispatch) then - FToolbarDispatch.NotifyVisualsChanged; - end; - end; - end; - - if ClearActive then begin + if FButtonState <> bsIdle then + begin + FButtonState := bsIdle; + if Assigned(FToolbarDispatch) then + FToolbarDispatch.NotifyVisualsChanged; + end; + end; + end; + + if ClearActive then + begin FMouseActiveElement:=beNone; - end; - end -else - begin - FMouseHoverElement:=beNone; - FMouseActiveElement:=beNone; - if FButtonState<>bsIdle then - begin - FButtonState:=bsIdle; - - if assigned(FToolbarDispatch) then - FToolbarDispatch.NotifyVisualsChanged; - end; - end; + end; + end // if FEnabled + else + begin + FMouseHoverElement := beNone; + FMouseActiveElement := beNone; + if FButtonState <> bsIdle then + begin + FButtonState := bsIdle; + if Assigned(FToolbarDispatch) then + FToolbarDispatch.NotifyVisualsChanged; + end; + end; end; procedure TSpkBaseButton.SetAction(const Value: TBasicAction); @@ -722,6 +718,7 @@ begin CalcRects; end; + { TSpkLargeButton } procedure TSpkLargeButton.CalcRects; @@ -1128,6 +1125,16 @@ end; { TSpkSmallButton } +constructor TSpkSmallButton.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + FImageIndex := -1; + FTableBehaviour := tbContinuesRow; + FGroupBehaviour := gbSingleItem; + FHideFrameWhenIdle := false; + FShowCaption := true; +end; + procedure TSpkSmallButton.CalcRects; var RectVector: T2DIntVector; @@ -1143,144 +1150,140 @@ begin end; procedure TSpkSmallButton.ConstructRects(out BtnRect, DropRect: T2DIntRect); - -var BtnWidth : integer; - DropdownWidth: Integer; - Bitmap : TBitmap; - TextWidth: Integer; +var + BtnWidth: integer; + DropdownWidth: Integer; + Bitmap: TBitmap; + TextWidth: Integer; AdditionalPadding: Boolean; - begin -{$IFDEF EnhancedRecordSupport} -BtnRect:=T2DIntRect.Create(0, 0, 0, 0); -DropRect:=T2DIntRect.Create(0, 0, 0, 0); -{$ELSE} -BtnRect.Create(0, 0, 0, 0); -DropRect.Create(0, 0, 0, 0); -{$ENDIF} + {$IFDEF EnhancedRecordSupport} + BtnRect := T2DIntRect.Create(0, 0, 0, 0); + DropRect := T2DIntRect.Create(0, 0, 0, 0); + {$ELSE} + BtnRect.Create(0, 0, 0, 0); + DropRect.Create(0, 0, 0, 0); + {$ENDIF} -if not(assigned(FToolbarDispatch)) then - exit; -if not(assigned(FAppearance)) then - exit; + if not Assigned(FToolbarDispatch) then + exit; + if not Assigned(FAppearance) then + exit; -Bitmap:=FToolbarDispatch.GetTempBitmap; -if not(assigned(Bitmap)) then - exit; + Bitmap := FToolbarDispatch.GetTempBitmap; + if not Assigned(Bitmap) then + exit; -// *** Niezale¿nie od rodzaju, musi byæ miejsce dla ikony i/lub tekstu *** + // *** Niezale¿nie od rodzaju, musi byæ miejsce dla ikony i/lub tekstu *** -BtnWidth:=0; -AdditionalPadding:=false; + BtnWidth := 0; + AdditionalPadding := false; -// Ikona -if FImageIndex<>-1 then - begin - BtnWidth:=BtnWidth + SmallButtonPadding + SmallButtonGlyphWidth; - AdditionalPadding:=true; - end; + // Ikona + if FImageIndex <> -1 then + begin + BtnWidth := BtnWidth + SmallButtonPadding + SmallButtonGlyphWidth; + AdditionalPadding := true; + end; -// Tekst -if FShowCaption then - begin - Bitmap.Canvas.Font.assign(FAppearance.Element.CaptionFont); - TextWidth:=Bitmap.Canvas.TextWidth(FCaption); + // Tekst + if FShowCaption then + begin + Bitmap.Canvas.Font.Assign(FAppearance.Element.CaptionFont); + TextWidth := Bitmap.Canvas.TextWidth(FCaption); - BtnWidth:=BtnWidth + SmallButtonPadding + TextWidth; - AdditionalPadding:=true; - end; + BtnWidth := BtnWidth + SmallButtonPadding + TextWidth; + AdditionalPadding := true; + end; -// Padding za tekstem lub ikon¹ -if AdditionalPadding then - BtnWidth:=BtnWidth + SmallButtonPadding; + // Padding za tekstem lub ikon¹ + if AdditionalPadding then + BtnWidth := BtnWidth + SmallButtonPadding; -// Szerokoœæ zawartoœci przycisku musi wynosiæ co najmniej SMALLBUTTON_MIN_WIDTH -BtnWidth := Max(SmallButtonMinWidth, BtnWidth); + // Szerokoœæ zawartoœci przycisku musi wynosiæ co najmniej SMALLBUTTON_MIN_WIDTH + BtnWidth := Max(SmallButtonMinWidth, BtnWidth); -// *** Dropdown *** -case FButtonKind of - bkButton: begin - // Lewa krawêdŸ przycisku - if FGroupBehaviour in [gbContinuesGroup, gbEndsGroup] then - BtnWidth:=BtnWidth + SmallButtonHalfBorderWidth else - BtnWidth:=BtnWidth + SmallButtonBorderWidth; + // *** Dropdown *** + case FButtonKind of + bkButton: + begin + // Lewa krawêdŸ przycisku + if FGroupBehaviour in [gbContinuesGroup, gbEndsGroup] then + BtnWidth := BtnWidth + SmallButtonHalfBorderWidth + else + BtnWidth := BtnWidth + SmallButtonBorderWidth; - // Prawa krawêdŸ przycisku - if (FGroupBehaviour in [gbBeginsGroup, gbContinuesGroup]) then - BtnWidth:=BtnWidth + SmallButtonHalfBorderWidth else - BtnWidth:=BtnWidth + SmallButtonBorderWidth; + // Prawa krawêdŸ przycisku + if (FGroupBehaviour in [gbBeginsGroup, gbContinuesGroup]) then + BtnWidth := BtnWidth + SmallButtonHalfBorderWidth + else + BtnWidth := BtnWidth + SmallButtonBorderWidth; - {$IFDEF EnhancedRecordSupport} - BtnRect:=T2DIntRect.Create(0, 0, BtnWidth - 1, SpkLayoutSizes.PANE_ROW_HEIGHT - 1); - DropRect:=T2DIntRect.Create(0, 0, 0, 0); - {$ELSE} - BtnRect.Create(0, 0, BtnWidth - 1, PaneRowHeight - 1); - DropRect.Create(0, 0, 0, 0); - {$ENDIF} - end; - bkButtonDropdown: begin - // Lewa krawêdŸ przycisku - if FGroupBehaviour in [gbContinuesGroup, gbEndsGroup] then - BtnWidth:=BtnWidth + SmallButtonHalfBorderWidth else - BtnWidth:=BtnWidth + SmallButtonBorderWidth; + {$IFDEF EnhancedRecordSupport} + BtnRect := T2DIntRect.Create(0, 0, BtnWidth - 1, SpkLayoutSizes.PANE_ROW_HEIGHT - 1); + DropRect := T2DIntRect.Create(0, 0, 0, 0); + {$ELSE} + BtnRect.Create(0, 0, BtnWidth - 1, PaneRowHeight - 1); + DropRect.Create(0, 0, 0, 0); + {$ENDIF} + end; - // Prawa krawêdŸ przycisku - BtnWidth:=BtnWidth + SmallButtonHalfBorderWidth; + bkButtonDropdown: + begin + // Lewa krawêdŸ przycisku + if FGroupBehaviour in [gbContinuesGroup, gbEndsGroup] then + BtnWidth := BtnWidth + SmallButtonHalfBorderWidth + else + BtnWidth := BtnWidth + SmallButtonBorderWidth; - // Lewa krawêdŸ i zawartoœæ pola dropdown - DropdownWidth := SmallButtonHalfBorderWidth + SmallButtonDropdownWidth; + // Prawa krawêdŸ przycisku + BtnWidth := BtnWidth + SmallButtonHalfBorderWidth; - // Prawa krawêdŸ pola dropdown - if (FGroupBehaviour in [gbBeginsGroup, gbContinuesGroup]) then - DropdownWidth:=DropdownWidth + SmallButtonHalfBorderWidth else - DropdownWidth:=DropdownWidth + SmallButtonBorderWidth; + // Lewa krawêdŸ i zawartoœæ pola dropdown + DropdownWidth := SmallButtonHalfBorderWidth + SmallButtonDropdownWidth; - {$IFDEF EnhancedRecordSupport} - BtnRect:=T2DIntRect.Create(0, 0, BtnWidth - 1, PaneRowHeightT - 1); - DropRect:=T2DIntRect.Create(BtnRect.right+1, - 0, - BtnRect.right+DropdownWidth, - PaneRowHeight - 1); - {$ELSE} - BtnRect.Create(0, 0, BtnWidth - 1, PaneRowHeight - 1); - DropRect.Create(BtnRect.right+1, 0, - BtnRect.right+DropdownWidth, PaneRowHeight - 1); - {$ENDIF} - end; - bkDropdown: begin - // Lewa krawêdŸ przycisku - if FGroupBehaviour in [gbContinuesGroup, gbEndsGroup] then - BtnWidth:=BtnWidth + SmallButtonHalfBorderWidth else - BtnWidth:=BtnWidth + SmallButtonBorderWidth; + // Prawa krawêdŸ pola dropdown + if (FGroupBehaviour in [gbBeginsGroup, gbContinuesGroup]) then + DropdownWidth := DropdownWidth + SmallButtonHalfBorderWidth + else + DropdownWidth := DropdownWidth + SmallButtonBorderWidth; - // Prawa krawêdŸ przycisku - if (FGroupBehaviour in [gbBeginsGroup, gbContinuesGroup]) then - BtnWidth:=BtnWidth + SmallButtonHalfBorderWidth else - BtnWidth:=BtnWidth + SmallButtonBorderWidth; + {$IFDEF EnhancedRecordSupport} + BtnRect := T2DIntRect.Create(0, 0, BtnWidth - 1, PaneRowHeightT - 1); + DropRect := T2DIntRect.Create(BtnRect.Right+1, 0, BtnRect.Right+DropdownWidth, PaneRowHeight - 1); + {$ELSE} + BtnRect.Create(0, 0, BtnWidth - 1, PaneRowHeight - 1); + DropRect.Create(BtnRect.Right+1, 0, BtnRect.Right+DropdownWidth, PaneRowHeight - 1); + {$ENDIF} + end; - // Dodatkowy obszar na dropdown + miejsce na œrodkow¹ krawêdŸ, - // dla kompatybilnoœci wymiarów z dkButtonDropdown - BtnWidth:=BtnWidth + SmallButtonBorderWidth + SmallButtonDropdownWidth; + bkDropdown: + begin + // Lewa krawêdŸ przycisku + if FGroupBehaviour in [gbContinuesGroup, gbEndsGroup] then + BtnWidth := BtnWidth + SmallButtonHalfBorderWidth + else + BtnWidth := BtnWidth + SmallButtonBorderWidth; - {$IFDEF EnhancedRecordSupport} - BtnRect:=T2DIntRect.Create(0, 0, BtnWidth - 1, PaneRowHeight - 1); - DropRect:=T2DIntRect.Create(0, 0, 0, 0); - {$ELSE} - BtnRect.Create(0, 0, BtnWidth - 1, PaneRowHeight - 1); - DropRect.Create(0, 0, 0, 0); - {$ENDIF} - end; -end; -end; + // Prawa krawêdŸ przycisku + if (FGroupBehaviour in [gbBeginsGroup, gbContinuesGroup]) then + BtnWidth := BtnWidth + SmallButtonHalfBorderWidth + else + BtnWidth := BtnWidth + SmallButtonBorderWidth; -constructor TSpkSmallButton.Create(AOwner: TComponent); -begin - inherited Create(AOwner); - FImageIndex := -1; - FTableBehaviour := tbContinuesRow; - FGroupBehaviour := gbSingleItem; - FHideFrameWhenIdle := false; - FShowCaption := true; + // Dodatkowy obszar na dropdown + miejsce na œrodkow¹ krawêdŸ, + // dla kompatybilnoœci wymiarów z dkButtonDropdown + BtnWidth := BtnWidth + SmallButtonBorderWidth + SmallButtonDropdownWidth; + + {$IFDEF EnhancedRecordSupport} + BtnRect := T2DIntRect.Create(0, 0, BtnWidth - 1, PaneRowHeight - 1); + DropRect := T2DIntRect.Create(0, 0, 0, 0); + {$ELSE} + BtnRect.Create(0, 0, BtnWidth - 1, PaneRowHeight - 1); + DropRect.Create(0, 0, 0, 0); + {$ENDIF} + end; + end; end; procedure TSpkSmallButton.Draw(ABuffer: TBitmap; ClipRect: T2DIntRect); @@ -1581,7 +1584,7 @@ end; procedure TSpkSmallButton.SetImageIndex(const Value: TImageIndex); begin - FImageIndex:=Value; + FImageIndex := Value; if Assigned(FToolbarDispatch) then FToolbarDispatch.NotifyMetricsChanged; end; diff --git a/components/spktoolbar/SpkToolbar/spkt_Checkboxes.pas b/components/spktoolbar/SpkToolbar/spkt_Checkboxes.pas index 4855ad7c3..7f6366fc8 100644 --- a/components/spktoolbar/SpkToolbar/spkt_Checkboxes.pas +++ b/components/spktoolbar/SpkToolbar/spkt_Checkboxes.pas @@ -12,7 +12,6 @@ type TSpkCustomCheckbox = class; TSpkCheckboxActionLink = class(TSpkButtonActionLink) - private protected procedure SetChecked(Value: Boolean); override; public @@ -98,7 +97,8 @@ procedure TSpkCheckboxActionLink.SetChecked(Value: Boolean); var cb: TSpkCustomCheckbox; begin - if IsCheckedLinked then begin + if IsCheckedLinked then + begin cb := TSpkCustomCheckbox(FClient); cb.Checked := Value; end; @@ -120,7 +120,8 @@ end; procedure TSpkCustomCheckbox.ActionChange(Sender: TObject); begin if Sender is TCustomAction then - with TCustomAction(Sender) do begin + with TCustomAction(Sender) do + begin if (Self.Caption = '') or (Self.Caption = GetDefaultCaption) then Self.Caption := Caption; if (Self.Enabled = True) then @@ -148,7 +149,7 @@ end; procedure TSpkCustomCheckbox.CalcRects; var - RectVector : T2DIntVector; + RectVector: T2DIntVector; begin ConstructRect(FButtonRect); {$IFDEF EnhancedRecordSupport} @@ -179,12 +180,12 @@ end; procedure TSpkCustomCheckbox.ConstructRect(var BtnRect: T2DIntRect); var - BtnWidth : integer; - Bitmap : TBitmap; + BtnWidth: integer; + Bitmap: TBitmap; TextWidth: Integer; begin {$IFDEF EnhancedRecordSupport} - BtnRect:=T2DIntRect.Create(0, 0, 0, 0); + BtnRect := T2DIntRect.Create(0, 0, 0, 0); {$ELSE} BtnRect.Create(0, 0, 0, 0); {$ENDIF} @@ -195,7 +196,7 @@ begin exit; Bitmap := FToolbarDispatch.GetTempBitmap; - if not(assigned(Bitmap)) then + if not Assigned(Bitmap) then exit; Bitmap.Canvas.Font.Assign(FAppearance.Element.CaptionFont); @@ -246,7 +247,8 @@ begin end; // Border - if (FButtonState = bsIdle) and (not(FHideFrameWhenIdle)) then begin + if (FButtonState = bsIdle) and (not(FHideFrameWhenIdle)) then + begin with FAppearance.Element do TButtonTools.DrawButton( ABuffer, @@ -265,7 +267,8 @@ begin ClipRect ); end else - if (FButtonState=bsBtnHottrack) then begin + if (FButtonState=bsBtnHottrack) then + begin with FAppearance.Element do TButtonTools.DrawButton( ABuffer, @@ -284,7 +287,8 @@ begin ClipRect ); end else - if (FButtonState = bsBtnPressed) then begin + if (FButtonState = bsBtnPressed) then + begin with FAppearance.Element do TButtonTools.DrawButton( ABuffer, @@ -305,11 +309,13 @@ begin end; // Checkbox - if ThemeServices.ThemesEnabled then begin + if ThemeServices.ThemesEnabled then + begin te := ThemeServices.GetElementDetails(tbCheckboxCheckedNormal); h := ThemeServices.GetDetailSize(te).cy; end else h := GetSystemMetrics(SM_CYMENUCHECK); + if (FGroupBehaviour in [gbContinuesGroup, gbEndsGroup]) then x := FButtonRect.Left + SmallButtonHalfBorderWidth + SmallButtonPadding else @@ -350,40 +356,40 @@ end; function TSpkCustomCheckbox.GetChecked: Boolean; begin - result := (FState = cbChecked); + Result := (FState = cbChecked); end; function TSpkCustomCheckbox.GetDefaultCaption: String; begin - result := 'Checkbox'; + Result := 'Checkbox'; end; function TSpkCustomCheckbox.GetGroupBehaviour: TSpkItemGroupBehaviour; begin - result := FGroupBehaviour; + Result := FGroupBehaviour; end; function TSpkCustomCheckbox.GetSize: TSpkItemSize; begin - result := isNormal; + Result := isNormal; end; function TSpkCustomCheckbox.GetTableBehaviour: TSpkItemTableBehaviour; begin - result := FTableBehaviour; + Result := FTableBehaviour; end; function TSpkCustomCheckbox.GetWidth: integer; var - BtnRect, DropRect : T2DIntRect; + BtnRect, DropRect: T2DIntRect; begin - result := -1; + Result := -1; if FToolbarDispatch = nil then exit; if FAppearance = nil then exit; ConstructRect(BtnRect); - result := BtnRect.Right + 1; + Result := BtnRect.Right + 1; end; procedure TSpkCustomCheckbox.MouseDown(Button: TMouseButton; Shift: TShiftState; @@ -452,7 +458,8 @@ end; procedure TSpkCustomCheckbox.SetState(AValue:TCheckboxState); begin - if AValue <> FState then begin + if AValue <> FState then + begin FState := AValue; if Assigned(FToolbarDispatch) then FToolbarDispatch.NotifyVisualsChanged; @@ -477,6 +484,7 @@ end; { TSpkRadioButton } + constructor TSpkRadioButton.Create(AOwner: TComponent); begin inherited Create(AOwner); @@ -485,7 +493,7 @@ end; function TSpkRadioButton.GetDefaultCaption: string; begin - result := 'RadioButton'; + Result := 'RadioButton'; end; procedure TSpkRadioButton.SetState(AValue: TCheckboxState); @@ -500,7 +508,8 @@ var i: Integer; pane: TSpkPane; begin - if (Parent is TSpkPane) then begin + if (Parent is TSpkPane) then + begin pane := TSpkPane(Parent); for i:=0 to pane.Items.Count-1 do if (pane.items[i] is TSpkRadioButton) and (pane.items[i] <> self) then diff --git a/components/spktoolbar/SpkToolbar/spkt_Const.pas b/components/spktoolbar/SpkToolbar/spkt_Const.pas index 2e02dbdc7..1d16b50b7 100644 --- a/components/spktoolbar/SpkToolbar/spkt_Const.pas +++ b/components/spktoolbar/SpkToolbar/spkt_Const.pas @@ -266,7 +266,6 @@ uses procedure SpkInitLayoutConsts(FromDPI: Integer; ToDPI: Integer = 0); begin - if not(DPI_AWARE) then ToDPI := FromDPI; @@ -391,21 +390,21 @@ initialization // Sprawdzanie poprawnoœci // £uk du¿ego przycisku -assert(LARGEBUTTON_RADIUS * 2 <= LARGEBUTTON_DROPDOWN_FIELD_SIZE); +Assert(LARGEBUTTON_RADIUS * 2 <= LARGEBUTTON_DROPDOWN_FIELD_SIZE); // Tafla, wersja z jednym wierszem -assert(PANE_ROW_HEIGHT + +Assert(PANE_ROW_HEIGHT + PANE_ONE_ROW_TOPPADDING + PANE_ONE_ROW_BOTTOMPADDING <= MAX_ELEMENT_HEIGHT); // Tafla, wersja z dwoma wierszami -assert(2*PANE_ROW_HEIGHT + +Assert(2*PANE_ROW_HEIGHT + PANE_TWO_ROWS_TOPPADDING + PANE_TWO_ROWS_VSPACER + PANE_TWO_ROWS_BOTTOMPADDING <= MAX_ELEMENT_HEIGHT); // Tafla, wersja z trzema wierszami -assert(3*PANE_ROW_HEIGHT + +Assert(3*PANE_ROW_HEIGHT + PANE_THREE_ROWS_TOPPADDING + 2*PANE_THREE_ROWS_VSPACER + PANE_THREE_ROWS_BOTTOMPADDING <= MAX_ELEMENT_HEIGHT); diff --git a/components/spktoolbar/SpkToolbar/spkt_Dispatch.pas b/components/spktoolbar/SpkToolbar/spkt_Dispatch.pas index f0a2a3705..d592c169c 100644 --- a/components/spktoolbar/SpkToolbar/spkt_Dispatch.pas +++ b/components/spktoolbar/SpkToolbar/spkt_Dispatch.pas @@ -15,32 +15,30 @@ unit spkt_Dispatch; interface -uses Classes, Controls, Graphics, - SpkMath; +uses + Classes, Controls, Graphics, + SpkMath; -type TSpkBaseDispatch = class abstract(TObject) - private - protected - public - end; +type + TSpkBaseDispatch = class abstract(TObject) + private + protected + public + end; -type TSpkBaseAppearanceDispatch = class abstract(TSpkBaseDispatch) - private - protected - public - procedure NotifyAppearanceChanged; virtual; abstract; - end; + TSpkBaseAppearanceDispatch = class abstract(TSpkBaseDispatch) + public + procedure NotifyAppearanceChanged; virtual; abstract; + end; -type TSpkBaseToolbarDispatch = class abstract(TSpkBaseAppearanceDispatch) - private - protected - public - procedure NotifyItemsChanged; virtual; abstract; - procedure NotifyMetricsChanged; virtual; abstract; - procedure NotifyVisualsChanged; virtual; abstract; - function GetTempBitmap : TBitmap; virtual; abstract; - function ClientToScreen(Point : T2DIntPoint) : T2DIntPoint; virtual; abstract; - end; + TSpkBaseToolbarDispatch = class abstract(TSpkBaseAppearanceDispatch) + public + procedure NotifyItemsChanged; virtual; abstract; + procedure NotifyMetricsChanged; virtual; abstract; + procedure NotifyVisualsChanged; virtual; abstract; + function GetTempBitmap: TBitmap; virtual; abstract; + function ClientToScreen(Point: T2DIntPoint): T2DIntPoint; virtual; abstract; + end; implementation diff --git a/components/spktoolbar/SpkToolbar/spkt_Exceptions.pas b/components/spktoolbar/SpkToolbar/spkt_Exceptions.pas index 752840bc8..e479e6ebe 100644 --- a/components/spktoolbar/SpkToolbar/spkt_Exceptions.pas +++ b/components/spktoolbar/SpkToolbar/spkt_Exceptions.pas @@ -14,12 +14,14 @@ unit spkt_Exceptions; interface -uses SysUtils; +uses + SysUtils; -type InternalException = class(Exception); - AssignException = class(Exception); - RuntimeException = class(Exception); - ListException = class(Exception); +type + InternalException = class(Exception); + AssignException = class(Exception); + RuntimeException = class(Exception); + ListException = class(Exception); implementation diff --git a/components/spktoolbar/SpkToolbar/spkt_Items.pas b/components/spktoolbar/SpkToolbar/spkt_Items.pas index e603c35e4..c5da587c5 100644 --- a/components/spktoolbar/SpkToolbar/spkt_Items.pas +++ b/components/spktoolbar/SpkToolbar/spkt_Items.pas @@ -15,45 +15,48 @@ unit spkt_Items; interface -uses Classes, Controls, SysUtils, Dialogs, - spkt_Appearance, spkt_Dispatch, spkt_BaseItem, spkt_Types, - spkt_Buttons, spkt_Checkboxes; +uses + Classes, Controls, SysUtils, Dialogs, + spkt_Appearance, spkt_Dispatch, spkt_BaseItem, spkt_Types, + spkt_Buttons, spkt_Checkboxes; -type TSpkItems = class(TSpkCollection) - private - FToolbarDispatch : TSpkBaseToolbarDispatch; - FAppearance : TSpkToolbarAppearance; - FImages : TImageList; - FDisabledImages : TImageList; - FLargeImages : TImageList; - FDisabledLargeImages : TImageList; +type + TSpkItems = class(TSpkCollection) + private + FToolbarDispatch: TSpkBaseToolbarDispatch; + FAppearance: TSpkToolbarAppearance; + FImages: TImageList; + FDisabledImages: TImageList; + FLargeImages: TImageList; + FDisabledLargeImages: TImageList; - // *** Gettery i settery *** - procedure SetToolbarDispatch(const Value: TSpkBaseToolbarDispatch); - function GetItems(index: integer): TSpkBaseItem; reintroduce; - procedure SetAppearance(const Value: TSpkToolbarAppearance); - procedure SetImages(const Value: TImageList); - procedure SetDisabledImages(const Value : TImageList); - procedure SetLargeImages(const Value : TImageList); - procedure SetDisabledLargeImages(const Value : TImageList); - public - function AddLargeButton : TSpkLargeButton; - function AddSmallButton : TSpkSmallButton; - function AddCheckbox: TSpkCheckbox; - function AddRadioButton: TSpkRadioButton; + // *** Gettery i settery *** + procedure SetToolbarDispatch(const Value: TSpkBaseToolbarDispatch); + function GetItems(AIndex: integer): TSpkBaseItem; reintroduce; + procedure SetAppearance(const Value: TSpkToolbarAppearance); + procedure SetImages(const Value: TImageList); + procedure SetDisabledImages(const Value: TImageList); + procedure SetLargeImages(const Value: TImageList); + procedure SetDisabledLargeImages(const Value: TImageList); - // *** Reakcja na zmiany listy *** - procedure Notify(Item: TComponent; Operation : TOperation); override; - procedure Update; override; + public + function AddLargeButton: TSpkLargeButton; + function AddSmallButton: TSpkSmallButton; + function AddCheckbox: TSpkCheckbox; + function AddRadioButton: TSpkRadioButton; - property Items[index : integer] : TSpkBaseItem read GetItems; default; - property ToolbarDispatch : TSpkBaseToolbarDispatch read FToolbarDispatch write SetToolbarDispatch; - property Appearance : TSpkToolbarAppearance read FAppearance write SetAppearance; - property Images : TImageList read FImages write SetImages; - property DisabledImages : TImageList read FDisabledImages write SetDisabledImages; - property LargeImages : TImageList read FLargeImages write SetLargeImages; - property DisabledLargeImages : TImageList read FDisabledLargeImages write SetDisabledLargeImages; - end; + // *** Reakcja na zmiany listy *** + procedure Notify(Item: TComponent; Operation: TOperation); override; + procedure Update; override; + + property Items[index: integer]: TSpkBaseItem read GetItems; default; + property ToolbarDispatch: TSpkBaseToolbarDispatch read FToolbarDispatch write SetToolbarDispatch; + property Appearance: TSpkToolbarAppearance read FAppearance write SetAppearance; + property Images: TImageList read FImages write SetImages; + property DisabledImages: TImageList read FDisabledImages write SetDisabledImages; + property LargeImages: TImageList read FLargeImages write SetLargeImages; + property DisabledLargeImages: TImageList read FDisabledLargeImages write SetDisabledLargeImages; + end; implementation @@ -87,47 +90,45 @@ begin AddItem(Result); end; -function TSpkItems.GetItems(index: integer): TSpkBaseItem; +function TSpkItems.GetItems(AIndex: integer): TSpkBaseItem; begin -result:=TSpkBaseItem(inherited Items[index]); + Result := TSpkBaseItem(inherited Items[AIndex]); end; -procedure TSpkItems.Notify(Item: TComponent; - Operation : TOperation); +procedure TSpkItems.Notify(Item: TComponent; Operation: TOperation); begin inherited Notify(Item, Operation); case Operation of - opInsert: begin - // Ustawienie dyspozytora na nil spowoduje, ¿e podczas - // przypisywania w³asnoœci nie bêd¹ wo³ane metody Notify* - TSpkBaseItem(Item).ToolbarDispatch:=nil; + opInsert: + begin + // Ustawienie dyspozytora na nil spowoduje, ¿e podczas + // przypisywania w³asnoœci nie bêd¹ wo³ane metody Notify* + TSpkBaseItem(Item).ToolbarDispatch := nil; + TSpkBaseItem(Item).Appearance := FAppearance; + TSpkBaseItem(Item).Images := FImages; + TSpkBaseItem(Item).DisabledImages := FDisabledImages; + TSpkBaseItem(Item).LargeImages := FLargeImages; + TSpkBaseItem(Item).DisabledLargeImages := FDisabledLargeImages; + TSpkBaseItem(Item).ToolbarDispatch := FToolbarDispatch; + end; - TSpkBaseItem(Item).Appearance:=FAppearance; - TSpkBaseItem(Item).Images:=FImages; - TSpkBaseItem(Item).DisabledImages:=FDisabledImages; - TSpkBaseItem(Item).LargeImages:=FLargeImages; - TSpkBaseItem(Item).DisabledLargeImages:=FDisabledLargeImages; - TSpkBaseItem(Item).ToolbarDispatch:=FToolbarDispatch; - end; - opRemove: begin - if not(csDestroying in Item.ComponentState) then - begin - TSpkBaseItem(Item).ToolbarDispatch:=nil; - TSpkBaseItem(Item).Appearance:=nil; - TSpkBaseItem(Item).Images:=nil; - TSpkBaseItem(Item).DisabledImages:=nil; - TSpkBaseItem(Item).LargeImages:=nil; - TSpkBaseItem(Item).DisabledLargeImages:=nil; - end; - end; + opRemove: + if not (csDestroying in Item.ComponentState) then + begin + TSpkBaseItem(Item).ToolbarDispatch := nil; + TSpkBaseItem(Item).Appearance := nil; + TSpkBaseItem(Item).Images := nil; + TSpkBaseItem(Item).DisabledImages := nil; + TSpkBaseItem(Item).LargeImages := nil; + TSpkBaseItem(Item).DisabledLargeImages := nil; + end; end; end; procedure TSpkItems.SetAppearance(const Value: TSpkToolbarAppearance); - -var i: Integer; - +var + i: Integer; begin FAppearance := Value; for i := 0 to Count - 1 do @@ -135,9 +136,8 @@ begin end; procedure TSpkItems.SetDisabledImages(const Value: TImageList); - -var i: Integer; - +var + i: Integer; begin FDisabledImages := Value; for i := 0 to Count - 1 do @@ -145,9 +145,8 @@ begin end; procedure TSpkItems.SetDisabledLargeImages(const Value: TImageList); - -var i: Integer; - +var + i: Integer; begin FDisabledLargeImages := Value; for i := 0 to Count - 1 do @@ -155,9 +154,8 @@ begin end; procedure TSpkItems.SetImages(const Value: TImageList); - -var i: Integer; - +var + i: Integer; begin FImages := Value; for i := 0 to Count - 1 do @@ -165,9 +163,8 @@ begin end; procedure TSpkItems.SetLargeImages(const Value: TImageList); - -var i: Integer; - +var + i: Integer; begin FLargeImages := Value; for i := 0 to Count - 1 do @@ -175,9 +172,8 @@ begin end; procedure TSpkItems.SetToolbarDispatch(const Value: TSpkBaseToolbarDispatch); - -var i : integer; - +var + i : integer; begin FToolbarDispatch := Value; for i := 0 to Count - 1 do @@ -187,8 +183,7 @@ end; procedure TSpkItems.Update; begin inherited Update; - - if assigned(FToolbarDispatch) then + if Assigned(FToolbarDispatch) then FToolbarDispatch.NotifyItemsChanged; end; diff --git a/components/spktoolbar/SpkToolbar/spkt_Pane.pas b/components/spktoolbar/SpkToolbar/spkt_Pane.pas index fe62faa40..270cea031 100644 --- a/components/spktoolbar/SpkToolbar/spkt_Pane.pas +++ b/components/spktoolbar/SpkToolbar/spkt_Pane.pas @@ -15,214 +15,218 @@ unit spkt_Pane; interface -uses Graphics, Controls, Classes, SysUtils, Math, Dialogs, - SpkGraphTools, SpkGUITools, SpkMath, - spkt_Appearance, spkt_Const, spkt_Dispatch, spkt_Exceptions, - spkt_BaseItem, spkt_Items, spkt_Types; +uses + Graphics, Controls, Classes, SysUtils, Math, Dialogs, + SpkGraphTools, SpkGUITools, SpkMath, + spkt_Appearance, spkt_Const, spkt_Dispatch, spkt_Exceptions, + spkt_BaseItem, spkt_Items, spkt_Types; -type TSpkPaneState = (psIdle, psHover); +type + TSpkPaneState = (psIdle, psHover); -type TSpkMousePaneElementType = (peNone, pePaneArea, peItem); + TSpkMousePaneElementType = (peNone, pePaneArea, peItem); - TSpkMousePaneElement = record - ElementType : TSpkMousePaneElementType; - ElementIndex : integer; - end; + TSpkMousePaneElement = record + ElementType: TSpkMousePaneElementType; + ElementIndex: integer; + end; - T2DIntRectArray = array of T2DIntRect; - TSpkPaneItemsLayout = record - Rects : T2DIntRectArray; - Width : integer; - end; + T2DIntRectArray = array of T2DIntRect; -type TSpkPane = class; + TSpkPaneItemsLayout = record + Rects: T2DIntRectArray; + Width: integer; + end; - TSpkPane = class(TSpkComponent) - private - FPaneState : TSpkPaneState; + TSpkPane = class; - FMouseHoverElement : TSpkMousePaneElement; - FMouseActiveElement : TSpkMousePaneElement; - protected - FCaption : string; - FRect : T2DIntRect; - FToolbarDispatch : TSpkBaseToolbarDispatch; - FAppearance : TSpkToolbarAppearance; - FImages : TImageList; - FDisabledImages : TImageList; - FLargeImages : TImageList; - FDisabledLargeImages : TImageList; - FVisible : boolean; - FItems : TSpkItems; + TSpkPane = class(TSpkComponent) + private + FPaneState: TSpkPaneState; + FMouseHoverElement: TSpkMousePaneElement; + FMouseActiveElement: TSpkMousePaneElement; + protected + FCaption: string; + FRect: T2DIntRect; + FToolbarDispatch: TSpkBaseToolbarDispatch; + FAppearance: TSpkToolbarAppearance; + FImages: TImageList; + FDisabledImages: TImageList; + FLargeImages: TImageList; + FDisabledLargeImages: TImageList; + FVisible: boolean; + FItems: TSpkItems; - // *** Generowanie layoutu elementów *** - function GenerateLayout: TSpkPaneItemsLayout; + // *** Generowanie layoutu elementów *** + function GenerateLayout: TSpkPaneItemsLayout; - // *** Obs³uga designtime i DFM *** - procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override; - procedure DefineProperties(Filer : TFiler); override; - procedure Loaded; override; + // *** Obs³uga designtime i DFM *** + procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override; + procedure DefineProperties(Filer : TFiler); override; + procedure Loaded; override; - // *** Gettery i settery *** - procedure SetCaption(const Value: string); - procedure SetVisible(const Value: boolean); - procedure SetAppearance(const Value: TSpkToolbarAppearance); - procedure SetImages(const Value: TImageList); - procedure SetDisabledImages(const Value : TImageList); - procedure SetLargeImages(const Value: TImageList); - procedure SetDisabledLargeImages(const Value : TImageList); - procedure SetRect(ARect : T2DIntRect); - procedure SetToolbarDispatch(const Value: TSpkBaseToolbarDispatch); - public - // *** Konstruktor, destruktor *** - constructor Create(AOwner : TComponent); override; - destructor Destroy; override; + // *** Gettery i settery *** + procedure SetCaption(const Value: string); + procedure SetVisible(const Value: boolean); + procedure SetAppearance(const Value: TSpkToolbarAppearance); + procedure SetImages(const Value: TImageList); + procedure SetDisabledImages(const Value: TImageList); + procedure SetLargeImages(const Value: TImageList); + procedure SetDisabledLargeImages(const Value: TImageList); + procedure SetRect(ARect : T2DIntRect); + procedure SetToolbarDispatch(const Value: TSpkBaseToolbarDispatch); - // *** Obs³uga gryzonia *** - procedure MouseLeave; - procedure MouseDown(Button: TMouseButton; Shift: TShiftState; - X, Y: Integer); - procedure MouseMove(Shift: TShiftState; X, Y: Integer); - procedure MouseUp(Button: TMouseButton; Shift: TShiftState; - X, Y: Integer); + public + // *** Konstruktor, destruktor *** + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; - // *** Geometria i rysowanie *** - function GetWidth : integer; - procedure Draw(ABuffer : TBitmap; ClipRect : T2DIntRect); - function FindItemAt(x, y: integer): integer; + // *** Obs³uga gryzonia *** + procedure MouseLeave; + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); + procedure MouseMove(Shift: TShiftState; X, Y: Integer); + procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); - // *** Obs³uga elementów *** - procedure FreeingItem(AItem : TSpkBaseItem); + // *** Geometria i rysowanie *** + function GetWidth: integer; + procedure Draw(ABuffer: TBitmap; ClipRect: T2DIntRect); + function FindItemAt(x, y: integer): integer; - property ToolbarDispatch : TSpkBaseToolbarDispatch read FToolbarDispatch write SetToolbarDispatch; - property Appearance : TSpkToolbarAppearance read FAppearance write SetAppearance; - property Rect : T2DIntRect read FRect write SetRect; - property Images : TImageList read FImages write SetImages; - property DisabledImages : TImageList read FDisabledImages write SetDisabledImages; - property LargeImages : TImageList read FLargeImages write SetLargeImages; - property DisabledLargeImages : TImageList read FDisabledLargeImages write SetDisabledLargeImages; - property Items : TSpkItems read FItems; - published - property Caption : string read FCaption write SetCaption; - property Visible : boolean read FVisible write SetVisible; - end; + // *** Obs³uga elementów *** + procedure FreeingItem(AItem: TSpkBaseItem); -type TSpkPanes = class(TSpkCollection) - private - protected - FToolbarDispatch : TSpkBaseToolbarDispatch; - FAppearance : TSpkToolbarAppearance; - FImages : TImageList; - FDisabledImages : TImageList; - FLargeImages : TImageList; - FDisabledLargeImages : TImageList; + property ToolbarDispatch: TSpkBaseToolbarDispatch read FToolbarDispatch write SetToolbarDispatch; + property Appearance: TSpkToolbarAppearance read FAppearance write SetAppearance; + property Rect: T2DIntRect read FRect write SetRect; + property Images: TImageList read FImages write SetImages; + property DisabledImages: TImageList read FDisabledImages write SetDisabledImages; + property LargeImages: TImageList read FLargeImages write SetLargeImages; + property DisabledLargeImages: TImageList read FDisabledLargeImages write SetDisabledLargeImages; + property Items: TSpkItems read FItems; - // *** Gettery i settery *** - procedure SetToolbarDispatch(const Value: TSpkBaseToolbarDispatch); - function GetItems(index: integer): TSpkPane; reintroduce; - procedure SetAppearance(const Value: TSpkToolbarAppearance); - procedure SetImages(const Value: TImageList); - procedure SetDisabledImages(const Value : TImageList); - procedure SetLargeImages(const Value: TImageList); - procedure SetDisabledLargeImages(const Value : TImageList); - public - // *** Dodawanie i wstawianie elementów *** - function Add : TSpkPane; - function Insert(index : integer) : TSpkPane; + published + property Caption: string read FCaption write SetCaption; + property Visible: boolean read FVisible write SetVisible; + end; - // *** Reakcja na zmiany listy *** - procedure Notify(Item: TComponent; Operation : TOperation); override; - procedure Update; override; + TSpkPanes = class(TSpkCollection) + private + protected + FToolbarDispatch: TSpkBaseToolbarDispatch; + FAppearance: TSpkToolbarAppearance; + FImages: TImageList; + FDisabledImages: TImageList; + FLargeImages: TImageList; + FDisabledLargeImages: TImageList; + + // *** Gettery i settery *** + procedure SetToolbarDispatch(const Value: TSpkBaseToolbarDispatch); + function GetItems(AIndex: integer): TSpkPane; reintroduce; + procedure SetAppearance(const Value: TSpkToolbarAppearance); + procedure SetImages(const Value: TImageList); + procedure SetDisabledImages(const Value: TImageList); + procedure SetLargeImages(const Value: TImageList); + procedure SetDisabledLargeImages(const Value: TImageList); + + public + // *** Dodawanie i wstawianie elementów *** + function Add: TSpkPane; + function Insert(AIndex: integer): TSpkPane; + + // *** Reakcja na zmiany listy *** + procedure Notify(Item: TComponent; Operation: TOperation); override; + procedure Update; override; + + property Items[index: integer]: TSpkPane read GetItems; default; + property ToolbarDispatch: TSpkBaseToolbarDispatch read FToolbarDispatch write SetToolbarDispatch; + property Appearance: TSpkToolbarAppearance read FAppearance write SetAppearance; + property Images: TImageList read FImages write SetImages; + property DisabledImages: TImageList read FDisabledImages write SetDisabledImages; + property LargeImages: TImageList read FLargeImages write SetLargeImages; + property DisabledLargeImages: TImageList read FDisabledLargeImages write SetDisabledLargeImages; + end; - property Items[index : integer] : TSpkPane read GetItems; default; - property ToolbarDispatch : TSpkBaseToolbarDispatch read FToolbarDispatch write SetToolbarDispatch; - property Appearance : TSpkToolbarAppearance read FAppearance write SetAppearance; - property Images : TImageList read FImages write SetImages; - property DisabledImages : TImageList read FDisabledImages write SetDisabledImages; - property LargeImages : TImageList read FLargeImages write SetLargeImages; - property DisabledLargeImages : TImageList read FDisabledLargeImages write SetDisabledLargeImages; - end; implementation { TSpkPane } -procedure TSpkPane.SetRect(ARect: T2DIntRect); - -var Pt : T2DIntPoint; - i : integer; - Layout : TSpkPaneItemsLayout; - -begin -FRect:=ARect; - -// Obliczamy layout -Layout:=GenerateLayout; - -{$IFDEF EnhancedRecordSupport} -Pt:=T2DIntPoint.create(ARect.left + SpkLayoutSizes.PANE_BORDER_SIZE + SpkLayoutSizes.PANE_LEFT_PADDING, ARect.top + SpkLayoutSizes.PANE_BORDER_SIZE); -{$ELSE} -Pt.create(ARect.left + PaneBorderSize + PaneLeftPadding, ARect.top + PaneBorderSize); -{$ENDIF} - -if length(Layout.Rects)>0 then - begin - for i := 0 to high(Layout.Rects) do - FItems[i].Rect:=Layout.Rects[i] + Pt; - end; -end; - -procedure TSpkPane.SetToolbarDispatch(const Value: TSpkBaseToolbarDispatch); - -begin - FToolbarDispatch := Value; - FItems.ToolbarDispatch:=FToolbarDispatch; -end; - -constructor TSpkPane.Create(AOwner : TComponent); +constructor TSpkPane.Create(AOwner: TComponent); begin inherited Create(AOwner); - FPaneState:=psIdle; - FMouseHoverElement.ElementType:=peNone; - FMouseHoverElement.ElementIndex:=-1; - FMouseActiveElement.ElementType:=peNone; - FMouseActiveElement.ElementIndex:=-1; + FPaneState := psIdle; + FMouseHoverElement.ElementType := peNone; + FMouseHoverElement.ElementIndex := -1; + FMouseActiveElement.ElementType := peNone; + FMouseActiveElement.ElementIndex := -1; - FCaption:='Pane'; + FCaption := 'Pane'; {$IFDEF EnhancedRecordSupport} - FRect:=T2DIntRect.create(0,0,0,0); + FRect := T2DIntRect.Create(0,0,0,0); {$ELSE} - FRect.create(0,0,0,0); + FRect.Create(0,0,0,0); {$ENDIF} - FToolbarDispatch:=nil; - FAppearance:=nil; - FImages:=nil; - FDisabledImages:=nil; - FLargeImages:=nil; - FDisabledLargeImages:=nil; + FToolbarDispatch := nil; + FAppearance := nil; + FImages := nil; + FDisabledImages := nil; + FLargeImages := nil; + FDisabledLargeImages := nil; - FVisible:=true; + FVisible := true; - FItems:=TSpkItems.Create(self); - FItems.ToolbarDispatch:=FToolbarDispatch; - FItems.Appearance:=FAppearance; -end; - -procedure TSpkPane.DefineProperties(Filer: TFiler); -begin - inherited DefineProperties(Filer); - - Filer.DefineProperty('Items',FItems.ReadNames,FItems.WriteNames,true); + FItems := TSpkItems.Create(self); + FItems.ToolbarDispatch := FToolbarDispatch; + FItems.Appearance := FAppearance; end; destructor TSpkPane.Destroy; begin FItems.Free; - inherited Destroy; end; +procedure TSpkPane.SetRect(ARect: T2DIntRect); +var + Pt: T2DIntPoint; + i: integer; + Layout: TSpkPaneItemsLayout; +begin + FRect := ARect; + + // Obliczamy layout + Layout := GenerateLayout; + + {$IFDEF EnhancedRecordSupport} + Pt := T2DIntPoint.Create( + {$ELSE} + Pt.Create( + {$ENDIF} + ARect.Left + PaneBorderSize + PaneLeftPadding, + ARect.Top + PaneBorderSize + ); + + if Length(Layout.Rects) > 0 then + begin + for i := 0 to High(Layout.Rects) do + FItems[i].Rect:=Layout.Rects[i] + Pt; + end; +end; + +procedure TSpkPane.SetToolbarDispatch(const Value: TSpkBaseToolbarDispatch); +begin + FToolbarDispatch := Value; + FItems.ToolbarDispatch := FToolbarDispatch; +end; + + +procedure TSpkPane.DefineProperties(Filer: TFiler); +begin + inherited DefineProperties(Filer); + Filer.DefineProperty('Items', FItems.ReadNames, FItems.WriteNames, true); +end; + procedure TSpkPane.Draw(ABuffer: TBitmap; ClipRect: T2DIntRect); var x: Integer; @@ -238,6 +242,7 @@ begin // * Brak dyspozytora if FToolbarDispatch = nil then exit; + // * Brak appearance if FAppearance = nil then exit; @@ -328,48 +333,6 @@ begin case FAppearance.Pane.Style of psRectangleFlat: begin - {$IFDEF EnhancedRecordSupport} - R := T2DIntRect.Create( - {$ELSE} - R := Create2DIntRect( - {$ENDIF} - FRect.Left, - FRect.Top, - FRect.Right, - FRect.bottom - ); - TGUITools.DrawAARoundFrame( - ABuffer, - R, - PaneCornerRadius, - BorderDarkColor, - ClipRect - ); - end; - - psRectangleEtched, psRectangleRaised: - begin - {$IFDEF EnhancedRecordSupport} - R := T2DIntRect.Create( - {$ELSE} - R := Create2DIntRect( - {$ENDIF} - FRect.Left + 1, - FRect.Top + 1, - FRect.Right, - FRect.bottom - ); - if FAppearance.Pane.Style = psRectangleEtched then - c := BorderLightColor else - c := BorderDarkColor; - TGUITools.DrawAARoundFrame( - ABuffer, - R, - PaneCornerRadius, - c, - ClipRect - ); - {$IFDEF EnhancedRecordSupport} R := T2DIntRect.Create( {$ELSE} @@ -377,134 +340,174 @@ begin {$ENDIF} FRect.Left, FRect.Top, - FRect.Right-1, - FRect.Bottom-1 + FRect.Right, + FRect.bottom ); - if FAppearance.Pane.Style = psRectangleEtched then - c := BorderDarkColor else - c := BorderLightColor; TGUITools.DrawAARoundFrame( ABuffer, R, PaneCornerRadius, - c, + BorderDarkColor, ClipRect ); - end; + end; - psDividerRaised, psDividerEtched: - begin - if FAppearance.Pane.Style = psDividerRaised then - c := BorderLightColor else - c := BorderDarkColor; - TGUITools.DrawVLine( - ABuffer, - FRect.Right + PaneBorderHalfSize - 1, - FRect.Top, - FRect.Bottom, - c - ); - if FAppearance.Pane.Style = psDividerRaised then - c := BorderDarkColor else - c := BorderLightColor; - TGUITools.DrawVLine( - ABuffer, - FRect.Right + PaneBorderHalfSize, - FRect.Top, - FRect.Bottom, - c - ); - end; + psRectangleEtched, psRectangleRaised: + begin + {$IFDEF EnhancedRecordSupport} + R := T2DIntRect.Create( + {$ELSE} + R := Create2DIntRect( + {$ENDIF} + FRect.Left + 1, + FRect.Top + 1, + FRect.Right, + FRect.bottom + ); + if FAppearance.Pane.Style = psRectangleEtched then + c := BorderLightColor else + c := BorderDarkColor; + TGUITools.DrawAARoundFrame( + ABuffer, + R, + PaneCornerRadius, + c, + ClipRect + ); - psDividerFlat: + {$IFDEF EnhancedRecordSupport} + R := T2DIntRect.Create( + {$ELSE} + R := Create2DIntRect( + {$ENDIF} + FRect.Left, + FRect.Top, + FRect.Right-1, + FRect.Bottom-1 + ); + if FAppearance.Pane.Style = psRectangleEtched then + c := BorderDarkColor else + c := BorderLightColor; + TGUITools.DrawAARoundFrame( + ABuffer, + R, + PaneCornerRadius, + c, + ClipRect + ); + end; + + psDividerRaised, psDividerEtched: + begin + if FAppearance.Pane.Style = psDividerRaised then + c := BorderLightColor else + c := BorderDarkColor; + TGUITools.DrawVLine( + ABuffer, + FRect.Right + PaneBorderHalfSize - 1, + FRect.Top, + FRect.Bottom, + c + ); + if FAppearance.Pane.Style = psDividerRaised then + c := BorderDarkColor else + c := BorderLightColor; TGUITools.DrawVLine( ABuffer, FRect.Right + PaneBorderHalfSize, FRect.Top, FRect.Bottom, - BorderDarkColor - ); + c + ); + end; + + psDividerFlat: + TGUITools.DrawVLine( + ABuffer, + FRect.Right + PaneBorderHalfSize, + FRect.Top, + FRect.Bottom, + BorderDarkColor + ); end; // Elementy for i := 0 to FItems.Count - 1 do if FItems[i].Visible then - Fitems[i].Draw(ABuffer, ClipRect); + FItems[i].Draw(ABuffer, ClipRect); end; -function TSpkPane.FindItemAt(x, y : integer) : integer; - -var i : integer; - +function TSpkPane.FindItemAt(x, y: integer): integer; +var + i: integer; begin -result:=-1; -i:=FItems.count-1; -while (i>=0) and (result=-1) do - begin - if FItems[i].Visible then - begin - {$IFDEF EnhancedRecordSupport} - if FItems[i].Rect.Contains(T2DIntVector.create(x,y)) then - {$ELSE} - if FItems[i].Rect.Contains(x,y) then - {$ENDIF} - result:=i; - end; - dec(i); - end; + result := -1; + i := FItems.count-1; + while (i >= 0) and (result = -1) do + begin + if FItems[i].Visible then + begin + {$IFDEF EnhancedRecordSupport} + if FItems[i].Rect.Contains(T2DIntVector.create(x,y)) then + {$ELSE} + if FItems[i].Rect.Contains(x,y) then + {$ENDIF} + Result := i; + end; + dec(i); + end; end; procedure TSpkPane.FreeingItem(AItem: TSpkBaseItem); begin -FItems.RemoveReference(AItem); + FItems.RemoveReference(AItem); end; function TSpkPane.GenerateLayout: TSpkPaneItemsLayout; - -type TLayoutRow = array of integer; - TLayoutColumn = array of TLayoutRow; - TLayout = array of TLayoutColumn; - -var Layout : TLayout; - CurrentColumn : integer; - CurrentRow : integer; - CurrentItem : integer; - c, r, i: Integer; - ItemTableBehaviour : TSpkItemTableBehaviour; - ItemGroupBehaviour : TSpkItemGroupBehaviour; - ItemSize : TSpkItemSize; - ForceNewColumn : boolean; - LastX : integer; - MaxRowX : integer; - ColumnX : integer; - rows: Integer; - ItemWidth: Integer; - tmpRect : T2DIntRect; - +type + TLayoutRow = array of integer; + TLayoutColumn = array of TLayoutRow; + TLayout = array of TLayoutColumn; +var + Layout: TLayout; + CurrentColumn: integer; + CurrentRow: integer; + CurrentItem: integer; + c, r, i: Integer; + ItemTableBehaviour: TSpkItemTableBehaviour; + ItemGroupBehaviour: TSpkItemGroupBehaviour; + ItemSize: TSpkItemSize; + ForceNewColumn: boolean; + LastX: integer; + MaxRowX: integer; + ColumnX: integer; + rows: Integer; + ItemWidth: Integer; + tmpRect: T2DIntRect; begin -setlength(result.Rects,FItems.count); -result.Width:=0; + SetLength(Result.Rects, FItems.count); + Result.Width := 0; -if FItems.count=0 then - exit; + if FItems.Count = 0 then + exit; -// Notatka: algorytm jest skonstruowany w ten sposób, ¿e trójka: CurrentColumn, -// CurrentRow oraz CurrentItem wskazuje na element, którego jeszcze nie -// ma (zaraz za ostatnio dodanym elementem). + // Notatka: algorytm jest skonstruowany w ten sposób, ¿e trójka: CurrentColumn, + // CurrentRow oraz CurrentItem wskazuje na element, którego jeszcze nie + // ma (zaraz za ostatnio dodanym elementem). -setlength(Layout,1); -CurrentColumn:=0; + SetLength(Layout, 1); + CurrentColumn := 0; -setlength(Layout[CurrentColumn],1); -CurrentRow:=0; + SetLength(Layout[CurrentColumn], 1); + CurrentRow := 0; -setlength(Layout[CurrentColumn][CurrentRow],0); -CurrentItem:=0; + SetLength(Layout[CurrentColumn][CurrentRow], 0); + CurrentItem := 0; -ForceNewColumn:=false; + ForceNewColumn := false; -for i := 0 to FItems.count - 1 do - begin + for i := 0 to FItems.Count - 1 do + begin ItemTableBehaviour := FItems[i].GetTableBehaviour; ItemSize := FItems[i].GetSize; @@ -514,211 +517,202 @@ for i := 0 to FItems.count - 1 do (ItemTableBehaviour = tbBeginsColumn) or ((ItemTableBehaviour = tbBeginsRow) and (CurrentRow = 2)) or (ForceNewColumn) then - begin - // Jeœli ju¿ jesteœmy na pocz¹tku nowej kolumny, nie ma nic do roboty. - if (CurrentRow<>0) or (CurrentItem<>0) then - begin - setlength(Layout, length(Layout)+1); - CurrentColumn:=high(Layout); + begin + // Jeœli ju¿ jesteœmy na pocz¹tku nowej kolumny, nie ma nic do roboty. + if (CurrentRow <> 0) or (CurrentItem <> 0) then + begin + SetLength(Layout, Length(Layout)+1); + CurrentColumn := High(Layout); - setlength(Layout[CurrentColumn], 1); - CurrentRow:=0; + SetLength(Layout[CurrentColumn], 1); + CurrentRow := 0; - setlength(Layout[CurrentColumn][CurrentRow],0); - CurrentItem:=0; - end; - end else + SetLength(Layout[CurrentColumn][CurrentRow], 0); + CurrentItem := 0; + end; + end else // Rozpoczêcie nowego wiersza? if (ItemTableBehaviour = tbBeginsRow) then - begin - // Jeœli ju¿ jesteœmy na pocz¹tku nowego wiersza, nie ma nic do roboty. - if CurrentItem <> 0 then - begin - setlength(Layout[CurrentColumn], length(Layout[CurrentColumn])+1); - inc(CurrentRow); - CurrentItem:=0; - end; - end; + begin + // Jeœli ju¿ jesteœmy na pocz¹tku nowego wiersza, nie ma nic do roboty. + if CurrentItem <> 0 then + begin + SetLength(Layout[CurrentColumn], Length(Layout[CurrentColumn])+1); + inc(CurrentRow); + CurrentItem := 0; + end; + end; - ForceNewColumn:=ItemSize = isLarge; + ForceNewColumn := (ItemSize = isLarge); // Jeœli element jest widoczny, dodajemy go w aktualnej kolumnie i aktualnym // wierszu. if FItems[i].Visible then - begin - setlength(Layout[CurrentColumn][CurrentRow], length(Layout[CurrentColumn][CurrentRow])+1); - Layout[CurrentColumn][CurrentRow][CurrentItem]:=i; + begin + SetLength(Layout[CurrentColumn][CurrentRow], Length(Layout[CurrentColumn][CurrentRow])+1); + Layout[CurrentColumn][CurrentRow][CurrentItem] := i; - inc(CurrentItem); - end; + inc(CurrentItem); + end; + end; + + // W tym miejscu mamy gotowy layout. Teraz trzeba obliczyæ pozycje i rozmiary + // Rectów. + + // Najpierw wype³niamy je pustymi danymi, które zape³ni¹ miejsce elementów + // niewidocznych. + {$IFDEF EnhancedRecordSupport} + for i := 0 to FItems.Count - 1 do + Result.Rects[i] := T2DIntRect.Create(-1, -1, -1, -1); + {$ELSE} + for i := 0 to FItems.Count - 1 do + Result.Rects[i].Create(-1, -1, -1, -1); + {$ENDIF} + + MaxRowX := 0; + + // Teraz iterujemy po layoucie, ustalaj¹c recty. + for c := 0 to High(Layout) do + begin + if c>0 then + begin + LastX := MaxRowX + PaneColumnSpacer; + MaxRowX := LastX; + end + else + begin + LastX := MaxRowX; end; -// W tym miejscu mamy gotowy layout. Teraz trzeba obliczyæ pozycje i rozmiary -// Rectów. + ColumnX := LastX; -// Najpierw wype³niamy je pustymi danymi, które zape³ni¹ miejsce elementów -// niewidocznych. -{$IFDEF EnhancedRecordSupport} -for i := 0 to FItems.count - 1 do - result.Rects[i]:=T2DIntRect.create(-1, -1, -1, -1); -{$ELSE} -for i := 0 to FItems.count - 1 do - result.Rects[i].create(-1, -1, -1, -1); -{$ENDIF} + rows := Length(Layout[c]); + for r := 0 to rows - 1 do + begin + LastX := ColumnX; -MaxRowX:=0; + for i := 0 to High(Layout[c][r]) do + begin + ItemGroupBehaviour := FItems[Layout[c][r][i]].GetGroupBehaviour; + ItemSize := FItems[Layout[c][r][i]].GetSize; + ItemWidth := FItems[Layout[c][r][i]].GetWidth; -// Teraz iterujemy po layoucie, ustalaj¹c recty. -if length(Layout)>0 then - for c := 0 to high(Layout) do - begin - if c>0 then + if ItemSize = isLarge then + begin + tmpRect.Top := PaneFullRowTopPadding; + tmpRect.Bottom := tmpRect.Top + PaneFullRowHeight - 1; + tmpRect.Left := LastX; + tmpRect.Right := LastX + ItemWidth - 1; + + LastX := tmpRect.Right + 1; + if LastX > MaxRowX then + MaxRowX := LastX; + end + else + begin + if ItemGroupBehaviour in [gbContinuesGroup, gbEndsGroup] then begin - LastX:=MaxRowX + PaneColumnSpacer; - MaxRowX:=LastX; + tmpRect.Left := LastX; + tmpRect.Right := tmpRect.Left + ItemWidth - 1; end - else + else begin - LastX:=MaxRowX; + // Jeœli element nie jest pierwszy, musi zostaæ + // odsuniêty marginesem od poprzedniego + if i>0 then + tmpRect.Left := LastX + PaneGroupSpacer + else + tmpRect.Left := LastX; + tmpRect.Right := tmpRect.Left + ItemWidth - 1; end; - ColumnX:=LastX; + {$REGION 'Obliczanie tmpRect.top i bottom'} + case rows of + 1 : begin + tmpRect.Top := PaneOneRowTopPadding; + tmpRect.Bottom := tmpRect.Top + PaneRowHeight - 1; + end; + 2 : case r of + 0 : begin + tmpRect.Top := PaneTwoRowsTopPadding; + tmpRect.Bottom := tmpRect.top + PaneRowHeight - 1; + end; + 1 : begin + tmpRect.Top := PaneTwoRowsTopPadding + PaneRowHeight + PaneTwoRowsVSpacer; + tmpRect.Bottom := tmpRect.top + PaneRowHeight - 1; + end; + end; + 3 : case r of + 0 : begin + tmpRect.Top := PaneThreeRowsTopPadding; + tmpRect.Bottom := tmpRect.Top + PaneRowHeight - 1; + end; + 1 : begin + tmpRect.Top := PaneThreeRowsTopPadding + PaneRowHeight + PaneThreeRowsVSpacer; + tmpRect.Bottom := tmpRect.Top + PaneRowHeight - 1; + end; + 2 : begin + tmpRect.Top := PaneThreeRowsTopPadding + 2 * PaneRowHeight + 2 * PaneThreeRowsVSpacer; + tmpRect.Bottom := tmpRect.Top + PaneRowHeight - 1; + end; + end; + end; + {$ENDREGION} - rows:=length(Layout[c]); - if rows>0 then - for r := 0 to rows - 1 do - begin - LastX:=ColumnX; + LastX := tmpRect.right + 1; + if LastX > MaxRowX then + MaxRowX:=LastX; + end; - if length(Layout[c][r])>0 then - for i := 0 to high(Layout[c][r]) do - begin - ItemGroupBehaviour:=FItems[Layout[c][r][i]].GetGroupBehaviour; - ItemSize:=FItems[Layout[c][r][i]].GetSize; - ItemWidth:=FItems[Layout[c][r][i]].GetWidth; - - if ItemSize = isLarge then - begin - tmpRect.top:=PaneFullRowTopPadding; - tmpRect.bottom:=tmpRect.top + PaneFullRowHeight - 1; - tmpRect.left:=LastX; - tmpRect.right:=LastX + ItemWidth - 1; - - LastX:=tmpRect.right + 1; - if LastX>MaxRowX then - MaxRowX:=LastX; - end - else - begin - if ItemGroupBehaviour in [gbContinuesGroup, gbEndsGroup] then - begin - tmpRect.Left:=LastX; - tmpRect.right:=tmpRect.Left + ItemWidth - 1; - end - else - begin - // Jeœli element nie jest pierwszy, musi zostaæ - // odsuniêty marginesem od poprzedniego - if i>0 then - tmpRect.Left:=LastX + PaneGroupSpacer else - tmpRect.Left:=LastX; - tmpRect.right:=tmpRect.Left + ItemWidth - 1; - end; - - {$REGION 'Obliczanie tmpRect.top i bottom'} - case rows of - 1 : begin - tmpRect.top:=PaneOneRowTopPadding; - tmpRect.bottom:=tmpRect.top + PaneRowHeight - 1; - end; - 2 : begin - case r of - 0 : begin - tmpRect.top:=PaneTwoRowsTopPadding; - tmpRect.bottom:=tmpRect.top + PaneRowHeight - 1; - end; - 1 : begin - tmpRect.top:=PaneTwoRowsTopPadding + PaneRowHeight + PaneTwoRowsVSpacer; - tmpRect.bottom:=tmpRect.top + PaneRowHeight - 1; - end; - end; - end; - 3 : begin - case r of - 0 : begin - tmpRect.top:=PaneThreeRowsTopPadding; - tmpRect.bottom:=tmpRect.top + PaneRowHeight - 1; - end; - 1 : begin - tmpRect.top:=PaneThreeRowsTopPadding + PaneRowHeight + PaneThreeRowsVSpacer; - tmpRect.bottom:=tmpRect.top + PaneRowHeight - 1; - end; - 2 : begin - tmpRect.top:=PaneThreeRowsTopPadding + 2 * PaneRowHeight + 2 * PaneThreeRowsVSpacer; - tmpRect.bottom:=tmpRect.top + PaneRowHeight - 1; - end; - end; - end; - end; - {$ENDREGION} - - LastX:=tmpRect.right + 1; - if LastX>MaxRowX then - MaxRowX:=LastX; - end; - - Result.Rects[Layout[c][r][i]]:=tmpRect; - end; - end; - end; -// W tym miejscu MaxRowX wskazuje na pierwszy piksel za najbardziej wysuniêtym -// w prawo elementem - ergo jest równy szerokoœci ca³ego layoutu. -Result.Width:=MaxRowX; + Result.Rects[Layout[c][r][i]] := tmpRect; + end; + end; + end; + // W tym miejscu MaxRowX wskazuje na pierwszy piksel za najbardziej wysuniêtym + // w prawo elementem - ergo jest równy szerokoœci ca³ego layoutu. + Result.Width := MaxRowX; end; procedure TSpkPane.GetChildren(Proc: TGetChildProc; Root: TComponent); var i: Integer; begin -inherited; - -if FItems.Count>0 then - for i := 0 to FItems.Count - 1 do - Proc(FItems.Items[i]); + inherited; + for i := 0 to FItems.Count - 1 do + Proc(FItems.Items[i]); end; function TSpkPane.GetWidth: integer; - -var tmpBitmap : TBitmap; - PaneCaptionWidth, PaneElementsWidth : integer; - TextW : integer; - ElementsW : integer; - Layout : TSpkPaneItemsLayout; - +var + tmpBitmap: TBitmap; + PaneCaptionWidth, PaneElementsWidth: integer; + TextW: integer; + ElementsW: integer; + Layout: TSpkPaneItemsLayout; begin -// Przygotowywanie... -result:=-1; -if FToolbarDispatch=nil then - exit; -if FAppearance=nil then - exit; + // Przygotowywanie... + Result := -1; + if FToolbarDispatch = nil then + exit; + if FAppearance = nil then + exit; -tmpBitmap:=FToolbarDispatch.GetTempBitmap; -if tmpBitmap=nil then - exit; -tmpBitmap.Canvas.font.assign(FAppearance.Pane.CaptionFont); + tmpBitmap := FToolbarDispatch.GetTempBitmap; + if tmpBitmap = nil then + exit; + tmpBitmap.Canvas.Font.Assign(FAppearance.Pane.CaptionFont); -// *** Minimalna szerokoœæ tafli (tekstu) *** -TextW:=tmpBitmap.Canvas.TextWidth(FCaption); -PaneCaptionWidth := 2*PaneBorderSize + 2*PaneCaptionHMargin + TextW; + // *** Minimalna szerokoœæ tafli (tekstu) *** + TextW := tmpBitmap.Canvas.TextWidth(FCaption); + PaneCaptionWidth := 2*PaneBorderSize + 2*PaneCaptionHMargin + TextW; -// *** Szerokoœæ elementów tafli *** -Layout:=GenerateLayout; -ElementsW:=Layout.Width; -PaneElementsWidth:=PaneBorderSize + PaneLeftPadding + ElementsW + PaneRightPadding + PaneBorderSize; + // *** Szerokoœæ elementów tafli *** + Layout := GenerateLayout; + ElementsW := Layout.Width; + PaneElementsWidth := PaneBorderSize + PaneLeftPadding + ElementsW + PaneRightPadding + PaneBorderSize; -// *** Ustawianie szerokoœci tafli *** -result:=max(PaneCaptionWidth, PaneElementsWidth); + // *** Ustawianie szerokoœci tafli *** + Result := Max(PaneCaptionWidth, PaneElementsWidth); end; procedure TSpkPane.Loaded; @@ -728,206 +722,202 @@ begin FItems.ProcessNames(self.Owner); end; -procedure TSpkPane.MouseDown(Button: TMouseButton; Shift: TShiftState; X, - Y: Integer); +procedure TSpkPane.MouseDown(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); begin -if FMouseActiveElement.ElementType = peItem then - begin - if FMouseActiveElement.ElementIndex<>-1 then + if FMouseActiveElement.ElementType = peItem then + begin + if FMouseActiveElement.ElementIndex <> -1 then FItems[FMouseActiveElement.ElementIndex].MouseDown(Button, Shift, X, Y); - end else -if FMouseActiveElement.ElementType = pePaneArea then - begin - FPaneState:=psHover; - end else -if FMouseActiveElement.ElementType = peNone then - begin - if FMouseHoverElement.ElementType = peItem then + end else + if FMouseActiveElement.ElementType = pePaneArea then + begin + FPaneState := psHover; + end else + if FMouseActiveElement.ElementType = peNone then + begin + if FMouseHoverElement.ElementType = peItem then + begin + if FMouseHoverElement.ElementIndex <> -1 then begin - if FMouseHoverElement.ElementIndex<>-1 then - begin - FMouseActiveElement.ElementType:=peItem; - FMouseActiveElement.ElementIndex:=FMouseHoverElement.ElementIndex; - - FItems[FMouseHoverElement.ElementIndex].MouseDown(Button, Shift, X, Y); - end + FMouseActiveElement.ElementType := peItem; + FMouseActiveElement.ElementIndex := FMouseHoverElement.ElementIndex; + FItems[FMouseHoverElement.ElementIndex].MouseDown(Button, Shift, X, Y); + end else - begin - FMouseActiveElement.ElementType:=pePaneArea; - FMouseActiveElement.ElementIndex:=-1; - end; - end else - if FMouseHoverElement.ElementType = pePaneArea then begin - FMouseActiveElement.ElementType:=pePaneArea; - FMouseActiveElement.ElementIndex:=-1; - - // Placeholder, jeœli zajdzie potrzeba obs³ugi tego zdarzenia. + FMouseActiveElement.ElementType := pePaneArea; + FMouseActiveElement.ElementIndex := -1; end; - end; + end else + if FMouseHoverElement.ElementType = pePaneArea then + begin + FMouseActiveElement.ElementType := pePaneArea; + FMouseActiveElement.ElementIndex := -1; + // Placeholder, jeœli zajdzie potrzeba obs³ugi tego zdarzenia. + end; + end; end; procedure TSpkPane.MouseLeave; begin -if FMouseActiveElement.ElementType = peNone then - begin - if FMouseHoverElement.ElementType = peItem then - begin - if FMouseHoverElement.ElementIndex<>-1 then - FItems[FMouseHoverElement.ElementIndex].MouseLeave; - end else - if FMouseHoverElement.ElementType = pePaneArea then - begin + if FMouseActiveElement.ElementType = peNone then + begin + if FMouseHoverElement.ElementType = peItem then + begin + if FMouseHoverElement.ElementIndex <> -1 then + FItems[FMouseHoverElement.ElementIndex].MouseLeave; + end else + if FMouseHoverElement.ElementType = pePaneArea then + begin // Placeholder, jeœli zajdzie potrzeba obs³ugi tego zdarzenia. - end; - end; + end; + end; -FMouseHoverElement.ElementType:=peNone; -FMouseHoverElement.ElementIndex:=-1; + FMouseHoverElement.ElementType := peNone; + FMouseHoverElement.ElementIndex := -1; -// Niezale¿nie od tego, który element by³ aktywny / pod mysz¹, trzeba -// wygasiæ HotTrack. -if FPaneState<>psIdle then - begin - FPaneState:=psIdle; - if assigned(FToolbarDispatch) then + // Niezale¿nie od tego, który element by³ aktywny / pod mysz¹, trzeba + // wygasiæ HotTrack. + if FPaneState <> psIdle then + begin + FPaneState := psIdle; + if Assigned(FToolbarDispatch) then FToolbarDispatch.NotifyVisualsChanged; - end; + end; end; procedure TSpkPane.MouseMove(Shift: TShiftState; X, Y: Integer); - -var i : integer; - NewMouseHoverElement : TSpkMousePaneElement; - +var + i: integer; + NewMouseHoverElement: TSpkMousePaneElement; begin -// MouseMove jest wywo³ywany tylko, gdy tafla jest aktywna, b¹dŸ gdy -// mysz rusza siê wewn¹trz jej obszaru. Wobec tego zawsze nale¿y -// w tej sytuacji zapaliæ HotTrack. + // MouseMove jest wywo³ywany tylko, gdy tafla jest aktywna, b¹dŸ gdy + // mysz rusza siê wewn¹trz jej obszaru. Wobec tego zawsze nale¿y + // w tej sytuacji zapaliæ HotTrack. -if FPaneState = psIdle then - begin - FPaneState:=psHover; - if assigned(FToolbarDispatch) then + if FPaneState = psIdle then + begin + FPaneState := psHover; + if Assigned(FToolbarDispatch) then FToolbarDispatch.NotifyVisualsChanged; - end; + end; -// Szukamy obiektu pod mysz¹ -i:=FindItemAt(x, y); -if i<>-1 then - begin - NewMouseHoverElement.ElementType:=peItem; - NewMouseHoverElement.ElementIndex:=i; - end else -if (X>=FRect.left) and (Y>=FRect.top) and - (X<=FRect.right) and (Y<=FRect.bottom) then - begin - NewMouseHoverElement.ElementType:=pePaneArea; - NewMouseHoverElement.ElementIndex:=-1; - end else - begin - NewMouseHoverElement.ElementType:=peNone; - NewMouseHoverElement.ElementIndex:=-1; - end; + // Szukamy obiektu pod mysz¹ + i := FindItemAt(X, Y); + if i <> -1 then + begin + NewMouseHoverElement.ElementType := peItem; + NewMouseHoverElement.ElementIndex := i; + end else + if (X >= FRect.Left) and (Y >= FRect.Top) and + (X <= FRect.Right) and (Y <= FRect.Bottom) then + begin + NewMouseHoverElement.ElementType := pePaneArea; + NewMouseHoverElement.ElementIndex := -1; + end else + begin + NewMouseHoverElement.ElementType := peNone; + NewMouseHoverElement.ElementIndex := -1; + end; -if FMouseActiveElement.ElementType = peItem then - begin - if FMouseActiveElement.ElementIndex<>-1 then + if FMouseActiveElement.ElementType = peItem then + begin + if FMouseActiveElement.ElementIndex <> -1 then FItems[FMouseActiveElement.ElementIndex].MouseMove(Shift, X, Y); - end else -if FMouseActiveElement.ElementType = pePaneArea then - begin - // Placeholder, jeœli zajdzie potrzeba obs³ugi tego zdarzenia - end else -if FMouseActiveElement.ElementType = peNone then - begin - // Jeœli element pod mysz¹ siê zmienia, informujemy poprzedni element o - // tym, ¿e mysz opuszcza jego obszar - if (NewMouseHoverElement.ElementType<>FMouseHoverElement.ELementType) or - (NewMouseHoverElement.ElementIndex<>FMouseHoverElement.ElementIndex) then - begin + end else + if FMouseActiveElement.ElementType = pePaneArea then + begin + // Placeholder, jeœli zajdzie potrzeba obs³ugi tego zdarzenia + end else + if FMouseActiveElement.ElementType = peNone then + begin + // Jeœli element pod mysz¹ siê zmienia, informujemy poprzedni element o + // tym, ¿e mysz opuszcza jego obszar + if (NewMouseHoverElement.ElementType <> FMouseHoverElement.ELementType) or + (NewMouseHoverElement.ElementIndex <> FMouseHoverElement.ElementIndex) then + begin if FMouseHoverElement.ElementType = peItem then - begin - if FMouseHoverElement.ElementIndex<>-1 then - FItems[FMouseHoverElement.ElementIndex].MouseLeave; - end else - if FMouseHoverElement.ElementType = pePaneArea then - begin - // Placeholder, jeœli zajdzie potrzeba obs³ugi tego zdarzenia - end; - end; - - if NewMouseHoverElement.ElementType = peItem then begin - if NewMouseHoverElement.ElementIndex<>-1 then - FItems[NewMouseHoverElement.ElementIndex].MouseMove(Shift, X, Y); + if FMouseHoverElement.ElementIndex <> -1 then + FItems[FMouseHoverElement.ElementIndex].MouseLeave; end else - if NewMouseHoverElement.ElementType = pePaneArea then + if FMouseHoverElement.ElementType = pePaneArea then begin - // Placeholder, jeœli zajdzie potrzeba obs³ugi tego zdarzenia + // Placeholder, jeœli zajdzie potrzeba obs³ugi tego zdarzenia end; - end; + end; -FMouseHoverElement:=NewMouseHoverElement; + if NewMouseHoverElement.ElementType = peItem then + begin + if NewMouseHoverElement.ElementIndex <> -1 then + FItems[NewMouseHoverElement.ElementIndex].MouseMove(Shift, X, Y); + end else + if NewMouseHoverElement.ElementType = pePaneArea then + begin + // Placeholder, jeœli zajdzie potrzeba obs³ugi tego zdarzenia + end; + end; + + FMouseHoverElement := NewMouseHoverElement; end; -procedure TSpkPane.MouseUp(Button: TMouseButton; Shift: TShiftState; X, - Y: Integer); - -var ClearActive : boolean; - +procedure TSpkPane.MouseUp(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); +var + ClearActive: boolean; begin -ClearActive:=not(ssLeft in Shift) and not(ssMiddle in Shift) and not(ssRight in Shift); + ClearActive := not (ssLeft in Shift) and not (ssMiddle in Shift) and not (ssRight in Shift); -if FMouseActiveElement.ElementType = peItem then - begin - if FMouseActiveElement.ElementIndex<>-1 then + if FMouseActiveElement.ElementType = peItem then + begin + if FMouseActiveElement.ElementIndex <> -1 then FItems[FMouseActiveElement.ElementIndex].MouseUp(Button, Shift, X, Y); - end else -if FMouseActiveElement.ElementType = pePaneArea then - begin - // Placeholder, jeœli zajdzie potrzeba obs³ugi tego zdarzenia. - end; + end else + if FMouseActiveElement.ElementType = pePaneArea then + begin + // Placeholder, jeœli zajdzie potrzeba obs³ugi tego zdarzenia. + end; -if ClearActive and - (FMouseActiveElement.ElementType<>FMouseHoverElement.ElementType) or - (FMouseActiveElement.ElementIndex<>FMouseHoverElement.ElementIndex) then - begin - if FMouseActiveElement.ElementType = peItem then - begin - if FMouseActiveElement.ElementIndex<>-1 then - FItems[FMouseActiveElement.ElementIndex].MouseLeave; - end else - if FMouseActiveElement.ElementType = pePaneArea then - begin + if ClearActive and + (FMouseActiveElement.ElementType <> FMouseHoverElement.ElementType) or + (FMouseActiveElement.ElementIndex <> FMouseHoverElement.ElementIndex) then + begin + if FMouseActiveElement.ElementType = peItem then + begin + if FMouseActiveElement.ElementIndex <> -1 then + FItems[FMouseActiveElement.ElementIndex].MouseLeave; + end else + if FMouseActiveElement.ElementType = pePaneArea then + begin // Placeholder, jeœli zajdzie potrzeba obs³ugi tego zdarzenia. - end; + end; - if FMouseHoverElement.ElementType = peItem then - begin - if FMouseActiveElement.ElementIndex<>-1 then - FItems[FMouseActiveElement.ElementIndex].MouseMove(Shift, X, Y); - end else - if FMouseHoverElement.ElementType = pePaneArea then - begin + if FMouseHoverElement.ElementType = peItem then + begin + if FMouseActiveElement.ElementIndex <> -1 then + FItems[FMouseActiveElement.ElementIndex].MouseMove(Shift, X, Y); + end else + if FMouseHoverElement.ElementType = pePaneArea then + begin // Placeholder, jeœli zajdzie potrzeba obs³ugi tego zdarzenia. - end else - if FMouseHoverElement.ElementType = peNone then + end else + if FMouseHoverElement.ElementType = peNone then + begin + if FPaneState <> psIdle then begin - if FPaneState<>psIdle then - begin - FPaneState:=psIdle; - if assigned(FToolbarDispatch) then - FToolbarDispatch.NotifyVisualsChanged; - end; + FPaneState := psIdle; + if Assigned(FToolbarDispatch) then + FToolbarDispatch.NotifyVisualsChanged; end; - end; + end; + end; -if ClearActive then - begin - FMouseActiveElement.ElementType:=peNone; - FMouseActiveElement.ElementIndex:=-1; - end; + if ClearActive then + begin + FMouseActiveElement.ElementType := peNone; + FMouseActiveElement.ElementIndex := -1; + end; end; procedure TSpkPane.SetAppearance(const Value: TSpkToolbarAppearance); @@ -939,120 +929,115 @@ end; procedure TSpkPane.SetCaption(const Value: string); begin FCaption := Value; - if assigned(FToolbarDispatch) then + if Assigned(FToolbarDispatch) then FToolbarDispatch.NotifyMetricsChanged; end; procedure TSpkPane.SetDisabledImages(const Value: TImageList); begin FDisabledImages := Value; - FItems.DisabledImages:=FDisabledImages; + FItems.DisabledImages := FDisabledImages; end; procedure TSpkPane.SetDisabledLargeImages(const Value: TImageList); begin FDisabledLargeImages := Value; - FItems.DisabledLargeImages:=FDisabledLargeImages; + FItems.DisabledLargeImages := FDisabledLargeImages; end; procedure TSpkPane.SetImages(const Value: TImageList); begin FImages := Value; - FItems.Images:=FImages; + FItems.Images := FImages; end; procedure TSpkPane.SetLargeImages(const Value: TImageList); begin FLargeImages := Value; - FItems.LargeImages:=FLargeImages; + FItems.LargeImages := FLargeImages; end; procedure TSpkPane.SetVisible(const Value: boolean); begin FVisible := Value; - - if assigned(FToolbarDispatch) then - FToolbarDispatch.NotifyItemsChanged; + if Assigned(FToolbarDispatch) then + FToolbarDispatch.NotifyItemsChanged; end; + { TSpkPanes } function TSpkPanes.Add: TSpkPane; begin - Result:=TSpkPane.Create(FRootComponent); - Result.Parent:=FRootComponent; + Result := TSpkPane.Create(FRootComponent); + Result.Parent := FRootComponent; AddItem(Result); end; -function TSpkPanes.GetItems(index: integer): TSpkPane; +function TSpkPanes.GetItems(AIndex: integer): TSpkPane; begin - result:=TSpkPane(inherited Items[index]); + Result := TSpkPane(inherited Items[AIndex]); end; -function TSpkPanes.Insert(index: integer): TSpkPane; - -var Owner, Parent : TComponent; +function TSpkPanes.Insert(AIndex: integer): TSpkPane; +var + lOwner, lParent: TComponent; i: Integer; - begin -if (index<0) or (index>self.Count) then - raise InternalException.create('TSpkPanes.Insert: Nieprawid³owy indeks!'); + if (AIndex < 0) or (AIndex > self.Count) then + raise InternalException.Create('TSpkPanes.Insert: Nieprawid³owy indeks!'); -if FRootComponent<>nil then - begin - Owner:=FRootComponent.Owner; - Parent:=FRootComponent; - end -else - begin - Owner:=nil; - Parent:=nil; - end; + if FRootComponent<>nil then + begin + lOwner := FRootComponent.Owner; + lParent := FRootComponent; + end + else + begin + lOwner := nil; + lParent := nil; + end; -result:=TSpkPane.Create(Owner); -result.Parent:=Parent; + Result := TSpkPane.Create(lOwner); + Result.Parent := lParent; -if FRootComponent<>nil then - begin - i:=0; - while FRootComponent.Owner.FindComponent('SpkPane'+inttostr(i))<>nil do - inc(i); - - result.Name:='SpkPane'+inttostr(i); - end; + if FRootComponent <> nil then + begin + i := 0; + while FRootComponent.Owner.FindComponent('SpkPane'+IntToStr(i)) <> nil do + inc(i); + Result.Name := 'SpkPane' + IntToStr(i); + end; -InsertItem(index,result); + InsertItem(AIndex, Result); end; -procedure TSpkPanes.Notify(Item: TComponent; - Operation : TOperation); +procedure TSpkPanes.Notify(Item: TComponent; Operation: TOperation); begin inherited Notify(Item, Operation); - case Operation of - opInsert: begin - // Ustawienie dyspozytora na nil spowoduje, ¿e podczas - // przypisywania w³asnoœci nie bêd¹ wo³ane metody Notify* - TSpkPane(Item).ToolbarDispatch:=nil; - - TSpkPane(Item).Appearance:=FAppearance; - TSpkPane(Item).Images:=FImages; - TSpkPane(Item).DisabledImages:=FDisabledImages; - TSpkPane(Item).LargeImages:=FLargeImages; - TSpkPane(Item).DisabledLargeImages:=FDisabledLargeImages; - TSpkPane(Item).ToolbarDispatch:=FToolbarDispatch; - end; - opRemove: begin - if not(csDestroying in Item.ComponentState) then - begin - TSpkPane(Item).ToolbarDispatch:=nil; - TSpkPane(Item).Appearance:=nil; - TSpkPane(Item).Images:=nil; - TSpkPane(Item).DisabledImages:=nil; - TSpkPane(Item).LargeImages:=nil; - TSpkPane(Item).DisabledLargeImages:=nil; - end; - end; + opInsert: + begin + // Ustawienie dyspozytora na nil spowoduje, ¿e podczas + // przypisywania w³asnoœci nie bêd¹ wo³ane metody Notify* + TSpkPane(Item).ToolbarDispatch := nil; + TSpkPane(Item).Appearance := FAppearance; + TSpkPane(Item).Images := FImages; + TSpkPane(Item).DisabledImages := FDisabledImages; + TSpkPane(Item).LargeImages := FLargeImages; + TSpkPane(Item).DisabledLargeImages := FDisabledLargeImages; + TSpkPane(Item).ToolbarDispatch := FToolbarDispatch; + end; + opRemove: + if not(csDestroying in Item.ComponentState) then + begin + TSpkPane(Item).ToolbarDispatch := nil; + TSpkPane(Item).Appearance := nil; + TSpkPane(Item).Images := nil; + TSpkPane(Item).DisabledImages := nil; + TSpkPane(Item).LargeImages := nil; + TSpkPane(Item).DisabledLargeImages := nil; + end; end; end; @@ -1061,9 +1046,8 @@ var I: Integer; begin FImages := Value; - if self.Count>0 then - for I := 0 to self.count - 1 do - Items[i].Images:=Value; + for I := 0 to self.Count - 1 do + Items[i].Images := Value; end; procedure TSpkPanes.SetLargeImages(const Value: TImageList); @@ -1071,63 +1055,52 @@ var I: Integer; begin FLargeImages := Value; - if self.Count>0 then - for I := 0 to self.count - 1 do - Items[i].LargeImages:=Value; + for I := 0 to self.Count - 1 do + Items[i].LargeImages := Value; end; procedure TSpkPanes.SetToolbarDispatch(const Value: TSpkBaseToolbarDispatch); - -var i : integer; - +var + i: integer; begin FToolbarDispatch := Value; - if self.Count>0 then - for i := 0 to self.count - 1 do - Items[i].ToolbarDispatch:=FToolbarDispatch; + for i := 0 to self.Count - 1 do + Items[i].ToolbarDispatch := FToolbarDispatch; end; procedure TSpkPanes.SetAppearance(const Value: TSpkToolbarAppearance); - -var i: Integer; - +var + i: Integer; begin FAppearance := Value; - if self.Count>0 then - for i := 0 to self.count - 1 do - Items[i].Appearance:=FAppearance; - - if FToolbarDispatch<>nil then + for i := 0 to self.Count - 1 do + Items[i].Appearance := FAppearance; + if FToolbarDispatch <> nil then FToolbarDispatch.NotifyMetricsChanged; end; procedure TSpkPanes.SetDisabledImages(const Value: TImageList); - -var I: Integer; - +var + I: Integer; begin FDisabledImages := Value; - if self.Count>0 then - for I := 0 to self.count - 1 do - Items[i].DisabledImages:=Value; + for I := 0 to self.Count - 1 do + Items[i].DisabledImages := Value; end; procedure TSpkPanes.SetDisabledLargeImages(const Value: TImageList); - var I: Integer; begin FDisabledLargeImages := Value; - if self.Count>0 then - for I := 0 to self.count - 1 do - Items[i].DisabledLargeImages:=Value; + for I := 0 to self.Count - 1 do + Items[i].DisabledLargeImages := Value; end; procedure TSpkPanes.Update; begin inherited Update; - - if assigned(FToolbarDispatch) then + if Assigned(FToolbarDispatch) then FToolbarDispatch.NotifyItemsChanged; end; diff --git a/components/spktoolbar/SpkToolbar/spkt_Tab.pas b/components/spktoolbar/SpkToolbar/spkt_Tab.pas index e5837f88a..2203419bc 100644 --- a/components/spktoolbar/SpkToolbar/spkt_Tab.pas +++ b/components/spktoolbar/SpkToolbar/spkt_Tab.pas @@ -15,154 +15,148 @@ unit spkt_Tab; interface -uses Graphics, Controls, Classes, SysUtils, - SpkMath, - spkt_Appearance, spkt_Const, spkt_Dispatch, spkt_Exceptions, - spkt_Pane, spkt_Types; +uses + Graphics, Controls, Classes, SysUtils, + SpkMath, + spkt_Appearance, spkt_Const, spkt_Dispatch, spkt_Exceptions, + spkt_Pane, spkt_Types; -type TSpkTab = class; +type + TSpkTab = class; - TSpkMouseTabElementType = (etNone, etTabArea, etPane); + TSpkMouseTabElementType = (etNone, etTabArea, etPane); - TSpkMouseTabElement = record - ElementType : TSpkMouseTabElementType; - ElementIndex : integer; - end; + TSpkMouseTabElement = record + ElementType: TSpkMouseTabElementType; + ElementIndex: integer; + end; - TSpkTabAppearanceDispatch = class(TSpkBaseAppearanceDispatch) - private - FTab : TSpkTab; - protected - public - // *** Konstruktor *** - constructor Create(ATab : TSpkTab); + TSpkTabAppearanceDispatch = class(TSpkBaseAppearanceDispatch) + private + FTab: TSpkTab; + public + // *** Konstruktor *** + constructor Create(ATab: TSpkTab); - // *** Implementacja metod odziedziczonych po TSpkBaseTabDispatch *** - procedure NotifyAppearanceChanged; override; - end; + // *** Implementacja metod odziedziczonych po TSpkBaseTabDispatch *** + procedure NotifyAppearanceChanged; override; + end; - TSpkTab = class(TSpkComponent) - private - FAppearanceDispatch : TSpkTabAppearanceDispatch; - FAppearance : TSpkToolbarAppearance; + TSpkTab = class(TSpkComponent) + private + FAppearanceDispatch: TSpkTabAppearanceDispatch; + FAppearance: TSpkToolbarAppearance; + FMouseHoverElement: TSpkMouseTabElement; + FMouseActiveElement: TSpkMouseTabElement; + FOnClick: TNotifyEvent; - FMouseHoverElement : TSpkMouseTabElement; - FMouseActiveElement : TSpkMouseTabElement; + protected + FToolbarDispatch: TSpkBaseToolbarDispatch; + FCaption: string; + FVisible: boolean; + FOverrideAppearance: boolean; + FCustomAppearance: TSpkToolbarAppearance; + FPanes: TSpkPanes; + FRect: T2DIntRect; + FImages: TImageList; + FDisabledImages: TImageList; + FLargeImages: TImageList; + FDisabledLargeImages: TImageList; - FOnClick: TNotifyEvent; + // *** Makro ustawia odpowiednie appearance taflom *** + procedure SetPaneAppearance; inline; - protected - FToolbarDispatch : TSpkBaseToolbarDispatch; - FCaption : string; - FVisible : boolean; - FOverrideAppearance : boolean; - FCustomAppearance : TSpkToolbarAppearance; + // *** Wyszukiwanie tafli *** + function FindPaneAt(x, y: integer): integer; - FPanes : TSpkPanes; - FRect : T2DIntRect; + // *** Obs³uga designtime i DFM *** + procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override; + procedure DefineProperties(Filer: TFiler); override; + procedure Loaded; override; - FImages : TImageList; - FDisabledImages : TImageList; - FLargeImages : TImageList; - FDisabledLargeImages : TImageList; + // *** Gettery i settery *** + procedure SetCaption(const Value: string); + procedure SetCustomAppearance(const Value: TSpkToolbarAppearance); + procedure SetOverrideAppearance(const Value: boolean); + procedure SetVisible(const Value: boolean); + procedure SetAppearance(const Value: TSpkToolbarAppearance); + procedure SetImages(const Value: TImageList); + procedure SetDisabledImages(const Value: TImageList); + procedure SetLargeImages(const Value: TImageList); + procedure SetDisabledLargeImages(const Value: TImageList); + procedure SetRect(ARect: T2DIntRect); + procedure SetToolbarDispatch(const Value: TSpkBaseToolbarDispatch); - // *** Makro ustawia odpowiednie appearance taflom *** - procedure SetPaneAppearance; inline; + public + // *** Konstruktor, destruktor *** + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; - // *** Wyszukiwanie tafli *** - function FindPaneAt(x, y : integer) : integer; + // *** Geometria, obs³uga tafli, rysowanie *** + function AtLeastOnePaneVisible: boolean; + procedure Draw(ABuffer: TBitmap; AClipRect: T2DIntRect); - // *** Obs³uga designtime i DFM *** - procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override; - procedure DefineProperties(Filer : TFiler); override; - procedure Loaded; override; + // *** Obs³uga gryzonia *** + procedure MouseLeave; + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); + procedure MouseMove(Shift: TShiftState; X, Y: Integer); + procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); - // *** Gettery i settery *** - procedure SetCaption(const Value: string); - procedure SetCustomAppearance(const Value: TSpkToolbarAppearance); - procedure SetOverrideAppearance(const Value: boolean); - procedure SetVisible(const Value: boolean); - procedure SetAppearance(const Value: TSpkToolbarAppearance); - procedure SetImages(const Value: TImageList); - procedure SetDisabledImages(const Value : TImageList); - procedure SetLargeImages(const Value : TImageList); - procedure SetDisabledLargeImages(const Value : TImageList); - procedure SetRect(ARect : T2DIntRect); - procedure SetToolbarDispatch(const Value: TSpkBaseToolbarDispatch); - public - // *** Konstruktor, destruktor *** - constructor Create(AOwner : TComponent); override; - destructor Destroy; override; + // *** Obs³uga zdarzeñ dyspozytora *** + procedure NotifyAppearanceChanged; - // *** Geometria, obs³uga tafli, rysowanie *** - function AtLeastOnePaneVisible: boolean; - procedure Draw(ABuffer : TBitmap; AClipRect : T2DIntRect); + // *** Obs³uga elementów *** + procedure FreeingPane(APane: TSpkPane); - // *** Obs³uga gryzonia *** - procedure MouseLeave; - procedure MouseDown(Button: TMouseButton; Shift: TShiftState; - X, Y: Integer); - procedure MouseMove(Shift: TShiftState; X, Y: Integer); - procedure MouseUp(Button: TMouseButton; Shift: TShiftState; - X, Y: Integer); + procedure ExecOnClick; - // *** Obs³uga zdarzeñ dyspozytora *** - procedure NotifyAppearanceChanged; + property ToolbarDispatch: TSpkBaseToolbarDispatch read FToolbarDispatch write SetToolbarDispatch; + property Appearance: TSpkToolbarAppearance read FAppearance write SetAppearance; + property Panes: TSpkPanes read FPanes; + property Rect: T2DIntRect read FRect write SetRect; + property Images: TImageList read FImages write SetImages; + property DisabledImages: TImageList read FDisabledImages write SetDisabledImages; + property LargeImages: TImageList read FLargeImages write SetLargeImages; + property DisabledLargeImages: TImageList read FDisabledLargeImages write SetDisabledLargeImages; - // *** Obs³uga elementów *** - procedure FreeingPane(APane : TSpkPane); + published + property CustomAppearance: TSpkToolbarAppearance read FCustomAppearance write SetCustomAppearance; + property Caption: string read FCaption write SetCaption; + property OverrideAppearance: boolean read FOverrideAppearance write SetOverrideAppearance; + property Visible: boolean read FVisible write SetVisible; + property OnClick: TNotifyEvent read FOnClick write FOnClick; + end; - procedure ExecOnClick; + TSpkTabs = class(TSpkCollection) + protected + FToolbarDispatch: TSpkBaseToolbarDispatch; + FAppearance: TSpkToolbarAppearance; + FImages: TImageList; + FDisabledImages: TImageList; + FLargeImages: TImageList; + FDisabledLargeImages: TImageList; + procedure SetToolbarDispatch(const Value: TSpkBaseToolbarDispatch); + function GetItems(AIndex: integer): TSpkTab; reintroduce; + procedure SetAppearance(const Value: TSpkToolbarAppearance); + procedure SetImages(const Value: TImageList); + procedure SetDisabledImages(const Value: TImageList); + procedure SetLargeImages(const Value: TImageList); + procedure SetDisabledLargeImages(const Value: TImageList); + public + function Add: TSpkTab; + function Insert(AIndex: integer): TSpkTab; + procedure Notify(Item: TComponent; Operation: TOperation); override; + procedure Update; override; - property ToolbarDispatch : TSpkBaseToolbarDispatch read FToolbarDispatch write SetToolbarDispatch; - property Appearance : TSpkToolbarAppearance read FAppearance write SetAppearance; + property Items[index: integer]: TSpkTab read GetItems; default; + property ToolbarDispatch: TSpkBaseToolbarDispatch read FToolbarDispatch write SetToolbarDispatch; + property Appearance: TSpkToolbarAppearance read FAppearance write SetAppearance; + property Images: TImageList read FImages write SetImages; + property DisabledImages: TImageList read FDisabledImages write SetDisabledImages; + property LargeImages: TImageList read FLargeImages write SetLargeImages; + property DisabledLargeImages: TImageList read FDisabledLargeImages write SetDisabledLargeImages; + end; - property Panes : TSpkPanes read FPanes; - property Rect : T2DIntRect read FRect write SetRect; - property Images : TImageList read FImages write SetImages; - property DisabledImages : TImageList read FDisabledImages write SetDisabledImages; - property LargeImages : TImageList read FLargeImages write SetLargeImages; - property DisabledLargeImages : TImageList read FDisabledLargeImages write SetDisabledLargeImages; - published - property CustomAppearance : TSpkToolbarAppearance read FCustomAppearance write SetCustomAppearance; - property Caption : string read FCaption write SetCaption; - property OverrideAppearance : boolean read FOverrideAppearance write SetOverrideAppearance; - property Visible : boolean read FVisible write SetVisible; - property OnClick: TNotifyEvent read FOnClick write FOnClick; - end; - -type TSpkTabs = class(TSpkCollection) - private - protected - FToolbarDispatch : TSpkBaseToolbarDispatch; - FAppearance : TSpkToolbarAppearance; - FImages : TImageList; - FDisabledImages : TImageList; - FLargeImages : TImageList; - FDisabledLargeImages : TImageList; - - procedure SetToolbarDispatch(const Value: TSpkBaseToolbarDispatch); - function GetItems(index: integer): TSpkTab; reintroduce; - procedure SetAppearance(const Value: TSpkToolbarAppearance); - procedure SetImages(const Value: TImageList); - procedure SetDisabledImages(const Value : TImageList); - procedure SetLargeImages(const Value : TImageList); - procedure SetDisabledLargeImages(const Value : TImageList); - public - function Add : TSpkTab; - function Insert(index : integer) : TSpkTab; - - procedure Notify(Item: TComponent; Operation : TOperation); override; - procedure Update; override; - - property Items[index : integer] : TSpkTab read GetItems; default; - property ToolbarDispatch : TSpkBaseToolbarDispatch read FToolbarDispatch write SetToolbarDispatch; - property Appearance : TSpkToolbarAppearance read FAppearance write SetAppearance; - property Images : TImageList read FImages write SetImages; - property DisabledImages : TImageList read FDisabledImages write SetDisabledImages; - property LargeImages : TImageList read FLargeImages write SetLargeImages; - property DisabledLargeImages : TImageList read FDisabledLargeImages write SetDisabledLargeImages; - end; implementation @@ -171,137 +165,123 @@ implementation constructor TSpkTabAppearanceDispatch.Create(ATab: TSpkTab); begin inherited Create; - FTab:=ATab; + FTab := ATab; end; procedure TSpkTabAppearanceDispatch.NotifyAppearanceChanged; begin - if assigned(FTab) then - FTab.NotifyAppearanceChanged; + if Assigned(FTab) then + FTab.NotifyAppearanceChanged; end; + { TSpkTab } -function TSpkTab.AtLeastOnePaneVisible: boolean; - -var i : integer; - PaneVisible : boolean; - -begin -result:=FPanes.count>0; -if result then - begin - PaneVisible:=false; - i:=FPanes.count-1; - while (i>=0) and not(PaneVisible) do - begin - PaneVisible:=FPanes[i].Visible; - dec(i); - end; - result:=result and PaneVisible; - end; -end; - -procedure TSpkTab.SetRect(ARect: T2DIntRect); - -var x, i : integer; - tw : integer; - tmpRect : T2DIntRect; - -begin -FRect:=ARect; - -if AtLeastOnePaneVisible then - begin - x:=ARect.left; - for i := 0 to FPanes.count - 1 do - if FPanes[i].Visible then - begin - tw:=FPanes[i].GetWidth; - - tmpRect.Left:=x; - tmpRect.top:=ARect.Top; - tmpRect.right:=x + tw - 1; - tmpRect.bottom:=ARect.bottom; - - FPanes[i].Rect:=tmpRect; - - x:=x + tw + TabPaneHSpacing; - end - else - begin - {$IFDEF EnhancedRecordSupport} - FPanes[i].Rect:=T2DIntRect.create(-1,-1,-1,-1); - {$ELSE} - FPanes[i].Rect.create(-1,-1,-1,-1); - {$ENDIF} - end; - end; -end; - -procedure TSpkTab.SetToolbarDispatch(const Value: TSpkBaseToolbarDispatch); - -begin - FToolbarDispatch := Value; - FPanes.ToolbarDispatch:=FToolbarDispatch; -end; - -constructor TSpkTab.Create(AOwner : TComponent); +constructor TSpkTab.Create(AOwner: TComponent); begin inherited Create(AOwner); - - FAppearanceDispatch:=TSpkTabAppearanceDispatch.create(self); - FMouseHoverElement.ElementType:=etNone; - FMouseHoverElement.ElementIndex:=-1; - FMouseActiveElement.ElementType:=etNone; - FMouseActiveElement.ElementIndex:=-1; - - FCaption:='Tab'; - FVisible:=true; - FCustomAppearance:=TSpkToolbarAppearance.Create(FAppearanceDispatch); - - FPanes:=TSpkPanes.Create(self); - FPanes.ToolbarDispatch:=FToolbarDispatch; - + FAppearanceDispatch := TSpkTabAppearanceDispatch.Create(self); + FMouseHoverElement.ElementType := etNone; + FMouseHoverElement.ElementIndex := -1; + FMouseActiveElement.ElementType := etNone; + FMouseActiveElement.ElementIndex := -1; + FCaption := 'Tab'; + FVisible := true; + FCustomAppearance := TSpkToolbarAppearance.Create(FAppearanceDispatch); + FPanes := TSpkPanes.Create(self); + FPanes.ToolbarDispatch := FToolbarDispatch; {$IFDEF EnhancedRecordSupport} - FRect:=T2DIntRect.create(0,0,0,0); + FRect := T2DIntRect.Create(0,0,0,0); {$ELSE} - FRect.create(0,0,0,0); + FRect.Create(0,0,0,0); {$ENDIF} - - SetPaneAppearance; end; -procedure TSpkTab.DefineProperties(Filer: TFiler); -begin - inherited DefineProperties(Filer); - - Filer.DefineProperty('Panes',FPanes.ReadNames,FPanes.WriteNames,true); -end; - destructor TSpkTab.Destroy; begin FPanes.Free; FCustomAppearance.Free; FAppearanceDispatch.Free; - inherited Destroy; end; -procedure TSpkTab.Draw(ABuffer: TBitmap; AClipRect: T2DIntRect); - -var LocalClipRect : T2DIntRect; - i : integer; - +function TSpkTab.AtLeastOnePaneVisible: boolean; +var + i: integer; + PaneVisible: boolean; begin -if AtLeastOnePaneVisible then - for i := 0 to FPanes.Count - 1 do - if FPanes[i].visible then - begin - if AClipRect.IntersectsWith(FPanes[i].Rect, LocalClipRect) then - FPanes[i].Draw(ABuffer, LocalClipRect); - end; + Result := (FPanes.Count > 0); + if Result then + begin + PaneVisible := false; + i := FPanes.Count - 1; + while (i >= 0) and not PaneVisible do + begin + PaneVisible := FPanes[i].Visible; + dec(i); + end; + Result := Result and PaneVisible; + end; +end; + +procedure TSpkTab.SetRect(ARect: T2DIntRect); +var + x, i: integer; + tw: integer; + tmpRect: T2DIntRect; +begin + FRect := ARect; + if AtLeastOnePaneVisible then + begin + x := ARect.left; + for i := 0 to FPanes.Count - 1 do + if FPanes[i].Visible then + begin + tw := FPanes[i].GetWidth; + tmpRect.Left := x; + tmpRect.Top := ARect.Top; + tmpRect.Right := x + tw - 1; + tmpRect.Bottom := ARect.bottom; + FPanes[i].Rect := tmpRect; + x := x + tw + TabPaneHSpacing; + end + else + begin + {$IFDEF EnhancedRecordSupport} + FPanes[i].Rect := T2DIntRect.Create(-1,-1,-1,-1); + {$ELSE} + FPanes[i].Rect.Create(-1,-1,-1,-1); + {$ENDIF} + end; + end; +end; + +procedure TSpkTab.SetToolbarDispatch(const Value: TSpkBaseToolbarDispatch); +begin + FToolbarDispatch := Value; + FPanes.ToolbarDispatch := FToolbarDispatch; +end; + +procedure TSpkTab.DefineProperties(Filer: TFiler); +begin + inherited DefineProperties(Filer); + Filer.DefineProperty('Panes', FPanes.ReadNames, FPanes.WriteNames, true); +end; + + +procedure TSpkTab.Draw(ABuffer: TBitmap; AClipRect: T2DIntRect); +var + LocalClipRect: T2DIntRect; + i: integer; +begin + if AtLeastOnePaneVisible then + for i := 0 to FPanes.Count - 1 do + if FPanes[i].visible then + begin + if AClipRect.IntersectsWith(FPanes[i].Rect, LocalClipRect) then + FPanes[i].Draw(ABuffer, LocalClipRect); + end; end; procedure TSpkTab.ExecOnClick; @@ -311,236 +291,227 @@ begin end; function TSpkTab.FindPaneAt(x, y: integer): integer; - -var i : integer; - +var + i: integer; begin -result:=-1; -i:=FPanes.count-1; -while (i>=0) and (result=-1) do - begin - if FPanes[i].Visible then - begin - {$IFDEF EnhancedRecordSupport} - if FPanes[i].Rect.Contains(T2DIntVector.create(x,y)) then - {$ELSE} - if FPanes[i].Rect.Contains(x,y) then - {$ENDIF} - result:=i; - end; - dec(i); - end; + Result := -1; + i := FPanes.Count - 1; + while (i >= 0) and (Result = -1) do + begin + if FPanes[i].Visible then + begin + {$IFDEF EnhancedRecordSupport} + if FPanes[i].Rect.Contains(T2DIntVector.Create(x,y)) then + {$ELSE} + if FPanes[i].Rect.Contains(x,y) then + {$ENDIF} + Result := i; + end; + dec(i); + end; end; procedure TSpkTab.FreeingPane(APane: TSpkPane); begin -FPanes.RemoveReference(APane); + FPanes.RemoveReference(APane); end; procedure TSpkTab.GetChildren(Proc: TGetChildProc; Root: TComponent); - -var i: Integer; - +var + i: Integer; begin -inherited; - -if FPanes.Count>0 then - for i := 0 to FPanes.Count - 1 do - Proc(FPanes.Items[i]); + inherited; + for i := 0 to FPanes.Count - 1 do + Proc(FPanes.Items[i]); end; procedure TSpkTab.Loaded; begin inherited; - if FPanes.ListState = lsNeedsProcessing then - FPanes.ProcessNames(self.Owner); + FPanes.ProcessNames(self.Owner); end; -procedure TSpkTab.MouseDown(Button: TMouseButton; Shift: TShiftState; X, - Y: Integer); +procedure TSpkTab.MouseDown(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); begin -if FMouseActiveElement.ElementType = etPane then - begin - if FMouseActiveElement.ElementIndex<>-1 then + if FMouseActiveElement.ElementType = etPane then + begin + if FMouseActiveElement.ElementIndex <> -1 then FPanes[FMouseActiveElement.ElementIndex].MouseDown(Button, Shift, X, Y); - end else -if FMouseActiveElement.ElementType = etTabArea then - begin + end else + if FMouseActiveElement.ElementType = etTabArea then + begin // Placeholder, jeœli zajdzie potrzeba obs³ugi tego zdarzenia. - end else -if FMouseActiveElement.ElementType = etNone then - begin - if FMouseHoverElement.ElementType = etPane then + end else + if FMouseActiveElement.ElementType = etNone then + begin + if FMouseHoverElement.ElementType = etPane then + begin + if FMouseHoverElement.ElementIndex <> -1 then begin - if FMouseHoverElement.ElementIndex<>-1 then - begin - FMouseActiveElement.ElementType:=etPane; - FMouseActiveElement.ElementIndex:=FMouseHoverElement.ElementIndex; - - FPanes[FMouseHoverElement.ElementIndex].MouseDown(Button, Shift, X, Y); - end + FMouseActiveElement.ElementType := etPane; + FMouseActiveElement.ElementIndex := FMouseHoverElement.ElementIndex; + FPanes[FMouseHoverElement.ElementIndex].MouseDown(Button, Shift, X, Y); + end else - begin - FMouseActiveElement.ElementType:=etTabArea; - FMouseActiveElement.ElementIndex:=-1; - end; - end else - if FMouseHoverElement.ElementType = etTabArea then begin - FMouseActiveElement.ElementType:=etTabArea; - FMouseActiveElement.ElementIndex:=-1; - - // Placeholder, jeœli zajdzie potrzeba obs³ugi tego zdarzenia. + FMouseActiveElement.ElementType := etTabArea; + FMouseActiveElement.ElementIndex := -1; end; - end; + end else + if FMouseHoverElement.ElementType = etTabArea then + begin + FMouseActiveElement.ElementType := etTabArea; + FMouseActiveElement.ElementIndex := -1; + // Placeholder, jeœli zajdzie potrzeba obs³ugi tego zdarzenia. + end; + end; end; procedure TSpkTab.MouseLeave; begin -if FMouseActiveElement.ElementType = etNone then - begin - if FMouseHoverElement.ElementType = etPane then - begin - if FMouseHoverElement.ElementIndex<>-1 then - FPanes[FMouseHoverElement.ElementIndex].MouseLeave; - end else - if FMouseHoverElement.ElementType = etTabArea then - begin + if FMouseActiveElement.ElementType = etNone then + begin + if FMouseHoverElement.ElementType = etPane then + begin + if FMouseHoverElement.ElementIndex <> -1 then + FPanes[FMouseHoverElement.ElementIndex].MouseLeave; + end else + if FMouseHoverElement.ElementType = etTabArea then + begin // Placeholder, jeœli zajdzie potrzeba obs³ugi tego zdarzenia. - end; - end; + end; + end; -FMouseHoverElement.ElementType:=etNone; -FMouseHoverElement.ElementIndex:=-1; + FMouseHoverElement.ElementType := etNone; + FMouseHoverElement.ElementIndex := -1; end; procedure TSpkTab.MouseMove(Shift: TShiftState; X, Y: Integer); - -var i : integer; - NewMouseHoverElement : TSpkMouseTabElement; - +var + i: integer; + NewMouseHoverElement: TSpkMouseTabElement; begin -// Szukamy obiektu pod mysz¹ -i:=FindPaneAt(x, y); -if i<>-1 then - begin - NewMouseHoverElement.ElementType:=etPane; - NewMouseHoverElement.ElementIndex:=i; - end else -if (X>=FRect.left) and (Y>=FRect.top) and - (X<=FRect.right) and (Y<=FRect.bottom) then - begin - NewMouseHoverElement.ElementType:=etTabArea; - NewMouseHoverElement.ElementIndex:=-1; - end else - begin - NewMouseHoverElement.ElementType:=etNone; - NewMouseHoverElement.ElementIndex:=-1; - end; + // Szukamy obiektu pod mysz¹ + i := FindPaneAt(X, Y); + if i <> -1 then + begin + NewMouseHoverElement.ElementType := etPane; + NewMouseHoverElement.ElementIndex := i; + end else + if (X >= FRect.left) and (Y >= FRect.top) and + (X <= FRect.right) and (Y <= FRect.bottom) then + begin + NewMouseHoverElement.ElementType := etTabArea; + NewMouseHoverElement.ElementIndex := -1; + end else + begin + NewMouseHoverElement.ElementType := etNone; + NewMouseHoverElement.ElementIndex := -1; + end; -if FMouseActiveElement.ElementType = etPane then - begin - if FMouseActiveElement.ElementIndex<>-1 then - begin + if FMouseActiveElement.ElementType = etPane then + begin + if FMouseActiveElement.ElementIndex <> -1 then + begin FPanes[FMouseActiveElement.ElementIndex].MouseMove(Shift, X, Y); - end; - end else -if FMouseActiveElement.ElementType = etTabArea then - begin - // Placeholder, jeœli zajdzie potrzeba obs³ugi tego zdarzenia - end else -if FMouseActiveElement.ElementType = etNone then - begin - // Jeœli element pod mysz¹ siê zmienia, informujemy poprzedni element o - // tym, ¿e mysz opuszcza jego obszar - if (NewMouseHoverElement.ElementType<>FMouseHoverElement.ElementType) or - (NewMouseHoverElement.ElementIndex<>FMouseHoverElement.ElementIndex) then - begin + end; + end else + if FMouseActiveElement.ElementType = etTabArea then + begin + // Placeholder, jeœli zajdzie potrzeba obs³ugi tego zdarzenia + end else + if FMouseActiveElement.ElementType = etNone then + begin + // Jeœli element pod mysz¹ siê zmienia, informujemy poprzedni element o + // tym, ¿e mysz opuszcza jego obszar + if (NewMouseHoverElement.ElementType <> FMouseHoverElement.ElementType) or + (NewMouseHoverElement.ElementIndex <> FMouseHoverElement.ElementIndex) then + begin if FMouseHoverElement.ElementType = etPane then - begin - if FMouseHoverElement.ElementIndex<>-1 then - FPanes[FMouseHoverElement.ElementIndex].MouseLeave; - end else - if FMouseHoverElement.ElementType = etTabArea then - begin - // Placeholder, jeœli zajdzie potrzeba obs³ugi tego zdarzenia - end; - end; - - if NewMouseHoverElement.ElementType = etPane then begin - if NewMouseHoverElement.ElementIndex<>-1 then - FPanes[NewMouseHoverElement.ElementIndex].MouseMove(Shift, X, Y); + if FMouseHoverElement.ElementIndex <> -1 then + FPanes[FMouseHoverElement.ElementIndex].MouseLeave; end else - if NewMouseHoverElement.ElementType = etTabArea then + if FMouseHoverElement.ElementType = etTabArea then begin - // Placeholder, jeœli zajdzie potrzeba obs³ugi tego zdarzenia + // Placeholder, jeœli zajdzie potrzeba obs³ugi tego zdarzenia end; - end; + end; -FMouseHoverElement:=NewMouseHoverElement; + if NewMouseHoverElement.ElementType = etPane then + begin + if NewMouseHoverElement.ElementIndex <> -1 then + FPanes[NewMouseHoverElement.ElementIndex].MouseMove(Shift, X, Y); + end else + if NewMouseHoverElement.ElementType = etTabArea then + begin + // Placeholder, jeœli zajdzie potrzeba obs³ugi tego zdarzenia + end; + end; + + FMouseHoverElement := NewMouseHoverElement; end; procedure TSpkTab.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); - -var ClearActive : boolean; - +var + ClearActive: boolean; begin -ClearActive:=not(ssLeft in Shift) and not(ssMiddle in Shift) and not(ssRight in Shift); + ClearActive := not (ssLeft in Shift) and not (ssMiddle in Shift) and not (ssRight in Shift); -if FMouseActiveElement.ElementType = etPane then - begin - if FMouseActiveElement.ElementIndex<>-1 then + if FMouseActiveElement.ElementType = etPane then + begin + if FMouseActiveElement.ElementIndex <> -1 then FPanes[FMouseActiveElement.ElementIndex].MouseUp(Button, Shift, X, Y); - end else -if FMouseActiveElement.ElementType = etTabArea then - begin - // Placeholder, jeœli zajdzie potrzeba obs³ugi tego zdarzenia. - end; + end else + if FMouseActiveElement.ElementType = etTabArea then + begin + // Placeholder, jeœli zajdzie potrzeba obs³ugi tego zdarzenia. + end; -if ClearActive and - (FMouseActiveElement.ElementType<>FMouseHoverElement.ElementType) or - (FMouseActiveElement.ElementIndex<>FMouseHoverElement.ElementIndex) then - begin - if FMouseActiveElement.ElementType = etPane then - begin - if FMouseActiveElement.ElementIndex<>-1 then - FPanes[FMouseActiveElement.ElementIndex].MouseLeave; - end else - if FMouseActiveElement.ElementType = etTabArea then - begin + if ClearActive and + (FMouseActiveElement.ElementType <> FMouseHoverElement.ElementType) or + (FMouseActiveElement.ElementIndex <> FMouseHoverElement.ElementIndex) then + begin + if FMouseActiveElement.ElementType = etPane then + begin + if FMouseActiveElement.ElementIndex <> -1 then + FPanes[FMouseActiveElement.ElementIndex].MouseLeave; + end else + if FMouseActiveElement.ElementType = etTabArea then + begin // Placeholder, jeœli zajdzie potrzeba obs³ugi tego zdarzenia. - end; + end; - if FMouseHoverElement.ElementType = etPane then - begin - if FMouseHoverElement.ElementIndex<>-1 then - FPanes[FMouseHoverElement.ElementIndex].MouseMove(Shift, X, Y); - end else - if FMouseHoverElement.ElementType = etTabArea then - begin + if FMouseHoverElement.ElementType = etPane then + begin + if FMouseHoverElement.ElementIndex <> -1 then + FPanes[FMouseHoverElement.ElementIndex].MouseMove(Shift, X, Y); + end else + if FMouseHoverElement.ElementType = etTabArea then + begin // Placeholder, jeœli zajdzie potrzeba obs³ugi tego zdarzenia. - end; - end; + end; + end; -if ClearActive then - begin - FMouseActiveElement.ElementType:=etNone; - FMouseActiveElement.ElementIndex:=-1; - end; + if ClearActive then + begin + FMouseActiveElement.ElementType := etNone; + FMouseActiveElement.ElementIndex := -1; + end; end; procedure TSpkTab.NotifyAppearanceChanged; begin - if assigned(FToolbarDispatch) then - FToolbarDispatch.NotifyAppearanceChanged; + if Assigned(FToolbarDispatch) then + FToolbarDispatch.NotifyAppearanceChanged; end; procedure TSpkTab.SetCustomAppearance(const Value: TSpkToolbarAppearance); begin - FCustomAppearance.assign(Value); + FCustomAppearance.Assign(Value); end; procedure TSpkTab.SetDisabledImages(const Value: TImageList); @@ -569,205 +540,181 @@ end; procedure TSpkTab.SetAppearance(const Value: TSpkToolbarAppearance); begin - FAppearance:=Value; - + FAppearance := Value; SetPaneAppearance; - - if FToolbarDispatch<>nil then - FToolbarDispatch.NotifyMetricsChanged; + if FToolbarDispatch <> nil then + FToolbarDispatch.NotifyMetricsChanged; end; procedure TSpkTab.SetCaption(const Value: string); begin FCaption := Value; - if assigned(FToolbarDispatch) then - FToolbarDispatch.NotifyMetricsChanged; + if Assigned(FToolbarDispatch) then + FToolbarDispatch.NotifyMetricsChanged; end; procedure TSpkTab.SetOverrideAppearance(const Value: boolean); begin FOverrideAppearance := Value; - SetPaneAppearance; - - if FToolbarDispatch<>nil then - FToolbarDispatch.NotifyMetricsChanged; + if FToolbarDispatch <> nil then + FToolbarDispatch.NotifyMetricsChanged; end; procedure TSpkTab.SetPaneAppearance; begin -if FOverrideAppearance then - FPanes.Appearance:=FCustomAppearance else - FPanes.Appearance:=FAppearance; - -// Metoda pe³ni rolê makra - dlatego nie powiadamia dyspozytora o zmianie. + if FOverrideAppearance then + FPanes.Appearance := FCustomAppearance + else + FPanes.Appearance := FAppearance; + // Metoda pe³ni rolê makra - dlatego nie powiadamia dyspozytora o zmianie. end; procedure TSpkTab.SetVisible(const Value: boolean); begin FVisible := Value; - if FToolbarDispatch<>nil then - FToolbarDispatch.NotifyItemsChanged; + if FToolbarDispatch <> nil then + FToolbarDispatch.NotifyItemsChanged; end; + { TSpkTabs } function TSpkTabs.Add: TSpkTab; begin - Result:=TSpkTab.create(FRootComponent); - Result.Parent:=FRootComponent; + Result := TSpkTab.create(FRootComponent); + Result.Parent := FRootComponent; AddItem(Result); end; -function TSpkTabs.GetItems(index: integer): TSpkTab; +function TSpkTabs.GetItems(AIndex: integer): TSpkTab; begin - result:=TSpkTab(inherited Items[index]); + Result := TSpkTab(inherited Items[AIndex]); end; -function TSpkTabs.Insert(index: integer): TSpkTab; - -var Owner, Parent : TComponent; +function TSpkTabs.Insert(AIndex: integer): TSpkTab; +var + lOwner, lParent: TComponent; i: Integer; - begin -if (index<0) or (index>=self.Count) then - raise InternalException.create('TSpkTabs.Insert: Nieprawid³owy indeks!'); + if (AIndex < 0) or (AIndex >= self.Count) then + raise InternalException.create('TSpkTabs.Insert: Nieprawid³owy indeks!'); -if FRootComponent<>nil then - begin - Owner:=FRootComponent.Owner; - Parent:=FRootComponent; - end -else - begin - Owner:=nil; - Parent:=nil; - end; + if FRootComponent<>nil then + begin + lOwner := FRootComponent.Owner; + lParent := FRootComponent; + end + else + begin + lOwner := nil; + lParent := nil; + end; -result:=TSpkTab.create(Owner); -result.Parent:=Parent; + Result := TSpkTab.create(lOwner); + Result.Parent := lParent; -if FRootComponent<>nil then - begin - i:=0; - while FRootComponent.Owner.FindComponent('SpkTab'+inttostr(i))<>nil do - inc(i); + if FRootComponent<>nil then + begin + i := 0; + while FRootComponent.Owner.FindComponent('SpkTab'+IntToStr(i)) <> nil do + inc(i); - result.Name:='SpkTab'+inttostr(i); - end; -InsertItem(index, result); + Result.Name := 'SpkTab' + IntToStr(i); + end; + InsertItem(AIndex, Result); end; -procedure TSpkTabs.Notify(Item: TComponent; - Operation : TOperation); +procedure TSpkTabs.Notify(Item: TComponent; Operation: TOperation); begin inherited Notify(Item, Operation); case Operation of - opInsert: begin - // Ustawienie dyspozytora na nil spowoduje, ¿e podczas - // przypisywania w³asnoœci nie bêd¹ wo³ane metody Notify* - TSpkTab(Item).ToolbarDispatch:=nil; - - TSpkTab(Item).Appearance:=self.FAppearance; - TSpkTab(Item).Images:=self.FImages; - TSpkTab(Item).DisabledImages:=self.FDisabledImages; - TSpkTab(Item).LargeImages:=self.FLargeImages; - TSpkTab(Item).DisabledLargeImages:=self.FDisabledLargeImages; - TSpkTab(Item).ToolbarDispatch:=self.FToolbarDispatch; - end; - opRemove: begin - if not(csDestroying in Item.ComponentState) then - begin - TSpkTab(Item).ToolbarDispatch:=nil; - TSpkTab(Item).Appearance:=nil; - TSpkTab(Item).Images:=nil; - TSpkTab(Item).DisabledImages:=nil; - TSpkTab(Item).LargeImages:=nil; - TSpkTab(Item).DisabledLargeImages:=nil; - end; - end; + opInsert: + begin + // Ustawienie dyspozytora na nil spowoduje, ¿e podczas + // przypisywania w³asnoœci nie bêd¹ wo³ane metody Notify* + TSpkTab(Item).ToolbarDispatch := nil; + TSpkTab(Item).Appearance := self.FAppearance; + TSpkTab(Item).Images := self.FImages; + TSpkTab(Item).DisabledImages := self.FDisabledImages; + TSpkTab(Item).LargeImages := self.FLargeImages; + TSpkTab(Item).DisabledLargeImages := self.FDisabledLargeImages; + TSpkTab(Item).ToolbarDispatch := self.FToolbarDispatch; + end; + opRemove: + if not(csDestroying in Item.ComponentState) then + begin + TSpkTab(Item).ToolbarDispatch := nil; + TSpkTab(Item).Appearance := nil; + TSpkTab(Item).Images := nil; + TSpkTab(Item).DisabledImages := nil; + TSpkTab(Item).LargeImages := nil; + TSpkTab(Item).DisabledLargeImages := nil; + end; end; end; procedure TSpkTabs.SetAppearance(const Value: TSpkToolbarAppearance); - -var i: Integer; - +var + i: Integer; begin FAppearance := Value; - - if self.count>0 then - for i := 0 to self.count - 1 do - self.Items[i].Appearance:=FAppearance; + for i := 0 to self.Count - 1 do + self.Items[i].Appearance := FAppearance; end; procedure TSpkTabs.SetDisabledImages(const Value: TImageList); - -var i: Integer; - +var + i: Integer; begin FDisabledImages := Value; - - if self.Count>0 then - for i := 0 to self.count - 1 do - Items[i].DisabledImages:=Value; + for i := 0 to self.Count - 1 do + Items[i].DisabledImages := Value; end; procedure TSpkTabs.SetDisabledLargeImages(const Value: TImageList); - -var i: Integer; - +var + i: Integer; begin FDisabledLargeImages := Value; - - if self.Count>0 then - for i := 0 to self.count - 1 do - Items[i].DisabledLargeImages:=Value; + for i := 0 to self.count - 1 do + Items[i].DisabledLargeImages := Value; end; procedure TSpkTabs.SetImages(const Value: TImageList); - -var i: Integer; - +var + i: Integer; begin FImages := Value; - - if self.Count>0 then - for i := 0 to self.count - 1 do - Items[i].Images:=Value; + for i := 0 to self.Count - 1 do + Items[i].Images := Value; end; procedure TSpkTabs.SetLargeImages(const Value: TImageList); - -var i: Integer; - +var + i: Integer; begin FLargeImages := Value; - - if self.Count>0 then - for i := 0 to self.count - 1 do - Items[i].LargeImages:=Value; + for i := 0 to self.Count - 1 do + Items[i].LargeImages := Value; end; procedure TSpkTabs.SetToolbarDispatch(const Value: TSpkBaseToolbarDispatch); - -var i : integer; - +var + i: integer; begin FToolbarDispatch := Value; - - if self.Count>0 then - for i := 0 to self.count - 1 do - self.Items[i].ToolbarDispatch:=FToolbarDispatch; + for i := 0 to self.Count - 1 do + self.Items[i].ToolbarDispatch := FToolbarDispatch; end; procedure TSpkTabs.Update; begin inherited Update; - if assigned(FToolbarDispatch) then - FToolbarDispatch.NotifyItemsChanged; + if Assigned(FToolbarDispatch) then + FToolbarDispatch.NotifyItemsChanged; end; diff --git a/components/spktoolbar/SpkToolbar/spkt_Tools.pas b/components/spktoolbar/SpkToolbar/spkt_Tools.pas index 291566c38..7d1792f80 100644 --- a/components/spktoolbar/SpkToolbar/spkt_Tools.pas +++ b/components/spktoolbar/SpkToolbar/spkt_Tools.pas @@ -18,25 +18,24 @@ interface uses Graphics, SysUtils, SpkMath, SpkGUITools; -type TButtonTools = class sealed(TObject) - private - protected - public - class procedure DrawButton(Bitmap: TBitmap; - Rect: T2DIntRect; - FrameColor, - InnerLightColor, - InnerDarkColor, - GradientFrom, - GradientTo: TColor; - GradientKind: TBackgroundKind; - LeftEdgeOpen, - RightEdgeOpen, - TopEdgeOpen, - BottomEdgeOpen: boolean; - Radius: integer; - ClipRect: T2DIntRect); - end; +type + TButtonTools = class sealed(TObject) + public + class procedure DrawButton(Bitmap: TBitmap; + Rect: T2DIntRect; + FrameColor, + InnerLightColor, + InnerDarkColor, + GradientFrom, + GradientTo: TColor; + GradientKind: TBackgroundKind; + LeftEdgeOpen, + RightEdgeOpen, + TopEdgeOpen, + BottomEdgeOpen: boolean; + Radius: integer; + ClipRect: T2DIntRect); + end; implementation @@ -46,13 +45,12 @@ class procedure TButtonTools.DrawButton(Bitmap: TBitmap; Rect: T2DIntRect; FrameColor, InnerLightColor, InnerDarkColor, GradientFrom, GradientTo: TColor; GradientKind: TBackgroundKind; LeftEdgeOpen, RightEdgeOpen, TopEdgeOpen, BottomEdgeOpen: boolean; Radius: integer; - ClipRect : T2DIntRect); - + ClipRect: T2DIntRect); var x1, x2, y1, y2: integer; LeftClosed, TopClosed, RightClosed, BottomClosed: byte; begin - if (Rect.Width <6 ) or (Rect.Height < 6) or + if (Rect.Width < 6) or (Rect.Height < 6) or (Rect.Width < 2*Radius) or (Rect.Height < 2*Radius) then exit; if LeftEdgeOpen then LeftClosed := 0 else LeftClosed := 1; diff --git a/components/spktoolbar/SpkToolbar/spkt_Types.pas b/components/spktoolbar/SpkToolbar/spkt_Types.pas index 1ec9aee6b..a0a019566 100644 --- a/components/spktoolbar/SpkToolbar/spkt_Types.pas +++ b/components/spktoolbar/SpkToolbar/spkt_Types.pas @@ -14,86 +14,104 @@ unit spkt_Types; interface -uses Controls, Classes, ContNrs, SysUtils, Dialogs, - spkt_Exceptions; +uses + Controls, Classes, ContNrs, SysUtils, Dialogs, + spkt_Exceptions; -type TSpkListState = (lsNeedsProcessing, lsReady); +type + TSpkListState = (lsNeedsProcessing, lsReady); -type TSpkCollection = class(TPersistent) - private - protected - FList : TFPObjectList; - FNames : TStringList; - FListState : TSpkListState; - FRootComponent : TComponent; + TSpkCollection = class(TPersistent) + protected + FList: TFPObjectList; + FNames: TStringList; + FListState: TSpkListState; + FRootComponent: TComponent; - // *** Metody reakcji na zmiany w liœcie *** - // *** Methods responding to changes in list *** - procedure Notify(Item : TComponent; Operation : TOperation); virtual; - procedure Update; virtual; + // *** Metody reakcji na zmiany w liœcie *** + // *** Methods responding to changes in list *** + procedure Notify(Item: TComponent; Operation: TOperation); virtual; + procedure Update; virtual; - // *** Wewnêtrzne metody dodawania i wstawiania elementów *** - // *** Gettery i settery *** + // *** Wewnêtrzne metody dodawania i wstawiania elementów *** + // *** Gettery i settery *** - // *** Internal methods for adding and inserting elements *** - // *** Getters and setters *** - function GetItems(index: integer): TComponent; virtual; - public - // *** Konstruktor, destruktor *** - constructor Create(RootComponent : TComponent); reintroduce; virtual; - destructor Destroy; override; + // *** Internal methods for adding and inserting elements *** + // *** Getters and setters *** + function GetItems(AIndex: integer): TComponent; virtual; - // *** Obs³uga listy *** - // *** List operations *** - procedure AddItem(AItem: TComponent); - procedure InsertItem(index: integer; AItem: TComponent); - procedure Clear; - function Count: integer; - procedure Delete(index: integer); virtual; - function IndexOf(Item: TComponent) : integer; - procedure Remove(Item: TComponent); virtual; - procedure RemoveReference(Item: TComponent); - procedure Exchange(item1, item2: integer); - procedure Move(IndexFrom, IndexTo: integer); + public + // *** Konstruktor, destruktor *** + constructor Create(ARootComponent : TComponent); reintroduce; virtual; + destructor Destroy; override; - // *** Reader, writer i obs³uga designtime i DFM *** - // *** Reader, writer and operation designtime and DFM - procedure WriteNames(Writer: TWriter); virtual; - procedure ReadNames(Reader: TReader); virtual; - procedure ProcessNames(Owner: TComponent); virtual; + // *** Obs³uga listy *** + // *** List operations *** + procedure AddItem(AItem: TComponent); + procedure InsertItem(AIndex: integer; AItem: TComponent); + procedure Clear; + function Count: integer; + procedure Delete(AIndex: integer); virtual; + function IndexOf(Item: TComponent) : integer; + procedure Remove(Item: TComponent); virtual; + procedure RemoveReference(Item: TComponent); + procedure Exchange(item1, item2: integer); + procedure Move(IndexFrom, IndexTo: integer); - property ListState : TSpkListState read FListState; - property Items[index : integer] : TComponent read GetItems; default; - property RootComponent: TComponent read FRootComponent; - end; + // *** Reader, writer i obs³uga designtime i DFM *** + // *** Reader, writer and operation designtime and DFM + procedure WriteNames(Writer: TWriter); virtual; + procedure ReadNames(Reader: TReader); virtual; + procedure ProcessNames(Owner: TComponent); virtual; -type TSpkComponent = class(TComponent) - private - protected - FParent : TComponent; - FCollection: TSpkCollection; - public - // *** Obs³uga parenta *** - // *** Parent operations *** - function HasParent : boolean; override; - function GetParentComponent : TComponent; override; - procedure SetParentComponent(Value : TComponent); override; + property ListState: TSpkListState read FListState; + property Items[index: integer] : TComponent read GetItems; default; + property RootComponent: TComponent read FRootComponent; + end; + + TSpkComponent = class(TComponent) + protected + FParent: TComponent; + FCollection: TSpkCollection; + public + // *** Obs³uga parenta *** + // *** Parent operations *** + function HasParent: boolean; override; + function GetParentComponent: TComponent; override; + procedure SetParentComponent(Value: TComponent); override; + + property Parent: TComponent read FParent write SetParentComponent; + property Collection: TSpkCollection read FCollection; + end; - property Parent : TComponent read FParent write SetParentComponent; - property Collection: TSpkCollection read FCollection; - end; implementation { TSpkCollection } +constructor TSpkCollection.Create(ARootComponent: TComponent); +begin + inherited Create; + FRootComponent := ARootComponent; + FNames := TStringList.Create; + FList := TFPObjectList.Create(False); + FListState := lsReady; +end; + +destructor TSpkCollection.Destroy; +begin + FNames.Free; + FList.Free; + inherited; +end; + procedure TSpkCollection.AddItem(AItem: TComponent); begin -// Ta metoda mo¿e byæ wywo³ywana bez przetworzenia nazw (w szczególnoœci, metoda -// przetwarzaj¹ca nazwy korzysta z AddItem) + // Ta metoda mo¿e byæ wywo³ywana bez przetworzenia nazw (w szczególnoœci, metoda + // przetwarzaj¹ca nazwy korzysta z AddItem) -// This method can be recalling untreated names (in particular, the method -// uses the name przetwarzaj¹ca AddItem) --- ??? + // This method can be recalling untreated names (in particular, the method + // uses the name przetwarzaj¹ca AddItem) --- ??? Notify(AItem, opInsert); FList.Add(AItem); @@ -112,49 +130,31 @@ end; function TSpkCollection.Count: integer; begin - result := FList.Count; + Result := FList.Count; end; -constructor TSpkCollection.Create(RootComponent : TComponent); +procedure TSpkCollection.Delete(AIndex: integer); begin - inherited Create; - FRootComponent := RootComponent; - FNames := TStringList.create; - FList := TFPObjectList.create(False); - FListState := lsReady; -end; - -procedure TSpkCollection.Delete(index: integer); -begin - if (index < 0) or (index >= FList.count) then + if (AIndex < 0) or (AIndex >= FList.count) then raise InternalException.Create('TSpkCollection.Delete: Illegal index!'); - //raise InternalException.Create('TSpkCollection.Delete: Nieprawid³owy indeks!'); - Notify(TComponent(FList[index]), opRemove); - FList.Delete(index); + Notify(TComponent(FList[AIndex]), opRemove); + FList.Delete(AIndex); Update; end; -destructor TSpkCollection.Destroy; -begin - FNames.Destroy; - FList.Destroy; - inherited; -end; - procedure TSpkCollection.Exchange(item1, item2: integer); begin FList.Exchange(item1, item2); Update; end; -function TSpkCollection.GetItems(index: integer): TComponent; +function TSpkCollection.GetItems(AIndex: integer): TComponent; begin - if (index < 0) or (index >= FList.Count) then + if (AIndex < 0) or (AIndex >= FList.Count) then raise InternalException.Create('TSpkCollection.Delete: Illegal index!'); - //raise InternalException.create('TSpkCollection.GetItems: Nieprawid³owy indeks!'); - result := TComponent(FList[index]); + Result := TComponent(FList[AIndex]); end; function TSpkCollection.IndexOf(Item: TComponent): integer; @@ -162,14 +162,13 @@ begin result := FList.IndexOf(Item); end; -procedure TSpkCollection.InsertItem(index: integer; AItem: TComponent); +procedure TSpkCollection.InsertItem(AIndex: integer; AItem: TComponent); begin - if (index < 0) or (index > FList.Count) then + if (AIndex < 0) or (AIndex > FList.Count) then raise InternalException.Create('TSpkCollection.Delete: Illegal index!'); - //raise InternalException.Create('TSpkCollection.Insert: Nieprawid³owy indeks!'); Notify(AItem, opInsert); - FList.Insert(index, AItem); + FList.Insert(AIndex, AItem); if AItem is TSpkComponent then TSpkComponent(AItem).FCollection := self; Update; @@ -181,7 +180,6 @@ begin (indexTo < 0) or (indexTo >= FList.Count) then raise InternalException.Create('TSpkCollection.Delete: Illegal index!'); - //raise InternalException.Create('TSpkCollection.Move: Nieprawid³owy indeks!'); FList.Move(IndexFrom, IndexTo); Update; @@ -242,7 +240,7 @@ end; procedure TSpkCollection.Update; begin -// + // end; procedure TSpkCollection.WriteNames(Writer: TWriter); @@ -255,16 +253,17 @@ begin Writer.WriteListEnd; end; + { TSpkComponent } function TSpkComponent.GetParentComponent: TComponent; begin - result := FParent; + Result := FParent; end; function TSpkComponent.HasParent: boolean; begin - result := FParent<>nil; + Result := (FParent <> nil); end; procedure TSpkComponent.SetParentComponent(Value: TComponent); diff --git a/components/spktoolbar/demos/basic/Project1.res b/components/spktoolbar/demos/basic/Project1.res index 4ff746d8ad795966bb1af52e6626a7a90a04cb91..877868cb4251927ab961b2295948c0d753ecb7cd 100644 GIT binary patch delta 43 zcmdn7mt)IbjtL5kmJ1ab*&PcC{1S6hCu=a;Y|dm9XKk)$Yp-Wx++NSdWGMjvKxqvk delta 49 zcmdn8mt)6XjtL5kb_*35*(38yiyR9ICTlR-uqtGv7Nu@ZVH9U=u3>AhVPo80!^UJG F0RWvE4-WtU diff --git a/components/spktoolbar/designtime/spkte_AppearanceEditor.pas b/components/spktoolbar/designtime/spkte_AppearanceEditor.pas index fbe24ddec..08088b887 100644 --- a/components/spktoolbar/designtime/spkte_AppearanceEditor.pas +++ b/components/spktoolbar/designtime/spkte_AppearanceEditor.pas @@ -5,11 +5,10 @@ unit spkte_AppearanceEditor; interface uses - LCLIntf, LCLType, LMessages, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, + LCLIntf, LCLType, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, StdCtrls, ComCtrls, Buttons, Spin, - SpkGUITools, SpkXMLParser, - spkt_Buttons, spkt_BaseItem, spkt_Pane, spkt_Types, spkt_Tab, SpkToolbar, - spkt_Appearance; + SpkGUITools, SpkXMLParser, SpkToolbar, + spkt_Buttons, spkt_Pane, spkt_Tab, spkt_Appearance; type