TvPlanIt: Use array of rectangle, rather than combined regions, to draw event text wrapped around event icons. (Supposed to fix rendering issue in cocoa).

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8893 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/tvplanit/source/include/vp.inc

@@ -123,3 +123,7 @@
 { This defines whether the new icons will be linked into the package. }
 {$DEFINE NEW_ICONS}
 
+{ This define activate supports of regions for word-wrapped texts.
+  Not supported by Lazarus for cocoa widgetset. }
+{.$DEFINE REGION_SUPPORT}
+

components/tvplanit/source/vpcanvasutils.pas

@@ -93,8 +93,6 @@ uses
 type
   TVpPaletteArray = array[0..255] of TPALETTEENTRY;
 
-  { !!.01 Begin changes !!.01 }
-
   TVpExCanvas = class(TObject)
     private                                                              
       FAngle: TVpRotationAngle;
@@ -175,15 +173,29 @@ type
       FViewPort: TRect;
 
     protected
-      function FindEndingPos(ARegion: HRGN; LineSize, HPos, YPos: Integer): TPoint;
+      {$IFDEF REGION_SUPPORT}
+      function FindEndingPos(ARegion: HRGN;
+        LineSize, HPos, YPos: Integer): TPoint;
       function FindNextStartingPoint(ARegion: HRGN; LineSize: Integer;
-        var HPos, YPos: Integer): Boolean;
+        var HPos, YPos: Integer): Boolean; overload;
+      function GetNextRectangle(ARegion: HRGN; LineSize, AvgCharSize: Integer;
+        var HPos: Integer; var LinePos: Integer): TRect; overload;
+      {$ELSE}
+      function FindEndingPos(const ARects: Array of TRect;
+        LineSize, HPos, YPos: Integer): TPoint;
+      function FindNextStartingPoint(const ARects: Array of TRect;
+        LineSize: Integer;  var HPos, YPos: Integer): Boolean; overload;
+      function GetNextRectangle(const ARects: Array of TRect; LineSize, AvgCharSize: Integer;
+        var HPos: Integer; var LinePos: Integer): TRect; overload;
+      function GetUnionBox(const ARects: Array of TRect): TRect;
+      function PtInRects(const ARects: Array of TRect; X, Y: Integer): Boolean;
+      {$ENDIF}
+
       function FindWordBreaks(AString: string; CharPos: Integer): Integer;
       function FitStringInRect(ACanvas: TCanvas; RectWidth, AvgCharSize: Integer;
         var AString: string; var CharsOut: Integer): string;
       function GetAverageCharSize(ACanvas: TCanvas): Integer;
-      function GetNextRectangle(ARegion: HRGN; LineSize, AvgCharSize: Integer;
+
-        var HPos: Integer; var LinePos: Integer): TRect;
       function IsWordBreak(AString: string; CharPos: Integer): Boolean;
       function NextChar(AString: string; CharPos: Integer): Char;
       function PrevChar(AString: string; CharPos: Integer): Char;
@@ -193,8 +205,13 @@ type
       constructor Create;                                                
       function RenderTextToCanvas(ACanvas: TCanvas; ARect: TRect;
         AString: string): Integer;
+      {$IFDEF REGION_SUPPORT}
       function RenderTextToCanvasRegion(ACanvas: TCanvas; ARegion: HRGN;
         AString: string): Integer;
+      {$ELSE}
+      function RenderTextToCanvasRects(ACanvas: TCanvas; const ARects: Array of TRect;
+        AString: String): Integer;
+      {$ENDIF}
 
       property MinChars: Integer read FMinChars write FMinChars default 5;
       property TextMargin: Integer read FTextMargin write FTextMargin default 3;
@@ -320,8 +337,13 @@ procedure TPSSetBmpPixel(ABitmap: TBitmap; PaletteCache: TVpPaletteArray;
 function RenderTextToRect(ACanvas: TCanvas; const Angle: TVpRotationAngle;
   const Viewport: TRect; ARect: TRect; AString: string): Integer;
 
+{$IFDEF REGION_SUPPORT}
 function RenderTextToRegion(ACanvas: TCanvas; const Angle: TVpRotationAngle;
   const Viewport: TRect; ARegion: HRGN; AString: string): Integer;
+{$ELSE}
+function RenderTextToRects(ACanvas: TCanvas; const Angle: TVpRotationAngle;
+  const Viewport: TRect; const ARects: array of TRect; AString: string): Integer;
+{$ENDIF}
 
 {$IFDEF FPC}
 procedure RotateBitmap(ABitmap: TBitmap; Angle: TVpRotationAngle);
@@ -649,6 +671,7 @@ begin
   Result := VpTextRenderer.RenderTextToCanvas(ACanvas, ARect, AString);
 end;
 
+{$IFDEF REGION_SUPPORT}
 function RenderTextToRegion(ACanvas: TCanvas; const Angle: TVpRotationAngle;
   const Viewport: TRect; ARegion: HRGN; AString: string): Integer;
 begin
@@ -656,6 +679,15 @@ begin
   VpTextRenderer.Viewport := Viewport;
   Result := VpTextRenderer.RenderTextToCanvasRegion(ACanvas, ARegion, AString);
 end;
+{$ELSE}
+function RenderTextToRects(ACanvas: TCanvas; const Angle: TVpRotationAngle;
+  const Viewport: TRect; const ARects: array of TRect; AString: string): Integer;
+begin
+  VpTextRenderer.Angle := Angle;
+  VpTextRenderer.Viewport := Viewport;
+  Result := VpTextRenderer.RenderTextToCanvasRects(ACanvas, ARects, AString);
+end;
+{$ENDIF}
 
 
 { TVpExCanvas *************************************************************** }
@@ -1462,6 +1494,7 @@ begin
   FViewPort := Rect(0, 0, 0, 0);
 end;
 
+{$IFDEF REGION_SUPPORT}
 function TVpLineWrapper.FindEndingPos(ARegion: HRGN;
   LineSize, HPos, YPos: Integer): TPoint;
 var                                                                      
@@ -1476,7 +1509,23 @@ begin
   do
     Inc(Result.x);
 end;
+{$ELSE}
+function TVpLineWrapper.FindEndingPos(const ARects: Array of TRect;
+  LineSize, HPos, YPos: Integer): TPoint;
+var
+  WorkRect: TRect;
+begin
+  WorkRect := GetUnionBox(ARects);
+  Result := Point(HPos, YPos);
+  while PtInRects(ARects, Result.X, Result.Y) and
+        PtInRects(ARects, Result.X, Result.Y + LineSize) and
+        (Result.X < WorkRect.Right)
+  do
+    inc(Result.X);
+end;
+{$ENDIF}
 
+{$IFDEF REGION_SUPPORT}
 function TVpLineWrapper.FindNextStartingPoint(ARegion: HRGN; LineSize: Integer;
   var HPos, YPos: Integer): Boolean;
 var                                                                      
@@ -1509,6 +1558,40 @@ begin
     end;                                                                 
   end;
 end;
+{$ELSE}
+function TVpLineWrapper.FindNextStartingPoint(const ARects: Array of TRect;
+  LineSize: Integer; var HPos, YPos: Integer): Boolean;
+var
+  WorkRect: TRect;
+  Done: Boolean;
+begin
+  Result := False;
+  Done := False;
+  WorkRect := GetUnionBox(ARects);
+  while not Done do begin
+    if HPos > WorkRect.Right then begin
+      HPos := WorkRect.Left;
+      Inc(YPos, LineSize);
+      if YPos > WorkRect.Bottom then
+        Break;
+    end;
+    if (not PtInRects(ARects, HPos, YPos)) or
+       (not PtInRects(ARects, HPos, YPos + LineSize)) then
+    begin
+      Inc(HPos);
+      if HPos > WorkRect.Right then begin
+        HPos := WorkRect.Left;
+        Inc(YPos, LineSize);
+        if YPos > WorkRect.Bottom then
+          Break;
+      end;
+    end else begin
+      Result := True;
+      Break;
+    end;
+  end;
+end;
+{$ENDIF}
 
 function TVpLineWrapper.FindWordBreaks(AString: string;
   CharPos: Integer): Integer;
@@ -1544,14 +1627,12 @@ begin
 
     if CharsToRender > 0 then begin                                      
       Result := Copy(AString, 1, CharsToRender);
-      while (ACanvas.TextWidth(Result) < RectWidth) and
+      while (ACanvas.TextWidth(Result) < RectWidth) and (CharsToRender < Length(Result)) do
-            (CharsToRender < Length(Result)) do
       begin
         Inc(CharsToRender);
         Result := Copy(AString, 1, CharsToRender);
       end;                                                               
-      while (ACanvas.TextWidth(Result) > RectWidth) and
+      while (ACanvas.TextWidth(Result) > RectWidth) and (CharsToRender > 0) do
-            (CharsToRender > 0) do
       begin
         Dec(CharsToRender);
         Result := Copy(AString, 1, CharsToRender);
@@ -1633,6 +1714,7 @@ begin
   {$ENDIF}
 end;                                                                     
 
+{$IFDEF REGION_SUPPORT}
 function TVpLineWrapper.GetNextRectangle(ARegion: HRGN;
   LineSize, AvgCharSize: Integer; var HPos, LinePos: Integer): TRect;
 var                                                                      
@@ -1652,6 +1734,43 @@ begin
     end else                                                             
       Break;                                                             
 end;                                                                     
+{$ELSE}
+function TVpLineWrapper.GetNextRectangle(const ARects: Array of TRect;
+  LineSize, AvgCharSize: Integer; var HPos, LinePos: Integer): TRect;
+var
+  EndPoint: TPoint;
+  Done: Boolean;
+begin
+  Result := Rect(0, 0, 0, 0);
+  Done := False;
+  while not Done do
+    if FindNextStartingPoint(ARects, LineSize, HPos, LinePos) then begin
+      EndPoint := FindEndingPos(ARects, LineSize, HPos, LinePos);
+      if EndPoint.x - HPos > FMinChars * AvgCharSize then begin
+        Result := Rect(HPos, LinePos, EndPoint.x, EndPoint.y);
+        Break;
+      end else
+        Inc(HPos);
+    end else
+      Break;
+end;
+{$ENDIF}
+
+{$IFNDEF REGION_SUPPORT}
+function TVpLineWrapper.GetUnionBox(const ARects: Array of TRect): TRect;
+var
+  i: Integer;
+begin
+  Result := ARects[0];
+  for i := Low(ARects) + 1 to High(ARects) do
+  begin
+    if ARects[i].Left <= Result.Left then Result.Left := ARects[i].Left;
+    if ARects[i].Top <= Result.Top then Result.Top := ARects[i].Top;
+    if ARects[i].Right >= Result.Right then Result.Right := ARects[i].Right;
+    if ARects[i].Bottom >= Result.Bottom then Result.Bottom := ARects[i].Bottom;
+  end;
+end;
+{$ENDIF}
 
 function TVpLineWrapper.IsWordBreak(AString: string; CharPos: Integer): Boolean;
 var                                                                      
@@ -1692,6 +1811,22 @@ begin
     Result := #0;                                                        
 end;                                                                     
 
+{$IFNDEF REGION_SUPPORT}
+function TVpLineWrapper.PtInRects(const ARects: Array of TRect;
+  X, Y: Integer): Boolean;
+var
+  i: Integer;
+  P: TPoint;
+begin
+  Result := true;
+  P := Point(X, Y);
+  for i := Low(ARects) to High(ARects) do
+    if PtInRect(ARects[i], P) then
+      exit;
+  Result := false;
+end;
+{$ENDIF}
+
 function TVpLineWrapper.RenderTextToCanvas(ACanvas: TCanvas; ARect: TRect;
   AString: string): Integer;
 var
@@ -1741,6 +1876,7 @@ begin
   end;
 end;
 
+{$IFDEF REGION_SUPPORT}
 function TVpLineWrapper.RenderTextToCanvasRegion(ACanvas: TCanvas;
   ARegion: HRGN; AString: string): Integer;
 var
@@ -1794,6 +1930,61 @@ begin
     HPos := WorkRect.Right + 1;
   end;
 end;
+{$ELSE}
+function TVpLineWrapper.RenderTextToCanvasRects(ACanvas: TCanvas;
+  const ARects: array of TRect; AString: String): Integer;
+var
+  LineHeight: Integer;
+  RectHeight: Integer;
+  LinePos: Integer;
+  AvgCharSize: Integer;
+  HPos: Integer;
+  CharsWritten: Integer;
+  Done: Boolean;
+  UnionRect: TRect;
+  WorkRect: TRect;
+begin
+  Result := 0;
+  CharsWritten := 0;
+
+  SetTVpExCanvasAVC(ACanvas, Angle, ViewPort);
+  UnionRect := GetUnionBox(ARects);
+
+  LineHeight := ACanvas.TextHeight('yY0');
+  if Angle = ra0 then
+    RectHeight := HeightOf(UnionRect)
+  else
+    RectHeight := VpRotatedCanvas.ViewportHeight;
+  LinePos := UnionRect.Top + FTextMargin;
+  HPos := UnionRect.Left + FTextMargin;
+  AvgCharSize := GetAverageCharSize(ACanvas);
+  Done := false;
+
+  if LineHeight > RectHeight then
+    exit;
+
+  while not Done do
+  begin
+    if (LinePos + LineHeight > UnionRect.Bottom) or (AString = '') then
+      Break;
+
+    WorkRect := GetNextRectangle(ARects, LineHeight, AvgCharSize, HPos, LinePos);
+    if IsZeroRect(WorkRect) then
+      break;
+    if WidthOf(WorkRect) > 0 then
+    begin
+      VpRotatedCanvas.TextOut(
+        WorkRect.Left + FTextMargin,
+        WorkRect.Top,
+        FitStringInRect(ACanvas, WidthOf(WorkRect) - FTextMargin, AvgCharSize, AString, CharsWritten)
+      );
+      Result := Result + CharsWritten;
+    end else
+      Break;
+    HPos := WorkRect.Right + 1;
+  end;
+end;
+{$ENDIF}
 
 function TVpLineWrapper.ThisChar(AString: string; CharPos: Integer): Char;
 begin                                                                    
@@ -1868,6 +2059,4 @@ finalization
   VpRotatedCanvas.Free;
   VpTextRenderer.Free;                              
 
-{ !!.01 End changes !!.01 }
-
 end.

components/tvplanit/source/vpdayviewpainter.pas

@@ -1091,9 +1091,13 @@ end;
 procedure TVpDayViewPainter.DrawEventText(const AText: String;
   const AEventRect, AIconRect: TRect; ALevel: Integer);
 var
+  {$IFDEF REGION_SUPPORT}
   WorkRegion1: HRGN = 0;
   WorkRegion2: HRGN = 0;
   TextRegion: HRGN = 0;
+  {$ELSE}
+  TextRects: array of TRect = nil;
+  {$ENDIF}
   CW: Integer;
 begin
   if (FDayView.WrapStyle <> wsNone) then begin
@@ -1101,17 +1105,42 @@ begin
     then begin
       if FDayView.WrapStyle = wsIconFlow then
       begin
+        {$IFDEF REGION_SUPPORT}
         WorkRegion1 := CreateRectRgn(AIconRect.Right, AEventRect.Top, AEventRect.Right, AIconRect.Bottom);
         WorkRegion2 := CreateRectRgn(AEventRect.Left + FScaledGutterWidth, AIconRect.Bottom, AEventRect.Right, AEventRect.Bottom);
         TextRegion := CreateRectRgn(AIconRect.Right, AEventRect.Top, AEventRect.Right, AIconRect.Bottom);
         CombineRgn(TextRegion, WorkRegion1, WorkRegion2, RGN_OR);
+        {$ELSE}
+        SetLength(TextRects, 2);
+        TextRects[0] := Rect(AIconRect.Right, AEventRect.Top, AEventRect.Right, AIconRect.Bottom);
+        TextRects[1] := Rect(AEventRect.Left + FScaledGutterWidth, AIconRect.Bottom, AEventRect.Right, AEventRect.Bottom);
+        {$ENDIF}
       end else
+      begin
+        {$IFDEF REGION_SUPPORT}
         TextRegion := CreateRectRgn(AIconRect.Right, AEventRect.Top, AEventRect.Right, AEventRect.Bottom);
+        {$ELSE}
+        SetLength(TextRects, 1);
+        TextRects[0] := Rect(AIconRect.Right, AEventRect.Top, AEventRect.Right, AEventRect.Bottom);
+        {$ENDIF}
+      end;
     end else
+    begin
+      {$IFDEF REGION_SUPPORT}
       TextRegion := CreateRectRgn(AIconRect.Right + FScaledGutterWidth, AEventRect.Top, AEventRect.Right, AEventRect.Bottom);
+      {$ELSE}
+      SetLength(TextRects, 1);
+      TextRects[0] := Rect(AIconRect.Right + FScaledGutterWidth, AEventRect.Top, AEventRect.Right, AEventRect.Bottom);
+      {$ENDIF}
+    end;
 
+    {$IFDEF REGION_SUPPORT}
     try
       CW := RenderTextToRegion(RenderCanvas, Angle, RenderIn, TextRegion, AText);
+    {$ELSE}
+      CW := RenderTextToRects(RenderCanvas, Angle, RenderIn, TextRects, AText);
+    {$ENDIF}
+
       { write the event string to the proper spot in the EventRect }
       if CW < Length(AText) then begin
         RenderCanvas.Brush.Color := FDayView.DotDotDotColor;
@@ -1124,11 +1153,13 @@ begin
         TPSFillRect(RenderCanvas, Angle, RenderIn,
           Rect(AEventRect.Right - 6, AEventRect.Bottom - 7, AEventRect.Right - 3, AEventRect.Bottom - 4));
       end;
+    {$IFDEF REGION_SUPPORT}
     finally
       if WorkRegion1 <> 0 then DeleteObject(WorkRegion1);
       if WorkRegion2 <> 0 then DeleteObject(WorkRegion2);
       if TextRegion <> 0 then DeleteObject(TextRegion);
     end;
+    {$ENDIF}
   end
   else begin
   if ALevel = 0 then

components/tvplanit/source/vpmisc.pas

@@ -103,6 +103,9 @@ function RightOf(AControl: TControl): Integer;
 function BottomOf(AControl: TControl): Integer;
   {- returns the bottom edge of a control }
 
+function IsZeroRect(const R: TRect): Boolean;
+  { - returns true of all sides of the rectangle are zero }
+
 function MoveRect(const ARect: TRect; const ADelta: TPoint): TRect;
   { - moves ARect by dx in ADelta.x and dy in ADelta.y direction }
 
@@ -1069,6 +1072,12 @@ begin
   Result := AControl.Top + AControl.Height;
 end;
 
+{ Returns true if all corner coordinates of the rectangle are zero. }
+function IsZeroRect(const R: TRect): Boolean;
+begin
+  Result := (R.Left = 0) and (R.Top = 0) and (R.Right = 0) and (R.Bottom = 0);
+end;
+
 { Moves a rectangle ARect by ADelta.x in x, and by ADelta.y in y direction }
 function MoveRect(const ARect: TRect; const ADelta: TPoint): TRect;
 begin