{                 --------------------------------------------
                  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 AddToWidget(AParent: TCarbonWidget); override;

    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 LazUTF8, 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.AddToWidget

  Override to perform docked design window
 ------------------------------------------------------------------------------}
procedure TCarbonDesignWindow.AddToWidget(AParent: TCarbonWidget);
begin
  inherited AddToWidget(AParent);

  if not Assigned(fWindowRef) then
  begin
    HIViewRemoveFromSuperview(FDesignControl);
    OSError(HIViewAddSubview(HIViewGetFirstSubview(FScrollView), FDesignControl),
      Self, 'AddToWidget', SViewAddView);
    BringDesignerToFront;
  end else
  begin
    HIViewRemoveFromSuperview(FDesignControl);
    OSError(HIViewAddSubview(fWinContent, FDesignControl), Self, 'AddToWidget',
      SViewAddView);
    BringDesignerToFront;
  end;
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;

  if Assigned(FWindowRef) then
    GetClientRect(R{%H-})
  else
    GetScreenBounds(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);
        CGContextFillRect(Context, RectToCGRect(Bounds(0,0, b.Right-b.Left, b.Bottom-b.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.


