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

LCL Carbon: show only current tab page if designing

Browse Source 
git-svn-id: trunk@14231 -
This commit is contained in:
tombo 2008-02-22 12:48:24 +00:00
parent d8d0de7c0e
commit a21128f663
2 changed files with 59 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

44
lcl/interfaces/carbon/carbontabs.pp
View File

@ -53,6 +53,7 @@ type
procedure Attach(AParent: TCarbonTabsControl);
procedure UpdateTab;
function SetText(const S: String): Boolean; override;
procedure ShowHide(AVisible: Boolean); override;
end;
{ TCarbonTabsControl }
@ -93,6 +94,8 @@ type
function GetClientRect(var ARect: TRect): Boolean; override;
function SetBounds(const ARect: TRect): Boolean; override;
function IsDesignInteractive(const P: TPoint): Boolean;
procedure ScrollTabsLeft;
procedure ScrollTabsRight;
procedure StartScrollingTabsLeft;
@ -180,6 +183,27 @@ begin
Result := True;
end;
{------------------------------------------------------------------------------
Method: TCarbonTab.ShowHide
Params: AVisible - if show
Shows or hides control
------------------------------------------------------------------------------}
procedure TCarbonTab.ShowHide(AVisible: Boolean);
begin
if not (csDesigning in LCLObject.ComponentState) then
inherited ShowHide(AVisible)
else
begin
if FParent <> nil then
AVisible :=
(LCLObject as TCustomPage).PageIndex = (FParent.LCLObject as TCustomNotebook).PageIndex;
OSError(HIViewSetVisible(Frames[0], AVisible),
Self, 'ShowHide', SViewVisible);
end;
end;
{ TCarbonTabsControl }
{------------------------------------------------------------------------------
@ -727,6 +751,26 @@ begin
UpdateTabs;
end;
{------------------------------------------------------------------------------
Method: TCarbonTabsControl.IsDesignInteractive
Params: P
Returns: If the pos is design interactive
------------------------------------------------------------------------------}
function TCarbonTabsControl.IsDesignInteractive(const P: TPoint): Boolean;
var
R: TRect;
begin
GetClientRect(R);
Offsetrect(R, -R.Left, -R.Top);
case FTabPosition of
tpTop: Result := P.Y < R.Top;
tpBottom: Result := P.Y > R.Bottom;
tpLeft: Result := P.X < R.Left;
tpRight: Result := P.X > R.Right;
end;
end;
{------------------------------------------------------------------------------
Method: TCarbonTabsControl.ScrollTabsLeft;
------------------------------------------------------------------------------}

15
lcl/interfaces/carbon/carbonwsextctrls.pp
View File

@ -63,6 +63,7 @@ type
class procedure MovePage(const ANotebook: TCustomNotebook; const AChild: TCustomPage; const NewIndex: integer); override;
class procedure RemovePage(const ANotebook: TCustomNotebook; const AIndex: integer); override;
class function GetDesignInteractive(const AWinControl: TWinControl; AClientPos: TPoint): Boolean; override;
//class function GetNotebookMinTabHeight(const AWinControl: TWinControl): integer; override;
//class function GetNotebookMinTabWidth(const AWinControl: TWinControl): integer; override;
//class function GetPageRealIndex(const ANotebook: TCustomNotebook; AIndex: Integer): Integer; override;
@ -309,6 +310,20 @@ begin
TCarbonTabsControl(ANotebook.Handle).Remove(AIndex);
end;
{------------------------------------------------------------------------------
Method: TCarbonWSCustomNotebook.GetDesignInteractive
Params: AWinControl - LCL win control
AClientPos - Pos
Returns: If client pos should be interactive in designer
------------------------------------------------------------------------------}
class function TCarbonWSCustomNotebook.GetDesignInteractive(
const AWinControl: TWinControl; AClientPos: TPoint): Boolean;
begin
Result := False;
if not CheckHandle(AWinControl, Self, 'GetDesignInteractive') then Exit;
Result := TCarbonTabsControl(AWinControl.Handle).IsDesignInteractive(AClientPos);
end;
{------------------------------------------------------------------------------
Method: TCarbonWSCustomNotebook.SetPageIndex
Params: ANotebook - LCL custom notebook