pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

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

Browse Source 
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
Download Patch File Download Diff File Expand all files Collapse all files

4
components/tvplanit/source/include/vp.inc
View File

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

221
components/tvplanit/source/vpcanvasutils.pas
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.

33
components/tvplanit/source/vpdayviewpainter.pas
View File

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

9
components/tvplanit/source/vpmisc.pas
View File

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