pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

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

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6933 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2019-05-21 22:00:33 +00:00
parent ae1719d0a3
commit c67022ccfa
8 changed files with 399 additions and 57 deletions
Download Patch File Download Diff File Expand all files Collapse all files

84
components/lazmapviewer/example/main.lfm
View File

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

62
components/lazmapviewer/example/main.pas
View File

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

BIN
components/lazmapviewer/example/mapmarker.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 3.8 KiB

110
components/lazmapviewer/source/addons/rgbgraphics_drawingengine/mvde_rgbgraphics.pas
View File

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

86
components/lazmapviewer/source/mvde_intfgraphics.pas
View File

@ -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,29 +377,50 @@ begin
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;
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);
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
if GetBrushStyle = bsClear then begin
brClr := TColorToFPColor(GetBrushColor);
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;
end else
FCanvas.Draw(X, Y, img);
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;

8
components/lazmapviewer/source/mvde_lcl.pas
View File

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

2
components/lazmapviewer/source/mvdrawingengine.pas
View File

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

76
components/lazmapviewer/source/mvmapviewer.pas
View File

@ -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;
// 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;
// Buffer.Draw();
// 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.