Carbon intf: TSynEdit fixed textout, improved scrolling

- enhanced clipboard to use more text formats
- TComboBox.OnDropDown and OnCloseUp partial implementation

git-svn-id: trunk@12509 -

lcl/interfaces/carbon/carboncanvas.pp

@@ -609,6 +609,7 @@ var
   W: WideString;
   Tag: ATSUAttributeTag;
   DataSize: ByteCount;
+  Options: ATSLineLayoutOptions;
   PValue: ATSUAttributeValuePtr;
 const
   SName = 'BeginTextRender';
@@ -643,7 +644,19 @@ begin
   PValue := @(CurrentFont.LineRotation);
   if OSError(ATSUSetLayoutControls(ALayout, 1, @Tag, @DataSize, @PValue),
     Self, SName, 'ATSUSetLayoutControls', 'LineRotation') then Exit;
-      
+
+  // disable fractional positions of glyphs in layout
+  // TODO: restrict to monspaced fonts only
+  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;
+
+
   // set layout context
   Tag := kATSUCGContextTag;
   DataSize := SizeOf(CGContextRef);

lcl/interfaces/carbon/carbonclipboard.pp

@@ -38,9 +38,10 @@ type
   { TCarbonClipboard }
 
   TCarbonClipboard = class
+    FOwnerShips: Integer;
   private
     FPasteboards: Array [TClipboardType] of PasteboardRef;
-    FFormats: TList; // list of CFStringRef UTIs, 1 is reserved for text/plain
+    FFormats: TList; // list of CFStringRef UTIs
     FOnClipboardRequest: Array [TClipboardType] of TClipboardRequestEvent;
     
     function FindFormat(const UTI: CFStringRef): TClipboardFormat;
@@ -59,14 +60,16 @@ type
       OnRequestProc: TClipboardRequestEvent; FormatCount: Integer;
       Formats: PClipboardFormat): Boolean;
     function RegisterFormat(const AMimeType: String): TClipboardFormat;
+  public
+    property OwnerShips: Integer read FOwnerShips;
   end;
 
 var
   ClipboardTypeToPasteboard: Array [TClipboardType] of CFStringRef =
   (
 {ctPrimarySelection  } kPasteboardUniqueName, // local application pasteboard
-{ctSecondarySelection} nil,       // Find pasteboard
+{ctSecondarySelection} nil,                   // Find pasteboard
-{ctClipboard         } nil   // standard global pasteboard
+{ctClipboard         } nil                    // standard global pasteboard
   );
   Clipboard: TCarbonClipboard;
 
@@ -88,7 +91,7 @@ var
 begin
   for I := 1 to FFormats.Count - 1 do
   begin
-    if UTTypeConformsTo(UTI, CFStringRef(FFormats[I])) then
+    if UTTypeEqual(UTI, CFStringRef(FFormats[I])) then
     begin
       Result := I;
       Exit;
@@ -113,8 +116,14 @@ begin
 
     FOnClipboardRequest[T] := nil;
   end;
+  FOwnerShips := 0;
+  
   FFormats := TList.Create;
-  FFormats.Add(nil);
+  
+  FFormats.Add(nil); // add default supported text formats
+  FFormats.Add(kUTTypePlainText);
+  FFormats.Add(kUTTypeUTF8PlainText);
+  FFormats.Add(kUTTypeUTF16PlainText);
   
   RegisterFormat(PredefinedClipboardMimeTypes[pcfText]);
 end;
@@ -128,7 +137,7 @@ var
   I: Integer;
   S: CFStringRef;
 begin
-  for I := 0 to FFormats.Count - 1 do
+  for I := 4 to FFormats.Count - 1 do // 0..3 are predefined
   begin
     S := FFormats[I];
     FreeCFString(S);
@@ -157,6 +166,7 @@ begin
     if (PasteboardSynchronize(FPasteboards[T]) and
       kPasteboardClientIsOwner) = 0 then
     begin  // inform LCL about ownership lost
+      Dec(FOwnerShips);
       FOnClipboardRequest[T](0, nil);
     end;
   end;
@@ -192,12 +202,6 @@ var
 begin
   if (FormatID > 0) and (FormatID < FFormats.Count) then
   begin
-    if FormatID = 1 then
-    begin
-      Result := PredefinedClipboardMimeTypes[pcfText];
-      Exit;
-    end;
-    
     S := UTTypeCopyPreferredTagWithClass(CFStringRef(FFormats[FormatID]), kUTTagClassMIMEType);
     try
       Result := CFStringToStr(S);
@@ -221,17 +225,34 @@ function TCarbonClipboard.GetData(ClipboardType: TClipboardType;
   FormatID: TClipboardFormat; Stream: TStream): Boolean;
 var
   Pasteboard: PasteboardRef;
-  I, J: Integer;
+  I: Integer;
-  L: SizeUInt;
+  UTI, CFString: CFStringRef;
+  Encoding: CFStringEncoding;
   Flavors: CFArrayRef;
-  UTI: CFStringRef;
-  FlavorCount: CFIndex;
   FlavorData: CFDataRef;
   Count: ItemCount;
   ID: PasteboardItemID;
   S: String;
 const
   SName = 'GetData';
+  
+  function HasFormat(Format: CFStringRef): Boolean;
+  var
+    FlavorCount: CFIndex;
+    J: Integer;
+  begin
+    Result := False;
+    FlavorCount := CFArrayGetCount(Flavors);
+    
+    for J := 0 to FlavorCount - 1 do
+      if UTTypeEqual(Format, CFArrayGetValueAtIndex(Flavors, J)) then
+      begin
+        //DebugLn('Has UTI ' + CFStringToStr(Format));
+        Result := True;
+        Break;
+      end;
+  end;
+  
 begin
   Result := False;
   
@@ -255,46 +276,55 @@ begin
     if OSError(PasteboardCopyItemFlavors(Pasteboard, ID, Flavors), Self, SName,
       'PasteboardCopyItemFlavors') then Continue;
       
-    FlavorCount := CFArrayGetCount(Flavors);
+    UTI := FFormats[FormatID];
-    for J := 0 to FlavorCount - 1 do
+    if FormatID = 1 then
     begin
-      UTI := CFArrayGetValueAtIndex(Flavors, J);
+      if HasFormat(FFormats[2]) then UTI := FFormats[2]   // check UTF-8 text
-      //DebugLn('TCarbonClipboard.GetData FlavorType: ' + CFStringToStr(UTI) +
+      else
-      //  ' ' + CFStringToStr(FFormats[FormatID]));
+        if HasFormat(FFormats[3]) then UTI := FFormats[3] // check UTF-16 text
-      if UTTypeConformsTo(FFormats[FormatID], UTI) then
+        else
+          if not HasFormat(UTI) then Exit;               // check plain text
+    end
+    else
+      if not HasFormat(UTI) then Exit;
+
+    //DebugLn('TCarbonClipboard.GetData Paste FlavorType: ' + CFStringToStr(UTI));
+
+    if OSError(PasteboardCopyItemFlavorData(Pasteboard, ID, UTI, FlavorData),
+      Self, SGetData, 'PasteboardCopyItemFlavorData') then Continue;
+    try
+      if CFDataGetLength(FlavorData) = 0 then
       begin
-        //DebugLn('TCarbonClipboard.GetData Paste FlavorType: ' + CFStringToStr(UTI));
-
-        if OSError(PasteboardCopyItemFlavorData(Pasteboard, ID, UTI, FlavorData),
-          Self, SGetData, 'PasteboardCopyItemFlavorData') then Continue;
-        try
-          if CFDataGetLength(FlavorData) = 0 then
-          begin
-            Result := True;
-            Exit;
-          end;
-          //DebugLn('TCarbonClipboard.GetData Paste FlavordataLength: ' + DbgS(CFDataGetLength(FlavorData)));
-
-          if FormatID = 1 then // convert text/plain UTF-16 to UTF-8
-          begin
-            SetLength(S, (CFDataGetLength(FlavorData) div 2) * 3);
-            if ConvertUTF16ToUTF8(PChar(S), Length(S) + 1,
-              PWideChar(CFDataGetBytePtr(FlavorData)), CFDataGetLength(FlavorData) div 2,
-              [toInvalidCharToSymbol], L) <> trNoError then Exit;
-
-            SetLength(S, L - 1);
-            Stream.Write(S[1], L - 1);
-          end
-          else
-            Stream.Write(CFDataGetBytePtr(FlavorData)^, CFDataGetLength(FlavorData));
-        finally
-          CFRelease(FlavorData);
-        end;
-        
         Result := True;
         Exit;
       end;
+      //DebugLn('TCarbonClipboard.GetData Paste FlavordataLength: ' + DbgS(CFDataGetLength(FlavorData)));
+
+      if FormatID = 1 then
+      begin
+        if UTI =  FFormats[2] then // UTF-8 text
+            Encoding := kCFStringEncodingUTF8;
+        if UTI =  FFormats[3] then // UTF-16 text
+            Encoding := kCFStringEncodingUTF16;
+        if UTI =  FFormats[1] then // plain text
+            Encoding := CFStringGetSystemEncoding;
+        
+        CreateCFString(FlavorData, Encoding, CFString);
+        try
+          S := CFStringtoStr(CFString);
+          Stream.Write(S[1], Length(S));
+        finally
+          FreeCFString(CFString);
+        end;
+      end
+      else
+        Stream.Write(CFDataGetBytePtr(FlavorData)^, CFDataGetLength(FlavorData));
+    finally
+      CFRelease(FlavorData);
     end;
+
+    Result := True;
+    Exit;
   end;
 end;
 
@@ -343,10 +373,14 @@ begin
       for J := 0 to FlavorCount - 1 do
       begin
         UTI := CFArrayGetValueAtIndex(Flavors, J);
+        //DebugLn('TCarbonClipboard.GetFormats ' + CFStringToStr(UTI));
 
         FormatID := FindFormat(UTI);
         if FormatID = 0 then
           FormatID := FFormats.Add(UTI);
+        if FormatID < 4 then // if it is text format, add plain text format
+          if Formats.IndexOf(Pointer(1)) = -1 then Formats.Add(Pointer(1));
+
 
         if Formats.IndexOf(Pointer(FormatID)) = -1 then
         begin
@@ -388,46 +422,53 @@ function TCarbonClipboard.GetOwnerShip(ClipboardType: TClipboardType;
   OnRequestProc: TClipboardRequestEvent; FormatCount: Integer;
   Formats: PClipboardFormat): Boolean;
   
+  procedure AddData(Format: CFStringRef; CFData: CFDataRef);
+  begin
+    if CFData = nil then Exit;
+    //DebugLn('Add Data ' + CFStringToStr(Format));
+    
+    OSError(PasteboardPutItemFlavor(FPasteboards[ClipboardType],
+          PasteboardItemID(1), Format, CFData, 0),
+        Self, 'GetOwnerShip', 'PasteboardPutItemFlavor');
+  end;
+    
   procedure PutOnClipboard;
   var
-    Data: CFDataRef;
+    DataStream: TStringStream;
-    UTI: CFStringRef;
-    DataStream: TMemoryStream;
     I: Integer;
-    L: SizeUInt;
+    CFString: CFStringRef;
-    W: WideString;
   begin
-    DataStream := TMemoryStream.Create;
+    DataStream := TStringStream.Create('');
 
     for I := 0 to FormatCount - 1 do
     begin
-      DataStream.Size := 0;
-      DataStream.Position := 0;
-
       if not ((Formats[I] > 0) and (Formats[I] < FFormats.Count)) then
       begin
         DebugLn('TCarbonClipboard.GetOwnerShip Error: Invalid Format ' + DbgS(Formats[I]) + ' specified!');
         Continue;
       end;
       
-      UTI := CFStringRef(FFormats[Formats[I]]);
+      DataStream.Size := 0;
+      DataStream.Position := 0;
       FOnClipBoardRequest[ClipboardType](Formats[I], DataStream);
-      
+
-      if Formats[I] = 1 then // convert plain/text UTF-8 to UTF-16
+      if Formats[I] = 1 then // add more unicode and mac text formats
       begin
-        SetLength(W, DataStream.Size);
+        CreateCFString(DataStream.DataString, CFString);
-        if ConvertUTF8ToUTF16(PWideChar(W), Length(W) + 1, PChar(DataStream.Memory),
+        try
-          DataStream.Size, [toInvalidCharToSymbol], L) <> trNoError then Exit;
+          // UTF-8 text
-          
+          AddData(FFormats[2], CFStringToData(CFString, kCFStringEncodingUTF8));
-        SetLength(W, L - 1);
+          // UTF-16 text
-        Data := CFDataCreate(nil, PChar(W), (L - 1) * 2);
+          AddData(FFormats[3], CFStringToData(CFString, kCFStringEncodingUTF16));
+          // plain text
+          AddData(FFormats[1], CFStringToData(CFString, CFStringGetSystemEncoding));
+        finally
+          FreeCFString(CFString);
+        end;
       end
       else
-        Data := CFDataCreate(nil, DataStream.Memory, DataStream.Size);
+        AddData(FFormats[Formats[I]], CFDataCreate(nil, @DataStream.DataString[1],
-
+          DataStream.Size));
-      OSError(PasteboardPutItemFlavor(FPasteboards[ClipboardType],
-          PasteboardItemID(1), UTI, Data, 0),
-        Self, 'GetOwnerShip', 'PasteboardPutItemFlavor');
     end;
 
     DataStream.Free;
@@ -435,13 +476,14 @@ function TCarbonClipboard.GetOwnerShip(ClipboardType: TClipboardType;
   
 begin
   Result := False;
-  DebugLn('TCarbonClipboard.GetOwnerShip');
+  //DebugLn('TCarbonClipboard.GetOwnerShip');
 
   if (FormatCount = 0) or (OnRequestProc = nil) then
   begin
     // The LCL indicates it doesn't have the clipboard data anymore
     // and the interface can't use the OnRequestProc anymore.
     FOnClipboardRequest[ClipboardType] := nil;
+    Dec(FOwnerShips);
   end
   else
   begin
@@ -450,6 +492,7 @@ begin
     FOnClipboardRequest[ClipboardType] := nil;
     if not Clear(ClipboardType) then Exit;
     
+    Inc(FOwnerShips);
     FOnClipboardRequest[ClipboardType] := OnRequestProc;
     PutOnClipboard;
   end;
@@ -467,16 +510,11 @@ function TCarbonClipboard.RegisterFormat(const AMimeType: String): TClipboardFor
 var
   UTI, M: CFStringRef;
 begin
-  if AMimeType = PredefinedClipboardMimeTypes[pcfText] then
+  CreateCFString(AMimeType, M);
-    CreateCFString('public.utf16-plain-text', UTI)
+  try
-  else
+    UTI := UTTypeCreatePreferredIdentifierForTag(kUTTagClassMIMEType, M, nil);
-  begin
+  finally
-    CreateCFString(AMimeType, M);
+    FreeCFString(M);
-    try
-      UTI := UTTypeCreatePreferredIdentifierForTag(kUTTagClassMIMEType, M, nil);
-    finally
-      FreeCFString(M);
-    end;
   end;
   
   Result := FindFormat(UTI);
@@ -497,7 +535,7 @@ initialization
 
 finalization
 
-  Clipboard.Free;
+  FreeAndNil(Clipboard);
   FreeCFString(ClipboardTypeToPasteboard[ctSecondarySelection]);
   FreeCFString(ClipboardTypeToPasteboard[ctClipboard]);
 

lcl/interfaces/carbon/carbondef.pp

@@ -75,11 +75,14 @@ type
     LCLObject: TWinControl;  // LCL control which created this widget
     Context: TCarbonContext; // Carbon content area context
     Widget: Pointer;         // Reference to the Carbon window or control
+  public
+    procedure FocusSet; dynamic;
+    procedure FocusKilled; dynamic;
+    procedure BoundsChanged; virtual;
   public
     constructor Create(const AObject: TWinControl; const AParams: TCreateParams);
     destructor Destroy; override;
     procedure AddToWidget(AParent: TCarbonWidget); virtual; abstract;
-    procedure BoundsChanged; virtual;
     function GetClientRect(var ARect: TRect): Boolean; virtual; abstract;
     function GetPreferredSize: TPoint; virtual;
     function GetMousePos: TPoint; virtual; abstract;
@@ -373,6 +376,26 @@ begin
   end;
 end;
 
+{------------------------------------------------------------------------------
+  Method:  TCarbonWidget.FocusSet
+
+  Handles set focus
+ ------------------------------------------------------------------------------}
+procedure TCarbonWidget.FocusSet;
+begin
+  LCLSendSetFocusMsg(LCLObject);
+end;
+
+{------------------------------------------------------------------------------
+  Method:  TCarbonWidget.FocusKilled
+
+  Handles kill focus
+ ------------------------------------------------------------------------------}
+procedure TCarbonWidget.FocusKilled;
+begin
+  LCLSendKillFocusMsg(LCLObject);
+end;
+
 {------------------------------------------------------------------------------
   Method:  TCarbonWidget.BoundsChanged
 

lcl/interfaces/carbon/carbonedits.pp

@@ -82,6 +82,8 @@ type
     class function GetValidEvents: TCarbonControlEvents; override;
     procedure ListItemSelected(AIndex: Integer); virtual;
     procedure ValueChanged; override;
+    procedure FocusSet; override;
+    procedure FocusKilled; override;
   public
     function GetText(var S: String): Boolean; override;
     procedure SetReadOnly(AReadOnly: Boolean); override;
@@ -630,6 +632,30 @@ begin
   if FReadOnly then ListItemSelected(GetValue - 1);
 end;
 
+{------------------------------------------------------------------------------
+  Method:  TCarbonComboBox.FocusSet
+
+  Handles set focus
+ ------------------------------------------------------------------------------}
+procedure TCarbonComboBox.FocusSet;
+begin
+  inherited;
+  // emulate DropDown event here
+  LCLSendDropDownMsg(LCLObject);
+end;
+
+{------------------------------------------------------------------------------
+  Method:  TCarbonComboBox.FocusKilled
+
+  Handles kill focus
+ ------------------------------------------------------------------------------}
+procedure TCarbonComboBox.FocusKilled;
+begin
+  inherited;
+  // emulate CloseUp event here
+  LCLSendCloseUpMsg(LCLObject);
+end;
+
 {------------------------------------------------------------------------------
   Method:  TCarbonComboBox.GetText
   Params:  S - Text

lcl/interfaces/carbon/carbonobject.inc

@@ -471,7 +471,8 @@ begin
     SendEventToEventTarget(Event, Target);
     ReleaseEvent(Event);
     
-    Clipboard.CheckOwnerShip;
+    if Clipboard <> nil then
+      if Clipboard.OwnerShips > 0 then Clipboard.CheckOwnerShip;
     
   until Application.Terminated;
   

lcl/interfaces/carbon/carbonprivate.pp

@@ -171,17 +171,19 @@ type
   TCarbonCustomControl = class(TCarbonControl)
   private
     FScrollView: HIViewRef;
-    FScrollOrigin: TPoint;
+    FScrollOrigin: HIPoint;
     FScrollSize: TPoint;
     FScrollPageSize: TPoint;
+    FMulX: Single; // multiply x coords to fit real page size
+    FMulY: Single; // multiply y coords to fit real page size
   protected
     procedure RegisterEvents; override;
     procedure CreateWidget(const AParams: TCreateParams); override;
     procedure DestroyWidget; override;
     function GetFrame(Index: Integer): ControlRef; override;
   public
-    procedure GetInfo(out AImageSize, AViewSize, ALineSize, AOrigin: TPoint); dynamic;
+    procedure GetInfo(out AImageSize, AViewSize, ALineSize: HISize; out AOrigin: HIPoint); virtual;
-    procedure ScrollTo(const ANewOrigin: TPoint); dynamic;
+    procedure ScrollTo(const ANewOrigin: HIPoint); virtual;
   public
     procedure SetColor(const AColor: TColor); override;
     procedure SetFont(const AFont: TFont); override;
@@ -363,7 +365,6 @@ function CarbonScrollable_GetInfo(ANextHandler: EventHandlerCallRef;
   AEvent: EventRef;
   AWidget: TCarbonWidget): OSStatus; {$IFDEF darwin}mwpascal;{$ENDIF}
 var
-  ImageSize, ViewSize, LineSize, Origin: TPoint;
   ImageHISize, ViewHISize, LineHISize: HISize;
   HIOrigin: HIPoint;
 const
@@ -373,12 +374,7 @@ begin
     DebugLn('CarbonScrollable_GetInfo ', DbgSName(AWidget.LCLObject));
   {$ENDIF}
 
-  (AWidget as TCarbonCustomControl).GetInfo(ImageSize, ViewSize, LineSize, Origin);
+  (AWidget as TCarbonCustomControl).GetInfo(ImageHISize, ViewHISize, LineHISize, HIOrigin);
-  
-  ImageHISize := PointToHISize(ImageSize);
-  ViewHISize := PointToHISize(ViewSize);
-  LineHISize := PointToHISize(LineSize);
-  HIOrigin := PointToHIPoint(Origin);
   
   OSError(SetEventParameter(AEvent, kEventParamImageSize, typeHISize,
     SizeOf(HISize), @ImageHISize), SName, SSetEvent, 'kEventParamImageSize');
@@ -411,7 +407,7 @@ begin
       SizeOf(HIPoint), nil, @Origin), 'CarbonScrollable_ScrollTo', SGetEvent,
     'kEventParamOrigin') then Exit;
   
-  (AWidget as TCarbonCustomControl).ScrollTo(HIPointToPoint(Origin));
+  (AWidget as TCarbonCustomControl).ScrollTo(Origin);
   
   Result := noErr;
 end;
@@ -455,7 +451,9 @@ begin
   FScrollView := EmbedInScrollView(AParams);
   FScrollSize := Classes.Point(0, 0);
   FScrollPageSize := Classes.Point(0, 0);
-  FScrollOrigin := Classes.Point(0, 0);
+  FScrollOrigin := GetHIPoint(0, 0);
+  FMulX := 1;
+  FMulY := 1;
     
   inherited;
 end;
@@ -489,15 +487,27 @@ end;
            ALineSize  - Size of scrollable line
            AOrigin    - Scroll position
 
-  Handles scrollableget info event
+  Handles scrollable get info event
  ------------------------------------------------------------------------------}
-procedure TCarbonCustomControl.GetInfo(out AImageSize, AViewSize,
+procedure TCarbonCustomControl.GetInfo(out AImageSize, AViewSize, ALineSize: HISize;
-  ALineSize, AOrigin: TPoint);
+  out AOrigin: HIPoint);
+var
+  C: TRect;
 begin
-  AOrigin := FScrollOrigin;
+  // modify coordinates to fit real page size
-  AImageSize := FScrollSize;
+  GetClientRect(C);
-  AViewSize := FScrollPageSize;
+  
-  ALineSize := Classes.Point(10, 10);
+  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(FScrollOrigin.X * FMulX, FScrollOrigin.Y * FMulY);
+  AImageSize := GetHISize(FScrollSize.X * FMulX, FScrollSize.Y * FMulY);
+  AViewSize := GetHISize(C.Right - C.Left, C.Bottom - C.Top);
+  ALineSize := GetHISize(FScrollPageSize.X * FMulX / 40, FScrollPageSize.Y * FMulY / 40);
   
   {$IFDEF VerboseScroll}
     DebugLn('TCarbonCustomControl.GetInfo ' + LCLObject.Name + ' Origin: ' +
@@ -512,7 +522,7 @@ end;
 
   Handles scrollable scroll to event
  ------------------------------------------------------------------------------}
-procedure TCarbonCustomControl.ScrollTo(const ANewOrigin: TPoint);
+procedure TCarbonCustomControl.ScrollTo(const ANewOrigin: HIPoint);
 var
   ScrollMsg: TLMScroll;
 begin
@@ -521,14 +531,19 @@ begin
       DbgS(ANewOrigin));
   {$ENDIF}
   
-  FScrollOrigin := ANewOrigin;
+  if FMulX = 0 then FScrollOrigin.X := 0
+  else
+    FScrollOrigin.X := ANewOrigin.X / FMulX;
+  if FMulY = 0 then FScrollOrigin.Y := 0
+  else
+    FScrollOrigin.Y := ANewOrigin.Y / FMulY;
   
   // send vertical scroll
   FillChar(ScrollMsg, SizeOf(TLMScroll), 0);
   with ScrollMsg do
   begin
     Msg := LM_VSCROLL;
-    Pos := ANewOrigin.Y;
+    Pos := Round(FScrollOrigin.Y);
     ScrollCode := SB_THUMBPOSITION;
   end;
   DeliverMessage(LCLObject, ScrollMsg);
@@ -538,7 +553,7 @@ begin
   with ScrollMsg do
   begin
     Msg := LM_HSCROLL;
-    Pos := ANewOrigin.X;
+    Pos := Round(FScrollOrigin.X);
     ScrollCode := SB_THUMBPOSITION;
   end;
   DeliverMessage(LCLObject, ScrollMsg);
@@ -590,9 +605,9 @@ begin
   {$ENDIF}
 
   if SBStyle = SB_HORZ then
-    Result := FScrollOrigin.X;
+    Result := Round(FScrollOrigin.X);
   if SBStyle = SB_VERT then
-    Result := FScrollOrigin.Y;
+    Result := Round(FScrollOrigin.Y);
 
   if (SIF_RANGE and ScrollInfo.fMask) > 0 then
   begin
@@ -665,9 +680,9 @@ begin
   if (SIF_POS and ScrollInfo.fMask) > 0 then
   begin
     if SBStyle = SB_HORZ then
-      ScrollInfo.nPos := FScrollOrigin.X;
+      ScrollInfo.nPos := Round(FScrollOrigin.X);
     if SBStyle = SB_VERT then
-      ScrollInfo.nPos := FScrollOrigin.Y;
+      ScrollInfo.nPos := Round(FScrollOrigin.Y);
   end;
 
   if (SIF_PAGE and ScrollInfo.fMask) > 0 then

lcl/interfaces/carbon/carbonprivatecommon.inc

@@ -350,9 +350,9 @@ begin
   end;
 
   if FocusPart <> kControlFocusNoPart then
-    LCLSendSetFocusMsg(AWidget.LCLObject)
+    AWidget.FocusSet
   else
-    LCLSendKillFocusMsg(AWidget.LCLObject);
+    AWidget.FocusKilled;
 end;
 
 {------------------------------------------------------------------------------

lcl/interfaces/carbon/carbonproc.pp

@@ -78,8 +78,10 @@ const
   DEFAULT_CFSTRING_ENCODING = kCFStringEncodingUTF8;
 
 procedure CreateCFString(const S: String; out AString: CFStringRef);
+procedure CreateCFString(const Data: CFDataRef; Encoding: CFStringEncoding; out AString: CFStringRef);
 procedure FreeCFString(var AString: CFStringRef);
-function CFStringToStr(AString: CFStringRef): String;
+function CFStringToStr(AString: CFStringRef; Encoding: CFStringEncoding = DEFAULT_CFSTRING_ENCODING): String;
+function CFStringToData(AString: CFStringRef; Encoding: CFStringEncoding = DEFAULT_CFSTRING_ENCODING): CFDataRef;
 
 function RoundFixed(const F: Fixed): Integer;
 
@@ -104,6 +106,8 @@ function HIRectToCarbonRect(const ARect: HIRect): FPCMacOSAll.Rect;
 function PointToHIPoint(const APoint: TPoint): HIPoint;
 function PointToHISize(const APoint: TPoint): HISize;
 function HIPointToPoint(const APoint: HIPoint): TPoint;
+function GetHIPoint(X, Y: Single): HIPoint;
+function GetHISize(X, Y: Single): HISize;
 
 function ColorToRGBColor(const AColor: TColor): RGBColor;
 function RGBColorToColor(const AColor: RGBColor): TColor;
@@ -111,6 +115,8 @@ function CreateCGColor(const AColor: TColor): CGColorRef;
 
 function DbgS(const ARect: FPCMacOSAll.Rect): string; overload;
 function DbgS(const AColor: FPCMacOSAll.RGBColor): string; overload;
+function DbgS(const APoint: HIPoint): string; overload;
+function DbgS(const ASize: HISize): string; overload;
 
 implementation
 
@@ -493,13 +499,30 @@ end;
   Params:  S       - UTF-8 string
            AString - Core Foundation string ref
 
-  Creates new Core Foundation string form specified string
+  Creates new Core Foundation string from the specified string
  ------------------------------------------------------------------------------}
 procedure CreateCFString(const S: String; out AString: CFStringRef);
 begin
   AString := CFStringCreateWithCString(nil, Pointer(PChar(S)), DEFAULT_CFSTRING_ENCODING);
 end;
 
+{------------------------------------------------------------------------------
+  Name:    CreateCFString
+  Params:  Data     - CFDataRef
+           Encoding - Data encoding format
+           AString  - Core Foundation string ref
+
+  Creates new Core Foundation string from the specified data and format
+ ------------------------------------------------------------------------------}
+procedure CreateCFString(const Data: CFDataRef; Encoding: CFStringEncoding; out
+  AString: CFStringRef);
+begin
+  AString := nil;
+  if Data = nil then Exit;
+  AString := CFStringCreateWithBytes(nil, CFDataGetBytePtr(Data),
+    CFDataGetLength(Data), Encoding, False);
+end;
+
 {------------------------------------------------------------------------------
   Name:    FreeCFString
   Params:  AString - Core Foundation string ref to free
@@ -514,12 +537,13 @@ end;
 
 {------------------------------------------------------------------------------
   Name:    CFStringToStr
-  Params:  AString - Core Foundation string ref
+  Params:  AString  - Core Foundation string ref
+           Encoding - Result data encoding format
   Returns: UTF-8 string
 
   Converts Core Foundation string to string
  ------------------------------------------------------------------------------}
-function CFStringToStr(AString: CFStringRef): String;
+function CFStringToStr(AString: CFStringRef; Encoding: CFStringEncoding): String;
 var
   Str: Pointer;
   StrSize: CFIndex;
@@ -532,7 +556,7 @@ begin
   end;
 
   // Try the quick way first
-  Str := CFStringGetCStringPtr(AString, DEFAULT_CFSTRING_ENCODING);
+  Str := CFStringGetCStringPtr(AString, Encoding);
   if Str <> nil then
     Result := PChar(Str)
   else
@@ -541,16 +565,35 @@ begin
     StrRange.location := 0;
     StrRange.length := CFStringGetLength(AString);
     
-    CFStringGetBytes(AString, StrRange, DEFAULT_CFSTRING_ENCODING,
+    CFStringGetBytes(AString, StrRange, Encoding,
-      0, False, nil, 0, StrSize);
+      Ord('?'), False, nil, 0, StrSize);
     SetLength(Result, StrSize);
 
     if StrSize > 0 then
-      CFStringGetBytes(AString, StrRange, DEFAULT_CFSTRING_ENCODING,
+      CFStringGetBytes(AString, StrRange, Encoding,
-        0, False, @Result[1], StrSize, StrSize);
+        Ord('?'), False, @Result[1], StrSize, StrSize);
   end;
 end;
 
+{------------------------------------------------------------------------------
+  Name:    CFStringToData
+  Params:  AString  - Core Foundation string ref
+           Encoding - Result data encoding format
+  Returns: CFDataRef
+
+  Converts Core Foundation string to data
+ ------------------------------------------------------------------------------}
+function CFStringToData(AString: CFStringRef; Encoding: CFStringEncoding): CFDataRef;
+var
+  S: String;
+begin
+  Result := nil;
+  if AString = nil then Exit;
+  S := CFStringToStr(AString, Encoding);
+  
+  Result := CFDataCreate(nil, @S[1], Length(S));
+end;
+
 {------------------------------------------------------------------------------
   Name:    RoundFixed
   Params:  F - Fixed value
@@ -810,6 +853,28 @@ begin
   Result.Y := Trunc(APoint.Y);
 end;
 
+{------------------------------------------------------------------------------
+  Name:    GetHIPoint
+  Params:  X, Y
+  Returns: HIPoint
+ ------------------------------------------------------------------------------}
+function GetHIPoint(X, Y: Single): HIPoint;
+begin
+  Result.X := X;
+  Result.Y := Y;
+end;
+
+{------------------------------------------------------------------------------
+  Name:    GetHISize
+  Params:  X, Y
+  Returns: HISize
+ ------------------------------------------------------------------------------}
+function GetHISize(X, Y: Single): HISize;
+begin
+  Result.width := X;
+  Result.height := Y;
+end;
+
 {------------------------------------------------------------------------------
   Name:    ColorToRGBColor
   Params:  AColor - Color
@@ -875,6 +940,16 @@ begin
     ' B: ' + IntToHex(AColor.Blue, 4);
 end;
 
+function DbgS(const APoint: HIPoint): string;
+begin
+  Result := 'X: ' + DbgS(APoint.X) + ' Y: ' + DbgS(APoint.Y);
+end;
+
+function DbgS(const ASize: HISize): string;
+begin
+  Result := 'W: ' + DbgS(ASize.width) + ' H: ' + DbgS(ASize.height);
+end;
+
 {------------------------------------------------------------------------------
   Name: CustomControlHandler
   Handles custom control class methods