paweld/lazarus-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Implements OnTabChanging. Patch by Werner Pamler with modifications

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@2450 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
blikblum 2012-06-06 01:28:14 +00:00
parent 1c8147ec02
commit 54716119b3
1 changed files with 43 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -50,6 +50,9 @@ type /// <summary>Typ opisuj¹cy regiony toolbara, które s¹ u¿ywane podczas
/// obs³ugi interakcji z mysz¹</summary> /// obs³ugi interakcji z mysz¹</summary>
TSpkMouseToolbarElement = (teNone, teToolbarArea, teTabs, teTabContents); TSpkMouseToolbarElement = (teNone, teToolbarArea, teTabs, teTabContents);
TSpkTabChangingEvent = procedure (Sender: TObject; OldIndex, NewIndex: Integer;
var Allowed: Boolean) of object;
type TSpkToolbar = class; type TSpkToolbar = class;
/// <summary>Klasa dyspozytora s³u¿¹ca do bezpiecznego przyjmowania /// <summary>Klasa dyspozytora s³u¿¹ca do bezpiecznego przyjmowania
@ -96,6 +99,9 @@ type TSpkToolbar = class;
/// <summary>Rozszerzony pasek narzêdzi inspirowany Microsoft Fluent /// <summary>Rozszerzony pasek narzêdzi inspirowany Microsoft Fluent
/// UI</summary> /// UI</summary>
{ TSpkToolbar }
TSpkToolbar = class(TCustomControl) TSpkToolbar = class(TCustomControl)
private private
/// <summary>Instancja obiektu dyspozytora przekazywanego elementom /// <summary>Instancja obiektu dyspozytora przekazywanego elementom
@ -141,7 +147,7 @@ type TSpkToolbar = class;
/// komponentu. FUpdating jest sterowana przez u¿ytkownika.</summary> /// komponentu. FUpdating jest sterowana przez u¿ytkownika.</summary>
FUpdating : boolean; FUpdating : boolean;
FOnTabChanging: TNotifyEvent; FOnTabChanging: TSpkTabChangingEvent;
FOnTabChanged: TNotifyEvent; FOnTabChanged: TNotifyEvent;
protected protected
@ -165,6 +171,7 @@ type TSpkToolbar = class;
/// </summary> /// </summary>
FDisabledLargeImages : TImageList; FDisabledLargeImages : TImageList;
function DoTabChanging(OldIndex, NewIndex: Integer): Boolean;
// ******************************************* // *******************************************
// *** Zarz¹dzanie stanem metryki i bufora *** // *** Zarz¹dzanie stanem metryki i bufora ***
// ******************************************* // *******************************************
@ -359,7 +366,7 @@ type TSpkToolbar = class;
property DisabledLargeImages : TImageList read FDisabledLargeImages write SetDisabledLargeImages; property DisabledLargeImages : TImageList read FDisabledLargeImages write SetDisabledLargeImages;
// <summary>Events called before and after a different tab is selected</summary> // <summary>Events called before and after a different tab is selected</summary>
property OnTabChanging: TNotifyEvent read FOnTabChanging write FOnTabChanging; property OnTabChanging: TSpkTabChangingEvent read FOnTabChanging write FOnTabChanging;
property OnTabChanged: TNotifyEvent read FOnTabChanged write FOnTabChanged; property OnTabChanged: TNotifyEvent read FOnTabChanged write FOnTabChanged;
end; end;
@ -885,9 +892,10 @@ begin
end; end;
procedure TSpkToolbar.NotifyItemsChanged; procedure TSpkToolbar.NotifyItemsChanged;
var
OldTabIndex: Integer;
begin begin
if Assigned(FOnTabChanging) then FOnTabChanging(self); OldTabIndex := FTabIndex;
// Poprawianie TabIndex o ile zachodzi taka potrzeba // Poprawianie TabIndex o ile zachodzi taka potrzeba
if not(AtLeastOneTabVisible) then FTabIndex:=-1 if not(AtLeastOneTabVisible) then FTabIndex:=-1
else else
@ -901,12 +909,16 @@ begin
end; end;
FTabHover:=-1; FTabHover:=-1;
SetMetricsInvalid; if DoTabChanging(OldTabIndex, FTabIndex) then begin
SetMetricsInvalid;
if not(FInternalUpdating or FUpdating) then if not(FInternalUpdating or FUpdating) then
Repaint; Repaint;
if Assigned(FOnTabChanged) then FOnTabChanged(self);
end else
FTabIndex := OldTabIndex;
if Assigned(FOnTabChanged) then FOnTabChanged(self);
end; end;
procedure TSpkToolbar.NotifyVisualsChanged; procedure TSpkToolbar.NotifyVisualsChanged;
@ -1001,6 +1013,13 @@ begin
Repaint; Repaint;
end; end;
function TSpkToolbar.DoTabChanging(OldIndex, NewIndex: Integer): Boolean;
begin
Result := True;
if Assigned(FOnTabChanging) then
FOnTabChanging(Self, OldIndex, NewIndex, Result);
end;
procedure TSpkToolbar.SetMetricsInvalid; procedure TSpkToolbar.SetMetricsInvalid;
begin begin
FMetricsValid:=false; FMetricsValid:=false;
@ -1008,8 +1027,10 @@ FBufferValid:=false;
end; end;
procedure TSpkToolbar.SetTabIndex(const Value: integer); procedure TSpkToolbar.SetTabIndex(const Value: integer);
var
OldTabIndex: Integer;
begin begin
if Assigned(FOnTabChanging) then FOnTabChanging(self); OldTabIndex := FTabIndex;
if not(AtLeastOneTabVisible) then FTabIndex:=-1 if not(AtLeastOneTabVisible) then FTabIndex:=-1
else else
@ -1023,12 +1044,13 @@ begin
end; end;
FTabHover:=-1; FTabHover:=-1;
SetMetricsInvalid; if DoTabChanging(OldTabIndex, FTabIndex) then begin
SetMetricsInvalid;
if not(FInternalUpdating or FUpdating) then if not(FInternalUpdating or FUpdating) then
Repaint; Repaint;
if Assigned(FOnTabChanged) then FOnTabChanged(self);
if Assigned(FOnTabChanged) then FOnTabChanged(self); end else
FTabIndex := OldTabIndex;
end; end;
procedure TSpkToolbar.TabMouseDown(Button: TMouseButton; Shift: TShiftState; X, procedure TSpkToolbar.TabMouseDown(Button: TMouseButton; Shift: TShiftState; X,
@ -1061,11 +1083,12 @@ if AtLeastOneTabVisible then
// zmieñ zaznaczenie. // zmieñ zaznaczenie.
if (Button = mbLeft) and (SelTab<>-1) and (SelTab<>FTabIndex) then if (Button = mbLeft) and (SelTab<>-1) and (SelTab<>FTabIndex) then
begin begin
if Assigned(FOnTabChanging) then FOnTabChanging(self); if DoTabChanging(FTabIndex, SelTab) then begin
FTabIndex:=SelTab; FTabIndex:=SelTab;
SetMetricsInvalid; SetMetricsInvalid;
Repaint; Repaint;
if Assigned(FOnTabChanged) then FOnTabChanged(self); if Assigned(FOnTabChanged) then FOnTabChanged(self);
end;
end; end;
end; end;