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

LazMapViewer: Complete unfinished LCL mapviewer (using only LCL drawing routines). Update "fulldemo_with_addons".

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@9324 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz 2024-04-04 18:10:21 +00:00
parent 4f4248244a
commit c13251c57d
5 changed files with 132 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
components/lazmapviewer/examples/fulldemo_with_addons/main.lfm
View File

@ -727,6 +727,7 @@ object MainForm: TMainForm
'default'
'RGBGraphics'
'BGRABitmap'
'LCL'
)
Style = csDropDownList
TabOrder = 0

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

@ -7,8 +7,9 @@ interface
uses
Classes, SysUtils, Types, Forms, Controls, Graphics, Dialogs, ExtCtrls,
StdCtrls, ComCtrls, Buttons, IntfGraphics, ColorBox, Spin, Grids, ExtDlgs,
mvGeoNames, mvMapViewer, mvTypes, mvGpsObj, mvDrawingEngine, mvDE_RGBGraphics,
mvDE_BGRA, mvDLEFPC, mvDLEWin, mvDLESynapse;
mvGeoNames, mvMapViewer, mvTypes, mvGpsObj,
mvDrawingEngine, mvDE_RGBGraphics, mvDE_BGRA, mvDE_LCL,
mvDLEFPC, mvDLEWin, mvDLESynapse;
type
@ -142,6 +143,7 @@ type
private
FRGBGraphicsDrawingEngine: TMvRGBGraphicsDrawingEngine;
FBGRADrawingEngine: TMvBGRADrawingEngine;
FLCLDrawingEngine: TMvLCLDrawingEngine;
FSynapseDownloadEngine: TMvDESynapse;
FFpHttpClientDownloadEngine: TMvDEFPC;
{$IFDEF MSWINDOWS}
@ -406,6 +408,11 @@ begin
FBGRADrawingEngine := TMvBGRADrawingEngine.Create(self);
MapView.DrawingEngine := FBGRADrawingEngine;
end;
3: begin
if FLCLDrawingEngine = nil then
FLCLDrawingEngine := TMvLCLDrawingEngine.Create(self);
MapView.DrawingEngine := FLCLDrawingEngine;
end;
end;
UpdateLayers;
end;

7
components/lazmapviewer/lazmapviewerpkg.lpk
View File

@ -20,7 +20,7 @@
<Description Value="Component for viewing maps (Google, OpenStreetMap, etc). This is a fork of MapViewer by ti_dic (https://sourceforge.net/p/roadbook/code/ci/master/tree/mapviewer/) which itself is based on the MapViewer by Maciej Kaczkowski (https://github.com/maciejkaczkowski/mapviewer)."/>
<License Value="Modified LGPL with linking exception, like FreePascal RTL/FCL and Lazarus LCL"/>
<Version Minor="2" Release="7"/>
<Files Count="20">
<Files Count="21">
<Item1>
<Filename Value="source/mvcache.pas"/>
<UnitName Value="mvCache"/>
@ -103,6 +103,11 @@
<Filename Value="source/mvlayerspropeditform.pas"/>
<UnitName Value="mvLayersPropEditForm"/>
</Item20>
<Item21>
<Filename Value="source/mvde_lcl.pas"/>
<HasRegisterProc Value="True"/>
<UnitName Value="mvDE_LCL"/>
</Item21>
</Files>
<CompatibilityMode Value="True"/>
<RequiredPkgs Count="2">

4
components/lazmapviewer/lazmapviewerpkg.pas
View File

@ -11,7 +11,8 @@ uses
mvCache, mvDownloadEngine, mvDragObj, mvEngine, mvGeoNames, mvGpsObj,
mvJobQueue, mvJobs, mvMapProvider, mvTypes, mvMapViewer, mvExtraData,
mvDLEFpc, mvMapViewerReg, mvGPX, mvDrawingEngine, mvDE_IntfGraphics,
mvDLEWin, mvMapViewerPropEdits, mvLayersPropEditForm, LazarusPackageIntf;
mvDLEWin, mvMapViewerPropEdits, mvLayersPropEditForm, mvDE_LCL,
LazarusPackageIntf;
implementation
@ -19,6 +20,7 @@ procedure Register;
begin
RegisterUnit('mvMapViewerReg', @mvMapViewerReg.Register);
RegisterUnit('mvMapViewerPropEdits', @mvMapViewerPropEdits.Register);
RegisterUnit('mvDE_LCL', @mvDE_LCL.Register);
end;
initialization

135
components/lazmapviewer/source/mvde_lcl.pas
View File

@ -16,11 +16,26 @@ unit mvDE_LCL;
interface
uses
Classes, SysUtils, Graphics, Types, IntfGraphics,
mvDrawingEngine;
Classes, SysUtils, Graphics, Types, IntfGraphics, fpReadJPEG, fpReadPNG,
mvDrawingEngine, mvCache;
type
{ TLCLCacheItem }
TLCLCacheItem = class(TPictureCacheItem)
private
FImage: TCustomBitmap;
function GetImage: TCustomBitmap;
protected
function GetImageObject: TObject; override;
public
constructor Create(AStream: TStream); override;
destructor Destroy; override;
property Image: TCustomBitmap read GetImage;
end;
{ TMvLCLDrawingEngine }
TMvLCLDrawingEngine = class(TMvCustomDrawingEngine)
@ -48,25 +63,82 @@ type
procedure CreateBuffer(AWidth, AHeight: Integer); override;
procedure DrawBitmap(X, Y: Integer; ABitmap: TCustomBitmap;
{%H-}UseAlphaChannel: Boolean); override;
procedure DrawLazIntfImage(X, Y: Integer; AImg: TLazIntfImage); override;
procedure DrawCacheItem(X, Y: Integer; AImg: TPictureCacheItem;
ADrawMode: TItemDrawMode = idmDraw; AOpacity: Single = 1.0 ); override;
procedure DrawScaledCacheItem(DestRect, SrcRect: TRect; ASrcImg: TPictureCacheItem); override;
procedure Ellipse(X1, Y1, X2, Y2: Integer); override;
procedure FillPixels(X1, Y1, X2, Y2: Integer; AColor: TColor); override;
procedure FillRect(X1, Y1, X2, Y2: Integer); override;
procedure Line(X1, Y1, X2, Y2: Integer); override;
procedure Polyline(const Points: array of TPoint); override;
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;
procedure TextOut(X, Y: Integer; const AText: String); override;
function GetCacheItemClass: TPictureCacheItemClass; override;
end;
procedure Register;
implementation
uses
LCLType;
LCLType, FPImage, mvTypes;
procedure Register;
begin
RegisterComponents(PALETTE_PAGE, [TMvLCLDrawingEngine]);
end;
{ TLCLCacheItem }
function TLCLCacheItem.GetImage: TCustomBitmap;
begin
Result := FImage;
end;
function TLCLCacheItem.GetImageObject: TObject;
begin
Result := FImage;
end;
constructor TLCLCacheItem.Create(AStream: TStream);
var
reader: TFPCustomImageReader;
begin
FImage := Nil;
reader := GetImageReader(AStream);
if reader is TFPReaderJPEG then
FImage := TJpegImage.Create
else
if reader is TFPReaderPNG then
FImage := TPortableNetworkGraphic.Create
else
raise EInvalidGraphic.Create('PNG/JPG expected.');
try
try
FImage.LoadFromStream(AStream);
except
FreeAndNil(FImage);
end;
finally
reader.Free;
end;
end;
destructor TLCLCacheItem.Destroy;
begin
FImage.Free;
inherited Destroy;
end;
{ TMvLCLDrawingEngine }
destructor TMvLCLDrawingEngine.Destroy;
begin
@ -88,23 +160,23 @@ begin
FBuffer.Canvas.Draw(X, Y, ABitmap);
end;
procedure TMvLCLDrawingEngine.DrawLazIntfImage(X, Y: Integer;
AImg: TLazIntfImage);
procedure TMvLCLDrawingEngine.DrawCacheItem(X, Y: Integer;
AImg: TPictureCacheItem; ADrawMode: TItemDrawMode; AOpacity: Single);
var
bmp: TBitmap;
h, mh: HBITMAP;
item: TLCLCacheItem;
begin
bmp := TBitmap.Create;
try
bmp.PixelFormat := pf32Bit;
bmp.SetSize(AImg.Width, AImg.Height);
AImg.CreateBitmaps(h, mh);
bmp.Handle := h;
bmp.MaskHandle := mh;
FBuffer.Canvas.Draw(X, Y, bmp);
finally
bmp.Free;
end;
item := AImg as TLCLCacheItem;
FBuffer.Canvas.Draw(X, Y, item.Image);
end;
procedure TMvLCLDrawingEngine.DrawScaledCacheItem(DestRect,
SrcRect: TRect; ASrcImg: TPictureCacheItem);
var
item: TLCLCacheItem;
bmp: TBitmap;
begin
item := ASrcImg as TLCLCacheItem;
FBuffer.Canvas.CopyRect(DestRect, item.Image.Canvas, SrcRect);
end;
procedure TMvLCLDrawingEngine.Ellipse(X1, Y1, X2, Y2: Integer);
@ -112,6 +184,20 @@ begin
FBuffer.Canvas.Ellipse(X1,Y1, X2, Y2);
end;
procedure TMvLCLDrawingEngine.FillPixels(X1, Y1, X2, Y2: Integer; AColor: TColor);
begin
if (X1 >= FBuffer.Width) or (X2 < 0) or (Y1 >= FBuffer.Height) or (Y2 < 0) then
exit;
if X1 < 0 then X1 := 0;
if Y1 < 0 then Y1 := 0;
if X2 >= FBuffer.Width then X2 := FBuffer.Width - 1;
if Y2 >= FBuffer.Height then Y2 := FBuffer.Height - 1;
FBuffer.Canvas.Brush.Color := AColor;
FBuffer.Canvas.FillRect(X1, Y1, X2, Y2);
end;
procedure TMvLCLDrawingEngine.FillRect(X1, Y1, X2, Y2: Integer);
begin
FBuffer.Canvas.FillRect(X1,Y1, X2, Y2);
@ -127,6 +213,11 @@ begin
Result := FBuffer.Canvas.Brush.Style
end;
function TMvLCLDrawingEngine.GetCacheItemClass: TPictureCacheItemClass;
begin
Result := TLCLCacheItem;
end;
function TMvLCLDrawingEngine.GetFontColor: TColor;
begin
Result := FBuffer.Canvas.Font.Color
@ -178,9 +269,9 @@ begin
FBuffer.Canvas.PolyBezier(Points, Filled, Continuous);
end;
procedure TMvLCLDrawingEngine.PaintToCanvas(ACanvas: TCanvas);
procedure TMvLCLDrawingEngine.PaintToCanvas(ACanvas: TCanvas; Origin: TPoint);
begin
ACanvas.Draw(0, 0, FBuffer);
ACanvas.Draw(Origin.X, Origin.Y, FBuffer);
end;
procedure TMvLCLDrawingEngine.Rectangle(X1, Y1, X2, Y2: Integer);