You've already forked lazarus-ccr
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
This commit is contained in:
@ -17,22 +17,17 @@ object MainForm: TMainForm
|
|||||||
Hint = 'Displays the map'
|
Hint = 'Displays the map'
|
||||||
Top = 0
|
Top = 0
|
||||||
Width = 608
|
Width = 608
|
||||||
Active = False
|
|
||||||
Align = alClient
|
Align = alClient
|
||||||
CacheOnDisk = True
|
|
||||||
CachePath = 'cache/'
|
|
||||||
DefaultTrackColor = clBlue
|
DefaultTrackColor = clBlue
|
||||||
DefaultTrackWidth = 3
|
DefaultTrackWidth = 3
|
||||||
DownloadEngine = MapView.BuiltInDLE
|
DownloadEngine = MapView.BuiltInDLE
|
||||||
DrawingEngine = MapView.BuiltInDE
|
DrawingEngine = MapView.BuiltInDE
|
||||||
Font.Color = clBlack
|
Font.Color = clBlack
|
||||||
InactiveColor = clWhite
|
|
||||||
MapProvider = 'OpenStreetMap Mapnik'
|
MapProvider = 'OpenStreetMap Mapnik'
|
||||||
UseThreads = True
|
UseThreads = True
|
||||||
Zoom = 0
|
Zoom = 0
|
||||||
OnZoomChange = MapViewZoomChange
|
OnZoomChange = MapViewZoomChange
|
||||||
OnChange = MapViewChange
|
OnChange = MapViewChange
|
||||||
OnDrawGpsPoint = MapViewDrawGpsPoint
|
|
||||||
OnMouseLeave = MapViewMouseLeave
|
OnMouseLeave = MapViewMouseLeave
|
||||||
OnMouseMove = MapViewMouseMove
|
OnMouseMove = MapViewMouseMove
|
||||||
OnMouseUp = MapViewMouseUp
|
OnMouseUp = MapViewMouseUp
|
||||||
@ -573,7 +568,6 @@ object MainForm: TMainForm
|
|||||||
ItemIndex = 0
|
ItemIndex = 0
|
||||||
Items.Strings = (
|
Items.Strings = (
|
||||||
'default'
|
'default'
|
||||||
'LCL'
|
|
||||||
'RGBGraphics'
|
'RGBGraphics'
|
||||||
)
|
)
|
||||||
OnChange = CbDrawingEngineChange
|
OnChange = CbDrawingEngineChange
|
||||||
@ -758,6 +752,78 @@ object MainForm: TMainForm
|
|||||||
OnChange = CbDebugTilesChange
|
OnChange = CbDebugTilesChange
|
||||||
TabOrder = 4
|
TabOrder = 4
|
||||||
end
|
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
|
||||||
end
|
end
|
||||||
object GeoNames: TMVGeoNames
|
object GeoNames: TMVGeoNames
|
||||||
@ -771,4 +837,10 @@ object MainForm: TMainForm
|
|||||||
left = 240
|
left = 240
|
||||||
top = 456
|
top = 456
|
||||||
end
|
end
|
||||||
|
object FontDialog: TFontDialog
|
||||||
|
MinFontSize = 0
|
||||||
|
MaxFontSize = 0
|
||||||
|
left = 648
|
||||||
|
top = 280
|
||||||
|
end
|
||||||
end
|
end
|
||||||
|
@ -6,20 +6,22 @@ interface
|
|||||||
|
|
||||||
uses
|
uses
|
||||||
Classes, SysUtils, Types, Forms, Controls, Graphics, Dialogs,
|
Classes, SysUtils, Types, Forms, Controls, Graphics, Dialogs,
|
||||||
ExtCtrls, StdCtrls, ComCtrls, Buttons,
|
ExtCtrls, StdCtrls, ComCtrls, Buttons, IntfGraphics, ColorBox,
|
||||||
mvGeoNames, mvMapViewer, mvTypes, mvGpsObj, mvDrawingEngine,
|
mvGeoNames, mvMapViewer, mvTypes, mvGpsObj, mvDrawingEngine,
|
||||||
mvDE_LCL, mvDE_RGBGraphics;
|
mvDE_RGBGraphics;
|
||||||
|
|
||||||
type
|
type
|
||||||
|
|
||||||
{ TMainForm }
|
{ TMainForm }
|
||||||
|
|
||||||
TMainForm = class(TForm)
|
TMainForm = class(TForm)
|
||||||
|
Bevel1: TBevel;
|
||||||
BtnSearch: TButton;
|
BtnSearch: TButton;
|
||||||
BtnGoTo: TButton;
|
BtnGoTo: TButton;
|
||||||
BtnGPSPoints: TButton;
|
BtnGPSPoints: TButton;
|
||||||
BtnSaveToFile: TButton;
|
BtnSaveToFile: TButton;
|
||||||
BtnLoadGPXFile: TButton;
|
BtnLoadGPXFile: TButton;
|
||||||
|
BtnPOITextFont: TButton;
|
||||||
CbDoubleBuffer: TCheckBox;
|
CbDoubleBuffer: TCheckBox;
|
||||||
CbFoundLocations: TComboBox;
|
CbFoundLocations: TComboBox;
|
||||||
CbLocations: TComboBox;
|
CbLocations: TComboBox;
|
||||||
@ -29,6 +31,9 @@ type
|
|||||||
CbDistanceUnits: TComboBox;
|
CbDistanceUnits: TComboBox;
|
||||||
CbDebugTiles: TCheckBox;
|
CbDebugTiles: TCheckBox;
|
||||||
CbDrawingEngine: TComboBox;
|
CbDrawingEngine: TComboBox;
|
||||||
|
CbShowPOIImage: TCheckBox;
|
||||||
|
cbPOITextBgColor: TColorBox;
|
||||||
|
FontDialog: TFontDialog;
|
||||||
GbCenterCoords: TGroupBox;
|
GbCenterCoords: TGroupBox;
|
||||||
GbScreenSize: TGroupBox;
|
GbScreenSize: TGroupBox;
|
||||||
GbSearch: TGroupBox;
|
GbSearch: TGroupBox;
|
||||||
@ -40,6 +45,7 @@ type
|
|||||||
GPSPointInfo: TLabel;
|
GPSPointInfo: TLabel;
|
||||||
InfoViewportWidth: TLabel;
|
InfoViewportWidth: TLabel;
|
||||||
Label1: TLabel;
|
Label1: TLabel;
|
||||||
|
LblPOITextBgColor: TLabel;
|
||||||
LblSelectLocation: TLabel;
|
LblSelectLocation: TLabel;
|
||||||
LblCenterLatitude: TLabel;
|
LblCenterLatitude: TLabel;
|
||||||
LblViewportHeight: TLabel;
|
LblViewportHeight: TLabel;
|
||||||
@ -65,12 +71,15 @@ type
|
|||||||
procedure BtnSearchClick(Sender: TObject);
|
procedure BtnSearchClick(Sender: TObject);
|
||||||
procedure BtnGPSPointsClick(Sender: TObject);
|
procedure BtnGPSPointsClick(Sender: TObject);
|
||||||
procedure BtnSaveToFileClick(Sender: TObject);
|
procedure BtnSaveToFileClick(Sender: TObject);
|
||||||
|
procedure BtnPOITextFontClick(Sender: TObject);
|
||||||
procedure CbDebugTilesChange(Sender: TObject);
|
procedure CbDebugTilesChange(Sender: TObject);
|
||||||
procedure CbDrawingEngineChange(Sender: TObject);
|
procedure CbDrawingEngineChange(Sender: TObject);
|
||||||
procedure CbDoubleBufferChange(Sender: TObject);
|
procedure CbDoubleBufferChange(Sender: TObject);
|
||||||
procedure CbFoundLocationsDrawItem(Control: TWinControl; Index: Integer;
|
procedure CbFoundLocationsDrawItem(Control: TWinControl; Index: Integer;
|
||||||
ARect: TRect; State: TOwnerDrawState);
|
ARect: TRect; State: TOwnerDrawState);
|
||||||
|
procedure cbPOITextBgColorChange(Sender: TObject);
|
||||||
procedure CbProvidersChange(Sender: TObject);
|
procedure CbProvidersChange(Sender: TObject);
|
||||||
|
procedure CbShowPOIImageChange(Sender: TObject);
|
||||||
procedure CbUseThreadsChange(Sender: TObject);
|
procedure CbUseThreadsChange(Sender: TObject);
|
||||||
procedure CbDistanceUnitsChange(Sender: TObject);
|
procedure CbDistanceUnitsChange(Sender: TObject);
|
||||||
procedure FormCreate(Sender: TObject);
|
procedure FormCreate(Sender: TObject);
|
||||||
@ -81,7 +90,6 @@ type
|
|||||||
procedure MapViewChange(Sender: TObject);
|
procedure MapViewChange(Sender: TObject);
|
||||||
procedure MapViewDrawGpsPoint(Sender: TObject;
|
procedure MapViewDrawGpsPoint(Sender: TObject;
|
||||||
ADrawer: TMvCustomDrawingEngine; APoint: TGpsPoint);
|
ADrawer: TMvCustomDrawingEngine; APoint: TGpsPoint);
|
||||||
// procedure MapViewDrawGpsPoint(Sender, ACanvas: TObject; APoint: TGpsPoint);
|
|
||||||
procedure MapViewMouseLeave(Sender: TObject);
|
procedure MapViewMouseLeave(Sender: TObject);
|
||||||
procedure MapViewMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
|
procedure MapViewMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
|
||||||
procedure MapViewMouseUp(Sender: TObject; Button: TMouseButton;
|
procedure MapViewMouseUp(Sender: TObject; Button: TMouseButton;
|
||||||
@ -92,8 +100,8 @@ type
|
|||||||
procedure ZoomTrackBarChange(Sender: TObject);
|
procedure ZoomTrackBarChange(Sender: TObject);
|
||||||
|
|
||||||
private
|
private
|
||||||
FLCLDrawingEngine: TMvLCLDrawingEngine;
|
|
||||||
FRGBGraphicsDrawingEngine: TMvRGBGraphicsDrawingEngine;
|
FRGBGraphicsDrawingEngine: TMvRGBGraphicsDrawingEngine;
|
||||||
|
POIImage: TCustomBitmap;
|
||||||
procedure ClearFoundLocations;
|
procedure ClearFoundLocations;
|
||||||
procedure UpdateCoords(X, Y: Integer);
|
procedure UpdateCoords(X, Y: Integer);
|
||||||
procedure UpdateDropdownWidth(ACombobox: TCombobox);
|
procedure UpdateDropdownWidth(ACombobox: TCombobox);
|
||||||
@ -114,7 +122,7 @@ implementation
|
|||||||
{$R *.lfm}
|
{$R *.lfm}
|
||||||
|
|
||||||
uses
|
uses
|
||||||
LCLType, IniFiles, Math, FPCanvas, FPImage, IntfGraphics,
|
LCLType, IniFiles, Math, FPCanvas, FPImage, FpImgCanv, GraphType,
|
||||||
mvEngine, mvGPX,
|
mvEngine, mvGPX,
|
||||||
globals, gpslistform;
|
globals, gpslistform;
|
||||||
|
|
||||||
@ -231,6 +239,13 @@ begin
|
|||||||
ShowMessage('Map saved to "mapview.png".');
|
ShowMessage('Map saved to "mapview.png".');
|
||||||
end;
|
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);
|
procedure TMainForm.CbDebugTilesChange(Sender: TObject);
|
||||||
begin
|
begin
|
||||||
MapView.DebugTiles := CbDebugTiles.Checked;
|
MapView.DebugTiles := CbDebugTiles.Checked;
|
||||||
@ -241,10 +256,6 @@ begin
|
|||||||
case CbDrawingEngine.ItemIndex of
|
case CbDrawingEngine.ItemIndex of
|
||||||
0: MapView.DrawingEngine := nil;
|
0: MapView.DrawingEngine := nil;
|
||||||
1: begin
|
1: begin
|
||||||
if FLCLDrawingEngine = nil then FLCLDrawingEngine := TMvLCLDrawingEngine.Create(self);
|
|
||||||
MapView.DrawingEngine := FLCLDrawingEngine;
|
|
||||||
end;
|
|
||||||
2: begin
|
|
||||||
if FRGBGraphicsDrawingEngine = nil then
|
if FRGBGraphicsDrawingEngine = nil then
|
||||||
FRGBGraphicsDrawingEngine := TMvRGBGraphicsDrawingEngine.Create(self);
|
FRGBGraphicsDrawingEngine := TMvRGBGraphicsDrawingEngine.Create(self);
|
||||||
MapView.DrawingEngine := FRGBGraphicsDrawingEngine;
|
MapView.DrawingEngine := FRGBGraphicsDrawingEngine;
|
||||||
@ -286,11 +297,24 @@ begin
|
|||||||
combo.Canvas.TextOut(x, y, P.Descr);
|
combo.Canvas.TextOut(x, y, P.Descr);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure TMainForm.cbPOITextBgColorChange(Sender: TObject);
|
||||||
|
begin
|
||||||
|
MapView.POITextBgColor := cbPOITextBgColor.Selected;
|
||||||
|
end;
|
||||||
|
|
||||||
procedure TMainForm.CbProvidersChange(Sender: TObject);
|
procedure TMainForm.CbProvidersChange(Sender: TObject);
|
||||||
begin
|
begin
|
||||||
MapView.MapProvider := CbProviders.Text;
|
MapView.MapProvider := CbProviders.Text;
|
||||||
end;
|
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);
|
procedure TMainForm.CbUseThreadsChange(Sender: TObject);
|
||||||
begin
|
begin
|
||||||
MapView.UseThreads := CbUseThreads.Checked;
|
MapView.UseThreads := CbUseThreads.Checked;
|
||||||
@ -316,6 +340,11 @@ end;
|
|||||||
|
|
||||||
procedure TMainForm.FormCreate(Sender: TObject);
|
procedure TMainForm.FormCreate(Sender: TObject);
|
||||||
begin
|
begin
|
||||||
|
// FMapMarker := CreateMapMarker(32, clRed, clBlack);
|
||||||
|
POIImage := TPortableNetworkGraphic.Create;
|
||||||
|
POIImage.PixelFormat := pf32bit;
|
||||||
|
POIImage.LoadFromFile('../../mapmarker.png');
|
||||||
|
|
||||||
ForceDirectories(HOMEDIR + 'cache/');
|
ForceDirectories(HOMEDIR + 'cache/');
|
||||||
MapView.CachePath := HOMEDIR + 'cache/';
|
MapView.CachePath := HOMEDIR + 'cache/';
|
||||||
MapView.GetMapProviders(CbProviders.Items);
|
MapView.GetMapProviders(CbProviders.Items);
|
||||||
@ -324,6 +353,7 @@ begin
|
|||||||
MapView.Zoom := 1;
|
MapView.Zoom := 1;
|
||||||
CbUseThreads.Checked := MapView.UseThreads;
|
CbUseThreads.Checked := MapView.UseThreads;
|
||||||
CbDoubleBuffer.Checked := MapView.DoubleBuffered;
|
CbDoubleBuffer.Checked := MapView.DoubleBuffered;
|
||||||
|
CbPOITextBgColor.Selected := MapView.POITextBgColor;
|
||||||
|
|
||||||
InfoPositionLongitude.Caption := '';
|
InfoPositionLongitude.Caption := '';
|
||||||
InfoPositionLatitude.Caption := '';
|
InfoPositionLatitude.Caption := '';
|
||||||
@ -340,6 +370,7 @@ procedure TMainForm.FormDestroy(Sender: TObject);
|
|||||||
begin
|
begin
|
||||||
WriteToIni;
|
WriteToIni;
|
||||||
ClearFoundLocations;
|
ClearFoundLocations;
|
||||||
|
FreeAndNil(POIImage)
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TMainForm.FormShow(Sender: TObject);
|
procedure TMainForm.FormShow(Sender: TObject);
|
||||||
@ -374,16 +405,25 @@ begin
|
|||||||
// Screen coordinates of the GPS point
|
// Screen coordinates of the GPS point
|
||||||
P := TMapView(Sender).LonLatToScreen(APoint.RealPoint);
|
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
|
// Draw the GPS point as a circle
|
||||||
ADrawer.BrushColor := clRed;
|
ADrawer.BrushColor := clRed;
|
||||||
ADrawer.BrushStyle := bsSolid;
|
ADrawer.BrushStyle := bsSolid;
|
||||||
ADrawer.Ellipse(P.X - R, P.Y - R, P.X + R, P.Y + R);
|
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
|
// Draw the caption of the GPS point
|
||||||
ext := ADrawer.TextExtent(APoint.Name);
|
ext := ADrawer.TextExtent(APoint.Name);
|
||||||
ADrawer.BrushColor := clWhite;
|
ADrawer.BrushColor := clWhite;
|
||||||
ADrawer.BrushStyle := bsClear;
|
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;
|
end;
|
||||||
|
|
||||||
procedure TMainForm.MapViewMouseLeave(Sender: TObject);
|
procedure TMainForm.MapViewMouseLeave(Sender: TObject);
|
||||||
|
BIN
components/lazmapviewer/example/mapmarker.png
Normal file
BIN
components/lazmapviewer/example/mapmarker.png
Normal file
Binary file not shown.
After Width: | Height: | Size: 3.8 KiB |
@ -42,6 +42,8 @@ type
|
|||||||
public
|
public
|
||||||
destructor Destroy; override;
|
destructor Destroy; override;
|
||||||
procedure CreateBuffer(AWidth, AHeight: Integer); 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 DrawLazIntfImage(X, Y: Integer; AImg: TLazIntfImage); override;
|
||||||
procedure Ellipse(X1, Y1, X2, Y2: Integer); override;
|
procedure Ellipse(X1, Y1, X2, Y2: Integer); override;
|
||||||
procedure FillRect(X1, Y1, X2, Y2: Integer); override;
|
procedure FillRect(X1, Y1, X2, Y2: Integer); override;
|
||||||
@ -59,7 +61,7 @@ procedure Register;
|
|||||||
implementation
|
implementation
|
||||||
|
|
||||||
uses
|
uses
|
||||||
GraphType, FPImage,
|
GraphType, LCLType, FPImage,
|
||||||
mvTypes;
|
mvTypes;
|
||||||
|
|
||||||
procedure Register;
|
procedure Register;
|
||||||
@ -79,6 +81,36 @@ begin
|
|||||||
FBuffer := TRGB32Bitmap.Create(AWidth, AHeight);
|
FBuffer := TRGB32Bitmap.Create(AWidth, AHeight);
|
||||||
end;
|
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;
|
procedure TMvRGBGraphicsDrawingEngine.DrawLazIntfImage(X, Y: Integer;
|
||||||
AImg: TLazIntfImage);
|
AImg: TLazIntfImage);
|
||||||
//http://mantis.freepascal.org/view.php?id=27144
|
//http://mantis.freepascal.org/view.php?id=27144
|
||||||
@ -235,6 +267,7 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
(*
|
||||||
procedure TMvRGBGraphicsDrawingEngine.TextOut(X, Y: Integer; const AText: String);
|
procedure TMvRGBGraphicsDrawingEngine.TextOut(X, Y: Integer; const AText: String);
|
||||||
var
|
var
|
||||||
bmp: TBitmap;
|
bmp: TBitmap;
|
||||||
@ -286,6 +319,81 @@ begin
|
|||||||
bmp.Free;
|
bmp.Free;
|
||||||
end;
|
end;
|
||||||
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.
|
end.
|
||||||
|
|
||||||
|
@ -40,6 +40,8 @@ type
|
|||||||
public
|
public
|
||||||
destructor Destroy; override;
|
destructor Destroy; override;
|
||||||
procedure CreateBuffer(AWidth, AHeight: Integer); 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 DrawLazIntfImage(X, Y: Integer; AImg: TLazIntfImage); override;
|
||||||
procedure Ellipse(X1, Y1, X2, Y2: Integer); override;
|
procedure Ellipse(X1, Y1, X2, Y2: Integer); override;
|
||||||
procedure FillRect(X1, Y1, X2, Y2: Integer); override;
|
procedure FillRect(X1, Y1, X2, Y2: Integer); override;
|
||||||
@ -55,6 +57,7 @@ type
|
|||||||
implementation
|
implementation
|
||||||
|
|
||||||
uses
|
uses
|
||||||
|
LCLType,
|
||||||
FPImgCanv, GraphType;
|
FPImgCanv, GraphType;
|
||||||
|
|
||||||
{$IF Laz_FullVersion < 1090000}
|
{$IF Laz_FullVersion < 1090000}
|
||||||
@ -137,6 +140,7 @@ begin
|
|||||||
rawImg.Description.Init_BPP32_A8R8G8B8_BIO_TTB(AWidth, AHeight);
|
rawImg.Description.Init_BPP32_A8R8G8B8_BIO_TTB(AWidth, AHeight);
|
||||||
{$ELSE}
|
{$ELSE}
|
||||||
rawImg.Description.Init_BPP32_B8G8R8_BIO_TTB(AWidth, AHeight);
|
rawImg.Description.Init_BPP32_B8G8R8_BIO_TTB(AWidth, AHeight);
|
||||||
|
// rawImg.Description.Init_BPP32_B8G8R8A8_BIO_TTB(AWidth, AHeight);
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
rawImg.CreateData(True);
|
rawImg.CreateData(True);
|
||||||
ABuffer := TLazIntfImage.Create(rawImg, true);
|
ABuffer := TLazIntfImage.Create(rawImg, true);
|
||||||
@ -145,6 +149,36 @@ begin
|
|||||||
ACanvas.FillRect(0, 0, AWidth, AHeight);
|
ACanvas.FillRect(0, 0, AWidth, AHeight);
|
||||||
end;
|
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;
|
procedure TMvIntfGraphicsDrawingEngine.DrawLazIntfImage(X, Y: Integer;
|
||||||
AImg: TLazIntfImage);
|
AImg: TLazIntfImage);
|
||||||
begin
|
begin
|
||||||
@ -323,9 +357,12 @@ var
|
|||||||
bmp: TBitmap;
|
bmp: TBitmap;
|
||||||
ex: TSize;
|
ex: TSize;
|
||||||
img: TLazIntfImage;
|
img: TLazIntfImage;
|
||||||
brClr: TFPColor;
|
|
||||||
imgClr: TFPColor;
|
|
||||||
i, j: Integer;
|
i, j: Integer;
|
||||||
|
hb, hm: HBitmap;
|
||||||
|
c: TColor;
|
||||||
|
fc, tc: TFPColor;
|
||||||
|
intens, intens0: Int64;
|
||||||
|
alpha: Double;
|
||||||
begin
|
begin
|
||||||
if (FCanvas = nil) or (AText = '') then
|
if (FCanvas = nil) or (AText = '') then
|
||||||
exit;
|
exit;
|
||||||
@ -340,29 +377,50 @@ begin
|
|||||||
bmp.Canvas.Font.Color := FFontColor;
|
bmp.Canvas.Font.Color := FFontColor;
|
||||||
ex := bmp.Canvas.TextExtent(AText);
|
ex := bmp.Canvas.TextExtent(AText);
|
||||||
bmp.SetSize(ex.CX, ex.CY);
|
bmp.SetSize(ex.CX, ex.CY);
|
||||||
|
if GetBrushStyle <> bsClear then begin
|
||||||
bmp.Canvas.Brush.Color := GetBrushColor;
|
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.FillRect(0, 0, bmp.Width, bmp.Height);
|
||||||
bmp.Canvas.TextOut(0, 0, AText);
|
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;
|
img := bmp.CreateIntfImage;
|
||||||
try
|
try
|
||||||
if GetBrushStyle = bsClear then begin
|
fc := TColorToFPColor(bmp.Canvas.Font.Color);
|
||||||
brClr := TColorToFPColor(GetBrushColor);
|
intens0 := (fc.Red + fc.Green + fc.Blue);
|
||||||
for j := 0 to img.Height - 1 do
|
for j := 0 to img.Height - 1 do
|
||||||
for i := 0 to img.Width - 1 do begin
|
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;
|
end;
|
||||||
end else
|
img.Colors[i, j] := tc;
|
||||||
FCanvas.Draw(X, Y, img);
|
end;
|
||||||
|
img.CreateBitmaps(hb, hm);
|
||||||
|
bmp.Handle := hb;
|
||||||
|
bmp.MaskHandle := hm;
|
||||||
|
DrawBitmap(X, Y, bmp, true);
|
||||||
finally
|
finally
|
||||||
img.Free;
|
img.Free;
|
||||||
end;
|
end;
|
||||||
|
end;
|
||||||
finally
|
finally
|
||||||
bmp.Free;
|
bmp.Free;
|
||||||
end;
|
end;
|
||||||
|
@ -32,6 +32,8 @@ type
|
|||||||
public
|
public
|
||||||
destructor Destroy; override;
|
destructor Destroy; override;
|
||||||
procedure CreateBuffer(AWidth, AHeight: Integer); 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 DrawLazIntfImage(X, Y: Integer; AImg: TLazIntfImage); override;
|
||||||
procedure Ellipse(X1, Y1, X2, Y2: Integer); override;
|
procedure Ellipse(X1, Y1, X2, Y2: Integer); override;
|
||||||
procedure FillRect(X1, Y1, X2, Y2: Integer); override;
|
procedure FillRect(X1, Y1, X2, Y2: Integer); override;
|
||||||
@ -62,6 +64,12 @@ begin
|
|||||||
FBuffer.SetSize(AWidth, AHeight);
|
FBuffer.SetSize(AWidth, AHeight);
|
||||||
end;
|
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;
|
procedure TMvLCLDrawingEngine.DrawLazIntfImage(X, Y: Integer;
|
||||||
AImg: TLazIntfImage);
|
AImg: TLazIntfImage);
|
||||||
var
|
var
|
||||||
|
@ -29,6 +29,8 @@ type
|
|||||||
|
|
||||||
public
|
public
|
||||||
procedure CreateBuffer(AWidth, AHeight: Integer); virtual; abstract;
|
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 DrawLazIntfImage(X, Y: Integer; AImg: TLazIntfImage); virtual; abstract;
|
||||||
procedure Ellipse(X1, Y1, X2, Y2: Integer); virtual; abstract;
|
procedure Ellipse(X1, Y1, X2, Y2: Integer); virtual; abstract;
|
||||||
procedure FillRect(X1, Y1, X2, Y2: Integer); virtual; abstract;
|
procedure FillRect(X1, Y1, X2, Y2: Integer); virtual; abstract;
|
||||||
|
@ -45,6 +45,7 @@ Type
|
|||||||
FGPSItems: TGPSObjectList;
|
FGPSItems: TGPSObjectList;
|
||||||
FInactiveColor: TColor;
|
FInactiveColor: TColor;
|
||||||
FPOIImage: TBitmap;
|
FPOIImage: TBitmap;
|
||||||
|
FPOITextBgColor: TColor;
|
||||||
FOnDrawGpsPoint: TDrawGpsPointEvent;
|
FOnDrawGpsPoint: TDrawGpsPointEvent;
|
||||||
FDebugTiles: Boolean;
|
FDebugTiles: Boolean;
|
||||||
FDefaultTrackColor: TColor;
|
FDefaultTrackColor: TColor;
|
||||||
@ -66,10 +67,11 @@ Type
|
|||||||
function GetOnZoomChange: TNotifyEvent;
|
function GetOnZoomChange: TNotifyEvent;
|
||||||
function GetUseThreads: boolean;
|
function GetUseThreads: boolean;
|
||||||
function GetZoom: integer;
|
function GetZoom: integer;
|
||||||
|
function IsCachePathStored: Boolean;
|
||||||
function IsFontStored: Boolean;
|
function IsFontStored: Boolean;
|
||||||
procedure SetActive(AValue: boolean);
|
procedure SetActive(AValue: boolean);
|
||||||
procedure SetCacheOnDisk(AValue: boolean);
|
procedure SetCacheOnDisk(AValue: boolean);
|
||||||
procedure SetCachePath({%H-}AValue: String);
|
procedure SetCachePath(AValue: String);
|
||||||
procedure SetCenter(AValue: TRealPoint);
|
procedure SetCenter(AValue: TRealPoint);
|
||||||
procedure SetDebugTiles(AValue: Boolean);
|
procedure SetDebugTiles(AValue: Boolean);
|
||||||
procedure SetDefaultTrackColor(AValue: TColor);
|
procedure SetDefaultTrackColor(AValue: TColor);
|
||||||
@ -82,9 +84,12 @@ Type
|
|||||||
procedure SetOnCenterMove(AValue: TNotifyEvent);
|
procedure SetOnCenterMove(AValue: TNotifyEvent);
|
||||||
procedure SetOnChange(AValue: TNotifyEvent);
|
procedure SetOnChange(AValue: TNotifyEvent);
|
||||||
procedure SetOnZoomChange(AValue: TNotifyEvent);
|
procedure SetOnZoomChange(AValue: TNotifyEvent);
|
||||||
|
procedure SetPOIImage(AValue: TBitmap);
|
||||||
|
procedure SetPOITextBgColor(AValue: TColor);
|
||||||
procedure SetUseThreads(AValue: boolean);
|
procedure SetUseThreads(AValue: boolean);
|
||||||
procedure SetZoom(AValue: integer);
|
procedure SetZoom(AValue: integer);
|
||||||
procedure UpdateFont(Sender: TObject);
|
procedure UpdateFont(Sender: TObject);
|
||||||
|
procedure UpdateImage(Sender: TObject);
|
||||||
|
|
||||||
protected
|
protected
|
||||||
AsyncInvalidate : boolean;
|
AsyncInvalidate : boolean;
|
||||||
@ -123,10 +128,10 @@ Type
|
|||||||
property Engine: TMapViewerEngine read FEngine;
|
property Engine: TMapViewerEngine read FEngine;
|
||||||
property GPSItems: TGPSObjectList read FGPSItems;
|
property GPSItems: TGPSObjectList read FGPSItems;
|
||||||
published
|
published
|
||||||
property Active: boolean read FActive write SetActive;
|
property Active: boolean read FActive write SetActive default false;
|
||||||
property Align;
|
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 DebugTiles: Boolean read FDebugTiles write SetDebugTiles default false;
|
||||||
property DefaultTrackColor: TColor read FDefaultTrackColor write SetDefaultTrackColor default clRed;
|
property DefaultTrackColor: TColor read FDefaultTrackColor write SetDefaultTrackColor default clRed;
|
||||||
property DefaultTrackWidth: Integer read FDefaultTrackWidth write SetDefaultTrackWidth default 1;
|
property DefaultTrackWidth: Integer read FDefaultTrackWidth write SetDefaultTrackWidth default 1;
|
||||||
@ -134,11 +139,12 @@ Type
|
|||||||
property DrawingEngine: TMvCustomDrawingEngine read GetDrawingEngine write SetDrawingEngine;
|
property DrawingEngine: TMvCustomDrawingEngine read GetDrawingEngine write SetDrawingEngine;
|
||||||
property Font: TFont read FFont write SetFont stored IsFontStored;
|
property Font: TFont read FFont write SetFont stored IsFontStored;
|
||||||
property Height default 150;
|
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 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 PopupMenu;
|
||||||
property UseThreads: boolean read GetUseThreads write SetUseThreads;
|
property UseThreads: boolean read GetUseThreads write SetUseThreads default false;
|
||||||
property Width default 150;
|
property Width default 150;
|
||||||
property Zoom: integer read GetZoom write SetZoom;
|
property Zoom: integer read GetZoom write SetZoom;
|
||||||
property OnCenterMove: TNotifyEvent read GetOnCenterMove write SetOnCenterMove;
|
property OnCenterMove: TNotifyEvent read GetOnCenterMove write SetOnCenterMove;
|
||||||
@ -156,7 +162,8 @@ Type
|
|||||||
implementation
|
implementation
|
||||||
|
|
||||||
uses
|
uses
|
||||||
GraphType, mvJobQueue, mvExtraData, mvDLEFpc, mvDE_IntfGraphics;
|
GraphType, Types,
|
||||||
|
mvJobQueue, mvExtraData, mvDLEFpc, mvDE_IntfGraphics;
|
||||||
|
|
||||||
type
|
type
|
||||||
|
|
||||||
@ -333,6 +340,11 @@ begin
|
|||||||
result := Engine.Zoom;
|
result := Engine.Zoom;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
function TMapView.IsCachePathStored: Boolean;
|
||||||
|
begin
|
||||||
|
Result := not SameText(CachePath, 'cache/');
|
||||||
|
end;
|
||||||
|
|
||||||
function TMapView.IsFontStored: Boolean;
|
function TMapView.IsFontStored: Boolean;
|
||||||
begin
|
begin
|
||||||
Result := SameText(FFont.Name, 'default') and (FFont.Size = 0) and
|
Result := SameText(FFont.Name, 'default') and (FFont.Size = 0) and
|
||||||
@ -346,7 +358,7 @@ end;
|
|||||||
|
|
||||||
procedure TMapView.SetCachePath(AValue: String);
|
procedure TMapView.SetCachePath(AValue: String);
|
||||||
begin
|
begin
|
||||||
Engine.CachePath := CachePath;
|
Engine.CachePath := AValue; //CachePath;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TMapView.SetCenter(AValue: TRealPoint);
|
procedure TMapView.SetCenter(AValue: TRealPoint);
|
||||||
@ -434,6 +446,20 @@ begin
|
|||||||
Engine.OnZoomChange := AValue;
|
Engine.OnZoomChange := AValue;
|
||||||
end;
|
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);
|
procedure TMapView.SetUseThreads(AValue: boolean);
|
||||||
begin
|
begin
|
||||||
Engine.UseThreads := aValue;
|
Engine.UseThreads := aValue;
|
||||||
@ -575,8 +601,10 @@ end;
|
|||||||
|
|
||||||
procedure TMapView.DrawPt(const Area: TRealArea; aPOI: TGPSPoint);
|
procedure TMapView.DrawPt(const Area: TRealArea; aPOI: TGPSPoint);
|
||||||
var
|
var
|
||||||
PT: TPoint;
|
Pt: TPoint;
|
||||||
PtColor: TColor;
|
PtColor: TColor;
|
||||||
|
extent: TSize;
|
||||||
|
s: String;
|
||||||
begin
|
begin
|
||||||
if Assigned(FOnDrawGpsPoint) then begin
|
if Assigned(FOnDrawGpsPoint) then begin
|
||||||
FOnDrawGpsPoint(Self, DrawingEngine, aPOI);
|
FOnDrawGpsPoint(Self, DrawingEngine, aPOI);
|
||||||
@ -590,11 +618,28 @@ begin
|
|||||||
if aPOI.ExtraData.inheritsFrom(TDrawingExtraData) then
|
if aPOI.ExtraData.inheritsFrom(TDrawingExtraData) then
|
||||||
PtColor := TDrawingExtraData(aPOI.ExtraData).Color;
|
PtColor := TDrawingExtraData(aPOI.ExtraData).Color;
|
||||||
end;
|
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.PenColor := ptColor;
|
||||||
DrawingEngine.Line(Pt.X, Pt.Y - 5, Pt.X, Pt.Y + 5);
|
DrawingEngine.Line(Pt.X, Pt.Y - 5, Pt.X, Pt.Y + 5);
|
||||||
DrawingEngine.Line(Pt.X - 5, Pt.Y, Pt.X + 5, Pt.Y);
|
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;
|
end;
|
||||||
|
|
||||||
procedure TMapView.CallAsyncInvalidate;
|
procedure TMapView.CallAsyncInvalidate;
|
||||||
@ -710,11 +755,16 @@ begin
|
|||||||
FFont.Style := [];
|
FFont.Style := [];
|
||||||
FFont.Color := clBlack;
|
FFont.Color := clBlack;
|
||||||
FFont.OnChange := @UpdateFont;
|
FFont.OnChange := @UpdateFont;
|
||||||
|
|
||||||
|
FPOIImage := TBitmap.Create;
|
||||||
|
FPOIImage.OnChange := @UpdateImage;
|
||||||
|
FPOITextBgColor := clNone;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
destructor TMapView.Destroy;
|
destructor TMapView.Destroy;
|
||||||
begin
|
begin
|
||||||
FFont.Free;
|
FFont.Free;
|
||||||
|
FreeAndNil(FPOIImage);
|
||||||
FreeAndNil(FGPSItems);
|
FreeAndNil(FGPSItems);
|
||||||
inherited Destroy;
|
inherited Destroy;
|
||||||
end;
|
end;
|
||||||
@ -824,6 +874,10 @@ begin
|
|||||||
Engine.Redraw;
|
Engine.Redraw;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure TMapView.UpdateImage(Sender: TObject);
|
||||||
|
begin
|
||||||
|
Engine.Redraw;
|
||||||
|
end;
|
||||||
|
|
||||||
end.
|
end.
|
||||||
|
|
||||||
|
Reference in New Issue
Block a user