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
This commit is contained in:
wp_xxyyzz
2023-07-22 14:25:42 +00:00
parent a6b4323add
commit b211e27180
4 changed files with 250 additions and 17 deletions

View File

@@ -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.