Carbon: implemented SIF_TRACKPOS in GetScrollInfo for TCarbonCustomControl.

git-svn-id: trunk@34130 -

lcl/interfaces/carbon/carbondef.pp

@@ -72,6 +72,7 @@ type
     function GetProperty(AIndex: String): Pointer;
     function GetScrollOffset: TPoint;
     procedure SetProperty(AIndex: String; const AValue: Pointer);
+    procedure SetScrollOffset(AValue: TPoint);
   protected
     procedure RegisterEvents; virtual; abstract;
     procedure CreateWidget(const AParams: TCreateParams); virtual; abstract;
@@ -144,7 +145,7 @@ type
      - processes track and draw event                  }
     property Content: ControlRef read GetContent;
     property Cursor: HCURSOR read FCursor;
-    property ScrollOffset: TPoint read GetScrollOffset; // scrolled offset of  ScrollingWinControl
+    property ScrollOffset: TPoint read GetScrollOffset write SetScrollOffset; // scrolled offset of  ScrollingWinControl
     property HasCaret: Boolean read FHasCaret write FHasCaret;
     property Painting: Boolean read GetPainting;
     property Properties[AIndex: String]: Pointer read GetProperty write SetProperty;
@@ -461,6 +462,11 @@ begin
   end;
 end;
 
+procedure TCarbonWidget.SetScrollOffset(AValue: TPoint);
+begin
+  FScrollOffset := AValue;
+end;
+
 {------------------------------------------------------------------------------
   Method:  TCarbonWidget.UpdateLCLClientRect
 

lcl/interfaces/carbon/carbonprivate.pp

@@ -1041,6 +1041,10 @@ procedure TCarbonCustomControl.GetScrollInfo(SBStyle: Integer;
   var ScrollInfo: TScrollInfo);
 const
   SName = 'GetScrollInfo';
+var
+  AImageSize, AViewSize, ALineSize: HISize;
+  AOrigin: HIPoint;
+  Pt: TPoint;
 begin
   {$IFDEF VerboseScroll}
     DebugLn('TCarbonCustomControl.GetScrollInfo ' + LCLObject.Name +
@@ -1057,7 +1061,7 @@ begin
       ScrollInfo.nMax := FScrollSize.Y - FScrollMin.Y - 1;
   end;
 
-  if (SIF_POS and ScrollInfo.fMask) > 0 then
+  if ((SIF_POS and ScrollInfo.fMask) > 0) then
   begin
     if SBStyle = SB_HORZ then
       ScrollInfo.nPos := Trunc(FScrollOrigin.X) + FScrollMin.X;
@@ -1072,6 +1076,17 @@ begin
     if SBStyle = SB_VERT then
       ScrollInfo.nPage := FScrollPageSize.Y;
   end;
+
+  if ((SIF_TRACKPOS and ScrollInfo.fMask) > 0) then
+  begin
+    GetInfo(AImageSize, AViewSize, ALineSize, AOrigin);
+    Pt := HIPointToPoint(AOrigin);
+    if SBStyle = SB_HORZ then
+      ScrollInfo.nTrackPos := Pt.X
+    else
+    if SBStyle = SB_VERT then
+      ScrollInfo.nTrackPos := Pt.Y;
+  end;
   
   {$IFDEF VerboseScroll}
     DebugLn('TCarbonCustomControl.GetScrollInfo Result: ' + DbgS(ScrollInfo));

lcl/interfaces/carbon/carbonwinapi.inc

@@ -2944,9 +2944,62 @@ end;
 function TCarbonWidgetSet.ScrollWindowEx(hWnd: HWND; dx, dy: Integer;
   prcScroll, prcClip: PRect; hrgnUpdate: HRGN; prcUpdate: PRect; flags: UINT
   ): Boolean;
+const
+  SName = 'ScrollWindowEx';
+var
+  ACtl: TCarbonControl;
+  R, R1: CGRect;
+  RR: TRect;
 begin
-  Result:=inherited ScrollWindowEx(hWnd, dx, dy, prcScroll, prcClip,
-    hrgnUpdate, prcUpdate, flags);
+  {$IFDEF VerboseWinAPI}
+  DebugLn('TCarbonWidgetSet.ScrollWindowEx() HWnd=',dbgs(hWnd),' prcScroll ',prcScroll <> nil,
+    ' prcClip ',prcClip <> nil,' flags ',flags);
+  {$ENDIF}
+  if (hWnd <> 0) then
+  begin
+    ACtl := TCarbonControl(hWnd);
+    if (flags and SW_SCROLLCHILDREN <> 0) then
+    begin
+      // complete view scrolls
+      OSError(HIViewScrollRect(ACtl.Content, HiRectPtr(@R), CGFloat(dx), CGFloat(dy)),
+        ACtl, SName, 'HIViewScrollRect');
+      with ACtl.ScrollOffset do
+      begin
+        X := X + DX;
+        Y := Y + DY;
+      end;
+      Result := True;
+    end else
+    if (Flags = 0) then
+    begin
+      if (prcScroll <> nil) then
+      begin
+        R := RectToCGRect(prcScroll^);
+        // TODO: create CGRect
+        OSError(HIViewGetBounds(ACtl.Content, R1),
+          Self, SName, 'HIViewGetBounds');
+        RR := CGRectToRect(R1);
+        OSError(HIViewScrollRect(ACtl.Content, HiRectPtr(@R), CGFloat(dx), CGFloat(dy)),
+          ACtl, SName, 'HIViewScrollRect');
+        Result := True;
+      end;
+    end;
+
+    if flags and SW_INVALIDATE <> 0 then
+    begin
+      if prcClip <> nil then
+      begin
+        prcUpdate := prcClip;
+        Result := Self.InvalidateRect(hwnd, prcClip, flags and SW_ERASE <> 0)
+      end else
+      begin
+        prcUpdate := prcScroll;
+        Result := Self.InvalidateRect(hwnd, prcScroll, flags and SW_ERASE <> 0);
+      end;
+    end;
+  end else
+    Result:=inherited ScrollWindowEx(hWnd, dx, dy, prcScroll, prcClip,
+      hrgnUpdate, prcUpdate, flags);
 end;
 
 function TCarbonWidgetSet.SelectClipRGN(DC: hDC; RGN: HRGN): Longint;