diff --git a/components/lazmapviewer/example/main.lfm b/components/lazmapviewer/example/main.lfm index 31a9a9d79..1ba18c62e 100644 --- a/components/lazmapviewer/example/main.lfm +++ b/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 diff --git a/components/lazmapviewer/example/main.pas b/components/lazmapviewer/example/main.pas index e669f7bea..6fc8365af 100644 --- a/components/lazmapviewer/example/main.pas +++ b/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 - ADrawer.BrushColor := clRed; - ADrawer.BrushStyle := bsSolid; - ADrawer.Ellipse(P.X - R, P.Y - R, P.X + R, P.Y + R); - + // Draw the GPS point with MapMarker bitmap + { + if CbShowPOIImage.Checked and not MapView.POIImage.Empty then begin + 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); diff --git a/components/lazmapviewer/example/mapmarker.png b/components/lazmapviewer/example/mapmarker.png new file mode 100644 index 000000000..2bd322068 Binary files /dev/null and b/components/lazmapviewer/example/mapmarker.png differ diff --git a/components/lazmapviewer/source/addons/rgbgraphics_drawingengine/mvde_rgbgraphics.pas b/components/lazmapviewer/source/addons/rgbgraphics_drawingengine/mvde_rgbgraphics.pas index 50eab50be..28a3301f2 100644 --- a/components/lazmapviewer/source/addons/rgbgraphics_drawingengine/mvde_rgbgraphics.pas +++ b/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. diff --git a/components/lazmapviewer/source/mvde_intfgraphics.pas b/components/lazmapviewer/source/mvde_intfgraphics.pas index 5c084c8e4..165652374 100644 --- a/components/lazmapviewer/source/mvde_intfgraphics.pas +++ b/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 - bmp.Canvas.Brush.Style := bsSolid - else - bmp.Canvas.Brush.Style := GetBrushStyle; - bmp.Canvas.FillRect(0, 0, bmp.Width, bmp.Height); - bmp.Canvas.TextOut(0, 0, AText); - img := bmp.CreateIntfImage; - try - if GetBrushStyle = bsClear then begin - brClr := TColorToFPColor(GetBrushColor); + 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 - imgClr := img.Colors[i, j]; - if (imgClr.Red = brClr.Red) and (imgClr.Green = brClr.Green) and (imgClr.Blue = brClr.Blue) then - Continue; - FCanvas.Colors[X + i, Y + j] := imgClr; + 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; - end else - FCanvas.Draw(X, Y, img); - finally - img.Free; + img.CreateBitmaps(hb, hm); + bmp.Handle := hb; + bmp.MaskHandle := hm; + DrawBitmap(X, Y, bmp, true); + finally + img.Free; + end; end; finally bmp.Free; diff --git a/components/lazmapviewer/source/mvde_lcl.pas b/components/lazmapviewer/source/mvde_lcl.pas index fd9e1bfa2..76bb5be92 100644 --- a/components/lazmapviewer/source/mvde_lcl.pas +++ b/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 diff --git a/components/lazmapviewer/source/mvdrawingengine.pas b/components/lazmapviewer/source/mvdrawingengine.pas index b9b942da3..e64a33e6c 100644 --- a/components/lazmapviewer/source/mvdrawingengine.pas +++ b/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; diff --git a/components/lazmapviewer/source/mvmapviewer.pas b/components/lazmapviewer/source/mvmapviewer.pas index 5a9dcf566..e08fc2add 100644 --- a/components/lazmapviewer/source/mvmapviewer.pas +++ b/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 CachePath: String read GetCachePath write SetCachePath; + property CacheOnDisk: boolean read GetCacheOnDisk write SetCacheOnDisk default true; + 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.