From 06b87dfadedcad8d76201a8feadc144217580dfd Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Wed, 29 Jan 2025 17:38:26 +0000 Subject: [PATCH] LazMapViewer: Add GreatCirclePainterPlugin by Ekkehard Domning. Refactor some calculation routines in mvGeoMath git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@9609 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../greatcircle_demo.lpi | 154 +++ .../greatcircle_demo.lpr | 24 + .../greatcirclepaint_demo/main.lfm | 542 ++++++++ .../greatcirclepaint_demo/main.pas | 300 +++++ components/lazmapviewer/lazmapviewerpkg.lpk | 8 +- components/lazmapviewer/lazmapviewerpkg.pas | 2 +- .../mvgreatcirclepainterplugin.pas | 1111 +++++++++++++++++ components/lazmapviewer/source/mvgeomath.pas | 92 +- 8 files changed, 2205 insertions(+), 28 deletions(-) create mode 100644 components/lazmapviewer/examples/plugin_demos/greatcirclepaint_demo/greatcircle_demo.lpi create mode 100644 components/lazmapviewer/examples/plugin_demos/greatcirclepaint_demo/greatcircle_demo.lpr create mode 100644 components/lazmapviewer/examples/plugin_demos/greatcirclepaint_demo/main.lfm create mode 100644 components/lazmapviewer/examples/plugin_demos/greatcirclepaint_demo/main.pas create mode 100644 components/lazmapviewer/source/addons/plugins/greatcircle/mvgreatcirclepainterplugin.pas diff --git a/components/lazmapviewer/examples/plugin_demos/greatcirclepaint_demo/greatcircle_demo.lpi b/components/lazmapviewer/examples/plugin_demos/greatcirclepaint_demo/greatcircle_demo.lpi new file mode 100644 index 000000000..3bc8a1e50 --- /dev/null +++ b/components/lazmapviewer/examples/plugin_demos/greatcirclepaint_demo/greatcircle_demo.lpi @@ -0,0 +1,154 @@ + + + + + + + + + <Scaled Value="True"/> + <ResourceType Value="res"/> + <UseXPManifest Value="True"/> + <XPManifest> + <DpiAware Value="True"/> + </XPManifest> + <Icon Value="0"/> + </General> + <BuildModes> + <Item Name="Default" Default="True"/> + <Item Name="Debug"> + <CompilerOptions> + <Version Value="11"/> + <PathDelim Value="\"/> + <Target> + <Filename Value="greatcircle_demo"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Parsing> + <SyntaxOptions> + <IncludeAssertionCode Value="True"/> + </SyntaxOptions> + </Parsing> + <CodeGeneration> + <Checks> + <IOChecks Value="True"/> + <RangeChecks Value="True"/> + <OverflowChecks Value="True"/> + <StackChecks Value="True"/> + </Checks> + <VerifyObjMethodCallValidity Value="True"/> + </CodeGeneration> + <Linking> + <Debugging> + <DebugInfoType Value="dsDwarf3"/> + <UseHeaptrc Value="True"/> + <TrashVariables Value="True"/> + <UseExternalDbgSyms Value="True"/> + </Debugging> + <Options> + <Win32> + <GraphicApplication Value="True"/> + </Win32> + </Options> + </Linking> + </CompilerOptions> + </Item> + <Item Name="Release"> + <CompilerOptions> + <Version Value="11"/> + <PathDelim Value="\"/> + <Target> + <Filename Value="greatcircle_demo"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <CodeGeneration> + <SmartLinkUnit Value="True"/> + <Optimizations> + <OptimizationLevel Value="3"/> + </Optimizations> + </CodeGeneration> + <Linking> + <Debugging> + <GenerateDebugInfo Value="False"/> + <RunWithoutDebug Value="True"/> + </Debugging> + <LinkSmart Value="True"/> + <Options> + <Win32> + <GraphicApplication Value="True"/> + </Win32> + </Options> + </Linking> + </CompilerOptions> + </Item> + </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="greatcircle_demo.lpr"/> + <IsPartOfProject Value="True"/> + </Unit> + <Unit> + <Filename Value="main.pas"/> + <IsPartOfProject Value="True"/> + <ComponentName Value="MainForm"/> + <HasResources Value="True"/> + <ResourceBaseClass Value="Form"/> + </Unit> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <PathDelim Value="\"/> + <Target> + <Filename Value="greatcircle_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> diff --git a/components/lazmapviewer/examples/plugin_demos/greatcirclepaint_demo/greatcircle_demo.lpr b/components/lazmapviewer/examples/plugin_demos/greatcirclepaint_demo/greatcircle_demo.lpr new file mode 100644 index 000000000..5644a95d5 --- /dev/null +++ b/components/lazmapviewer/examples/plugin_demos/greatcirclepaint_demo/greatcircle_demo.lpr @@ -0,0 +1,24 @@ +program greatcircle_demo; + +{$mode objfpc}{$H+} + +uses + {$IFDEF UNIX} + cthreads, + {$ENDIF} + {$IFDEF HASAMIGA} + athreads, + {$ENDIF} + Interfaces, // this includes the LCL widgetset + Forms, main; + +{$R *.res} + +begin + RequireDerivedFormResource:=True; + Application.Scaled:=True; + Application.Initialize; + Application.CreateForm(TMainForm, MainForm); + Application.Run; +end. + diff --git a/components/lazmapviewer/examples/plugin_demos/greatcirclepaint_demo/main.lfm b/components/lazmapviewer/examples/plugin_demos/greatcirclepaint_demo/main.lfm new file mode 100644 index 000000000..0cc9db382 --- /dev/null +++ b/components/lazmapviewer/examples/plugin_demos/greatcirclepaint_demo/main.lfm @@ -0,0 +1,542 @@ +object MainForm: TMainForm + Left = 324 + Height = 493 + Top = 119 + Width = 872 + Caption = 'Great Circle Plugin Demo' + ClientHeight = 493 + ClientWidth = 872 + LCLVersion = '4.99.0.0' + OnActivate = FormActivate + OnCreate = FormCreate + object ParamsPanel: TPanel + Left = 8 + Height = 454 + Top = 8 + Width = 200 + Align = alLeft + BorderSpacing.Around = 8 + BevelOuter = bvNone + ClientHeight = 454 + ClientWidth = 200 + TabOrder = 0 + object cbCyclicMap: TCheckBox + AnchorSideLeft.Control = ParamsPanel + AnchorSideTop.Control = ParamsPanel + Left = 0 + Height = 19 + Top = 0 + Width = 77 + Caption = 'Cyclic Map' + Checked = True + State = cbChecked + TabOrder = 0 + OnChange = cbCyclicMapChange + end + object cbZOrder: TComboBox + AnchorSideLeft.Control = tbSegmentLength + AnchorSideTop.Control = cbCyclicMap + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = ParamsPanel + AnchorSideRight.Side = asrBottom + Left = 92 + Height = 23 + Top = 27 + Width = 108 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 8 + ItemHeight = 15 + ItemIndex = 0 + Items.Strings = ( + 'Canvas' + 'In front of markers' + 'Behind markers' + ) + Style = csDropDownList + TabOrder = 1 + Text = 'Canvas' + OnChange = cbZOrderChange + end + object lblZOrder: TLabel + AnchorSideLeft.Control = ParamsPanel + AnchorSideTop.Control = cbZOrder + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = Label2 + AnchorSideRight.Side = asrBottom + Left = 42 + Height = 15 + Top = 31 + Width = 42 + Anchors = [akTop, akRight] + BorderSpacing.Top = 4 + Caption = 'Z-Order' + end + object tbSegmentLength: TTrackBar + AnchorSideLeft.Control = Label2 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = cbZOrder + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = ParamsPanel + AnchorSideRight.Side = asrBottom + Left = 92 + Height = 25 + Top = 58 + Width = 108 + Position = 0 + OnChange = tbSegmentLengthChange + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + TabOrder = 2 + end + object Label2: TLabel + AnchorSideLeft.Control = ParamsPanel + AnchorSideTop.Control = tbSegmentLength + Left = 0 + Height = 15 + Top = 58 + Width = 84 + Caption = 'Segment length' + end + object gbPresets: TGroupBox + AnchorSideLeft.Control = ParamsPanel + AnchorSideTop.Control = GroupBox3 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = ParamsPanel + AnchorSideRight.Side = asrBottom + Left = 0 + Height = 161 + Top = 294 + Width = 200 + Anchors = [akTop, akLeft, akRight] + AutoSize = True + BorderSpacing.Top = 8 + Caption = 'Presets' + ChildSizing.LeftRightSpacing = 16 + ChildSizing.TopBottomSpacing = 8 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 1 + ClientHeight = 141 + ClientWidth = 196 + TabOrder = 6 + object btnPresetPolar: TButton + Left = 16 + Height = 25 + Top = 8 + Width = 164 + Caption = 'Polar' + TabOrder = 0 + OnClick = btnPresetPolarClick + end + object btnPreseEquator: TButton + Left = 16 + Height = 25 + Top = 33 + Width = 164 + Caption = 'Equator' + TabOrder = 1 + OnClick = btnPreseEquatorClick + end + object btnPresetPorto: TButton + Left = 16 + Height = 25 + Top = 58 + Width = 164 + Caption = 'Porto-PoS' + TabOrder = 2 + OnClick = btnPresetPortoClick + end + object btnPresetLongestSeaWay: TButton + Left = 16 + Height = 25 + Top = 83 + Width = 164 + Caption = 'Longest sea way' + TabOrder = 3 + OnClick = btnPresetLongestSeaWayClick + end + object btnLongestEarthWay: TButton + Left = 16 + Height = 25 + Top = 108 + Width = 164 + Caption = 'Longest earth way' + TabOrder = 4 + OnClick = btnLongestEarthWayClick + end + end + object cgOptions: TCheckGroup + AnchorSideLeft.Control = ParamsPanel + AnchorSideTop.Control = tbSegmentLength + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = ParamsPanel + AnchorSideRight.Side = asrBottom + Left = 0 + Height = 89 + Top = 83 + Width = 200 + Anchors = [akTop, akLeft, akRight] + AutoFill = True + AutoSize = True + Caption = 'Options' + ChildSizing.LeftRightSpacing = 6 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 1 + ClientHeight = 69 + ClientWidth = 196 + Items.Strings = ( + 'Mark Start' + 'Mark Center' + 'Mark Destination' + ) + TabOrder = 3 + OnItemClick = cgOptionsItemClick + Data = { + 03000000020202 + } + end + object gbOrthodromePen: TGroupBox + AnchorSideLeft.Control = ParamsPanel + AnchorSideTop.Control = cgOptions + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = ParamsPanel + AnchorSideRight.Side = asrBottom + Left = 0 + Height = 49 + Top = 180 + Width = 200 + Anchors = [akTop, akLeft, akRight] + AutoSize = True + BorderSpacing.Top = 8 + Caption = 'Orthodrome Pen' + ClientHeight = 29 + ClientWidth = 196 + TabOrder = 4 + object lblOrthodromePenWidth: TLabel + AnchorSideLeft.Control = gbOrthodromePen + AnchorSideTop.Control = seOrthodromePenWidth + AnchorSideTop.Side = asrCenter + Left = 16 + Height = 15 + Top = 4 + Width = 32 + BorderSpacing.Left = 16 + Caption = 'Width' + end + object seOrthodromePenWidth: TSpinEdit + AnchorSideLeft.Control = lblOrthodromePenWidth + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = clbOrthodromePenColor + AnchorSideTop.Side = asrCenter + Left = 56 + Height = 23 + Top = 0 + Width = 64 + Alignment = taRightJustify + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 6 + MaxValue = 10 + MinValue = 1 + TabOrder = 0 + Value = 3 + OnChange = seOrthodromePenWidthChange + end + object clbOrthodromePenColor: TColorButton + AnchorSideLeft.Control = seOrthodromePenWidth + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = seOrthodromePenWidth + AnchorSideRight.Control = gbOrthodromePen + AnchorSideRight.Side = asrBottom + Left = 128 + Height = 25 + Top = -1 + Width = 60 + Anchors = [akLeft, akRight] + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + BorderWidth = 2 + ButtonColorSize = 16 + ButtonColor = clPurple + OnColorChanged = clbOrthodromePenColorColorChanged + end + end + object GroupBox3: TGroupBox + AnchorSideLeft.Control = ParamsPanel + AnchorSideTop.Control = gbOrthodromePen + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = ParamsPanel + AnchorSideRight.Side = asrBottom + Left = 0 + Height = 49 + Top = 237 + Width = 200 + Anchors = [akTop, akLeft, akRight] + AutoSize = True + BorderSpacing.Top = 8 + Caption = 'Great Circle Pen' + ClientHeight = 29 + ClientWidth = 196 + TabOrder = 5 + object lblGreatCirclePenWidth: TLabel + AnchorSideLeft.Control = GroupBox3 + AnchorSideTop.Control = seGreatCirclePenWidth + AnchorSideTop.Side = asrCenter + Left = 16 + Height = 15 + Top = 4 + Width = 32 + BorderSpacing.Left = 16 + Caption = 'Width' + end + object seGreatCirclePenWidth: TSpinEdit + AnchorSideLeft.Control = lblGreatCirclePenWidth + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = GroupBox3 + Left = 56 + Height = 23 + Top = 0 + Width = 64 + Alignment = taRightJustify + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 6 + MaxValue = 10 + MinValue = 1 + TabOrder = 0 + Value = 1 + OnChange = seGreatCirclePenWidthChange + end + object clbGreatCirclePenColor: TColorButton + AnchorSideLeft.Control = seGreatCirclePenWidth + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = GroupBox3 + AnchorSideRight.Side = asrBottom + Left = 128 + Height = 25 + Top = 0 + Width = 60 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Right = 8 + BorderWidth = 2 + ButtonColorSize = 16 + ButtonColor = clBlack + OnColorChanged = clbGreatCirclePenColorColorChanged + end + end + end + object StatusBar: TStatusBar + Left = 0 + Height = 23 + Top = 470 + Width = 872 + Panels = < + item + Bevel = pbRaised + Text = 'Orthodrome (km)' + Width = 100 + end + item + Width = 60 + end + item + Text = 'Rest (km)' + Width = 60 + end + item + Width = 60 + end + item + Bevel = pbRaised + Text = 'Start' + Width = 40 + end + item + Width = 120 + end + item + Bevel = pbRaised + Text = 'Destination' + Width = 70 + end + item + Width = 120 + end + item + Text = 'Bearing' + Width = 50 + end + item + Width = 50 + end + item + Bevel = pbRaised + Text = 'Pt. Cnt' + Width = 50 + end + item + Width = 50 + end + item + Width = 50 + end> + SimplePanel = False + end + object MapPanel: TPanel + Left = 216 + Height = 470 + Top = 0 + Width = 656 + Align = alClient + BevelOuter = bvNone + Caption = 'MapPanel' + ClientHeight = 470 + ClientWidth = 656 + TabOrder = 2 + object MapView: TMapView + Left = 0 + Height = 443 + Top = 27 + Width = 656 + Align = alClient + Cyclic = True + DownloadEngine = MapView.BuiltInDLE + DrawingEngine = MapView.BuiltInDE + Layers = <> + Font.Color = clBlack + MapProvider = 'OpenStreetMap Standard' + PluginManager = MvPluginManager + POIImages = ImageList + end + object lblInfo: TLabel + Left = 6 + Height = 15 + Top = 6 + Width = 644 + Align = alTop + Alignment = taCenter + BorderSpacing.Around = 6 + Caption = 'Drag start or destination points with left mouse button' + end + end + object MvPluginManager: TMvPluginManager + Left = 320 + Top = 40 + object MvPluginManagerDraggableMarkerPlugin1: TDraggableMarkerPlugin + DraggableMarkerMovedEvent = MvPluginManagerDraggableMarkerPlugin1DraggableMarkerMovedEvent + end + end + object PolarPopupMenu: TPopupMenu + Left = 248 + Top = 328 + object MenuItem7: TMenuItem + Tag = 1 + Caption = 'Antipodes E / NZ' + OnClick = PoleMenuItemClick + end + object MenuItem1: TMenuItem + Tag = 2 + Caption = 'Start North, Dest South' + OnClick = PoleMenuItemClick + end + object MenuItem2: TMenuItem + Tag = 3 + Caption = 'Dest North, Start South' + OnClick = PoleMenuItemClick + end + object MenuItem3: TMenuItem + Tag = 4 + Caption = 'Start North, Dest free' + OnClick = PoleMenuItemClick + end + object MenuItem4: TMenuItem + Tag = 5 + Caption = 'Start South, Dest free' + OnClick = PoleMenuItemClick + end + object MenuItem5: TMenuItem + Tag = 6 + Caption = 'Dest North, Start free' + OnClick = PoleMenuItemClick + end + object MenuItem6: TMenuItem + Tag = 7 + Caption = 'Dest South, Start Free' + OnClick = PoleMenuItemClick + end + end + object ImageList: TImageList + Height = 24 + Scaled = True + Width = 24 + Left = 432 + Top = 40 + Bitmap = { + 4C7A0200000018000000180000003B0700000000000078DACD566D6C54551A3E + 2DADA4C114C1C50F3E5AB4884BA5441713547691163F881451A844851A2BD568 + 94862EFC80988E49811A7E18D94D2C89BF201A49955ADDD276415A2A0B65DB5A + ECCED0292DED0CC5763A9D99FB7D673A1F9D79F63DF78EAED9CD2D1430D9499E + E4E4DEF33EE7BDCFFBCE7B1E000C93606262229D904DF803E18F49F075762291 + 48C735E2AD40B1D3A2D1E83255536D82229CB60BF6E1165F4B98C31EB00F8BAA + D8120C052B684F1EDF3B55FE6030582C6BB2BDDE571F29BC5C88BC9E3CE4D873 + 90F3630EF22EE4A1D05E88E323C723B22ADB69EF9629E49DA1EBFA9F3B840E6C + 746F44BA331DAC87813908FF22FC4068279C6348FF3E1D9B7EDC848EB10EF018 + 1E7B2D4D42E3A1975DB26B74B56B3552FA52C0FA89AB8FD04BB848E84E9E719E + 708621B52515F9EDF9700BEED15028B47932AD78CD4893536557CB1206F70071 + B892B89C3CC34EE84A7EC359C2698694EF52B0C3BE23A1A8CA49E2C8B2E2D783 + 7A69DD581DE65D9A67E6CC79AF323C36F618BED0BF801017204C08F85CFC1C2B + 9C2B0C8D582BE13B8679CDF350375497A05A6CB3E2A73EA9DD3DB41B698E34B0 + 4B1437C8B06078011C3107FEFB670FD931FF87F960DFD3BE530C694D69D8EDD8 + 0D5111BFB2E277492E77517F9159472733B47F5F781F56BF3D57F698F9133F6B + 6478A9FD25B804D7A0157F8FD8132EE82900BB90D499FAA6516FB4E46F141B0D + FDB93E9C7FCDD935E8F1F784ADF87BC55EE5D98BCF827532F30CFA8ECFA4CF2C + F98F788F80B5D0BE93840686B5E7D6E252E0926CC53F228D74BFDEFB7AC2E8BD + 0EB30F370C6EB0E45FEF586F6AF377423D4349674962441CB960C5AF69DABE6A + 773532CF659ABDC1CFF927C307C31F6028328448226260283C049BDB06D64CEF + 4F98B9673664A2BAAF1AC45169C51F8944FEE40C383D2B3B579A7DF10FB3C733 + DA3250E028C0CEC19DD839B01305DD05C868CD30756934735FD9BA124E9FD3C3 + 39ACF8E3F17826CDB343C7AE1E8BA536A79ADA9E4EF6786B72DD9CACE789FF70 + A77E9B8A5A776D8CC7728EC966442C165B48DF78A2B2B712B79FBADDE439F92B + 70AD9B4C4DD8DF1866D4CF40A5BD92EB728262B3AF67C6D1BEE557C42B3F955E + 28C5F4A6E926D7CF386EF2B26F19A67F331D25ED257CF68CF098A9CC6741144A + 2EFA2E4AF967F20D2E03DF24F135A1966155F32A38C61CB2244BA5539DFFA4E3 + 6DA467D94060405ADCB418EC1833F19589450D8BD0EFEF97694F39DF7B237718 + C5CDA2B9FE979A811A64D567817DC90CF0F5D181A3D074EDAF342F67DFE81D99 + 3C638E5FF6B71D701CC0CCBA99C8FC3A1355F62AD0B30E7AF7BB9BE1FED5BDF0 + 7B9A8BE76DDDB6784577459CEEDE767A967B2BB893F75A2ACDF5755EC9EBE2E0 + 6BFEEC56F127CFB88D788B38F8FA56F1FEE6FE47D56C92A49E1E18D086BBBAB4 + 7067A716EEEF578725496B09064337E57F1445B3B7B7EB91FDFB83D8BE3D8837 + DED0B1658B86E262153B76C868695122B2ACDD90FFE9EBD370F060082525116C + DD1AC12BAF8C63D3A6109E7B4E47418186C71F57B07CB984B23209DDDDCAF5FB + 9FD0F8CB1E8F365A55358E37DF8CE2EDB7A378EBADA871CEABAF86F1E28B21AC + 5DAB63D52A95F8652C5D2AD2D9228686D4EBF23FA4C9A9C3874389D2D228DE7B + 2F86F2F23869318177DE8919676CDE3C8EC2C220D6ACD1B0628582BC3C098B16 + 09B0D9C404C54EEE7FF460695B9B8E77DF0D1B3973DE3D7B12A8AE06BABA1208 + 06417318686D9D205D4278E209050F3F2C61F16281BE258086067952FF238A6A + ED9123BC86E3D8B62D4A358D61FFFE38BCDEFFBD7B5DAE385E784133F81F7C50 + 4076B61F7BF78A1045CDD2FF0C0F6BEE0F3FD4515414C26BAF458C6FA8AF8F5B + DEEF870E8DFF92FFDCB97ED22F00B75BB1F43F83835A78D72E1DEBD7070D9DB7 + 6E0DC36E4F58F29F3D1BFB45FF7BEFF563C3063F9C4EC5D2FFB85C9AB26B9786 + 679ED1F1FCF341A31FCF9CB1CEBFBE3E82DC5C11F7DD17C05D77F9B071A31F7D + 7DAAA5FFF17AB5EEBD7BD504EFBDA79FD68D5EDFB72F6CC9BF7DBB6E68B36041 + 0077DE39463D26243C1E7552FF5353A360F56AD9E80D7E4E7EBE86C3872354E3 + 046231201A053C9E043EF9649CEA2A62E1C200EEB9C787F9F3C7F0E9A7E235FD + CFE5CBAAA7B858C6238FC878F451997A5CC6934F2AD4B33A3EFE781C1F7D14A2 + DEE27D63EA3277AECFC8FDA9A77CE8ED55AEED7F54FD505393125BB244C0430F + 8946FD962D33B174A984254B443CF08060E4FD33F7CC995ED4D549311E7BBDFE + E7E041896A173072CCC909E0FEFBCD755656C0E8C5BBEFF661D6AC31AAAB97FE + 23C294FD0FCD939FCACB45E2F353EFF90C8D39E79C393ECC9E3D86CC4C2FEEB8 + C38BD252DEF3EAD4FD8F2096389DAAB46E9D9FBE9FF3999C3366789191318AF4 + F451AACB181C0E459624F9C6FC8FAA970D0E2A526EAE1769691E4C9BE6414A8A + 078C8DD07F6A14FDFD8A4C7B6EDEFFD4709D460D5E0EBE3E7A94F7A27E6BFC8F + 5F6D3B7040209D3CA49107555502E8D9ADF53FA27ADE660BC42B2A8438CDC8DF + C6FF78551707DDEBFF37FEE7DF82F5EDA1 + } + end +end diff --git a/components/lazmapviewer/examples/plugin_demos/greatcirclepaint_demo/main.pas b/components/lazmapviewer/examples/plugin_demos/greatcirclepaint_demo/main.pas new file mode 100644 index 000000000..b74327866 --- /dev/null +++ b/components/lazmapviewer/examples/plugin_demos/greatcirclepaint_demo/main.pas @@ -0,0 +1,300 @@ +unit main; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls, + ComCtrls, Menus, Spin, + mvMapViewer, mvTypes, mvGPSObj, mvPluginCommon, + mvGeoMath, mvPlugins, mvGreatCirclePainterPlugin; + +type + + { TMainForm } + + TMainForm = class(TForm) + btnPresetPolar: TButton; + btnPreseEquator: TButton; + btnPresetPorto: TButton; + btnPresetLongestSeaWay: TButton; + btnLongestEarthWay: TButton; + cbCyclicMap: TCheckBox; + cgOptions: TCheckGroup; + clbOrthodromePenColor: TColorButton; + clbGreatCirclePenColor: TColorButton; + cbZOrder: TComboBox; + gbPresets: TGroupBox; + gbOrthodromePen: TGroupBox; + GroupBox3: TGroupBox; + ImageList: TImageList; + lblInfo: TLabel; + lblZOrder: TLabel; + Label2: TLabel; + lblOrthodromePenWidth: TLabel; + lblGreatCirclePenWidth: TLabel; + MapView: TMapView; + MenuItem1: TMenuItem; + MenuItem2: TMenuItem; + MenuItem3: TMenuItem; + MenuItem4: TMenuItem; + MenuItem5: TMenuItem; + MenuItem6: TMenuItem; + MenuItem7: TMenuItem; + MvPluginManager: TMvPluginManager; + MvPluginManagerDraggableMarkerPlugin1: TDraggableMarkerPlugin; + ParamsPanel: TPanel; + MapPanel: TPanel; + PolarPopupMenu: TPopupMenu; + seOrthodromePenWidth: TSpinEdit; + seGreatCirclePenWidth: TSpinEdit; + StatusBar: TStatusBar; + tbSegmentLength: TTrackBar; + procedure btnPresetPolarClick(Sender: TObject); + procedure btnPreseEquatorClick(Sender: TObject); + procedure btnPresetPortoClick(Sender: TObject); + procedure btnPresetLongestSeaWayClick(Sender: TObject); + procedure btnLongestEarthWayClick(Sender: TObject); + procedure cbCyclicMapChange(Sender: TObject); + procedure cgOptionsItemClick(Sender: TObject; Index: integer); + procedure clbOrthodromePenColorColorChanged(Sender: TObject); + procedure clbGreatCirclePenColorColorChanged(Sender: TObject); + procedure cbZOrderChange(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure PoleMenuItemClick(Sender: TObject); + procedure MvPluginManagerDraggableMarkerPlugin1DraggableMarkerMovedEvent( + Sender: TDraggableMarkerPlugin; AMarker: TGPSPoint; + AOrgPosition: TRealPoint); + procedure seOrthodromePenWidthChange(Sender: TObject); + procedure seGreatCirclePenWidthChange(Sender: TObject); + procedure tbSegmentLengthChange(Sender: TObject); + private + FActivated: Boolean; + FGreatCirclePainterPlugin : TGreatCirclePainterPlugin; + FStartMarker : TGpsPointOfInterest; + FDestinationMarker : TGpsPointOfInterest; + procedure OnGreatCirclePainterGetCoords(Sender : TGreatCirclePainterPlugin; + var FStart, FDestination : TRealPoint); + procedure SetMarkerPositions(const AStartLat, AStartLon, ADestLat, ADestLon : Double); + procedure OnGreatCirclePainterPluginChange(Sender : TObject); + public + + end; + +var + MainForm: TMainForm; + +implementation + +{$R *.lfm} + +{ TMainForm } +procedure TMainForm.FormCreate(Sender: TObject); + + function AddTraditionalMarker(const ALat, ALon: Double; + ACaption: String; const AImgIndex : Integer = -1) : TGpsPointOfInterest; + var + gpsPt: TGpsPointOfInterest; + begin + Result := Nil; + gpsPt := TGpsPointOfInterest.Create(ALon,ALat); + try + gpsPt.Name := ACaption; + gpsPt.ImageIndex := AImgIndex; + MapView.GPSItems.Add(gpsPt, 100); + Result := gpsPt; + gpsPt := Nil; + finally + if Assigned(gpsPt) then + gpsPt.Free; + end; + end; + +begin + MapView.Active := true; + + FGreatCirclePainterPlugin := TGreatCirclePainterPlugin.Create(MvPluginManager); + MvPluginManager.PluginList.Add(FGreatCirclePainterPlugin); + FGreatCirclePainterPlugin.ZOrder := gcpzCanvas; + FGreatCirclePainterPlugin.OnGetStartAndDestinationCoords:=@OnGreatCirclePainterGetCoords; + FGreatCirclePainterPlugin.OnChange := @OnGreatCirclePainterPluginChange; + FGreatCirclePainterPlugin.MapView := MapView; + FGreatCirclePainterPlugin.GreatCirclePen.Color:= clbGreatCirclePenColor.ButtonColor; + FGreatCirclePainterPlugin.GreatCirclePen.Style:= psSolid; + FGreatCirclePainterPlugin.GreatCirclePen.Width:= seGreatCirclePenWidth.Value; + FGreatCirclePainterPlugin.OrthodromePen.Color:= clbOrthodromePenColor.ButtonColor; + FGreatCirclePainterPlugin.OrthodromePen.Style:= psSolid; + FGreatCirclePainterPlugin.OrthodromePen.Width:= seOrthodromePenWidth.Value; + FStartMarker := AddTraditionalMarker(41.1578,-8.6333, 'Start',0); + FDestinationMarker := AddTraditionalMarker(10.6722,-61.5333, 'Destination',1); +end; + +procedure TMainForm.SetMarkerPositions(const AStartLat, AStartLon, ADestLat, ADestLon : Double); +begin + FStartMarker.MoveTo(AStartLon, AStartLat); + FDestinationMarker.MoveTo(ADestLon, ADestLat); + MapView.Invalidate; +end; + +procedure TMainForm.OnGreatCirclePainterPluginChange(Sender: TObject); +var + s : String; +begin + s := Format('%1.3f',[FGreatCirclePainterPlugin.OrthodromeDistance / 1000.0]); + StatusBar.Panels[1].Text := s; + s := Format('%1.3f',[(EARTH_CIRCUMFERENCE-FGreatCirclePainterPlugin.OrthodromeDistance) / 1000.0]); + StatusBar.Panels[3].Text := s; + s := Format('%1.6f:%1.6f',[FGreatCirclePainterPlugin.StartLat,FGreatCirclePainterPlugin.StartLon]); + StatusBar.Panels[5].Text := s; + s := Format('%1.6f:%1.6f',[FGreatCirclePainterPlugin.DestinationLat,FGreatCirclePainterPlugin.DestinationLon]); + StatusBar.Panels[7].Text := s; + s := Format('%1.2f°',[FGreatCirclePainterPlugin.InitialBearing]); + StatusBar.Panels[9].Text := s; + StatusBar.Panels[11].Text := IntToStr(FGreatCirclePainterPlugin.GreatCirclePointsCount); +end; + + +procedure TMainForm.PoleMenuItemClick(Sender: TObject); + +begin + if Sender is TMenuItem then + begin + case TMenuItem(Sender).Tag of + 1 : SetMarkerPositions(42.496909,-7.026229,-42.496909,172.973771); // Antipodes Spain / New Zealand + 2 : SetMarkerPositions(90.0,20.0,-90.0,-90.0); // Both Poles, Start North + 3 : SetMarkerPositions(-90.0,40.0,90.0,-100.0); // Both Poles, Start South + 4 : SetMarkerPositions(90.0,60.0,48.8582300,2.2945500); // Start North, Dest free + 5 : SetMarkerPositions(-90.0,80.0,22.2708100,114.1497900); // Start South, Dest free + 6 : SetMarkerPositions(-33.8707000,151.2082800,90.0,-110.0); // Dest North, Start free + 7 : SetMarkerPositions(43.6439500,-79.3884000,-90.0,-120.0); // Dest South, Start free + end; + end; +end; + +procedure TMainForm.cbCyclicMapChange(Sender: TObject); +begin + MapView.Cyclic := cbCyclicMap.Checked; + MapView.Invalidate; +end; + +procedure TMainForm.cgOptionsItemClick(Sender: TObject; Index: integer); +var + opt : TGreatCirclePainterOptions = []; +begin + if cgOptions.Checked[0] then + Include(opt,gcpoMarkStart); + if cgOptions.Checked[1] then + Include(opt,gcpoMarkCenter); + if cgOptions.Checked[2] then + Include(opt,gcpoMarkDestination); + FGreatCirclePainterPlugin.Options := opt; +end; + +procedure TMainForm.clbOrthodromePenColorColorChanged(Sender: TObject); +begin + FGreatCirclePainterPlugin.OrthodromePen.Color := clbOrthodromePenColor.ButtonColor; +end; + +procedure TMainForm.clbGreatCirclePenColorColorChanged(Sender: TObject); +begin + FGreatCirclePainterPlugin.GreatCirclePen.Color := clbGreatCirclePenColor.ButtonColor; +end; + +procedure TMainForm.btnPresetPolarClick(Sender: TObject); +begin + PolarPopupMenu.PopUp; +end; + +procedure TMainForm.btnPreseEquatorClick(Sender: TObject); +begin + FStartMarker.MoveTo(0.0,0.0); + FDestinationMarker.MoveTo(100.0,0.0); + MapView.Invalidate; +end; + +procedure TMainForm.btnPresetPortoClick(Sender: TObject); +begin + FStartMarker.MoveTo(-8.6333,41.1578); + FDestinationMarker.MoveTo(-61.5333,10.6722); + MapView.Invalidate; +end; + +procedure TMainForm.btnPresetLongestSeaWayClick(Sender: TObject); +begin + FStartMarker.MoveTo(DMSToDeg(66,40,0),DMSToDeg(25,17,0)); + FDestinationMarker.MoveTo(DMSToDeg(162,14,0),DMSToDeg(58,37,0)); + MapView.Invalidate; +end; + +procedure TMainForm.btnLongestEarthWayClick(Sender: TObject); +begin +// 24◦33′ N, 118◦38′ E +// 37◦2′ N, 8◦55′ W + FStartMarker.MoveTo(DMSToDeg(118,38,0),DMSToDeg(23,33,0)); + FDestinationMarker.MoveTo(-DMSToDeg(8,55,0),DMSToDeg(37,2,0)); + MapView.Invalidate; +end; + +procedure TMainForm.cbZOrderChange(Sender: TObject); +begin + case cbZOrder.ItemIndex of + 0 : FGreatCirclePainterPlugin.ZOrder := gcpzCanvas; + 1 : FGreatCirclePainterPlugin.ZOrder := gcpzInFrontOfMarkers; + 2 : FGreatCirclePainterPlugin.ZOrder := gcpzBehindMarkers; + end; + MapView.Invalidate; +end; + +procedure TMainForm.FormActivate(Sender: TObject); +begin + if not FActivated then + begin + Constraints.MinHeight := gbPresets.Top + gbPresets.Height + + ParamsPanel.BorderSpacing.Around * 2 + Statusbar.Height; + Constraints.MinWidth := ParamsPanel.Width + ParamsPanel.BorderSpacing.Around * 2; + if Height < Constraints.MinHeight then + Height := 0; + FActivated := true; + end; +end; + +procedure TMainForm.MvPluginManagerDraggableMarkerPlugin1DraggableMarkerMovedEvent + (Sender: TDraggableMarkerPlugin; AMarker: TGPSPoint; AOrgPosition: TRealPoint + ); +begin + FGreatCirclePainterPlugin.SetStartAndDestination( + FStartMarker.RealPoint, FDestinationMarker.RealPoint + ); +end; + +procedure TMainForm.seOrthodromePenWidthChange(Sender: TObject); +begin + FGreatCirclePainterPlugin.OrthodromePen.Width := seOrthodromePenWidth.Value; +end; + +procedure TMainForm.seGreatCirclePenWidthChange(Sender: TObject); +begin + FGreatCirclePainterPlugin.GreatCirclePen.Width := seGreatCirclePenWidth.Value; +end; + +procedure TMainForm.tbSegmentLengthChange(Sender: TObject); +const + SegmentLengths : array[0..10] of Integer = ( + 1,2,5,10,20,30,50,70,100,150,200 + ); +begin + FGreatCirclePainterPlugin.SegmentLength := SegmentLengths[tbSegmentLength.Position]; + MapView.Invalidate; +end; + +procedure TMainForm.OnGreatCirclePainterGetCoords( + Sender: TGreatCirclePainterPlugin; var FStart, FDestination: TRealPoint); +begin + FStart := FStartMarker.RealPoint; + FDestination := FDestinationMarker.RealPoint; +end; + +end. + diff --git a/components/lazmapviewer/lazmapviewerpkg.lpk b/components/lazmapviewer/lazmapviewerpkg.lpk index 7e98c4efb..6fa119005 100644 --- a/components/lazmapviewer/lazmapviewerpkg.lpk +++ b/components/lazmapviewer/lazmapviewerpkg.lpk @@ -8,7 +8,7 @@ <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"/> + <OtherUnitFiles Value="source;source/addons/plugins;source/addons/plugins/spreadmarkers;source/addons/plugins/grids;source/addons/plugins/scale;source/addons/plugins/greatcircle"/> <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> </SearchPaths> <Other> @@ -23,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="33"> + <Files Count="34"> <Item1> <Filename Value="source/mvcache.pas"/> <UnitName Value="mvCache"/> @@ -157,6 +157,10 @@ FPC 3.2.0 or newer required."/> <Filename Value="source/mvengine_mapreg.inc"/> <Type Value="Include"/> </Item33> + <Item34> + <Filename Value="source/addons/plugins/greatcircle/mvgreatcirclepainterplugin.pas"/> + <UnitName Value="mvGreatCirclePainterPlugin"/> + </Item34> </Files> <CompatibilityMode Value="True"/> <RequiredPkgs Count="2"> diff --git a/components/lazmapviewer/lazmapviewerpkg.pas b/components/lazmapviewer/lazmapviewerpkg.pas index 1b3229b22..817660d5c 100644 --- a/components/lazmapviewer/lazmapviewerpkg.pas +++ b/components/lazmapviewer/lazmapviewerpkg.pas @@ -15,7 +15,7 @@ uses mvMapViewerPathEditForm, mvMapViewerPathEditDsgForm, mvDLECache, mvPluginEditors, mvClassRegistration, mvPluginCommon, mvPlugins, mvspreadmarker_plugin, uInactivityAlarmTimer, mvMapGridPlugin, - mvMapScalePlugin, LazarusPackageIntf; + mvMapScalePlugin, mvGreatCirclePainterPlugin, LazarusPackageIntf; implementation diff --git a/components/lazmapviewer/source/addons/plugins/greatcircle/mvgreatcirclepainterplugin.pas b/components/lazmapviewer/source/addons/plugins/greatcircle/mvgreatcirclepainterplugin.pas new file mode 100644 index 000000000..4adc243c6 --- /dev/null +++ b/components/lazmapviewer/source/addons/plugins/greatcircle/mvgreatcirclepainterplugin.pas @@ -0,0 +1,1111 @@ +{ Copyright (C) 2025 Ekkehard Domning (www.domis.de) + + License: modified LGPL with linking exception (like RTL, FCL and LCL) + + See the file COPYING.modifiedLGPL.txt, included in the Lazarus distribution, + for details about the license. + + This unit implements an MapViewer-Plugin to display a great circle on the map. + For details about great circles please see: + + https://en.wikipedia.org/wiki/Great_circle + + The great circle is defined by a Start and a Destination coordinate. + + If Start and Destination are equal, no greatcircle is displayed. + + If Start and Destination are 0 or separated by 180 degrees, the circle around + the two poles are displayed. + + The part containing the shortest distance between Start and Destination is + called Orthodrome. + + The pens for drawing the Great Circle and the Orthodrome can be chosen + independently. + + A great circle on the map is approximated by drawing short straight lines + segments. The length of those segments can be set. + In general, the segments should be smaller on larger scales (smaller zoom) + and could be longer on smaller scales (bigger zoom), since the deviations from + linearity are bigger on large scales, especially in polar regions. + + The Z-Order can be selected in three steps: + On the native map behind or before the markers (this allows to save the + great circle together with the map in a file) or on the Canvas. + + The calculated points are accessible. They contain the location, the distance + (in meters) from Start and the kind of the point (wether it is start or destination, + is part of the Orthodrome or none of the above). The distance starts at 0 at + Start, increases in direction of the Destination and continues increasing until + Start is reached again. + The points are only available for the longitudes visible in the map! +} + +unit mvGreatCirclePainterPlugin; + +{$mode ObjFPC}{$H+} + +interface + +uses + Classes, SysUtils, Controls, Graphics, Math, Contnrs, ClipBrd, + mvPluginCommon, mvPlugins, mvMapViewer, mvTypes, mvGeoMath, mvDrawingEngine; + +const + DefaultSegmentLength = 10; // 10 pixels for one line segment on screen + MaxSegmentLength = 200; // maximum 200 pixels + +type + TGreatCirclePointKind = (gcpkStandard, gcpkOrthodrome, gcpkStart, gcpkCenter, gcpkDestination); + + { TGreatCirclePoint } + + TGreatCirclePoint = class(TObject) + private + FRealPoint : TRealPoint; + FDistance : Double; + FPointKind : TGreatCirclePointKind; + protected + public + constructor Create(const ARealPoint : TRealPoint; const ADistance : Double; + const APointKind : TGreatCirclePointKind = gcpkStandard); + constructor Create(const ARealPointLat, ARealPointLon : Double; const ADistance : Double; + const APointKind : TGreatCirclePointKind = gcpkStandard); + property RealPoint : TRealPoint read FRealPoint; + property PointKind : TGreatCirclePointKind read FPointKind; + property Distance : Double read FDistance; + end; + + TGreatCirclePainterZOrder = (gcpzCanvas,gcpzInFrontOfMarkers,gcpzBehindMarkers); + TGreatCirclePainterOption = (gcpoMarkStart, gcpoMarkCenter, gcpoMarkDestination); + TGreatCirclePainterOptions = set of TGreatCirclePainterOption; + + { TGreatCirclePainterPlugin } + + TGreatCirclePainterPlugin = class; + TGreatCirclePainterGetCoordsEvent = procedure (Sender : TGreatCirclePainterPlugin; + var FStart, FDestination : TRealPoint) of Object; + TGreatCirclePainterPlugin = class(TMvDrawPlugin) + private + FZOrder : TGreatCirclePainterZOrder; + FOrthodromePen: TPen; + FOptions : TGreatCirclePainterOptions; + FStart : TRealPoint; + FDestination : TRealPoint; + FCenterPoint : TRealPoint; + FSegmentLength : Integer; + FOrthodromeDistance : Double; + FInitialBearing : Double; + FGetStartAndDestinationCoordsEvent : TGreatCirclePainterGetCoordsEvent; + FOnChange : TNotifyEvent; + FGreatCircleLinePoints : TObjectList; + function LimitLat(const ALat : Double) : Double; + function LimitLon(const ALon : Double) : Double; + procedure DoGetCoordEvent; + procedure SetOrthodromePen(AValue: TPen); + procedure SetStartLat(Value : Double); + procedure SetStartLon(Value : Double); + procedure SetDestinationLat(Value : Double); + procedure SetDestinationLon(Value : Double); + function GetGreatCirclePointsCount : Integer; + function GetGreatCirclePoints(AIndex : Integer) : TGreatCirclePoint; + procedure SetOptions(Value : TGreatCirclePainterOptions); + procedure SetSegmentLength(Value : Integer); + procedure PaintGreatCircleWithCanvas; + procedure PaintGreatCircleWithDrawingEngine; + procedure OrthodromePenChanged(Sender : TObject); + procedure SetGreatCirclePen(Value : TPen); + function GetGreatCirclePen : TPen; + protected + procedure AfterDrawObjects(AMapView: TMapView; var Handled: Boolean); override; + procedure AfterPaint(AMapView: TMapView; var Handled: Boolean); override; + procedure BeforeDrawObjects(AMapView: TMapView; var Handled: Boolean); override; + procedure CenterMove(AMapView: TMapView; var Handled: Boolean); override; + procedure Resize(AMapView: TMapView; var Handled: Boolean); override; + procedure Update; override; + procedure ZoomChange(AMapView: TMapView; var Handled: Boolean); override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy;override; + procedure CalculateGreatCircle; + procedure SetStartAndDestination(const AStartLat, AStartLon, ADestinationLat, ADestinationLon : Double); + procedure SetStartAndDestination(const AStart, ADestination : TRealPoint); + + property OrthodromeDistance : Double read FOrthodromeDistance; + property InitialBearing : Double read FInitialBearing; + property CenterPoint : TRealPoint read FCenterPoint; + + property GreatCirclePointsCount : Integer read GetGreatCirclePointsCount; + property GreatCirclePoints[AIndex : Integer] : TGreatCirclePoint read GetGreatCirclePoints; + published + property DestinationLat : Double read FDestination.Lat write SetDestinationLat; + property DestinationLon : Double read FDestination.Lon write SetDestinationLon; + property GreatCirclePen : TPen read GetGreatCirclePen write SetGreatCirclePen; + property Options : TGreatCirclePainterOptions read FOptions write SetOptions; + property OrthodromePen: TPen read FOrthodromePen write SetOrthodromePen; + property SegmentLength : Integer read FSegmentLength write SetSegmentLength default DefaultSegmentLength; + property StartLat : Double read FStart.Lat write SetStartLat; + property StartLon : Double read FStart.Lon write SetStartLon; + property ZOrder : TGreatCirclePainterZOrder read FZOrder write FZOrder default gcpzCanvas; + property OnChange : TNotifyEvent read FOnChange write FOnChange; + property OnGetStartAndDestinationCoords : TGreatCirclePainterGetCoordsEvent read FGetStartAndDestinationCoordsEvent write FGetStartAndDestinationCoordsEvent; + end; + +procedure VertexOfGreatCircle(const AStartLat, AStartLon, ADestinationLat, ADestinationLon : Double; + out AVertexLat, AVertexLon : Double); +procedure LatFromLonAtGreatCircle(const AStartLat, AStartLon, ADestinationLat, ADestinationLon : Double; + const ASearchLon: Double; out AFoundLat: Double); + + +implementation + +procedure VertexOfGreatCircle(const AStartLat, AStartLon, ADestinationLat, + ADestinationLon: Double; out AVertexLat, AVertexLon: Double); +var + lStartLat, lStartLon, lDestinationLat, lDestinationLon : Double; + lDestBearing, lDestBearingRad : Double; + d : Double; + lDestLatRad : Double; + SecondLoop : Boolean = False; +begin + AVertexLon := 0.0; + lStartLat := AStartLat; + lStartLon := AStartLon; + lDestinationLat := ADestinationLat; + lDestinationLon := ADestinationLon; + // Problem: If the Latitude is 0.0 then the computation fails, we try then the opposite direction + repeat + lDestLatRad := DegToRad(lDestinationLat); + lDestBearing := CalcBearing(lDestinationLat,lDestinationLon,lStartLat,lStartLon); + if lDestBearing > 180.0 then + lDestBearing := lDestBearing - 360.0; + lDestBearingRad := DegToRad(lDestBearing); + // Vertex Latitude + // Latitude of Vertex: cos phiS = sin alpha * cos phiA + // cos φS = sin α · cos φPoS = sin 46,87° · cos 10,6722° = 0,7172; φS = 44,1762° + d := ArcCos(Sin(lDestBearingRad) * Cos(lDestLatRad)); + AVertexLat := RadToDeg(d); + // The latitude has a sign problem if the signs of DestinationLat and Bearing are different + if ((lDestinationLat > 0.0) and (lDestBearing < 0.0)) or + ((lDestinationLat < 0.0) and (lDestBearing > 0.0)) then + AVertexLat := -AVertexLat; + // Vertex Longitude + // Longitude of Vertex: tan(lamda A - lambda S) = 1 / (sin phi A * tan alpha) + // tan (λS - λPoS) = cot α ⁄ sin φPoS = + // = cot 46,87° ⁄ sin 10,6722° = 0,937 ⁄ 0,185 = 5,065; + // ⇒ λS - λPoS = 78,83°, und daraus + // λS = 78,83° + (-61,53°) = 17,3° + if (lDestLatRad <> 0.0) and (lDestBearingRad <> 0.0) then + begin + d := RadToDeg(ArcTan(Cot(lDestBearingRad) / Sin(lDestLatRad))); + AVertexLon := NormalizeLon(d + lDestinationLon); + Break; + end; + if SecondLoop then Break; + // If lDestLatRad is 0.0, then try the opposite way + SecondLoop := True; + lStartLat := ADestinationLat; + lStartLon := ADestinationLon; + lDestinationLat := AStartLat; + lDestinationLon := AStartLon; + until False; +end; + +procedure LatFromLonAtGreatCircle(const AStartLat, AStartLon, ADestinationLat, ADestinationLon : Double; + const ASearchLon: Double; out AFoundLat: Double); +var + lVertexLat, lVertexLon : Double; +begin +// tan φWP = tan φS · cos(λS - λWP) +// φS = Lat of Vertex +// λS = Lon of Vertex +// λWP = Lon of sdearched point + VertexOfGreatCircle(AStartLat, AStartLon, ADestinationLat, ADestinationLon,lVertexLat, lVertexLon); + AFoundLat := RadToDeg(ArcTan(Tan(DegToRad(lVertexLat)) * Cos(DegToRad(lVertexLon-ASearchLon)))); +end; + + +{ TGreatCirclePoint } + +constructor TGreatCirclePoint.Create(const ARealPoint: TRealPoint; const ADistance : Double; + const APointKind: TGreatCirclePointKind); +begin + inherited Create; + FRealPoint := ARealPoint; + FDistance := ADistance; + if FDistance < 0.0 then + FDistance := FDistance+EARTH_CIRCUMFERENCE; + FPointKind := APointKind; +end; + +constructor TGreatCirclePoint.Create(const ARealPointLat, ARealPointLon: Double; + const ADistance : Double; + const APointKind: TGreatCirclePointKind); +begin + inherited Create; + FRealPoint.InitLatLon(ARealPointLat, ARealPointLon); + FDistance := ADistance; + if FDistance < 0.0 then + FDistance := FDistance+EARTH_CIRCUMFERENCE; + FPointKind := APointKind; +end; + + +{ TGreatCirclePainterPlugin } +// Default SortCompare sortes the points along the longitude and on same +// longitudes shorter distance from start first. +function GreatCircleLinePointsListSortCompare(Item1, Item2: Pointer): Integer; +var + pt1 : TGreatCirclePoint absolute Item1; + pt2 : TGreatCirclePoint absolute Item2; +begin + Result := 0; + if pt1.FRealPoint.Lon > pt2.FRealPoint.Lon then + Result := 1 + else if pt1.FRealPoint.Lon < pt2.FRealPoint.Lon then + Result := -1 + else if pt1.FDistance > pt2.FDistance then + Result := 1 + else if pt1.FDistance < pt2.FDistance then + Result := -1; +end; + +// Special SortCompare for Polroutes sortes the points only along the distance from start +function GreatCircleLinePolarPointsListSortCompare(Item1, Item2: Pointer): Integer; +var + pt1 : TGreatCirclePoint absolute Item1; + pt2 : TGreatCirclePoint absolute Item2; +begin + Result := 0; + if pt1.FDistance > pt2.FDistance then + Result := 1 + else if pt1.FDistance < pt2.FDistance then + Result := -1 +end; + +// This is the big calculation method +procedure TGreatCirclePainterPlugin.CalculateGreatCircle; + + // Calculates the distance between the given start and the given point + // including the direction, not the shorts way! + function DistanceFromStartEx(const ALat, ALon : Double; const AStartLat, AStartLon : Double; AInitialBearing : Double) : Double; + var + d, d0 : Double; + refPt : TRealPoint; + begin + // First the absolute distance + d := CalcGeoDistance(AStartLat, AStartLon, ALat, ALon, duMeters); + // Now calculate the point in the given distance + CalcLatLon(AStartLat, AStartLon, d, AInitialBearing, refPt.Lat, refPt.Lon); + // now calculate the delta between the points + d0 := CalcGeoDistance(refPt.Lat, refPt.Lon, ALat, ALon, duMeters); + if Abs(d0) > 1.0 then // if not same + d := EARTH_CIRCUMFERENCE-d; // the distance is on the other side + Result := d; + end; + + // Calculates the distance between start and the given point + // including the direction, not the shorts way! + function DistanceFromStart(const ALat, ALon : Double) : Double; + begin + Result := DistanceFromStartEx(ALat, ALon, FStart.Lat, FStart.Lon, FInitialBearing); + end; + + // PointKindFromDist + // return gcpkOrthodrome if between start and destination else gcpkStandard + function PointKindFromDist(const ADistFromStart : Double) : TGreatCirclePointKind; + var + d : Double; + begin + d := ADistFromStart; + if d > EARTH_CIRCUMFERENCE then + d := d - EARTH_CIRCUMFERENCE + else if d < 0.0 then + d := d + EARTH_CIRCUMFERENCE; + if InRange(d,0.0,FOrthodromeDistance) then + Result := gcpkOrthodrome + else + Result := gcpkStandard; + end; + +var + lScreenArea : TRealArea; + lMapCenter : TRealPoint; + rPt, rPtSub : TRealPoint; + d : Double; + lStepLon, lStepLonSub : Double; + lCurLon : Double; + lStopLon : Double; + curDist : Double; + lMapViewWidth : Integer; + lMapViewHeight : Integer; + i : Integer; + lStart, lDest : TRealPoint; + lWorldSize : Int64; + lGCP : TGreatCirclePoint; + ptKind : TGreatCirclePointKind; + lon0, lon1 : Double; + lLastRPt : TrealPoint; + cnt : Integer; + lSuppressSort : Boolean = False; + lFullSpan : Boolean; + pt : TPoint; + lDateBorderOnMap : Boolean; + lBear : Double; +begin + FGreatCircleLinePoints.Clear; + FOrthodromeDistance := 0.0; + FInitialBearing := 0.0; + if not Assigned(MapView) then Exit; + if not MapView.Visible then Exit; + lMapViewWidth := MapView.Width; + lMapViewHeight := MapView.Height; + if (lMapViewWidth <= 0) or (lMapViewHeight <= 0) then Exit; + try + try + // Start and Destination on the same point, no display + if (FStart.Lat = FDestination.Lat) and + (FStart.Lon = FDestination.Lon) then Exit; + + lWorldSize := mvGeoMath.ZoomFactor(MapView.Zoom) * TileSize.CX; + lFullSpan := ((lMapViewWidth + 2*FSegmentLength) >= lWorldSize); + // Set the ScreenArea (in Degree) from the visible parts, include an area of SegmentLen around. + // Take care to limit the area to the maximum width + if lFullSpan then + begin + lScreenArea.TopLeft := MapView.ScreenToLatLon(Point(0,0-FSegmentLength)); + lScreenArea.TopLeft.Lon := -180.0; + lScreenArea.BottomRight := MapView.ScreenToLatLon(Point(lMapViewWidth,lMapViewHeight+FSegmentLength)); + lScreenArea.BottomRight.Lon := 180.0; + lMapViewWidth := lWorldSize; + end + else + begin + lScreenArea.TopLeft := MapView.ScreenToLatLon(Point(0-FSegmentLength,0-FSegmentLength)); + lScreenArea.BottomRight := MapView.ScreenToLatLon(Point(lMapViewWidth+FSegmentLength,lMapViewHeight+FSegmentLength)); + end; + lMapCenter.InitLatLon((lScreenArea.TopLeft.Lat+lScreenArea.BottomRight.Lat) / 2.0, + (lScreenArea.TopLeft.Lon+lScreenArea.BottomRight.Lon) / 2.0); + // Calculate the step distance (in fraction of longitude degree), by using the pixel distance + lon0 := lScreenArea.TopLeft.Lon; + lon1 := lScreenArea.BottomRight.Lon; + if lon1 >= lon0 then // Normal case + d := lon1-lon0 + else // crossing date border + d := lon1-lon0+360.0; + lStepLon := d / lMapViewWidth * FSegmentLength; + lStopLon := lon0+d; + // Now sort out two special cases vertical and horizontal + FInitialBearing := CalcBearing(FStart.Lat, FStart.Lon, FDestination.Lat, FDestination.Lon); + FOrthodromeDistance := CalcGeoDistance(FStart.Lat, FStart.Lon, FDestination.Lat, FDestination.Lon,duMeters); + // Calculate CenterPoint + CalcLatLon(FStart.Lat, FStart.Lon, FOrthodromeDistance / 2.0, FInitialBearing, + FCenterPoint.Lat,FCenterPoint.Lon); + + // Special processing of all Polar-Routes. + // Those are + // 1.) any Start and Destination sharing a common Longitude + // 2.) same Start and Destination having 180 Degree between Start and Destination + // 3.) Start or Destination one at a pole, the other somwhere eles + // 4.) Start and Destination separated, each on one pole + if (Abs(FStart.Lat) = 90.0) or (Abs(FDestination.Lat) = 90) or + (Abs(FStart.Lon-FDestination.Lon) = 0.0) or + (Abs(FStart.Lon-FDestination.Lon) = 180.0) then + begin + if (Abs(FStart.Lat) = 90.0) and (Abs(FDestination.Lat) = 90) then + begin // case 4.) + FCenterPoint.Lon := FStart.Lon; + // create 5 points (Start Longitude leads) and exit + FGreatCircleLinePoints.Add(TGreatCirclePoint.Create(FStart.Lat,FStart.Lon,0.0,gcpkStart)); + FGreatCircleLinePoints.Add(TGreatCirclePoint.Create(FCenterPoint.Lat,FCenterPoint.Lon, + EARTH_CIRCUMFERENCE / 4.0,gcpkCenter)); + FGreatCircleLinePoints.Add(TGreatCirclePoint.Create(FDestination.Lat,FStart.Lon,FOrthodromeDistance,gcpkDestination)); + + FGreatCircleLinePoints.Add(TGreatCirclePoint.Create(FDestination.Lat,NormalizeLon(FStart.Lon+180.0),FOrthodromeDistance,gcpkStandard)); + FGreatCircleLinePoints.Add(TGreatCirclePoint.Create(FStart.Lat,NormalizeLon(FStart.Lon+180.0),EARTH_CIRCUMFERENCE,gcpkStandard)); + Exit; + end; + // Caution: We may need to modify FStart or FDestination for the proper calculation. + // Doing so, cause an endless loop of repainting, if external coordiates are provided + // via the GetCoords Event!! + // So we use a local copy + lStart.InitLatLon(FStart.Lat,FStart.Lon); + lDest.InitLatLon(FDestination.Lat,FDestination.Lon); + if InRange(Abs(FCenterPoint.Lon-lDest.Lon),0.0,1E-10) then + FCenterPoint.Lon := lDest.Lon + else + FCenterPoint.Lon := lStart.Lon; + + // Cases 3.) + // To reuse most of the standard code we slightly remove the points from + // the pole, to get a proper distance calculation for sorting the points + if (Abs(FStart.Lat) = 90.0) and (Abs(FDestination.Lat) <> 90) then + begin + if FStart.Lat = 90.0 then + lStart.Lat := 89.99 + else + lStart.Lat := -89.99; + lStart.Lon := FDestination.Lon; + FCenterPoint.Lon := FDestination.Lon; + end + else if (Abs(FStart.Lat) <> 90.0) and (Abs(FDestination.Lat) = 90) then + begin + if FDestination.Lat = 90.0 then + lDest.Lat := 89.99 + else + lDest.Lat := -89.99; + lDest.Lon := FStart.Lon; + FCenterPoint.Lon := FStart.Lon; + end + else if Abs(FStart.Lon-FDestination.Lon) = 180.0 then + begin + if FStart.Lat > FDestination.Lat then + FCenterPoint.Lon := FDestination.Lon + else + FCenterPoint.Lon := FStart.Lon; + FCenterPoint.Lat := 0.0; + end; + + // The bearing has changed too, using an internal copy + if Abs(FStart.Lon-FDestination.Lon) = 180.0 then + lBear := 0.0 + else + lBear := CalcBearing(lStart.Lat, lStart.Lon, lDest.Lat, lDest.Lon); + // We have to insert 7 points: + // North pole, South pole, South pole + 180, North pole + 180 + // plus Start, Center and Destination. + // Start and Destination may share the same Longitude or differ by 180 + // To ease the calculation, we will insert not twice the Poles, instead + // we will insert two points in a very close distance to the Poles. + // This will give two different distances and a proper sort order + // First, insert Start, CenterPoint and Destination (the local copies) + FGreatCircleLinePoints.Add(TGreatCirclePoint.Create(lStart.Lat,lStart.Lon,0.0,gcpkStart)); + FGreatCircleLinePoints.Add(TGreatCirclePoint.Create(FCenterPoint.Lat,FCenterPoint.Lon, + FOrthodromeDistance / 2.0,gcpkCenter)); + FGreatCircleLinePoints.Add(TGreatCirclePoint.Create(lDest.Lat,lDest.Lon,FOrthodromeDistance,gcpkDestination)); + // Now insert the four pole points + for i := 0 to 3 do + begin + case i of + 0,3 : + begin // North pole 0, 1 + rPt.Lat := 90-1E-10; + if i = 0 then + rPt.Lon := lStart.Lon + else + rPt.Lon := NormalizeLon(lStart.Lon + 180.0); + end; + 1,2 : + begin // South pole 0, 1 + rPt.Lat := -90+1E-10; + if i = 1 then + rPt.Lon := lStart.Lon + else + rPt.Lon := NormalizeLon(lStart.Lon + 180.0); + end; + end; + // calculate the distance + curDist := DistanceFromStartEx(rPt.Lat, rPt.Lon, lStart.Lat, lStart.Lon, lBear); + // calculate the kind of the points (Orthrodrome or normal) + ptKind := PointKindFromDist(curDist); + FGreatCircleLinePoints.Add(TGreatCirclePoint.Create(rPt.Lat,rPt.Lon,curDist,ptKind)); + end; + // Sort all points along their distances from Start + FGreatCircleLinePoints.Sort(@GreatCircleLinePolarPointsListSortCompare); + // move the last point from the end to the beginning to draw a line from this pole prior to start + lGCP := TGreatCirclePoint(FGreatCircleLinePoints.Extract(FGreatCircleLinePoints.Items[FGreatCircleLinePoints.Count-1])); + FGreatCircleLinePoints.Insert(0,lGCP); + lSuppressSort := True; // Points have been sorted here + // The North-South straight line has been processed + Exit; + end; + + // Now all other points on earth, including the equator. + + // Add Start and Destination points + FGreatCircleLinePoints.Add(TGreatCirclePoint.Create(FStart,0.0,gcpkStart)); + FGreatCircleLinePoints.Add(TGreatCirclePoint.Create(FCenterPoint,FOrthodromeDistance / 2.0,gcpkCenter)); + FGreatCircleLinePoints.Add(TGreatCirclePoint.Create(FDestination,FOrthodromeDistance,gcpkDestination)); + + // Equator will be processed as normal + lStart := FStart; + lDest := FDestination; + + // Now we travel along the part that may(!) visible on the screen. + // We start far in the west (left) + lCurLon := lScreenArea.TopLeft.Lon; + lLastRPt.Lon := lCurLon; + LatFromLonAtGreatCircle(lStart.Lat, lStart.Lon, lDest.Lat, lDest.Lon, + lLastRPt.Lon, lLastRPt.Lat); + // Loop from left to right + repeat + // Increment the curDist (= distance on the circle to travel from normalized start) + rPt.Lon := lCurLon; + if rPt.Lon > 180.0 then + rPt.Lon := rPt.Lon - 360.0; + LatFromLonAtGreatCircle(lStart.Lat, lStart.Lon, lDest.Lat, lDest.Lon, + rPt.Lon, rPt.Lat); + + // Determine kind of point + d := DistanceFromStart(rPt.Lat,rPt.Lon); + ptKind := PointKindFromDist(d); + FGreatCircleLinePoints.Add(TGreatCirclePoint.Create(rPt,d,ptKind)); + + // Sub task. + // If the great circle has a great slope, e.g. runing from and to high latitudes, + // than the latitude may increase very fast, so we have to insert + // some intermediate points. + d := rPt.Lat-lLastRPt.Lat; + if Abs(d) > lStepLon then + begin + cnt := Trunc(Abs(d) / lStepLon); + lStepLonSub := lStepLon / cnt; + for i := 1 to cnt-1 do + begin + rPtSub.Lon := lLastRPt.Lon + (i*lStepLonSub); + if rPtSub.Lon > 180.0 then + rPtSub.Lon := rPtSub.Lon - 360.0; + LatFromLonAtGreatCircle(lStart.Lat, lStart.Lon, lDest.Lat, lDest.Lon, + rPtSub.Lon, rPtSub.Lat); + // But we will only insert those points if they are visible on the screen. + if lScreenArea.ContainsPoint(rPtSub) then + begin + // Determine kind of point + d := DistanceFromStart(rPtSub.Lat,rPtSub.Lon); + ptKind := PointKindFromDist(d); + FGreatCircleLinePoints.Add(TGreatCirclePoint.Create(rPtSub,d,ptKind)); + end; + end; + end; + lLastRPt.InitLatLon(rPt.Lat,rPt.Lon); // save the current point as last point + // terminate the loop if the right side is reached, or the full circle has been processed + lCurLon := lCurLon + lStepLon; + until lCurLon > lStopLon; + + // Add the points -180 and 180 to avoid a gap in the great circle in cyclic map mode + lDateBorderOnMap := lScreenArea.BottomRight.Lon < lScreenArea.TopLeft.Lon; + for i := 0 to 1 do + begin + if i = 0 then + begin + rPt.Lon := -180.0; + if not lDateBorderOnMap then + begin + pt := MapView.LatLonToScreen(lScreenArea.TopLeft.Lat,-180.0); + if pt.X <= MapView.Engine.MapLeft then Continue; + end; + end + else + begin + rPt.Lon := 180.0; + if not lDateBorderOnMap then + begin + pt := MapView.LatLonToScreen(lScreenArea.TopLeft.Lat,180.0); + if pt.X >= MapView.Engine.MapLeft+lWorldSize then Continue; + end; + end; + LatFromLonAtGreatCircle(lStart.Lat, lStart.Lon, lDest.Lat, lDest.Lon, + rPt.Lon, rPt.Lat); + d := DistanceFromStart(rPt.Lat,rPt.Lon); + ptKind := PointKindFromDist(d); + FGreatCircleLinePoints.Add(TGreatCirclePoint.Create(rPt,d,ptKind)); + end; + + except + // Keep silence on any computation errors + end; + finally + // Finally the found points must be sorted, if not processed in a different way. + if not lSuppressSort then + FGreatCircleLinePoints.Sort(@GreatCircleLinePointsListSortCompare); + // Give the user a message, to update the information about the current great circle + if Assigned(FOnChange) then + FOnChange(Self); + end; +end; + +function TGreatCirclePainterPlugin.LimitLat(const ALat: Double): Double; +begin + if ALat > 90.0 then + Result := 90.0 + else if ALat < -90.0 then + Result := -90.0 + else + Result := ALat; +end; + +function TGreatCirclePainterPlugin.LimitLon(const ALon: Double): Double; +begin + if ALon > 180.0 then + Result := 180.0 + else if ALon < -180.0 then + Result := -180.0 + else + Result := ALon; +end; + +procedure TGreatCirclePainterPlugin.DoGetCoordEvent; +var + lSPt, lDPt : TRealPoint; +begin + if Assigned(FGetStartAndDestinationCoordsEvent) then + begin + lSPt := FStart; + lDPt := FDestination; + FGetStartAndDestinationCoordsEvent(Self,lSPt, lDPt); + SetStartAndDestination(lSPt, lDPt); + end; +end; + +procedure TGreatCirclePainterPlugin.SetOrthodromePen(AValue: TPen); +begin + if not Assigned(AValue ) then + Exit; + if (AValue.Color = FOrthodromePen.Color) and (AValue.Width = FOrthodromePen.Width) and + (AValue.Style = FOrthodromePen.Style) and (AValue.Mode = FOrthodromePen.Mode) and + (AValue.JoinStyle = FOrthodromePen.JoinStyle) and (AValue.EndCap = FOrthodromePen.EndCap) + then + Exit; + FOrthodromePen.Assign(AValue); + OrthodromePenChanged(Self); +end; + +procedure TGreatCirclePainterPlugin.SetStartLat(Value: Double); +var + d : Double; +begin + d := LimitLat(Value); + if FStart.Lat = d then Exit; + FStart.Lat := d; + Update; +end; + +procedure TGreatCirclePainterPlugin.SetStartLon(Value: Double); +var + d : Double; +begin + d := LimitLon(Value); + if FStart.Lon = d then Exit; + FStart.Lon := d; + Update; +end; + +procedure TGreatCirclePainterPlugin.SetDestinationLat(Value: Double); +var + d : Double; +begin + d := LimitLon(Value); + if FDestination.Lat = d then Exit; + FDestination.Lat := d; + Update; +end; + +procedure TGreatCirclePainterPlugin.SetDestinationLon(Value: Double); +var + d : Double; +begin + d := LimitLon(Value); + if FDestination.Lon = d then Exit; + FDestination.Lon := d; + Update; +end; + +function TGreatCirclePainterPlugin.GetGreatCirclePointsCount: Integer; +begin + Result := FGreatCircleLinePoints.Count; +end; + +function TGreatCirclePainterPlugin.GetGreatCirclePoints(AIndex: Integer + ): TGreatCirclePoint; +begin + Result := TGreatCirclePoint(FGreatCircleLinePoints.Items[AIndex]); +end; + +procedure TGreatCirclePainterPlugin.SetOptions(Value: TGreatCirclePainterOptions + ); +begin + if FOptions = Value then Exit; + FOptions := Value; + inherited Update; // Points could be reused, no position changed +end; + +procedure TGreatCirclePainterPlugin.SetSegmentLength(Value: Integer); +var + v : Integer; +begin + if Value <= 0 then + v := 1 + else if Value > MaxSegmentLength then + v := MaxSegmentLength + else + v := Value; + if FSegmentLength = v then Exit; + FSegmentLength := v; + Update; +end; + +// Painting the great circle is fairly straight forward. +// We simply run to the points and draw the segments. +// Care must be taken not to draw invisble parts of the graph and, even in the +// not cyclic maps, the crossing of the right and left borders must be catched. +procedure TGreatCirclePainterPlugin.PaintGreatCircleWithCanvas; +var + i : Integer; + pt : TPoint; + pt0, pt1 : TPoint; + ptCyc: TPointArray; + dpx, dpy : Integer; + ptGC0 : TGreatCirclePoint; + ptGC1 : TGreatCirclePoint; + cnt : Integer; + lWorldSize : Int64; + topY, bottomY : Integer; + ptOutArr : array of Boolean = Nil; + isCyclic : Boolean; +begin + cnt := FGreatCircleLinePoints.Count; + if cnt > 1 then + begin + isCyclic := MapView.Cyclic; + lWorldSize := mvGeoMath.ZoomFactor(MapView.Zoom) * TileSize.CX; + pt0 := MapView.LatLonToScreen(90.0,0); + topY := pt0.Y; + pt0 := MapView.LatLonToScreen(-90.0,0); + bottomY := pt0.Y; + // Here we will setup an array, containing a flag for each point + // wether he is in or out the visible screen. + // Since the values running from -180 to +180 in longitude (but limited + // to the visible longitudes), only the Latitude / Y-Values must be checked + SetLength(ptOutArr,cnt); + for i := 0 to cnt-1 do + begin + ptGC0 := TGreatCirclePoint(FGreatCircleLinePoints.Items[i]); + pt0 := MapView.LatLonToScreen(ptGC0.RealPoint); + ptOutArr[i] := (pt0.Y <= topY) or (pt0.Y >= bottomY); + end; + // In a second step we find the segments wher one end is out, and one is in. + // In this case the "out" point is marked as "in". + for i := 1 to cnt-1 do + begin + if not ptOutArr[i] then Continue; + ptGC0 := TGreatCirclePoint(FGreatCircleLinePoints.Items[i-1]); + pt0 := MapView.LatLonToScreen(ptGC0.RealPoint); + ptGC1 := TGreatCirclePoint(FGreatCircleLinePoints.Items[i]); + pt1 := MapView.LatLonToScreen(ptGC1.RealPoint); + + if ((pt0.Y <= topY) and (pt1.Y >= bottomY)) or + ((pt0.Y >= bottomY) and (pt1.Y <= topY)) then + ptOutArr[i] := False; + end; + + // No Brush, we draw only lines + MapView.Canvas.Brush.Style:= bsClear; + + // Now loop through al points, but since we draw segmens, we start with the + // second point (= index 1). + ptGC0 := TGreatCirclePoint(FGreatCircleLinePoints.Items[0]); + for i := 1 to cnt-1 do + begin + ptGC1 := TGreatCirclePoint(FGreatCircleLinePoints.Items[i]); + if (not ptOutArr[i-1]) or (not ptOutArr[i]) then + begin // if at least one side is in, we have to paint + pt0 := MapView.LatLonToScreen(ptGC0.RealPoint); + pt1 := MapView.LatLonToScreen(ptGC1.RealPoint); + // In the cyclic map we limit all points to the actual world size + if isCyclic then + begin + pt0.X := Trunc(Frac(pt0.X / lWorldSize)*lWorldSize); + if pt0.X < 0 then + pt0.X := pt0.X + lWorldSize + else if pt0.X > lWorldSize then + pt0.X := pt0.X - lWorldSize; + pt1.X := Trunc(Frac(pt1.X / lWorldSize)*lWorldSize); + if pt1.X < 0 then + pt1.X := pt1.X + lWorldSize + else if pt1.X > lWorldSize then + pt1.X := pt1.X - lWorldSize; + end; + // we take the differences in the X and Y axis for this point pair + // to ease the cyclic processing + dpy := pt1.Y-pt0.Y; + dpx := pt1.X-pt0.X; + // Cyclic or not, a big dpx has to be limited, to avoid big zig-zags + if Abs(dpx) > (lWorldSize div 2) then + begin + if dpx < 0 then + dpx := dpx + lWorldSize + else + dpx := dpx - lWorldSize; + end; + // Select the pen. The orthodrome ends when a standard point is used + if (ptGC0.FPointKind <> gcpkStandard) and + (ptGC1.FPointKind <> gcpkStandard) then + MapView.Canvas.Pen := FOrthodromePen + else + MapView.Canvas.Pen := Pen; + // Geta all cyclic points + ptCyc := MapView.CyclicPointsOf(pt1); + // Draw al lines for the current segment + for pt in ptCyc do + MapView.Canvas.Line(pt.X,pt.Y,pt.X-dpx,pt.Y-dpy); + // If the options ticked to paint the start, center or end, paint same + if ((ptGC1.FPointKind = gcpkStart) and (gcpoMarkStart in FOptions)) or + ((ptGC1.FPointKind = gcpkCenter) and (gcpoMarkCenter in FOptions)) or + ((ptGC1.FPointKind = gcpkDestination) and (gcpoMarkDestination in FOptions)) then + begin + MapView.Canvas.Pen := FOrthodromePen; + for pt in ptCyc do + MapView.Canvas.Ellipse(pt.X-5,pt.Y-5,pt.X+5,pt.Y+5); + end; + end; + // take the current point as the last one + ptGC0 := ptGC1; + end; + end; +end; + +// Nearly the same for drawing with the drawing engine on the map. +procedure TGreatCirclePainterPlugin.PaintGreatCircleWithDrawingEngine; +var + i : Integer; + pt : TPoint; + pt0, pt1 : TPoint; + ptCyc: TPointArray; + dpx, dpy : Integer; + ptGC0 : TGreatCirclePoint; + ptGC1 : TGreatCirclePoint; + cnt : Integer; + lWorldSize : Int64; + topY, bottomY : Integer; + ptOutArr : array of Boolean = Nil; + lDrawingEngine : TMvCustomDrawingEngine; + isCyclic : Boolean; +begin + cnt := FGreatCircleLinePoints.Count; + if cnt > 1 then + begin + isCyclic := MapView.Cyclic; + lWorldSize := mvGeoMath.ZoomFactor(MapView.Zoom) * TileSize.CX; + lDrawingEngine := MapView.DrawingEngine; + pt0 := MapView.LatLonToScreen(90.0,0); + topY := pt0.Y; + pt0 := MapView.LatLonToScreen(-90.0,0); + bottomY := pt0.Y; + SetLength(ptOutArr,cnt); + for i := 0 to cnt-1 do + begin + ptGC0 := TGreatCirclePoint(FGreatCircleLinePoints.Items[i]); + pt0 := MapView.LatLonToScreen(ptGC0.RealPoint); + ptOutArr[i] := (pt0.Y <= topY) or (pt0.Y >= bottomY); + end; + for i := 1 to cnt-1 do + begin + if not ptOutArr[i] then Continue; + ptGC0 := TGreatCirclePoint(FGreatCircleLinePoints.Items[i-1]); + pt0 := MapView.LatLonToScreen(ptGC0.RealPoint); + ptGC1 := TGreatCirclePoint(FGreatCircleLinePoints.Items[i]); + pt1 := MapView.LatLonToScreen(ptGC1.RealPoint); + + if ((pt0.Y <= topY) and (pt1.Y >= bottomY)) or + ((pt0.Y >= bottomY) and (pt1.Y <= topY)) then + ptOutArr[i] := False; + end; + + lDrawingEngine.BrushStyle:= bsClear; + lDrawingEngine.PenStyle:= Pen.Style; + lDrawingEngine.PenWidth:= Pen.Width; + lDrawingEngine.PenColor:= Pen.Color; + + ptGC0 := TGreatCirclePoint(FGreatCircleLinePoints.Items[0]); + for i := 1 to cnt-1 do + begin + ptGC1 := TGreatCirclePoint(FGreatCircleLinePoints.Items[i]); + if (not ptOutArr[i-1]) or (not ptOutArr[i]) then + begin + pt0 := MapView.LatLonToScreen(ptGC0.RealPoint); + pt1 := MapView.LatLonToScreen(ptGC1.RealPoint); + if isCyclic then + begin + pt0.X := Trunc(Frac(pt0.X / lWorldSize)*lWorldSize); + if pt0.X < 0 then + pt0.X := pt0.X + lWorldSize + else if pt0.X > lWorldSize then + pt0.X := pt0.X - lWorldSize; + pt1.X := Trunc(Frac(pt1.X / lWorldSize)*lWorldSize); + if pt1.X < 0 then + pt1.X := pt1.X + lWorldSize + else if pt1.X > lWorldSize then + pt1.X := pt1.X - lWorldSize; + end; + + dpy := pt1.Y-pt0.Y; + dpx := pt1.X-pt0.X; + if Abs(dpx) > (lWorldSize div 2) then + begin + if dpx < 0 then + dpx := dpx + lWorldSize + else + dpx := dpx - lWorldSize; + end; + + if (ptGC0.FPointKind <> gcpkStandard) and + (ptGC1.FPointKind <> gcpkStandard) then + begin + lDrawingEngine.PenStyle:= FOrthodromePen.Style; + lDrawingEngine.PenWidth:= FOrthodromePen.Width; + lDrawingEngine.PenColor:= FOrthodromePen.Color; + end + else + begin + lDrawingEngine.PenStyle:= Pen.Style; + lDrawingEngine.PenWidth:= Pen.Width; + lDrawingEngine.PenColor:= Pen.Color; + end; + + ptCyc := MapView.CyclicPointsOf(pt1); + for pt in ptCyc do + lDrawingEngine.Line(pt.X,pt.Y,pt.X-dpx,pt.Y-dpy); + + if ((ptGC1.FPointKind = gcpkStart) and (gcpoMarkStart in FOptions)) or + ((ptGC1.FPointKind = gcpkCenter) and (gcpoMarkCenter in FOptions)) or + ((ptGC1.FPointKind = gcpkDestination) and (gcpoMarkDestination in FOptions)) then + begin + lDrawingEngine.PenStyle:= FOrthodromePen.Style; + lDrawingEngine.PenWidth:= FOrthodromePen.Width; + lDrawingEngine.PenColor:= FOrthodromePen.Color; + for pt in ptCyc do + begin +// A small bug in the TMvIntfGraphicsDrawingEngine, the ellipse is not drawn in +// the correct pen width, while a rectangle is. +// lDrawingEngine.Rectangle(pt.X-5,pt.Y-5,pt.X+5,pt.Y+5); + lDrawingEngine.Ellipse(pt.X-5,pt.Y-5,pt.X+5,pt.Y+5); + end; + end; + end; + ptGC0 := ptGC1; + end; + end; +end; + +procedure TGreatCirclePainterPlugin.OrthodromePenChanged(Sender: TObject); +begin + inherited Update; // No recalculation of the map needed, only a redraw of the map +end; + +procedure TGreatCirclePainterPlugin.SetGreatCirclePen(Value: TPen); +begin + Pen := Value; +end; + +function TGreatCirclePainterPlugin.GetGreatCirclePen: TPen; +begin + Result := Pen; +end; + +procedure TGreatCirclePainterPlugin.AfterDrawObjects(AMapView: TMapView; + var Handled: Boolean); +begin + Unused(AMapView,Handled); + if FZOrder <> gcpzInFrontOfMarkers then Exit; + DoGetCoordEvent; + PaintGreatCircleWithDrawingEngine; +end; + +procedure TGreatCirclePainterPlugin.AfterPaint(AMapView: TMapView; var Handled: Boolean); +begin + Unused(AMapView,Handled); + if FZOrder <> gcpzCanvas then Exit; + DoGetCoordEvent; + PaintGreatCircleWithCanvas; +end; + +procedure TGreatCirclePainterPlugin.BeforeDrawObjects(AMapView: TMapView; + var Handled: Boolean); +begin + Unused(AMapView,Handled); + if FZOrder <> gcpzBehindMarkers then Exit; + DoGetCoordEvent; + PaintGreatCircleWithDrawingEngine; +end; + +procedure TGreatCirclePainterPlugin.CenterMove(AMapView: TMapView; + var Handled: Boolean); +begin + Unused(AMapView,Handled); + Update; +end; + +procedure TGreatCirclePainterPlugin.Resize(AMapView: TMapView; + var Handled: Boolean); +begin + Unused(AMapView,Handled); + Update; +end; + +procedure TGreatCirclePainterPlugin.ZoomChange(AMapView: TMapView; + var Handled: Boolean); +begin + Unused(AMapView,Handled); + Update; +end; + +procedure TGreatCirclePainterPlugin.Update; +begin + CalculateGreatCircle; + inherited; +end; + +procedure TGreatCirclePainterPlugin.SetStartAndDestination(const AStartLat, + AStartLon, ADestinationLat, ADestinationLon: Double); +var + lSPt, sDPt : TRealPoint; +begin + lSPt.InitLatLon(AStartLat,AStartLon); + sDPt.InitLatLon(ADestinationLat, ADestinationLon); + SetStartAndDestination(lSPt, sDPt); +end; + +procedure TGreatCirclePainterPlugin.SetStartAndDestination(const AStart, + ADestination: TRealPoint); +var + lNewStart, lNewDest : TRealPoint; +begin + lNewStart.Lat := LimitLat(AStart.Lat); + lNewStart.Lon := LimitLon(AStart.Lon); + lNewDest.Lat := LimitLat(ADestination.Lat); + lNewDest.Lon := LimitLon(ADestination.Lon); + if (FStart.Lat <>lNewStart.Lat) or + (FStart.Lon <>lNewStart.Lon) or + (FDestination.Lat <> lNewDest.Lat) or + (FDestination.Lon <> lNewDest.Lon) then + begin + FStart.Lat := lNewStart.Lat; + FStart.Lon := lNewStart.Lon; + FDestination.Lat := lNewDest.Lat; + FDestination.Lon := lNewDest.Lon; + Update; + end; +end; + +constructor TGreatCirclePainterPlugin.Create(AOwner: TComponent); +begin + inherited; + FGreatCircleLinePoints := TObjectList.Create(True); + FSegmentLength := DefaultSegmentLength; + FOrthodromePen := TPen.Create; + FOrthodromePen.OnChange := @OrthodromePenChanged; +end; + +destructor TGreatCirclePainterPlugin.Destroy; +begin + if Assigned(FGreatCircleLinePoints) then + FGreatCircleLinePoints.Free; + FOrthodromePen.Free; + inherited; +end; + +initialization + RegisterPluginClass(TGreatCirclePainterPlugin, 'Great Circle Painter'); + +end. + diff --git a/components/lazmapviewer/source/mvgeomath.pas b/components/lazmapviewer/source/mvgeomath.pas index db3191dd5..d05bfd05f 100644 --- a/components/lazmapviewer/source/mvgeomath.pas +++ b/components/lazmapviewer/source/mvgeomath.pas @@ -69,6 +69,19 @@ begin Result := round(IntPower(2, AZoomLevel)); end; +{ Protected version of arcin which does not crash when the argument is outside + domain due to round-off error. } +function SafeArcsin(x: Double): Double; +begin + if x >= +1.0 then + Result := pi * 0.5 + else + if x <= -1.0 then + Result := -pi * 0.5 + else + Result := arcsin(x); +end; + { Calculation of distance on a sphere https://stackoverflow.com/questions/73608975/pascal-delphi-11-formula-for-distance-in-meters-between-two-decimal-gps-point } @@ -76,24 +89,24 @@ end; function HaversineAngle(Lat1, Lon1, Lat2, Lon2: Double): Double; var latFrom, latTo, lonDiff: Double; - dx, dy, dz, arg: Double; + sinLatFrom, cosLatFrom: Double; + sinLatTo, cosLatTo: Double; + sinLonDiff, cosLonDiff: Double; + dx, dy, dz: Double; begin lonDiff := Lon1 - Lon2; latFrom := Lat1; latTo := Lat2; - dz := sin(latFrom) - sin(latTo); - dx := cos(lonDiff) * cos(latFrom) - cos(latTo); - dy := sin(lonDiff) * cos(latFrom); + SinCos(latFrom, sinLatFrom, cosLatFrom); + SinCos(latTo, sinLatTo, cosLatTo); + SinCos(lonDiff, sinLonDiff, cosLonDiff); - arg := sqrt(sqr(dx) + sqr(dy) + sqr(dz)) / 2.0; - if arg >= 1.0 then - Result := pi - else - if arg <= -1.0 then - Result := -pi - else - Result := arcsin(arg) * 2.0; + dz := sinlatFrom - sinlatTo; + dx := coslonDiff * coslatFrom - coslatTo; + dy := sinlonDiff * coslatFrom; + + Result := SafeArcsin(sqrt(sqr(dx) + sqr(dy) + sqr(dz)) / 2.0) * 2.0; end; // Angles in degrees @@ -167,12 +180,20 @@ end; function CalcBearing(Lat1, Lon1, Lat2, Lon2: Double): Double; var latFrom, latTo, lonDiff: Double; + sin_LatFrom, cos_LatFrom: Double; + sin_LatTo, cos_LatTo: Double; + sin_LonDiff, cos_LonDiff: Double; begin lonDiff := DegToRad(Lon2 - Lon1); latFrom := DegToRad(Lat1); latTo := DegToRad(Lat2); - Result := ArcTan2(Sin(lonDiff) * Cos(latTo), - Cos(latFrom) * Sin(latTo) - Sin(latFrom) * Cos(latTo) * Cos(lonDiff)); + + SinCos(lonDiff, sin_LonDiff, cos_LonDiff); + SinCos(latFrom, sin_LatFrom, cos_LatFrom); + SinCos(latTo, sin_LatTo, cos_LatTo); + + Result := ArcTan2(sin_LonDiff * cos_LatTo, + cos_LatFrom * sin_LatTo - sin_LatFrom * cos_LatTo * cos_LonDiff); Result := RadToDeg(Result); if Result < 0.0 then Result := Result + 360.0; @@ -186,16 +207,25 @@ procedure CalcLatLon(const Lat1, Lon1, ADist, ABearing: Double; out Lat2, Lon2: Double); var latFrom, lonFrom, brng, aD: Double; + sin_LatFrom, cos_LatFrom: Double; + sin_LonFrom, cos_LonFrom: Double; + sin_brng, cos_brng: Double; + sin_aD, cos_aD: Double; begin latFrom := DegToRad(Lat1); lonFrom := DegToRad(Lon1); brng := DegToRad(ABearing); aD := ADist / EARTH_EQUATORIAL_RADIUS; - Lat2 := ArcSin(Sin(latFrom) * Cos(aD) + Cos(latFrom) * Sin(aD) * Cos(brng)); - Lon2 := lonFrom + ArcTan2(Sin(brng) * Sin(aD) * Cos(latFrom), - Cos(aD) - Sin(latFrom) * Sin(Lat2)); + + SinCos(latFrom, sin_LatFrom, cos_LatFrom); + SinCos(lonFrom, sin_lonFrom, cos_lonFrom); + SinCos(brng, sin_brng, cos_brng); + SinCos(aD, sin_aD, cos_aD); + + Lat2 := SafeArcSin(sin_LatFrom * cos_aD + cos_LatFrom * sin_aD * cos_brng); + Lon2 := lonFrom + ArcTan2(sin_brng * sin_aD * cos_latFrom, cos_aD - sin_latFrom * Sin(Lat2)); Lat2 := RadToDeg(Lat2); - Lon2 := NormalizeLon(RadToDeg(Lon2)); + Lon2 := {%H-}NormalizeLon(RadToDeg(Lon2)); end; { Calculate midpoint Lat,Lon by given start point Lat1,Lon1 and end point @@ -205,6 +235,7 @@ procedure CalcMidpoint(const Lat1, Lon1, Lat2, Lon2: Double; out Lat, Lon: Double); var latFrom, lonDiff, latTo, lonTo, Bx, By: Double; + sin_latFrom, cos_latFrom: Double; begin lonDiff := DegToRad(Lon2 - Lon1); latFrom := DegToRad(Lat1); @@ -212,10 +243,13 @@ begin lonTo := DegToRad(Lon2); Bx := Cos(latTo) * Cos(lonDiff); By := Cos(latTo) * Sin(lonDiff); - Lat := ArcTan2(Sin(latFrom) + Sin(latTo), Sqrt(Sqr(Cos(latFrom) + Bx) + Sqr(By))); - Lon := lonTo + ArcTan2(By, Cos(latFrom) + By); + + SinCos(latFrom, sin_latFrom, cos_latFrom); + + Lat := ArcTan2(sin_latFrom + Sin(latTo), Sqrt(Sqr(cos_latFrom + Bx) + Sqr(By))); + Lon := lonTo + ArcTan2(By, cos_latFrom + By); Lat := RadToDeg(Lat); - Lon := NormalizeLon(RadToDeg(Lon)); + Lon := {%H-}NormalizeLon(RadToDeg(Lon)); end; { Calculate intermediate point Lat,Lon by given start point Lat1,Lon1, end point @@ -227,6 +261,9 @@ procedure CalcIntermedPoint(const Lat1, Lon1, Lat2, Lon2, AFrac: Double; out var latFrom, lonFrom, latTo, lonTo: Double; A, B, aD, X, Y, Z: Double; + sin_latFrom, cos_latFrom: Double; + sin_lonFrom, cos_lonFrom: Double; + sin_latTo, cos_latTo: Double; begin if (Lat1 = Lat2) and (Lon1 = Lon2) or (AFrac < 0.001) then begin @@ -245,15 +282,20 @@ begin lonFrom := DegToRad(Lon1); latTo := DegToRad(Lat2); lonTo := DegToRad(Lon2); + + SinCos(latFrom, sin_LatFrom, cos_LatFrom); + SinCos(lonFrom, sin_LonFrom, cos_lonFrom); + SinCos(latTo, sin_latTo, cos_latTo); + A := Sin((1.0 - AFrac) * aD) / Sin(aD); B := Sin(AFrac * aD) / Sin(aD); - X := A * Cos(latFrom) * Cos(lonFrom) + B * Cos(latTo) * Cos(lonTo); - Y := A * Cos(latFrom) * Sin(lonFrom) + B * Cos(latTo) * Sin(lonTo); - Z := A * Sin(latFrom) + B * Sin(latTo); + X := A * cos_latFrom * cos_lonFrom + B * cos_latTo * Cos(lonTo); + Y := A * cos_latFrom * sin_lonFrom + B * cos_latTo * Sin(lonTo); + Z := A * sin_latFrom + B * sin_latTo; Lat := ArcTan2(Z, Sqrt(Sqr(X) + Sqr(Y))); Lon := ArcTan2(Y, X); Lat := RadToDeg(Lat); - Lon := NormalizeLon(RadToDeg(Lon)); + Lon := {%H-}NormalizeLon(RadToDeg(Lon)); end; function NormalizeLon(const Lon: Double): Double;