diff --git a/components/lazmapviewer/examples/fulldemo_with_addons/main.lfm b/components/lazmapviewer/examples/fulldemo_with_addons/main.lfm
index 27a855ad2..575f56ed4 100644
--- a/components/lazmapviewer/examples/fulldemo_with_addons/main.lfm
+++ b/components/lazmapviewer/examples/fulldemo_with_addons/main.lfm
@@ -727,6 +727,7 @@ object MainForm: TMainForm
'default'
'RGBGraphics'
'BGRABitmap'
+ 'LCL'
)
Style = csDropDownList
TabOrder = 0
diff --git a/components/lazmapviewer/examples/fulldemo_with_addons/main.pas b/components/lazmapviewer/examples/fulldemo_with_addons/main.pas
index 3e6e07717..62519f0a9 100644
--- a/components/lazmapviewer/examples/fulldemo_with_addons/main.pas
+++ b/components/lazmapviewer/examples/fulldemo_with_addons/main.pas
@@ -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;
diff --git a/components/lazmapviewer/lazmapviewerpkg.lpk b/components/lazmapviewer/lazmapviewerpkg.lpk
index f131f2f66..ae869fb3d 100644
--- a/components/lazmapviewer/lazmapviewerpkg.lpk
+++ b/components/lazmapviewer/lazmapviewerpkg.lpk
@@ -20,7 +20,7 @@
-
+
@@ -103,6 +103,11 @@
+
+
+
+
+
diff --git a/components/lazmapviewer/lazmapviewerpkg.pas b/components/lazmapviewer/lazmapviewerpkg.pas
index dd1de60d3..66f5f3ff2 100644
--- a/components/lazmapviewer/lazmapviewerpkg.pas
+++ b/components/lazmapviewer/lazmapviewerpkg.pas
@@ -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
diff --git a/components/lazmapviewer/source/mvde_lcl.pas b/components/lazmapviewer/source/mvde_lcl.pas
index 31199abc4..ff5c605fd 100644
--- a/components/lazmapviewer/source/mvde_lcl.pas
+++ b/components/lazmapviewer/source/mvde_lcl.pas
@@ -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);