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

carbon: implemented Tab hittest for CustomNotebook

Browse Source 
git-svn-id: trunk@22386 -
This commit is contained in:
dmitry 2009-11-02 15:21:56 +00:00
parent c2309f274d
commit 9fee6fe8eb
3 changed files with 60 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
lcl/interfaces/carbon/carbonproc.pp
View File

@ -83,6 +83,8 @@ function CreateCustomHIView(const ARect: HIRect; ControlStyle: TControlStyle = [
procedure SetControlViewStyle(Control: ControlRef; TinySize, SmallSize, NormalSize: Integer; ControlHeight: Boolean = True);
function CarbonHitTest(Control: ControlRef; const X,Y: integer; var part: ControlPartCode): Boolean;
const
DEFAULT_CFSTRING_ENCODING = kCFStringEncodingUTF8;
@ -669,6 +671,33 @@ begin
SetControlData(Control, kControlEntireControl, kControlSizeTag, SizeOf(Data), @Data);
end;
{------------------------------------------------------------------------------
Name: CarbonHitTest
Params: Control - control to test
x,y - mouse coordinates in control's local coordinates
part - hit test result
Returns: True - if hittest is succsefull, False - overwise
Performs hit-test on a carbon control (hiview)
------------------------------------------------------------------------------}
function CarbonHitTest(Control: ControlRef; const X,Y: integer; var part: ControlPartCode): Boolean;
var
event : EventRef;
mp : MacOSAll.point;
begin
Result := false;
if CreateEvent(kCFAllocatorDefault, kEventClassControl, kEventControlHitTest, 0, 0, event) <> noErr then
Exit;
mp.h := X;
mp.v := Y;
SetEventParameter(event, kEventParamDirectObject, typeControlRef, sizeof(Control), @Control);
SetEventParameter(event, kEventParamMouseLocation, typeQDPoint, sizeof(mp), @mp);
if SendEventToEventTarget(event, GetControlEventTarget(Control))= noErr then
Result:=GetEventParameter(event, kEventParamControlPart, typeControlPartCode, nil, sizeof(part), nil, @part)=noErr;
ReleaseEvent(event);
end;
{------------------------------------------------------------------------------
Name: CreateCFString
Params: S - UTF-8 string

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

@ -98,6 +98,8 @@ type
public
function GetClientRect(var ARect: TRect): Boolean; override;
function SetBounds(const ARect: TRect): Boolean; override;
function GetPageIndexAtCursor(const AClientPos: TPoint): Integer;
function IsDesignInteractive(const P: TPoint): Boolean; override;
@ -880,6 +882,23 @@ begin
UpdateTabs;
end;
function TCarbonTabsControl.GetPageIndexAtCursor(const AClientPos: TPoint): Integer;
var
tabno : ControlPartCode;
begin
Result := -1;
if not CarbonHitTest(Widget, AClientPos.X, AClientPos.Y, tabno) then Exit;
if tabno = kControlNoPart then
begin
Result := TCustomNotebook(LCLObject).PageIndex
//CarbonHitTest(FUserPane, AClientPos.X, AClientPos.Y-35, tabno);
//Result := tabno;
end
else
Result := FFirstIndex+tabno-1;
end;
{------------------------------------------------------------------------------
Method: TCarbonTabsControl.IsDesignInteractive
Params: P

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

@ -67,7 +67,7 @@ type
//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;
//class function GetTabIndexAtPos(const ANotebook: TCustomNotebook; const AClientPos: TPoint): integer; override;
class function GetTabIndexAtPos(const ANotebook: TCustomNotebook; const AClientPos: TPoint): integer; override;
class procedure SetPageIndex(const ANotebook: TCustomNotebook; const AIndex: integer); override;
class procedure SetTabPosition(const ANotebook: TCustomNotebook; const ATabPosition: TTabPosition); override;
class procedure ShowTabs(const ANotebook: TCustomNotebook; AShowTabs: boolean); override;
@ -296,6 +296,17 @@ begin
TCarbonTabsControl(ANotebook.Handle).SetPageIndex(ANotebook.PageIndex);
end;
class function TCarbonWSCustomNotebook.GetTabIndexAtPos(const ANotebook: TCustomNotebook; const AClientPos: TPoint): integer;
var
p : TPoint;
begin
if not CheckHandle(ANotebook, Self, 'GetTabIndexAtPos') then Exit;
p := AClientPos;
inc(p.y, 35); // todo: find out why AClientPos incorrect for TNotebook
Result := TCarbonTabsControl(ANotebook.Handle).GetPageIndexAtCursor(p);
end;
{------------------------------------------------------------------------------
Method: TCarbonWSCustomNotebook.SetPageIndex
Params: ANotebook - LCL custom notebook