mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-06-03 15:58:16 +02:00
1757 lines
55 KiB
ObjectPascal
1757 lines
55 KiB
ObjectPascal
{ --------------------------------------------
|
|
carbonprivate.pp - Carbon internal classes
|
|
--------------------------------------------
|
|
|
|
This unit contains the private classhierarchy for the Carbon implemetations
|
|
This hierarchy reflects (more or less) the Carbon widget hierarchy
|
|
|
|
*****************************************************************************
|
|
This file is part of the Lazarus Component Library (LCL)
|
|
|
|
See the file COPYING.modifiedLGPL.txt, included in this distribution,
|
|
for details about the license.
|
|
*****************************************************************************
|
|
}
|
|
unit CarbonPrivate;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
// defines
|
|
{$I carbondefines.inc}
|
|
|
|
uses
|
|
// rtl+ftl
|
|
Types, Classes, SysUtils,
|
|
// carbon bindings
|
|
MacOSAll,
|
|
{$ifdef CarbonUseCocoaAll}
|
|
CocoaAll,
|
|
{$endif}
|
|
// widgetset
|
|
WSLCLClasses,
|
|
// LCL Carbon
|
|
CarbonDef, CarbonGDIObjects, CarbonMenus,
|
|
// LCL
|
|
LMessages, LCLMessageGlue, LCLProc, LCLType, Graphics, Controls, Forms,
|
|
Dialogs, StdCtrls, Buttons, ComCtrls, ExtCtrls, Menus;
|
|
|
|
type
|
|
TCarbonControlEvent = (cceValueChanged, cceIndicatorMoved, cceDoAction,
|
|
cceDraw, cceHit);
|
|
TCarbonControlEvents = set of TCarbonControlEvent;
|
|
TCarbonWidgetFlag = (cwfNone, cwdTToolBar, cwdTTabControl);
|
|
|
|
{ TCarbonControl }
|
|
|
|
TCarbonControl = class(TCarbonWidget)
|
|
private
|
|
FCarbonWidgetFlag: TCarbonWidgetFlag;
|
|
protected
|
|
procedure RegisterEvents; override;
|
|
procedure CreateWidget(const {%H-}AParams: TCreateParams); override;
|
|
procedure DestroyWidget; override;
|
|
procedure AddControlPart(const AControl: ControlRef);
|
|
function GetContent: ControlRef; override;
|
|
function GetControlContentRect(var ARect: TRect): Boolean;
|
|
function GetFrame({%H-}Index: Integer): ControlRef; virtual;
|
|
function GetFrameBounds(var ARect: TRect): Boolean; virtual;
|
|
function GetForceEmbedInScrollView: Boolean; virtual;
|
|
function UpdateContentBounds: Boolean;
|
|
function EmbedInScrollView(const AParams: TCreateParams): HIViewRef;
|
|
function EmbedInScrollView(AScrollBars: TScrollStyle): HIViewRef;
|
|
procedure ChangeScrollBars(AScrollView: HIViewRef; var AScrollBars: TScrollStyle; ANewValue: TScrollStyle);
|
|
public
|
|
class function GetFrameCount: Integer; virtual;
|
|
class function GetValidEvents: TCarbonControlEvents; virtual;
|
|
procedure Hit({%H-}AControlPart: ControlPartCode); virtual;
|
|
procedure Draw; virtual;
|
|
procedure ValueChanged; virtual;
|
|
procedure IndicatorMoved; virtual;
|
|
procedure DoAction({%H-}AControlPart: ControlPartCode); virtual;
|
|
public
|
|
procedure AllowMenuProcess({%H-}MenuHotKey: AnsiChar; {%H-}State: TShiftState; var AllowCommandProcess: Boolean); virtual;
|
|
public
|
|
procedure AddToWidget(AParent: TCarbonWidget); override;
|
|
function GetTopParentWindow: WindowRef; override;
|
|
function GetThemeDrawState: ThemeDrawState;
|
|
function GetWindowRelativePos(winX, winY: Integer): TPoint; override;
|
|
function GetClientRect(var ARect: TRect): Boolean; override;
|
|
function GetPreferredSize: TPoint; override;
|
|
procedure Invalidate(Rect: PRect = nil); override;
|
|
function IsEnabled: Boolean; override;
|
|
function IsVisible: Boolean; override;
|
|
function Enable(AEnable: Boolean): Boolean; override;
|
|
|
|
function GetBounds(var ARect: TRect): Boolean; override;
|
|
function GetScreenBounds(var ARect: TRect): Boolean; override;
|
|
function SetBounds(const ARect: TRect): Boolean; override;
|
|
|
|
procedure SetFocus; override;
|
|
procedure SetColor(const AColor: TColor); override;
|
|
procedure SetFont(const AFont: TFont); override;
|
|
procedure SetZOrder(AOrder: HIViewZOrderOp; ARefWidget: TCarbonWidget); override;
|
|
procedure ShowHide(AVisible: Boolean); override;
|
|
|
|
function GetText(var {%H-}S: String): Boolean; override;
|
|
function SetText(const S: String): Boolean; override;
|
|
|
|
function Update: Boolean; override;
|
|
|
|
function WidgetAtPos(const P: TPoint): ControlRef; override;
|
|
public
|
|
function GetValue: Integer;
|
|
procedure SetValue(AValue: Integer);
|
|
procedure SetMinimum(AValue: Integer);
|
|
procedure SetMaximum(AValue: Integer);
|
|
procedure SetViewSize(AValue: Integer);
|
|
public
|
|
// needed to avoid "Class is" or "ClassType"
|
|
property CarbonWidgetFlag: TCarbonWidgetFlag read FCarbonWidgetFlag write FCarbonWidgetFlag;
|
|
{ Frame:
|
|
= widget in controls without special frame control
|
|
- frame area control of control
|
|
- determines bounds of control
|
|
- processes only bounds changed event }
|
|
property Frames[Index: Integer]: ControlRef read GetFrame;
|
|
end;
|
|
|
|
{ TCarbonCustomControl }
|
|
|
|
TCarbonCustomControl = class(TCarbonControl)
|
|
private
|
|
FScrollView: HIViewRef;
|
|
FScrollOrigin: HIPoint;
|
|
FScrollSize: TPoint;
|
|
FScrollMin: TPoint;
|
|
FScrollPageSize: TPoint;
|
|
|
|
FMulX: Single; // multiply x coords to fit real page size
|
|
FMulY: Single; // multiply y coords to fit real page size
|
|
FTextFractional: Boolean;
|
|
protected
|
|
procedure RegisterEvents; override;
|
|
procedure CreateWidget(const AParams: TCreateParams); override;
|
|
procedure DestroyWidget; override;
|
|
function GetFrame({%H-}Index: Integer): ControlRef; override;
|
|
function GetForceEmbedInScrollView: Boolean; override;
|
|
procedure SendScrollUpdate;
|
|
procedure UpdateLCLClientRect; override;
|
|
public
|
|
class function GetValidEvents: TCarbonControlEvents; override;
|
|
procedure Draw; override;
|
|
procedure GetInfo(out AImageSize, AViewSize, ALineSize: HISize; out AOrigin: HIPoint); virtual;
|
|
procedure ScrollTo(const ANewOrigin: HIPoint); virtual;
|
|
procedure Invalidate(Rect:PRect=nil);override;
|
|
public
|
|
procedure AddToWidget(AParent: TCarbonWidget); override;
|
|
procedure SetColor(const {%H-}AColor: TColor); override;
|
|
procedure SetFont(const {%H-}AFont: TFont); override;
|
|
procedure GetScrollInfo(SBStyle: Integer; var ScrollInfo: TScrollInfo); override;
|
|
function GetScrollbarVisible(SBStyle: Integer): Boolean; override;
|
|
function SetScrollInfo(SBStyle: Integer; const ScrollInfo: TScrollInfo): Integer; override;
|
|
|
|
property TextFractional: Boolean read FTextFractional write FTextFractional;
|
|
end;
|
|
|
|
{ TCarbonToolBar }
|
|
|
|
TCarbonToolBar = class(TCarbonCustomControl)
|
|
protected
|
|
procedure CreateWidget(const AParams: TCreateParams); override;
|
|
end;
|
|
|
|
{ TCarbonScrollingWinControl }
|
|
|
|
TCarbonScrollingWinControl = class(TCarbonCustomControl)
|
|
protected
|
|
procedure CreateWidget(const AParams: TCreateParams); override;
|
|
function GetForceEmbedInScrollView: Boolean; override;
|
|
public
|
|
function GetWindowRelativePos(winX, winY: Integer): TPoint; override;
|
|
function GetPreferredSize: TPoint; override;
|
|
end;
|
|
|
|
{ TCarbonWindow }
|
|
|
|
TCarbonWindow = class(TCarbonScrollingWinControl)
|
|
private
|
|
FSheetWin: WindowRef;
|
|
protected
|
|
fWindowRef : WindowRef;
|
|
fHiddenWin : WindowRef;
|
|
fWinContent : HIViewRef; // actuall content view
|
|
|
|
fPrevMenuEnabled : Boolean; // was menu enabled before showing modal
|
|
|
|
|
|
procedure RegisterWindowEvents; virtual;
|
|
procedure CreateWindow(const AParams: TCreateParams); virtual;
|
|
|
|
procedure RegisterEvents; override;
|
|
procedure CreateWidget(const AParams: TCreateParams); override;
|
|
|
|
procedure DestroyWidget; override;
|
|
public
|
|
function GetPreferredSize: TPoint; override;
|
|
|
|
procedure BoundsChanged; override;
|
|
|
|
procedure AddToWidget(AParent: TCarbonWidget); override;
|
|
function GetWindowRelativePos(winX, winY: Integer): TPoint; override;
|
|
function GetTopParentWindow: WindowRef; override;
|
|
function GetClientRect(var ARect: TRect): Boolean; override;
|
|
procedure Invalidate(Rect: PRect = nil); override;
|
|
function IsEnabled: Boolean; override;
|
|
function IsVisible: Boolean; override;
|
|
function Enable(AEnable: Boolean): boolean; override;
|
|
|
|
function GetBounds(var ARect: TRect): Boolean; override;
|
|
function GetScreenBounds(var ARect: TRect): Boolean; override;
|
|
function SetBounds(const ARect: TRect): Boolean; override;
|
|
|
|
procedure SetFocus; override;
|
|
procedure SetColor(const AColor: TColor); override;
|
|
procedure SetFont(const AFont: TFont); override;
|
|
procedure SetZOrder(AOrder: HIViewZOrderOp; ARefWidget: TCarbonWidget); override;
|
|
procedure ShowHide(AVisible: Boolean); override;
|
|
|
|
function GetText(var {%H-}S: String): Boolean; override;
|
|
function SetText(const S: String): Boolean; override;
|
|
|
|
function Update: Boolean; override;
|
|
function WidgetAtPos(const {%H-}P: TPoint): ControlRef; override;
|
|
public
|
|
function Activate: Boolean; virtual;
|
|
|
|
procedure CloseModal; virtual;
|
|
procedure ShowModal; virtual;
|
|
|
|
function IsIconic: Boolean; virtual;
|
|
function IsZoomed: Boolean; virtual;
|
|
|
|
function SetForeground: Boolean; virtual;
|
|
function Show(AShow: Integer): Boolean; virtual;
|
|
|
|
procedure SetBorderIcons(ABorderIcons: TBorderIcons); virtual;
|
|
procedure SetFormBorderStyle(AFormBorderStyle: TFormBorderStyle); virtual;
|
|
public
|
|
property Window: WindowRef read FWindowRef;
|
|
property SheetWin: WindowRef read FSheetWin write FSheetWin; // used to show sheet in modal window
|
|
end;
|
|
|
|
{ TCarbonHintWindow }
|
|
|
|
TCarbonHintWindow = class(TCarbonWindow)
|
|
protected
|
|
procedure CreateWindow(const AParams: TCreateParams); override;
|
|
public
|
|
procedure ShowHide(AVisible: Boolean); override;
|
|
end;
|
|
|
|
{ TCarbonDesignWindow }
|
|
|
|
TCarbonDesignWindow = class(TCarbonWindow)
|
|
private
|
|
FDesignControl: HIViewRef;
|
|
FDesignContext: TCarbonContext;
|
|
procedure BringDesignerToFront;
|
|
protected
|
|
procedure RegisterEvents; override;
|
|
procedure CreateWidget(const AParams: TCreateParams); override;
|
|
procedure DestroyWidget; override;
|
|
public
|
|
procedure ControlAdded; override;
|
|
procedure BoundsChanged; override;
|
|
|
|
procedure SetChildZPosition(AChild: TCarbonWidget; const AOldPos, ANewPos: Integer; const AChildren: TFPList); override;
|
|
|
|
function GetDesignContext: TCarbonContext;
|
|
procedure ReleaseDesignContext;
|
|
end;
|
|
|
|
{ TCarbonGroupBox }
|
|
|
|
TCarbonGroupBox = class(TCarbonControl)
|
|
private
|
|
FUserPane: ControlRef;
|
|
FBoxColor: TColor;
|
|
protected
|
|
procedure RegisterEvents; override;
|
|
procedure CreateWidget(const AParams: TCreateParams); override;
|
|
procedure DestroyWidget; override;
|
|
function GetContent: ControlRef; override;
|
|
public
|
|
function GetPreferredSize: TPoint; override;
|
|
function GetClientRect(var ARect: TRect): Boolean; override;
|
|
function SetBounds(const ARect: TRect): Boolean; override;
|
|
procedure SetColor(const AColor: TColor); override;
|
|
end;
|
|
|
|
{ TCarbonStatusBar }
|
|
|
|
TCarbonStatusBar = class(TCarbonControl)
|
|
private
|
|
{$ifdef CarbonOldStatusBar}
|
|
FPanels: TObjectList;
|
|
{$endif}
|
|
protected
|
|
procedure CreateWidget(const AParams: TCreateParams); override;
|
|
procedure DestroyWidget; override;
|
|
public
|
|
class function GetValidEvents: TCarbonControlEvents; override;
|
|
procedure Draw; override;
|
|
public
|
|
function GetPreferredSize: TPoint; override;
|
|
procedure SetColor(const {%H-}AColor: TColor); override;
|
|
procedure SetFont(const {%H-}AFont: TFont); override;
|
|
procedure UpdatePanel({%H-}AIndex: Integer = -1);
|
|
end;
|
|
|
|
{ TCarbonStaticText }
|
|
|
|
TCarbonStaticText = class(TCarbonControl)
|
|
protected
|
|
procedure CreateWidget(const AParams: TCreateParams); override;
|
|
public
|
|
procedure BoundsChanged; override;
|
|
public
|
|
procedure SetAlignment(AAlignment: TAlignment); virtual;
|
|
end;
|
|
|
|
function GetCarbonWidget(AWidget: Pointer): TCarbonWidget;
|
|
function GetCarbonWindow(AWidget: WindowRef): TCarbonWindow;
|
|
function GetCarbonControl(AWidget: ControlRef): TCarbonControl;
|
|
|
|
const
|
|
larAXStaticTextRoles = [larClock, larLabel, larListItem, larTreeItem, larResizeGrip];
|
|
larAXListRoles = [larListBox, larTreeView];
|
|
|
|
implementation
|
|
|
|
uses InterfaceBase, CarbonInt, CarbonProc, CarbonDbgConsts, CarbonUtils, CarbonCanvas, CarbonCaret;
|
|
|
|
var
|
|
// recursive number of draw events called by OSX
|
|
IsDrawEvent : Integer = 0;
|
|
// invalidated inside OnPaint event
|
|
InvalidPaint : Boolean = false;
|
|
// invalidating
|
|
IsRepaint : Boolean = false;
|
|
|
|
|
|
|
|
{------------------------------------------------------------------------------
|
|
Name: GetCarbonWidget
|
|
Params: AWidget - Pointer to control or window widget
|
|
Returns: The Carbon widget
|
|
|
|
Retrieves widget for specified Carbon control or window
|
|
------------------------------------------------------------------------------}
|
|
function GetCarbonWidget(AWidget: Pointer): TCarbonWidget;
|
|
begin
|
|
if AWidget = nil then
|
|
begin
|
|
Result := nil;
|
|
Exit;
|
|
end;
|
|
|
|
if IsValidControlHandle(AWidget) then
|
|
Result := GetCarbonControl(ControlRef(AWidget))
|
|
else
|
|
// there is no (cheap) check for windows so assume a window
|
|
// when it is not a control.
|
|
Result := GetCarbonWindow(WindowRef(AWidget));
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Name: GetCarbonWindow
|
|
Params: AWidget - Pointer to window widget
|
|
Returns: The Carbon window
|
|
|
|
Retrieves the Carbon window for specified window widget
|
|
------------------------------------------------------------------------------}
|
|
function GetCarbonWindow(AWidget: WindowRef): TCarbonWindow;
|
|
begin
|
|
if GetWindowProperty(AWidget, LAZARUS_FOURCC, WIDGETINFO_FOURCC,
|
|
SizeOf(TCarbonWidget), nil, @Result) <> noErr then Result := nil;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Name: GetCarbonControl
|
|
Params: AWidget - Pointer to control widget
|
|
Returns: The Carbon control
|
|
|
|
Retrieves the Carbon control for specified control widget
|
|
------------------------------------------------------------------------------}
|
|
function GetCarbonControl(AWidget: ControlRef): TCarbonControl;
|
|
begin
|
|
if GetControlProperty(AWidget, LAZARUS_FOURCC, WIDGETINFO_FOURCC,
|
|
SizeOf(TCarbonWidget), nil, @Result) <> noErr then Result := nil;
|
|
end;
|
|
|
|
// Store state of key modifiers so that we can emulate keyup/keydown
|
|
// of keys like control, option, command, caps lock, shift
|
|
var PrevKeyModifiers: UInt32 = 0;
|
|
|
|
// Stores mouse up message to be fired on control hit after value is updated
|
|
var SavedMouseUpMsg: TLMMouse;
|
|
|
|
// Stores multi click mouse down message to be fired after handling standard event
|
|
var PostponedDownMsg: TLMMouse;
|
|
var PostponedDown: Boolean;
|
|
|
|
// Stores last mouse pos to call mouse move only when it really has changed
|
|
var LastMousePos: TPoint;
|
|
|
|
{$I carbonprivatecommon.inc}
|
|
{$I carbonprivatecontrol.inc}
|
|
{$I carbonprivatewindow.inc}
|
|
|
|
{ TCarbonHintWindow }
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonHintWindow.CreateWindow
|
|
Params: AParams - Creation parameters
|
|
|
|
Creates Carbon hint window
|
|
------------------------------------------------------------------------------}
|
|
procedure TCarbonHintWindow.CreateWindow(const AParams: TCreateParams);
|
|
var
|
|
AWindow: WindowRef;
|
|
begin
|
|
if OSError(
|
|
CreateNewWindow(kHelpWindowClass,
|
|
kWindowCompositingAttribute or
|
|
kWindowHideOnSuspendAttribute or kWindowStandardHandlerAttribute,
|
|
ParamsToCarbonRect(AParams), AWindow{%H-}),
|
|
Self, SCreateWidget, 'CreateNewWindow') then RaiseCreateWidgetError(LCLObject);
|
|
|
|
fWindowRef := AWindow;
|
|
|
|
// creating wrapped views
|
|
if OSError(
|
|
HIViewFindByID(HIViewGetRoot(fWindowRef), kHIViewWindowContentID, fWinContent),
|
|
Self, SCreateWidget, 'HIViewGetRoot') then RaiseCreateWidgetError(LCLObject);
|
|
|
|
OSError(
|
|
SetWindowProperty(AWindow, LAZARUS_FOURCC, WIDGETINFO_FOURCC, SizeOf(Self), @Self),
|
|
Self, SCreateWidget, 'SetWindowProperty');
|
|
OSError(
|
|
SetControlProperty(fWinContent, LAZARUS_FOURCC, WIDGETINFO_FOURCC, SizeOf(Self), @Self),
|
|
Self, SCreateWidget, SSetControlProp);
|
|
|
|
SetColor(LCLObject.Color);
|
|
end;
|
|
|
|
procedure TCarbonHintWindow.ShowHide(AVisible: Boolean);
|
|
begin
|
|
if Assigned(fWindowRef) then
|
|
MacOSAll.ShowHide(fWindowRef, AVisible or (csDesigning in LCLobject.ComponentState))
|
|
else
|
|
inherited ShowHide(AVisible);
|
|
end;
|
|
|
|
{ TCarbonDesignWindow }
|
|
|
|
{------------------------------------------------------------------------------
|
|
Name: CarbonDesign_Draw
|
|
Handles draw event
|
|
------------------------------------------------------------------------------}
|
|
function CarbonDesign_Draw(ANextHandler: EventHandlerCallRef;
|
|
AEvent: EventRef;
|
|
AWidget: TCarbonWidget): OSStatus; {$IFDEF darwin}mwpascal;{$ENDIF}
|
|
var
|
|
ADesignWindow: TCarbonDesignWindow;
|
|
AStruct: PPaintStruct;
|
|
begin
|
|
{$IFDEF VerbosePaint}
|
|
Debugln('CarbonDesign_Draw ', DbgSName(AWidget.LCLObject));
|
|
{$ENDIF}
|
|
|
|
ADesignWindow := (AWidget as TCarbonDesignWindow);
|
|
|
|
ADesignWindow.FDesignContext := TCarbonControlContext.Create(ADesignWindow);
|
|
try
|
|
// set canvas context
|
|
if OSError(
|
|
GetEventParameter(AEvent, kEventParamCGContextRef, typeCGContextRef, nil,
|
|
SizeOf(CGContextRef), nil, @(ADesignWindow.FDesignContext.CGContext)),
|
|
'CarbonDesign_Draw', SGetEvent, 'kEventParamCGContextRef') then Exit;
|
|
|
|
// let carbon draw/update
|
|
Result := CallNextEventHandler(ANextHandler, AEvent);
|
|
|
|
// draw designer stuff
|
|
New(AStruct);
|
|
FillChar(AStruct^, SizeOf(TPaintStruct), 0);
|
|
AStruct^.hdc := HDC(ADesignWindow.FDesignContext);
|
|
try
|
|
{$IFDEF VerbosePaint}
|
|
DebugLn('CarbonDesign_Draw LM_PAINT to ', DbgSName(AWidget.LCLObject));
|
|
{$ENDIF}
|
|
LCLSendPaintMsg(AWidget.LCLObject, HDC(ADesignWindow.FDesignContext), AStruct);
|
|
finally
|
|
Dispose(AStruct);
|
|
end;
|
|
finally
|
|
FreeAndNil(ADesignWindow.FDesignContext);
|
|
end;
|
|
{$IFDEF VerbosePaint}
|
|
Debugln('CarbonDesign_Draw end ', DbgSName(AWidget.LCLObject));
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonDesignWindow.BringDesignerToFront
|
|
------------------------------------------------------------------------------}
|
|
procedure TCarbonDesignWindow.BringDesignerToFront;
|
|
begin
|
|
OSError(HIViewSetZOrder(FDesignControl, kHIViewZOrderAbove, nil),
|
|
Self, 'BringDesignerToFront', 'HIViewSetZOrder');
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonDesignWindow.RegisterEvents
|
|
|
|
Registers event handlers for design window
|
|
------------------------------------------------------------------------------}
|
|
procedure TCarbonDesignWindow.RegisterEvents;
|
|
var
|
|
TmpSpec: EventTypeSpec;
|
|
begin
|
|
inherited;
|
|
|
|
TmpSpec := MakeEventSpec(kEventClassControl, kEventControlDraw);
|
|
InstallControlEventHandler(FDesignControl,
|
|
RegisterEventHandler(@CarbonDesign_Draw),
|
|
1, @TmpSpec, Pointer(Self), nil);
|
|
|
|
TmpSpec := MakeEventSpec(kEventClassControl, kEventControlTrack);
|
|
InstallControlEventHandler(FDesignControl,
|
|
RegisterEventHandler(@CarbonCommon_Track),
|
|
1, @TmpSpec, Pointer(Self), nil);
|
|
|
|
{$IFDEF VerboseWindowEvent}
|
|
DebugLn('TCarbonDesignWindow.RegisterEvents ', ClassName, ' ',
|
|
LCLObject.Name, ': ', LCLObject.ClassName);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonDesignWindow.CreateWidget
|
|
Params: AParams - Creation parameters
|
|
|
|
Creates Carbon window for designing
|
|
------------------------------------------------------------------------------}
|
|
procedure TCarbonDesignWindow.CreateWidget(const AParams: TCreateParams);
|
|
var
|
|
R: TRect;
|
|
begin
|
|
inherited;
|
|
|
|
// create custom view above all others
|
|
GetClientRect(R{%H-});
|
|
OffsetRect(R, -R.Left, -R.Top);
|
|
FDesignControl := CreateCustomHIView(RectToCGRect(R));
|
|
|
|
OSError(
|
|
HIViewChangeFeatures(FDesignControl, kHIViewFeatureDoesNotUseSpecialParts,
|
|
kHIViewFeatureGetsFocusOnClick),
|
|
SCreateWidget, 'HIViewChangeFeatures');
|
|
|
|
OSError(
|
|
SetControlProperty(FDesignControl, LAZARUS_FOURCC, WIDGETINFO_FOURCC, SizeOf(Self), @Self),
|
|
Self, SCreateWidget, SSetControlProp);
|
|
|
|
OSError(HIViewAddSubview(fWinContent, FDesignControl), Self, SCreateWidget, SViewAddView);
|
|
BringDesignerToFront;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonDesignWindow.DestroyWidget
|
|
|
|
Override to do some clean-up
|
|
------------------------------------------------------------------------------}
|
|
procedure TCarbonDesignWindow.DestroyWidget;
|
|
begin
|
|
DisposeControl(FDesignControl);
|
|
LCLObject := nil;
|
|
inherited;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonDesignWindow.ControlAdded
|
|
|
|
Notifies about control added
|
|
------------------------------------------------------------------------------}
|
|
procedure TCarbonDesignWindow.ControlAdded;
|
|
begin
|
|
BringDesignerToFront;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonDesignWindow.BoundsChanged
|
|
|
|
Handles bounds change
|
|
------------------------------------------------------------------------------}
|
|
procedure TCarbonDesignWindow.BoundsChanged;
|
|
var
|
|
R: TRect;
|
|
begin
|
|
inherited;
|
|
|
|
GetClientRect(R{%H-});
|
|
OffsetRect(R, -R.Left, -R.Top);
|
|
OSError(HIViewSetFrame(FDesignControl, RectToCGRect(R)),
|
|
Self, SSetBounds, SViewFrame);
|
|
|
|
BringDesignerToFront;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonDesignWindow.SetChildZPosition
|
|
Params: AChild - Child widget
|
|
AOldPos - Old z position
|
|
ANewPos - New z position
|
|
AChildren - List of all child controls
|
|
|
|
Sets the child z position of Carbon widget
|
|
------------------------------------------------------------------------------}
|
|
procedure TCarbonDesignWindow.SetChildZPosition(AChild: TCarbonWidget; const AOldPos,
|
|
ANewPos: Integer; const AChildren: TFPList);
|
|
begin
|
|
inherited;
|
|
|
|
BringDesignerToFront;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonDesignWindow.GetDesignContext
|
|
Returns: Context for drawing designer stuff
|
|
------------------------------------------------------------------------------}
|
|
function TCarbonDesignWindow.GetDesignContext: TCarbonContext;
|
|
begin
|
|
if FDesignContext <> nil then Result := FDesignContext
|
|
else Result := DefaultContext;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonDesignWindow.ReleaseDesignContext
|
|
|
|
Releases the context for drawing designer stuff
|
|
------------------------------------------------------------------------------}
|
|
procedure TCarbonDesignWindow.ReleaseDesignContext;
|
|
begin
|
|
// nothing
|
|
end;
|
|
|
|
{ TCarbonCustomControl }
|
|
|
|
{------------------------------------------------------------------------------
|
|
Name: CarbonScrollable_GetInfo
|
|
Handles scrollable get info
|
|
------------------------------------------------------------------------------}
|
|
function CarbonScrollable_GetInfo({%H-}ANextHandler: EventHandlerCallRef;
|
|
AEvent: EventRef;
|
|
AWidget: TCarbonWidget): OSStatus; {$IFDEF darwin}mwpascal;{$ENDIF}
|
|
var
|
|
ImageHISize, ViewHISize, LineHISize: HISize;
|
|
HIOrigin: HIPoint;
|
|
const
|
|
SName = 'CarbonScrollable_GetInfo';
|
|
begin
|
|
{$IFDEF VerboseControlEvent}
|
|
DebugLn('CarbonScrollable_GetInfo ', DbgSName(AWidget.LCLObject));
|
|
{$ENDIF}
|
|
|
|
(AWidget as TCarbonCustomControl).GetInfo(ImageHISize, ViewHISize, LineHISize, HIOrigin);
|
|
|
|
OSError(SetEventParameter(AEvent, kEventParamImageSize, typeHISize,
|
|
SizeOf(HISize), @ImageHISize), SName, SSetEvent, 'kEventParamImageSize');
|
|
OSError(SetEventParameter(AEvent, kEventParamViewSize, typeHISize,
|
|
SizeOf(HISize), @ViewHISize), SName, SSetEvent, 'kEventParamViewSize');
|
|
OSError(SetEventParameter(AEvent, kEventParamLineSize, typeHISize,
|
|
SizeOf(HISize), @LineHISize), SName, SSetEvent, 'kEventParamLineSize');
|
|
OSError(SetEventParameter(AEvent, kEventParamOrigin, typeHIPoint,
|
|
SizeOf(HIPoint), @HIOrigin), SName, SSetEvent, 'kEventParamOrigin');
|
|
|
|
Result := noErr;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Name: CarbonScrollable_ScrollTo
|
|
Handles scrollable get info
|
|
------------------------------------------------------------------------------}
|
|
function CarbonScrollable_ScrollTo({%H-}ANextHandler: EventHandlerCallRef;
|
|
AEvent: EventRef;
|
|
AWidget: TCarbonWidget): OSStatus; {$IFDEF darwin}mwpascal;{$ENDIF}
|
|
var
|
|
Origin: HIPoint;
|
|
begin
|
|
{$IFDEF VerboseControlEvent}
|
|
DebugLn('CarbonScrollable_ScrollTo ', DbgSName(AWidget.LCLObject));
|
|
{$ENDIF}
|
|
|
|
if OSError(
|
|
GetEventParameter(AEvent, kEventParamOrigin, typeHIPoint, nil,
|
|
SizeOf(HIPoint), nil, @Origin), 'CarbonScrollable_ScrollTo', SGetEvent,
|
|
'kEventParamOrigin') then Exit;
|
|
|
|
(AWidget as TCarbonCustomControl).ScrollTo(Origin);
|
|
|
|
Result := noErr;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonCustomControl.RegisterEvents
|
|
|
|
Registers event handlers for custom control
|
|
------------------------------------------------------------------------------}
|
|
procedure TCarbonCustomControl.RegisterEvents;
|
|
var
|
|
TmpSpec: EventTypeSpec;
|
|
begin
|
|
inherited RegisterEvents;
|
|
|
|
if FScrollView <> Widget then
|
|
begin
|
|
TmpSpec := MakeEventSpec(kEventClassScrollable, kEventScrollableScrollTo);
|
|
InstallControlEventHandler(Widget,
|
|
RegisterEventHandler(@CarbonScrollable_ScrollTo),
|
|
1, @TmpSpec, Pointer(Self), nil);
|
|
end;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonCustomControl.CreateWidget
|
|
Params: AParams - Creation parameters
|
|
|
|
Creates Carbon custom control
|
|
------------------------------------------------------------------------------}
|
|
procedure TCarbonCustomControl.CreateWidget(const AParams: TCreateParams);
|
|
var
|
|
TmpSpec: EventTypeSpec;
|
|
AStyle: TControlStyle;
|
|
begin
|
|
AStyle := LCLObject.ControlStyle;
|
|
|
|
if CarbonWidgetFlag = cwdTToolBar then
|
|
AStyle := AStyle + [csNoFocus];
|
|
|
|
Widget := CreateCustomHIView(ParamsToHIRect(AParams), AStyle);
|
|
if Widget = nil then RaiseCreateWidgetError(LCLObject);
|
|
|
|
// The event must be installed before embedding ScrollView. related to #19425
|
|
TmpSpec := MakeEventSpec(kEventClassScrollable, kEventScrollableGetInfo);
|
|
InstallControlEventHandler(Widget,
|
|
RegisterEventHandler(@CarbonScrollable_GetInfo),
|
|
1, @TmpSpec, Pointer(Self), nil);
|
|
|
|
FScrollView := EmbedInScrollView(AParams);
|
|
FScrollSize := Classes.Point(0, 0);
|
|
FScrollMin := Classes.Point(0, 0);
|
|
FScrollPageSize := Classes.Point(0, 0);
|
|
FScrollOrigin := GetHIPoint(0, 0);
|
|
FMulX := 1;
|
|
FMulY := 1;
|
|
|
|
if LCLObject.ClassNameIs('TSynEdit') then
|
|
FTextFractional := False
|
|
else
|
|
FTextFractional := True;
|
|
|
|
inherited;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonCustomControl.DestroyWidget
|
|
|
|
Clean-up
|
|
------------------------------------------------------------------------------}
|
|
procedure TCarbonCustomControl.DestroyWidget;
|
|
begin
|
|
if (FScrollView <> Widget) and (FScrollView <> nil) then DisposeControl(FScrollView);
|
|
|
|
inherited DestroyWidget;
|
|
end;
|
|
|
|
procedure TCarbonCustomControl.AddToWidget(AParent: TCarbonWidget);
|
|
begin
|
|
inherited AddToWidget(AParent);
|
|
// Updating ScrollInfo of the control. Sometimes Carbon shows "unused" scrollbars #16613
|
|
SendScrollUpdate;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonCustomControl.GetFrame
|
|
Params: Frame index
|
|
Returns: Frame area control
|
|
------------------------------------------------------------------------------}
|
|
function TCarbonCustomControl.GetFrame(Index: Integer): ControlRef;
|
|
begin
|
|
Result := FScrollView;
|
|
end;
|
|
|
|
function TCarbonCustomControl.GetForceEmbedInScrollView:Boolean;
|
|
begin
|
|
Result:=True;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonCustomControl.GetValidEvents
|
|
Returns: Set of events with installed handlers
|
|
------------------------------------------------------------------------------}
|
|
class function TCarbonCustomControl.GetValidEvents: TCarbonControlEvents;
|
|
begin
|
|
Result := [cceDraw];
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonCustomControl.Draw
|
|
|
|
Draw event handler
|
|
------------------------------------------------------------------------------}
|
|
procedure TCarbonCustomControl.Draw;
|
|
var
|
|
DC: TCarbonDeviceContext;
|
|
Color: TColor;
|
|
begin
|
|
if Context <> nil then
|
|
begin
|
|
DC := (Context as TCarbonDeviceContext);
|
|
|
|
if DC.CGContext <> nil then
|
|
begin
|
|
if DC.CurrentBrush <> nil then // apply control background color
|
|
begin
|
|
Color := LCLObject.Color;
|
|
if Color = clDefault then
|
|
DC.CurrentBrush.SetColor(LCLObject.GetDefaultColor(dctBrush), False)
|
|
else
|
|
if Color <> clBtnFace then
|
|
DC.CurrentBrush.SetColor(Color, True)
|
|
else
|
|
DC.CurrentBrush.SetColor(Color, False);
|
|
|
|
DC.CurrentBrush.Apply(DC, False);
|
|
if (Color <> clBtnFace) and (Color <> clDefault) then
|
|
DC.FillRect(DC.GetClipRect, DC.CurrentBrush);
|
|
end;
|
|
end;
|
|
|
|
DC.TextFractional := TextFractional;
|
|
end;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonCustomControl.GetInfo
|
|
Params: AImageSize - Size of entire scrollable area
|
|
AViewSize - Size of scrollable page
|
|
ALineSize - Size of scrollable line
|
|
AOrigin - Scroll position
|
|
|
|
Handles scrollable get info event
|
|
------------------------------------------------------------------------------}
|
|
procedure TCarbonCustomControl.GetInfo(out AImageSize, AViewSize, ALineSize: HISize;
|
|
out AOrigin: HIPoint);
|
|
var
|
|
C: TRect;
|
|
begin
|
|
// modify coordinates to fit real page size
|
|
c := LCLObject.BoundsRect;
|
|
if FScrollPageSize.X = 0 then FMulX := 1
|
|
else
|
|
FMulX := (C.Right - C.Left) / FScrollPageSize.X;
|
|
if FScrollPageSize.Y = 0 then FMulY := 1
|
|
else
|
|
FMulY := (C.Bottom - C.Top) / FScrollPageSize.Y;
|
|
|
|
AOrigin := GetHIPoint(Round(FScrollOrigin.X * FMulX), Round(FScrollOrigin.Y * FMulY));
|
|
AImageSize := GetHISize(Round(FScrollSize.X * FMulX), Round(FScrollSize.Y * FMulY));
|
|
|
|
GetBounds(C);
|
|
AViewSize := GetHISize(C.Right - C.Left, C.Bottom - C.Top);
|
|
|
|
if FMulX > 1 then
|
|
ALineSize.width := FMulX
|
|
else
|
|
ALineSize.width := 10;
|
|
|
|
if FMulY > 1 then
|
|
ALineSize.height := FMulY
|
|
else
|
|
ALineSize.height := 20;
|
|
|
|
{$IFDEF VerboseScroll}
|
|
DebugLn('TCarbonCustomControl.GetInfo ' + LCLObject.Name + ' Origin: ' +
|
|
DbgS(AOrigin) + ' Image: ' + DbgS(AImageSize) + ' View: ' +
|
|
DbgS(AViewSize) + ' Line: ' + DbgS(ALineSize));
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonCustomControlScrollTo
|
|
Params: ANewOrigin - New scroll position
|
|
|
|
Handles scrollable scroll to event
|
|
------------------------------------------------------------------------------}
|
|
procedure TCarbonCustomControl.ScrollTo(const ANewOrigin: HIPoint);
|
|
var
|
|
ScrollMsg: TLMScroll;
|
|
I: Integer;
|
|
begin
|
|
{$IFDEF VerboseScroll}
|
|
DebugLn('TCarbonCustomControl.ScrollTo ' + LCLObject.Name + ' Origin: ' +
|
|
DbgS(ANewOrigin));
|
|
{$ENDIF}
|
|
|
|
if FMulX = 0 then FScrollOrigin.X := 0
|
|
else
|
|
FScrollOrigin.X := Round(ANewOrigin.X / FMulX);
|
|
if FMulY = 0 then FScrollOrigin.Y := 0
|
|
else
|
|
FScrollOrigin.Y := Round(ANewOrigin.Y / FMulY);
|
|
|
|
// send vertical scroll
|
|
FillChar(ScrollMsg{%H-}, SizeOf(TLMScroll), 0);
|
|
with ScrollMsg do
|
|
begin
|
|
Msg := LM_VSCROLL;
|
|
Pos := Round(FScrollOrigin.Y) + FScrollMin.Y;
|
|
ScrollCode := SB_THUMBPOSITION;
|
|
end;
|
|
DeliverMessage(LCLObject, ScrollMsg);
|
|
|
|
// send horizontal scroll
|
|
FillChar(ScrollMsg, SizeOf(TLMScroll), 0);
|
|
with ScrollMsg do
|
|
begin
|
|
Msg := LM_HSCROLL;
|
|
Pos := Round(FScrollOrigin.X) + FScrollMin.X;
|
|
ScrollCode := SB_THUMBPOSITION;
|
|
end;
|
|
DeliverMessage(LCLObject, ScrollMsg);
|
|
|
|
// force update all child views - BUG in OS X
|
|
for I := 0 to LCLObject.ControlCount - 1 do
|
|
if (LCLObject.Controls[I] is TWinControl) and
|
|
(LCLObject.Controls[I] as TWinControl).HandleAllocated and
|
|
TCarbonWidget((LCLObject.Controls[I] as TWinControl).Handle).IsVisible then
|
|
begin
|
|
TCarbonWidget((LCLObject.Controls[I] as TWinControl).Handle).ShowHide(False);
|
|
TCarbonWidget((LCLObject.Controls[I] as TWinControl).Handle).ShowHide(True);
|
|
end;
|
|
|
|
// scroll bars can change client rect - update it
|
|
UpdateLCLClientRect;
|
|
|
|
OSError(
|
|
HiViewSetNeedsDisplay(Widget, True), Self, 'ScrollTo', SViewNeedsDisplay);
|
|
end;
|
|
|
|
procedure TCarbonCustomControl.Invalidate(Rect:PRect);
|
|
var
|
|
v : HIViewRef;
|
|
r : HIRect;
|
|
b : HIRect;
|
|
begin
|
|
inherited Invalidate(Rect);
|
|
|
|
// Forced invalidation of ScrollBars
|
|
if Assigned(FScrollView) and not Assigned(Rect) then
|
|
begin
|
|
v:=HIViewGetFirstSubview(FScrollView);
|
|
while Assigned(v) do
|
|
begin
|
|
HIViewSetNeedsDisplay(v, true);
|
|
v:=HIViewGetNextView(v);
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
v:=HIViewGetFirstSubview(FScrollView);
|
|
r:=RectToCGRect(Rect^);
|
|
while Assigned(v) do
|
|
begin
|
|
HIViewGetBounds(v, b);
|
|
r.origin.x:=Rect^.Left+b.origin.x;
|
|
r.origin.y:=Rect^.Top+b.origin.y;
|
|
OSError(
|
|
HIViewSetNeedsDisplayInRect(v, r, True), Self,
|
|
SInvalidate, SViewNeedsDisplayRect);
|
|
v:=HIViewGetNextView(v);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonCustomControl.SetColor
|
|
Params: AColor - New color
|
|
|
|
Sets the color of control (for edit like controls)
|
|
------------------------------------------------------------------------------}
|
|
procedure TCarbonCustomControl.SetColor(const AColor: TColor);
|
|
begin
|
|
// not supported
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonCustomControl.SetFont
|
|
Params: AFont - New font
|
|
|
|
Sets the font of control
|
|
------------------------------------------------------------------------------}
|
|
procedure TCarbonCustomControl.SetFont(const AFont: TFont);
|
|
begin
|
|
// not supported
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonCustomControl.SetScrollInfo
|
|
Params: SBStyle - Scrollbar type (SB_VERT, SB_HORZ)
|
|
ScrollInfo - Scrolling info
|
|
Returns: The new scroll bar position
|
|
|
|
Sets the scrolling info of the specified scroll bar
|
|
------------------------------------------------------------------------------}
|
|
function TCarbonCustomControl.SetScrollInfo(SBStyle: Integer;
|
|
const ScrollInfo: TScrollInfo): Integer;
|
|
begin
|
|
{$IFDEF VerboseScroll}
|
|
DebugLn('TCarbonCustomControl.SetScrollInfo ' + LCLObject.Name +
|
|
' SBStyle: ' + DbgS(SBStyle) + ' ' + DbgS(ScrollInfo));
|
|
{$ENDIF}
|
|
|
|
if (SIF_RANGE and ScrollInfo.fMask) > 0 then
|
|
begin
|
|
if SBStyle = SB_HORZ then
|
|
begin
|
|
FScrollSize.X := (ScrollInfo.nMax - ScrollInfo.nMin + 1);
|
|
FScrollMin.X := ScrollInfo.nMin;
|
|
end;
|
|
if SBStyle = SB_VERT then
|
|
begin
|
|
FScrollSize.Y := (ScrollInfo.nMax - ScrollInfo.nMin + 1);
|
|
FScrollMin.Y := ScrollInfo.nMin;
|
|
end;
|
|
end;
|
|
|
|
if (SIF_POS and ScrollInfo.fMask) > 0 then
|
|
begin
|
|
if SBStyle = SB_HORZ then
|
|
FScrollOrigin.X := ScrollInfo.nPos - FScrollMin.X;
|
|
if SBStyle = SB_VERT then
|
|
FScrollOrigin.Y := ScrollInfo.nPos - FScrollMin.Y;
|
|
end;
|
|
|
|
if (SIF_PAGE and ScrollInfo.fMask) > 0 then
|
|
begin
|
|
if SBStyle = SB_HORZ then
|
|
FScrollPageSize.X := ScrollInfo.nPage;
|
|
if SBStyle = SB_VERT then
|
|
FScrollPageSize.Y := ScrollInfo.nPage;
|
|
end;
|
|
|
|
if SBStyle = SB_HORZ then
|
|
Result := Round(FScrollOrigin.X);
|
|
if SBStyle = SB_VERT then
|
|
Result := Round(FScrollOrigin.Y);
|
|
|
|
if (SBStyle in [SB_HORZ, SB_VERT]) and
|
|
((ScrollInfo.fMask and (SIF_RANGE or SIF_POS or SIF_PAGE)) > 0) then
|
|
SendScrollUpdate;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonCustomControl.GetScrollInfo
|
|
Params: SBStyle - Scrollbar type (SB_VERT, SB_HORZ)
|
|
ScrollInfo - Record fo scrolling info
|
|
Returns: If the function suceeds
|
|
|
|
Gets the scrolling info of the specified scroll bar
|
|
------------------------------------------------------------------------------}
|
|
procedure TCarbonCustomControl.GetScrollInfo(SBStyle: Integer;
|
|
var ScrollInfo: TScrollInfo);
|
|
var
|
|
AImageSize, AViewSize, ALineSize: HISize;
|
|
AOrigin: HIPoint;
|
|
Pt: TPoint;
|
|
begin
|
|
{$IFDEF VerboseScroll}
|
|
DebugLn('TCarbonCustomControl.GetScrollInfo ' + LCLObject.Name +
|
|
' SBStyle: ' + DbgS(SBStyle) + ' ' + DbgS(ScrollInfo));
|
|
{$ENDIF}
|
|
|
|
if (SIF_RANGE and ScrollInfo.fMask) > 0 then
|
|
begin
|
|
ScrollInfo.nMin := 0;
|
|
|
|
if SBStyle = SB_HORZ then
|
|
ScrollInfo.nMax := FScrollSize.X - FScrollMin.X - 1;
|
|
if SBStyle = SB_VERT then
|
|
ScrollInfo.nMax := FScrollSize.Y - FScrollMin.Y - 1;
|
|
end;
|
|
|
|
if ((SIF_POS and ScrollInfo.fMask) > 0) then
|
|
begin
|
|
if SBStyle = SB_HORZ then
|
|
ScrollInfo.nPos := Trunc(FScrollOrigin.X) + FScrollMin.X;
|
|
if SBStyle = SB_VERT then
|
|
ScrollInfo.nPos := Trunc(FScrollOrigin.Y) + FScrollMin.Y;
|
|
end;
|
|
|
|
if (SIF_PAGE and ScrollInfo.fMask) > 0 then
|
|
begin
|
|
if SBStyle = SB_HORZ then
|
|
ScrollInfo.nPage := FScrollPageSize.X;
|
|
if SBStyle = SB_VERT then
|
|
ScrollInfo.nPage := FScrollPageSize.Y;
|
|
end;
|
|
|
|
if ((SIF_TRACKPOS and ScrollInfo.fMask) > 0) then
|
|
begin
|
|
GetInfo(AImageSize, AViewSize, ALineSize, AOrigin);
|
|
Pt := HIPointToPoint(AOrigin);
|
|
if SBStyle = SB_HORZ then
|
|
ScrollInfo.nTrackPos := Pt.X
|
|
else
|
|
if SBStyle = SB_VERT then
|
|
ScrollInfo.nTrackPos := Pt.Y;
|
|
end;
|
|
|
|
{$IFDEF VerboseScroll}
|
|
DebugLn('TCarbonCustomControl.GetScrollInfo Result: ' + DbgS(ScrollInfo));
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TCarbonCustomControl.GetScrollbarVisible(SBStyle: Integer): Boolean;
|
|
begin
|
|
case SBStyle of
|
|
SB_VERT:
|
|
Result := FScrollPageSize.Y < (FScrollSize.Y - FScrollMin.Y);
|
|
SB_HORZ:
|
|
Result := FScrollPageSize.X < (FScrollSize.X - FScrollMin.X);
|
|
else
|
|
Result := False;
|
|
end;
|
|
end;
|
|
|
|
{ TCarbonScrollingWinControl }
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonScrollingWinControl.CreateWidget
|
|
Params: AParams - Creation parameters
|
|
|
|
Creates Carbon scrolling window control
|
|
------------------------------------------------------------------------------}
|
|
procedure TCarbonScrollingWinControl.CreateWidget(const AParams: TCreateParams);
|
|
var
|
|
Params: TCreateParams;
|
|
begin
|
|
Params := AParams;
|
|
// add both scrollbars
|
|
Params.Style := Params.Style or WS_HSCROLL or WS_VSCROLL;
|
|
|
|
inherited CreateWidget(Params);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonScrollingWinControl.GetForceEmbedInScrollView
|
|
Returns: Whether use scroll view even if no scroll bars are needed
|
|
------------------------------------------------------------------------------}
|
|
function TCarbonScrollingWinControl.GetForceEmbedInScrollView: Boolean;
|
|
begin
|
|
Result := True;
|
|
end;
|
|
|
|
function TCarbonScrollingWinControl.GetWindowRelativePos(winX, winY: Integer): TPoint;
|
|
var
|
|
sz : HISize;
|
|
org : HIPoint;
|
|
begin
|
|
Result:=inherited GetWindowRelativePos(winX, winY);
|
|
GetInfo(sz, sz, sz, org);
|
|
dec(Result.X, Trunc(org.x));
|
|
dec(Result.Y, Trunc(org.y));
|
|
end;
|
|
|
|
function TCarbonScrollingWinControl.GetPreferredSize: TPoint;
|
|
begin
|
|
Result.X:=0;
|
|
Result.Y:=0;
|
|
end;
|
|
|
|
{ TCarbonGroupBox }
|
|
|
|
|
|
function CarbonGroupBox_Draw(ANextHandler: EventHandlerCallRef;
|
|
AEvent: EventRef;
|
|
AWidget: TCarbonWidget): OSStatus; {$IFDEF darwin}mwpascal;{$ENDIF}
|
|
var
|
|
ABox : TCarbonGroupBox;
|
|
Context : CGContextRef;
|
|
c : TColorRef;
|
|
b : TRect;
|
|
const
|
|
rgbkoef = 1 / 255;
|
|
begin
|
|
{$IFDEF VerbosePaint}
|
|
Debugln('CarbonGroupBox_Draw ', DbgSName(AWidget.LCLObject));
|
|
{$ENDIF}
|
|
|
|
ABox := (AWidget as TCarbonGroupBox);
|
|
|
|
try
|
|
Context := nil;
|
|
if (ABox.FBoxColor <> clBtnFace) and (ABox.FBoxColor <> clDefault) then
|
|
begin
|
|
if OSError(
|
|
GetEventParameter(AEvent, kEventParamCGContextRef, typeCGContextRef, nil,
|
|
SizeOf(CGContextRef), nil, @Context),
|
|
'CarbonGroupBox_Draw', SGetEvent, 'kEventParamCGContextRef') then Exit;
|
|
if Assigned(Context) then
|
|
begin
|
|
c := ColorToRGB(ABox.FBoxColor);
|
|
ABox.GetBounds(b{%H-});
|
|
CGContextSaveGState(Context);
|
|
CGContextSetRGBFillColor(Context, (c and $FF) * rgbkoef, ((c shr 8) and $FF)*rgbkoef,
|
|
((c shr 16) and $FF)*rgbkoef, 1);
|
|
with b do CGContextFillRect(Context, RectToCGRect(Bounds(0,0, Right-Left, Bottom-Top)));
|
|
CGContextRestoreGState(Context);
|
|
end;
|
|
end;
|
|
|
|
// let carbon draw/update
|
|
Result := CallNextEventHandler(ANextHandler, AEvent);
|
|
|
|
finally
|
|
end;
|
|
{$IFDEF VerbosePaint}
|
|
Debugln('CarbonGroupBox_Draw end ', DbgSName(AWidget.LCLObject));
|
|
{$ENDIF}
|
|
end;
|
|
|
|
|
|
procedure TCarbonGroupBox.RegisterEvents;
|
|
var
|
|
TmpSpec: EventTypeSpec;
|
|
begin
|
|
inherited;
|
|
TmpSpec := MakeEventSpec(kEventClassControl, kEventControlDraw);
|
|
InstallControlEventHandler(Widget,
|
|
RegisterEventHandler(@CarbonGroupBox_Draw),
|
|
1, @TmpSpec, Pointer(Self), nil);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonGroupBox.CreateWidget
|
|
Params: AParams - Creation parameters
|
|
|
|
Creates Carbon custom group box
|
|
------------------------------------------------------------------------------}
|
|
procedure TCarbonGroupBox.CreateWidget(const AParams: TCreateParams);
|
|
var
|
|
Control: ControlRef;
|
|
R: TRect;
|
|
begin
|
|
if OSError(
|
|
CreateGroupBoxControl(GetTopParentWindow, ParamsToCarbonRect(AParams),
|
|
nil, not (LCLObject.Parent is TCustomGroupBox), Control{%H-}),
|
|
Self, SCreateWidget, 'CreateGroupBoxControl') then RaiseCreateWidgetError(LCLObject);
|
|
|
|
Widget := Control;
|
|
|
|
if not GetClientRect(R{%H-}) then
|
|
begin
|
|
DebugLn('TCarbonGroupBox.CreateWidget Error - no content region!');
|
|
Exit;
|
|
end;
|
|
|
|
FUserPane := CreateCustomHIView(RectToCGRect(R));
|
|
if FUserPane = nil then RaiseCreateWidgetError(LCLObject);
|
|
|
|
OSError(HIViewSetVisible(FUserPane, True), Self, SCreateWidget, SViewVisible);
|
|
|
|
if OSError(HIViewAddSubview(Control, FUserPane), Self, SCreateWidget,
|
|
SViewAddView) then RaiseCreateWidgetError(LCLObject);
|
|
|
|
inherited;
|
|
|
|
SetText(AParams.Caption);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonGroupBox.DestroyWidget
|
|
|
|
Clean-up
|
|
------------------------------------------------------------------------------}
|
|
procedure TCarbonGroupBox.DestroyWidget;
|
|
begin
|
|
DisposeControl(FUserPane);
|
|
|
|
inherited DestroyWidget;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonGroupBox.GetContent
|
|
Returns: Content area control
|
|
------------------------------------------------------------------------------}
|
|
function TCarbonGroupBox.GetContent: ControlRef;
|
|
begin
|
|
Result := FUserPane;
|
|
end;
|
|
|
|
function TCarbonGroupBox.GetPreferredSize:TPoint;
|
|
const
|
|
DefaultWidth = 8;
|
|
DefaultHeight = 22;
|
|
var
|
|
ContentRect: TRect;
|
|
BoundsRect: TRect;
|
|
begin
|
|
Result := inherited;
|
|
if GetBounds(BoundsRect{%H-}) and
|
|
((BoundsRect.Right - BoundsRect.Left) = Result.X) and
|
|
((BoundsRect.Bottom - BoundsRect.Top) = Result.Y) then
|
|
begin
|
|
// OSX does not know the preferred size and returned us the bounds rect size
|
|
Result.X := DefaultWidth;
|
|
Result.Y := DefaultHeight;
|
|
end
|
|
else
|
|
if GetClientRect(ContentRect{%H-}) then
|
|
begin
|
|
Dec(Result.X, ContentRect.Right - ContentRect.Left);
|
|
Dec(Result.Y, ContentRect.Bottom - ContentRect.Top);
|
|
end;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonGroupBox.GetClientRect
|
|
Params: ARect - Record for client area coordinates
|
|
Returns: If the function succeeds
|
|
|
|
Returns the control client rectangle relative to the control origin
|
|
------------------------------------------------------------------------------}
|
|
function TCarbonGroupBox.GetClientRect(var ARect: TRect): Boolean;
|
|
begin
|
|
Result := GetControlContentRect(ARect);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonGroupBox.SetBounds
|
|
Params: ARect - Record for control coordinates
|
|
Returns: If function succeeds
|
|
|
|
Sets the control bounding rectangle relative to the client origin of its
|
|
parent
|
|
------------------------------------------------------------------------------}
|
|
function TCarbonGroupBox.SetBounds(const ARect: TRect): Boolean;
|
|
begin
|
|
Result := False;
|
|
if not inherited SetBounds(ARect) then Exit;
|
|
Result := UpdateContentBounds;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonGroupBox.SetColor
|
|
Params: AColor - color of group box
|
|
|
|
Sets groupbox's color
|
|
------------------------------------------------------------------------------}
|
|
procedure TCarbonGroupBox.SetColor(const AColor: TColor);
|
|
begin
|
|
FBoxColor := AColor;
|
|
inherited SetColor(AColor);
|
|
end;
|
|
|
|
{ TCarbonStatusBar }
|
|
|
|
type
|
|
TStatusItemData = record
|
|
Text : AnsiString;
|
|
Width : Integer;
|
|
Align : TAlignment;
|
|
end;
|
|
|
|
TItemDrawEvent = procedure (ItemIndex: Integer; const r: TRect; const ItemData: TStatusItemData) of object;
|
|
|
|
const
|
|
StatusHeight = 15;
|
|
|
|
procedure DrawSection(Ctx: CGContextRef; const r: TRect; data: TStatusItemData);
|
|
var
|
|
cr : CGRect;
|
|
cf : CFStringRef;
|
|
info : HIThemeButtonDrawInfo;
|
|
txtinfo : HIThemeTextInfo;
|
|
const
|
|
txtHorzFlush : array [TAlignment] of Integer =
|
|
(kHIThemeTextHorizontalFlushLeft,kHIThemeTextHorizontalFlushRight,kHIThemeTextHorizontalFlushCenter);
|
|
begin
|
|
cr:=RectToCGRect(r);
|
|
FillChar(info{%H-}, sizeof(info), 0);
|
|
info.kind:=kThemeListHeaderButton;
|
|
info.state:=kThemeStateActive;
|
|
HIThemeDrawButton( cr, info, ctx, 0, nil);
|
|
|
|
cr.origin.x:=cr.origin.x+2;
|
|
cr.origin.y:=cr.origin.y+1;
|
|
cr.size.width:=cr.size.width-6;
|
|
if data.Text<>'' then
|
|
begin
|
|
CreateCFString(data.Text, cf);
|
|
if Assigned(cf) then
|
|
begin
|
|
FillChar(txtinfo{%H-}, sizeof(txtinfo), 0);
|
|
txtinfo.version:=1;
|
|
//txtinfo.fontID:=kThemeMiniSystemFont;
|
|
txtinfo.horizontalFlushness:=txtHorzFlush[data.align];
|
|
txtinfo.fontID:=kThemeSmallSystemFont;
|
|
txtinfo.state:=kThemeStateActive;
|
|
HIThemeSetTextFill(kThemeTextColorListView, nil, ctx, 0);
|
|
HIThemeDrawTextBox(cf, cr, txtinfo, ctx, 0);
|
|
end;
|
|
CFRelease(cf);
|
|
end;
|
|
end;
|
|
|
|
procedure DrawCarbonStatusBar(Ctx: CGContextRef; const bnd: TRect; Items: array of TStatusItemData; OnItemDraw: TItemDrawEvent);
|
|
var
|
|
i : Integer;
|
|
x : Integer;
|
|
xn : Integer;
|
|
r : TRect;
|
|
const
|
|
dummy : TStatusItemData = (Text:''; Width:0; align: taLeftJustify);
|
|
ExtraWidth=2;
|
|
begin
|
|
if length(Items)>0 then
|
|
begin
|
|
x:=bnd.Left;
|
|
for i:=0 to length(Items)-2 do
|
|
begin
|
|
xn:=x+Items[i].Width;
|
|
r:=Types.Rect(x, bnd.Top, xn+ExtraWidth, bnd.Bottom);
|
|
DrawSection(Ctx, r, Items[i]);
|
|
dec(r.Right, ExtraWidth);
|
|
if Assigned(OnItemDraw) then OnItemDraw(i, r, Items[i]);
|
|
x:=xn;
|
|
end;
|
|
|
|
i:=length(Items)-1;
|
|
r:=Types.Rect(x, bnd.Top, bnd.Right, bnd.Bottom);
|
|
DrawSection(Ctx, r, Items[i]);
|
|
if Assigned(OnItemDraw) then OnItemDraw(i, r, Items[i]);
|
|
end
|
|
else
|
|
begin
|
|
DrawSection(Ctx, bnd, dummy);
|
|
if Assigned(OnItemDraw) then OnItemDraw(-1, bnd, dummy);
|
|
end;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonStatusBar.CreateWidget
|
|
Params: AParams - Creation parameters
|
|
|
|
Creates Carbon status bar
|
|
------------------------------------------------------------------------------}
|
|
procedure TCarbonStatusBar.CreateWidget(const AParams: TCreateParams);
|
|
{$ifdef CarbonOldStatusBar}
|
|
var
|
|
Control: ControlRef;
|
|
{$endif}
|
|
begin
|
|
{$ifdef CarbonOldStatusBar}
|
|
if OSError(
|
|
CreatePlacardControl(GetTopParentWindow, ParamsToCarbonRect(AParams), Control),
|
|
Self, SCreateWidget, 'CreatePlacardControl') then RaiseCreateWidgetError(LCLObject);
|
|
Widget := Control;
|
|
{$else}
|
|
Widget := CreateCustomHIView(ParamsToHIRect(AParams), LCLObject.ControlStyle);
|
|
{$endif}
|
|
|
|
inherited;
|
|
|
|
{$ifdef CarbonOldStatusBar}
|
|
FPanels := TObjectList.Create(True);
|
|
UpdatePanel; // add panels
|
|
{$endif}
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonStatusBar.DestroyWidget
|
|
|
|
Clean-up
|
|
------------------------------------------------------------------------------}
|
|
procedure TCarbonStatusBar.DestroyWidget;
|
|
begin
|
|
{$ifdef CarbonOldStatusBar}
|
|
FPanels.Free;
|
|
{$endif}
|
|
inherited DestroyWidget;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonStatusBar.GetValidEvents
|
|
Returns: Set of events with installed handlers
|
|
------------------------------------------------------------------------------}
|
|
class function TCarbonStatusBar.GetValidEvents: TCarbonControlEvents;
|
|
begin
|
|
Result := [cceDraw];
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonStatusBar.Draw
|
|
|
|
Draw event handler
|
|
------------------------------------------------------------------------------}
|
|
procedure TCarbonStatusBar.Draw;
|
|
var
|
|
StatusBar : TStatusBar;
|
|
R : TRect;
|
|
{$ifndef CarbonOldStatusBar}
|
|
items : array of TStatusItemData;
|
|
i : Integer;
|
|
{$endif}
|
|
begin
|
|
StatusBar := LCLObject as TStatusBar;
|
|
{$ifdef CarbonOldStatusBar}
|
|
if StatusBar.SimplePanel and (StatusBar.SimpleText <> '') then
|
|
begin
|
|
GetClientRect(R);
|
|
|
|
(Context as TCarbonDeviceContext).ExtTextOut(R.Top, R.Left, 0, nil,
|
|
PChar(StatusBar.SimpleText), Length(StatusBar.SimpleText), nil);
|
|
end;
|
|
{$else}
|
|
StatusBar := LCLObject as TStatusBar;
|
|
GetClientRect(r{%H-});
|
|
if StatusBar.SimplePanel then
|
|
begin
|
|
SetLength(items, 1);
|
|
items[0].Width:=r.Right-r.Left;
|
|
items[0].Text:=StatusBar.SimpleText;
|
|
items[0].Align:=taLeftJustify; //todo: select proper Justify based on lanuage text-mode (r2l, l2r)!
|
|
end
|
|
else
|
|
begin
|
|
SetLength(items, StatusBar.Panels.Count);
|
|
for i:=0 to length(items)-1 do
|
|
begin
|
|
items[i].Width:=StatusBar.Panels[i].Width;
|
|
items[i].Text:=StatusBar.Panels[i].Text;
|
|
items[i].Align:=StatusBar.Panels[i].Alignment;
|
|
end;
|
|
end;
|
|
DrawCarbonStatusBar( TCarbonContext(Context).CGContext, r, items, nil);
|
|
{$endif}
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonStatusBar.GetPreferredSize
|
|
Returns: The preffered size of status bar for autosizing or (0, 0)
|
|
------------------------------------------------------------------------------}
|
|
function TCarbonStatusBar.GetPreferredSize: TPoint;
|
|
{$ifdef CarbonOldStatusBar}
|
|
const
|
|
CarbonStatusBarHeight = 20; // should statusbar height be evaluated of the default font's height?
|
|
{$else}
|
|
const
|
|
CarbonStatusBarHeight = StatusHeight; // should statusbar height be evaluated of the default font's height?
|
|
{$endif}
|
|
begin
|
|
Result := inherited GetPreferredSize;
|
|
|
|
// stretch status bar to whole window width
|
|
if LCLObject.Parent <> nil then
|
|
begin
|
|
Result.X := LCLObject.Parent.ClientWidth;
|
|
Result.Y := CarbonStatusBarHeight;
|
|
end;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonStatusBar.SetColor
|
|
Params: AColor - New color
|
|
|
|
Sets the color of control (for edit like controls)
|
|
------------------------------------------------------------------------------}
|
|
procedure TCarbonStatusBar.SetColor(const AColor: TColor);
|
|
begin
|
|
// not supported
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonStatusBar.SetFont
|
|
Params: AFont - New font
|
|
|
|
Sets the font of control
|
|
------------------------------------------------------------------------------}
|
|
procedure TCarbonStatusBar.SetFont(const AFont: TFont);
|
|
begin
|
|
// not supported
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonStatusBar.UpdatePanel
|
|
Params: AIndex - Index of panel to update or -1 to update all
|
|
|
|
Updates properties of the specified panel(s) of status bar
|
|
------------------------------------------------------------------------------}
|
|
procedure TCarbonStatusBar.UpdatePanel(AIndex: Integer);
|
|
{$ifdef CarbonOldStatusBar}
|
|
var
|
|
StatusBar: TStatusBar;
|
|
I, X: Integer;
|
|
Panel: TPanel;
|
|
{$endif}
|
|
begin
|
|
{$ifdef CarbonOldStatusBar}
|
|
StatusBar := LCLObject as TStatusBar;
|
|
|
|
if StatusBar.SimplePanel then
|
|
begin
|
|
// hide panels
|
|
for I := 0 to FPanels.Count - 1 do (FPanels[I] as TPanel).Hide;
|
|
end
|
|
else
|
|
begin
|
|
X := 0;
|
|
|
|
for I := 0 to StatusBar.Panels.Count - 1 do
|
|
begin
|
|
if I >= FPanels.Count then // create new panel
|
|
begin
|
|
Panel := TPanel.Create(nil);
|
|
Panel.Visible := False;
|
|
|
|
Panel.Height := LCLObject.Height;
|
|
Panel.Parent := LCLObject;
|
|
|
|
FPanels.Add(Panel);
|
|
end
|
|
else Panel := FPanels[I] as TPanel;
|
|
|
|
if I >= AIndex then // reposition panel
|
|
begin
|
|
Panel.Left := X;
|
|
|
|
if (I = AIndex) or (AIndex = -1) then // update panel attrs
|
|
begin
|
|
Panel.Width := StatusBar.Panels[I].Width;
|
|
if I = StatusBar.Panels.Count - 1 then
|
|
Panel.Align:=alClient
|
|
else
|
|
Panel.Align:=alLeft;
|
|
Panel.Caption := StatusBar.Panels[I].Text;
|
|
Panel.Alignment := StatusBar.Panels[I].Alignment;
|
|
Panel.BevelOuter := TPanelBevel(StatusBar.Panels[I].Bevel);
|
|
end;
|
|
end;
|
|
Panel.Show;
|
|
|
|
Inc(X, Panel.Width);
|
|
end;
|
|
|
|
// delete unneeded panels
|
|
for I := FPanels.Count - 1 downto StatusBar.Panels.Count do
|
|
FPanels.Delete(I);
|
|
end;
|
|
{$endif}
|
|
Invalidate;
|
|
end;
|
|
|
|
{ TCarbonStaticText }
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonStaticText.CreateWidget
|
|
Params: AParams - Creation parameters
|
|
|
|
Creates Carbon static text
|
|
------------------------------------------------------------------------------}
|
|
procedure TCarbonStaticText.CreateWidget(const AParams: TCreateParams);
|
|
var
|
|
Control: ControlRef;
|
|
MultiLine: Boolean = True;
|
|
FontStyle: ControlFontStyleRec;
|
|
begin
|
|
FontStyle.flags := kControlUseJustMask;
|
|
case (LCLObject as TCustomStaticText).Alignment of
|
|
taLeftJustify: FontStyle.just := teFlushLeft;
|
|
taRightJustify: FontStyle.just := teFlushRight;
|
|
taCenter: FontStyle.just := teCenter;
|
|
end;
|
|
|
|
if OSError(
|
|
CreateStaticTextControl(GetTopParentWindow, ParamsToCarbonRect(AParams),
|
|
nil, @FontStyle, Control{%H-}),
|
|
Self, SCreateWidget, 'CreateStaticTextControl') then RaiseCreateWidgetError(LCLObject);
|
|
|
|
Widget := Control;
|
|
|
|
inherited;
|
|
|
|
SetText(AParams.Caption);
|
|
|
|
// switch on multi-line attribute
|
|
OSError(
|
|
SetControlData(Control, kControlEntireControl,
|
|
kControlStaticTextIsMultilineTag, SizeOf(Boolean), @MultiLine),
|
|
Self, SCreateWidget, SSetData, 'kControlStaticTextIsMultilineTag');
|
|
end;
|
|
|
|
const
|
|
// values are used from Interface Builder
|
|
StdStaticTextNormalSize = 16;
|
|
StdStaticTextSmallSize = 13;
|
|
StdStaticTextTinySize = 0; // 11
|
|
|
|
procedure TCarbonStaticText.BoundsChanged;
|
|
begin
|
|
inherited BoundsChanged;
|
|
SetControlViewStyle(Widget, StdStaticTextTinySize, StdStaticTextSmallSize, StdStaticTextNormalSize);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCarbonStaticText.SetAlignment
|
|
Params: AAlignment - New caption alignment
|
|
|
|
Sets the new caption alignment of Carbon static text
|
|
------------------------------------------------------------------------------}
|
|
procedure TCarbonStaticText.SetAlignment(AAlignment: TAlignment);
|
|
var
|
|
FontStyle: ControlFontStyleRec;
|
|
const
|
|
SName = 'SetAlignment';
|
|
begin
|
|
// get static text font style and change only justification
|
|
OSError(
|
|
GetControlData(ControlRef(Widget), kControlEntireControl,
|
|
kControlStaticTextStyleTag, SizeOf(FontStyle), @FontStyle, nil),
|
|
Self, SName, SGetData);
|
|
|
|
FontStyle.flags := FontStyle.flags or kControlUseJustMask;
|
|
case AAlignment of
|
|
taLeftJustify : FontStyle.just := teFlushLeft;
|
|
taRightJustify: FontStyle.just := teFlushRight;
|
|
taCenter : FontStyle.just := teCenter;
|
|
end;
|
|
|
|
OSError(
|
|
SetControlData(ControlRef(Widget), kControlEntireControl,
|
|
kControlStaticTextStyleTag, SizeOf(FontStyle), @FontStyle),
|
|
Self, SName, SSetData);
|
|
|
|
Invalidate;
|
|
end;
|
|
|
|
|
|
|
|
end.
|
|
|
|
|