Carbon intf: implemented Caret

- fixed bug #0010058 Carbon TStatusBar is made transparent by its panels
- implemented TextFractional property

git-svn-id: trunk@12895 -

.gitattributes

@@ -2785,6 +2785,7 @@ lcl/interfaces/carbon/README.txt svneol=native#text/plain
 lcl/interfaces/carbon/carbonbars.pp svneol=native#text/pascal
 lcl/interfaces/carbon/carbonbuttons.pp svneol=native#text/pascal
 lcl/interfaces/carbon/carboncanvas.pp svneol=native#text/pascal
+lcl/interfaces/carbon/carboncaret.pas svneol=native#text/pascal
 lcl/interfaces/carbon/carbonclipboard.pp svneol=native#text/pascal
 lcl/interfaces/carbon/carbondbgconsts.pp svneol=native#text/pascal
 lcl/interfaces/carbon/carbondebug.inc svneol=native#text/plain

lcl/interfaces/carbon/carboncanvas.pp

@@ -81,6 +81,7 @@ type
     FClipRegion: TCarbonRegion;
     
     FSavedDCList: TFPObjectList;
+    FTextFractional: Boolean;
 
     procedure SetBkColor(const AValue: TColor);
     procedure SetBkMode(const AValue: Integer);
@@ -116,8 +117,10 @@ type
     function ExtTextOut(X, Y: Integer; Options: Longint; Rect: PRect; Str: PChar; Count: Longint; Dx: PInteger): Boolean;
     procedure FillRect(Rect: TRect; Brush: TCarbonBrush);
     procedure Frame3D(var ARect: TRect; const FrameWidth: integer; const Style: TBevelCut);
+    function GetClipRect: TRect;
     function GetTextExtentPoint(Str: PChar; Count: Integer; var Size: TSize): Boolean;
     function GetTextMetrics(var TM: TTextMetric): Boolean;
+    procedure InvertRectangle(X1, Y1, X2, Y2: Integer);
     procedure LineTo(X, Y: Integer);
     procedure PolyBezier(Points: PPoint; NumPts: Integer; Filled, Continuous: boolean);
     procedure Polygon(Points: PPoint; NumPts: Integer; Winding: boolean);
@@ -144,6 +147,8 @@ type
 
     property ROP2: Integer read FROP2 write SetROP2;
     property PenPos: TPoint read FPenPos write FPenPos;
+    
+    property TextFractional: Boolean read FTextFractional write FTextFractional;
   end;
 
   { TCarbonScreenContext }
@@ -164,6 +169,7 @@ type
     function GetSize: TPoint; override;
   public
     constructor Create(AOwner: TCarbonWidget);
+    procedure Reset; override;
   end;
 
   { TCarbonBitmapContext }
@@ -389,17 +395,19 @@ begin
   FBkBrush := TCarbonBrush.Create(False);
   FTextBrush := TCarbonBrush.Create(False);
   
-  FCurrentPen := BlackPen;
+  FCurrentPen := DefaultPen;
   FCurrentPen.Select;
-  FCurrentBrush := WhiteBrush;
+  FCurrentBrush := DefaultBrush;
   FCurrentBrush.Select;
-  FCurrentFont := StockSystemFont;
+  FCurrentFont := DefaultFont;
   FCurrentFont.Select;
   
   FClipRegion := TCarbonRegion.Create;
 
   FCurrentRegion := FClipRegion;
   FCurrentRegion.Select;
+  
+  FTextFractional := True;
 end;
 
 {------------------------------------------------------------------------------
@@ -446,7 +454,7 @@ begin
   // set raster operation to copy
   FROP2 := R2_COPYPEN;
 
-  CurrentFont := StockSystemFont;
+  CurrentFont := DefaultFont;
   
   if CGContext <> nil then
   begin
@@ -458,8 +466,8 @@ begin
     CGContextSetShouldAntialias(CGContext, 1);
     
     // set initial pen, brush and font
-    CurrentPen := BlackPen;
-    CurrentBrush := WhiteBrush;
+    CurrentPen := DefaultPen;
+    CurrentBrush := DefaultBrush;
   end;
 end;
 
@@ -645,16 +653,18 @@ begin
   if OSError(ATSUSetLayoutControls(ALayout, 1, @Tag, @DataSize, @PValue),
     Self, SName, 'ATSUSetLayoutControls', 'LineRotation') then Exit;
 
-  // disable fractional positions of glyphs in layout
-  Tag := kATSULineLayoutOptionsTag;
-  DataSize := SizeOf(ATSLineLayoutOptions);
-
-  Options := kATSLineFractDisable or kATSLineDisableAutoAdjustDisplayPos or
-    kATSLineDisableAllLayoutOperations or kATSLineUseDeviceMetrics;
-  PValue := @Options;
-  if OSError(ATSUSetLayoutControls(ALayout, 1, @Tag, @DataSize, @PValue),
-    Self, SName, 'ATSUSetLayoutControls', 'LineLayoutOptions') then Exit;
+  if not TextFractional then
+  begin
+    // disable fractional positions of glyphs in layout
+    Tag := kATSULineLayoutOptionsTag;
+    DataSize := SizeOf(ATSLineLayoutOptions);
 
+    Options := kATSLineFractDisable or kATSLineDisableAutoAdjustDisplayPos or
+      kATSLineDisableAllLayoutOperations or kATSLineUseDeviceMetrics;
+    PValue := @Options;
+    if OSError(ATSUSetLayoutControls(ALayout, 1, @Tag, @DataSize, @PValue),
+      Self, SName, 'ATSUSetLayoutControls', 'LineLayoutOptions') then Exit;
+  end;
 
   // set layout context
   Tag := kATSUCGContextTag;
@@ -836,6 +846,8 @@ const
   SName = 'ExtTextOut';
 begin
   Result := False;
+  //DebugLn('TCarbonDeviceContext.ExtTextOut ' + DbgS(X) + ', ' + DbgS(Y) + ' R: ' + DbgS(Rect^) +
+  //  ' S: ' + Str + ' C: ' + DbgS(Count));
   
   if not BeginTextRender(Str, Count, TextLayout) then
   begin
@@ -930,8 +942,6 @@ var
 const
   SName = 'Frame3D';
 begin
-  if CurrentBrush.Solid then FillRect(ARect, CurrentBrush);
-
   if Style = bvRaised then
   begin
     D := GetCarbonThemeMetric(kThemeMetricPrimaryGroupBoxContentInset, 1);
@@ -953,6 +963,15 @@ begin
   end;
 end;
 
+{------------------------------------------------------------------------------
+  Method:  TCarbonDeviceContext.GetClipRect
+  Returns: Clipping rectangle
+ ------------------------------------------------------------------------------}
+function TCarbonDeviceContext.GetClipRect: TRect;
+begin
+  Result := CGRectToRect(CGContextGetClipBoundingBox(CGContext));
+end;
+
 {------------------------------------------------------------------------------
   Method:  TCarbonDeviceContext.GetTextExtentPoint
   Params:  Str   - Text string
@@ -1070,6 +1089,29 @@ begin
   Result := True;
 end;
 
+{------------------------------------------------------------------------------
+  Method:  TCarbonDeviceContext.InvertRectangle
+  Params:  X1 - X-coordinate of bounding rectangle's upper-left corner
+           Y1 - Y-coordinate of bounding rectangle's upper-left corner
+           X2 - X-coordinate of bounding rectangle's lower-right corner
+           Y2 - Y-coordinate of bounding rectangle's lower-right corner
+
+  Draws an inverted rectangle.
+ ------------------------------------------------------------------------------}
+procedure TCarbonDeviceContext.InvertRectangle(X1, Y1, X2, Y2: Integer);
+begin
+  // save dest context
+  CGContextSaveGState(CGContext);
+  try
+    WhiteBrush.Apply(Self, False);
+    CGContextSetBlendMode(CGContext, kCGBlendModeDifference);
+    
+    CGContextFillRect(CGContext, GetCGRectSorted(X1, Y1, X2, Y2));
+  finally
+    CGContextRestoreGState(CGContext);
+  end;
+end;
+
 {------------------------------------------------------------------------------
   Method:  TCarbonDeviceContext.LineTo
   Params:  X  - X-coordinate of line's ending point
@@ -1423,6 +1465,30 @@ begin
   Reset;
 end;
 
+{------------------------------------------------------------------------------
+  Method:  TCarbonControlContext.Reset
+
+  Resets the control context properties to defaults (pen, brush, ...)
+ ------------------------------------------------------------------------------}
+procedure TCarbonControlContext.Reset;
+begin
+  inherited Reset;
+  
+  if CGContext <> nil then
+    if CurrentBrush <> nil then // apply control background color
+    begin
+      if FOwner.LCLObject.Color <> clBtnFace then
+        CurrentBrush.SetColor(FOwner.LCLObject.Color, True)
+      else
+        CurrentBrush.SetColor(FOwner.LCLObject.Color, False);
+        
+      CurrentBrush.Apply(Self, False);
+    end;
+  
+  if FOwner.LCLObject.Font.Handle <> 0 then
+    CurrentFont := TCarbonFont(FOwner.LCLObject.Font.Handle);
+end;
+
 { TCarbonBitmapContext }
 
 {------------------------------------------------------------------------------

lcl/interfaces/carbon/carboncaret.pas

@@ -0,0 +1,359 @@
+{
+ /***************************************************************************
+                    CarbonCaret.pas  -  Carbon Caret Emulation
+                    ------------------------------------------
+
+ copyright (c) Andreas Hausladen
+
+ adopted for Lazarus and Carbon by Lazarus Team
+
+ ***************************************************************************/
+
+ *****************************************************************************
+ *                                                                           *
+ *  This file is part of the Lazarus Component Library (LCL)                 *
+ *                                                                           *
+ *  See the file COPYING.modifiedLGPL, included in this distribution,        *
+ *  for details about the copyright.                                         *
+ *                                                                           *
+ *  This program is distributed in the hope that it will be useful,          *
+ *  but WITHOUT ANY WARRANTY; without even the implied warranty of           *
+ *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                     *
+ *                                                                           *
+ *****************************************************************************
+}
+
+unit CarbonCaret;
+{$mode objfpc}{$H+}
+
+interface
+
+// debugging defines
+{$I carbondebug.inc}
+
+uses
+  // Bindings
+  FPCMacOSAll,
+  // Free Pascal
+  Classes, SysUtils, Types,
+  // Widgetset
+  CarbonDef, CarbonGDIObjects,
+  // LCL
+  LCLType, LCLIntf, LCLProc, Graphics, ExtCtrls;
+
+type
+  { TEmulatedCaret }
+
+  TEmulatedCaret = class(TComponent)
+  private
+    FTimer: TTimer;
+    FUpdating: Boolean;
+    FOldRect: TRect;
+    FWidget: TCarbonWidget;
+    FBitmap: TCarbonBitmap;
+    FWidth, FHeight: Integer;
+    FPos: TPoint;
+    FVisible: Boolean;
+    FVisibleState: Boolean;
+    FRespondToFocus: Boolean;
+    procedure SetPos(const Value: TPoint);
+  protected
+    procedure DoTimer(Sender: TObject);
+    procedure DrawCaret; virtual;
+    procedure SetWidget(AWidget: TCarbonWidget);
+    procedure UpdateCaret;
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+
+    function CreateCaret(AWidget: TCarbonWidget; Bitmap: PtrUInt; Width, Height: Integer): Boolean;
+    function DestroyCaret: Boolean;
+
+    function IsValid: Boolean;
+
+    function Show(AWidget: TCarbonWidget): Boolean;
+    function Hide: Boolean;
+
+    property Timer: TTimer read FTimer;
+    property Pos: TPoint read FPos write SetPos;
+    property RespondToFocus: Boolean read FRespondToFocus write FRespondToFocus;
+  end;
+
+function CreateCaret(Widget: TCarbonWidget; Bitmap: PtrUInt; Width, Height: Integer): Boolean; overload;
+function HideCaret(Widget: TCarbonWidget): Boolean;
+function ShowCaret(Widget: TCarbonWidget): Boolean;
+function SetCaretPos(X, Y: Integer): Boolean;
+function GetCaretPos(var P: TPoint): Boolean;
+function GetCarbonCaretRespondToFocus: Boolean;
+procedure SetCarbonCaretRespondToFocus(Value: Boolean);
+function DestroyCaret: Boolean;
+procedure DrawCaret;
+procedure DestroyGlobalCaret;
+
+implementation
+
+uses CarbonCanvas;
+
+var
+  GlobalCaret: TEmulatedCaret = nil;
+  
+procedure GlobalCaretNeeded;
+begin
+  if GlobalCaret = nil then GlobalCaret := TEmulatedCaret.Create(nil);
+end;
+
+procedure DrawCaret;
+begin
+  GlobalCaretNeeded;
+  if Assigned(GlobalCaret) then GlobalCaret.DrawCaret;
+end;
+
+procedure DestroyGlobalCaret;
+begin
+  FreeAndNil(GlobalCaret);
+end;
+
+function CreateCaret(Widget: TCarbonWidget; Bitmap: PtrUInt; Width, Height: Integer): Boolean;
+begin
+  GlobalCaretNeeded;
+
+  Result := GlobalCaret.CreateCaret(Widget, Bitmap, Width, Height);
+end;
+
+function GetCaretBlinkTime: Cardinal;
+begin
+  // TODO: use FPCMacOSAll.GetCaretTime
+  Result := 600; // our default value
+end;
+
+function HideCaret(Widget: TCarbonWidget): Boolean;
+begin
+  GlobalCaretNeeded;
+  if Assigned(GlobalCaret) then
+    Result := GlobalCaret.Hide
+  else
+    Result := False;
+end;
+
+function ShowCaret(Widget: TCarbonWidget): Boolean;
+begin
+  GlobalCaretNeeded;
+
+  Result := GlobalCaret.Show(Widget);
+end;
+
+function SetCaretPos(X, Y: Integer): Boolean;
+begin
+  Result := True;
+  GlobalCaretNeeded;
+
+  GlobalCaret.Pos := Classes.Point(X, Y);
+end;
+
+function GetCaretPos(var P: TPoint): Boolean;
+begin
+  Result := True;
+  GlobalCaretNeeded;
+  
+  with GlobalCaret.Pos do
+  begin
+    P.x := X;
+    P.y := Y;
+  end;
+end;
+
+function GetCarbonCaretRespondToFocus: Boolean;
+begin
+  Result := GlobalCaret.RespondToFocus;
+end;
+
+procedure SetCarbonCaretRespondToFocus(Value: Boolean);
+begin
+  GlobalCaret.RespondToFocus := Value;
+end;
+
+function DestroyCaret: Boolean;
+begin
+  if Assigned(GlobalCaret) then
+    Result := GlobalCaret.DestroyCaret
+  else
+    Result := False;
+end;
+
+{ TEmulatedCaret }
+
+constructor TEmulatedCaret.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+
+  FOldRect := Rect(0, 0, 1, 1);
+  
+  FUpdating := False;
+  FTimer := TTimer.Create(self);
+  FTimer.Enabled := False;
+  FTimer.Interval := GetCaretBlinkTime;
+  FTimer.OnTimer := @DoTimer;
+  
+  FRespondToFocus := False;
+end;
+
+destructor TEmulatedCaret.Destroy;
+begin
+  DestroyCaret;
+
+  inherited Destroy;
+end;
+
+function TEmulatedCaret.CreateCaret(AWidget: TCarbonWidget; Bitmap: PtrUInt;
+  Width, Height: Integer): Boolean;
+begin
+  DestroyCaret;
+  SetWidget(AWidget);
+  
+  FWidth := Width;
+  FHeight := Height;
+  if Bitmap > 1 then
+    FBitmap := TCarbonBitmap.Create(TCarbonBitmap(Bitmap))
+  else
+    FBitmap := nil;
+
+  Result := IsValid;
+  FTimer.Enabled := True;
+end;
+
+function TEmulatedCaret.DestroyCaret: Boolean;
+begin
+  FTimer.Enabled := False;
+  Hide;
+  if Assigned(FBitmap) then FBitmap.Free;
+  FWidget := nil;
+  FBitmap := nil;
+  FWidth := 0;
+  FHeight := 0;
+  Result := not IsValid;
+end;
+
+procedure TEmulatedCaret.DrawCaret;
+begin
+  if IsValid and FVisible and FVisibleState and FWidget.Painting then
+  begin
+    if FBitmap = nil then
+      (FWidget.Context as TCarbonDeviceContext).InvertRectangle(FPos.X, FPos.Y,
+        FPos.X + FWidth, FPos.Y + FHeight)
+    else
+      (FWidget.Context as TCarbonDeviceContext).DrawCGImage(FPos.X, FPos.Y,
+        FBitmap.Width, FBitmap.Height, FBitmap.CGImage);
+  end;
+end;
+
+function TEmulatedCaret.Show(AWidget: TCarbonWidget): Boolean;
+var
+  ShowVisible: Boolean;
+begin
+  Result := False;
+  if FUpdating then Exit;
+
+  if FWidget <> AWidget then
+  begin
+    Hide;
+    SetWidget(AWidget);
+    ShowVisible := True;
+  end
+  else ShowVisible := not FVisible;
+  
+  Result := IsValid;
+  
+  if Result then
+  begin
+    FVisible := True;
+    FVisibleState := ShowVisible;
+    UpdateCaret;
+    FTimer.Enabled := True;
+  end;
+end;
+
+function TEmulatedCaret.Hide: Boolean;
+begin
+  Result := False;
+  if FUpdating then Exit;
+
+  Result := IsValid;
+  if Result and FVisible then
+  begin
+    FVisible := False;
+    UpdateCaret;
+    FTimer.Enabled := False;
+  end;
+end;
+
+procedure TEmulatedCaret.SetPos(const Value: TPoint);
+begin
+  if FUpdating then Exit;
+  if FWidget = nil then
+  begin
+    FPos.X := 0;
+    FPos.Y := 0;
+    Exit;
+  end;
+  
+  if ((FPos.x <> Value.x) or (FPos.y <> Value.y)) then
+  begin
+    FPos := Value;
+    FVisibleState := True;
+    UpdateCaret;
+  end;
+end;
+
+procedure TEmulatedCaret.DoTimer(Sender: TObject);
+begin
+  FVisibleState := not FVisibleState;
+  if FVisible then UpdateCaret;
+end;
+
+function TEmulatedCaret.IsValid: Boolean;
+begin
+  Result := (FWidth > 0) and (FHeight > 0) and (FWidget <> nil) and FWidget.IsVisible;
+end;
+
+procedure TEmulatedCaret.SetWidget(AWidget: TCarbonWidget);
+begin
+  if FUpdating then Exit;
+  if FWidget <> nil then FWidget.HasCaret := False;
+
+  FWidget := AWidget;
+  if FWidget <> nil then FWidget.HasCaret := True;
+end;
+
+procedure TEmulatedCaret.UpdateCaret;
+var
+  R: TRect;
+begin
+  if FUpdating then Exit;
+  if (FWidget <> nil) and FWidget.Painting then Exit;
+  FUpdating := True;
+  try
+    if FWidget <> nil then
+    begin
+      //DebugLn('TEmulatedCaret.UpdateCaret ' + DbgS(FPos) + ' ' + DbgS(FVisible) + ' ' + DbgS(FVisibleState));
+      R.Left := FPos.x;
+      R.Top := FPos.y;
+      R.Right := R.Left + FWidth + 2;
+      R.Bottom := R.Top + FHeight + 2;
+      
+      if not EqualRect(FOldRect, R) then FWidget.Invalidate(@FOldRect);
+      FWidget.Invalidate(@R);
+      FWidget.Update;
+        
+      FOldRect := R;
+    end;
+  finally
+    FUpdating := False;
+  end;
+end;
+
+
+finalization
+
+  DestroyGlobalCaret;
+
+end.

lcl/interfaces/carbon/carbondbgconsts.pp

@@ -95,6 +95,7 @@ const
   SCreateStyle = 'ATSUCreateStyle';
   SDisposeStyle = 'ATSUDisposeStyle';
 
+
 implementation
 
 end.

lcl/interfaces/carbon/carbondef.pp

@@ -64,6 +64,8 @@ type
   private
     FProperties: TStringList;
     FCursor: HCURSOR;
+    FHasCaret: Boolean;
+    function GetPainting: Boolean;
     function GetProperty(AIndex: String): Pointer;
     procedure SetProperty(AIndex: String; const AValue: Pointer);
   protected
@@ -121,6 +123,8 @@ type
      - processes track and draw event                  }
     property Content: ControlRef read GetContent;
     property Cursor: HCURSOR read FCursor;
+    property HasCaret: Boolean read FHasCaret write FHasCaret;
+    property Painting: Boolean read GetPainting;
     property Properties[AIndex: String]: Pointer read GetProperty write SetProperty;
   end;
   
@@ -149,7 +153,7 @@ function RegisterEventHandler(AHandler: TCarbonEventHandlerProc): EventHandlerUP
 implementation
 
 uses
-  CarbonProc, CarbonDbgConsts, CarbonUtils;
+  CarbonProc, CarbonDbgConsts, CarbonUtils, CarbonCaret;
 
 {------------------------------------------------------------------------------
   Name:    CheckHandle
@@ -339,6 +343,15 @@ begin
   Result := nil;
 end;
 
+{------------------------------------------------------------------------------
+  Method:  TCarbonWidget.GetPainting
+  Returns: If the widget is being repaint
+ ------------------------------------------------------------------------------}
+function TCarbonWidget.GetPainting: Boolean;
+begin
+  Result := Context <> nil;
+end;
+
 {------------------------------------------------------------------------------
   Method:  TCarbonWidget.SetProperty
   Params:  AIndex - Property name
@@ -497,6 +510,7 @@ begin
   FProperties := nil;
   Widget := nil;
   Context := nil;
+  FHasCaret := False;
   
   CreateWidget(AParams);
   
@@ -523,14 +537,16 @@ end;
  ------------------------------------------------------------------------------}
 destructor TCarbonWidget.Destroy;
 begin
-  DestroyWidget;
-  
-  FProperties.Free;
-
   {$IFDEF VerboseWidget}
     DebugLn('TCarbonWidget.Destroy ', ClassName, ' ', LCLObject.Name, ': ',
       LCLObject.ClassName);
   {$ENDIF}
+  
+  DestroyWidget;
+  
+  FProperties.Free;
+  
+  if HasCaret then DestroyCaret;
 
   inherited Destroy;
 end;

lcl/interfaces/carbon/carbonedits.pp

@@ -713,7 +713,7 @@ end;
 function TCarbonComboBox.SetItemIndex(AIndex: Integer): Boolean;
 begin
   Result := False;
-  DebugLn('TCarbonComboBox.SetItemIndex New: ' + DbgS(AIndex) + ' Prev: ' + DbgS(FItemIndex));
+  //DebugLn('TCarbonComboBox.SetItemIndex New: ' + DbgS(AIndex) + ' Prev: ' + DbgS(FItemIndex));
   if AIndex <> FItemIndex then
   begin
     if FReadOnly then SetValue(AIndex + 1)

lcl/interfaces/carbon/carbongdiobjects.pp

@@ -167,6 +167,7 @@ type
   TCarbonBitmap = class(TCarbonGDIObject)
   private
     FData: Pointer;
+    FAlignment: TCarbonBitmapAlignment;
     FFreeData: Boolean;
     FDataSize: Integer;
     FBytesPerRow: Integer;
@@ -183,6 +184,7 @@ type
     constructor Create(AWidth, AHeight, ADepth, ABitsPerPixel: Integer;
       AAlignment: TCarbonBitmapAlignment; AType: TCarbonBitmapType;
       AData: Pointer; ACopyData: Boolean = True);
+    constructor Create(ABitmap: TCarbonBitmap);
     destructor Destroy; override;
     procedure Update;
     function CreateSubImage(const ARect: TRect): CGImageRef;
@@ -289,6 +291,10 @@ var
   StockNullBrush: TCarbonBrush;
   WhiteBrush: TCarbonBrush;
   BlackPen: TCarbonPen;
+  
+  DefaultFont: TCarbonFont;
+  DefaultBrush: TCarbonBrush;
+  DefaultPen: TCarbonPen;
 
   DefaultBitmap: TCarbonBitmap; // 1 x 1 bitmap for default context
   
@@ -636,6 +642,7 @@ end;
 procedure TCarbonRegion.Apply(ADC: TCarbonContext);
 begin
   if ADC = nil then Exit;
+  if ADC.CGContext = nil then Exit;
   
   if OSError(HIShapeReplacePathInCGContext(FShape, ADC.CGContext),
     Self, 'Apply', 'HIShapeReplacePathInCGContext') then Exit;
@@ -960,6 +967,7 @@ var
   AROP2: Integer;
 begin
   if ADC = nil then Exit;
+  if ADC.CGContext = nil then Exit;
 
   if UseROP2 then AROP2 := (ADC as TCarbonDeviceContext).ROP2
   else AROP2 := R2_COPYPEN;
@@ -1027,6 +1035,7 @@ var
   AROP2: Integer;
 begin
   if ADC = nil then Exit;
+  if ADC.CGContext = nil then Exit;
 
   if UseROP2 then AROP2 := (ADC as TCarbonDeviceContext).ROP2
   else AROP2 := R2_COPYPEN;
@@ -1100,7 +1109,7 @@ end;
   Params:  AWidth        - Bitmap width
            AHeight       - Bitmap height
            ADepth        - Significant bits per pixel
-           ABitsPerPixel - The number of allocated bits per pixel (can be larget that depth)
+           ABitsPerPixel - The number of allocated bits per pixel (can be larger than depth)
            AAlignment    - Alignment of the data for each row
            ABytesPerRow  - The number of bytes between rows
            ACopyData     - Copy supplied bitmap data (OPTIONAL)
@@ -1113,8 +1122,7 @@ constructor TCarbonBitmap.Create(AWidth, AHeight, ADepth, ABitsPerPixel: Integer
 const
   ALIGNBITS: array[TCarbonBitmapAlignment] of Integer = (0, 1, 3, 7, $F);
 var
-  m: Integer;
-
+  M: Integer;
 begin
   inherited Create(False);
   
@@ -1127,11 +1135,11 @@ begin
   FDepth := ADepth;
   FBitsPerPixel := ABitsPerPixel;
   FType := AType;
+  FAlignment := AAlignment;
 
   FBytesPerRow := ((AWidth * ABitsPerPixel) + 7) shr 3;
-  m := FBytesPerRow and ALIGNBITS[AAlignment];
-  if m <> 0
-  then Inc(FBytesPerRow, ALIGNBITS[AAlignment] + 1 - m);
+  M := FBytesPerRow and ALIGNBITS[AAlignment];
+  if M <> 0 then Inc(FBytesPerRow, ALIGNBITS[AAlignment] + 1 - M);
 
   FDataSize := FBytesPerRow * FHeight;
   
@@ -1157,6 +1165,18 @@ begin
   //DbgDumpImage(FCGImage, 'TCarbonBitmap.Create');
 end;
 
+{------------------------------------------------------------------------------
+  Method:  TCarbonBitmap.Create
+  Params:  ABitmap - Source bitmap
+
+  Creates Carbon bitmap as a copy of specified bitmap
+ ------------------------------------------------------------------------------}
+constructor TCarbonBitmap.Create(ABitmap: TCarbonBitmap);
+begin
+  Create(ABitmap.Width, ABitmap.Height, ABitmap.Depth, ABitmap.FBitsPerPixel,
+    ABitmap.FAlignment, ABitmap.FType, ABitmap.Data);
+end;
+
 {------------------------------------------------------------------------------
   Method:  TCarbonBitmap.Destroy
 
@@ -1577,6 +1597,11 @@ initialization
   WhiteBrush := TCarbonBrush.Create(True);
   BlackPen := TCarbonPen.Create(True);
   
+  DefaultFont := TCarbonFont.Create(True);
+
+  DefaultBrush := TCarbonBrush.Create(True);
+  DefaultPen := TCarbonPen.Create(True);
+  
   DefaultContext := TCarbonBitmapContext.Create;
   DefaultBitmap := TCarbonBitmap.Create(1, 1, 32, 32, cbaDQWord, cbtARGB, nil);
   DefaultContext.Bitmap := DefaultBitmap;
@@ -1588,6 +1613,11 @@ finalization
   DefaultContext.Free;
   ScreenContext.Free;
   
+  DefaultBrush.Free;
+  DefaultPen.Free;
+  
+  DefaultFont.Free;
+  
   BlackPen.Free;
   WhiteBrush.Free;
 

lcl/interfaces/carbon/carbonint.pas

@@ -115,6 +115,7 @@ type
     property MainMenu: TMainMenu read FMainMenu;
   public
     procedure SetCaptureWidget(const AWidget: HWND);
+    procedure SetTextFractional(ACanvas: TCanvas; AEnabled: Boolean);
   end;
   
 const
@@ -162,7 +163,7 @@ uses
   { these can/should go up }
   CarbonDef, CarbonPrivate, CarbonMenus, CarbonButtons, CarbonBars, CarbonEdits,
   CarbonListViews, CarbonTabs,
-  CarbonThemes, CarbonCanvas, CarbonStrings, CarbonClipboard,
+  CarbonThemes, CarbonCanvas, CarbonStrings, CarbonClipboard, CarbonCaret,
   CarbonProc, CarbonDbgConsts, CarbonUtils,
   
   Buttons, StdCtrls, PairSplitter, ComCtrls, CListBox, Calendar, Arrow,

lcl/interfaces/carbon/carbonlclintf.inc

@@ -617,6 +617,23 @@ begin
   end;
 end;
 
+{------------------------------------------------------------------------------
+  Method:  SetTextFractional
+  Params:  ACanvas - LCL Canvas
+
+  Sets canvas text fractional enabled
+ ------------------------------------------------------------------------------}
+procedure TCarbonWidgetSet.SetTextFractional(ACanvas: TCanvas; AEnabled: Boolean);
+begin
+   {$IFDEF VerboseLCLIntf}
+    DebugLn('TCarbonWidgetSet.SetTextFractional ACanvas: ' + DbgS(ACanvas) + ' AEnabled: ' + DbgS(AEnabled));
+  {$ENDIF}
+  
+  if not CheckDC(ACanvas.Handle, 'SetTextFractional') then Exit;
+  
+  TCarbonDeviceContext(ACanvas.Handle).TextFractional := AEnabled;
+end;
+
 //##apiwiz##eps##   // Do not remove, no wizard declaration after this line
 
 // included by carbonint.pas

lcl/interfaces/carbon/carbonobject.inc

@@ -440,7 +440,6 @@ var
   Event: EventRef;
   CurEventClass: TEventInt;
   CurEventKind: TEventInt;
-  P: TPoint;
 begin
   {$IFDEF VerboseObject}
     DebugLn('TCarbonWidgetSet.AppProcessMessages');
@@ -474,10 +473,7 @@ begin
     
     if Clipboard <> nil then
       if Clipboard.OwnerShips > 0 then Clipboard.CheckOwnerShip;
-      
-    //GetCursorPos(P);
-    //DebugLn('Mouse Pos: ' + DbgS(P));
-    
+
   until Application.Terminated;
   
   {$IFDEF VerboseObject}

lcl/interfaces/carbon/carbonprivate.pp

@@ -198,12 +198,15 @@ type
     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(Index: Integer): ControlRef; override;
-  public
+    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;
   public
@@ -211,6 +214,8 @@ type
     procedure SetFont(const AFont: TFont); override;
     procedure GetScrollInfo(SBStyle: Integer; var ScrollInfo: TScrollInfo); override;
     function SetScrollInfo(SBStyle: Integer; const ScrollInfo: TScrollInfo): Integer; override;
+
+    property TextFractional: Boolean read FTextFractional write FTextFractional;
   end;
   
   { TCarbonScrollingWinControl }
@@ -271,7 +276,7 @@ function GetCarbonControl(AWidget: ControlRef): TCarbonControl;
 implementation
 
 uses InterfaceBase, CarbonInt, CarbonProc, CarbonDbgConsts, CarbonUtils,
-  CarbonWSStdCtrls, CarbonCanvas;
+  CarbonWSStdCtrls, CarbonCanvas, CarbonCaret;
 
 {------------------------------------------------------------------------------
   Name:    RaiseCreateWidgetError
@@ -690,6 +695,11 @@ begin
   FScrollOrigin := GetHIPoint(0, 0);
   FMulX := 1;
   FMulY := 1;
+  
+  if LCLObject.ClassType.ClassNameIs('TSynEdit') then
+     FTextFractional := False
+  else
+    FTextFractional := True;
     
   inherited;
 end;
@@ -716,6 +726,30 @@ begin
   Result := FScrollView;
 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;
+begin
+  if Context <> nil then
+  begin
+    (Context as TCarbonDeviceContext).TextFractional := TextFractional;
+    if LCLObject.Color <> clBtnFace then
+      with (Context as TCarbonDeviceContext) do FillRect(GetClipRect, CurrentBrush);
+  end;
+end;
+
 {------------------------------------------------------------------------------
   Method:  TCarbonCustomControl.GetInfo
   Params:  AImageSize - Size of entire scrollable area

lcl/interfaces/carbon/carbonprivatecommon.inc

@@ -40,7 +40,6 @@ function CarbonCommon_Draw(ANextHandler: EventHandlerCallRef;
   AWidget: TCarbonWidget): OSStatus; {$IFDEF darwin}mwpascal;{$ENDIF}
 var
   AStruct: PPaintStruct;
-  //EraseMsg: TLMEraseBkgnd;
 begin
   {$IFDEF VerbosePaint}
     Debugln('CarbonCommon_Draw ', DbgSName(AWidget.LCLObject));
@@ -55,10 +54,7 @@ begin
         SizeOf(CGContextRef), nil, @(AWidget.Context.CGContext)),
       'CarbonCommon_Draw', SGetEvent, 'kEventParamCGContextRef') then Exit;
 
-    // erase background
-    {EraseMsg.Msg := LM_ERASEBKGND;
-    EraseMsg.DC := HDC(AWidget.Context);
-    DeliverMessage(AWidget.LCLObject, EraseMsg);}
+    AWidget.Context.Reset;
 
     // let carbon draw/update
     Result := CallNextEventHandler(ANextHandler, AEvent);
@@ -78,6 +74,8 @@ begin
     finally
       Dispose(AStruct);
     end;
+    
+    if AWidget.HasCaret then DrawCaret;
   finally
     FreeAndNil(AWidget.Context);
   end;

lcl/interfaces/carbon/carbonwinapi.inc

@@ -286,8 +286,7 @@ end;
   Creates new logical brush that has the specified style, color, and pattern
   TODO: patterns
  ------------------------------------------------------------------------------}
-function TCarbonWidgetSet.CreateBrushIndirect(const LogBrush: TLogBrush
-  ): HBRUSH;
+function TCarbonWidgetSet.CreateBrushIndirect(const LogBrush: TLogBrush): HBRUSH;
 begin
   {$IFDEF VerboseWinAPI}
     DebugLn('TCarbonWidgetSet.CreateBrushIndirect');
@@ -296,10 +295,29 @@ begin
   Result := HBRUSH(TCarbonBrush.Create(LogBrush));
 end;
 
-function TCarbonWidgetSet.CreateCaret(Handle: HWND; Bitmap: hBitmap; width,
-  Height: Integer): Boolean;
+{------------------------------------------------------------------------------
+  Method:  CreateCaret
+  Params:  Handle - handle to owner window
+           Bitmap - handle to bitmap for caret shape
+           Width  - caret width
+           Height - caret height
+  Returns: If the function succeeded
+
+  Creates a new shape for the system caret and assigns ownership of the caret
+  to the specified window
+ ------------------------------------------------------------------------------}
+function TCarbonWidgetSet.CreateCaret(Handle: HWND; Bitmap: hBitmap; Width, Height: Integer): Boolean;
 begin
-  Result:=inherited CreateCaret(Handle, Bitmap, width, Height);
+  Result := True;
+  {$IFDEF VerboseWinAPI}
+    DebugLn('TCarbonWidgetSet.CreateCaret Handle: ' + DbgS(Handle) + ' Bitmap: ' + DbgS(Bitmap),
+      ' W: ' + DbgS(Width), ' H: ' + DbgS(Height));
+  {$ENDIF}
+  if not CheckWidget(Handle, 'CreateCaret') then Exit;
+  if Bitmap > 1 then
+    if not CheckBitmap(Bitmap, 'CreateCaret') then Exit;
+  
+  Result := CarbonCaret.CreateCaret(TCarbonWidget(Handle), Bitmap, Width, Height);
 end;
 
 {------------------------------------------------------------------------------
@@ -538,9 +556,22 @@ begin
   Result := True;
 end;
 
+{------------------------------------------------------------------------------
+  Method:  DestroyCaret
+  Params:  Handle - handle to the window with a caret (IGNORED)
+  Returns: If the function succeeds
+
+  Destroys the caret but doesn't free the bitmap.
+ ------------------------------------------------------------------------------}
 function TCarbonWidgetSet.DestroyCaret(Handle: HWND): Boolean;
 begin
-  Result:=inherited DestroyCaret(Handle);
+  Result := False;
+
+  {$IFDEF VerboseWinAPI}
+    DebugLn('TCarbonWidgetSet.DestroyCaret Handle: ' + DbgS(Handle));
+  {$ENDIF}
+  
+  Result := CarbonCaret.DestroyCaret;
 end;
 
 {------------------------------------------------------------------------------
@@ -990,9 +1021,20 @@ begin
   Result := FCaptureWidget;
 end;
 
+{------------------------------------------------------------------------------
+  Method:  GetCaretPos
+  Params:  LPPoint - record to receive coordinates
+  Returns: If the function succeeds
+
+  Gets the caret's position, in client coordinates.
+ ------------------------------------------------------------------------------}
 function TCarbonWidgetSet.GetCaretPos(var lpPoint: TPoint): Boolean;
 begin
-  Result:=inherited GetCaretPos(lpPoint);
+  Result := CarbonCaret.GetCaretPos(lpPoint);
+  
+  {$IFDEF VerboseWinAPI}
+    DebugLn('TCarbonWidgetSet.GetCaretPos Point: ' + DbgS(lpPoint), ' Result: ' + DbgS(Result));
+  {$ENDIF}
 end;
 
 function TCarbonWidgetSet.GetCaretRespondToFocus(handle: HWND;
@@ -1079,8 +1121,7 @@ begin
   if not CheckDC(DC, 'GetClipBox') then Exit;
   
   if lpRect <> nil then
-    lpRect^ := CGRectToRect(
-      CGContextGetClipBoundingBox(TCarbonDeviceContext(DC).CGContext));
+    lpRect^ := TCarbonDeviceContext(DC).GetClipRect;
 
   Result := COMPLEXREGION;
   
@@ -1848,9 +1889,22 @@ begin
     Mode);
 end;
 
+{------------------------------------------------------------------------------
+  Method:  HideCaret
+  Params:  HWnd - handle to the window with the caret
+  Returns: Whether the window owns the caret
+
+  Removes the caret from the screen.
+ ------------------------------------------------------------------------------}
 function TCarbonWidgetSet.HideCaret(hWnd: HWND): Boolean;
 begin
-  Result:=inherited HideCaret(hWnd);
+  Result := False;
+  {$IFDEF VerboseWinAPI}
+    DebugLn('TCarbonWidgetSet.HideCaret Handle: ' + DbgS(hWnd));
+  {$ENDIF}
+  if not CheckWidget(hWnd, 'HideCaret') then Exit;
+
+  Result := CarbonCaret.HideCaret(TCarbonWidget(hWnd));
 end;
 
 {------------------------------------------------------------------------------
@@ -2623,14 +2677,38 @@ begin
   Result:=inherited SetCapture(AHandle);
 end;
 
+{------------------------------------------------------------------------------
+  Method:  SetCaretPos
+  Params:  X, Y - Caret pos
+  Returns: If the function succeeds
+
+  Moves the caret to the specified coordinates.
+ ------------------------------------------------------------------------------}
 function TCarbonWidgetSet.SetCaretPos(X, Y: Integer): Boolean;
 begin
-  Result:=inherited SetCaretPos(X, Y);
+  {$IFDEF VerboseWinAPI}
+    DebugLn('TCarbonWidgetSet.SetCaretPos X: ' + DbgS(X) + ' Y: ' + DbgS(Y));
+  {$ENDIF}
+  
+  Result := CarbonCaret.SetCaretPos(X, Y);
 end;
 
+{------------------------------------------------------------------------------
+  Method:  SetCaretPosEx
+  Params:  Handle - handle of window
+           X      - Horizontal caret coordinate
+           Y      - Vertical caret coordinate
+  Returns: If the function succeeds
+
+  Moves the caret to the specified coordinates in the specified window.
+ ------------------------------------------------------------------------------}
 function TCarbonWidgetSet.SetCaretPosEx(Handle: HWnd; X, Y: Integer): Boolean;
 begin
-  Result:=inherited SetCaretPosEx(Handle, X, Y);
+  {$IFDEF VerboseWinAPI}
+    DebugLn('TCarbonWidgetSet.SetCaretPosEx X: ' + DbgS(X) + ' Y: ' + DbgS(Y));
+  {$ENDIF}
+  
+  Result := CarbonCaret.SetCaretPos(X, Y);
 end;
 
 function TCarbonWidgetSet.SetCaretRespondToFocus(handle: HWND;
@@ -2908,9 +2986,22 @@ begin
   Result:=inherited SetWindowPos(hWnd, hWndInsertAfter, X, Y, cx, cy, uFlags);
 end;
 
+{------------------------------------------------------------------------------
+  Method:  ShowCaret
+  Params:  HWnd - Handle of window with caret
+  Returns: if the function succeeds
+
+  Makes the caret visible on the screen at the caret's current position.
+ ------------------------------------------------------------------------------}
 function TCarbonWidgetSet.ShowCaret(hWnd: HWND): Boolean;
 begin
-  Result:=inherited ShowCaret(hWnd);
+  Result := False;
+  {$IFDEF VerboseWinAPI}
+    DebugLn('TCarbonWidgetSet.ShowCaret Handle: ' + DbgS(hWnd));
+  {$ENDIF}
+  if not CheckWidget(hWnd, 'ShowCaret') then Exit;
+
+  Result := CarbonCaret.ShowCaret(TCarbonWidget(hWnd));
 end;
 
 function TCarbonWidgetSet.ShowScrollBar(Handle: HWND; wBar: Integer;