LazMapViewer: Improved output of rotated text. DrawingEngine.TextExtent now can return both unrotated and rotated text extents.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@9709 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz 2025-03-30 22:01:32 +00:00
parent c5dd3f0862
commit 3a4e228b66
5 changed files with 99 additions and 19 deletions

View File

@ -13,7 +13,7 @@
unit mvDE_BGRA;
{$mode objfpc}{$H+}
{$WARN 6058 off : Call to subroutine "$1" marked as inline is not inlined}
interface
uses
@ -93,7 +93,7 @@ type
procedure PaintToCanvas(ACanvas: TCanvas; Origin: TPoint); override;
procedure Rectangle(X1, Y1, X2, Y2: Integer); override;
function SaveToImage(AClass: TRasterImageClass): TRasterImage; override;
function TextExtent(const AText: String): TSize; override;
function TextExtent(const AText: String; ARotated: Boolean = false): TSize; override;
procedure TextOut(X, Y: Integer; const AText: String); override;
function GetCacheItemClass: TPictureCacheItemClass; override;
end;
@ -113,6 +113,13 @@ begin
RegisterComponents(PALETTE_PAGE, [TMvBGRADrawingEngine]);
end;
function RotatePointF(P: TPointF; sinPhi, cosPhi: Double): TPointF;
begin
Result.X := cosPhi * P.X + sinPhi * P.Y;
Result.Y := -sinPhi * P.X + cosPhi * P.Y;
end;
{ TBGRABitmapCacheItem }
function TBGRABitmapCacheItem.GetImageObject: TObject;
@ -415,12 +422,75 @@ begin
FBuffer.CanvasBGRA.Font.Antialiasing := true;
end;
function TMvBGRADrawingEngine.TextExtent(const AText: String): TSize;
function TMvBGRADrawingEngine.TextExtent(const AText: String;
ARotated: Boolean = false): TSize;
var
s, c: Double;
pts: Array[0..3] of TPointF;
begin
ApplyFont;
Result := FBuffer.CanvasBGRA.TextExtent(AText);
if (FFontOrientation <> 0) and ARotated then
begin
SinCos(FFontOrientation * pi / 1800, s, c);
pts[0] := PointF(0, 0);
pts[1] := RotatePointF(PointF(Result.CX, 0), s, c);
pts[2] := RotatePointF(PointF(Result.CX, Result.CY), s, c);
pts[3] := RotatePointF(PointF(0, Result.CY), s, c);
Result.CX := round(
MaxValue([pts[0].X, pts[1].X, pts[2].X, pts[3].X]) -
MinValue([pts[0].X, pts[1].X, pts[2].X, pts[3].X])
);
Result.CY := round(
MaxValue([pts[0].Y, pts[1].Y, pts[2].Y, pts[3].Y]) -
MinValue([pts[0].Y, pts[1].Y, pts[2].Y, pts[3].Y])
);
end;
end;
procedure TMvBGRADrawingEngine.TextOut(X, Y: Integer; const AText: String);
var
ext: TSize;
dx, dy: Single;
ctr: TPointF;
R: TRectF;
Pts: Array[0..3] of TPointF;
s, c: Double;
begin
if (AText <> '') then
begin
ApplyFont;
if FFontOrientation = 0 then
begin
FBuffer.FontVerticalAnchor := fvaTop;
FBuffer.CanvasBGRA.TextOut(X, Y, AText);
end else
begin
ext := FBuffer.CanvasBGRA.TextExtent(AText);
dx := ext.CX/2;
dy := ext.CY/2;
SinCos(FFontOrientation * pi / 1800, s, c);
Pts[0] := RotatePointF(PointF(-dx, -dy), s, c);
Pts[1] := RotatePointF(PointF(+dx, -dy), s, c);
Pts[2] := RotatePointF(PointF(+dx, +dy), s, c);
Pts[3] := RotatePointF(PointF(-dx, +dy), s, c);
R := RectF(
MinValue([Pts[0].X, Pts[1].X, Pts[2].X, Pts[3].X]),
MinValue([Pts[0].Y, Pts[1].Y, Pts[2].Y, Pts[3].Y]),
MaxValue([Pts[0].X, Pts[1].X, Pts[2].X, Pts[3].X]),
MaxValue([Pts[0].Y, Pts[1].Y, Pts[2].Y, Pts[3].Y])
);
dx := R.Width/2;
dy := R.Height/2;
ctr := PointF(X + dx, Y + dy);
FBuffer.CanvasBGRA.PolygonF([Pts[0] + ctr, Pts[1] + ctr, Pts[2] + ctr, Pts[3] + ctr], False, True);
FBuffer.FontVerticalAnchor := fvaXCenter;
FBuffer.TextOut(ctr.X, ctr.Y, AText, FontColor, taCenter);
end;
end;
end;
{
procedure TMvBGRADrawingEngine.TextOut(X, Y: Integer; const AText: String);
begin
if (AText <> '') then
@ -429,7 +499,7 @@ begin
FBuffer.CanvasBGRA.TextOut(X, Y, AText);
end;
end;
}
function TMvBGRADrawingEngine.GetCacheItemClass: TPictureCacheItemClass;
begin
Result := TBGRABitmapCacheItem;

View File

@ -105,7 +105,7 @@ type
procedure PaintToCanvas(ACanvas: TCanvas; Origin: TPoint); override;
procedure Rectangle(X1, Y1, X2, Y2: Integer); override;
function SaveToImage(AClass: TRasterImageClass): TRasterImage; override;
function TextExtent(const AText: String): TSize; override;
function TextExtent(const AText: String; ARotated: Boolean = false): TSize; override;
procedure TextOut(X, Y: Integer; const AText: String); override;
function GetCacheItemClass: TPictureCacheItemClass; override;
end;
@ -710,7 +710,8 @@ begin
Opacity := 1.0;
end;
function TMvRGBGraphicsDrawingEngine.TextExtent(const AText: String): TSize;
function TMvRGBGraphicsDrawingEngine.TextExtent(const AText: String;
ARotated: Boolean = false): TSize;
var
bmp: TBitmap;
pts: TPointArray;
@ -721,7 +722,10 @@ begin
bmp.Canvas.Font.Size := FFontSize;
bmp.Canvas.Font.Style := FFontStyle;
bmp.Canvas.Font.Orientation := FFontOrientation;
Result := MeasureTextSize(bmp.Canvas, AText, pts);
if (FFontOrientation = 0) or not ARotated then
Result := bmp.Canvas.TextExtent(AText)
else
Result := MeasureTextSize(bmp.Canvas, AText, pts);
finally
bmp.Free;
end;

View File

@ -96,7 +96,7 @@ type
procedure PaintToCanvas(ACanvas: TCanvas; Origin: TPoint); override;
procedure Rectangle(X1, Y1, X2, Y2: Integer); override;
function SaveToImage(AClass: TRasterImageClass): TRasterImage; override;
function TextExtent(const AText: String): TSize; override;
function TextExtent(const AText: String; ARotated: Boolean = false): TSize; override;
procedure TextOut(X, Y: Integer; const AText: String); override;
function GetCacheItemClass: TPictureCacheItemClass; override;
end;
@ -746,11 +746,13 @@ begin
end;
{ Returns the size of the given text.
NOTE: Text rotation is taken into account. }
function TMvIntfGraphicsDrawingEngine.TextExtent(const AText: String): TSize;
NOTE: Text rotation is taken into account if the Rotated argument is true. }
function TMvIntfGraphicsDrawingEngine.TextExtent(const AText: String;
ARotated: Boolean = false): TSize;
var
bmp: TBitmap;
pts: TPointArray;
R: TRect;
begin
bmp := TBitmap.Create;
try
@ -758,7 +760,13 @@ begin
bmp.Canvas.Font.Size := FFontSize;
bmp.Canvas.Font.Style := FFontStyle;
bmp.Canvas.Font.Orientation := FFontOrientation;
Result := MeasureTextSize(bmp.Canvas, AText, pts);
if (FFontOrientation = 0) or (not ARotated) then
begin
R := Rect(0, 0, 10000, 10000);
DrawText(bmp.Canvas.Handle, PChar(AText), Length(AText), R, DT_CALCRECT or DT_WORDBREAK);
Result := TSize(R.BottomRight);
end else
Result := MeasureTextSize(bmp.Canvas, AText, pts);
finally
bmp.Free;
end;

View File

@ -102,7 +102,7 @@ type
AFontStyle: TFontStyles; AFontColor: TColor; AFontOrientation: Single = 0.0);
procedure SetPen(APen: TMvPen);
procedure SetPen(APenStyle: TPenStyle; APenWidth: Integer; APenColor: TColor);
function TextExtent(const AText: String): TSize; virtual; abstract;
function TextExtent(const AText: String; ARotated: Boolean = false): TSize; virtual; abstract;
function TextHeight(const AText: String): Integer;
procedure TextOut(X, Y: Integer; const AText: String); virtual; abstract;
function TextWidth(const AText: String): Integer;
@ -147,8 +147,8 @@ function ClipPolyToRect(constref ARect: TRect; var APoly: TPointArray;
procedure PolyBounds(APoly: array of TPoint; out ABounds: TRect);
// Measures the size of the given text and returns the vertices of the corners
// of the rectangle enclosing the text. Text rotation is supported.
// BUT: in case of rotated text, word-wrapping is not allowed.
// of the rectangle enclosing the text. Text rotation is supported.
// BUT: in case of rotated text, word-wrapping is not allowed.
function MeasureTextSize(ACanvas: TCanvas; AText: String;
out ACorners: TPointArray): TSize;

View File

@ -3508,14 +3508,12 @@ var
end;
// Draw the point text
DrawingEngine.Opacity := FPOIOpacity;
DrawingEngine.BrushColor := FPOITextBgColor;
if FPOITextBgColor = clNone then
DrawingEngine.BrushStyle := bsClear
else
begin
DrawingEngine.BrushStyle := bsSolid;
DrawingEngine.BrushColor := FPOITextBgColor;
end;
DrawingEngine.Opacity := FPOIOpacity;
// Text is at the left/centered/right of the GPS point...
case txtPosHor of
@ -3588,7 +3586,7 @@ begin
txt := APt.Name;
if FPOITextBgColor <> clNone then
txt := ' ' + txt + ' '; // add some margin
txtExtent := DrawingEngine.TextExtent(txt);
txtExtent := DrawingEngine.TextExtent(txt, DrawingEngine.FontOrientation <> 0);
// Draw point, in case of cyclic points multiple times.
pt := Engine.LatLonToScreen(APt.RealPoint);