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

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@9324 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/lazmapviewer/examples/fulldemo_with_addons/main.lfm

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

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,
+  mvGeoNames, mvMapViewer, mvTypes, mvGpsObj,
-  mvDE_BGRA, mvDLEFPC, mvDLEWin, mvDLESynapse;
+  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;

components/lazmapviewer/lazmapviewerpkg.lpk

@@ -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">

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

components/lazmapviewer/source/mvde_lcl.pas

@@ -16,11 +16,26 @@ unit mvDE_LCL;
 interface
 
 uses
-  Classes, SysUtils, Graphics, Types, IntfGraphics,
+  Classes, SysUtils, Graphics, Types, IntfGraphics, fpReadJPEG, fpReadPNG,
-  mvDrawingEngine;
+  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;
+procedure TMvLCLDrawingEngine.DrawCacheItem(X, Y: Integer;
-  AImg: TLazIntfImage);
+  AImg: TPictureCacheItem; ADrawMode: TItemDrawMode; AOpacity: Single);
 var
-  bmp: TBitmap;
+  item: TLCLCacheItem;
-  h, mh: HBITMAP;
 begin
-  bmp := TBitmap.Create;
+  item := AImg as TLCLCacheItem;
-  try
+  FBuffer.Canvas.Draw(X, Y, item.Image);
-    bmp.PixelFormat := pf32Bit;
+end;
-    bmp.SetSize(AImg.Width, AImg.Height);
+
-    AImg.CreateBitmaps(h, mh);
+procedure TMvLCLDrawingEngine.DrawScaledCacheItem(DestRect,
-    bmp.Handle := h;
+  SrcRect: TRect; ASrcImg: TPictureCacheItem);
-    bmp.MaskHandle := mh;
+var
-    FBuffer.Canvas.Draw(X, Y, bmp);
+  item: TLCLCacheItem;
-  finally
+  bmp: TBitmap;
-    bmp.Free;
+begin
-  end;
+  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);