paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-11 19:36:32 +02:00
Code Issues Packages Projects Releases Wiki Activity

Lcl/Cocoa/TabControl: Tabs dragdrop supported

Browse Source
This commit is contained in:
rich2014 2023-05-22 19:00:24 +08:00
parent fee3b05a06
commit bf6d81c33d
2 changed files with 11 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
lcl/interfaces/cocoa/cocoatabcontrols.pas
View File

@ -33,6 +33,7 @@ uses
type
ITabControlCallback = interface(ICommonCallback)
function shouldSelectTabViewItem(aTabIndex: Integer): Boolean;
procedure willSelectTabViewItem(aTabIndex: Integer);
procedure didSelectTabViewItem(aTabIndex: Integer);
end;
@ -529,6 +530,10 @@ function TCocoaTabControl.tabView_shouldSelectTabViewItem(tabView: NSTabView;
tabViewItem: NSTabViewItem): Boolean;
begin
Result := True;
if Assigned(callback) then
begin
Result:= callback.shouldSelectTabViewItem( IndexOfTab( self, tabViewItem) );
end;
end;
procedure TCocoaTabControl.tabView_willSelectTabViewItem(tabView: NSTabView;

6
lcl/interfaces/cocoa/cocoawscomctrls.pas
View File

@ -52,6 +52,7 @@ type
{ TLCLTabControlCallback }
TLCLTabControlCallback = class(TLCLCommonCallback, ITabControlCallback)
function shouldSelectTabViewItem(aTabIndex: Integer): Boolean;
procedure willSelectTabViewItem(aTabIndex: Integer);
procedure didSelectTabViewItem(aTabIndex: Integer);
end;
@ -439,6 +440,11 @@ end;
{ TLCLTabControlCallback }
function TLCLTabControlCallback.shouldSelectTabViewItem(aTabIndex: Integer): Boolean;
begin
Result:= NOT TTabControl(Target).Dragging;
end;
procedure TLCLTabControlCallback.willSelectTabViewItem(aTabIndex: Integer);
var
Msg: TLMNotify;