Carbon intf:

- Fixed text metrics is now rounded instead of truncated as suggested by Phil J. Hess
- GetTextExtent accepts empty strings and returns zero size
- scrolling should now partially work!!!, implemented TScrollingWinControl.ScrollBy
- force 32-bit bitmaps to allow supported context creation

git-svn-id: trunk@11928 -

lcl/interfaces/carbon/carboncanvas.pp

@@ -909,8 +909,8 @@ begin
       if (Options and ETO_OPAQUE) > 0 then
       begin
         BkBrush.Apply(Self, False); // do not use ROP2
-        CGContextFillRect(CGContext, GetCGRectSorted(X - TextBefore shr 16,
-          -Y, X + TextAfter shr 16, -Y - (Ascent + Descent) shr 16));
+        CGContextFillRect(CGContext, GetCGRectSorted(X - RoundFixed(TextBefore),
+          -Y, X + RoundFixed(TextAfter), -Y - RoundFixed(Ascent + Descent)));
       end;
     end;
 
@@ -1008,7 +1008,9 @@ const
   SName = 'GetTextExtentPoint';
 begin
   Result := False;
-  
+  Size.cx := 0;
+  Size.cy := 0;
+
   if not BeginTextRender(Str, Count, TextLayout) then Exit;
   try
     // finally compute the text dimensions
@@ -1016,8 +1018,8 @@ begin
         kATSUToTextEnd, TextBefore, TextAfter, Ascent, Descent),
       Self, SName, SGetUnjustifiedBounds) then Exit;
 
-    Size.cx := (TextAfter - TextBefore) shr 16;
-    Size.cy := (Descent + Ascent) shr 16;
+    Size.cx := RoundFixed(TextAfter - TextBefore);
+    Size.cy := RoundFixed(Descent + Ascent);
 
     Result := True;
   finally
@@ -1061,16 +1063,16 @@ begin
     EndTextRender(TextLayout);
   end;
 
-  TM.tmAscent := Ascent shr 16;
-  TM.tmDescent := Descent shr 16;
-  TM.tmHeight := (Ascent + Descent) shr 16;
+  TM.tmAscent := RoundFixed(Ascent);
+  TM.tmDescent := RoundFixed(Descent);
+  TM.tmHeight := RoundFixed(Ascent + Descent);
 
   if OSError(ATSUGetAttribute(TextStyle, kATSULeadingTag, SizeOf(M), @M, nil),
     Self, SName, SGetAttrName, 'kATSULeadingTag', kATSUNotSetErr) then Exit;
-  TM.tmInternalLeading := M shr 16;
+  TM.tmInternalLeading := RoundFixed(M);
   TM.tmExternalLeading := 0;
 
-  TM.tmAveCharWidth := (TextAfter - TextBefore) shr 16;
+  TM.tmAveCharWidth := RoundFixed(TextAfter - TextBefore);
 
   TM.tmMaxCharWidth := TM.tmAscent; // TODO: don't know how to determine this right
   TM.tmOverhang := 0;

lcl/interfaces/carbon/carbondef.pp

@@ -95,6 +95,7 @@ type
     function SetBounds(const ARect: TRect): Boolean; virtual; abstract;
     procedure SetChildZPosition(AChild: TCarbonWidget; const AOldPos, ANewPos: Integer; const AChildren: TFPList); virtual; abstract;
     
+    procedure ScrollBy(DX, DY: Integer); virtual;
     procedure SetFocus; virtual; abstract;
     procedure SetColor(const AColor: TColor); virtual; abstract;
     function SetScrollInfo(SBStyle: Integer; const ScrollInfo: TScrollInfo): Integer; virtual;
@@ -534,6 +535,24 @@ begin
   DebugLn(ClassName + '.GetScrollInfo unsupported or not implemented!');
 end;
 
+{------------------------------------------------------------------------------
+  Method:  TCarbonWidget.ScrollBy
+  Params:  DX, DY
+
+  Scrolls the content
+ ------------------------------------------------------------------------------}
+procedure TCarbonWidget.ScrollBy(DX, DY: Integer);
+var
+  R: CGRect;
+const
+  SName = 'ScrollBy';
+begin
+  OSError(HIViewGetBounds(Content, R),
+    Self, SName, 'HIViewGetBounds');
+  OSError(HIViewSetBoundsOrigin(Content, R.origin.x + DX, R.origin.y + DY),
+    Self, SName, 'HIViewSetBoundsOrigin');
+end;
+
 {------------------------------------------------------------------------------
   Method:  TCarbonWidget.SetScrollInfo
   Params:  SBStyle    - Scrollbar type (SB_VERT, SB_HORZ)

lcl/interfaces/carbon/carbonobject.inc

@@ -756,7 +756,6 @@ end;
 procedure TCarbonWidgetSet.RegisterEvents;
 var
   TmpSpec: EventTypeSpec;
-  OpenSpec: array [0..1] of EventTypeSpec;
 const
   SName = 'RegisterEvents';
 begin
@@ -773,10 +772,6 @@ begin
     1, @TmpSpec, nil, nil);
     
   FOpenEventHandlerUPP := NewAEEventHandlerUPP(AEEventHandlerProcPtr(@CarbonApp_Open));
-  //OpenSpec[0] := MakeEventSpec(kCoreEventClass, kAEOpenDocuments);
-  //OpenSpec[1] := MakeEventSpec(kCoreEventClass, kAEOpenContents);
-  //InstallApplicationEventHandler(RegisterEventHandler(@CarbonApp_Open),
-  //  2, @OpenSpec[0], nil, nil);
   OSError(
     AEInstallEventHandler(kCoreEventClass, kAEOpenDocuments, FOpenEventHandlerUPP, 0, False),
     Self, SName, 'AEInstallEventHandler');

lcl/interfaces/carbon/carbonprivate.pp

@@ -386,7 +386,7 @@ begin
     SizeOf(HISize), @ViewHISize), SName, SSetEvent, 'kEventParamViewSize');
   OSError(SetEventParameter(AEvent, kEventParamLineSize, typeHISize,
     SizeOf(HISize), @LineHISize), SName, SSetEvent, 'kEventParamLineSize');
-  OSError(SetEventParameter(AEvent, kEventParamOrigin, typeHISize,
+  OSError(SetEventParameter(AEvent, kEventParamOrigin, typeHIPoint,
     SizeOf(HIPoint), @HIOrigin), SName, SSetEvent, 'kEventParamOrigin');
   
   Result := noErr;
@@ -499,7 +499,7 @@ begin
   AOrigin := FScrollOrigin;
   AImageSize := FScrollSize;
   AViewSize := FScrollPageSize;
-  ALineSize := Classes.Point(20, 20);
+  ALineSize := Classes.Point(10, 10);
   
   {$IFDEF VerboseScroll}
     DebugLn('TCarbonCustomControl.GetInfo ' + LCLObject.Name + ' Origin: ' +

lcl/interfaces/carbon/carbonprivatecontrol.inc

@@ -445,13 +445,13 @@ begin
   // set scroll view bounds
   OSError(HIViewGetFrame(Widget, Bounds), Self, SName, 'HIViewGetFrame');
   OSError(HIViewSetFrame(Result, Bounds), Self, SName, SViewFrame);
-  
+
   OSError(HIScrollViewSetScrollBarAutoHide(Result,
       AScrollBars in [ssNone, ssAutoVertical, ssAutoHorizontal, ssAutoBoth]),
     Self, SName, SViewSetScrollBarAutoHide);
     
-  OSError(HIViewSetVisible(Widget, True), Self, SName, SViewVisible);
   OSError(HIViewAddSubview(Result, Widget), Self, SName, SViewAddView);
+  OSError(HIViewSetVisible(Widget, True), Self, SName, SViewVisible);
 end;
 
 {------------------------------------------------------------------------------

lcl/interfaces/carbon/carbonproc.pp

@@ -79,6 +79,8 @@ procedure CreateCFString(const S: String; out AString: CFStringRef);
 procedure FreeCFString(var AString: CFStringRef);
 function CFStringToStr(AString: CFStringRef): String;
 
+function RoundFixed(const F: Fixed): Integer;
+
 function GetCarbonRect(Left, Top, Width, Height: Integer): FPCMacOSAll.Rect;
 function GetCarbonRect(const ARect: TRect): FPCMacOSAll.Rect;
 function ParamsToCarbonRect(const AParams: TCreateParams): FPCMacOSAll.Rect;
@@ -367,6 +369,7 @@ function FindCarbonFontID(const FontName: String): ATSUFontID;
 begin
   Result := 0;
 
+  //DebugLn('FindCarbonFontID ' + FontName);
   if (FontName <> '') and not SameText(FontName, 'default') then
   begin
     OSError(ATSUFindFontFromName(@FontName[1], Length(FontName),
@@ -517,9 +520,19 @@ begin
   end;
 end;
 
+{------------------------------------------------------------------------------
+  Name:    RoundFixed
+  Params:  F - Fixed value
+  Returns: Rounded passed fixed value
+ ------------------------------------------------------------------------------}
+function RoundFixed(const F: Fixed): Integer;
+begin
+  Result := Round(Fix2X(F));
+end;
+
 {------------------------------------------------------------------------------
   Name:    GetCarbonRect
-  Params:  Left, Top, Width, Height - coordinates
+  Params:  Left, Top, Width, Height - Coordinates
   Returns: Carbon Rect
  ------------------------------------------------------------------------------}
 function GetCarbonRect(Left, Top, Width, Height: Integer): FPCMacOSAll.Rect;
@@ -852,11 +865,12 @@ begin
           end;
       end;
     kEventClassTextInput: Result := noErr;
+    kEventClassScrollable: Result := noErr;
   end;
 end;
 
 var
-  EventSpec: Array [0..6] of EventTypeSpec;
+  EventSpec: Array [0..8] of EventTypeSpec;
   CustomControlHandlerUPP: EventHandlerUPP;
   
 initialization
@@ -880,12 +894,16 @@ initialization
   EventSpec[5].eventKind := kEventControlGetFocusPart;
   EventSpec[6].eventClass := kEventClassControl;
   EventSpec[6].eventKind := kEventControlSetFocusPart;
+  EventSpec[7].eventClass := kEventClassScrollable;
+  EventSpec[7].eventKind := kEventScrollableGetInfo;
+  EventSpec[8].eventClass := kEventClassScrollable;
+  EventSpec[8].eventKind := kEventScrollableScrollTo;
 
   CustomControlHandlerUPP := NewEventHandlerUPP(EventHandlerProcPtr(@CustomControlHandler));
 
   CreateCFString('com.lazarus.customcontrol', CustomControlClassID);
   CreateCFString('com.apple.hiview', HIViewClassID);
-                  // test 'com.apple.HITextView'
+
   OSError(
     HIObjectRegisterSubclass(CustomControlClassID, HIViewClassID, 0,
       CustomControlHandlerUPP, Length(EventSpec), @EventSpec[0], nil, nil),

lcl/interfaces/carbon/carbonwinapi.inc

@@ -197,6 +197,9 @@ begin
     DebugLn('TCarbonWidgetSet.CreateBitmap');
   {$ENDIF}
   
+  // force 32-bit depth
+  if (BitmapBits = nil) and (BitCount = 24) then BitCount := 32;
+  
   case BitCount of
     1: bmpType := cbtMono;
     32: bmpType := cbtARGB;

lcl/interfaces/carbon/carbonwsforms.pp

@@ -48,6 +48,7 @@ type
   protected
   public
     class function  CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override;
+    class procedure ScrollBy(const AWinControl: TScrollingWinControl; const DeltaX, DeltaY: integer); override;
   end;
 
   { TCarbonWSScrollBox }
@@ -146,6 +147,20 @@ begin
   Result := TLCLIntfHandle(TCarbonScrollingWinControl.Create(AWinControl, AParams));
 end;
 
+{------------------------------------------------------------------------------
+  Method:  TCarbonWSScrollingWinControl.ScrollBy
+  Params:  AWinControl - LCL scrolling win control
+           DX, DY      -
+
+  Scrolls the content of the passed window
+ ------------------------------------------------------------------------------}
+class procedure TCarbonWSScrollingWinControl.ScrollBy(const AWinControl: TScrollingWinControl; const DeltaX, DeltaY: integer);
+begin
+  if not CheckHandle(AWinControl, Self, 'ScrollBy') then Exit;
+
+  TCarbonWidget(AWinControl.Handle).ScrollBy(DeltaX, DeltaY);
+end;
+
 { TCarbonWSCustomForm }
 
 {------------------------------------------------------------------------------