mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-12-17 04:01:16 +01:00
438 lines
17 KiB
ObjectPascal
438 lines
17 KiB
ObjectPascal
{ $Id$}
|
|
{
|
|
*****************************************************************************
|
|
* CarbonWSControls.pp *
|
|
* --------------- *
|
|
* *
|
|
* *
|
|
*****************************************************************************
|
|
|
|
*****************************************************************************
|
|
* *
|
|
* This file is part of the Lazarus Component Library (LCL) *
|
|
* *
|
|
* See the file COPYING.modifiedLGPL.txt, included in this distribution, *
|
|
* for details about the copyright. *
|
|
* *
|
|
* This program is distributed in the hope that it will be useful, *
|
|
* but WITHOUT ANY WARRANTY; without even the implied warranty of *
|
|
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
|
|
* *
|
|
*****************************************************************************
|
|
}
|
|
unit CarbonWSControls;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
// defines
|
|
{$I carbondefines.inc}
|
|
|
|
uses
|
|
// libs
|
|
MacOSAll,
|
|
CarbonUtils, Classes, SysUtils,
|
|
// LCL
|
|
Forms, Controls, Graphics, LCLType, LMessages, LCLProc,
|
|
// widgetset
|
|
WSControls, WSLCLClasses, WSProc,
|
|
// LCL Carbon
|
|
CarbonDef, CarbonPrivate, CarbonEdits, CarbonListViews;
|
|
|
|
type
|
|
|
|
{ TCarbonWSDragImageList }
|
|
|
|
TCarbonWSDragImageList = class(TWSDragImageList)
|
|
published
|
|
end;
|
|
|
|
{ TCarbonWSLazAccessibleObject }
|
|
|
|
TCarbonWSLazAccessibleObject = class(TWSLazAccessibleObject)
|
|
public
|
|
// No need to implement SetFields in Carbon since Carbon requests the info
|
|
//class procedure SetFields(const AObject: TLazAccessibleObject; const ADescription, AName: string; const ARole: TLazAccessibilityRole); virtual;
|
|
class function CreateHandle(const AObject: TLazAccessibleObject): HWND; override;
|
|
class procedure DestroyHandle(const AObject: TLazAccessibleObject); override;
|
|
end;
|
|
|
|
{ TCarbonWSControl }
|
|
|
|
TCarbonWSControl = class(TWSControl)
|
|
published
|
|
end;
|
|
|
|
{ TCarbonWSWinControl }
|
|
|
|
TCarbonWSWinControlClass = class of TCarbonWSWincontrol;
|
|
TCarbonWSWinControl = class(TWSWinControl)
|
|
published
|
|
class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override;
|
|
|
|
class function CanFocus(const AWincontrol: TWinControl): Boolean; override;
|
|
|
|
class procedure AddControl(const AControl: TControl); override;
|
|
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;
|
|
class procedure SetChildZPosition(const AWinControl, AChild: TWinControl;
|
|
const AOldPos, ANewPos: Integer;
|
|
const AChildren: TFPList); override;
|
|
class procedure SetColor(const AWinControl: TWinControl); override;
|
|
class procedure SetCursor(const AWinControl: TWinControl; const ACursor: HCursor); override;
|
|
class procedure SetFont(const AWinControl: TWinControl; const AFont: TFont); override;
|
|
class procedure SetText(const AWinControl: TWinControl; const AText: String); override;
|
|
class procedure Invalidate(const AWinControl: TWinControl); override;
|
|
class procedure ShowHide(const AWinControl: TWinControl); override;
|
|
end;
|
|
|
|
{ TCarbonWSGraphicControl }
|
|
|
|
TCarbonWSGraphicControl = class(TWSGraphicControl)
|
|
published
|
|
end;
|
|
|
|
{ TCarbonWSCustomControl }
|
|
|
|
TCarbonWSCustomControl = class(TWSCustomControl)
|
|
published
|
|
class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override;
|
|
end;
|
|
|
|
{ TCarbonWSImageList }
|
|
|
|
TCarbonWSImageList = class(TWSImageList)
|
|
published
|
|
end;
|
|
|
|
|
|
implementation
|
|
|
|
uses
|
|
CarbonProc;
|
|
|
|
{ TCarbonWSLazAccessibleObject }
|
|
|
|
class function TCarbonWSLazAccessibleObject.CreateHandle(
|
|
const AObject: TLazAccessibleObject): HWND;
|
|
var
|
|
lElement: AXUIElementRef;
|
|
begin
|
|
lElement := MacOSAll.AXUIElementCreateSystemWide();
|
|
Result := HWND(lElement);
|
|
end;
|
|
|
|
class procedure TCarbonWSLazAccessibleObject.DestroyHandle(
|
|
const AObject: TLazAccessibleObject);
|
|
var
|
|
lElement: AXUIElementRef;
|
|
begin
|
|
if AObject.Handle = 0 then Exit;
|
|
lElement := AXUIElementRef(AObject.Handle);
|
|
CFRelease(lElement);
|
|
end;
|
|
|
|
{ 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
|
|
PreferredWidth - Preferred width, valid if > 0
|
|
PreferredHeight - Preferred height, valid if > 0
|
|
WithThemeSpace - Whether to include space for theme
|
|
|
|
Retrieves the preferred size of control in Carbon interface to support
|
|
autosizing of controls
|
|
------------------------------------------------------------------------------}
|
|
class procedure TCarbonWSWinControl.GetPreferredSize(const AWinControl: TWinControl;
|
|
var PreferredWidth, PreferredHeight: integer; WithThemeSpace: Boolean);
|
|
var
|
|
S: TPoint;
|
|
begin
|
|
if not CheckHandle(AWinControl, Self, 'GetPreferredSize') then Exit;
|
|
|
|
S := TCarbonWidget(AWinControl.Handle).GetPreferredSize;
|
|
PreferredWidth := S.X;
|
|
PreferredHeight := S.Y;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonWSWinControl.GetText
|
|
Params: AWinControl - LCL control
|
|
AText - Text
|
|
Returns: If the function succeeds
|
|
|
|
Retrieves the text (caption) of control in Carbon interface
|
|
------------------------------------------------------------------------------}
|
|
class function TCarbonWSWinControl.GetText(const AWinControl: TWinControl;
|
|
var AText: String): Boolean;
|
|
begin
|
|
Result := False;
|
|
if not CheckHandle(AWinControl, Self,'GetText') then Exit;
|
|
|
|
Result := TCarbonWidget(AWinControl.Handle).GetText(AText);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonWSWinControl.SetBounds
|
|
Params: AWinControl - LCL control
|
|
ALeft, ATop, AWidth, AHeight - Coordinates
|
|
|
|
Sets the bounds of control in Carbon interface
|
|
------------------------------------------------------------------------------}
|
|
class procedure TCarbonWSWinControl.SetBounds(const AWinControl: TWinControl;
|
|
const ALeft, ATop, AWidth, AHeight: Integer);
|
|
begin
|
|
if not CheckHandle(AWinControl, Self, 'SetBounds') then Exit;
|
|
|
|
TCarbonWidget(AWinControl.Handle).SetBounds(Bounds(ALeft, ATop, AWidth, AHeight));
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonWSWinControl.SetChildZPosition
|
|
Params: AWinControl - Parent LCL control
|
|
AChild - Child LCL control
|
|
AOldPos - Old z position
|
|
ANewPos - New z position
|
|
AChildren - List of all child controls
|
|
|
|
Sets the child z position of control in Carbon interface in the parent control
|
|
------------------------------------------------------------------------------}
|
|
class procedure TCarbonWSWinControl.SetChildZPosition(const AWinControl,
|
|
AChild: TWinControl; const AOldPos, ANewPos: Integer; const AChildren: TFPList);
|
|
begin
|
|
if not CheckHandle(AWinControl, Self, 'SetChildZPosition') then Exit;
|
|
if not CheckHandle(AChild, Self, 'SetChildZPosition AChild') then Exit;
|
|
|
|
TCarbonWidget(AWinControl.Handle).SetChildZPosition(TCarbonWidget(AChild.Handle),
|
|
AOldPos, ANewPos, AChildren);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonWSWinControl.SetColor
|
|
Params: AWinControl - LCL control
|
|
|
|
Sets the color of control in Carbon interface according to the LCL control
|
|
NOTE: Functions only for controls with edit
|
|
------------------------------------------------------------------------------}
|
|
class procedure TCarbonWSWinControl.SetColor(const AWinControl: TWinControl);
|
|
begin
|
|
if not CheckHandle(AWinControl, Self, 'SetColor') then Exit;
|
|
|
|
TCarbonWidget(AWinControl.Handle).SetColor(AWinControl.Color);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonWSWinControl.SetFont
|
|
Params: AWinControl - LCL control
|
|
ACursor - Cursor
|
|
|
|
Sets the cursor of control in Carbon interface
|
|
------------------------------------------------------------------------------}
|
|
class procedure TCarbonWSWinControl.SetCursor(const AWinControl: TWinControl;
|
|
const ACursor: HCursor);
|
|
begin
|
|
if not CheckHandle(AWinControl, Self, 'SetCursor') then Exit;
|
|
|
|
TCarbonWidget(AWinControl.Handle).SetCursor(ACursor);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonWSWinControl.SetFont
|
|
Params: AWinControl - LCL control
|
|
AFont - Font
|
|
|
|
Sets the font of control in Carbon interface
|
|
------------------------------------------------------------------------------}
|
|
class procedure TCarbonWSWinControl.SetFont(const AWinControl: TWinControl;
|
|
const AFont: TFont);
|
|
begin
|
|
if not CheckHandle(AWinControl, Self, 'SetFont') then Exit;
|
|
|
|
TCarbonWidget(AWinControl.Handle).SetFont(AFont);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonWSWinControl.SetText
|
|
Params: AWinControl - LCL control
|
|
AText - Text
|
|
|
|
Sets the text (caption) of control in Carbon interface
|
|
------------------------------------------------------------------------------}
|
|
class procedure TCarbonWSWinControl.SetText(const AWinControl: TWinControl;
|
|
const AText: String);
|
|
begin
|
|
if not CheckHandle(AWinControl, Self, 'SetText') then Exit;
|
|
|
|
//DebugLn('TCarbonWSWinControl.SetText ',dbgsName(AWinControl),' ',AText);
|
|
TCarbonWidget(AWinControl.Handle).SetText(AText);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonWSWinControl.Invalidate
|
|
Params: AWinControl - LCL control
|
|
|
|
Invalidates control in Carbon interface
|
|
------------------------------------------------------------------------------}
|
|
class procedure TCarbonWSWinControl.Invalidate(const AWinControl: TWinControl);
|
|
begin
|
|
if not CheckHandle(AWinControl, Self, 'Invalidate') then Exit;
|
|
|
|
TCarbonWidget(AWinControl.Handle).Invalidate;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonWSWinControl.ShowHide
|
|
Params: AWinControl - LCL control
|
|
|
|
Changes visibility of control in Carbon interface according to the LCL control
|
|
------------------------------------------------------------------------------}
|
|
class procedure TCarbonWSWinControl.ShowHide(const AWinControl: TWinControl);
|
|
begin
|
|
if not CheckHandle(AWinControl, Self, 'ShowHide') then Exit;
|
|
|
|
TCarbonWidget(AWinControl.Handle).ShowHide(AWinControl.HandleObjectShouldBeVisible);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonWSWinControl.CreateHandle
|
|
Params: AWinControl - LCL control
|
|
AParams - Creation parameters
|
|
Returns: Handle to the control in Carbon interface
|
|
|
|
Creates new win control in Carbon interface with the specified parameters
|
|
------------------------------------------------------------------------------}
|
|
class function TCarbonWSWinControl.CreateHandle(const AWinControl: TWinControl;
|
|
const AParams: TCreateParams): TLCLIntfHandle;
|
|
begin
|
|
DebugLn('Warning: Using Carbon custom control instead of not implemented win control!');
|
|
|
|
Result := TLCLIntfHandle(TCarbonCustomControl.Create(AWinControl, AParams));
|
|
end;
|
|
|
|
class function TCarbonWSWinControl.CanFocus(const AWincontrol: TWinControl): Boolean;
|
|
var
|
|
Bit: CFIndex;
|
|
Valid: Boolean;
|
|
begin
|
|
Result := inherited;
|
|
if not AWinControl.HandleAllocated then
|
|
begin
|
|
Result:=AWinControl.CanFocus;
|
|
Exit;
|
|
end;
|
|
if not CheckHandle(AWincontrol, Self, 'CanFocus') then Exit;
|
|
|
|
Bit := CFPreferencesGetAppIntegerValue(CFSTR('AppleKeyboardUIMode'),
|
|
kCFPreferencesCurrentApplication, Valid);
|
|
|
|
if Valid then
|
|
begin
|
|
if (Bit <> 0) then
|
|
Result := True
|
|
else
|
|
Result := (TCarbonWidget(AWincontrol.Handle) is TCarbonControlWithEdit) or
|
|
(TCarbonWidget(AWincontrol.Handle) is TCarbonDataBrowser) or
|
|
(TCarbonWidget(AWincontrol.Handle) is TCarbonCustomControl);
|
|
end;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonWSWinControl.AddControl
|
|
Params: AControl - LCL control to add
|
|
|
|
Adds new control to parent control or window in Carbon interface
|
|
------------------------------------------------------------------------------}
|
|
class procedure TCarbonWSWinControl.AddControl(const AControl: TControl);
|
|
begin
|
|
if not CheckHandle(AControl as TWinControl, Self, 'AddControl') then Exit;
|
|
if not CheckHandle(AControl.Parent, Self, 'AddControl Parent') then Exit;
|
|
|
|
TCarbonWidget((AControl as
|
|
TWinControl).Handle).AddToWidget(TCarbonWidget(AControl.Parent.Handle));
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonWSWinControl.DestroyHandle
|
|
Params: AWinControl - LCL control
|
|
|
|
Destroys control in Carbon interface
|
|
------------------------------------------------------------------------------}
|
|
class procedure TCarbonWSWinControl.DestroyHandle(const AWinControl: TWinControl);
|
|
begin
|
|
if not CheckHandle(AWinControl, Self, 'DestroyHandle') then Exit;
|
|
|
|
TCarbonWidget(AWinControl.Handle).FreeCarbonWidget;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonWSWinControl.GetClientBounds
|
|
Params: AWinControl - LCL control
|
|
ARect - Record for client bounding rect
|
|
|
|
Retrieves the client bounding rect of control in Carbon interface
|
|
------------------------------------------------------------------------------}
|
|
class function TCarbonWSWinControl.GetClientBounds(const AWinControl: TWinControl;
|
|
var ARect: TRect): Boolean;
|
|
begin
|
|
Result := False;
|
|
if not CheckHandle(AWinControl, Self, 'GetClientBounds') then Exit;
|
|
|
|
Result := TCarbonWidget(AWinControl.Handle).GetClientRect(ARect);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonWSWinControl.GetClientRect
|
|
Params: AWinControl - LCL control
|
|
ARect - Record for client rect
|
|
|
|
Retrieves the client rect of control in Carbon interface
|
|
------------------------------------------------------------------------------}
|
|
class function TCarbonWSWinControl.GetClientRect(const AWinControl: TWinControl;
|
|
var ARect: TRect): Boolean;
|
|
begin
|
|
Result := False;
|
|
if not CheckHandle(AWinControl, Self, 'GetClientRect') then Exit;
|
|
|
|
Result := TCarbonWidget(AWinControl.Handle).GetClientRect(ARect);
|
|
if Result then OffsetRect(ARect, -ARect.Left, -ARect.Top);
|
|
end;
|
|
|
|
{ TCarbonWSCustomControl }
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonWSCustomControl.CreateHandle
|
|
Params: AWinControl - LCL control
|
|
AParams - Creation parameters
|
|
Returns: Handle to the control in Carbon interface
|
|
|
|
Creates new custom control in Carbon interface with the specified parameters
|
|
------------------------------------------------------------------------------}
|
|
class function TCarbonWSCustomControl.CreateHandle(const AWinControl: TWinControl;
|
|
const AParams: TCreateParams): TLCLIntfHandle;
|
|
begin
|
|
Result := TLCLIntfHandle(TCarbonCustomControl.Create(AWinControl, AParams));
|
|
end;
|
|
|
|
end.
|