From b211e27180bf534b7cdb07df5849f82c44185504 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Sat, 22 Jul 2023 14:25:42 +0000 Subject: [PATCH] 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 | 4 + components/tvplanit/source/vpcanvasutils.pas | 221 ++++++++++++++++-- .../tvplanit/source/vpdayviewpainter.pas | 33 ++- components/tvplanit/source/vpmisc.pas | 9 + 4 files changed, 250 insertions(+), 17 deletions(-) diff --git a/components/tvplanit/source/include/vp.inc b/components/tvplanit/source/include/vp.inc index 2c06f5772..a2f15cf20 100644 --- a/components/tvplanit/source/include/vp.inc +++ b/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} + diff --git a/components/tvplanit/source/vpcanvasutils.pas b/components/tvplanit/source/vpcanvasutils.pas index fe83b66b0..361e4c3de 100644 --- a/components/tvplanit/source/vpcanvasutils.pas +++ b/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 - (CharsToRender < Length(Result)) do + while (ACanvas.TextWidth(Result) < RectWidth) and (CharsToRender < Length(Result)) do begin Inc(CharsToRender); Result := Copy(AString, 1, CharsToRender); end; - while (ACanvas.TextWidth(Result) > RectWidth) and - (CharsToRender > 0) do + while (ACanvas.TextWidth(Result) > RectWidth) and (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 @@ -1774,7 +1910,7 @@ begin Exit; while not Done do begin - if LinePos + LineHeight > RegionRect.Bottom then + if LinePos + LineHeight > RegionRect.Bottom then Break; if AString = '' then @@ -1791,9 +1927,64 @@ begin Result := Result + CharsWritten; end else Break; - HPos := WorkRect.Right + 1; - end; -end; + 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. diff --git a/components/tvplanit/source/vpdayviewpainter.pas b/components/tvplanit/source/vpdayviewpainter.pas index fd5e738c0..d912fbf03 100644 --- a/components/tvplanit/source/vpdayviewpainter.pas +++ b/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 @@ -1233,7 +1264,7 @@ begin if FDayView.DrawingStyle = dsFlat then begin RenderCanvas.Pen.Color := BevelShadow; TPSMoveTo(RenderCanvas, Angle, RenderIn, R.Right - 6, R.Bottom- 1); - TPSLineTo(RenderCanvas, Angle, RenderIn, R.Left + 3, R.Bottom - 1); + TPSLineTo(RenderCanvas, Angle, RenderIn, R.Left + 3, R.Bottom - 1); TPSMoveTo(RenderCanvas, Angle, RenderIn, R.Right - 2, R.Top + 6); TPSLineTo(RenderCanvas, Angle, RenderIn, R.Right - 2, R.Bottom - 5); end; diff --git a/components/tvplanit/source/vpmisc.pas b/components/tvplanit/source/vpmisc.pas index 4cdcd21d5..630a54f9c 100644 --- a/components/tvplanit/source/vpmisc.pas +++ b/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