paweld/lazarus-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

LazMapViewer: Improved drawing (PaintToCanvas with origin), fix of hang due to arithmetic error, improved cyclic drawing. Patch by Yuliyan Ivanov.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@9151 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz 2024-01-19 17:55:12 +00:00
parent 3750b0a3d7
commit a0a6aee91f
8 changed files with 196 additions and 74 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
components/lazmapviewer/examples/fulldemo/main.pas
View File

@ -884,6 +884,8 @@ end;
procedure TMainForm.sgLayersCheckboxToggled(sender: TObject; aCol,
aRow: Integer; aState: TCheckboxState);
begin
if TileLayer[Pred(sgLayers.Row)].MapProvider.IsEmpty then
Exit;
TileLayer[Pred(sgLayers.Row)].Visible := (aState = cbChecked);
MapView.Redraw;
end;

2
components/lazmapviewer/examples/fulldemo_with_addons/main.pas
View File

@ -230,6 +230,8 @@ end;
procedure TMainForm.sgLayersCheckboxToggled(Sender: TObject; aCol,
aRow: Integer; aState: TCheckboxState);
begin
if TileLayer[Pred(sgLayers.Row)].MapProvider.IsEmpty then
Exit;
TileLayer[Pred(sgLayers.Row)].Visible := (aState = cbChecked);
MapView.Redraw;
end;

6
components/lazmapviewer/source/addons/bgra_drawingengine/mvde_bgra.pas
View File

@ -83,7 +83,7 @@ type
procedure Polygon(const Points: array of TPoint); override;
procedure PolyBezier(const Points: array of TPoint; Filled: Boolean = False;
Continuous: Boolean = True); override;
procedure PaintToCanvas(ACanvas: TCanvas); override;
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;
@ -297,9 +297,9 @@ begin
FBuffer.CanvasBGRA.PolyBezier(Points, Filled, Continuous);
end;
procedure TMvBGRADrawingEngine.PaintToCanvas(ACanvas: TCanvas);
procedure TMvBGRADrawingEngine.PaintToCanvas(ACanvas: TCanvas; Origin: TPoint);
begin
FBuffer.Draw(ACanvas, 0, 0);
FBuffer.Draw(ACanvas, Origin.X, Origin.Y);
end;
procedure TMvBGRADrawingEngine.Rectangle(X1, Y1, X2, Y2: Integer);

7
components/lazmapviewer/source/addons/rgbgraphics_drawingengine/mvde_rgbgraphics.pas
View File

@ -85,7 +85,7 @@ type
procedure Polygon(const Points: array of TPoint); override;
procedure PolyBezier(const Points: array of TPoint; Filled: Boolean = False;
Continuous: Boolean = True); override;
procedure PaintToCanvas(ACanvas: TCanvas); override;
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;
@ -433,9 +433,10 @@ begin
else Polyline(PtDyn);
end;
procedure TMvRGBGraphicsDrawingEngine.PaintToCanvas(ACanvas: TCanvas);
procedure TMvRGBGraphicsDrawingEngine.PaintToCanvas(ACanvas: TCanvas;
Origin: TPoint);
begin
FBuffer.Canvas.DrawTo(ACanvas, 0, 0);
FBuffer.Canvas.DrawTo(ACanvas, Origin.X, Origin.Y);
end;
procedure TMvRGBGraphicsDrawingEngine.Rectangle(X1, Y1, X2, Y2: Integer);

7
components/lazmapviewer/source/mvde_intfgraphics.pas
View File

@ -83,7 +83,7 @@ type
procedure Polygon(const Points: array of TPoint); override;
procedure PolyBezier(const Points: array of TPoint; Filled: Boolean = False;
Continuous: Boolean = True); override;
procedure PaintToCanvas(ACanvas: TCanvas); override;
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;
@ -512,7 +512,8 @@ begin
else Polyline(PtDyn);
end;
procedure TMvIntfGraphicsDrawingEngine.PaintToCanvas(ACanvas: TCanvas);
procedure TMvIntfGraphicsDrawingEngine.PaintToCanvas(ACanvas: TCanvas;
Origin: TPoint);
var
bmp: TBitmap;
begin
@ -522,7 +523,7 @@ begin
bmp.PixelFormat := pf32Bit;
bmp.SetSize(FBuffer.Width, FBuffer.Height);
bmp.LoadFromIntfImage(FBuffer);
ACanvas.Draw(0, 0, bmp);
ACanvas.Draw(Origin.X, Origin.Y, bmp);
finally
bmp.Free;
end;

20
components/lazmapviewer/source/mvdrawingengine.pas
View File

@ -16,7 +16,7 @@ unit mvDrawingEngine;
interface
uses
Classes, SysUtils, Graphics, Types, IntfGraphics, mvCache;
Classes, SysUtils, Graphics, GraphMath, Types, IntfGraphics, mvCache;
type
@ -68,7 +68,8 @@ type
procedure Polygon(const Points: array of TPoint); virtual; abstract;
procedure PolyBezier(const Points: array of TPoint; Filled: Boolean = False;
Continuous: Boolean = True); virtual; abstract;
procedure PaintToCanvas(ACanvas: TCanvas); virtual; abstract;
procedure PaintToCanvas(ACanvas: TCanvas); overload;
procedure PaintToCanvas(ACanvas: TCanvas; Origin: TPoint); overload; virtual; abstract;
procedure Rectangle(X1, Y1, X2, Y2: Integer); virtual; abstract;
function SaveToImage(AClass: TRasterImageClass): TRasterImage; virtual; abstract;
function TextExtent(const AText: String): TSize; virtual; abstract;
@ -104,7 +105,7 @@ procedure PolyBounds(APoly: array of TPoint; out ABounds: TRect);
implementation
uses
Math, LCLType, FPImage, GraphMath,
Math, LCLType, FPImage, //GraphMath,
Generics.Collections, Generics.Defaults;
function Intersect(P1, P2, P3, P4: TPoint; out PX: TPoint): Integer;
@ -295,8 +296,8 @@ begin
YI := MaxInt; // Y of the previous point
while I < Length(APoly) do
begin
NPoly[L].X := APoly[I].X shl 1; // X * 2
R := APoly[I].Y shl 1;
NPoly[L].X := APoly[I].X * 2; // X * 2
R := APoly[I].Y * 2;
if R = YI // Last Y was the same?
then R := R + 1; // Make it non horizontal
NPoly[L].Y := R; // Y * 2
@ -326,8 +327,8 @@ begin
if XPoints.Count > 0 then
for XI := 0 to XPoints.Count div 2 - 1 do
ALineDrawProc(
XPoints[XI * 2].X shr 1, YI shr 1,
XPoints[XI * 2 + 1].X shr 1, YI shr 1);
XPoints[XI * 2].X div 2, YI div 2,
XPoints[XI * 2 + 1].X div 2, YI div 2);
Inc(YI, 2);
end;
finally
@ -411,6 +412,11 @@ begin
end;
end;
procedure TMvCustomDrawingEngine.PaintToCanvas(ACanvas: TCanvas);
begin
PaintToCanvas(ACanvas, Point(0, 0));
end;
function TMvCustomDrawingEngine.TextHeight(const AText: String): Integer;
begin
Result := TextExtent(AText).CX;

12
components/lazmapviewer/source/mvengine.pas
View File

@ -1008,7 +1008,7 @@ procedure TMapViewerEngine.Redraw(const aWin: TMapWindow;
var
TilesVis: TArea;
x, y, px, py: Integer;
iTile, numTiles: Integer;
iTile, numTiles, XShift: Integer;
Tiles: TTileIdArray = nil;
tile: TTileID;
previewDrawn: Boolean;
@ -1062,15 +1062,17 @@ begin
SetLength(Tiles, (TilesVis.Bottom - TilesVis.Top + 1) * (TilesVis.Right - TilesVis.Left + 1));
iTile := Low(Tiles);
numTiles := 1 shl AWin.Zoom;
XShift := IfThen(aWin.X > 0, numTiles - aWin.X div TILE_SIZE - 1, 0);
for y := TilesVis.Top to TilesVis.Bottom do
for X := TilesVis.Left to TilesVis.Right do
begin
if FCyclic then
begin
Tiles[iTile].X := X mod numTiles;
if Tiles[iTile].X < 0 then
begin // 0,1,2,3,4,5 --> 15,16,>0<,1,2,3
Tiles[iTile].X := (X + XShift) mod numTiles;
if Tiles[iTile].X < 0 then //
Tiles[iTile].X := Tiles[iTile].X + numTiles;
end else
end
else
Tiles[iTile].X := X;
Tiles[iTile].Y := Y;
Tiles[iTile].Z := AWin.Zoom;

214
components/lazmapviewer/source/mvmapviewer.pas
View File

@ -22,7 +22,8 @@ unit mvMapViewer;
interface
uses
Classes, SysUtils, Controls, Graphics, FPImage, IntfGraphics, Forms, ImgList, LCLVersion,
Classes, SysUtils, Controls, GraphType, Graphics, FPImage, IntfGraphics,
Forms, ImgList, LCLVersion,
MvTypes, MvGPSObj, MvEngine, MvMapProvider, MvDownloadEngine, MvDrawingEngine, mvCache;
Type
@ -129,6 +130,7 @@ Type
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function CyclicPointsOf(APoint: TPoint): TPointArray;
procedure DrawPointOfInterest(const {%H-}Area: TRealArea; APt: TGPSPointOfInterest);
procedure DrawPt(const {%H-}Area: TRealArea; APt: TGPSPoint);
procedure DrawTrack(const Area: TRealArea; trk: TGPSTrack);
@ -248,7 +250,7 @@ Type
implementation
uses
GraphType, Types,
GraphMath, Types, Math,
mvJobQueue, mvExtraData, mvDLEFpc,
{$IFDEF MSWINDOWS}
mvDLEWin,
@ -714,35 +716,66 @@ begin
end;
procedure TMapView.Paint;
const
FREE_DRAG = 0; //(TILE_SIZE * TILE_SIZE) div 4;
procedure Inactive;
procedure DrawCenter;
var
C: TPoint;
begin
C := Point(ClientWidth div 2, ClientHeight div 2);
Canvas.Pen.Color := clBlack;
Canvas.Pen.Width := 1;
Canvas.Line(C.X, C.Y - 15, C.X, C.Y + 15);
Canvas.Line(C.X - 15, C.Y, C.X + 15, C.Y);
end;
procedure InactiveDraw;
begin
Canvas.Brush.Color := InactiveColor;
Canvas.Brush.Style := bsSolid;
Canvas.FillRect(0, 0, ClientWidth, ClientHeight);
end;
procedure Redrw;
procedure FullRedraw;
var
W: Integer;
begin
Engine.Redraw;
DrawObjects(Default(TTileId), 0, 0, Canvas.Width, Canvas.Height);
W := Canvas.Width;
if Cyclic then
W := Min(1 shl Zoom * TILE_SIZE, W);
DrawObjects(Default(TTileId), 0, 0, W - 1, Canvas.Height);
DrawingEngine.PaintToCanvas(Canvas);
if DebugTiles then
DrawCenter;
end;
procedure Drag;
procedure DragDraw;
var
O: TPoint;
begin
// Placeholder for dragging visuals
Redrw;
O := Point(Engine.DragObj.OfsX, Engine.DragObj.OfsY);
// Free drag up to half of the tile
if ((O.X * O.X + O.Y * O.Y) < FREE_DRAG) then
begin
DrawingEngine.PaintToCanvas(Canvas);
DrawingEngine.PaintToCanvas(Canvas, O);
if DebugTiles then
DrawCenter;
end
else
FullRedraw;
end;
begin
inherited Paint;
if IsActive
then if Engine.InDrag
then Drag
else Redrw
then DragDraw
else FullRedraw
else
Inactive;
InactiveDraw;
end;
procedure TMapView.OnGPSItemsModified(Sender: TObject; objs: TGPSObjList;
@ -766,8 +799,9 @@ end;
procedure TMapView.DrawTrack(const Area: TRealArea; trk: TGPSTrack);
var
I, K: integer;
I, J, K: integer;
iPt1, iPt2: TPoint;
Pt1Cyc, Pt2Cyc: TPointArray;
iPt1Visible, iPt2Visible: Boolean;
pt1, pt2: TRealPoint;
trkColor: TColor;
@ -824,7 +858,17 @@ begin
iPt1 := Engine.LonLatToScreen(pt1);
iPt2 := Engine.LonLatToScreen(pt2);
K := I;
DrawingEngine.Line(iPt1.X, iPt1.Y, iPt2.X, iPt2.Y);
if Cyclic then
begin
Pt1Cyc := CyclicPointsOf(iPt1);
Pt2Cyc := CyclicPointsOf(iPt2);
for J := 0 to High(Pt1Cyc) do
DrawingEngine.Line(Pt1Cyc[J].X, Pt1Cyc[J].Y, Pt2Cyc[J].X, Pt2Cyc[J].Y);
end
else
DrawingEngine.Line(iPt1.X, iPt1.Y, iPt2.X, iPt2.Y);
iPt1 := iPt2;
end;
pt1 := pt2;
@ -835,32 +879,18 @@ end;
procedure TMapView.DrawPointOfInterest(const Area: TRealArea; APt: TGPSPointOfInterest);
var
pt: TPoint;
ptCyc: TPointArray;
ptColor: TColor;
extent: TSize;
s: String;
bmp: TBitmap;
w, h: Integer;
begin
pt := Engine.LonLatToScreen(APt.RealPoint);
// Draw point as symbol from image list ...
if Assigned(FPOIImages) and (APt.ImageIndex <> -1) and (APt.ImageIndex < FPOIImages.Count) then
begin
bmp := TBitmap.Create;
try
FPOIImages.GetBitmap(APt.ImageIndex, bmp);
{$IF LCL_FullVersion >= 2000000}
w := FPOIImages.WidthForPPI[FPOIImagesWidth, Font.PixelsPerInch];
h := FPOIImages.HeightForPPI[FPOIImagesWidth, Font.PixelsPerInch];
{$ELSE}
w := FPOIImages.Width;
h := FPOIImages.Height;
{$IFEND}
DrawingEngine.DrawBitmap(pt.X - w div 2, pt.Y - h, bmp, true);
finally
bmp.Free;
end;
end else
procedure DrawOne(pt: TPoint);
begin
if Assigned(bmp) then
DrawingEngine.DrawBitmap(pt.X - w div 2, pt.Y - h, bmp, true)
else
begin
// ... or as cross
ptColor := clRed;
@ -872,40 +902,64 @@ begin
DrawingEngine.Line(pt.X - 5, pt.Y, pt.X + 5, pt.Y);
pt.Y := pt.Y + 5;
end;
if FPOITextBgColor = clNone then
DrawingEngine.BrushStyle := bsClear
else
begin
DrawingEngine.BrushStyle := bsSolid;
DrawingEngine.BrushColor := FPOITextBgColor;
end;
DrawingEngine.TextOut(pt.X - extent.CX div 2, pt.Y + 5, s);
end;
begin
pt := Engine.LonLatToScreen(APt.RealPoint);
bmp := Nil;
try
// Draw point as symbol from image list ...
if Assigned(FPOIImages) and (APt.ImageIndex <> -1) and (APt.ImageIndex < FPOIImages.Count) then
begin
bmp := TBitmap.Create;
FPOIImages.GetBitmap(APt.ImageIndex, bmp);
{$IF LCL_FullVersion >= 2000000}
w := FPOIImages.WidthForPPI[FPOIImagesWidth, Font.PixelsPerInch];
h := FPOIImages.HeightForPPI[FPOIImagesWidth, Font.PixelsPerInch];
{$ELSE}
w := FPOIImages.Width;
h := FPOIImages.Height;
{$IFEND}
end;
// Draw point text
s := APt.Name;
if FPOITextBgColor = clNone then
DrawingEngine.BrushStyle := bsClear
else begin
DrawingEngine.BrushStyle := bsSolid;
DrawingEngine.BrushColor := FPOITextBgColor;
if FPOITextBgColor <> clNone then
s := ' ' + s + ' ';
end;
extent := DrawingEngine.TextExtent(s);
DrawingEngine.TextOut(pt.X - extent.CX div 2, pt.Y + 5, s);
if Cyclic then
begin
ptCyc := CyclicPointsOf(pt);
for pt in ptCyc do
DrawOne(pt);
end
else
DrawOne(pt);
finally
bmp.Free;
end;
end;
procedure TMapView.DrawPt(const Area: TRealArea; APt: TGPSPoint);
var
Pt: TPoint;
PtCyc: TPointArray;
PtColor: TColor;
extent: TSize;
s: String;
begin
if Assigned(FOnDrawGpsPoint) then begin
FOnDrawGpsPoint(Self, DrawingEngine, APt);
exit;
end;
Pt := Engine.LonLatToScreen(APt.RealPoint);
PtColor := clRed;
if APt.ExtraData <> nil then
begin
if APt.ExtraData.inheritsFrom(TDrawingExtraData) then
PtColor := TDrawingExtraData(APt.ExtraData).Color;
end;
R, L, WorldSize: LongInt;
procedure DrawOne(Pt: TPoint);
begin
// Draw point marker
if Assigned(FPOIImage) and not (FPOIImage.Empty) then
DrawingEngine.DrawBitmap(Pt.X - FPOIImage.Width div 2, Pt.Y - FPOIImage.Height, FPOIImage, true)
@ -928,7 +982,25 @@ begin
end;
extent := DrawingEngine.TextExtent(s);
DrawingEngine.Textout(Pt.X - extent.CX div 2, Pt.Y + 5, s);
end;
begin
if Assigned(FOnDrawGpsPoint) then begin
FOnDrawGpsPoint(Self, DrawingEngine, APt);
exit;
end;
Pt := Engine.LonLatToScreen(APt.RealPoint);
PtColor := clRed;
if APt.ExtraData <> nil then
begin
if APt.ExtraData.inheritsFrom(TDrawingExtraData) then
PtColor := TDrawingExtraData(APt.ExtraData).Color;
end;
PtCyc := CyclicPointsOf(Pt);
for Pt in PtCyc do
DrawOne(Pt);
end;
procedure TMapView.DrawGpsObj(const Area: TRealArea; AObj: TGPSObj);
@ -1112,6 +1184,42 @@ begin
inherited Destroy;
end;
function TMapView.CyclicPointsOf(APoint: TPoint): TPointArray;
var
I, R, L, WorldSize: LongInt;
begin
Result := Default(TPointArray);
if not Cyclic then
begin
SetLength(Result, 1);
Result[0] := APoint;
end
else
begin
WorldSize := 1 shl Zoom * TILE_SIZE;
SetLength(Result, 1 + Canvas.Width div WorldSize);
Result[0] := APoint;
I := 1; R := APoint.X + WorldSize; L := APoint.X - WorldSize;
while (R < Canvas.Width) or (L >= 0) do
begin
if R < Canvas.Width then
begin
Result[I].Y := APoint.Y;
Result[I].X := R;
Inc(I);
end;
if L >= 0 then
begin
Result[I].Y := APoint.Y;
Result[I].X := L;
Inc(I);
end;
Inc(R, WorldSize);
Dec(L, WorldSize);
end;
end;
end;
procedure TMapView.SaveToFile(AClass: TRasterImageClass; const AFileName: String);
var
stream: TFileStream;