paweld/lazarus-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

LazMapViewer: New TMarkerSelectAndDragPlugin. Separate all marker plugins off into unit MvMarkerPlugins.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@9688 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz 2025-03-19 23:29:03 +00:00
parent 0d5bec125e
commit 331e6fd9c2
12 changed files with 1411 additions and 532 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
components/lazmapviewer/examples/plugin_demos/dragmarker_demo/main.pas
View File

@ -5,9 +5,9 @@ unit Main;
interface
uses
SysUtils, Classes, Math,
SysUtils, Classes,
Graphics, Forms, Controls, StdCtrls, ExtCtrls,
mvDLEFpc, mvMapViewer, mvPluginCommon, mvPlugins, mvGPSObj;
mvMapViewer, mvPluginCommon, mvMarkerPlugins, mvGPSObj;
type

8
components/lazmapviewer/examples/plugin_demos/markerclick_demo/main.pas
View File

@ -7,7 +7,7 @@ interface
uses
SysUtils, Classes,
Graphics, Forms, Controls, StdCtrls, ExtCtrls, Dialogs, LCLType,
mvMapViewer, mvPluginCommon, mvPlugins, mvGPSObj, mvGeoMath, mvTypes;
mvMapViewer, mvPluginCommon, mvMarkerPlugins, mvGPSObj, mvGeoMath, mvTypes;
type
@ -29,7 +29,7 @@ type
procedure FormCreate(Sender: TObject);
private
Plugin: TMarkerClickPlugin;
procedure MarkerCanClickHandler(AMapView: TMapView; APoint: TGPSPoint; var CanClick: Boolean);
procedure MarkerCanClickHandler({%H-}AMapView: TMapView; APoint: TGPSPoint; var CanClick: Boolean);
procedure MarkerClickHandler({%H-}AMapView: TMapView; APoint: TGPSPoint);
public
@ -88,7 +88,7 @@ procedure TMainForm.FormCreate(Sender: TObject);
begin
track := TGPSTrack.Create;
for i := 0 to High(APoints) do
track.Points.Add(TGPSPoint.CreateFrom(APoints[i]));
{%H-}track.Points.Add(TGPSPoint.CreateFrom(APoints[i]));
track.LineColor := clRed;
track.LineWidth := 1.0;
MapView.GPSItems.Add(track, 200);
@ -121,7 +121,7 @@ begin
AddGPSMarker( -79.3884000, 43.6439500, 'CN Tower, Toronto');
AddMapMarker(-157.7739800, 21.2716900, 'Kahala Avenue, Honolulu');
AddMapMarker( 114.1497900, 22.2708100, 'The Peak, Hong Kong');
AddMapMarker( 13.377778, 52.5163890, 'Brandenburger Tor, Berlin');
AddMapMarker( 13.377778, 52.5163890, 'Brandenburger Tor'+LineEnding+'Berlin');
AddGPSTrack([RealPoint(-20,20), RealPoint(20, 0), RealPoint(-20,-20)]);
AddMapTrack([RealPoint(20,20), RealPoint(-20,0), RealPoint(20,-20)]);

8
components/lazmapviewer/examples/plugin_demos/markerhint_demo/main.pas
View File

@ -7,7 +7,7 @@ interface
uses
SysUtils, Classes,
Graphics, Forms, Controls, StdCtrls, ExtCtrls, LCLType, Types,
mvMapViewer, mvPluginCommon, mvPlugins, mvGPSObj, mvGeoMath, mvTypes;
mvMapViewer, mvPluginCommon, mvMarkerPlugins, mvGPSObj, mvGeoMath, mvTypes;
type
@ -30,8 +30,8 @@ type
Plugin: TMarkerHintPlugin;
procedure MarkerCreateHintWindowHandler(AMapView: TMapView;
out AHintWindow: THintWindow);
procedure MarkerHintHandler(AMapView: TMapView; APoint: TGPSPoint;
var AHint: String; var AShowHint: Boolean);
procedure MarkerHintHandler({%H-}AMapView: TMapView; APoint: TGPSPoint;
var AHint: String);
public
@ -232,7 +232,7 @@ begin
end;
procedure TMainForm.MarkerHintHandler(AMapView: TMapView; APoint: TGPSPoint;
var AHint: String; var AShowHint: Boolean);
var AHint: String);
var
sName: String = '';
sLatLon: String;

83
components/lazmapviewer/examples/plugin_demos/markerselectdrag_demo/MarkerSelectAndDrag_Demo.lpi Normal file
View File

@ -0,0 +1,83 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="12"/>
<PathDelim Value="\"/>
<General>
<SessionStorage Value="InProjectDir"/>
<Title Value="MarkerSelectAndDrag_Demo"/>
<Scaled Value="True"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<XPManifest>
<DpiAware Value="True"/>
</XPManifest>
</General>
<BuildModes>
<Item Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<UseFileFilters Value="True"/>
</PublishOptions>
<RunParams>
<FormatVersion Value="2"/>
</RunParams>
<RequiredPackages>
<Item>
<PackageName Value="lazMapViewerPkg"/>
</Item>
<Item>
<PackageName Value="LCL"/>
</Item>
</RequiredPackages>
<Units>
<Unit>
<Filename Value="MarkerSelectAndDrag_Demo.lpr"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="main.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="MainForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="Main"/>
</Unit>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="MarkerSelectAndDrag_Demo"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Debugging>
<DebugInfoType Value="dsDwarf3"/>
</Debugging>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
</CompilerOptions>
<Debugging>
<Exceptions>
<Item>
<Name Value="EAbort"/>
</Item>
<Item>
<Name Value="ECodetoolError"/>
</Item>
<Item>
<Name Value="EFOpenError"/>
</Item>
</Exceptions>
</Debugging>
</CONFIG>

28
components/lazmapviewer/examples/plugin_demos/markerselectdrag_demo/MarkerSelectAndDrag_Demo.lpr Normal file
View File

@ -0,0 +1,28 @@
program MarkerSelectAndDrag_Demo;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}
cthreads,
{$ENDIF}
{$IFDEF HASAMIGA}
athreads,
{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, main
{ you can add units after this };
{$R *.res}
begin
RequireDerivedFormResource := True;
Application.Scaled:=True;
{$PUSH}{$WARN 5044 OFF}
Application.MainFormOnTaskbar := True;
{$POP}
Application.Initialize;
Application.CreateForm(TMainForm, MainForm);
Application.Run;
end.

386
components/lazmapviewer/examples/plugin_demos/markerselectdrag_demo/main.lfm Normal file
View File

@ -0,0 +1,386 @@
object MainForm: TMainForm
Left = 576
Height = 426
Top = 248
Width = 653
Caption = 'Marker Select & Drag Demo'
ClientHeight = 426
ClientWidth = 653
LCLVersion = '4.99.0.0'
OnCreate = FormCreate
object MapView: TMapView
Left = 0
Height = 317
Top = 0
Width = 653
Align = alClient
Cyclic = True
DownloadEngine = MapView.BuiltInDLE
DrawingEngine = MapView.BuiltInDE
Layers = <>
Font.Color = clBlack
MapProvider = 'Open Topo Map'
PluginManager = PluginManager
POIImages = POI_Images
end
object Bevel1: TBevel
AnchorSideLeft.Control = Owner
AnchorSideLeft.Side = asrCenter
Left = 323
Height = 50
Top = 108
Width = 6
Shape = bsSpacer
end
object Panel1: TPanel
Left = 0
Height = 109
Top = 317
Width = 653
Align = alBottom
AutoSize = True
BevelOuter = bvNone
ClientHeight = 109
ClientWidth = 653
TabOrder = 1
object cgPointTypes: TCheckGroup
AnchorSideLeft.Control = Panel1
AnchorSideTop.Control = Panel1
Left = 8
Height = 70
Top = 8
Width = 363
AutoFill = True
AutoSize = True
BorderSpacing.Around = 8
Caption = 'Allowed point types'
ChildSizing.LeftRightSpacing = 12
ChildSizing.TopBottomSpacing = 6
ChildSizing.HorizontalSpacing = 10
ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
ChildSizing.EnlargeVertical = crsHomogenousChildResize
ChildSizing.ShrinkHorizontal = crsScaleChilds
ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 3
ClientHeight = 50
ClientWidth = 359
Columns = 3
Items.Strings = (
'GPSPointOfInterest'
'GPSTrackPoint'
'GPSAreaPoint'
'MapPointOfInterest'
'MapTrackPoint'
'MapAreaPoint'
)
TabOrder = 0
OnItemClick = cgPointTypesItemClick
Data = {
06000000020202020202
}
end
object Label2: TLabel
AnchorSideLeft.Control = Label1
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = Label1
Left = 104
Height = 15
Top = 86
Width = 91
BorderSpacing.Left = 16
Caption = 'blue: MAP points'
Color = clBlue
Font.Color = clBlue
ParentColor = False
ParentFont = False
end
object Label1: TLabel
AnchorSideLeft.Control = cgPointTypes
AnchorSideTop.Control = cgPointTypes
AnchorSideTop.Side = asrBottom
Left = 8
Height = 15
Top = 86
Width = 80
BorderSpacing.Bottom = 8
Caption = 'red: GPS points'
Font.Color = clRed
ParentColor = False
ParentFont = False
end
object rgClickMode: TRadioGroup
AnchorSideLeft.Control = cgPointTypes
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = cgPointTypes
AnchorSideBottom.Control = cgPointTypes
AnchorSideBottom.Side = asrBottom
Left = 379
Height = 70
Top = 8
Width = 133
Anchors = [akTop, akLeft, akBottom]
AutoFill = True
AutoSize = True
Caption = 'Click mode'
ChildSizing.LeftRightSpacing = 12
ChildSizing.TopBottomSpacing = 6
ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
ChildSizing.EnlargeVertical = crsHomogenousChildResize
ChildSizing.ShrinkHorizontal = crsScaleChilds
ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 1
ClientHeight = 50
ClientWidth = 129
ItemIndex = 0
Items.Strings = (
'Add to selection'
'Toggle selection'
)
TabOrder = 1
OnClick = rgClickModeClick
end
end
object PluginManager: TMvPluginManager
Left = 401
Top = 74
end
object POI_Images: TImageList
Height = 32
Width = 32
Left = 400
Top = 136
Bitmap = {
4C7A010000002000000020000000490500000000000078DAD597678894571486
ED1515C55ED6151B566C5831D862051511DDD87ED810B104438C0D05B145412C
885D04A3464111835D443016AC089AFCB060D9154554766766676766F77B72DE
7B6759C91F677535E4C761BEF9BE7BCF7BCF39EF79EFBD4029FE27969F9F9F1E
8D461785C3E1F33939395966B1A465E99DBE151414342D695CF90C8542870CA7
20949D4DE4FE7DA2C78F13DBB387D8AE5D448F1C2172E70EFAE6C68442BFDB9C
B492C0CECBCBFBC17C86426FDF123B708060D224183204060D827EFDA04F1FE8
D1033A7726183890D8A64D84DEBCC1D610B2B913BE04DBF2F99361937BF326C1
D4A9307AB4B7912361F870183C18FAF7F76BE8DE1D3A7582B66D09EC7FEEA54B
CA05E663C167C63DC1CDBF7001C68F8771E3FCAF6CEC58BF8E1123FC1A9487DE
BDA15B37E8D0015AB786162D881E3EECD650DC3CA876CA9FE276B81919307932
4C99E26DE244B05A70F52A5CB9023B7742DFBEBE0ECA419B36D0BC39A4A7937B
F1A2AB45717869C30FABDEC1B4691E5FD8CAFF8C19307DBAC7CECD8563C7E0E8
518844C0EA4EAF5ED0A50BB46BE7E2272D8DC0D6137AFD5A6B389462ECE9E2B0
B8E672AC7C2F5C08B76E81719C7BF72091800D1BFC378D59B60CE271B87C1954
AFB3677D5D9A5AC8F5EB93B76E9DEB0BEBDFA629706E91FA2850CC85F85BB762
01C0E9D3DEB66C01E566F56A58B102468D82A54B61FF7EB09EE4C3079837CFE5
5FF88171423ECDF72F9FC2978EA8BF5D8F89E7E2DAE6CD9095E573AF1A2C5E0C
561F5703E5DEF2EB6AA43E10079F3C29C26FD0006AD52272E306E6FBDCA7F0A5
65D216D7DFEA31E560E346C8CC2CE2DFC38770FDBAE7E598319E83B76F17F540
217E32FFD4AC4974F76ED5203305FC58CCC6BA9E520DD563EBD7C3CB9745FDA7
FAABE6CABBD6B86081AF7FCF9E9E7FC29F3BD7F18F7AF51C7ECC6A25DF29E0C7
63EA27E552DAA235AC59032F5E14E9CFAB57B0776F91066DDFEED757A8418F1F
C39C39D0B831D4AD0B356A105BB54AF8F114F033A5E7AE97B506E561E54A78FE
1C860DF3B676ADCF81F5B6E3BB9E972CF1B14B7F843F7B36346C08B56B43B56A
446D9F4825FFE248E4EE5DA7E72E1ED574F97278F60C060C00D378F7ABFA9E3C
09274EC0CC99D0B52B74ECE8B5E7D1239835CBD7DEB847D5AA85FC3B9342FF2D
946606E29F72293E89EFEA29F556A189231693D33EE57FDB36DFA7D2A177EFFC
9AEAD471B90F5AB52ADC0B7E4E457B6D6C7E4CBE6C2F71F914CFCE9DF3B9FED8
CE9FF7A66F67CE786D3875CAE7455A68BC53EC799E7BF9E6BB492A1A1889440E
6A0F0DA4E9DA4B945369AAD6A21CCBF4AC77FAA63149BDA75123CF79E5DDEA1E
B46CE9F4D77CFE568C734E135B6F4EAEF4547E65D273CBA3C392E9D97CBB6FCD
9AF95E13DFC4F724B62CD7F2235FE633AD98FB6F86DB3B77ECF07D24FFD213C5
28D3B3DEE99B70C535D55B391776E5CAE4191792FB6FC6679E3FD6697E7CFE7C
1F973064D254FD2ACF7AAF1E53CCC635D59B4A9588DBFE90E4DCAF9F7BFE0982
A08CF5CC1FA1F7EFC91F3AD4C7261356E1B33015AF702D662A5420DF7813B21E
B0B9A7E4E34BCE6036BF7A7676F65F61EBFF4075AF52C563C9F42CCC8A15A17C
79285B96C06A127EFA54B1FFADB92571064D24122DCCDFBB88F69CEAE6B25C39
6F8647190BAF74691B55CAAD2772ED9ACE1AEF6D4ECB923C83C7E3F1EF45E3E8
C18345781F9BBD8BDA99456334F66BDC3F8C4BF3C5A998B4FE5FF831D3C824DF
7EFC9A7720D3913D39769649481393D8093BA724EF1EFBBEF61DCC3855C178FD
A734ADC034B0A07D7BA76FF6EEAA7DABF88DEE81752DD617613B07851F3C10DF
5EDABB7ADFF22E6AFCEEA22B824CCFFFC57DD870BF937D898F7F0027F7CB1B
}
BitmapAdv = {
4C69020000004C7A010000003000000030000000F80800000000000078DAED9A
098C54551686610454105041C40D706B3710F785CD0D10B75614DC701715A545
13F78E81A82123288B0D8A3AC608AE719498A8D161C264CCE0AE710471C1489B
89318DD82ADDB57657D53FE7BBF7DDAE47D3CE64AA179A645E725255EFDD77EF
7FCFF9CF7FCF7DAF2475D1FF2D58D76C365B66566E56615619594574AEAC1362
FE432693195F5F5FBFACAEAE6E8399FE8BD558DBA5369771DCBB357D9D4824A6
189EB5CD31D66FDCA8E4175F28F9D1474A7EF8A192AB57BB732DCC655D32999C
425F1D893D97CB95990F5735E1D8B449A90F3E50C3C30F2B7FC515D2A9A74A27
9D248D1A259D78A274DC71D231C7285F5EAE869933957AE71D774F6C1EFFA0CF
8EC06EFE9A5CE70F37767AC50AE56FBC513AF34CE98C33A4D34F97C619354E3B
4D3AF96469F46869C408E9F8E3A5A38F96860F970E3B4C796B977EF5D562CCEC
48A55293DB13BBF53FC3C62A305EA2BA5AB97BEE91CE3DB768E65F9D7DB69F0B
F3183B563AE594E21C88C3514749871F2E1D7AA85456A6DCC5172BB16E5D9847
C1C6B8B99DB04F0DBE4A7DFCB10A975F2E5D7081346952D1CE3F5F3AEF3C3F8F
B3CE92264CF0B10873804BC71E2B1D79A43474A874F0C1D20107A8603149AD5C
D9140B8BF1756D89DDB4628CF59B73D8DF7D57BAE82269F264FF69FED32597F8
CF709E79108F3007E20097468EDC9C47510CB4EFBE6E1EA937DE087368344D1B
DD46B9DAD7A8F983F3CB9A351E2B18C13BC5A4833804E337D76FB9457AE925E9
C517A5E79F97962D93C8EB31635A8EC1FEFB4B8307BB39244D07A27CF881B1DB
803755AEBF9F7E52E1861B3C4F02F62BAF94AEBE5ABAE61AFFC9EF9B8DBE3FFF
AC2D8E0D1B3CDF420C421E1C728874E081D29021D25E7BA960D7EA6B6A028FAA
5A897D88F5D3405FD9254BA48913BDEF2FBDD4FB13DCD71955AFBFDEDB4D3749
96D7EE78ED35E9BEFB24D34BBDFCB23FF7CD37D2F8F1D20927383DDD8243FBEC
230D1CA8ECDD7737F1289D4E0F6E85565605AD717909AF2FBCD0FB1E8E80F1F5
D7A537DF948CBBFAFA6B8FD3F4DDCD91B9326734E9ADB7FCB5CF3E939E7A4A7A
F249E9F1C7A5458BFC3AB1DF7E1EFF1E7B487BEEA984CDB53531C8E7F33D8C83
B5F4D1F0E8A3D239E76C8EDFB4BBC563ED5A1F17DAD0967BB8975CFEF4D396EF
59B8D0E7C0A0410EBB76DB4DD93BEF0C31A8054B099A33C1F1FEB7DF544057F0
619C3FCB97FBB15F7945AAAAF2367FBEC45A461ECC9A253DFBACF4CC33D2EDB7
7B1D625DB8F5561FBB8A0A69C102DF073108391CE12F18A7EA7FFDD5CDC1B08C
2F813B735DFC3EF9C47316FFA189E420F91BFCFFD04345FE930BD3A74B9F7FBE
A58FAD1672F7535784B58CF62DE11F3040DA651725A9333C87E6FCAFF8EDBEBF
726F06ED43BFA90DE04188017EE778F0C1CD3528602757C1F5C823D2575FF973
A68D4E43C18F86FE1E7EF33FF833E69B88437F2901FFF78EFBB367FB7A8C1810
7F7C08A783A6703DE83F7A13B01323DAB116635F7EE9AFA1C1AC01E8CFD4A99B
E38FF15F3BEFAC066B1BE1AF2E017F3DF7E66EBBCDAF9DC4000E071EB13E7180
39ACC1CF3D57C413D660F286FBE6CE2D5E0B6B70C04FEEC4F5A77F7F87BFD1FA
88F0D795803FEFF0938FD42ED430D432610E2FBCE0C746DF43FDB37469114FC0
0EEFB86FCE9CE2B550C7C1B9700EFDDF7B6FA7FFEAD74FEADB57391B2BC29F2B
017FC2E19F31C3F335CC8138505B065F575616EBCF3BEEF0E7E03BBF992BBCC3
D0550E30C39D238EF0F9C2418EC07D5B7FB5FBEED2AEBB4A7DFA28677D44F813
25E0AF76FCC7BFC43BCC012E51DB93D71C77DDE5F3829860E80C077C479BF07B
C0BE6A95CFDB503B5C755551FFE3DCB7DC55EFDE6A304D8BF0AF2F597F582BE1
2A3127EF582BD140749D83FC083EC6D02774A6F901767420B68771350807EB40
E04EC47DF5EA15D79F1525D43E7F74DAFBFEFB7E3CC6C577D42EC4E2E9A7FDD8
AC47F00A031F9FC468DA3469F1629FAFD75EEBE74F1FF086BA93BAEDB2CB7C1F
AC7B41F723EEA867CF26FD372CB34B587FC785BD6D01CD660ED4BC70172CC425
F88EBA2D6EE43CF831D6357406DEC3177C1EEAECA0B7F3E66DEEFB9D7652C1F2
A1CED6FE68FD1D5B42DDDF3DD43F59349E780F1BE6FD077FA947DBEA2047E07D
CCF759D382681F500B9612EBE7F9AEFEFCF65B8F9D988779A043D475D4904F3C
B1A5719E39628F3DE6DBC227B412BD2167E10DD8C9E54833F13D9F09AB65A3DA
615E2BF65E83AD8FAC8BC1FDF7FB7DC6410715E7018F990BE3C3AF60FCE63CD7
69477BEEE37ED629F62AAC55701EBD0CBC31CDD18E3B2A6BF55E94B759C330A8
95CF4B16B838DAFEA9405EB2CE83833D47980B7B90E6C679F686B4A33DF7B146
A1F3680DEB6CC01EE925BC29D87C192BCADB856DB0FFED6D7DFDABA9160533FE
C38F60B23DABC317E614F0729EEBB40BB8F1396B14B98AD6C099E077C3EE6ACE
68FFCB9836769FB6D8C367329911ECE5DCF32AEA36FC0716D61C70311F30C68D
735CA30DEDC11D7C1E72358E7D871D94B6FD42ECF9C388367EFE333D3C9FC93E
F080F721FC0517F89A1BE731DAD036E0C6E7F025E42AD8B7DF3EBEE725672BDA
E919D692B02634A2E1E0810760C3C019B0625CA30D1C8FE3C6E7B6BE92ABEAD1
438DB6AF08CF436D8C3FB5E373DB6EA6C77F77F95C53A33CF50498E002F8E2C6
398CEBF0045D8FE3369FAB7B77E54DA3EA7FFC31FE1CB77B3B3F7BEE1FF63609
ABCB0AF01C6CC1F06FF80E5E3802667812C3ADEDB653C1E29258B32660FFDEFA
1ED011CFA0D3E9F4B0505FA7DE7EDB63051B1883F11BB3BC74988D27EAD6CDE1
56D7AEEE7BEC7961D2F2757847BE03B01C9B189E4567584FF169730B7803E62E
5D9A2C636B6F78E66C7D4DDA1AEF606CDC9941331AA8D1C0182C86B5B935581D
D7F42C3B959AB535DF2119863FBB7CFEE517E5A853FF036E2C3772A4EA6B6B43
6DB6BCA3DF1DB590CF3D0DCB3F1D9EEA6A1558AF7E073BD7EAD7AF0FD857E7F3
F95E9DE11D6454E7B9778FACFF4E739AE3370D4ABEF75EE0CD46EEE94CEF514D
3F468567D5699E4DC473C0BEC76A03DA8CE98CEFAFE3EF98B2F7DEDB843F5B59
19CFD7699DF91DBCE15BD45463D85EBEB1BC3C5E1B2CEEECFF21A0C630AC2B43
8D11DEA558BEFE8D6BDBC2FF200C673FC3FC5DECFDF4779CDB96FECB6178871A
EE4D18DFB7C5FFA318EE81587B8EF16FEC2287AD4C7A01000000400000004000
0000CD0D00000000000078DAED9B779014F512C70DA82046CC39670CA0A062CE
3927CC09047926CCE8B3D43281145A8AFACA124B2D1FFE61499915C14C524CAF
4A0554C00088A0C0C906F6367D5F7F66B6777F37DE3D79E59E049DAAAEDB9B99
9DE96F876FF7AF6756D232FA5BFE96569262B1D8A15028EC91CBE52E983F7FFE
209311265F9BCC3169ACC89CCA3E8E0DB273CFE73B7C7709C6BD7E369BED9D4A
A5DE344CDF9A144DB490C2B953EDBB23172C58D08B6B2D21B89735CC5D1B1A1A
EE31FDD3CD614BCD9BA7F4F4E94A7FFDB5D213272A3D6142FC79DAB4E8580BF6
C8FEFAEBAFF79B2DF65C5CB1974AA5554DBFCBF19B49A909E6B973951D354A8D
8F3DA6C24D37A978D9652A5D78A14AE79CA3D25967457F8B3D7AA8D0B7AF1A07
0F56F6EDB7959A33276903AE39D5EE7119F75A5C7097CBE5E52D577737DDFED3
04F3ECD9CA7EF0810AFDFB4BA79D261D7EB874D861D2218748071F2C1D78A0B4
FFFED23EFB487BEF2DED69AEDD630FA9532769D75DA5FDF653E1FAEB957DEB2D
A57EFCB1690CA5529FC20F76EF368B1ABFC5FB19A6D3C450BFCCE79FAB70FBED
2A9F7DB674CC31D2D1474B471D251D71446C87430F6D6A837DF7ADD960F7DD63
1BECB28BB4D34E2AEFB5978A975CA2CC279F246DF015F75E847E6F6FF7EF13F2
5AFA871F947FE001E9F4D3A5134E88E5F8E36339EE38E9D863635B1C7964CD0E
071D241D7040CD065DBBC671B0DB6EB10D76DC51DA7E7B69E79D95BFE106A5A7
4C69C293702CBA2C02BFF7A9D4ADD8E75F7CA1E26DB749279D249D7C725361DF
8927C67648DA807CC0069E0BE66F75E92275EE1CE741C78ED20E3B48DB6E2B6D
BDB58AE79DA7CC471F853698830DFE44BFB7B1FB9DEE7E4F353428FBE18792E9
A5534E914E3D35CE7762C085FF39862DDC0EE40539E171E0B9D0AD5B6C036200
1B54F240DB6D276DB38DB4F9E6D1BEEC881161BD28A5D3E9EE70516BE38777C8
3DB73FD84B975E1AE303EB199692DDBB4B679E5913FE673F7648DAC0E3C0F920
CC03B82019035B6E296DB699CA162BD937DE08E36012BAB5768D33EC9F85315F
F5BBE386F3AC9EE9DC736BC2FF56E7A2E356F774E79DD2C081D28001D23DF748
77DD25F5EB17DBC4F3002E240F9C0BE1016260ABADA42DB69036DE388A8B8CD9
3FAC0BA6E36AAD85DF6AEF3F42AE2B1AC757FDEED8C17BFEF9D20517D484FFD9
CFF1175E90162CD06FB66C567AE699DFC680F30039000F9203C4C0A69B4A1B6E
A8A2DD373D7972D506F420F461ADC0775D2BBD4D749F88E7E135F21DDF3B76F0
5E749164FD4C24175F1CFFDFB3A7F4F4D335BC33674A336648D60BCAEA7B757B
F0C1980FE001AF87D402CF01C76F3910C5C0061B287FD555611E4C315DBBD41B
BFF5B403BCAFA3BE473E2797C9697C4F8CE367C76E355BBD7AC502F6871E928C
2BA3ED9B6F24AB65BAFA6AE9CA2B63B15E38DAACEFD32DB7D46A81F74456FFA2
1C8003C801C7BFFEFA11270635A164BAF6AFF75AC6FBF9D4AC59719DA3B6831F
3BC071F8FE8A2BA4471E911E7D54B25E574386C4F2E493B598FFEA2BE9BAEB62
9B613B6288BCC746D8958D73E1859B6F8E79C1FA405D7B6D6C27E2C2EA605407
36D924F2BFD65D5705E397A04FCC98CEEBD531EF7B55F9DE7ADA325CD61CFE17
5F94CA65B5B8653212B6E35CBEE331E4B5E0724BDD54AAE5EF974AD2C30FC7F8
E1C00A0780BF6CDC9809EA81E9DCB35EEB77D6A17EDD029C8DAEE89CC43F7E7C
AC672E27FDF45353318ED2FDF7C7FC90C48F2DBD16E26FEACAF7DFC7F2DD77B1
603BB6D75F8F3920C4BF9EB97AADB554E8DD3BAC0523AC1EAE598F7AEFBCC73A
2ED299FE0DFCC46E98FFF4416C5F7E29DD71475CE7A86DFCBDF1C69813C06F7C
A5A143255BE7C9D6377AE289B82E829F3502D7733B79DD1C37EE77F1B33F5837
4E31DD3BFF51FCB95CEE3CEFF5B2A347C7BD0A7D1BFD3C7D8CD77EF474FC1F7F
1CE7B3F31FB8E1C43E7DA4E1C39BAF7FF877D8B0D8AEF4C3B6FE8B72DDFBA091
23FF37FEB5D796D65843593BEE6B0374FFA3F82B33ABE89A8D70196B587C441F
EF39E03160DC106DC6C5511DA0F6791DC40ED47E7298ADB1519A3A55B2F54CF4
D9F3FBA9A7621BFFBFF8F1BFE16FB4B80B6AE1C03AE01FE1731B6617D17A05FD
C8016C400C380F788CC203C91E88BA80DFC1F8E9A7B13D881DBECF716C562CC6
7170EBADB51EC8D742D6EF2F0CFE82F9813CADE01F5E07FC51AFCFCC8AB94DD4
A7D39F90ABCE0360A00F1A3B36D6913C48F6C09E1B7019751FEC5EFBB023F620
16D8E0049F8B3487DFF99FFA97C05FB4D84CDB3D7C4D5007FCD11A97191D33AB
A83FC506C40036F05A800DC68C8975240F926B20AF6BCF3D57C30EEFFB7A989C
8213D9E893BCFFF3FE27893F51FFD5A183B4FAEA2A99DDD2C6BF15FCBFD4017F
63847FC284684E17AD4FB00131E05CE83670FCC441720D9CCFC7C71E7FBC861D
0EF55900BC426D776E08D780F4BF56DBABF8C3FE2F89DFE225FDD9678E3F5707
FCF908BFD9B4841F894B6C00473B17782E8C1A15EB881D9273107A7DB637DF8C
FD9F9C83F097DAE039929C8338FED75EABAD7F36DA28EE7FD759475AD34AFD6A
ABA964F112E06FAC03FE79117EEB5B23FFE317B889991536F03840FFF7DF8F75
A44EFADCCBE760E8CD367B76DC0B24E7607002C73C479273B010BFE73EF883DA
17E137FDD2D63F55F0CFAB03FE4911FE69D3A2197594936E03CF05E7C4F7DE8B
75240EC0475EB8C09DF4736CE9741CEB60A6171A3CB8C60FD444D6923EFFF1F9
87C7C6ABAFC6B91FC67E85FBB4CA2A2A9A3DD3769F0AFE8975AB7F56530AE88A
5E6E03CF05B7C1BBEFC63A1207F019828F9D27E9039D07A875F493ACF7F8EC79
4F6C706DB0E37BD67DACFD43FCE43EBE073FB14FEE9BEFC15F30DE09EADF1B7F
14BFF5D103BD9FC8E133B8184E223EC95178DA63E19D77621DB103DC404C84C2
3ED6881CFFF9E7D81608714FCD23BEC879E73C9FFD31F780F7D85E79A569DD23
F62BB9AF955756CE6C1CF43F03EAD0FF9E53ED7FE9D789476C401CA02B36F058
E0381B7620261038C2C5F7911BF4C2F89A3900FD31F1E3D87DE6E5330FE65E21
7E5FF73BEF57621FFC41FF5B30DDCFAAC3FAA7336B89E89AD60396F133BAE11F
62143B100BE4043EF4FA4F0EFB2CD0C5F7B15608E7A2D447FA279F8D7A6DF419
3179E4DCF2F2CBCDFBBE7D7B952D2FE6D766C2934DF74E75C0BF3A7D6475FD8B
CF88496C402C60037C86EFA86DCE6FAC77117A3A17DF9714E641A158AF1509B3
126492B57176EF2A7EAF79F09ED57CADBAAAD4AE9DF2164741EC0F47F73ACD3F
7A56E71FE60766CFD12C8AF8743B10B3CC7C7C7DD31A1BD7BEEFBE1AE7277C9F
B11E31987F5C5CC7B9F7DA76CD54540766CE5481793F9C446E120B6E0772F89A
6BE2F916332B84FC76F17D08E720CCB5F80EB5B06FDFB81EC291CC82A899F004
F7637DC07A92FB79DCE3FB4ADE172C8782F957CA74AEEBBB13994CA6BFF36086
F51B3E671609376107E2C16D41CDC21E1E1BA1F87ECEE15CBEC3779DE72ACFB9
A21ECF7B7CAF759EF3955E378A7BC3CEBE70FE69BADEDD0ACF7D78C63DB93AFF
662D8C9EAC45DD0E1E136E0BB74728BE9F73FCD926C235B8963FDFA0C67B8FEB
D8BDD6C3F760B7B8077FDE6225987B7D83AEADF4CCB377F5F987F56945D6EDF8
085FA137FA27EDD19C70CC7DCDF9D8D171733D7053E3E079AF7349BF83DD38AF
68F522F1FCA34F6B3CFFA8CC42DBDB3D3EAE3EFF220F88637C85EED8C16D0126
8F8FA4F831CEE37CC7CD7588F796B0877E37ECC444F8FCCBE423D37195567EFE
D9C9EE33A15A0F5E7A4965B81F9DF11B1810F080AB2571BC7CC73113EB8EDBE3
DD793EE1F7B27D2F6BEBA400FB97F5A8F70BF3BE8BE5C16976BF72946FBFFCA2
1CCFACD01B01070226B035271C0B317B8E7B9EBBCF5BC0AE955652EEDE7B95B2
1EBA82BDFC673DFF0EEAC1CDE13B5E796A1898F01D0216B74973E278DDD760C6
DF1EEB8EBBB2AE8978BE6DDBE873BE67CFD0EF19745904EFBF74B0FB3E59E543
EBD78AF4AF6040C08380AD39F1E38E195F3BEECA5A3EE4787CAE155754D1D651
BC3757E5A04CE6DFA6CB5A8BE21DA07C3EDFD6EACD7BD55CF8F65B9558078001
2C6072718C2E1C0FF13A66F7B7C73A3E37DC6AD34625ABAD01D773CFD1A643BB
45F9FE576363E39E6683EAFB5FD9E79F8F9EC545B18B38B6A4F8F110B3C7B9C7
3A3E5F6185087BD9722BFBECB34DDEFFB2F55DB7C5E11D40B3413766ADD51ACC
FC0A7F3B26845846C27DF8D8E3DB7D5D89F308F7F24667CB2D171D5B30746898
F373B9E7E2F4FEE7BC79F3AE878BFC9DA83CBD7C655DD6AC80D5F18698CDD755
DCCB2E1BFD9FB7FE9F6BFABBB00D0D0DFD16C3F79D57B498FC67950B6C2D82DE
1126047C8ED105AC8E37C4BCCC3255C9F7E8A1D4F4E9619DBBD5EEB5D2E2FA0E
70382B80AB4AAC75C0D59C803581379404DF91F3235BF3FDA63AC5C196E6A3B7
ABF569ECD8D8062D606C113BEF768D1E5DC56ED77C876B2F09EFC1DB1A84B562
43F5FD489EFB12EF0B8BDF72223B6C5898F3F3ED9A5D9604ECC15AF12453FBA7
EAEC78D0A0980F7F0FBB9D931B38308CF9D976AD5397B4DF7F584FD6D6F4EE57
C5316386F2BD7BFF2E7E7A5BCEADF613D9EC4D76AD764B1AFE609D30C49F21CE
9F3B377A3E1D715F12BBEDA3B70D9E5DE4ADCE3DB1A4FFFEC9FAD3CD0CCB5B55
3E1C37AE593E2C75ECA8CC9831618FF3AED96EF3A5E1376066830DFC3D8AC806
E3C7ABCCDAA7829DCFD8259C61D977365E9A7E0767BDFAC9866B66950F7917AE
D2F7C38D01F699D6DB9EB234FE16D06A1873939CBF4F941B3040B9BBEF0E733E
677CD77D29FE2D641BC3F850F5B713B36645E2736BF3FDBF386769FE3DA8F5AF
6B5A2FF778F2377EB66F08C7FE0ABF89359C1B99AF2705393F897D7FA5DF051B
DE4EE6F397103EFF157F1BCD73456451EAF05F043D2AB1
}
end
end

150
components/lazmapviewer/examples/plugin_demos/markerselectdrag_demo/main.pas Normal file
View File

@ -0,0 +1,150 @@
unit Main;
{$mode objfpc}{$H+}
interface
uses
SysUtils, Classes,
Graphics, Forms, Controls, StdCtrls, ExtCtrls, Dialogs, LCLType,
mvMapViewer, mvPluginCommon, mvMarkerPlugins, mvGPSObj, mvTypes;
type
{ TMainForm }
TMainForm = class(TForm)
Bevel1: TBevel;
cgPointTypes: TCheckGroup;
Label1: TLabel;
Label2: TLabel;
Panel1: TPanel;
POI_Images: TImageList;
MapView: TMapView;
PluginManager: TMvPluginManager;
rgClickMode: TRadioGroup;
procedure cgPointTypesItemClick(Sender: TObject; Index: integer);
procedure FormCreate(Sender: TObject);
procedure rgClickModeClick(Sender: TObject);
private
Plugin: TMarkerSelectAndDragPlugin;
public
end;
var
MainForm: TMainForm;
implementation
{$R *.lfm}
{ TMainForm }
procedure TMainForm.FormCreate(Sender: TObject);
// GPS markers are identified by the cross
procedure AddGPSMarker(const ALon, ALat: Double;
ACaption: String);
var
gpsPt: TGpsPointOfInterest;
begin
gpsPt := TGpsPointOfInterest.Create(ALon,ALat);
try
gpsPt.Name := ACaption;
gpsPt.ImageIndex := -1;
MapView.GPSItems.Add(gpsPt, 100);
gpsPt := Nil;
finally
if Assigned(gpsPt) then
gpsPt.Free;
end;
end;
// Map markers are identified by an icon.
procedure AddMapMarker(const ALon, ALat: Double; ACaption: String);
var
layer: TMapLayer;
pt: TMapPointOfInterest;
begin
if MapView.Layers.Count = 0 then
layer := MapView.Layers.Add as TMapLayer
else
layer := MapView.Layers[0];
pt := layer.PointsOfInterest.Add as TMapPointOfInterest;
pt.Latitude := ALat;
pt.Longitude := ALon;
pt.Caption := ACaption;
pt.ImageIndex := 0;
end;
procedure AddGPSTrack(const APoints: TRealPointArray);
var
track: TGPSTrack;
i: Integer;
begin
track := TGPSTrack.Create;
for i := 0 to High(APoints) do
{%H-}track.Points.Add(TGPSPoint.CreateFrom(APoints[i]));
track.LineColor := clRed;
track.LineWidth := 1.0;
MapView.GPSItems.Add(track, 200);
end;
procedure AddMapTrack(const APoints: TRealPointArray);
var
layer: TMapLayer;
track: TMapTrack;
i: Integer;
begin
if MapView.Layers.Count =0 then
layer := MapView.Layers.Add as TMapLayer
else
layer := MapView.Layers[0];
track := layer.Tracks.Add as TMapTrack;
track.Caption := 'Test track';
track.LineColor := clBlue;
track.LineWidth := 0.8;
for i := 0 to High(APoints) do
TMapTrackPoint(track.Points.Add).RealPoint := APoints[i];
end;
var
i: Integer;
begin
MapView.Active := true;
AddGPSMarker( 0.0000000, 51.4825766, 'Greenwich');
AddGPSMarker( 2.2945500, 48.8582300, 'Tour d´Eiffel, Paris');
AddGPSMarker( -79.3884000, 43.6439500, 'CN Tower, Toronto');
AddMapMarker(-157.7739800, 21.2716900, 'Kahala Avenue, Honolulu');
AddMapMarker( 114.1497900, 22.2708100, 'The Peak, Hong Kong');
AddMapMarker( 13.377778, 52.5163890, 'Brandenburger Tor, Berlin');
AddGPSTrack([RealPoint(-20,20), RealPoint(20, 0), RealPoint(-20,-20)]);
AddMapTrack([RealPoint(20,20), RealPoint(-20,0), RealPoint(20,-20)]);
Plugin := TMarkerSelectAndDragPlugin.Create(PluginManager);
for i := 0 to cgPointTypes.Items.Count-1 do
cgPointTypes.Checked[i] := true;
end;
procedure TMainForm.rgClickModeClick(Sender: TObject);
begin
Plugin.ClickMode := TMarkerClickMode(rgClickMode.ItemIndex);
end;
procedure TMainForm.cgPointTypesItemClick(Sender: TObject; Index: integer);
var
pointTypes: TMvPointTypes;
begin
pointTypes := Plugin.PointTypes;
if cgPointTypes.Checked[Index] then
Include(pointTypes, TMvPointType(Index))
else
Exclude(pointtypes, TMvPointType(Index));
Plugin.PointTypes := pointTypes;
end;
end.

2
components/lazmapviewer/examples/plugin_demos/spreadmarker_demo/main.pas
View File

@ -7,7 +7,7 @@ interface
uses
Classes, SysUtils,
Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,
mvMapViewer, mvPluginCommon, mvPlugins, mvGPSObj, mvspreadmarker_plugin;
mvMapViewer, mvPluginCommon, mvPlugins, mvMarkerPlugins, mvGPSObj, mvspreadmarker_plugin;
type

9
components/lazmapviewer/lazmapviewerpkg.lpk
View File

@ -4,12 +4,11 @@
<Name Value="lazMapViewerPkg"/>
<Type Value="RunAndDesignTime"/>
<Author Value="Maciej Kaczkowski, ti_dic, Werner Pamler, Ekkehard Domning, Yuliyan Ivanov"/>
<ExamplesDirectory Value="examples"/>
<CompilerOptions>
<Version Value="11"/>
<SearchPaths>
<IncludeFiles Value="source"/>
<OtherUnitFiles Value="source;source/addons/plugins;source/addons/plugins/spreadmarkers;source/addons/plugins/grids;source/addons/plugins/scale;source/addons/plugins/greatcircle;source/addons/plugins/areaselection"/>
<OtherUnitFiles Value="source;source/addons/plugins;source/addons/plugins/spreadmarkers;source/addons/plugins/grids;source/addons/plugins/scale;source/addons/plugins/greatcircle;source/addons/plugins/areaselection;source/addons/plugins/markers"/>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Other>
@ -24,7 +23,7 @@
FPC 3.2.0 or newer required."/>
<License Value="Modified LGPL with linking exception, like FreePascal RTL/FCL and Lazarus LCL"/>
<Version Minor="2" Release="7"/>
<Files Count="35">
<Files Count="36">
<Item1>
<Filename Value="source/mvcache.pas"/>
<UnitName Value="mvCache"/>
@ -166,6 +165,10 @@ FPC 3.2.0 or newer required."/>
<Filename Value="source/addons/plugins/areaselection/mvareaselectionplugin.pas"/>
<UnitName Value="mvAreaSelectionPlugin"/>
</Item35>
<Item36>
<Filename Value="source/addons/plugins/markers/mvmarkerplugins.pas"/>
<UnitName Value="mvMarkerPlugins"/>
</Item36>
</Files>
<CompatibilityMode Value="True"/>
<RequiredPkgs Count="2">

2
components/lazmapviewer/lazmapviewerpkg.pas
View File

@ -16,7 +16,7 @@ uses
mvPluginEditors, mvClassRegistration, mvPluginCommon, mvPlugins,
mvspreadmarker_plugin, uInactivityAlarmTimer, mvMapGridPlugin,
mvMapScalePlugin, mvGreatCirclePainterPlugin, mvAreaSelectionPlugin,
LazarusPackageIntf;
mvMarkerPlugins, LazarusPackageIntf;
implementation

744
components/lazmapviewer/source/addons/plugins/markers/mvmarkerplugins.pas Normal file
View File

@ -0,0 +1,744 @@
unit mvMarkerPlugins;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Contnrs,
Graphics, Controls, Forms, LCLIntf,
mvMapViewer, mvDrawingEngine, mvPluginCommon, mvGPSObj, mvGeoMath, mvTypes;
type
{ TMarkerHintPlugin }
{ Event allowing to create a different hint window class for custom drawing
of the hint. }
TMarkerCreateHintWindowEvent = procedure(AMapView: TMapView;
out AHintWindow: THintWindow) of object;
{ Event to define the hint text for the marker at the given point.
Return an empty string when no hint should be displayed. }
TMarkerHintEvent = procedure (AMapView: TMapView; APoint: TGPSPoint;
var AHint: String) of object;
TMarkerHintPlugin = class(TMvMarkerPlugin)
private
const
DEFAULT_HINT_OFFSET_X = 0;
DEFAULT_HINT_OFFSET_Y = 15;
DEFAULT_HIDE_INTERVAL = 1000;
private
FAutoHideHint: Boolean;
FHideInterval: Integer;
FHintOffsetX: Integer;
FHintOffsetY: Integer;
FHintWindow: THintWindow;
FShowHint: Boolean;
FOnCreateHintWindow: TMarkerCreateHintWindowEvent;
FOnHint: TMarkerHintEvent;
protected
function CreateHintWindow(AMapView: TMapView): THintWindow; virtual;
procedure DisplayHint(AMapView: TMapView; APoint: TGPSPoint; X, Y: Integer); virtual;
procedure HideHint; virtual;
protected
procedure MouseMove(AMapView: TMapView; {%H-}AShift: TShiftState; X,Y: Integer;
var Handled: Boolean); override;
public
constructor Create(AOwner: TComponent); override;
published
property AutoHideHint: Boolean read FAutoHideHint write FAutoHideHint default false;
property HideInterval: Integer read FHideInterval write FHideInterval default 0;
property HintOffsetX: Integer read FHintOffsetX write FHintOffsetX default DEFAULT_HINT_OFFSET_X;
property HintOffsetY: Integer read FHintOffsetY write FHintOffsetY default DEFAULT_HINT_OFFSET_Y;
property ShowHint: Boolean read FShowHint write FShowHint default true;
property OnCreateHintWindow: TMarkerCreateHintWindowEvent read FOnCreateHintWindow write FOnCreateHintWindow;
property OnHint: TMarkerHintEvent read FOnHint write FOnHint;
end;
{ TMarkerClickPlugin }
TMarkerCanClickEvent = procedure (AMapView: TMapView; APoint: TGPSPoint; var CanClick: Boolean) of object;
TMarkerClickEvent = procedure (AMapView: TMapView; APoint: TGPSPoint) of object;
TMarkerClickPlugin = class(TMvMarkerPlugin)
private
FCursor: TCursor;
FShift: TShiftState;
FOnCanClick: TMarkerCanClickEvent;
FOnMarkerClick: TMarkerClickEvent;
protected
FMouseDownOnMarker: Boolean;
FMousePoint: TPoint;
FOrigGpsPoint: TGPSPoint;
FSavedCursor: TCursor;
procedure MouseDown(AMapView: TMapView; {%H-}Button: TMouseButton;
AShift: TShiftState; X,Y: Integer; var Handled: Boolean); override;
procedure MouseMove(AMapView: TMapView; {%H-}AShift: TShiftState;
X,Y: Integer; var Handled: Boolean); override;
procedure MouseUp({%H-}AMapView: TMapView; {%H-}Button: TMouseButton;
{%H-}AShift: TShiftState; {%H-}X,{%H-}Y: Integer; var {%H-}Handled: Boolean); override;
procedure SetMapView(AValue: TMapView); override;
public
constructor Create(AOwner: TComponent); override;
published
property Cursor: TCursor read FCursor write FCursor default crHandPoint;
property Shift: TShiftState read FShift write FShift default [ssLeft];
property OnCanClick: TMarkerCanClickEvent read FOnCanClick write FOnCanClick;
property OnMarkerClick: TMarkerClickEvent read FOnMarkerClick write FOnMarkerClick;
end;
{ TMarkerSelectAndDragPlugin }
TMarkerDrawPointEvent = procedure (AMapView: TMapView;
ADrawingEngine: TMvCustomDrawingEngine; AGPSPoint: TGPSPoint;
AScreenPoint: TPoint; AMarkerSize: Integer) of object;
TMarkerClickMode = (mcmAddToSelection, mcmToggleSelection);
TMarkerSelectAndDragPlugin = class(TMarkerClickPlugin)
private
FClickMode: TMarkerClickMode;
FDragCursor: TCursor;
FDragging: Boolean;
FSelection: TGPSPointList;
FOrigSelection: array of TRealPoint; // Selection before dragging starts
FOnDrawPoint: TMarkerDrawPointEvent;
FOnSelect: TNotifyEvent;
protected
procedure AddToSelection(AMapView: TMapView; APoint: TGPSPoint);
procedure DoSelect(AMapView: TMapView);
procedure DragStart(AMapView: TMapView);
procedure DragTo(AMapView: TMapView; X, Y: Integer);
procedure DragEnd(AMapView: TMapView);
procedure DrawPoint(AMapView: TMapView; ADrawingEngine: TMvCustomDrawingEngine;
AGpsPoint: TGPSPoint; AScreenPoint: TPoint; AMarkerSize: Integer);
procedure DrawSelection(AMapView: TMapView);
procedure MoveSelectionBy(AMapView: TMapView; dx, dy: Integer);
procedure ToggleSelected(AMapView: TMapView; APoint: TGPSPoint);
protected
procedure AfterDrawObjects(AMapView: TMapView; var {%H-}Handled: Boolean); override;
procedure MouseDown(AMapView: TMapView; {%H-}Button: TMouseButton;
AShift: TShiftState; X,Y: Integer; var Handled: Boolean); override;
procedure MouseMove(AMapView: TMapView; {%H-}AShift: TShiftState;
X,Y: Integer; var Handled: Boolean); override;
procedure MouseUp(AMapView: TMapView; {%H-}Button: TMouseButton;
AShift: TShiftState; X,Y: Integer; var Handled: Boolean); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property Selection: TGPSPointList read FSelection;
published
property ClickMode: TMarkerClickMode read FClickMode write FClickMode default mcmAddToSelection;
property DragCursor: TCursor read FDragCursor write FDragCursor default crSizeAll;
property OnDrawPoint: TMarkerDrawPointEvent read FOnDrawPoint write FOnDrawPoint;
property OnSelect: TNotifyEvent read FOnSelect write FOnSelect;
end;
{ TDraggableMarkerPlugin }
TDraggableMarkerPlugin = class;
TDraggableMarkerCanMoveEvent = function (Sender : TDraggableMarkerPlugin; AMarker : TGPSPoint) : Boolean of object;
TDraggableMarkerMovedEvent = procedure (Sender : TDraggableMarkerPlugin; AMarker : TGPSPoint; AOrgPosition : TRealPoint) of object;
{ TDraggableMarkerData }
PDraggableMarkerData = ^TDraggableMarkerData;
TDraggableMarkerData = record
FDraggedMarker : TGPSPoint;
FOrgPosition : TRealPoint;
end;
TDraggableMarkerPlugin = class(TMvMultiMapsPlugin)
private
const
DEFAULT_TOLERANCE = 5;
private
FDraggableMarkerCanMoveEvent : TDraggableMarkerCanMoveEvent;
FDraggableMarkerMovedEvent : TDraggableMarkerMovedEvent;
FDragMouseButton: TMouseButton;
FTolerance: Integer;
function GetFirstMarkerAtMousePos(const AMapView: TMapView; const AX, AY : Integer) : TGPSPoint;
function GetDraggedMarker(AMapView : TMapView) : TGPSPoint;
function GetOrgPosition(AMapView : TMapView): TRealPoint;
protected
procedure MouseDown(AMapView: TMapView; {%H-}Button: TMouseButton; {%H-}Shift: TShiftState;
X, Y: Integer; var Handled: Boolean); override;
procedure MouseMove(AMapView: TMapView; {%H-}AShift: TShiftState; X,Y: Integer;
var Handled: Boolean); override;
procedure MouseUp(AMapView: TMapView; {%H-}Button: TMouseButton; {%H-}Shift: TShiftState;
{%H-}X, {%H-}Y: Integer; var Handled: Boolean); override;
public
constructor Create(AOwner: TComponent); override;
procedure Assign(Source: TPersistent); override;
property DraggedMarker[AMapView : TMapView] : TGPSPoint read GetDraggedMarker;
property OrgPosition[AMapView : TMapView] : TRealPoint read GetOrgPosition;
published
property DraggableMarkerCanMoveEvent : TDraggableMarkerCanMoveEvent read FDraggableMarkerCanMoveEvent write FDraggableMarkerCanMoveEvent;
property DraggableMarkerMovedEvent : TDraggableMarkerMovedEvent read FDraggableMarkerMovedEvent write FDraggableMarkerMovedEvent;
property DragMouseButton : TMouseButton read FDragMouseButton write FDragMouseButton default mbLeft;
property Tolerance: Integer read FTolerance write FTolerance default DEFAULT_TOLERANCE;
end;
implementation
uses
Types;
function IfThen(AValue: Boolean; ACursor1, ACursor2: TCursor): TCursor;
begin
if AValue then Result := ACursor1 else Result := ACursor2;
end;
{ TMarkerHintPlugin }
constructor TMarkerHintPlugin.Create(AOwner: TComponent);
begin
inherited;
FHintOffsetX := DEFAULT_HINT_OFFSET_X;
FHintOffsetY := DEFAULT_HINT_OFFSET_Y;
FHideInterval := DEFAULT_HIDE_INTERVAL;
FShowHint := true;
end;
function TMarkerHintPlugin.CreateHintWindow(AMapView: TMapView): THintWindow;
begin
if Assigned(FOnCreateHintWindow) then
FOnCreateHintWindow(AMapView, Result)
else
Result := THintWindow.Create(self);
end;
procedure TMarkerHintPlugin.DisplayHint(AMapView: TMapView; APoint: TGPSPoint;
X, Y: Integer);
var
hintTxt: String;
hintRct: TRect;
hintPt: TPoint;
dx, dy: Integer;
begin
if APoint.Name <> '' then
hintTxt := Format('%s' + LineEnding + '(%s / %s)', [
APoint.Name, LatToStr(APoint.Lat, true), LonToStr(APoint.Lon, true)
])
else
hintTxt := Format('(%s / %s)', [LatToStr(APoint.Lat, true), LonToStr(APoint.Lon, true)]);
if Assigned(FOnHint) then
FOnHint(AMapView, APoint, hintTxt);
if (hintTxt = '') or not FShowHint then
exit;
if not Assigned(FHintWindow) then
FHintWindow := CreateHintWindow(AMapView);
FHintWindow.AutoHide := FAutoHideHint;
FHintWindow.HideInterval := FHideInterval;
hintRct := FHintWindow.CalcHintRect(AMapView.Width, hintTxt, nil);
hintPt := AMapView.ClientToScreen(Point(X, Y));
if FHintOffsetX = -1 then
dx := - hintRct.Width div 2
else
dx := FHintOffsetX;
if FHintOffsetY = -1 then
dy := - hintRct.Height div 2
else
dy := FHintOffsetY;
OffsetRect(hintRct, hintPt.X + dx, hintPt.Y + dy);
FHintWindow.ActivateHint(hintRct, hintTxt);
end;
procedure TMarkerHintPlugin.HideHint;
begin
FreeAndNil(FHintWindow);
end;
procedure TMarkerHintPlugin.MouseMove(AMapView: TMapView; AShift: TShiftState;
X,Y: Integer; var Handled: Boolean);
var
gpsPoint: TGPSPoint;
begin
if Handled then
exit;
gpsPoint := FindNearestMarker(AMapView, X, Y);
if gpsPoint = nil then
HideHint
else
DisplayHint(AMapView, gpsPoint, X, Y);
end;
{ TMarkerClickPlugin }
constructor TMarkerClickPlugin.Create(AOwner: TComponent);
begin
inherited;
FCursor := crHandPoint;
FSavedCursor := crDefault;
FShift := [ssLeft];
end;
procedure TMarkerClickPlugin.MouseDown(AMapView: TMapView; Button: TMouseButton;
AShift: TShiftState; X, Y: Integer; var Handled: Boolean);
var
canClick: Boolean;
begin
if Handled then
exit;
FOrigGPSPoint := FindNearestMarker(AMapView, X, Y);
if Assigned(FOrigGPSPoint) and (AShift = FShift) then
begin
if Assigned(FOnCanClick) then
begin
canClick := true;
FOnCanClick(AMapView, FOrigGPSPoint, canClick);
if not canClick then
exit;
end;
if Assigned(FOnMarkerClick) then
FOnMarkerClick(AMapView, FOrigGPSPoint);
FMouseDownOnMarker := true;
FMousePoint := Point(X, Y);
Handled := true;
end;
end;
procedure TMarkerClickPlugin.MouseMove(AMapView: TMapView;
{%H-}AShift: TShiftState; X,Y: Integer; var Handled: Boolean);
var
gpsPoint: TGPSPoint;
canClick: Boolean;
begin
if Handled then
exit;
gpsPoint := FindNearestMarker(AMapView, X, Y);
if Assigned(gpsPoint) then
begin
canClick := true;
if Assigned(FOnCanClick) then
FOnCanClick(AMapView, gpsPoint, canClick);
end else
canClick := false;
if not FMouseDownOnMarker then
AMapView.Cursor := IfThen(canClick, FCursor, FSavedCursor);
end;
procedure TMarkerClickPlugin.MouseUp(AMapView: TMapView; Button: TMouseButton;
AShift: TShiftState; X, Y: Integer; var Handled: Boolean);
begin
FMouseDownOnMarker := false;
end;
{ Store the original MapView cursor. Is used when the mouse is not over a
clickable point. If no MapView is assigned to the plugin it is assumed that
the MapView has the default cursor. }
procedure TMarkerClickPlugin.SetMapView(AValue: TMapView);
begin
inherited;
if Assigned(MapView) then
FSavedCursor := MapView.Cursor
else
FSavedCursor := crDefault;
end;
{ TMarkerSelectAndDragPlugin }
constructor TMarkerSelectAndDragPlugin.Create(AOwner: TComponent);
begin
inherited;
FDragCursor := crSizeAll;
FSelection := TGPSPointList.Create(false); // false = do not free objects
end;
destructor TMarkerSelectAndDragPlugin.Destroy;
begin
FSelection.Free;
inherited;
end;
procedure TMarkerSelectAndDragPlugin.AddToSelection(AMapView: TMapView;
APoint: TGPSPoint);
var
idx: Integer;
begin
idx := FSelection.IndexOf(APoint);
if idx > -1 then
FSelection.Move(idx, FSelection.Count-1)
else
FSelection.Add(APoint);
DoSelect(AMapView);
end;
procedure TMarkerSelectAndDragPlugin.AfterDrawObjects(AMapView: TMapView;
var {%H-}Handled: Boolean);
begin
inherited;
DrawSelection(AMapView);
end;
procedure TMarkerSelectAndDragPlugin.DoSelect(AMapView: TMapView);
begin
if Assigned(FOnSelect) then
FOnSelect(AMapView);
end;
procedure TMarkerSelectAndDragPlugin.DragStart(AMapView: TMapView);
var
i: Integer;
begin
AMapView.Cursor := DragCursor;
FDragging := true;
// Save original selection point coordinates in case it must be restored later.
SetLength(FOrigSelection, FSelection.Count);
for i := 0 to High(FOrigSelection) do
FOrigSelection[i] := FSelection[i].RealPoint;
end;
procedure TMarkerSelectAndDragPlugin.DragTo(AMapView: TMapView; X, Y: Integer);
var
dX, dY: Integer;
begin
if FDragging then
begin
// AMapView.Cursor := DragCursor;
dX := X - FMousePoint.X;
dY := Y - FMousePoint.Y;
MoveSelectionBy(AMapView, dX, dY);
Update;
FMousePoint := Point(X, Y);
end;
end;
procedure TMarkerSelectAndDragPlugin.DragEnd(AMapView: TMapView);
begin
FDragging := false;
AMapView.Cursor := FSavedCursor;
end;
{ Draw the selection marker for the given point. The drawing engine already
has been setup for the correct settings. }
procedure TMarkerSelectAndDragPlugin.DrawPoint(AMapView: TMapView;
ADrawingEngine: TMvCustomDrawingEngine; AGpsPoint: TGPSPoint;
AScreenPoint: TPoint; AMarkerSize: Integer);
begin
if Assigned(FOnDrawPoint) then
FOnDrawPoint(AMapView, ADrawingEngine, AGPSPoint, AScreenPoint, AMarkerSize)
else
ADrawingEngine.Rectangle(
AScreenPoint.X - AMarkerSize,
AScreenPoint.Y - AMarkerSize,
AScreenPoint.X + AMarkerSize,
AScreenPoint.Y + AMarkerSize
);
end;
procedure TMarkerSelectAndDragPlugin.DrawSelection(AMapView: TMapView);
const
MARKER_SIZE = 5;
var
i, j: Integer;
P: TPoint;
markerSize: Integer;
DE: TMvCustomDrawingEngine;
pts: TPointArray;
begin
if FSelection.Count = 0 then
exit;
DE := AMapView.DrawingEngine;
DE.PenColor := clRed;
DE.PenStyle := psSolid;
DE.PenWidth := 2;
DE.BrushColor := clWhite;
DE.BrushStyle := bsSolid;
markerSize := AMapView.Scale96ToFont(MARKER_SIZE);
for i := 0 to FSelection.Count - 1 do
begin
if i = FSelection.Count - 1 then
begin
// The last point is marked as being "focused"
DE.PenWidth := 3;
DE.BrushColor := clBlack;
inc(markerSize, 1);
end;
P := AMapView.LatLonToScreen(FSelection[i].RealPoint);
pts := AMapView.CyclicPointsOf(P);
for j := 0 to High(pts) do
DrawPoint(AMapView, DE, FSelection[i], pts[j], markerSize);
end;
end;
procedure TMarkerSelectAndDragPlugin.MoveSelectionBy(AMapView: TMapView; dx, dy: Integer);
var
i: Integer;
P: TPoint;
rPt: TRealPoint;
begin
for i := 0 to FSelection.Count-1 do
begin
P := AMapView.LatLonToScreen(FSelection[i].RealPoint);
P.X := P.X + dx;
P.Y := P.Y + dy;
rPt := AMapView.ScreenToLatLon(P);
FSelection[i].MoveTo(rPt.Lon, rPt.Lat);
end;
end;
procedure TMarkerSelectAndDragPlugin.MouseDown(AMapView: TMapView;
{%H-}Button: TMouseButton; {%H-}AShift: TShiftState;
X, Y: Integer; var Handled: Boolean);
begin
inherited;
if FMouseDownOnMarker then
begin
case FClickMode of
mcmAddToSelection : AddToSelection(AMapView, FOrigGPSPoint);
mcmToggleSelection: ToggleSelected(AMapView, FOrigGPSPoint);
end;
Update;
Handled := true;
end else
begin
FSelection.Clear;
Update;
end;
end;
procedure TMarkerSelectAndDragPlugin.MouseMove(AMapView: TMapView;
{%H-}AShift: TShiftState; X,Y: Integer; var Handled: Boolean);
const
SENSITIVITY = 5;
var
R: TRect;
begin
inherited;
if FMouseDownOnMarker then
begin
if not FDragging then
begin
// The mouse must be moved by more than SENSITIVITY pixels for dragging to
// start
R := Rect(X - SENSITIVITY, Y - SENSITIVITY, X + SENSITIVITY, Y + SENSITIVITY);
if not PtInRect(R, Point(X, Y)) then
begin
FDragging := false;
exit;
end;
DragStart(AMapView);
end;
DragTo(AMapView, X, Y);
Handled := true;
end;
end;
procedure TMarkerSelectAndDragPlugin.MouseUp(AMapView: TMapView;
{%H-}Button: TMouseButton; {%H-}AShift: TShiftState;
X, Y: Integer; var Handled: Boolean);
begin
inherited;
if FDragging then
DragEnd(AMapView);
end;
procedure TMarkerSelectAndDragPlugin.ToggleSelected(AMapView: TMapView;
APoint: TGPSPoint);
var
idx: Integer;
begin
idx := FSelection.IndexOf(APoint);
if idx = -1 then
FSelection.Add(APoint)
else
FSelection.Delete(idx);
DoSelect(AMapView);
end;
{ TDraggableMarkerPlugin }
constructor TDraggableMarkerPlugin.Create(AOwner: TComponent);
begin
inherited;
FTolerance := DEFAULT_TOLERANCE;
end;
procedure TDraggableMarkerPlugin.Assign(Source: TPersistent);
begin
if Source is TDraggableMarkerPlugin then
begin
FDraggableMarkerCanMoveEvent := TDraggableMarkerPlugin(Source).DraggableMarkerCanMoveEvent;
FDraggableMarkerMovedEvent := TDraggableMarkerPlugin(Source).DraggableMarkerMovedEvent;
FDragMouseButton := TDraggableMarkerPlugin(Source).DragMouseButton;
FTolerance := TDraggableMarkerPlugin(Source).Tolerance;
end;
inherited;
end;
function TDraggableMarkerPlugin.GetFirstMarkerAtMousePos(const AMapView: TMapView;
const AX, AY: Integer): TGPSPoint;
function FindInList(AGpsList: TGpsObjList): TGpsPoint;
var
i: Integer;
begin
if Assigned(AGpsList) then
for i := AGpsList.Count-1 downto 0 do
begin
if (AGpsList[i] is TGpsPoint) then
begin
Result := TGpsPoint(AGpsList[i]);
if (not Assigned(FDraggableMarkerCanMoveEvent)) or
DraggableMarkerCanMoveEvent(Self, Result)
then
exit;
end;
end;
Result := nil;
end;
var
aArea : TRealArea;
gpsList: TGpsObjList;
layer: TMapLayer;
i : Integer;
begin
Result := Nil;
aArea.TopLeft := AMapView.ScreenToLatLon(Point(AX - FTolerance, AY - FTolerance));
aArea.BottomRight := AMapView.ScreenToLatLon(Point(AX + FTolerance, AY + FTolerance));
// Search in GPSItems for all gps-type-of-points
gpsList := AMapView.GPSItems.GetObjectsInArea(aArea);
try
Result := FindInList(gpsList);
if Result <> nil then
exit;
finally
gpsList.Free;
end;
// Search in all layers for all map-type points
for i := AMapView.Layers.Count-1 downto 0 do
begin
layer := AMapView.Layers[i];
gpsList := layer.GetObjectsInArea(aArea);
try
Result := FindInList(gpsList);
if Result <> nil then
exit;
finally
gpsList.Free;
end;
end;
end;
function TDraggableMarkerPlugin.GetDraggedMarker(AMapView: TMapView): TGPSPoint;
var
lDraggableMarkerData : TDraggableMarkerData;
cnt : Integer;
begin
Result := Nil;
cnt := GetMapViewData(AMapView,lDraggableMarkerData,SizeOf(lDraggableMarkerData));
if (cnt >= SizeOf(lDraggableMarkerData)) then
Result := lDraggableMarkerData.FDraggedMarker;
end;
function TDraggableMarkerPlugin.GetOrgPosition(AMapView : TMapView): TRealPoint;
var
lDraggableMarkerData : TDraggableMarkerData;
cnt : Integer;
begin
Result.InitXY(0.0,0.0);
cnt := GetMapViewData(AMapView,lDraggableMarkerData,SizeOf(lDraggableMarkerData));
if (cnt >= SizeOf(lDraggableMarkerData)) then
Result := lDraggableMarkerData.FOrgPosition;
end;
procedure TDraggableMarkerPlugin.MouseDown(AMapView: TMapView; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer; var Handled: Boolean);
var
lDraggableMarkerData : TDraggableMarkerData;
begin
if Handled then Exit;
if not MapViewEnabled[AMapView] then Exit;
if FDragMouseButton <> Button then Exit;
lDraggableMarkerData.FDraggedMarker := GetFirstMarkerAtMousePos(AMapView,X,Y);
if Assigned(lDraggableMarkerData.FDraggedMarker) then
begin
lDraggableMarkerData.FOrgPosition.Lon:= lDraggableMarkerData.FDraggedMarker.Lon;
lDraggableMarkerData.FOrgPosition.Lat:= lDraggableMarkerData.FDraggedMarker.Lat;
SetMapViewData(AMapView,lDraggableMarkerData,SizeOf(lDraggableMarkerData));
Handled := True;
end;
end;
procedure TDraggableMarkerPlugin.MouseMove(AMapView: TMapView;
AShift: TShiftState; X, Y: Integer; var Handled: Boolean);
var
pt : TPoint;
rpt : TRealPoint;
ele : Double;
dt : TDateTime;
lDraggableMarkerData : TDraggableMarkerData;
cnt : Integer;
begin
cnt := GetMapViewData(AMapView,lDraggableMarkerData,SizeOf(lDraggableMarkerData));
if not MapViewEnabled[AMapView] then Exit;
if (cnt >= SizeOf(lDraggableMarkerData)) and
Assigned(lDraggableMarkerData.FDraggedMarker) then
begin
pt.X := X;
pt.Y := Y;
rpt := AMapView.ScreenToLatLon(pt);
ele := lDraggableMarkerData.FDraggedMarker.Elevation;
dt := lDraggableMarkerData.FDraggedMarker.DateTime;
lDraggableMarkerData.FDraggedMarker.MoveTo(rpt.Lon, rpt.Lat,ele,dt);
AMapView.Invalidate;
Handled := True; // Prevent the dragging of the map!!
end
else
begin
if Assigned(GetFirstMarkerAtMousePos(AMapView,X,Y)) then
begin
AMapView.Cursor := crHandPoint;
Handled := True;
end
else if not Handled then
AMapView.Cursor := crDefault;
end
end;
procedure TDraggableMarkerPlugin.MouseUp(AMapView: TMapView; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer; var Handled: Boolean);
var
lpDraggableMarkerData : PDraggableMarkerData;
begin
if not MapViewEnabled[AMapView] then Exit;
if FDragMouseButton <> Button then Exit;
lpDraggableMarkerData := MapViewDataPtr[AMapView];
if Assigned(lpDraggableMarkerData) and Assigned(lpDraggableMarkerData^.FDraggedMarker) then
begin
if Assigned(FDraggableMarkerMovedEvent) then
FDraggableMarkerMovedEvent(Self,lpDraggableMarkerData^.FDraggedMarker,lpDraggableMarkerData^.FOrgPosition);
Handled := True;
lpDraggableMarkerData^.FDraggedMarker := Nil;
end;
end;
initialization
RegisterPluginClass(TMarkerHintPlugin, 'Marker hint');
RegisterPluginClass(TMarkerClickPlugin, 'Marker click');
RegisterPluginClass(TMarkerSelectAndDragPlugin, 'Marker select and drag');
RegisterPluginClass(TDraggableMarkerPlugin, 'Draggable marker');
end.

519
components/lazmapviewer/source/addons/plugins/mvplugins.pas
View File

@ -136,144 +136,8 @@ type
end;
{ TMarkerClickPlugin }
{ TUserDefinedPlugin }
TMarkerCanClickEvent = procedure (AMapView: TMapView; APoint: TGPSPoint; var CanClick: Boolean) of object;
TMarkerClickEvent = procedure (AMapView: TMapView; APoint: TGPSPoint) of object;
TMarkerClickPlugin = class(TMvMarkerPlugin)
private
FCursor: TCursor;
FShift: TShiftState;
FOnCanClick: TMarkerCanClickEvent;
FOnMarkerClick: TMarkerClickEvent;
protected
FMouseDown: Boolean;
FMousePoint: TPoint;
FOrigGpsPoint: TGPSPoint;
FSavedCursor: TCursor;
procedure MouseDown(AMapView: TMapView; {%H-}Button: TMouseButton;
AShift: TShiftState; X,Y: Integer; var Handled: Boolean); override;
procedure MouseMove(AMapView: TMapView; {%H-}AShift: TShiftState;
X,Y: Integer; var Handled: Boolean); override;
procedure MouseUp(AMapView: TMapView; {%H-}Button: TMouseButton;
AShift: TShiftState; X,Y: Integer; var Handled: Boolean); override;
procedure SetMapView(AValue: TMapView); override;
public
constructor Create(AOwner: TComponent); override;
published
property Cursor: TCursor read FCursor write FCursor default crHandPoint;
property Shift: TShiftState read FShift write FShift default [ssLeft];
property OnCanClick: TMarkerCanClickEvent read FOnCanClick write FOnCanClick;
property OnMarkerClick: TMarkerClickEvent read FOnMarkerClick write FOnMarkerClick;
end;
{ TMarkerDragPlugin }
TMarkerDragPlugin = class(TMarkerClickPlugin)
private
FDragCursor: TCursor;
protected
procedure MouseDown(AMapView: TMapView; {%H-}Button: TMouseButton;
AShift: TShiftState; X,Y: Integer; var Handled: Boolean); override;
procedure MouseMove(AMapView: TMapView; {%H-}AShift: TShiftState;
X,Y: Integer; var Handled: Boolean); override;
procedure MouseUp(AMapView: TMapView; {%H-}Button: TMouseButton;
AShift: TShiftState; X,Y: Integer; var Handled: Boolean); override;
public
constructor Create(AOwner: TComponent); override;
published
property DragCursor: TCursor read FDragCursor write FDragCursor default crSizeAll;
end;
{ TMarkerHintPlugin }
TMarkerCreateHintWindowEvent = procedure(AMapView: TMapView;
out AHintWindow: THintWindow) of object;
TMarkerHintEvent = procedure (AMapView: TMapView; APoint: TGPSPoint;
var AHint: String; var AShowHint: Boolean) of object;
TMarkerHintPlugin = class(TMvMarkerPlugin)
private
const
DEFAULT_HINT_OFFSET_X = 0;
DEFAULT_HINT_OFFSET_Y = 15;
DEFAULT_HIDE_INTERVAL = 1000;
private
FAutoHideHint: Boolean;
FHideInterval: Integer;
FHintOffsetX: Integer;
FHintOffsetY: Integer;
FHintWindow: THintWindow;
FShowHint: Boolean;
FOnCreateHintWindow: TMarkerCreateHintWindowEvent;
FOnHint: TMarkerHintEvent;
protected
function CreateHintWindow(AMapView: TMapView): THintWindow; virtual;
procedure HideHint; virtual;
procedure MouseMove(AMapView: TMapView; {%H-}AShift: TShiftState; X,Y: Integer;
var Handled: Boolean); override;
public
constructor Create(AOwner: TComponent); override;
published
property AutoHideHint: Boolean read FAutoHideHint write FAutoHideHint default false;
property HideInterval: Integer read FHideInterval write FHideInterval default 0;
property HintOffsetX: Integer read FHintOffsetX write FHintOffsetX default DEFAULT_HINT_OFFSET_X;
property HintOffsetY: Integer read FHintOffsetY write FHintOffsetY default DEFAULT_HINT_OFFSET_Y;
property ShowHint: Boolean read FShowHint write FShowHint default true;
property OnCreateHintWindow: TMarkerCreateHintWindowEvent read FOnCreateHintWindow write FOnCreateHintWindow;
property OnHint: TMarkerHintEvent read FOnHint write FOnHint;
end;
{ TDraggableMarkerPlugin }
TDraggableMarkerPlugin = class;
TDraggableMarkerCanMoveEvent = function (Sender : TDraggableMarkerPlugin; AMarker : TGPSPoint) : Boolean of object;
TDraggableMarkerMovedEvent = procedure (Sender : TDraggableMarkerPlugin; AMarker : TGPSPoint; AOrgPosition : TRealPoint) of object;
{ TDraggableMarkerData }
PDraggableMarkerData = ^TDraggableMarkerData;
TDraggableMarkerData = record
FDraggedMarker : TGPSPoint;
FOrgPosition : TRealPoint;
end;
TDraggableMarkerPlugin = class(TMvMultiMapsPlugin)
private
const
DEFAULT_TOLERANCE = 5;
private
FDraggableMarkerCanMoveEvent : TDraggableMarkerCanMoveEvent;
FDraggableMarkerMovedEvent : TDraggableMarkerMovedEvent;
FDragMouseButton: TMouseButton;
FTolerance: Integer;
function GetFirstMarkerAtMousePos(const AMapView: TMapView; const AX, AY : Integer) : TGPSPoint;
function GetDraggedMarker(AMapView : TMapView) : TGPSPoint;
function GetOrgPosition(AMapView : TMapView): TRealPoint;
protected
procedure MouseDown(AMapView: TMapView; {%H-}Button: TMouseButton; {%H-}Shift: TShiftState;
X, Y: Integer; var Handled: Boolean); override;
procedure MouseMove(AMapView: TMapView; {%H-}AShift: TShiftState; X,Y: Integer;
var Handled: Boolean); override;
procedure MouseUp(AMapView: TMapView; {%H-}Button: TMouseButton; {%H-}Shift: TShiftState;
{%H-}X, {%H-}Y: Integer; var Handled: Boolean); override;
public
constructor Create(AOwner: TComponent); override;
procedure Assign(Source: TPersistent); override;
property DraggedMarker[AMapView : TMapView] : TGPSPoint read GetDraggedMarker;
property OrgPosition[AMapView : TMapView] : TRealPoint read GetOrgPosition;
published
property DraggableMarkerCanMoveEvent : TDraggableMarkerCanMoveEvent read FDraggableMarkerCanMoveEvent write FDraggableMarkerCanMoveEvent;
property DraggableMarkerMovedEvent : TDraggableMarkerMovedEvent read FDraggableMarkerMovedEvent write FDraggableMarkerMovedEvent;
property DragMouseButton : TMouseButton read FDragMouseButton write FDragMouseButton default mbLeft;
property Tolerance: Integer read FTolerance write FTolerance default DEFAULT_TOLERANCE;
end;
type
TMvPluginCenterMovingEvent = procedure (Sender: TObject; AMapView: TMapView;
var ANewCenter: TRealPoint; var Allow, Handled: Boolean) of object;
@ -305,8 +169,6 @@ type
TMvPluginZoomChangingEvent = procedure (Sender: TObject; AMapView: TMapView;
NewZoom: Integer; var Allow, Handled: Boolean) of object;
{ TUserDefinedPlugin }
TUserDefinedPlugin = class(TMvCustomPlugin)
private
FAfterDrawObjectsEvent : TMvPluginNotifyEvent;
@ -384,13 +246,7 @@ implementation
uses
Types;
function IfThen(AValue: Boolean; ACursor1, ACursor2: TCursor): TCursor;
begin
if AValue then Result := ACursor1 else Result := ACursor2;
end;
{ TCenterMargerPlugin }
{ TCenterMarkerPlugin }
constructor TCenterMarkerPlugin.Create(AOwner: TComponent);
begin
@ -925,7 +781,6 @@ begin
Result := -1;
end;
procedure TLegalNoticePlugin.SetPosition(AValue: TLegalNoticePosition);
begin
if FPosition = AValue then Exit;
@ -962,372 +817,6 @@ begin
end;
{ TMarkerClickPlugin }
constructor TMarkerClickPlugin.Create(AOwner: TComponent);
begin
inherited;
FCursor := crHandPoint;
FSavedCursor := crDefault;
FShift := [ssLeft];
end;
procedure TMarkerClickPlugin.MouseDown(AMapView: TMapView; Button: TMouseButton;
AShift: TShiftState; X, Y: Integer; var Handled: Boolean);
var
canClick: Boolean;
begin
if Handled then
exit;
FOrigGPSPoint := FindNearestMarker(AMapView, X, Y);
if Assigned(FOrigGPSPoint) and (AShift = FShift) then
begin
if Assigned(FOnCanClick) then
begin
canClick := true;
FOnCanClick(AMapView, FOrigGPSPoint, canClick);
if not canClick then
exit;
end;
if Assigned(FOnMarkerClick) then
FOnMarkerClick(AMapView, FOrigGPSPoint);
FMouseDown := true;
FMousePoint := Point(X, Y);
Handled := true;
end;
end;
procedure TMarkerClickPlugin.MouseMove(AMapView: TMapView;
{%H-}AShift: TShiftState; X,Y: Integer; var Handled: Boolean);
var
gpsPoint: TGPSPoint;
canClick: Boolean;
begin
if Handled then
exit;
gpsPoint := FindNearestMarker(AMapView, X, Y);
if Assigned(gpsPoint) then
begin
canClick := true;
if Assigned(FOnCanClick) then
FOnCanClick(AMapView, gpsPoint, canClick);
end else
canClick := false;
AMapView.Cursor := IfThen(canClick, FCursor, FSavedCursor);
end;
procedure TMarkerClickPlugin.MouseUp(AMapView: TMapView; Button: TMouseButton;
AShift: TShiftState; X, Y: Integer; var Handled: Boolean);
begin
FMouseDown := false;
end;
{ Store the original MapView cursor. Is used when the mouse is not over a
clickable point. If no MapView is assigned to the plugin it is assumed that
the MapView has the default cursor. }
procedure TMarkerClickPlugin.SetMapView(AValue: TMapView);
begin
inherited;
if Assigned(MapView) then
FSavedCursor := MapView.Cursor
else
FSavedCursor := crDefault;
end;
{ TMarkerDragPlugin }
constructor TMarkerDragPlugin.Create(AOwner: TComponent);
begin
inherited;
FDragCursor := crSizeAll;
end;
procedure TMarkerDragPlugin.MouseDown(AMapView: TMapView; {%H-}Button: TMouseButton;
AShift: TShiftState; X,Y: Integer; var Handled: Boolean);
begin
inherited;
if FMouseDown then
Handled := true;
end;
procedure TMarkerDragPlugin.MouseMove(AMapView: TMapView;
{%H-}AShift: TShiftState; X,Y: Integer; var Handled: Boolean);
var
P: TRealPoint;
begin
inherited;
if FMouseDown then
begin
AMapView.Cursor := FDragCursor;
P := AMapView.ScreenToLatLon(Point(X, Y));
FOrigGPSPoint.MoveTo(P.Lon, P.Lat);
Update;
Handled := true;
end;
end;
procedure TMarkerDragPlugin.MouseUp(AMapView: TMapView; {%H-}Button: TMouseButton;
AShift: TShiftState; X,Y: Integer; var Handled: Boolean);
begin
inherited;
AMapView.Cursor := FSavedCursor;
end;
{ TMarkerHintPlugin }
constructor TMarkerHintPlugin.Create(AOwner: TComponent);
begin
inherited;
FHintOffsetX := DEFAULT_HINT_OFFSET_X;
FHintOffsetY := DEFAULT_HINT_OFFSET_Y;
FHideInterval := DEFAULT_HIDE_INTERVAL;
FShowHint := true;
end;
function TMarkerHintPlugin.CreateHintWindow(AMapView: TMapView): THintWindow;
begin
if Assigned(FOnCreateHintWindow) then
FOnCreateHintWindow(AMapView, Result)
else
Result := THintWindow.Create(self);
end;
procedure TMarkerHintPlugin.HideHint;
begin
FreeAndNil(FHintWindow);
end;
procedure TMarkerHintPlugin.MouseMove(AMapView: TMapView; AShift: TShiftState;
X,Y: Integer; var Handled: Boolean);
var
gpsPoint: TGPSPoint;
hintTxt: String;
hintRct: TRect;
hintPt: TPoint;
hintShow: Boolean;
dx, dy: Integer;
begin
if Handled then
exit;
gpsPoint := FindNearestMarker(AMapView, X, Y);
if gpsPoint = nil then
begin
HideHint;
exit;
end;
if gpsPoint.Name <> '' then
hintTxt := Format('%s' + LineEnding + '(%s / %s)', [
gpsPoint.Name, LatToStr(gpsPoint.Lat, true), LonToStr(gpsPoint.Lon, true)
])
else
hintTxt := Format('(%s / %s)', [LatToStr(gpsPoint.Lat, true), LonToStr(gpsPoint.Lon, true)]);
if Assigned(FOnHint) then
begin
hintShow := true;
FOnHint(AMapView, gpsPoint, hintTxt, hintShow);
end;
if (hintTxt = '') or not (FShowHint and hintShow) then
exit;
if not Assigned(FHintWindow) then
FHintWindow := CreateHintWindow(AMapView);
FHintWindow.AutoHide := FAutoHideHint;
FHintWindow.HideInterval := FHideInterval;
hintRct := FHintWindow.CalcHintRect(AMapView.Width, hintTxt, nil);
hintPt := AMapView.ClientToScreen(Point(X, Y));
if FHintOffsetX = -1 then
dx := - hintRct.Width div 2
else
dx := FHintOffsetX;
if FHintOffsetY = -1 then
dy := - hintRct.Height div 2
else
dy := FHintOffsetY;
OffsetRect(hintRct, hintPt.X + dx, hintPt.Y + dy);
FHintWindow.ActivateHint(hintRct, hintTxt);
end;
{ TDraggableMarkerPlugin }
constructor TDraggableMarkerPlugin.Create(AOwner: TComponent);
begin
inherited;
FTolerance := DEFAULT_TOLERANCE;
end;
procedure TDraggableMarkerPlugin.Assign(Source: TPersistent);
begin
if Source is TDraggableMarkerPlugin then
begin
FDraggableMarkerCanMoveEvent := TDraggableMarkerPlugin(Source).DraggableMarkerCanMoveEvent;
FDraggableMarkerMovedEvent := TDraggableMarkerPlugin(Source).DraggableMarkerMovedEvent;
FDragMouseButton := TDraggableMarkerPlugin(Source).DragMouseButton;
FTolerance := TDraggableMarkerPlugin(Source).Tolerance;
end;
inherited;
end;
function TDraggableMarkerPlugin.GetFirstMarkerAtMousePos(const AMapView: TMapView;
const AX, AY: Integer): TGPSPoint;
function FindInList(AGpsList: TGpsObjList): TGpsPoint;
var
i: Integer;
begin
if Assigned(AGpsList) then
for i := AGpsList.Count-1 downto 0 do
begin
if (AGpsList[i] is TGpsPoint) then
begin
Result := TGpsPoint(AGpsList[i]);
if (not Assigned(FDraggableMarkerCanMoveEvent)) or
DraggableMarkerCanMoveEvent(Self, Result)
then
exit;
end;
end;
Result := nil;
end;
var
aArea : TRealArea;
gpsList: TGpsObjList;
layer: TMapLayer;
i : Integer;
begin
Result := Nil;
aArea.TopLeft := AMapView.ScreenToLatLon(Point(AX - FTolerance, AY - FTolerance));
aArea.BottomRight := AMapView.ScreenToLatLon(Point(AX + FTolerance, AY + FTolerance));
// Search in GPSItems for all gps-type-of-points
gpsList := AMapView.GPSItems.GetObjectsInArea(aArea);
try
Result := FindInList(gpsList);
if Result <> nil then
exit;
finally
gpsList.Free;
end;
// Search in all layers for all map-type points
for i := AMapView.Layers.Count-1 downto 0 do
begin
layer := AMapView.Layers[i];
gpsList := layer.GetObjectsInArea(aArea);
try
Result := FindInList(gpsList);
if Result <> nil then
exit;
finally
gpsList.Free;
end;
end;
end;
function TDraggableMarkerPlugin.GetDraggedMarker(AMapView: TMapView): TGPSPoint;
var
lDraggableMarkerData : TDraggableMarkerData;
cnt : Integer;
begin
Result := Nil;
cnt := GetMapViewData(AMapView,lDraggableMarkerData,SizeOf(lDraggableMarkerData));
if (cnt >= SizeOf(lDraggableMarkerData)) then
Result := lDraggableMarkerData.FDraggedMarker;
end;
function TDraggableMarkerPlugin.GetOrgPosition(AMapView : TMapView): TRealPoint;
var
lDraggableMarkerData : TDraggableMarkerData;
cnt : Integer;
begin
Result.InitXY(0.0,0.0);
cnt := GetMapViewData(AMapView,lDraggableMarkerData,SizeOf(lDraggableMarkerData));
if (cnt >= SizeOf(lDraggableMarkerData)) then
Result := lDraggableMarkerData.FOrgPosition;
end;
procedure TDraggableMarkerPlugin.MouseDown(AMapView: TMapView; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer; var Handled: Boolean);
var
lDraggableMarkerData : TDraggableMarkerData;
begin
if Handled then Exit;
if not MapViewEnabled[AMapView] then Exit;
if FDragMouseButton <> Button then Exit;
lDraggableMarkerData.FDraggedMarker := GetFirstMarkerAtMousePos(AMapView,X,Y);
if Assigned(lDraggableMarkerData.FDraggedMarker) then
begin
lDraggableMarkerData.FOrgPosition.Lon:= lDraggableMarkerData.FDraggedMarker.Lon;
lDraggableMarkerData.FOrgPosition.Lat:= lDraggableMarkerData.FDraggedMarker.Lat;
SetMapViewData(AMapView,lDraggableMarkerData,SizeOf(lDraggableMarkerData));
Handled := True;
end;
end;
procedure TDraggableMarkerPlugin.MouseMove(AMapView: TMapView;
AShift: TShiftState; X, Y: Integer; var Handled: Boolean);
var
pt : TPoint;
rpt : TRealPoint;
ele : Double;
dt : TDateTime;
lDraggableMarkerData : TDraggableMarkerData;
cnt : Integer;
begin
cnt := GetMapViewData(AMapView,lDraggableMarkerData,SizeOf(lDraggableMarkerData));
if not MapViewEnabled[AMapView] then Exit;
if (cnt >= SizeOf(lDraggableMarkerData)) and
Assigned(lDraggableMarkerData.FDraggedMarker) then
begin
pt.X := X;
pt.Y := Y;
rpt := AMapView.ScreenToLatLon(pt);
ele := lDraggableMarkerData.FDraggedMarker.Elevation;
dt := lDraggableMarkerData.FDraggedMarker.DateTime;
lDraggableMarkerData.FDraggedMarker.MoveTo(rpt.Lon, rpt.Lat,ele,dt);
AMapView.Invalidate;
Handled := True; // Prevent the dragging of the map!!
end
else
begin
if Assigned(GetFirstMarkerAtMousePos(AMapView,X,Y)) then
begin
AMapView.Cursor := crHandPoint;
Handled := True;
end
else if not Handled then
AMapView.Cursor := crDefault;
end
end;
procedure TDraggableMarkerPlugin.MouseUp(AMapView: TMapView; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer; var Handled: Boolean);
var
lpDraggableMarkerData : PDraggableMarkerData;
begin
if not MapViewEnabled[AMapView] then Exit;
if FDragMouseButton <> Button then Exit;
lpDraggableMarkerData := MapViewDataPtr[AMapView];
if Assigned(lpDraggableMarkerData) and Assigned(lpDraggableMarkerData^.FDraggedMarker) then
begin
if Assigned(FDraggableMarkerMovedEvent) then
FDraggableMarkerMovedEvent(Self,lpDraggableMarkerData^.FDraggedMarker,lpDraggableMarkerData^.FOrgPosition);
Handled := True;
lpDraggableMarkerData^.FDraggedMarker := Nil;
end;
end;
{ TMvCustomPlugin }
procedure TUserDefinedPlugin.AfterDrawObjects(AMapView: TMapView;
@ -1459,10 +948,6 @@ initialization
RegisterPluginClass(TTileInfoPlugin, 'Tile info');
RegisterPluginClass(TLegalNoticePlugin, 'Legal notice');
RegisterPluginClass(TLinkedMapsPlugin, 'Linked maps');
RegisterPluginClass(TMarkerHintPlugin, 'Marker hint');
RegisterPluginClass(TMarkerClickPlugin, 'Marker click');
RegisterPluginClass(TMarkerDragPlugin, 'Marker drag');
RegisterPluginClass(TDraggableMarkerPlugin, 'Draggable marker');
RegisterPluginClass(TUserDefinedPlugin, 'User-defined');
end.