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

LCL Carbon: allow selecting tabs of TPageControl in designer

Browse Source 
git-svn-id: trunk@14246 -
This commit is contained in:
tombo 2008-02-25 16:16:20 +00:00
parent 11d6ac41f5
commit c35a7a597d
8 changed files with 66 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
lcl/interfaces/carbon/carbondef.pp
View File

@ -94,6 +94,7 @@ type
function GetTopParentWindow: WindowRef; virtual; abstract;
procedure Invalidate(Rect: PRect = nil); virtual; abstract;
procedure InvalidateRgn(AShape: HISHapeRef);
function IsDesignInteractive(const P: TPoint): Boolean; virtual;
function IsEnabled: Boolean; virtual; abstract;
function IsVisible: Boolean; virtual; abstract;
function Enable(AEnable: Boolean): Boolean; virtual; abstract;
@ -608,6 +609,16 @@ begin
Self, 'InvalidateRgn', 'HIViewSetNeedsDisplayInShape');
end;
{------------------------------------------------------------------------------
Method: TCarbonWidget.IsDesignInteractive
Params: P - Client pos
Returns: If the pos is design interactive
------------------------------------------------------------------------------}
function TCarbonWidget.IsDesignInteractive(const P: TPoint): Boolean;
begin
Result := False;
end;
{------------------------------------------------------------------------------
Method: TCarbonWidget.GetScrollInfo
Params: SBStyle - Scrollbar type (SB_VERT, SB_HORZ)

1
lcl/interfaces/carbon/carbonprivate.pp
View File

@ -441,7 +441,6 @@ begin
InstallControlEventHandler(FDesignControl,
RegisterEventHandler(@CarbonDesign_Draw),
1, @TmpSpec, Pointer(Self), nil);
TmpSpec := MakeEventSpec(kEventClassControl, kEventControlTrack);
InstallControlEventHandler(FDesignControl,

36
lcl/interfaces/carbon/carbonprivatewindow.inc
View File

@ -251,7 +251,10 @@ var
end;
EventKind: UInt32;
Part: WindowPartCode;
DesignControl: TControl;
DesignWidget: TCarbonWidget;
P, ClientPt, ControlPt: TPoint;
ViewPart: HIViewPartCode;
begin
Result := EventNotHandledErr;
@ -300,8 +303,39 @@ begin
Result := EventNotHandledErr //CallNextEventHandler(ANextHandler, AEvent);
end
else
begin
// the LCL does not want the event propagated
Result := noErr;
end;
// interactive design
if (Widget is TCarbonDesignWindow) and (GetMouseButton = 1) and
(EventKind = kEventMouseDown) and (GetClickCount = 1) then
begin
P := GetMousePoint;
DesignControl := Widget.LCLObject.ControlAtPos(P,
[capfAllowDisabled, capfAllowWinControls, capfRecursive]);
if DesignControl is TWinControl then
begin
ClientPt := DesignControl.ScreenToClient(Widget.LCLObject.ClientToScreen(P));
ControlPt := DesignControl.ScreenToControl(Widget.LCLObject.ClientToScreen(P));
if (DesignControl as TWinControl).HandleAllocated then
begin
DesignWidget := TCarbonWidget((DesignControl as TWinControl).Handle);
if DesignWidget.IsDesignInteractive(ClientPt) then
begin
DebugLn('Send Design Click to control');
ViewPart := 0;
OSError(HIViewGetPartHit(DesignWidget.Widget, PointToHIPoint(ControlPt), ViewPart),
SName, 'HIViewGetPartHit');
OSError(HIViewSimulateClick(DesignWidget.Widget, ViewPart, GetCarbonMsgKeyState, nil),
SName, 'HIViewSimulateClick');
end;
end;
end;
end;
NotifyApplicationUserInput(Msg.Message.Msg);
end;

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

@ -1093,7 +1093,7 @@ begin
Result := SetEventParameter(AEvent, kEventParamControlPart,
typeControlPartCode, SizeOf(Part), @Part);
OSError(Result, SName, SSetEvent)
OSError(Result, SName, SSetEvent);
end;
end;
kEventClassTextInput: Result := noErr;

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

@ -94,7 +94,7 @@ type
function GetClientRect(var ARect: TRect): Boolean; override;
function SetBounds(const ARect: TRect): Boolean; override;
function IsDesignInteractive(const P: TPoint): Boolean;
function IsDesignInteractive(const P: TPoint): Boolean; override;
procedure ScrollTabsLeft;
procedure ScrollTabsRight;
@ -197,7 +197,7 @@ begin
begin
if FParent <> nil then
AVisible :=
(LCLObject as TCustomPage).PageIndex = (FParent.LCLObject as TCustomNotebook).PageIndex;
(LCLObject as TCustomPage).PageIndex = FParent.TabIndexToPageIndex(FParent.FTabIndex);
OSError(HIViewSetVisible(Frames[0], AVisible),
Self, 'ShowHide', SViewVisible);
@ -655,6 +655,7 @@ begin
Index := GetValue - 1;
if Index >= 0 then Inc(Index, FFirstIndex);
//DebugLn('TCarbonTabsControl.ValueChanged Index: ', DbgS(Index), ' Old ', DbgS(FOldTabIndex));
if Index = FOldTabIndex then Exit;
FOldTabIndex := Index;

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

@ -70,6 +70,7 @@ type
class procedure DestroyHandle(const AWinControl: TWinControl); override;
class function GetClientBounds(const AWincontrol: TWinControl; var ARect: TRect): Boolean; override;
class function GetClientRect(const AWincontrol: TWinControl; var ARect: TRect): Boolean; override;
class function GetDesignInteractive(const AWinControl: TWinControl; AClientPos: TPoint): Boolean; override;
class procedure GetPreferredSize(const AWinControl: TWinControl; var PreferredWidth, PreferredHeight: integer; WithThemeSpace: Boolean); override;
class function GetText(const AWinControl: TWinControl; var AText: String): Boolean; override;
class procedure SetBounds(const AWinControl: TWinControl; const ALeft, ATop, AWidth, AHeight: Integer); override;
@ -117,6 +118,20 @@ uses
{ TCarbonWSWinControl }
{------------------------------------------------------------------------------
Method: TCarbonWSWinControl.GetDesignInteractive
Params: AWinControl - LCL win control
AClientPos - Pos
Returns: If client pos should be interactive in designer
------------------------------------------------------------------------------}
class function TCarbonWSWinControl.GetDesignInteractive(
const AWinControl: TWinControl; AClientPos: TPoint): Boolean;
begin
Result := False;
if not CheckHandle(AWinControl, Self, 'GetDesignInteractive') then Exit;
Result := TCarbonWidget(AWinControl.Handle).IsDesignInteractive(AClientPos);
end;
{------------------------------------------------------------------------------
Method: TCarbonWSWinControl.GetPreferredSize
Params: AWinControl - LCL control

5
lcl/interfaces/carbon/carbonwsdialogs.pp
View File

@ -471,7 +471,6 @@ function CarbonFontDialog_Selection(ANextHandler: EventHandlerCallRef;
AEvent: EventRef;
AWidget: TCarbonWidget): OSStatus; {$IFDEF darwin}mwpascal;{$ENDIF}
var
AFontDialog: TFontDialog;
ID: ATSUFontID;
Size: Fixed;
Color: RGBColor;
@ -529,8 +528,6 @@ end;
function CarbonFontDialog_Close(ANextHandler: EventHandlerCallRef;
AEvent: EventRef;
AWidget: TCarbonWidget): OSStatus; {$IFDEF darwin}mwpascal;{$ENDIF}
var
AFontDialog: TFontDialog;
begin
{$IFDEF VerboseWSClass}
DebugLn('CarbonFontDialog_Close: ', DbgSName(FontDialog));
@ -588,7 +585,7 @@ begin
1, @TmpSpec, nil, nil);
OSError(ATSUCreateAndCopyStyle(TCarbonFont(AFontDialog.Font.Handle).Style, Style),
OSError(ATSUCreateAndCopyStyle(TCarbonFont(AFontDialog.Font.Reference.Handle).Style, Style),
Self, SShowModal, 'ATSUCreateAndCopyStyle');
// force set font ID

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

@ -63,7 +63,6 @@ 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;
@ -310,20 +309,6 @@ 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