LazMapViewer: Draw Point-of-interest image. Fix drawing of transparent bitmaps. Remove LCLDrawer from demo (not working).

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

components/lazmapviewer/example/main.lfm

@@ -17,22 +17,17 @@ object MainForm: TMainForm
     Hint = 'Displays the map'
     Top = 0
     Width = 608
-    Active = False
     Align = alClient
-    CacheOnDisk = True
-    CachePath = 'cache/'
     DefaultTrackColor = clBlue
     DefaultTrackWidth = 3
     DownloadEngine = MapView.BuiltInDLE
     DrawingEngine = MapView.BuiltInDE
     Font.Color = clBlack
-    InactiveColor = clWhite
     MapProvider = 'OpenStreetMap Mapnik'
     UseThreads = True
     Zoom = 0
     OnZoomChange = MapViewZoomChange
     OnChange = MapViewChange
-    OnDrawGpsPoint = MapViewDrawGpsPoint
     OnMouseLeave = MapViewMouseLeave
     OnMouseMove = MapViewMouseMove
     OnMouseUp = MapViewMouseUp
@@ -573,7 +568,6 @@ object MainForm: TMainForm
         ItemIndex = 0
         Items.Strings = (
           'default'
-          'LCL'
           'RGBGraphics'
         )
         OnChange = CbDrawingEngineChange
@@ -758,6 +752,78 @@ object MainForm: TMainForm
         OnChange = CbDebugTilesChange
         TabOrder = 4
       end
+      object CbShowPOIImage: TCheckBox
+        AnchorSideLeft.Control = CbDebugTiles
+        AnchorSideTop.Control = Bevel1
+        AnchorSideTop.Side = asrBottom
+        Left = 6
+        Height = 19
+        Top = 189
+        Width = 107
+        BorderSpacing.Top = 6
+        Caption = 'Show POI image'
+        OnChange = CbShowPOIImageChange
+        TabOrder = 5
+      end
+      object BtnPOITextFont: TButton
+        AnchorSideTop.Control = CbShowPOIImage
+        AnchorSideTop.Side = asrBottom
+        Left = 6
+        Height = 25
+        Top = 216
+        Width = 92
+        AutoSize = True
+        BorderSpacing.Top = 8
+        Caption = 'POI text font'
+        OnClick = BtnPOITextFontClick
+        TabOrder = 6
+      end
+      object cbPOITextBgColor: TColorBox
+        AnchorSideLeft.Control = LblPOITextBgColor
+        AnchorSideLeft.Side = asrBottom
+        AnchorSideTop.Control = BtnPOITextFont
+        AnchorSideTop.Side = asrCenter
+        AnchorSideRight.Control = CbDrawingEngine
+        AnchorSideRight.Side = asrBottom
+        Left = 153
+        Height = 22
+        Top = 217
+        Width = 108
+        NoneColorColor = clWhite
+        Style = [cbStandardColors, cbExtendedColors, cbIncludeNone, cbCustomColor, cbPrettyNames, cbCustomColors]
+        Anchors = [akTop, akLeft, akRight]
+        BorderSpacing.Left = 8
+        ItemHeight = 16
+        OnChange = cbPOITextBgColorChange
+        TabOrder = 7
+      end
+      object LblPOITextBgColor: TLabel
+        AnchorSideLeft.Control = BtnPOITextFont
+        AnchorSideLeft.Side = asrBottom
+        AnchorSideTop.Control = BtnPOITextFont
+        AnchorSideTop.Side = asrCenter
+        Left = 106
+        Height = 15
+        Top = 221
+        Width = 39
+        BorderSpacing.Left = 8
+        Caption = 'Backgr.'
+        ParentColor = False
+      end
+      object Bevel1: TBevel
+        AnchorSideLeft.Control = CbDrawingEngine
+        AnchorSideTop.Control = CbDebugTiles
+        AnchorSideTop.Side = asrBottom
+        AnchorSideRight.Control = CbDrawingEngine
+        AnchorSideRight.Side = asrBottom
+        Left = 6
+        Height = 4
+        Top = 179
+        Width = 255
+        Anchors = [akTop, akLeft, akRight]
+        BorderSpacing.Top = 8
+        Shape = bsTopLine
+      end
     end
   end
   object GeoNames: TMVGeoNames
@@ -771,4 +837,10 @@ object MainForm: TMainForm
     left = 240
     top = 456
   end
+  object FontDialog: TFontDialog
+    MinFontSize = 0
+    MaxFontSize = 0
+    left = 648
+    top = 280
+  end
 end

components/lazmapviewer/example/main.pas

@@ -6,20 +6,22 @@ interface
 
 uses
   Classes, SysUtils, Types, Forms, Controls, Graphics, Dialogs,
-  ExtCtrls, StdCtrls, ComCtrls, Buttons,
+  ExtCtrls, StdCtrls, ComCtrls, Buttons, IntfGraphics, ColorBox,
   mvGeoNames, mvMapViewer, mvTypes, mvGpsObj, mvDrawingEngine,
-  mvDE_LCL, mvDE_RGBGraphics;
+  mvDE_RGBGraphics;
 
 type
 
   { TMainForm }
 
   TMainForm = class(TForm)
+    Bevel1: TBevel;
     BtnSearch: TButton;
     BtnGoTo: TButton;
     BtnGPSPoints: TButton;
     BtnSaveToFile: TButton;
     BtnLoadGPXFile: TButton;
+    BtnPOITextFont: TButton;
     CbDoubleBuffer: TCheckBox;
     CbFoundLocations: TComboBox;
     CbLocations: TComboBox;
@@ -29,6 +31,9 @@ type
     CbDistanceUnits: TComboBox;
     CbDebugTiles: TCheckBox;
     CbDrawingEngine: TComboBox;
+    CbShowPOIImage: TCheckBox;
+    cbPOITextBgColor: TColorBox;
+    FontDialog: TFontDialog;
     GbCenterCoords: TGroupBox;
     GbScreenSize: TGroupBox;
     GbSearch: TGroupBox;
@@ -40,6 +45,7 @@ type
     GPSPointInfo: TLabel;
     InfoViewportWidth: TLabel;
     Label1: TLabel;
+    LblPOITextBgColor: TLabel;
     LblSelectLocation: TLabel;
     LblCenterLatitude: TLabel;
     LblViewportHeight: TLabel;
@@ -65,12 +71,15 @@ type
     procedure BtnSearchClick(Sender: TObject);
     procedure BtnGPSPointsClick(Sender: TObject);
     procedure BtnSaveToFileClick(Sender: TObject);
+    procedure BtnPOITextFontClick(Sender: TObject);
     procedure CbDebugTilesChange(Sender: TObject);
     procedure CbDrawingEngineChange(Sender: TObject);
     procedure CbDoubleBufferChange(Sender: TObject);
     procedure CbFoundLocationsDrawItem(Control: TWinControl; Index: Integer;
       ARect: TRect; State: TOwnerDrawState);
+    procedure cbPOITextBgColorChange(Sender: TObject);
     procedure CbProvidersChange(Sender: TObject);
+    procedure CbShowPOIImageChange(Sender: TObject);
     procedure CbUseThreadsChange(Sender: TObject);
     procedure CbDistanceUnitsChange(Sender: TObject);
     procedure FormCreate(Sender: TObject);
@@ -81,7 +90,6 @@ type
     procedure MapViewChange(Sender: TObject);
     procedure MapViewDrawGpsPoint(Sender: TObject;
       ADrawer: TMvCustomDrawingEngine; APoint: TGpsPoint);
-//    procedure MapViewDrawGpsPoint(Sender, ACanvas: TObject; APoint: TGpsPoint);
     procedure MapViewMouseLeave(Sender: TObject);
     procedure MapViewMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
     procedure MapViewMouseUp(Sender: TObject; Button: TMouseButton;
@@ -92,8 +100,8 @@ type
     procedure ZoomTrackBarChange(Sender: TObject);
 
   private
-    FLCLDrawingEngine: TMvLCLDrawingEngine;
     FRGBGraphicsDrawingEngine: TMvRGBGraphicsDrawingEngine;
+    POIImage: TCustomBitmap;
     procedure ClearFoundLocations;
     procedure UpdateCoords(X, Y: Integer);
     procedure UpdateDropdownWidth(ACombobox: TCombobox);
@@ -114,7 +122,7 @@ implementation
 {$R *.lfm}
 
 uses
-  LCLType, IniFiles, Math, FPCanvas, FPImage, IntfGraphics,
+  LCLType, IniFiles, Math, FPCanvas, FPImage, FpImgCanv, GraphType,
   mvEngine, mvGPX,
   globals, gpslistform;
 
@@ -231,6 +239,13 @@ begin
   ShowMessage('Map saved to "mapview.png".');
 end;
 
+procedure TMainForm.BtnPOITextFontClick(Sender: TObject);
+begin
+  FontDialog.Font.Assign(MapView.Font);
+  if FontDialog.Execute then
+    MapView.Font.Assign(FontDialog.Font);
+end;
+
 procedure TMainForm.CbDebugTilesChange(Sender: TObject);
 begin
   MapView.DebugTiles := CbDebugTiles.Checked;
@@ -241,10 +256,6 @@ begin
   case CbDrawingEngine.ItemIndex of
     0: MapView.DrawingEngine := nil;
     1: begin
-         if FLCLDrawingEngine = nil then FLCLDrawingEngine := TMvLCLDrawingEngine.Create(self);
-         MapView.DrawingEngine := FLCLDrawingEngine;
-       end;
-    2: begin
          if FRGBGraphicsDrawingEngine = nil then
            FRGBGraphicsDrawingEngine := TMvRGBGraphicsDrawingEngine.Create(self);
          MapView.DrawingEngine := FRGBGraphicsDrawingEngine;
@@ -286,11 +297,24 @@ begin
   combo.Canvas.TextOut(x, y, P.Descr);
 end;
 
+procedure TMainForm.cbPOITextBgColorChange(Sender: TObject);
+begin
+  MapView.POITextBgColor := cbPOITextBgColor.Selected;
+end;
+
 procedure TMainForm.CbProvidersChange(Sender: TObject);
 begin
   MapView.MapProvider := CbProviders.Text;
 end;
 
+procedure TMainForm.CbShowPOIImageChange(Sender: TObject);
+begin
+  if CbShowPOIImage.Checked then
+    MapView.POIImage.Assign(POIImage)
+  else
+    MapView.POIImage.Clear;
+end;
+
 procedure TMainForm.CbUseThreadsChange(Sender: TObject);
 begin
   MapView.UseThreads := CbUseThreads.Checked;
@@ -316,6 +340,11 @@ end;
 
 procedure TMainForm.FormCreate(Sender: TObject);
 begin
+//  FMapMarker := CreateMapMarker(32, clRed, clBlack);
+  POIImage := TPortableNetworkGraphic.Create;
+  POIImage.PixelFormat := pf32bit;
+  POIImage.LoadFromFile('../../mapmarker.png');
+
   ForceDirectories(HOMEDIR + 'cache/');
   MapView.CachePath := HOMEDIR + 'cache/';
   MapView.GetMapProviders(CbProviders.Items);
@@ -324,6 +353,7 @@ begin
   MapView.Zoom := 1;
   CbUseThreads.Checked := MapView.UseThreads;
   CbDoubleBuffer.Checked := MapView.DoubleBuffered;
+  CbPOITextBgColor.Selected := MapView.POITextBgColor;
 
   InfoPositionLongitude.Caption := '';
   InfoPositionLatitude.Caption := '';
@@ -340,6 +370,7 @@ procedure TMainForm.FormDestroy(Sender: TObject);
 begin
   WriteToIni;
   ClearFoundLocations;
+  FreeAndNil(POIImage)
 end;
 
 procedure TMainForm.FormShow(Sender: TObject);
@@ -374,16 +405,25 @@ begin
   // Screen coordinates of the GPS point
   P := TMapView(Sender).LonLatToScreen(APoint.RealPoint);
 
-  // Draw the GPS point as a circle
+  // Draw the GPS point with MapMarker bitmap
-  ADrawer.BrushColor := clRed;
+  {
-  ADrawer.BrushStyle := bsSolid;
+  if CbShowPOIImage.Checked and not MapView.POIImage.Empty then begin
-  ADrawer.Ellipse(P.X - R, P.Y - R, P.X + R, P.Y + R);
+    ADrawer.DrawBitmap(P.X - MapView.POIImage.Width div 2, P.Y - MapView.POIImage.Height, MapView.POIImage, true);
-
+  end else begin
+  }
+    // Draw the GPS point as a circle
+    ADrawer.BrushColor := clRed;
+    ADrawer.BrushStyle := bsSolid;
+    ADrawer.Ellipse(P.X - R, P.Y - R, P.X + R, P.Y + R);
+    P.Y := P.Y + R;
+  //end;
+    {
   // Draw the caption of the GPS point
   ext := ADrawer.TextExtent(APoint.Name);
   ADrawer.BrushColor := clWhite;
   ADrawer.BrushStyle := bsClear;
-  ADrawer.TextOut(P.X - ext.CX div 2, P.Y - ext.CY - R - 5, APoint.Name);
+  ADrawer.TextOut(P.X - ext.CX div 2, P.Y + 5, APoint.Name);
+  }
 end;
 
 procedure TMainForm.MapViewMouseLeave(Sender: TObject);

components/lazmapviewer/source/addons/rgbgraphics_drawingengine/mvde_rgbgraphics.pas

@@ -42,6 +42,8 @@ type
   public
     destructor Destroy; override;
     procedure CreateBuffer(AWidth, AHeight: Integer); override;
+    procedure DrawBitmap(X, Y: Integer; ABitmap: TCustomBitmap;
+      UseAlphaChannel: Boolean); override;
     procedure DrawLazIntfImage(X, Y: Integer; AImg: TLazIntfImage); override;
     procedure Ellipse(X1, Y1, X2, Y2: Integer); override;
     procedure FillRect(X1, Y1, X2, Y2: Integer); override;
@@ -59,7 +61,7 @@ procedure Register;
 implementation
 
 uses
-  GraphType, FPImage,
+  GraphType, LCLType, FPImage,
   mvTypes;
 
 procedure Register;
@@ -79,6 +81,36 @@ begin
   FBuffer := TRGB32Bitmap.Create(AWidth, AHeight);
 end;
 
+procedure TMvRGBGraphicsDrawingEngine.DrawBitmap(X,Y: Integer;
+  ABitmap: TCustomBitmap; UseAlphaChannel: Boolean);
+var
+  intfImg: TLazIntfImage;
+  i, j: Integer;
+  cimg, cbuf: TFPColor;
+  alpha: Double;
+begin
+  intfImg := ABitmap.CreateIntfImage;
+  try
+    if UseAlphaChannel then begin
+      for j := 0 to intfImg.Height - 1 do
+        for i := 0 to intfImg.Width - 1 do begin
+          cimg := intfImg.Colors[i, j];
+          alpha := cimg.Alpha / word($FFFF);
+          cbuf := TColorToFPColor(FBuffer.Canvas.GetColor(i + X, j + Y));
+          cbuf.Red := Round(alpha * cimg.Red + (1 - alpha) * cbuf.Red);
+          cbuf.Green := Round(alpha * cimg.Green + (1 - alpha) * cbuf.Green);
+          cbuf.Blue := Round(alpha * cimg.Blue + (1 - alpha) * cbuf.Blue);
+          FBuffer.Canvas.SetColor(i + X, j + Y, FPColorToTColor(cbuf));
+        end;
+    end else
+      for j := 0 to intfImg.Height - 1 do
+        for i := 0 to intfImg.Width - 1 do
+          FBuffer.Canvas.SetColor(i + X, j + Y, FPColorToTColor(intfImg.Colors[i, j]));
+  finally
+    intfimg.Free;
+  end;
+end;
+
 procedure TMvRGBGraphicsDrawingEngine.DrawLazIntfImage(X, Y: Integer;
   AImg: TLazIntfImage);
 //http://mantis.freepascal.org/view.php?id=27144
@@ -235,6 +267,7 @@ begin
   end;
 end;
 
+(*
 procedure TMvRGBGraphicsDrawingEngine.TextOut(X, Y: Integer; const AText: String);
 var
   bmp: TBitmap;
@@ -286,6 +319,81 @@ begin
     bmp.Free;
   end;
 end;
+*)
+
+procedure TMvRGBGraphicsDrawingEngine.TextOut(X, Y: Integer; const AText: String);
+var
+  bmp: TBitmap;
+  ex: TSize;
+  img: TLazIntfImage;
+  i, j: Integer;
+  c: TColor;
+  fc, tc: TFPColor;
+  intens, intens0: Int64;
+  alpha: Double;
+  hb, hm: HBitmap;
+begin
+  if (AText = '') then
+    exit;
+
+  bmp := TBitmap.Create;
+  try
+    bmp.PixelFormat := pf32Bit;
+    bmp.SetSize(1, 1);
+    bmp.Canvas.Font.Name := FFontName;
+    bmp.Canvas.Font.Size := FFontSize;
+    bmp.Canvas.Font.Style := FFontStyle;
+    bmp.Canvas.Font.Color := FFontColor;
+    ex := bmp.Canvas.TextExtent(AText);
+    bmp.SetSize(ex.CX, ex.CY);
+    if GetBrushStyle <> bsClear then begin
+      bmp.Canvas.Brush.Color := GetBrushColor;
+      bmp.Canvas.FillRect(0, 0, bmp.Width, bmp.Height);
+      bmp.Canvas.TextOut(0, 0, AText);
+      DrawBitmap(X, Y, bmp, false);
+    end else
+    begin
+      if FFontColor = clWhite then
+        bmp.Canvas.Brush.Color := clBlack
+      else
+        bmp.Canvas.Brush.Color := clWhite;
+      bmp.Canvas.FillRect(0, 0, bmp.Width, bmp.Height);
+      bmp.Canvas.TextOut(0, 0, AText);
+
+      img := bmp.CreateIntfImage;
+      try
+        fc := TColorToFPColor(bmp.Canvas.Font.Color);
+        intens0 := (fc.Red + fc.Green + fc.Blue);
+        for j := 0 to img.Height - 1 do
+          for i := 0 to img.Width - 1 do begin
+            c := bmp.Canvas.Pixels[i, j];
+            tc := TColorToFPColor(c);
+            if c = bmp.Canvas.Brush.Color then
+              tc.Alpha := alphaTransparent
+            else if c = FFontColor then
+              tc.Alpha := alphaOpaque
+            else begin
+              intens := tc.Red + tc.Green + tc.Blue;
+              if intens0 = 0 then
+                alpha := (3 * alphaopaque - intens) / (3 * alphaOpaque - intens0)
+              else
+                alpha := intens / intens0;
+              tc.Alpha := round(alphaOpaque * alpha);
+            end;
+            img.Colors[i, j] := tc;
+          end;
+        img.CreateBitmaps(hb, hm);
+        bmp.Handle := hb;
+        bmp.MaskHandle := hm;
+        DrawBitmap(X, Y, bmp, true);
+      finally
+        img.Free;
+      end;
+    end;
+  finally
+    bmp.Free;
+  end;
+end;
 
 end.
 

components/lazmapviewer/source/mvde_intfgraphics.pas

@@ -40,6 +40,8 @@ type
   public
     destructor Destroy; override;
     procedure CreateBuffer(AWidth, AHeight: Integer); override;
+    procedure DrawBitmap(X, Y: Integer; ABitmap: TCustomBitmap;
+      UseAlphaChannel: Boolean); override;
     procedure DrawLazIntfImage(X, Y: Integer; AImg: TLazIntfImage); override;
     procedure Ellipse(X1, Y1, X2, Y2: Integer); override;
     procedure FillRect(X1, Y1, X2, Y2: Integer); override;
@@ -55,6 +57,7 @@ type
 implementation
 
 uses
+  LCLType,
   FPImgCanv, GraphType;
 
 {$IF Laz_FullVersion < 1090000}
@@ -137,6 +140,7 @@ begin
   rawImg.Description.Init_BPP32_A8R8G8B8_BIO_TTB(AWidth, AHeight);
   {$ELSE}
   rawImg.Description.Init_BPP32_B8G8R8_BIO_TTB(AWidth, AHeight);
+//  rawImg.Description.Init_BPP32_B8G8R8A8_BIO_TTB(AWidth, AHeight);
   {$ENDIF}
   rawImg.CreateData(True);
   ABuffer := TLazIntfImage.Create(rawImg, true);
@@ -145,6 +149,36 @@ begin
   ACanvas.FillRect(0, 0, AWidth, AHeight);
 end;
 
+procedure TMvIntfGraphicsDrawingEngine.DrawBitmap(X, Y: Integer;
+  ABitmap: TCustomBitmap; UseAlphaChannel: Boolean);
+var
+  intfImg: TLazIntfImage;
+  i, j: Integer;
+  cimg, cbuf: TFPColor;
+  alpha: Double;
+begin
+  intfImg := ABitmap.CreateIntfImage;
+  try
+    if UseAlphaChannel then begin
+      for j := 0 to intfImg.Height - 1 do
+        for i := 0 to intfImg.Width - 1 do begin
+          cimg := intfImg.Colors[i, j];
+          alpha := cimg.Alpha / word($FFFF);
+          cbuf := FBuffer.Colors[i + X, j + Y];
+          cbuf.Red := Round(alpha * cimg.Red + (1 - alpha) * cbuf.Red);
+          cbuf.Green := Round(alpha * cimg.Green + (1 - alpha) * cbuf.Green);
+          cbuf.Blue := Round(alpha * cimg.Blue + (1 - alpha) * cbuf.Blue);
+          FBuffer.Colors[i + X, j + Y] := cbuf;
+        end;
+    end else
+      for j := 0 to intfImg.Height - 1 do
+        for i := 0 to intfImg.Width - 1 do
+          FBuffer.Colors[i + X, j + Y] := intfImg.Colors[i, j];
+  finally
+    intfimg.Free;
+  end;
+end;
+
 procedure TMvIntfGraphicsDrawingEngine.DrawLazIntfImage(X, Y: Integer;
   AImg: TLazIntfImage);
 begin
@@ -323,9 +357,12 @@ var
   bmp: TBitmap;
   ex: TSize;
   img: TLazIntfImage;
-  brClr: TFPColor;
-  imgClr: TFPColor;
   i, j: Integer;
+  hb, hm: HBitmap;
+  c: TColor;
+  fc, tc: TFPColor;
+  intens, intens0: Int64;
+  alpha: Double;
 begin
   if (FCanvas = nil) or (AText = '') then
     exit;
@@ -340,28 +377,49 @@ begin
     bmp.Canvas.Font.Color := FFontColor;
     ex := bmp.Canvas.TextExtent(AText);
     bmp.SetSize(ex.CX, ex.CY);
-    bmp.Canvas.Brush.Color := GetBrushColor;
+    if GetBrushStyle <> bsClear then begin
-    if GetBrushStyle = bsClear then
+      bmp.Canvas.Brush.Color := GetBrushColor;
-      bmp.Canvas.Brush.Style := bsSolid
+      bmp.Canvas.FillRect(0, 0, bmp.Width, bmp.Height);
-    else
+      bmp.Canvas.TextOut(0, 0, AText);
-      bmp.Canvas.Brush.Style := GetBrushStyle;
+      DrawBitmap(X, Y, bmp, false);
-    bmp.Canvas.FillRect(0, 0, bmp.Width, bmp.Height);
+    end else
-    bmp.Canvas.TextOut(0, 0, AText);
+    begin
-    img := bmp.CreateIntfImage;
+      if FFontColor = clWhite then
-    try
+        bmp.Canvas.Brush.Color := clBlack
-      if GetBrushStyle = bsClear then begin
+      else
-        brClr := TColorToFPColor(GetBrushColor);
+        bmp.Canvas.Brush.Color := clWhite;
+      bmp.Canvas.FillRect(0, 0, bmp.Width, bmp.Height);
+      bmp.Canvas.TextOut(0, 0, AText);
+
+      img := bmp.CreateIntfImage;
+      try
+        fc := TColorToFPColor(bmp.Canvas.Font.Color);
+        intens0 := (fc.Red + fc.Green + fc.Blue);
         for j := 0 to img.Height - 1 do
           for i := 0 to img.Width - 1 do begin
-            imgClr := img.Colors[i, j];
+            c := bmp.Canvas.Pixels[i, j];
-            if (imgClr.Red = brClr.Red) and (imgClr.Green = brClr.Green) and (imgClr.Blue = brClr.Blue) then
+            tc := TColorToFPColor(c);
-              Continue;
+            if c = bmp.Canvas.Brush.Color then
-            FCanvas.Colors[X + i, Y + j] := imgClr;
+              tc.Alpha := alphaTransparent
+            else if c = FFontColor then
+              tc.Alpha := alphaOpaque
+            else begin
+              intens := tc.Red + tc.Green + tc.Blue;
+              if intens0 = 0 then
+                alpha := (3 * alphaopaque - intens) / (3 * alphaOpaque - intens0)
+              else
+                alpha := intens / intens0;
+              tc.Alpha := round(alphaOpaque * alpha);
+            end;
+            img.Colors[i, j] := tc;
           end;
-      end else
+        img.CreateBitmaps(hb, hm);
-        FCanvas.Draw(X, Y, img);
+        bmp.Handle := hb;
-    finally
+        bmp.MaskHandle := hm;
-      img.Free;
+        DrawBitmap(X, Y, bmp, true);
+      finally
+        img.Free;
+      end;
     end;
   finally
     bmp.Free;

components/lazmapviewer/source/mvde_lcl.pas

@@ -32,6 +32,8 @@ type
     public
       destructor Destroy; override;
       procedure CreateBuffer(AWidth, AHeight: Integer); override;
+      procedure DrawBitmap(X, Y: Integer; ABitmap: TCustomBitmap;
+        UseAlphaChannel: Boolean); override;
       procedure DrawLazIntfImage(X, Y: Integer; AImg: TLazIntfImage); override;
       procedure Ellipse(X1, Y1, X2, Y2: Integer); override;
       procedure FillRect(X1, Y1, X2, Y2: Integer); override;
@@ -62,6 +64,12 @@ begin
   FBuffer.SetSize(AWidth, AHeight);
 end;
 
+procedure TMvLCLDrawingEngine.DrawBitmap(X, Y: Integer; ABitmap: TCustomBitmap;
+  UseAlphaChannel: Boolean);
+begin
+  FBuffer.Canvas.Draw(X, Y, ABitmap);
+end;
+
 procedure TMvLCLDrawingEngine.DrawLazIntfImage(X, Y: Integer;
   AImg: TLazIntfImage);
 var

components/lazmapviewer/source/mvdrawingengine.pas

@@ -29,6 +29,8 @@ type
 
   public
     procedure CreateBuffer(AWidth, AHeight: Integer); virtual; abstract;
+    procedure DrawBitmap(X, Y: Integer; ABitmap: TCustomBitmap;
+      UseAlphaChannel: Boolean); virtual; abstract;
     procedure DrawLazIntfImage(X, Y: Integer; AImg: TLazIntfImage); virtual; abstract;
     procedure Ellipse(X1, Y1, X2, Y2: Integer); virtual; abstract;
     procedure FillRect(X1, Y1, X2, Y2: Integer); virtual; abstract;

components/lazmapviewer/source/mvmapviewer.pas

@@ -45,6 +45,7 @@ Type
       FGPSItems: TGPSObjectList;
       FInactiveColor: TColor;
       FPOIImage: TBitmap;
+      FPOITextBgColor: TColor;
       FOnDrawGpsPoint: TDrawGpsPointEvent;
       FDebugTiles: Boolean;
       FDefaultTrackColor: TColor;
@@ -66,10 +67,11 @@ Type
       function GetOnZoomChange: TNotifyEvent;
       function GetUseThreads: boolean;
       function GetZoom: integer;
+      function IsCachePathStored: Boolean;
       function IsFontStored: Boolean;
       procedure SetActive(AValue: boolean);
       procedure SetCacheOnDisk(AValue: boolean);
-      procedure SetCachePath({%H-}AValue: String);
+      procedure SetCachePath(AValue: String);
       procedure SetCenter(AValue: TRealPoint);
       procedure SetDebugTiles(AValue: Boolean);
       procedure SetDefaultTrackColor(AValue: TColor);
@@ -82,9 +84,12 @@ Type
       procedure SetOnCenterMove(AValue: TNotifyEvent);
       procedure SetOnChange(AValue: TNotifyEvent);
       procedure SetOnZoomChange(AValue: TNotifyEvent);
+      procedure SetPOIImage(AValue: TBitmap);
+      procedure SetPOITextBgColor(AValue: TColor);
       procedure SetUseThreads(AValue: boolean);
       procedure SetZoom(AValue: integer);
       procedure UpdateFont(Sender: TObject);
+      procedure UpdateImage(Sender: TObject);
 
     protected
       AsyncInvalidate : boolean;
@@ -123,10 +128,10 @@ Type
       property Engine: TMapViewerEngine read FEngine;
       property GPSItems: TGPSObjectList read FGPSItems;
     published
-      property Active: boolean read FActive write SetActive;
+      property Active: boolean read FActive write SetActive default false;
       property Align;
-      property CacheOnDisk: boolean read GetCacheOnDisk write SetCacheOnDisk;
+      property CacheOnDisk: boolean read GetCacheOnDisk write SetCacheOnDisk default true;
-      property CachePath: String read GetCachePath write SetCachePath;
+      property CachePath: String read GetCachePath write SetCachePath stored IsCachePathStored;
       property DebugTiles: Boolean read FDebugTiles write SetDebugTiles default false;
       property DefaultTrackColor: TColor read FDefaultTrackColor write SetDefaultTrackColor default clRed;
       property DefaultTrackWidth: Integer read FDefaultTrackWidth write SetDefaultTrackWidth default 1;
@@ -134,11 +139,12 @@ Type
       property DrawingEngine: TMvCustomDrawingEngine read GetDrawingEngine write SetDrawingEngine;
       property Font: TFont read FFont write SetFont stored IsFontStored;
       property Height default 150;
-      property InactiveColor: TColor read FInactiveColor write SetInactiveColor;
+      property InactiveColor: TColor read FInactiveColor write SetInactiveColor default clWhite;
       property MapProvider: String read GetMapProvider write SetMapProvider;
-      property POIImage: TBitmap read FPOIImage write FPOIImage;
+      property POIImage: TBitmap read FPOIImage write SetPOIImage;
+      property POITextBgColor: TColor read FPOITextBgColor write SetPOITextBgColor default clNone;
       property PopupMenu;
-      property UseThreads: boolean read GetUseThreads write SetUseThreads;
+      property UseThreads: boolean read GetUseThreads write SetUseThreads default false;
       property Width default 150;
       property Zoom: integer read GetZoom write SetZoom;
       property OnCenterMove: TNotifyEvent read GetOnCenterMove write SetOnCenterMove;
@@ -156,7 +162,8 @@ Type
 implementation
 
 uses
-  GraphType, mvJobQueue, mvExtraData, mvDLEFpc, mvDE_IntfGraphics;
+  GraphType, Types,
+  mvJobQueue, mvExtraData, mvDLEFpc, mvDE_IntfGraphics;
 
 type
 
@@ -333,6 +340,11 @@ begin
   result := Engine.Zoom;
 end;
 
+function TMapView.IsCachePathStored: Boolean;
+begin
+  Result := not SameText(CachePath, 'cache/');
+end;
+
 function TMapView.IsFontStored: Boolean;
 begin
   Result := SameText(FFont.Name, 'default') and (FFont.Size = 0) and
@@ -346,7 +358,7 @@ end;
 
 procedure TMapView.SetCachePath(AValue: String);
 begin
-  Engine.CachePath := CachePath;
+  Engine.CachePath := AValue; //CachePath;
 end;
 
 procedure TMapView.SetCenter(AValue: TRealPoint);
@@ -434,6 +446,20 @@ begin
   Engine.OnZoomChange := AValue;
 end;
 
+procedure TMapView.SetPOIImage(AValue: TBitmap);
+begin
+  if FPOIImage = AValue then exit;
+  FPOIImage := AValue;
+  Engine.Redraw;
+end;
+
+procedure TMapView.SetPOITextBgColor(AValue: TColor);
+begin
+  if FPOITextBgColor = AValue then exit;
+  FPOITextBgColor := AValue;
+  Engine.Redraw;
+end;
+
 procedure TMapView.SetUseThreads(AValue: boolean);
 begin
   Engine.UseThreads := aValue;
@@ -575,8 +601,10 @@ end;
 
 procedure TMapView.DrawPt(const Area: TRealArea; aPOI: TGPSPoint);
 var
-  PT: TPoint;
+  Pt: TPoint;
   PtColor: TColor;
+  extent: TSize;
+  s: String;
 begin
   if Assigned(FOnDrawGpsPoint) then begin
     FOnDrawGpsPoint(Self, DrawingEngine, aPOI);
@@ -590,11 +618,28 @@ begin
     if aPOI.ExtraData.inheritsFrom(TDrawingExtraData) then
       PtColor := TDrawingExtraData(aPOI.ExtraData).Color;
   end;
-  DrawingEngine.PenColor := ptColor;
-  DrawingEngine.Line(Pt.X, Pt.Y - 5, Pt.X, Pt.Y + 5);
-  DrawingEngine.Line(Pt.X - 5, Pt.Y, Pt.X + 5, Pt.Y);
 
-//  Buffer.Draw();
+  // 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)
+  else begin
+    DrawingEngine.PenColor := ptColor;
+    DrawingEngine.Line(Pt.X, Pt.Y - 5, Pt.X, Pt.Y + 5);
+    DrawingEngine.Line(Pt.X - 5, Pt.Y, Pt.X + 5, Pt.Y);
+    Pt.Y := Pt.Y + 5;
+  end;
+
+  // Draw point text
+  s := aPOI.Name;
+  if FPOITextBgColor = clNone then
+    DrawingEngine.BrushStyle := bsClear
+  else begin
+    DrawingEngine.BrushStyle := bsSolid;
+    DrawingEngine.BrushColor := FPOITextBgColor;
+    s := ' ' + s + ' ';
+  end;
+  extent := DrawingEngine.TextExtent(s);
+  DrawingEngine.Textout(Pt.X - extent.CX div 2, Pt.Y + 5, s);
 end;
 
 procedure TMapView.CallAsyncInvalidate;
@@ -710,11 +755,16 @@ begin
   FFont.Style := [];
   FFont.Color := clBlack;
   FFont.OnChange := @UpdateFont;
+
+  FPOIImage := TBitmap.Create;
+  FPOIImage.OnChange := @UpdateImage;
+  FPOITextBgColor := clNone;
 end;
 
 destructor TMapView.Destroy;
 begin
   FFont.Free;
+  FreeAndNil(FPOIImage);
   FreeAndNil(FGPSItems);
   inherited Destroy;
 end;
@@ -824,6 +874,10 @@ begin
   Engine.Redraw;
 end;
 
+procedure TMapView.UpdateImage(Sender: TObject);
+begin
+  Engine.Redraw;
+end;
 
 end.