Carbon inf:

- fixed bug #0009410: Carbon TMainMenu does not reflect currently focused form
- fixed bug #0009409: Carbon Widgetset: Radio TMenuItem does not update
- fixed bug #0009266: UTF8 conversion problem with the output of components when using the cabon interace
- applied patch #0009423: Fix for Carbon custom control keyboard focus from Jonas Maebe, added to Contributors.txt
- corrected DefaultBitmap and CGBitmapContext creation
- fixed ExtTextOut origin with rotated font
- fixed FindCarbonFontID, implemented Get/SetWindowOrgEx from Phil J. Hess

git-svn-id: trunk@11915 -

docs/Contributors.txt

@@ -1,4 +1,4 @@
-The following people contributed to Lazarus:
+The following people contributed to Lazarus:
 
 A. J. Venter
 Aleksey Lagunov
@@ -46,6 +46,7 @@ Jeffrey A. Wormsley
 Jeroen van Idekinge
 Jesus Reyes
 Joerg Braun - german translation
+Jonas Maebe
 Joost van der Sluis
 Jouke Rensma
 Juan Salvador Perez García

docs/contributors.utf8

@@ -1,4 +1,4 @@
-See Contributors.txt for all contributors.
+See Contributors.txt for all contributors.
 This file is only a placeholder for the correct spelling 
 of some names until all widgetsets correctly display 
 utf8 names.
@@ -14,4 +14,5 @@ Júnior Gonçalves
 Luiz Américo
 Márton Papp 
 Sérgio Marcelo
+Tomáš Gregorovič
 Valdas Jankūnas

lcl/interfaces/carbon/carboncanvas.pp

@@ -106,6 +106,7 @@ type
     procedure EndTextRender(var ALayout: ATSUTextLayout);
     
     procedure SetAntialiasing(AValue: Boolean);
+    function DrawCGImage(X, Y, Width, Height: Integer; CGImage: CGImageRef): Boolean;
   public
     procedure DrawFocusRect(const ARect: TRect);
     procedure DrawFrameControl(var ARect: TRect; AType, AState: Cardinal);
@@ -683,6 +684,36 @@ begin
   CGContextSetShouldAntialias(CGContext, CBool(AValue));
 end;
 
+{------------------------------------------------------------------------------
+  Method:  TCarbonDeviceContext.DrawCGImage
+  Params:  X, Y - Left, Top
+           Width, Height
+           CGImage
+  Returns: If the function succeeds
+
+  Draws CGImage into CGContext
+ ------------------------------------------------------------------------------}
+function TCarbonDeviceContext.DrawCGImage(X, Y, Width, Height: Integer;
+  CGImage: CGImageRef): Boolean;
+begin
+  Result := False;
+  
+  // save dest context
+  CGContextSaveGState(CGContext);
+
+  CGContextSetBlendMode(CGContext, kCGBlendModeNormal);
+  try
+    if OSError(
+      HIViewDrawCGImage(CGContext,
+      GetCGRectSorted(X, Y, X + Width, Y + Height), CGImage),
+      'DrawCGImage', 'HIViewDrawCGImage') then Exit;
+  finally
+    CGContextRestoreGState(CGContext);
+  end;
+  
+  Result := True;
+end;
+
 {------------------------------------------------------------------------------
   Method:  TCarbonDeviceContext.DrawFocusRect
   Params:  ARect - Bounding rectangle
@@ -836,6 +867,8 @@ function TCarbonDeviceContext.ExtTextOut(X, Y: Integer; Options: Longint;
 var
   TextLayout: ATSUTextLayout;
   TextBefore, TextAfter, Ascent, Descent: ATSUTextMeasurement;
+  MX, MY: ATSUTextMeasurement;
+  A: Single;
 const
   SName = 'ExtTextOut';
 begin
@@ -853,6 +886,7 @@ begin
   
     Exit;
   end;
+  
   try
     // get text ascent
     if OSError(
@@ -860,6 +894,17 @@ begin
         TextBefore, TextAfter, Ascent, Descent),
       Self, SName, SGetUnjustifiedBounds) then Exit;
 
+    if CurrentFont.LineRotation <> 0 then // TODO: fill rotated text background
+    begin
+      A := CurrentFont.LineRotation * (PI / ($10000 * 180));
+      MX := Round(Ascent * Sin(A));
+      MY := Round(Ascent - Ascent * Cos(A));
+    end
+    else
+    begin
+      MX := 0;
+      MY := 0;
+
       // fill drawed text background
       if (Options and ETO_OPAQUE) > 0 then
       begin
@@ -867,16 +912,15 @@ begin
         CGContextFillRect(CGContext, GetCGRectSorted(X - TextBefore shr 16,
           -Y, X + TextAfter shr 16, -Y - (Ascent + Descent) shr 16));
       end;
+    end;
 
     // apply text color
     TextBrush.Apply(Self, False); // do not use ROP2
 
-
     // finally draw the text
     if OSError(ATSUDrawText(TextLayout, kATSUFromTextBeginning, kATSUToTextEnd,
-        X shl 16 - TextBefore, -(Y shl 16) - Ascent),
+        X shl 16 - TextBefore + MX, -(Y shl 16) - Ascent + MY),
        Self, SName, 'ATSUDrawText') then Exit;
-
     Result := True;
   finally
     EndTextRender(TextLayout);
@@ -1288,17 +1332,11 @@ var
   SubImage, SubMask: Boolean;
   Bitmap: TCarbonBitmap;
   LayRect, DstRect: CGRect;
-  sts: OSStatus;
   LayerContext: CGContextRef;
   Layer: CGLayerRef;
 begin
   Result := False;
   
-  // save dest context
-  CGContextSaveGState(CGContext);
-
-  CGContextSetBlendMode(CGContext, kCGBlendModeNormal);
-  try
   Image := nil;
   Bitmap := SrcDC.GetBitmap;
   if Bitmap <> nil then Image := Bitmap.CGImage;
@@ -1321,43 +1359,50 @@ begin
            or (SrcHeight <> Bitmap.Height);
 
 
-    if SubMask
+  if SubMask then
-    then MskImage := Msk.CreateSubImage(Bounds(XMsk, YMsk, SrcWidth, SrcHeight))
+    MskImage := Msk.CreateSubImage(Bounds(XMsk, YMsk, SrcWidth, SrcHeight))
-    else if Msk <> nil
+  else
-    then MskImage := Msk.CGImage
+    if Msk <> nil then MskImage := Msk.CGImage
     else MskImage := nil;
 
-    if SubImage
+  if SubImage then
-    then Image := Bitmap.CreateSubImage(Bounds(XSrc, YSrc, SrcWidth, SrcHeight));
+    Image := Bitmap.CreateSubImage(Bounds(XSrc, YSrc, SrcWidth, SrcHeight));
 
-
+  try
-    if MskImage = nil
+    if MskImage = nil then
-    then begin
+    begin
       // Normal drawing
-      sts := HIViewDrawCGImage(CGContext, DstRect, Image);
+      Result := DrawCGImage(X, Y, Width, Height, Image);
-      Result := not OSError(sts, 'StretchMaskBlt', 'HIViewDrawCGImage');
     end
-    else begin
+    else
+    begin
       // use temp layer to mask source image
       // todo find a way to maks "hard" when stretching, now some soft remains are visible
       LayRect := CGRectMake(0, 0, SrcWidth, SrcHeight);
       Layer := CGLayerCreateWithContext(SrcDC.CGContext, LayRect.size, nil);
+      try
         LayerContext := CGLayerGetContext(Layer);
         CGContextScaleCTM(LayerContext, 1, -1);
         CGContextTranslateCTM(LayerContext, 0, -SrcHeight);
         CGContextClipToMask(LayerContext, LayRect, MskImage);
         CGContextDrawImage(LayerContext, LayRect, Image);
         CGContextDrawLayerInRect(CGContext, DstRect, Layer);
-      CGLayerRelease(Layer);
-      Result := True;
-    end;
         
-    if SubImage then CGImageRelease(Image);
+        Result := True;
-    if SubMask then CGImageRelease(MskImage);
+      finally
+        CGLayerRelease(Layer);
+      end;
+    end;
 
   finally
-    CGContextRestoreGState(CGContext);
+    if SubImage then CGImageRelease(Image);
+    if SubMask then CGImageRelease(MskImage);
   end;
+  
+  //DebugLn('StretchMaskBlt succeeds: ', Format('Dest %d Src %d X %d Y %d',
+  //  [Integer(CGContext),
+  //  Integer(Image),
+  //  X, Y]));
 end;
 
 { TCarbonScreenContext }
@@ -1481,6 +1526,8 @@ end;
   Resets the bitmap context properties to defaults (pen, brush, ...)
  ------------------------------------------------------------------------------}
 procedure TCarbonBitmapContext.Reset;
+var
+  Info: CGBitmapInfo;
 begin
   if CGContext <> nil then CGContextRelease(CGContext);
 
@@ -1506,9 +1553,14 @@ begin
 
     // create CGBitmapContext
     
+    Info := FBitmap.Info;
+    // convert kCGImageAlphaFirst -> kCGImageAlphaNoneSkipFirst
+    if (Info and kCGImageAlphaFirst > 0) then
+      Info := (Info and (not kCGImageAlphaFirst)) or kCGImageAlphaNoneSkipFirst;
+    
     CGContext := CGBitmapContextCreate(FBitmap.Data, FBitmap.Width, FBitmap.Height,
                    FBitmap.BitsPerComponent, FBitmap.BytesPerRow, FBitmap.ColorSpace,
-                   FBitmap.Info);
+                   Info);
 
     // flip and offset CTM to upper left corner
     CGContextTranslateCTM(CGContext, 0, FBitmap.Height);

lcl/interfaces/carbon/carbonedits.pp

@@ -932,17 +932,9 @@ end;
   Text changed event handler
  ------------------------------------------------------------------------------}
 procedure TCarbonSpinEdit.TextDidChange;
-var
-  NewValue: Single;
 begin
-  NewValue := StrToFloatDef((LCLObject as TCustomFloatSpinEdit).Text, FValue);
+  FValue := (LCLObject as TCustomFloatSpinEdit).StrToValue(
-
+    (LCLObject as TCustomFloatSpinEdit).Text);
-  if FMax > FMin then
-  begin
-    if NewValue > FMax then NewValue := FMax;
-    if NewValue < FMin then NewValue := FMin;
-  end;
-  FValue := NewValue;
 
   inherited TextDidChange;
 end;
@@ -959,14 +951,8 @@ begin
     kControlUpButtonPart:   FValue := FValue + FIncrement;
     kControlDownButtonPart: FValue := FValue - FIncrement;
   end;
-  if FMax > FMin then
-  begin
-    if FValue < FMin then FValue := FMin;
-    if FValue > FMax then FValue := FMax;
-  end;
   
-  (LCLObject as TCustomFloatSpinEdit).Text :=
+  inherited SetText((LCLObject as TCustomFloatSpinEdit).ValueToStr(FValue));
-    FloatToStrF(FValue, ffFixed, 20, FDecimalPlaces);
 end;
 
 {------------------------------------------------------------------------------
@@ -1010,17 +996,8 @@ end;
   Sets the text of edit control
  ------------------------------------------------------------------------------}
 function TCarbonSpinEdit.SetText(const S: String): Boolean;
-var
-  NewValue: Single;
 begin
-  NewValue := StrToFloatDef(S, FValue);
+  FValue := (LCLObject as TCustomFloatSpinEdit).StrToValue(S);
-
-  if FMax > FMin then
-  begin
-    if NewValue > FMax then NewValue := FMax;
-    if NewValue < FMin then NewValue := FMin;
-  end;
-  FValue := NewValue;
   
   Result := inherited SetText(S);
 end;
@@ -1042,7 +1019,7 @@ begin
   FDecimalPlaces :=  SpinEdit.DecimalPlaces;
     
   // update edit text
-  SpinEdit.Text := FloatToStrF(FValue, ffFixed, 20, FDecimalPlaces);
+  inherited SetText((LCLObject as TCustomFloatSpinEdit).ValueToStr(FValue));
 end;
 
 { TCarbonEdit }

lcl/interfaces/carbon/carbongdiobjects.pp

@@ -100,6 +100,7 @@ type
     constructor Create(const AColor: TColor; ASolid, AGlobal: Boolean);
     procedure SetColor(const AColor: TColor; ASolid: Boolean);
     procedure GetRGBA(AROP2: Integer; out AR, AG, AB, AA: Single);
+    function CreateCGColor: CGColorRef;
   end;
 
   { TCarbonBrush }
@@ -159,6 +160,7 @@ type
   TCarbonBitmap = class(TCarbonGDIObject)
   private
     FData: Pointer;
+    FFreeData: Boolean;
     FDataSize: Integer;
     FBytesPerRow: Integer;
     FDepth: Byte;
@@ -171,7 +173,9 @@ type
     function GetColorSpace: CGColorSpaceRef;
     function GetInfo: CGBitmapInfo;
   public
-    constructor Create(AWidth, AHeight, ADepth, ABitsPerPixel: Integer; AAlignment: TCarbonBitmapAlignment; AType: TCarbonBitmapType; AData: Pointer);
+    constructor Create(AWidth, AHeight, ADepth, ABitsPerPixel: Integer;
+      AAlignment: TCarbonBitmapAlignment; AType: TCarbonBitmapType;
+      AData: Pointer; ACopyData: Boolean = True);
     destructor Destroy; override;
     procedure Update;
     function CreateSubImage(const ARect: TRect): CGImageRef;
@@ -871,6 +875,22 @@ begin
   end;
 end;
 
+{------------------------------------------------------------------------------
+  Method:  TCarbonColorObject.CreateCGColor
+  Returns: CGColor
+ ------------------------------------------------------------------------------}
+function TCarbonColorObject.CreateCGColor: CGColorRef;
+var
+  F: Array [0..3] of Single;
+begin
+  F[0] := FR / 255;
+  F[1] := FG / 255;
+  F[2] := FB / 255;
+  F[3] := Byte(FA);
+  
+  Result := CGColorCreate(RGBColorSpace, @F[0]);
+end;
+
 { TCarbonBrush }
 
 {------------------------------------------------------------------------------
@@ -1043,6 +1063,10 @@ begin
   else Result := RGBColorSpace
 end;
 
+{------------------------------------------------------------------------------
+  Method:  TCarbonBitmap.GetInfo
+  Returns: The CGBitmapInfo for this type of bitmap
+ ------------------------------------------------------------------------------}
 function TCarbonBitmap.GetInfo: CGBitmapInfo;
 begin
   Result := BITMAPINFOMAP[FType];
@@ -1056,10 +1080,13 @@ end;
            ABitsPerPixel - The number of allocated bits per pixel (can be larget that depth)
            AAlignment    - Alignment of the data for each row
            ABytesPerRow  - The number of bytes between rows
+           ACopyData     - Copy supplied bitmap data (OPTIONAL)
   
   Creates Carbon bitmap with the specified characteristics
  ------------------------------------------------------------------------------}
-constructor TCarbonBitmap.Create(AWidth, AHeight, ADepth, ABitsPerPixel: Integer; AAlignment: TCarbonBitmapAlignment; AType: TCarbonBitmapType; AData: Pointer);
+constructor TCarbonBitmap.Create(AWidth, AHeight, ADepth, ABitsPerPixel: Integer;
+  AAlignment: TCarbonBitmapAlignment; AType: TCarbonBitmapType; AData: Pointer;
+  ACopyData: Boolean);
 const
   ALIGNBITS: array[TCarbonBitmapAlignment] of Integer = (0, 1, 3, 7, $F);
 var
@@ -1084,12 +1111,21 @@ begin
   then Inc(FBytesPerRow, ALIGNBITS[AAlignment] + 1 - m);
 
   FDataSize := FBytesPerRow * FHeight;
+  
+  if (AData = nil) or ACopyData then
+  begin
     System.GetMem(FData, FDataSize);
+    FFreeData := True;
     if AData <> nil then
       System.Move(AData^, FData^, FDataSize) // copy data
     else
       FillDWord(FData^, FDataSize shr 2, 0); // clear bitmap
-
+  end
+  else
+  begin
+    FData := AData;
+    FFreeData := False;
+  end;
 //DebugLn(Format('TCarbonBitmap.Create %d x %d Data: %d RowSize: %d Size: %d',
 //  [AWidth, AHeight, Integer(AData), DataRowSize, FDataSize]));
 
@@ -1106,7 +1142,7 @@ end;
 destructor TCarbonBitmap.Destroy;
 begin
   CGImageRelease(FCGImage);
-  System.FreeMem(FData);
+  if FFreeData then System.FreeMem(FData);
 
   inherited Destroy;
 end;
@@ -1137,7 +1173,7 @@ begin
 end;
 
 {------------------------------------------------------------------------------
-  Method:  TCarbonBitmap.GetSubImage
+  Method:  TCarbonBitmap.CreateSubImage
   Returns: New image ref to portion of image data according to the rect
  ------------------------------------------------------------------------------}
 function TCarbonBitmap.CreateSubImage(const ARect: TRect): CGImageRef;
@@ -1517,7 +1553,7 @@ initialization
   BlackPen := TCarbonPen.Create(True);
   
   DefaultContext := TCarbonBitmapContext.Create;
-  DefaultBitmap := TCarbonBitmap.Create(1, 1, 1, 1, cbaDQWord, cbtMono, nil);
+  DefaultBitmap := TCarbonBitmap.Create(1, 1, 32, 32, cbaDQWord, cbtARGB, nil);
   DefaultContext.Bitmap := DefaultBitmap;
   
   ScreenContext := TCarbonScreenContext.Create;

lcl/interfaces/carbon/carbonint.pas

@@ -92,7 +92,7 @@ type
     procedure AppBringToFront; override;
     procedure AppSetTitle(const ATitle: string); override;
 
-    procedure AttachMenuToWindow(AMenuObject: TComponent); Override;
+    procedure AttachMenuToWindow(AMenuObject: TComponent); override;
     
     function  DCGetPixel(CanvasHandle: HDC; X, Y: integer): TGraphicsColor; override;
     procedure DCSetPixel(CanvasHandle: HDC; X, Y: integer; AColor: TGraphicsColor); override;
@@ -111,6 +111,7 @@ type
 
   public
     procedure SetMainMenuEnabled(AEnabled: Boolean);
+    procedure SetRootMenu(const AMenu: TMainMenu);
   public
     procedure SetCaptureWidget(const AWidget: HWND);
   end;

lcl/interfaces/carbon/carbonlclintf.inc

@@ -481,6 +481,24 @@ begin
   end;
 end;
 
+{------------------------------------------------------------------------------
+  Method:  TCarbonWidgetSet.SetRootMenu
+  Params:  AMenu - Main menu
+
+  Sets the menu to menu bar
+ ------------------------------------------------------------------------------}
+procedure TCarbonWidgetSet.SetRootMenu(const AMenu: TMainMenu);
+begin
+  if (AMenu <> nil) and AMenu.HandleAllocated then
+  begin
+    if not CheckMenu(AMenu.Handle, 'SetRootMenu') then Exit;
+
+    TCarbonMenu(AMenu.Handle).AttachToMenuBar;
+  end
+  else
+    OSError(FPCMacOSAll.SetRootMenu(EmptyMenu), Self, 'SetRootMenu', 'SetRootMenu');
+end;
+
 {------------------------------------------------------------------------------
   Method:  SetCaptureWidget
   Params:  AWidget - Carbon widget to capture

lcl/interfaces/carbon/carbonmenus.pp

@@ -74,6 +74,9 @@ type
   
 function CheckMenu(const Menu: HMENU; const AMethodName: String; AParamName: String = ''): Boolean;
 
+var
+  EmptyMenu: MenuRef; // menu for clearing menu bar workaround
+
 implementation
 
 uses
@@ -279,7 +282,7 @@ begin
   {$ENDIF}
   
   Index := GetIndex;
-  if FParentMenu.FRoot then MenuNeeded; // menu tiem is in toplevel of root menu
+  if FParentMenu.FRoot then MenuNeeded; // menu item is in toplevel of root menu
   
   if LCLMenuItem.Caption = cLineCaption then // menu item is separator
     OSError(
@@ -531,7 +534,8 @@ begin
         
         if Item.LCLMenuItem.RadioItem and Item.LCLMenuItem.AutoCheck and
           (Item.LCLMenuItem.GroupIndex = LCLMenuItem.GroupIndex) then
-            Item.SetCheck(False);
+            SetItemMark(FParentMenu.Menu, Item.GetIndex + 1, #0);
+
       end;
     end
     else
@@ -610,6 +614,14 @@ begin
   SetItemStyle(FParentMenu.Menu, GetIndex + 1, Style);
 end;
 
+initialization
+
+  OSError(CreateNewMenu(0, kMenuAttrAutoDisable, EmptyMenu),
+    'CarbonMenus.initialization', 'CreateNewMenu');
+
+finalization
+
+  DisposeMenu(EmptyMenu);
 
 end.
 

lcl/interfaces/carbon/carbonobject.inc

@@ -896,19 +896,7 @@ begin
     DebugLn('TCarbonWidgetSet.AttachMenuToWindow ' + AMenuObject.Name);
   {$ENDIF}
   
-  if (AMenuObject is TMainMenu) and (TMainMenu(AMenuObject).Handle <> 0) then
+  // menus are attached on each form activation
-  begin
-    if not CheckMenu(TMainMenu(AMenuObject).Handle, SName) then Exit;
-      
-    if FMainMenu <> nil then
-    begin
-      DebugLn(SName + ' Unable to change main menu - menu bar is set yet!');
-      Exit;
-    end;
-      
-    TCarbonMenu(TMainMenu(AMenuObject).Handle).AttachToMenuBar;
-    FMainMenu := TMainMenu(AMenuObject);
-  end;
 end;
 
 {------------------------------------------------------------------------------

lcl/interfaces/carbon/carbonprivatecommon.inc

@@ -308,8 +308,10 @@ var
 const
   SName = 'CarbonCommon_SetFocusPart';
 begin
-  //if not (AWidget.LCLObject is TCustomControl) then
+  if not (AWidget.LCLObject is TCustomControl) then
-    Result := CallNextEventHandler(ANextHandler, AEvent);
+    Result := CallNextEventHandler(ANextHandler, AEvent)
+  else
+    Result := noErr;
 
   if OSError(
     GetEventParameter(AEvent, kEventParamControlPart, typeControlPartCode, nil,

lcl/interfaces/carbon/carbonprivatewindow.inc

@@ -386,7 +386,7 @@ const
     VKKeyCode:=VK_UNKNOWN;
 
     KeyData:=GetCarbonMsgKeyState;
-    IsSysKey:=(GetCurrentEventKeyModifiers and optionKey)>0;
+    IsSysKey:=(GetCurrentEventKeyModifiers and cmdKey)>0;
 
     if OSError(GetEventParameter(AEvent, kEventParamKeyCode, typeUInt32, nil,
         Sizeof(KeyCode), nil, @KeyCode), SName, AGetEvent,
@@ -742,13 +742,25 @@ begin
   
   EventKind := GetEventKind(AEvent);
   case EventKind of
-    kEventWindowActivated:   Msg.msg := LM_ACTIVATE;
+    kEventWindowActivated:
-    kEventWindowDeactivated: Msg.msg := LM_DEACTIVATE;
+      begin
+        Msg.msg := LM_ACTIVATE;
+        if (AWidget.LCLObject is TCustomForm) then
+          CarbonWidgetSet.SetRootMenu((AWidget.LCLObject as TCustomForm).Menu);
+      end;
+    kEventWindowDeactivated:
+      begin
+        Msg.msg := LM_DEACTIVATE;
+        if (AWidget.LCLObject is TCustomForm) then
+          CarbonWidgetSet.SetRootMenu(nil);
+      end;
   else
     DebugLn('CarbonWindow_ActivateProc invalid event kind: ' + DbgS(EventKind));
     Exit;
   end;
   
+
+  
   DeliverMessage(AWidget.LCLObject, Msg);
 end;
 

lcl/interfaces/carbon/carbonproc.pp

@@ -370,7 +370,7 @@ begin
   if (FontName <> '') and not SameText(FontName, 'default') then
   begin
     OSError(ATSUFindFontFromName(@FontName[1], Length(FontName),
-        kFontFamilyName, kFontMacintoshPlatform, kFontRomanScript,
+        kFontFullName, kFontMacintoshPlatform, kFontRomanScript,
         kFontEnglishLanguage, Result),
       'FindCarbonFontID', 'ATSUFindFontFromName');
   end;
@@ -489,6 +489,7 @@ function CFStringToStr(AString: CFStringRef): String;
 var
   Str: Pointer;
   StrSize: CFIndex;
+  StrRange: CFRange;
 begin
   if AString = nil then
   begin
@@ -503,14 +504,16 @@ begin
   else
   begin
     // if that doesn't work this will
-    StrSize := CFStringGetLength(AString) + 1; // + 1 for null terminator
+    StrRange.location := 0;
-    GetMem(Str, StrSize);
+    StrRange.length := CFStringGetLength(AString);
-    try
+    
-      CFStringGetCString(AString, Str, StrSize, DEFAULT_CFSTRING_ENCODING);
+    CFStringGetBytes(AString, StrRange, DEFAULT_CFSTRING_ENCODING,
-      Result := PChar(Str);
+      0, False, nil, 0, StrSize);
-    finally
+    SetLength(Result, StrSize);
-      System.FreeMem(Str);
+
-    end;
+    if StrSize > 0 then
+      CFStringGetBytes(AString, StrRange, DEFAULT_CFSTRING_ENCODING,
+        0, False, @Result[1], StrSize, StrSize);
   end;
 end;
 
@@ -885,7 +888,7 @@ initialization
                   // test 'com.apple.HITextView'
   OSError(
     HIObjectRegisterSubclass(CustomControlClassID, HIViewClassID, 0,
-      CustomControlHandlerUPP, 5, @EventSpec[0], nil, nil),
+      CustomControlHandlerUPP, Length(EventSpec), @EventSpec[0], nil, nil),
     'CarbonProc.initialization', 'HIObjectRegisterSubclass');
 
 finalization

lcl/interfaces/carbon/carbonwinapi.inc

@@ -233,10 +233,25 @@ begin
   Result:=inherited CreateCaret(Handle, Bitmap, width, Height);
 end;
 
+{------------------------------------------------------------------------------
+  Method:  CreateCompatibleBitmap
+  Params:  DC     - Handle to memory device context
+           Width  - Bitmap width
+           Height - Bitmap height
+
+  Returns: Handle to a bitamp
+
+  Creates a bitamp compatible with the specified device
+ ------------------------------------------------------------------------------}
 function TCarbonWidgetSet.CreateCompatibleBitmap(DC: HDC; Width, Height: Integer
   ): HBITMAP;
 begin
-  Result:=inherited CreateCompatibleBitmap(DC, Width, Height);
+  {$IFDEF VerboseWinAPI}
+    DebugLn('TCarbonWidgetSet.CreateCompatibleBitmap');
+  {$ENDIF}
+  
+  // TODO: consider DC depth
+  Result := HBITMAP(TCarbonBitmap.Create(Width, Height, 32, 32, cbaDQWord, cbtARGB, nil));
 end;
 
 {------------------------------------------------------------------------------
@@ -252,6 +267,7 @@ begin
     DebugLn('TCarbonWidgetSet.CreateCompatibleDC');
   {$ENDIF}
   
+  // TODO: consider DC depth
   Result := HDC(TCarbonBitmapContext.Create);
 end;
 
@@ -490,7 +506,7 @@ begin
   Result := False;
 
   {$IFDEF VerboseWinAPI}
-    DebugLn('TCarbonWidgetSet.DrawFocusRect DC: ' + DbgS(DC) + ' Rect: ' + DbgS(Rect);
+    DebugLn('TCarbonWidgetSet.DrawFocusRect DC: ' + DbgS(DC) + ' Rect: ' + DbgS(Rect));
   {$ENDIF}
 
   if not CheckDC(DC, 'DrawFocusRect') then Exit;
@@ -519,7 +535,7 @@ begin
 
   {$IFDEF VerboseWinAPI}
     DebugLn('TCarbonWidgetSet.DrawFrameControl DC: ' + DbgS(DC) + ' R: ' +
-      DbgS(Rect) + ' Type: ' + DbgS(UType) + ' Style: ' + DbgS(Style);
+      DbgS(Rect) + ' Type: ' + DbgS(UType) + ' Style: ' + DbgS(UState));
   {$ENDIF}
 
   if not CheckDC(DC, 'DrawFrameControl') then Exit;
@@ -1659,9 +1675,37 @@ begin
   Result:=inherited GetWindowLong(Handle, int);
 end;
 
+{------------------------------------------------------------------------------
+  Method:  GetWindowOrgEx
+  Params:  DC - Handle of device context
+           P   - Record for context origin
+  Returns: if the function succeeds, the return value is nonzero; if the
+           function fails, the return value is zero
+
+  Retrieves the origin of the specified context
+ ------------------------------------------------------------------------------}
 function TCarbonWidgetSet.GetWindowOrgEx(dc: hdc; P: PPoint): Integer;
+var
+  Transform: CGAffineTransform;
+  SizeP: TPoint;
 begin
-  Result:=inherited GetWindowOrgEx(dc, P);
+  Result := 0;
+  
+  {$IFDEF VerboseWinAPI}
+    DebugLn('TCarbonWidgetSet.GetWindowOrgEx DC: ' + DbgS(DC));
+  {$ENDIF}
+  
+  if not CheckDC(DC, 'GetWindowOrgEx') then Exit;
+  
+  Transform := CGContextGetCTM(TCarbonContext(DC).CGContext);
+  GetDeviceSize(DC, SizeP);
+  P^.X := Round(Transform.tx);
+  P^.Y := SizeP.Y - Round(Transform.ty);
+  Result := 1;
+  
+  {$IFDEF VerboseWinAPI}
+    DebugLn('TCarbonWidgetSet.GetWindowOrgEx ' + DbgS(P^.X) + ', ' + DbgS(P^.Y));
+  {$ENDIF}
 end;
 
 {------------------------------------------------------------------------------
@@ -1864,6 +1908,9 @@ begin
     Exit;
   end;
 
+  if Rgn = 0 then
+    TCarbonWidget(Handle).Invalidate(nil)
+  else
     TCarbonWidget(Handle).InvalidateRgn(TCarbonRegion(Rgn).Shape);
   Result := True;
 end;
@@ -2759,10 +2806,31 @@ begin
   Result:=inherited SetWindowLong(Handle, Idx, NewLong);
 end;
 
+{------------------------------------------------------------------------------
+  Method:  SetWindowOrgEx
+  Params:  DC    - Handle to device context.
+           NewX, NewY - New context origin
+  Returns: If the function succeeds
+
+  Sets the origin of the specified device context
+ ------------------------------------------------------------------------------}
 function TCarbonWidgetSet.SetWindowOrgEx(DC: HDC; NewX, NewY: Integer;
   OldPoint: PPoint): Boolean;
+var
+  OldP: TPoint;
 begin
-  Result:=inherited SetWindowOrgEx(DC, NewX, NewY, OldPoint);
+  Result  := False;
+  
+  {$IFDEF VerboseWinAPI}
+    DebugLn('TCarbonWidgetSet.SetWindowOrgEx DC: ' + DbgS(DC) + ' X: ' + DbgS(NewX) +
+	  ' Y: ' + DbgS(NewY));
+  {$ENDIF}
+  
+  GetWindowOrgEx(DC, @OldP);
+  
+  Result := MoveWindowOrgEx(DC, NewX - OldP.X, NewY - OldP.Y);
+  if OldPoint <> nil then
+    OldPoint := @OldP;
 end;
 
 function TCarbonWidgetSet.SetWindowPos(hWnd: HWND; hWndInsertAfter: HWND; X, Y,