carbon support for ExtSelectClipRGN, GetClipRGN, CombineRGN

git-svn-id: trunk@21129 -

lcl/interfaces/carbon/carboncanvas.pp

@@ -84,6 +84,9 @@ type
     FSavedDCList: TFPObjectList;
     FTextFractional: Boolean;
 
+    fLastClipRegion : TCarbonRegion;
+    isClipped : Boolean;
+
     procedure SetBkColor(AValue: TColor);
     procedure SetBkMode(const AValue: Integer);
     procedure SetCurrentBrush(const AValue: TCarbonBrush);
@@ -136,9 +139,13 @@ type
     function StretchDraw(X, Y, Width, Height: Integer; SrcDC: TCarbonBitmapContext;
       XSrc, YSrc, SrcWidth, SrcHeight: Integer; Msk: TCarbonBitmap; XMsk,
       YMsk: Integer; Rop: DWORD): Boolean;
+    function SetClipRegion(AClipRegion: TCarbonRegion; Mode: Integer): Integer;
+    function CopyClipRegion(ADstRegion: TCarbonRegion): Integer;
   public
     property Size: TPoint read GetSize;
 
+    property LastClipRegion: TCarbonRegion read fLastClipRegion;
+
     property CurrentFont: TCarbonFont read FCurrentFont write SetCurrentFont;
     property CurrentBrush: TCarbonBrush read FCurrentBrush write SetCurrentBrush;
     property CurrentPen: TCarbonPen read FCurrentPen write SetCurrentPen;
@@ -397,6 +404,7 @@ end;
  ------------------------------------------------------------------------------}
 constructor TCarbonDeviceContext.Create;
 begin
+  inherited Create;
   FBkBrush := TCarbonBrush.Create(False);
   FTextBrush := TCarbonBrush.Create(False);
   
@@ -1453,6 +1461,35 @@ begin
   //  X, Y]));
 end;
 
+function TCarbonDeviceContext.SetClipRegion(AClipRegion: TCarbonRegion; Mode: Integer): Integer;
+begin
+  if isClipped  then
+  begin
+    isClipped := false;
+    CGContextRestoreGState(CGContext);
+  end;
+  fLastClipRegion := AClipRegion;
+
+  if not Assigned(AClipRegion) then
+  begin
+    HIShapeSetEmpty(FClipRegion.Shape);
+    Result := LCLType.NullRegion;
+  end
+  else
+  begin
+    CGContextSaveGState(CGContext);
+    FClipRegion.CombineWith(AClipRegion, Mode);
+    FClipRegion.Apply(Self);
+    isClipped := true;
+    Result := LCLType.ComplexRegion;
+  end;
+end;
+
+function TCarbonDeviceContext.CopyClipRegion(ADstRegion: TCarbonRegion): Integer;
+begin
+  Result := ADstRegion.CombineWith(FClipRegion, RGN_COPY);
+end;
+
 { TCarbonScreenContext }
 
 {------------------------------------------------------------------------------
@@ -1473,7 +1510,6 @@ end;
 constructor TCarbonScreenContext.Create;
 begin
   inherited Create;
-
   Reset;
 end;
 

lcl/interfaces/carbon/carbondef.pp

@@ -54,8 +54,6 @@ type
   TCarbonContext = class
   public
     CGContext : CGContextRef;
-    isClipped : Boolean;
-    constructor Create;
     procedure Reset; virtual; abstract;
   end;
 
@@ -353,16 +351,7 @@ begin
 
   Result := Node.UPP;
 end;
-  
-{ TCarbonContext }
 
-constructor TCarbonContext.Create;
-begin
-  inherited;
-
-  CGContext := nil;
-end;
-  
 { TCarbonWidget }
 
 {------------------------------------------------------------------------------

lcl/interfaces/carbon/carbongdiobjects.pp

@@ -72,8 +72,10 @@ type
     function GetBounds: TRect;
     function GetType: Integer;
     function ContainsPoint(const P: TPoint): Boolean;
+    procedure SetShape(AShape: HIShapeRef);
+    function CombineWith(ARegion: TCarbonRegion; CombineMode: Integer): Integer;
   public
-    property Shape: HIShapeRef read FShape;
+    property Shape: HIShapeRef read FShape write SetShape;
   end;
   
   TCarbonFont = class;
@@ -739,10 +741,8 @@ 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;
-
   CGContextClip(ADC.CGContext);
 end;
 
@@ -786,6 +786,39 @@ begin
   Result := HIShapeContainsPoint(FShape, PointToHIPoint(P));
 end;
 
+procedure TCarbonRegion.SetShape(AShape: HIShapeRef);
+begin
+  if Assigned(FShape) then CFRelease(FShape);
+  FShape := AShape;
+end;
+
+function TCarbonRegion.CombineWith(ARegion: TCarbonRegion; CombineMode: Integer): Integer;
+var
+  sh1, sh2: HIShapeRef;
+begin
+  if not Assigned(ARegion) then
+    Result := LCLType.Error
+  else
+  begin
+    Result := LCLType.ComplexRegion;
+    case CombineMode of
+      RGN_AND: Shape:=HIShapeCreateIntersection(FShape, ARegion.Shape);
+      RGN_XOR:
+      begin
+        sh1 := HIShapeCreateUnion(FShape, ARegion.Shape);
+        sh2 := HIShapeCreateIntersection(FShape, ARegion.Shape);
+        Shape  := HIShapeCreateDifference(sh1, sh2);
+        CFRelease(sh1); CFRelease(sh2);
+      end;
+      RGN_OR:   Shape:=HIShapeCreateUnion(FShape, ARegion.Shape);
+      RGN_DIFF: Shape:=HIShapeCreateDifference(FShape, ARegion.Shape);
+      RGN_COPY: Shape:=HIShapeCreateCopy(ARegion.Shape);
+    else
+      Result := LCLType.Error;
+    end;
+  end;
+end;
+
 { TCarbonTextLayout }
 
 procedure TCarbonTextLayout.Release;

lcl/interfaces/carbon/carbonwinapi.inc

@@ -212,9 +212,19 @@ end;
 
 function TCarbonWidgetSet.CombineRgn(Dest, Src1, Src2: HRGN;
   fnCombineMode: Longint): Longint;
+var
+  rd, r1, r2 : TCarbonRegion;
+  sh         : HIShapeRef;
+  sh1, sh2   :  HIShapeRef;
 begin
-  DebugLn('TCarbonWidgetSet.CombineRgn TODO');
-  Result:=inherited CombineRgn(Dest, Src1, Src2, fnCombineMode);
+  Result := LCLType.Error;
+  if (Dest = 0) or (Src1 = 0) or (fnCombineMode<RGN_AND) or (fnCombineMode>RGN_COPY) then Exit;
+  if (fnCombineMode <> RGN_COPY) and (Src2 = 0) then Exit;
+
+  TCarbonRegion(Dest).CombineWith(TCarbonRegion(Src1), RGN_COPY);
+
+  if fnCombineMode <> RGN_COPY then
+    TCarbonRegion(Dest). CombineWith(TCarbonRegion(Src2), fnCombineMode);
 end;
 
 {------------------------------------------------------------------------------
@@ -952,11 +962,18 @@ begin
   {$ENDIF}
 end;
 
-function TCarbonWidgetSet.ExtSelectClipRGN(dc: hdc; rgn: hrgn; Mode: Longint
-  ): Integer;
+function TCarbonWidgetSet.ExtSelectClipRGN(dc: hdc; rgn: hrgn; Mode: Longint): Integer;
+const
+  SName = 'TCarbonWidgetSet.ExtSelectClipRGN';
 begin
-  DebugLn('TCarbonWidgetSet.ExtSelectClipRGN TODO');
-  Result:=inherited ExtSelectClipRGN(dc, rgn, Mode);
+  {$IFDEF VerboseWinAPI}
+    DebugLn('TCarbonWidgetSet.ExtSelectClipRGN DC: ' + DbgS(DC) + ' RGN: ' +
+      DbgS(RGN));
+  {$ENDIF}
+  Result := LCLType.Error;
+  if (DC = 0) then Exit;
+  if not CheckDC(DC, SName) then Exit;
+  Result := TCarbonDeviceContext(DC).SetClipRegion(TCarbonRegion(RGN), Mode);
 end;
 
 {------------------------------------------------------------------------------
@@ -1247,8 +1264,13 @@ end;
 
 function TCarbonWidgetSet.GetClipRGN(DC: hDC; RGN: hRGN): Longint;
 begin
-  DebugLn('TCarbonWidgetSet.GetClipRGN TODO');
-  Result:=inherited GetClipRGN(DC, RGN);
+  {$IFDEF VerboseWinAPI}
+    DebugLn('TCarbonWidgetSet.GetClipRGN DC: ' + DbgS(DC));
+  {$ENDIF}
+  Result := LCLType.Error;
+  if RGN = 0 then Exit;
+  if not CheckDC(DC, 'GetClipRGN') then Exit;
+  Result := TCarbonDeviceContext(DC).CopyClipRegion(TCarbonRegion(RGN));
 end;
 
 function TCarbonWidgetSet.GetCmdLineParamDescForInterface: string;
@@ -2829,28 +2851,15 @@ begin
 end;
 
 function TCarbonWidgetSet.SelectClipRGN(DC: hDC; RGN: HRGN): Longint;
-var
-  ctx : TCarbonContext;
+const
+  SName = 'TCarbonWidgetSet.SelectClipRGN';
 begin
-  Result := 0;
-  if (DC = 0) then Exit;
+  {$IFDEF VerboseWinAPI}
+    DebugLn('TCarbonWidgetSet.SelectClipRGN DC: ' + DbgS(DC) + ' RGN: ' +
+      DbgS(RGN));
+  {$ENDIF}
 
-  ctx := TCarbonContext(DC);
-
-  if ctx.isClipped and Assigned(TCarbonContext(DC).CGContext) then
-  begin
-    ctx.isClipped := false;
-    CGContextRestoreGState(ctx.CGContext);
-  end;
-
-  if RGN <> 0 then
-  begin
-    if Assigned(ctx.CGContext) then CGContextSaveGState(ctx.CGContext);
-    TCarbonRegion(RGN).Apply( ctx );
-    ctx.isClipped := true;
-  end;
-
-  Result := 0;
+  Result := ExtSelectClipRGN(DC, RGN, RGN_COPY)
 end;
 
 {------------------------------------------------------------------------------