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