Abf Viewer: Embedded StreetView

├── DelphiMaps.groupproj ├── README.md ├── demos ├── DemoDirections │ ├── DemoDirections.dpr │ ├── DemoDirections.dproj │ ├── DemoDirections.res │ ├── uFrmMain.dfm │ └── uFrmMain.pas ├── DemoGeoCoder │ ├── DemoGeoCoder.dpr │ ├── DemoGeoCoder.dproj │ ├── DemoGeoCoder.res │ ├── uFrmMain.dfm │ └── uFrmMain.pas ├── DemoGeoCoderSimple │ └── DemoGeoCoderSimple.dpr ├── DemoGoogleMaps │ ├── DemoGoogleMaps.dpr │ ├── DemoGoogleMaps.dproj │ ├── DemoGoogleMaps.res │ ├── uFrmMain.dfm │ └── uFrmMain.pas ├── DemoStaticMap │ ├── DemoStaticMap.dpr │ ├── DemoStaticMap.dproj │ ├── DemoStaticMap.res │ ├── uFrmMain.dfm │ └── uFrmMain.pas ├── DemoStreetView │ ├── DemoStreetView.dpr │ ├── DemoStreetView.dproj │ ├── DemoStreetView.res │ ├── uFrmMain.dfm │ └── uFrmMain.pas └── DemoWMS │ ├── DemoWMS.dpr │ ├── DemoWMS.dproj │ ├── DemoWMS.res │ ├── uFrmMain.dfm │ └── uFrmMain.pas ├── packages ├── DelphiMapsDesignTime.dpk ├── DelphiMapsDesignTime.dproj ├── DelphiMapsDesignTime.res ├── DelphiMapsRunTime.dpk ├── DelphiMapsRunTime.dproj └── DelphiMapsRunTime.res └── source ├── DelphiMaps.Browser.Event.pas ├── DelphiMaps.Browser.External.pas ├── DelphiMaps.Browser.ExternalContainer.pas ├── DelphiMaps.Browser.IntfDocHostUIHandler.pas ├── DelphiMaps.Browser.NulContainer.pas ├── DelphiMaps.Browser.pas ├── DelphiMaps.DouglasPeuckers.pas ├── DelphiMaps.GeoCoder.pas ├── DelphiMaps.GeoCoderXML.pas ├── DelphiMaps.GoogleDirections.pas ├── DelphiMaps.GoogleDirectionsXML.pas ├── DelphiMaps.GoogleMaps.dcr ├── DelphiMaps.GoogleMaps.html ├── DelphiMaps.GoogleMaps.pas ├── DelphiMaps.GoogleMaps_html.rc ├── DelphiMaps.GoogleMaps_html.res ├── DelphiMaps.LayerList.pas ├── DelphiMaps.Location.pas ├── DelphiMaps.Register.pas ├── DelphiMaps.StaticMap.pas ├── DelphiMaps.StreetView.html ├── DelphiMaps.StreetView.pas ├── DelphiMaps.StreetView_html.rc ├── DelphiMaps.StreetView_html.res ├── DelphiMaps.WMS.Client.pas ├── DelphiMaps.WebImage.pas ├── DelphiMapsBrowserExternal.ridl ├── DelphiMapsBrowserExternal.tlb └── DelphiMapsBrowserExternal_TLB.pas /DelphiMaps.groupproj: -------------------------------------------------------------------------------- 1 | 2 | 3 | {304059C2-3677-4185-BCCD-E46FFDD08C70} 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | Default.Personality.12 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | 61 | 62 | 63 | 64 | 65 | 66 | 67 | 68 | 69 | 70 | 71 | 72 | 73 | 74 | 75 | 76 | 77 | 78 | 79 | 80 | 81 | 82 | 83 | 84 | 85 | 86 | 87 | 88 | 89 | 90 | 91 | 92 | 93 | 94 | 95 | 96 | 97 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # DelphiMaps 2 | 3 | The project contains wrappers for: 4 | 5 | - Google Maps API (v3) 6 | - Openstreetmap Static Maps 7 | - Geocoding API 8 | - Directions API 9 | - StreetView 10 | 11 | **Update 1** 12 | 13 | This project has been deprecated, and won't be updated any longer. 14 | 15 | It was created during a time where free and open source libraries to embed Google Maps related API's in Delphi applications were not available. 16 | 17 | In the meantime, I've switched to a stack of Postgres, PostGIS, OSM, GeoServer? and OpenLayers? for most of my GIS work. I've got OpenLayers? Delphi components that I use instead. If you're interested in those, you can contact me. 18 | 19 | If you're looking for a Google Maps wrappers for Delphi that are actively maintained, I recommend switching to GMLib: 20 | 21 | http://sourceforge.net/projects/gmlibrary/ 22 | 23 | Thanks for the nice feedback thank I've received over the years. 24 | 25 | Wouter 26 | 27 | **Update 2** 28 | 29 | Moved repository from Google Code to GitHub, because Google announced the EOL of their service 30 | -------------------------------------------------------------------------------- /demos/DemoDirections/DemoDirections.dpr: -------------------------------------------------------------------------------- 1 | program DemoDirections; 2 | 3 | uses 4 | Forms, 5 | uFrmMain in 'uFrmMain.pas' {frmMain}; 6 | 7 | {$R *.res} 8 | 9 | begin 10 | Application.Initialize; 11 | Application.MainFormOnTaskbar := True; 12 | Application.CreateForm(TfrmMain, frmMain); 13 | Application.Run; 14 | end. 15 | -------------------------------------------------------------------------------- /demos/DemoDirections/DemoDirections.dproj: -------------------------------------------------------------------------------- 1 | 2 | 3 | {41F9D30E-69B8-4F97-B0B2-847AF7A60A11} 4 | DemoDirections.dpr 5 | 12.2 6 | True 7 | Debug 8 | Win32 9 | Application 10 | VCL 11 | DCC32 12 | 13 | 14 | true 15 | 16 | 17 | true 18 | Base 19 | true 20 | 21 | 22 | true 23 | Base 24 | true 25 | 26 | 27 | 00400000 28 | .\$(Config)\$(Platform) 29 | WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;$(DCC_UnitAlias) 30 | .\$(Config)\$(Platform) 31 | false 32 | false 33 | false 34 | false 35 | false 36 | 37 | 38 | DEBUG;$(DCC_Define) 39 | false 40 | true 41 | 42 | 43 | false 44 | RELEASE;$(DCC_Define) 45 | 0 46 | false 47 | 48 | 49 | 50 | MainSource 51 | 52 | 53 | 54 | 55 | 56 | Cfg_2 57 | Base 58 | 59 | 60 | Base 61 | 62 | 63 | Cfg_1 64 | Base 65 | 66 | 67 | 68 | 69 | 70 | Delphi.Personality.12 71 | 72 | 73 | 74 | 75 | False 76 | False 77 | 1 78 | 0 79 | 0 80 | 0 81 | False 82 | False 83 | False 84 | False 85 | False 86 | 1043 87 | 1252 88 | 89 | 90 | 91 | 92 | 1.0.0.0 93 | 94 | 95 | 96 | 97 | 98 | 1.0.0.0 99 | 100 | 101 | 102 | DemoDirections.dpr 103 | 104 | 105 | 106 | True 107 | 108 | 109 | 12 110 | 111 | 112 | -------------------------------------------------------------------------------- /demos/DemoDirections/DemoDirections.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/WouterVanNifterick/delphi-maps/b16f46d3c99642d32c660d6632d4c1d2da572a9c/demos/DemoDirections/DemoDirections.res -------------------------------------------------------------------------------- /demos/DemoDirections/uFrmMain.dfm: -------------------------------------------------------------------------------- 1 | object frmMain: TfrmMain 2 | Left = 0 3 | Top = 0 4 | Caption = 'DelphiMaps Directions Demo' 5 | ClientHeight = 462 6 | ClientWidth = 691 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | PixelsPerInch = 96 15 | TextHeight = 13 16 | object Splitter1: TSplitter 17 | Left = 258 18 | Top = 29 19 | Width = 4 20 | Height = 405 21 | ExplicitLeft = 177 22 | ExplicitTop = 57 23 | ExplicitHeight = 221 24 | end 25 | object pnlTop: TPanel 26 | Left = 0 27 | Top = 0 28 | Width = 691 29 | Height = 29 30 | Align = alTop 31 | TabOrder = 0 32 | object lblStart: TLabel 33 | AlignWithMargins = True 34 | Left = 4 35 | Top = 4 36 | Width = 31 37 | Height = 21 38 | Align = alLeft 39 | Caption = 'From: ' 40 | Layout = tlCenter 41 | ExplicitHeight = 13 42 | end 43 | object lblEnd: TLabel 44 | AlignWithMargins = True 45 | Left = 239 46 | Top = 4 47 | Width = 19 48 | Height = 21 49 | Align = alLeft 50 | Caption = 'To: ' 51 | Layout = tlCenter 52 | ExplicitHeight = 13 53 | end 54 | object edStart: TEdit 55 | AlignWithMargins = True 56 | Left = 41 57 | Top = 4 58 | Width = 192 59 | Height = 21 60 | Align = alLeft 61 | TabOrder = 0 62 | Text = 'Ypenburg, Den Haag' 63 | end 64 | object btnGetDirections: TButton 65 | AlignWithMargins = True 66 | Left = 594 67 | Top = 4 68 | Width = 93 69 | Height = 21 70 | Align = alRight 71 | Caption = 'Get Directions' 72 | TabOrder = 2 73 | OnClick = btnGetDirectionsClick 74 | end 75 | object edEnd: TEdit 76 | AlignWithMargins = True 77 | Left = 264 78 | Top = 4 79 | Width = 177 80 | Height = 21 81 | Align = alLeft 82 | TabOrder = 1 83 | Text = 'Haagweg, Rijswijk' 84 | end 85 | end 86 | object pnlURL: TPanel 87 | Left = 0 88 | Top = 434 89 | Width = 691 90 | Height = 28 91 | Align = alBottom 92 | TabOrder = 1 93 | object edURL: TEdit 94 | AlignWithMargins = True 95 | Left = 4 96 | Top = 4 97 | Width = 683 98 | Height = 20 99 | Align = alClient 100 | ParentColor = True 101 | ReadOnly = True 102 | TabOrder = 0 103 | ExplicitHeight = 21 104 | end 105 | end 106 | object TreeView1: TTreeView 107 | AlignWithMargins = True 108 | Left = 3 109 | Top = 32 110 | Width = 255 111 | Height = 399 112 | Margins.Right = 0 113 | Align = alLeft 114 | Indent = 19 115 | TabOrder = 2 116 | end 117 | object Panel1: TPanel 118 | Left = 262 119 | Top = 29 120 | Width = 429 121 | Height = 405 122 | Align = alClient 123 | TabOrder = 3 124 | ExplicitLeft = 280 125 | ExplicitTop = 248 126 | ExplicitWidth = 185 127 | ExplicitHeight = 41 128 | object Splitter2: TSplitter 129 | Left = 1 130 | Top = 300 131 | Width = 427 132 | Height = 4 133 | Cursor = crVSplit 134 | Align = alBottom 135 | ExplicitTop = 314 136 | end 137 | object ListView1: TListView 138 | Left = 1 139 | Top = 1 140 | Width = 427 141 | Height = 299 142 | Align = alClient 143 | Columns = < 144 | item 145 | Caption = '#' 146 | Width = 45 147 | end 148 | item 149 | Caption = 'Start' 150 | Width = 0 151 | end 152 | item 153 | Caption = 'End' 154 | Width = 0 155 | end 156 | item 157 | Caption = 'Duration' 158 | Width = 60 159 | end 160 | item 161 | Caption = 'Distance' 162 | Width = 60 163 | end 164 | item 165 | AutoSize = True 166 | Caption = 'Instructions' 167 | end> 168 | RowSelect = True 169 | TabOrder = 0 170 | ViewStyle = vsReport 171 | end 172 | object Memo1: TMemo 173 | AlignWithMargins = True 174 | Left = 1 175 | Top = 304 176 | Width = 424 177 | Height = 97 178 | Margins.Left = 0 179 | Margins.Top = 0 180 | Align = alBottom 181 | TabOrder = 1 182 | WordWrap = False 183 | end 184 | end 185 | end 186 | -------------------------------------------------------------------------------- /demos/DemoDirections/uFrmMain.pas: -------------------------------------------------------------------------------- 1 | {**************************************************************************************************} 2 | { The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } 3 | { you may not use this file except in compliance with the License. You may obtain a copy of the } 4 | { License at http://www.mozilla.org/MPL/ } 5 | { } 6 | { Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } 7 | { ANY KIND, either express or implied. See the License for the specific language governing rights } 8 | { and limitations under the License. } 9 | { } 10 | { The Initial Developer of the Original Code is Wouter van Nifterick } 11 | { (wouter_van_nifterick@hotmail.com. } 12 | {**************************************************************************************************} 13 | unit uFrmMain; 14 | 15 | interface 16 | 17 | uses 18 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 19 | Dialogs, StdCtrls, ExtCtrls, ComCtrls; 20 | 21 | type 22 | TfrmMain = class(TForm) 23 | pnlTop: TPanel; 24 | edStart: TEdit; 25 | edEnd: TEdit; 26 | btnGetDirections: TButton; 27 | lblStart: TLabel; 28 | lblEnd: TLabel; 29 | pnlURL: TPanel; 30 | edURL: TEdit; 31 | TreeView1: TTreeView; 32 | Splitter1: TSplitter; 33 | Panel1: TPanel; 34 | ListView1: TListView; 35 | Memo1: TMemo; 36 | Splitter2: TSplitter; 37 | procedure btnGetDirectionsClick(Sender: TObject); 38 | end; 39 | 40 | procedure XMLtoTreeView(const aXML:String;aTreeView:TTreeView); 41 | 42 | var 43 | frmMain: TfrmMain; 44 | 45 | implementation 46 | 47 | uses 48 | XmlDoc, XmlIntf, 49 | DelphiMaps.GoogleDirections; 50 | 51 | {$R *.dfm} 52 | 53 | // general function to display any XML data in a TreeView 54 | procedure XMLtoTreeView(const aXML:String;aTreeView:TTreeView); 55 | var 56 | XMLDocument: IXMLDocument; 57 | procedure AddNodes(aXMLNode: IXMLNode; aTreeNode: TTreeNode; aIndex:Integer); 58 | var 59 | I: Integer; 60 | LNewNode: TTreeNode; 61 | LValue: string; 62 | begin 63 | if aXMLNode.NodeType in [ntText, ntCData, ntComment] then 64 | begin 65 | LValue := aXMLNode.text; 66 | aTreeNode.Text := aTreeNode.Text + '=' + LValue; 67 | end 68 | else 69 | begin 70 | LValue := aXMLNode.nodeName; 71 | LNewNode := aTreeView.Items.AddChild(aTreeNode, LValue); 72 | for I := 0 to aXMLNode.childNodes.Count - 1 do 73 | AddNodes(aXMLNode.childNodes[I], LNewNode,I); 74 | end; 75 | end; 76 | begin 77 | XMLDocument := TXMLDocument.Create(nil); 78 | XMLDocument.XML.Text:= aXML; 79 | XMLDocument.Active := True; 80 | try 81 | aTreeView.Items.BeginUpdate; 82 | aTreeView.Items.Clear; 83 | AddNodes(XMLDocument.Node , nil, 0); 84 | aTreeView.Items[0].Expand(True); 85 | aTreeView.TopItem := aTreeView.Items[0]; 86 | finally 87 | aTreeView.Items.EndUpdate; 88 | end; 89 | end; 90 | 91 | 92 | 93 | 94 | procedure TfrmMain.btnGetDirectionsClick(Sender: TObject); 95 | var 96 | LRequest : TGoogleDirectionsRequest; 97 | LDirections:IDirections; 98 | I: Integer; 99 | begin 100 | // create a request, set its parameters, and get the response from Google 101 | LRequest := TGoogleDirectionsRequest.Create(self); 102 | LRequest.origin.Text := edStart.Text; 103 | LRequest.destination.Text := edEnd.Text; 104 | edURL.Text := LRequest.URL; 105 | LDirections := LRequest.GetResponse ; 106 | 107 | XMLtoTreeView(LDirections.XML, TreeView1); // show the XML string as a treeview 108 | 109 | // display the result in a memo 110 | 111 | Memo1.Clear; 112 | Memo1.Lines.Add('Summary:'+ LDirections.Route.Summary ); 113 | Memo1.Lines.Add('Copyrights:'+ LDirections.Route.Copyrights ); 114 | Memo1.Lines.Add('Distance:'+ LDirections.Route.Leg.Distance.Text ); 115 | Memo1.Lines.Add('From:'+ LDirections.Route.Leg.Start_address ); 116 | Memo1.Lines.Add('From:'+ LDirections.Route.Leg.End_address ); 117 | 118 | ListView1.Clear; 119 | for I := 0 to LDirections.Route.Leg.Step.Count-1 do 120 | begin 121 | with ListView1.Items.Add do 122 | begin 123 | Caption := 'Step '+IntToStr(I+1); 124 | SubItems.Add( 125 | Format('(%s,%s)',[ 126 | LDirections.Route.Leg.Step[I].Start_location.Lat, 127 | LDirections.Route.Leg.Step[I].Start_location.Lng 128 | ]) 129 | ); 130 | SubItems.Add( 131 | Format('(%s,%s)',[ 132 | LDirections.Route.Leg.Step[I].End_location.Lat, 133 | LDirections.Route.Leg.Step[I].End_location.Lng 134 | ]) 135 | ); 136 | SubItems.Add(LDirections.Route.Leg.Step[I].Duration.Text); 137 | SubItems.Add(LDirections.Route.Leg.Step[I].Distance.Text); 138 | SubItems.Add(LDirections.Route.Leg.Step[I].Html_instructions); 139 | end; 140 | end; 141 | 142 | 143 | end; 144 | 145 | 146 | end. 147 | -------------------------------------------------------------------------------- /demos/DemoGeoCoder/DemoGeoCoder.dpr: -------------------------------------------------------------------------------- 1 | program DemoGeoCoder; 2 | 3 | uses 4 | Forms, 5 | uFrmMain in 'uFrmMain.pas' {frmMain}; 6 | 7 | {$R *.res} 8 | 9 | begin 10 | Application.Initialize; 11 | Application.MainFormOnTaskbar := True; 12 | Application.CreateForm(TfrmMain, frmMain); 13 | Application.Run; 14 | end. 15 | -------------------------------------------------------------------------------- /demos/DemoGeoCoder/DemoGeoCoder.dproj: -------------------------------------------------------------------------------- 1 | 2 | 3 | {BCF2903B-D549-478C-A529-F24A05EBE334} 4 | DemoGeoCoder.dpr 5 | 12.2 6 | True 7 | Debug 8 | Win32 9 | Application 10 | VCL 11 | DCC32 12 | 13 | 14 | true 15 | 16 | 17 | true 18 | Base 19 | true 20 | 21 | 22 | true 23 | Base 24 | true 25 | 26 | 27 | 00400000 28 | .\$(Config)\$(Platform) 29 | WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;$(DCC_UnitAlias) 30 | .\$(Config)\$(Platform) 31 | false 32 | false 33 | false 34 | false 35 | false 36 | 37 | 38 | DEBUG;$(DCC_Define) 39 | false 40 | true 41 | 42 | 43 | false 44 | RELEASE;$(DCC_Define) 45 | 0 46 | false 47 | 48 | 49 | 50 | MainSource 51 | 52 | 53 | 54 | 55 | 56 | Cfg_2 57 | Base 58 | 59 | 60 | Base 61 | 62 | 63 | Cfg_1 64 | Base 65 | 66 | 67 | 68 | 69 | 70 | Delphi.Personality.12 71 | 72 | 73 | 74 | 75 | False 76 | False 77 | 1 78 | 0 79 | 0 80 | 0 81 | False 82 | False 83 | False 84 | False 85 | False 86 | 1043 87 | 1252 88 | 89 | 90 | 91 | 92 | 1.0.0.0 93 | 94 | 95 | 96 | 97 | 98 | 1.0.0.0 99 | 100 | 101 | 102 | DemoGeoCoder.dpr 103 | 104 | 105 | 106 | True 107 | 108 | 109 | 12 110 | 111 | 112 | -------------------------------------------------------------------------------- /demos/DemoGeoCoder/DemoGeoCoder.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/WouterVanNifterick/delphi-maps/b16f46d3c99642d32c660d6632d4c1d2da572a9c/demos/DemoGeoCoder/DemoGeoCoder.res -------------------------------------------------------------------------------- /demos/DemoGeoCoder/uFrmMain.dfm: -------------------------------------------------------------------------------- 1 | object frmMain: TfrmMain 2 | Left = 0 3 | Top = 0 4 | Caption = 'DelphiMaps GeoCoding Demo' 5 | ClientHeight = 347 6 | ClientWidth = 415 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | PixelsPerInch = 96 15 | TextHeight = 13 16 | object Panel1: TPanel 17 | Left = 0 18 | Top = 0 19 | Width = 415 20 | Height = 81 21 | Align = alTop 22 | BevelOuter = bvNone 23 | TabOrder = 0 24 | object GroupBox2: TGroupBox 25 | AlignWithMargins = True 26 | Left = 3 27 | Top = 3 28 | Width = 237 29 | Height = 75 30 | Align = alClient 31 | Caption = 'Search' 32 | TabOrder = 0 33 | DesignSize = ( 34 | 237 35 | 75) 36 | object edSearch: TEdit 37 | Left = 10 38 | Top = 19 39 | Width = 211 40 | Height = 21 41 | Anchors = [akLeft, akTop, akRight] 42 | TabOrder = 0 43 | OnChange = edSearchChange 44 | end 45 | object edFound: TEdit 46 | Left = 10 47 | Top = 46 48 | Width = 211 49 | Height = 21 50 | Anchors = [akLeft, akTop, akRight] 51 | ParentColor = True 52 | ReadOnly = True 53 | TabOrder = 1 54 | end 55 | end 56 | object GroupBox1: TGroupBox 57 | AlignWithMargins = True 58 | Left = 246 59 | Top = 3 60 | Width = 166 61 | Height = 75 62 | Align = alRight 63 | Caption = 'Position' 64 | TabOrder = 1 65 | DesignSize = ( 66 | 166 67 | 75) 68 | object edLat: TLabeledEdit 69 | Left = 35 70 | Top = 19 71 | Width = 121 72 | Height = 21 73 | Anchors = [akLeft, akTop, akRight] 74 | EditLabel.Width = 15 75 | EditLabel.Height = 13 76 | EditLabel.Caption = 'Lat' 77 | LabelPosition = lpLeft 78 | ParentColor = True 79 | ReadOnly = True 80 | TabOrder = 0 81 | end 82 | object edLon: TLabeledEdit 83 | Left = 35 84 | Top = 46 85 | Width = 121 86 | Height = 21 87 | Anchors = [akLeft, akTop, akRight] 88 | EditLabel.Width = 17 89 | EditLabel.Height = 13 90 | EditLabel.Caption = 'Lon' 91 | LabelPosition = lpLeft 92 | ParentColor = True 93 | ReadOnly = True 94 | TabOrder = 1 95 | end 96 | end 97 | end 98 | object GoogleMaps1: TGoogleMaps 99 | Left = 0 100 | Top = 81 101 | Width = 415 102 | Height = 266 103 | JsVarName = 'GoogleMaps1' 104 | Align = alClient 105 | MapType = MT_ROADMAP 106 | end 107 | object Timer1: TTimer 108 | Interval = 50 109 | OnTimer = Timer1Timer 110 | Left = 32 111 | Top = 40 112 | end 113 | end 114 | -------------------------------------------------------------------------------- /demos/DemoGeoCoder/uFrmMain.pas: -------------------------------------------------------------------------------- 1 | unit uFrmMain; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 7 | Dialogs, StdCtrls, 8 | DelphiMaps.GeoCoder, ExtCtrls, DelphiMaps.GoogleMaps, DelphiMaps.Browser ; 9 | 10 | type 11 | TfrmMain = class(TForm) 12 | Panel1: TPanel; 13 | GroupBox2: TGroupBox; 14 | edSearch: TEdit; 15 | edFound: TEdit; 16 | GroupBox1: TGroupBox; 17 | edLat: TLabeledEdit; 18 | edLon: TLabeledEdit; 19 | GoogleMaps1: TGoogleMaps; 20 | Timer1: TTimer; 21 | procedure edSearchChange(Sender: TObject); 22 | procedure Timer1Timer(Sender: TObject); 23 | private 24 | Ad:TAddressRec; 25 | ChangeDateTime:TDateTime; 26 | end; 27 | 28 | var 29 | frmMain: TfrmMain; 30 | 31 | implementation 32 | 33 | uses DateUtils; 34 | 35 | {$R *.dfm} 36 | 37 | procedure TfrmMain.edSearchChange(Sender: TObject); 38 | begin 39 | Ad.GeoCode(edSearch.Text); 40 | 41 | edFound.Text := Ad.FormattedName; 42 | edLat.Text := FloatToSTr(Ad.Lat); 43 | edLon.Text := FloatToSTr(Ad.Lon); 44 | 45 | ChangeDateTime := Now; 46 | end; 47 | 48 | procedure TfrmMain.Timer1Timer(Sender: TObject); 49 | const 50 | MinMapUpdateDelay=500; // milliseconds 51 | begin 52 | // JScript.dll doesn't like your fast typing :) 53 | // so let's limit map movement to twice per second 54 | if MilliSecondsBetween(Now,ChangeDateTime)>MinMapUpdateDelay then 55 | begin 56 | if edSearch.Text<>'' then 57 | GoogleMaps1.SetCenter(Ad.Lat, Ad.Lon); 58 | end; 59 | end; 60 | 61 | end. 62 | -------------------------------------------------------------------------------- /demos/DemoGeoCoderSimple/DemoGeoCoderSimple.dpr: -------------------------------------------------------------------------------- 1 | program DemoGeoCoderSimple; 2 | 3 | {$APPTYPE CONSOLE} 4 | 5 | uses 6 | SysUtils, 7 | DelphiMaps.GeoCoder; 8 | 9 | procedure Main; 10 | var 11 | LAddressStr: String; 12 | Address : TAddressRec; 13 | 14 | begin 15 | WriteLn('DelphiMaps GeoCoder Demo'); 16 | WriteLn('========================'); 17 | WriteLn; 18 | Write('Address: ':15); 19 | ReadLn(LAddressStr); 20 | Address.FormattedName := LAddressStr; 21 | Address.GeoCode; 22 | WriteLn; 23 | WriteLn('FormattedName: ':15 , Address.FormattedName); 24 | WriteLn('Country: ' :15 , Address.Country); 25 | WriteLn('City: ' :15 , Address.City); 26 | WriteLn('ZipCode: ' :15 , Address.ZipCode); 27 | WriteLn('StreetName: ' :15 , Address.StreetName); 28 | WriteLn('HouseNumer: ' :15 , Address.HouseNumer); 29 | WriteLn('Lat: ' :15, Address.Lat:7:5); 30 | WriteLn('Lon: ' :15, Address.Lon:7:5); 31 | WriteLn; 32 | WriteLn(Address.XML); 33 | WriteLn('Press any key to quit . . .'); 34 | 35 | ReadLn; 36 | 37 | end; 38 | 39 | begin 40 | try 41 | Main 42 | except 43 | on E: Exception do 44 | WriteLn(E.ClassName, ': ', E.Message); 45 | end; 46 | 47 | end. 48 | -------------------------------------------------------------------------------- /demos/DemoGoogleMaps/DemoGoogleMaps.dpr: -------------------------------------------------------------------------------- 1 | program DemoGoogleMaps; 2 | 3 | uses 4 | FastMM4, 5 | Forms, 6 | uFrmMain in 'uFrmMain.pas' {frmMain}; 7 | 8 | {$R *.res} 9 | 10 | begin 11 | Application.Initialize; 12 | Application.MainFormOnTaskbar := True; 13 | Application.CreateForm(TfrmMain, frmMain); 14 | Application.Run; 15 | end. 16 | -------------------------------------------------------------------------------- /demos/DemoGoogleMaps/DemoGoogleMaps.dproj: -------------------------------------------------------------------------------- 1 | 2 | 3 | {1522B0E2-2B26-462E-9E96-7B76CAA1FCE1} 4 | DemoGoogleMaps.dpr 5 | 12.2 6 | True 7 | Debug 8 | Win32 9 | Application 10 | VCL 11 | DCC32 12 | 13 | 14 | true 15 | 16 | 17 | true 18 | Base 19 | true 20 | 21 | 22 | true 23 | Base 24 | true 25 | 26 | 27 | 00400000 28 | .\$(Config)\$(Platform) 29 | WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;$(DCC_UnitAlias) 30 | .\$(Config)\$(Platform) 31 | false 32 | false 33 | false 34 | false 35 | false 36 | 37 | 38 | true 39 | true 40 | true 41 | true 42 | true 43 | true 44 | DEBUG;$(DCC_Define) 45 | false 46 | true 47 | 48 | 49 | false 50 | RELEASE;$(DCC_Define) 51 | 0 52 | false 53 | 54 | 55 | 56 | MainSource 57 | 58 | 59 | 60 | 61 | 62 | 63 | Cfg_2 64 | Base 65 | 66 | 67 | Base 68 | 69 | 70 | Cfg_1 71 | Base 72 | 73 | 74 | 75 | 76 | 77 | Delphi.Personality.12 78 | 79 | 80 | 81 | 82 | False 83 | False 84 | 1 85 | 0 86 | 0 87 | 0 88 | False 89 | False 90 | False 91 | False 92 | False 93 | 1043 94 | 1252 95 | 96 | 97 | 98 | 99 | 1.0.0.0 100 | 101 | 102 | 103 | 104 | 105 | 1.0.0.0 106 | 107 | 108 | 109 | DemoGoogleMaps.dpr 110 | 111 | 112 | 113 | True 114 | 115 | 116 | 12 117 | 118 | 119 | -------------------------------------------------------------------------------- /demos/DemoGoogleMaps/DemoGoogleMaps.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/WouterVanNifterick/delphi-maps/b16f46d3c99642d32c660d6632d4c1d2da572a9c/demos/DemoGoogleMaps/DemoGoogleMaps.res -------------------------------------------------------------------------------- /demos/DemoGoogleMaps/uFrmMain.dfm: -------------------------------------------------------------------------------- 1 | object frmMain: TfrmMain 2 | Left = 0 3 | Top = 0 4 | BorderWidth = 4 5 | Caption = 'DelphiMaps GoogleMaps Demo' 6 | ClientHeight = 321 7 | ClientWidth = 609 8 | Color = clBtnFace 9 | DoubleBuffered = True 10 | Font.Charset = DEFAULT_CHARSET 11 | Font.Color = clWindowText 12 | Font.Height = -11 13 | Font.Name = 'Tahoma' 14 | Font.Style = [] 15 | OldCreateOrder = False 16 | OnCreate = FormCreate 17 | PixelsPerInch = 96 18 | TextHeight = 13 19 | object Splitter1: TSplitter 20 | Left = 393 21 | Top = 29 22 | Width = 7 23 | Height = 292 24 | Align = alRight 25 | ExplicitLeft = 432 26 | ExplicitTop = 0 27 | ExplicitHeight = 321 28 | end 29 | object GoogleMapsLayersList1: TGoogleMapsLayersList 30 | Left = 400 31 | Top = 29 32 | Width = 209 33 | Height = 292 34 | Align = alRight 35 | Indent = 19 36 | TabOrder = 0 37 | GoogleMaps = GoogleMaps1 38 | end 39 | object GoogleMaps1: TGoogleMaps 40 | Left = 121 41 | Top = 29 42 | Width = 272 43 | Height = 292 44 | JsVarName = 'map' 45 | Align = alClient 46 | MapType = MT_ROADMAP 47 | end 48 | object FlowPanel1: TFlowPanel 49 | Left = 0 50 | Top = 0 51 | Width = 609 52 | Height = 29 53 | Align = alTop 54 | AutoSize = True 55 | TabOrder = 2 56 | object Edit1: TEdit 57 | AlignWithMargins = True 58 | Left = 4 59 | Top = 4 60 | Width = 277 61 | Height = 21 62 | Align = alLeft 63 | TabOrder = 0 64 | OnKeyDown = Edit1KeyDown 65 | end 66 | object ComboBox1: TComboBox 67 | AlignWithMargins = True 68 | Left = 287 69 | Top = 4 70 | Width = 145 71 | Height = 21 72 | Align = alLeft 73 | Style = csDropDownList 74 | TabOrder = 1 75 | OnChange = ComboBox1Change 76 | end 77 | object LinkLabel1: TLinkLabel 78 | AlignWithMargins = True 79 | Left = 438 80 | Top = 4 81 | Width = 83 82 | Height = 17 83 | Caption = 'Open in browser' 84 | TabOrder = 2 85 | UseVisualStyle = True 86 | end 87 | end 88 | object pnlLeft: TPanel 89 | Left = 0 90 | Top = 29 91 | Width = 121 92 | Height = 292 93 | Align = alLeft 94 | TabOrder = 3 95 | object btnTestPolygon1: TButton 96 | AlignWithMargins = True 97 | Left = 4 98 | Top = 4 99 | Width = 113 100 | Height = 25 101 | Align = alTop 102 | Caption = 'Polygon' 103 | TabOrder = 0 104 | OnClick = btnTestPolygon1Click 105 | ExplicitLeft = 2 106 | ExplicitTop = -13 107 | end 108 | object btnTestMarkers: TButton 109 | AlignWithMargins = True 110 | Left = 4 111 | Top = 97 112 | Width = 113 113 | Height = 25 114 | Align = alTop 115 | Caption = 'Markers 2' 116 | TabOrder = 1 117 | OnClick = btnTestMarkersClick 118 | ExplicitLeft = 2 119 | end 120 | object btnMarker: TButton 121 | AlignWithMargins = True 122 | Left = 4 123 | Top = 66 124 | Width = 113 125 | Height = 25 126 | Align = alTop 127 | Caption = 'Markers 1' 128 | TabOrder = 2 129 | OnClick = btnMarkerClick 130 | ExplicitTop = 35 131 | end 132 | object btnTestPolyGon2: TButton 133 | AlignWithMargins = True 134 | Left = 4 135 | Top = 35 136 | Width = 113 137 | Height = 25 138 | Align = alTop 139 | Caption = 'Polygon' 140 | TabOrder = 3 141 | OnClick = btnTestPolyGon2Click 142 | ExplicitLeft = 2 143 | end 144 | object Button1: TButton 145 | AlignWithMargins = True 146 | Left = 4 147 | Top = 128 148 | Width = 113 149 | Height = 25 150 | Align = alTop 151 | Caption = 'Eval' 152 | TabOrder = 4 153 | OnClick = Button1Click 154 | ExplicitLeft = 48 155 | ExplicitTop = 152 156 | ExplicitWidth = 75 157 | end 158 | object btnGetBounds: TButton 159 | AlignWithMargins = True 160 | Left = 4 161 | Top = 159 162 | Width = 113 163 | Height = 25 164 | Align = alTop 165 | Caption = 'Get Bounds' 166 | TabOrder = 5 167 | OnClick = btnGetBoundsClick 168 | ExplicitLeft = 2 169 | ExplicitTop = 200 170 | end 171 | end 172 | end 173 | -------------------------------------------------------------------------------- /demos/DemoGoogleMaps/uFrmMain.pas: -------------------------------------------------------------------------------- 1 | {**************************************************************************************************} 2 | { The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } 3 | { you may not use this file except in compliance with the License. You may obtain a copy of the } 4 | { License at http://www.mozilla.org/MPL/ } 5 | { } 6 | { Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } 7 | { ANY KIND, either express or implied. See the License for the specific language governing rights } 8 | { and limitations under the License. } 9 | { } 10 | { The Initial Developer of the Original Code is Wouter van Nifterick } 11 | { (wouter_van_nifterick@hotmail.com. } 12 | {**************************************************************************************************} 13 | unit uFrmMain; 14 | 15 | interface 16 | 17 | uses 18 | Windows, Messages, SysUtils, Controls, Forms, StdCtrls, ExtCtrls, ComCtrls, Classes, 19 | 20 | DelphiMaps.LayerList, 21 | DelphiMaps.GoogleMaps, 22 | DelphiMaps.Browser ; 23 | 24 | type 25 | TfrmMain = class(TForm) 26 | GoogleMapsLayersList1: TGoogleMapsLayersList; 27 | Splitter1: TSplitter; 28 | GoogleMaps1: TGoogleMaps; 29 | FlowPanel1: TFlowPanel; 30 | Edit1: TEdit; 31 | ComboBox1: TComboBox; 32 | LinkLabel1: TLinkLabel; 33 | pnlLeft: TPanel; 34 | btnTestPolygon1: TButton; 35 | btnTestMarkers: TButton; 36 | btnMarker: TButton; 37 | btnTestPolyGon2: TButton; 38 | Button1: TButton; 39 | btnGetBounds: TButton; 40 | procedure FormCreate(Sender: TObject); 41 | procedure ComboBox1Change(Sender: TObject); 42 | procedure Edit1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); 43 | procedure btnTestPolygon1Click(Sender: TObject); 44 | procedure btnTestMarkersClick(Sender: TObject); 45 | procedure btnMarkerClick(Sender: TObject); 46 | procedure btnTestPolyGon2Click(Sender: TObject); 47 | procedure Button1Click(Sender: TObject); 48 | procedure btnGetBoundsClick(Sender: TObject); 49 | private 50 | { Private declarations } 51 | public 52 | { Public declarations } 53 | end; 54 | 55 | var 56 | frmMain: TfrmMain; 57 | 58 | implementation 59 | 60 | uses 61 | Graphics, Dialogs; 62 | 63 | {$R *.dfm} 64 | 65 | procedure TfrmMain.btnTestPolygon1Click(Sender: TObject); 66 | var 67 | LPolygon:TGPolyLine; 68 | begin 69 | LPolygon := TGPolyLine.Create; 70 | LPolygon.StrokeColor := clRed; 71 | LPolygon.StrokeWeight := 4; 72 | LPolygon.StrokeOpacity := 0.7; 73 | LPolygon.AddPoint( TGLatLng.Create(52.3,5.3) ); 74 | LPolygon.AddPoint( TGLatLng.Create(52.2,5.2) ); 75 | LPolygon.AddPoint( TGLatLng.Create(52.1,5.3) ); 76 | LPolygon.AddPoint( TGLatLng.Create(52.0,5.4) ); 77 | LPolygon.AddPoint( TGLatLng.Create(52.1,5.5) ); 78 | LPolygon.AddPoint( TGLatLng.Create(52.2,5.6) ); 79 | LPolygon.AddPoint( TGLatLng.Create(52.3,5.5) ); 80 | LPolygon.Map := GoogleMaps1; 81 | 82 | // don't free Poly here. It will be destroyed by GoogleMaps1 83 | end; 84 | 85 | procedure TfrmMain.btnTestPolyGon2Click(Sender: TObject); 86 | var 87 | SouthWest,NorthEast : TGLatLng; 88 | Bounds : TGLatLngBounds; 89 | latSpan,lngSpan:Double; 90 | Location:TGLatLng; 91 | PolyLine:TGPolyLine; 92 | i:Integer; 93 | Marker: TGMarker; 94 | begin 95 | SouthWest := TGLatLng.Create(-31.203405,125.244141); 96 | NorthEast := TGLatLng.Create(-25.363882,131.044922); 97 | Bounds := TGLatLngBounds.Create(SouthWest,NorthEast); 98 | try 99 | lngSpan := NorthEast.lng - SouthWest.lng; 100 | latSpan := NorthEast.lat - SouthWest.lat; 101 | GoogleMaps1.FitBounds(Bounds); 102 | Randomize; 103 | 104 | PolyLine := TGPolyLine.Create; 105 | for i := 0 to 4 do 106 | begin 107 | Location := TGLatLng.Create(SouthWest.lat + latSpan * Random, 108 | southWest.lng + lngSpan * random); 109 | PolyLine.AddPoint(Location); 110 | 111 | Marker := TGMarker.Create( 112 | Location, 113 | GoogleMaps1, 114 | 'This is point '+IntToStr(I), 115 | 'http://google-maps-icons.googlecode.com/files/nav-media.gif' 116 | ); 117 | end; 118 | PolyLine.Map := GoogleMaps1; 119 | finally 120 | Bounds.Free; 121 | end; 122 | 123 | end; 124 | 125 | 126 | procedure TfrmMain.Button1Click(Sender: TObject); 127 | begin 128 | ShowMessage(GoogleMaps1.Browser.Eval('map.getCenter().lat()')); 129 | end; 130 | 131 | procedure TfrmMain.btnGetBoundsClick(Sender: TObject); 132 | begin 133 | ShowMessage(GoogleMaps1.Bounds.ToString); 134 | end; 135 | 136 | procedure TfrmMain.btnMarkerClick(Sender: TObject); 137 | var 138 | Bounds : TGLatLngBounds; 139 | SouthWest: TGLatLng; 140 | NorthEast: TGLatLng; 141 | Marker : TGMarker; 142 | begin 143 | SouthWest := TGLatLng.Create(-31.203405,125.244141); 144 | NorthEast := TGLatLng.Create(-25.363882,131.044922); 145 | Bounds := TGLatLngBounds.Create(SouthWest,NorthEast); 146 | try 147 | // You can create an icon like this: 148 | 149 | TGMarker.Create( 150 | Bounds.getCenter, 151 | GoogleMaps1, 152 | 'Hello, World!', 153 | 'http://google-maps-icons.googlecode.com/files/snow.png' 154 | ); 155 | 156 | // or keep a reference, and set its properties later on 157 | Marker := TGMarker.Create( 158 | TGLatLng.Create(-31.213405,127) 159 | ); 160 | Marker.Map := GoogleMaps1; 161 | Marker.Title := 'Test'; 162 | Marker.Icon := 'http://google-maps-icons.googlecode.com/files/sun.png'; 163 | 164 | GoogleMaps1.FitBounds( Bounds ); 165 | 166 | finally 167 | Bounds.Free; 168 | end; 169 | end; 170 | 171 | procedure TfrmMain.btnTestMarkersClick(Sender: TObject); 172 | var 173 | SouthWest,NorthEast : TGLatLng; 174 | Bounds : TGLatLngBounds; 175 | latSpan,lngSpan:Double; 176 | Location:TGLatLng; 177 | i:Integer; 178 | begin 179 | SouthWest := TGLatLng.Create(-31.203405,125.244141); 180 | NorthEast := TGLatLng.Create(-25.363882,131.044922); 181 | Bounds := TGLatLngBounds.Create(SouthWest,NorthEast); 182 | lngSpan := NorthEast.lng - SouthWest.lng; 183 | latSpan := NorthEast.lat - SouthWest.lat; 184 | GoogleMaps1.FitBounds(Bounds); 185 | Randomize; 186 | for i := 0 to 4 do 187 | begin 188 | Location := TGLatLng.Create(SouthWest.lat + latSpan * Random, 189 | southWest.lng + lngSpan * random); 190 | TGMarker.Create(Location, GoogleMaps1); 191 | end; 192 | Bounds.Free; 193 | 194 | end; 195 | 196 | procedure TfrmMain.ComboBox1Change(Sender: TObject); 197 | begin 198 | if ComboBox1.ItemIndex<0 then 199 | Exit; 200 | 201 | GoogleMaps1.MapType := TGoogleMapType(ComboBox1.ItemIndex); 202 | end; 203 | 204 | procedure TfrmMain.Edit1KeyDown(Sender: TObject; var Key: Word; 205 | Shift: TShiftState); 206 | begin 207 | case Key of 208 | VK_RETURN: 209 | begin 210 | // GoogleMaps1.SetCenter( ); 211 | end; 212 | end; 213 | end; 214 | 215 | procedure TfrmMain.FormCreate(Sender: TObject); 216 | var S:String; 217 | begin 218 | for S in cGoogleMapTypeStr do 219 | ComboBox1.Items.Add(S); 220 | 221 | ComboBox1.ItemIndex := 0; 222 | end; 223 | 224 | end. 225 | -------------------------------------------------------------------------------- /demos/DemoStaticMap/DemoStaticMap.dpr: -------------------------------------------------------------------------------- 1 | program DemoStaticMap; 2 | 3 | uses 4 | Forms, 5 | uFrmMain in 'uFrmMain.pas' {frmMain}; 6 | 7 | {$R *.res} 8 | 9 | begin 10 | Application.Initialize; 11 | Application.MainFormOnTaskbar := True; 12 | Application.CreateForm(TfrmMain, frmMain); 13 | Application.Run; 14 | end. 15 | -------------------------------------------------------------------------------- /demos/DemoStaticMap/DemoStaticMap.dproj: -------------------------------------------------------------------------------- 1 | 2 | 3 | {E2306B3E-9DB0-4B73-8CF7-35D058CBA520} 4 | DemoStaticMap.dpr 5 | True 6 | Debug 7 | Win32 8 | Application 9 | VCL 10 | DCC32 11 | 12.2 12 | 13 | 14 | true 15 | 16 | 17 | true 18 | Base 19 | true 20 | 21 | 22 | true 23 | Base 24 | true 25 | 26 | 27 | false 28 | 00400000 29 | WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;WinTypes=Windows;WinProcs=Windows;$(DCC_UnitAlias) 30 | false 31 | false 32 | false 33 | false 34 | 35 | 36 | false 37 | RELEASE;$(DCC_Define) 38 | 0 39 | false 40 | 41 | 42 | .\$(Config)\$(Platform) 43 | DEBUG;$(DCC_Define) 44 | false 45 | true 46 | 47 | 48 | 49 | MainSource 50 | 51 | 52 | 53 | 54 | 55 | Cfg_2 56 | Base 57 | 58 | 59 | Base 60 | 61 | 62 | Cfg_1 63 | Base 64 | 65 | 66 | 67 | 68 | 69 | Delphi.Personality.12 70 | VCLApplication 71 | 72 | 73 | 74 | DemoStaticMap.dpr 75 | 76 | 77 | False 78 | False 79 | 1 80 | 0 81 | 0 82 | 0 83 | False 84 | False 85 | False 86 | False 87 | False 88 | 1043 89 | 1252 90 | 91 | 92 | 93 | 94 | 1.0.0.0 95 | 96 | 97 | 98 | 99 | 100 | 1.0.0.0 101 | 102 | 103 | 104 | 105 | True 106 | 107 | 108 | 12 109 | 110 | 111 | -------------------------------------------------------------------------------- /demos/DemoStaticMap/DemoStaticMap.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/WouterVanNifterick/delphi-maps/b16f46d3c99642d32c660d6632d4c1d2da572a9c/demos/DemoStaticMap/DemoStaticMap.res -------------------------------------------------------------------------------- /demos/DemoStaticMap/uFrmMain.dfm: -------------------------------------------------------------------------------- 1 | object frmMain: TfrmMain 2 | Left = 0 3 | Top = 0 4 | Caption = 'DelphiMaps Static Demo' 5 | ClientHeight = 474 6 | ClientWidth = 703 7 | Color = clBtnFace 8 | DoubleBuffered = True 9 | Font.Charset = DEFAULT_CHARSET 10 | Font.Color = clWindowText 11 | Font.Height = -11 12 | Font.Name = 'Tahoma' 13 | Font.Style = [] 14 | OldCreateOrder = False 15 | ShowHint = True 16 | OnCreate = FormCreate 17 | PixelsPerInch = 96 18 | TextHeight = 13 19 | object Panel1: TPanel 20 | Left = 0 21 | Top = 52 22 | Width = 703 23 | Height = 422 24 | Align = alClient 25 | BevelOuter = bvNone 26 | TabOrder = 0 27 | object StaticMap1: TStaticMap 28 | Left = 39 29 | Top = 0 30 | Width = 664 31 | Height = 422 32 | Align = alClient 33 | URL = 34 | 'http://maps.google.com/maps/api/staticmap?sensor=false¢er=0,' + 35 | '0&maptype=roadMap&size=664x422&zoom=0' 36 | Zoom = 0 37 | MapType = ST_ROADMAP 38 | Format = mfPng 39 | Sensor = False 40 | MapProvider = mpGoogleMaps 41 | ExplicitLeft = 192 42 | ExplicitTop = 56 43 | ExplicitWidth = 441 44 | ExplicitHeight = 313 45 | end 46 | object TrackBar1: TTrackBar 47 | Left = 0 48 | Top = 0 49 | Width = 39 50 | Height = 422 51 | Hint = 'ZoomLevel' 52 | Align = alLeft 53 | Max = 18 54 | Orientation = trVertical 55 | Position = 14 56 | PositionToolTip = ptRight 57 | TabOrder = 0 58 | TickMarks = tmBoth 59 | OnChange = TrackBar1Change 60 | end 61 | end 62 | object FlowPanel1: TFlowPanel 63 | Left = 0 64 | Top = 0 65 | Width = 703 66 | Height = 52 67 | Align = alTop 68 | AutoSize = True 69 | TabOrder = 1 70 | object Label1: TLabel 71 | AlignWithMargins = True 72 | Left = 4 73 | Top = 4 74 | Width = 40 75 | Height = 13 76 | Caption = 'Center: ' 77 | end 78 | object edCenter: TEdit 79 | AlignWithMargins = True 80 | Left = 50 81 | Top = 4 82 | Width = 121 83 | Height = 21 84 | Hint = 'Type address or coordinates, and press [ENTER]' 85 | TabOrder = 0 86 | OnKeyDown = edCenterKeyDown 87 | end 88 | object btnSetCenter: TButton 89 | Left = 174 90 | Top = 1 91 | Width = 27 92 | Height = 25 93 | Caption = 'Go' 94 | TabOrder = 1 95 | OnClick = btnSetCenterClick 96 | end 97 | object Label2: TLabel 98 | AlignWithMargins = True 99 | Left = 204 100 | Top = 4 101 | Width = 54 102 | Height = 13 103 | Caption = 'Map Type: ' 104 | end 105 | object cmbMapType: TComboBox 106 | AlignWithMargins = True 107 | Left = 264 108 | Top = 4 109 | Width = 145 110 | Height = 21 111 | Align = alLeft 112 | Style = csDropDownList 113 | TabOrder = 2 114 | OnChange = cmbMapTypeChange 115 | end 116 | object Label3: TLabel 117 | AlignWithMargins = True 118 | Left = 415 119 | Top = 4 120 | Width = 47 121 | Height = 13 122 | Caption = 'Provider: ' 123 | end 124 | object cmbProvider: TComboBox 125 | AlignWithMargins = True 126 | Left = 468 127 | Top = 4 128 | Width = 145 129 | Height = 21 130 | Align = alLeft 131 | Style = csDropDownList 132 | TabOrder = 3 133 | OnChange = cmbProviderChange 134 | end 135 | object LinkLabel1: TLinkLabel 136 | AlignWithMargins = True 137 | Left = 4 138 | Top = 31 139 | Width = 83 140 | Height = 17 141 | Caption = 'Open in browser' 142 | TabOrder = 4 143 | UseVisualStyle = True 144 | OnLinkClick = LinkLabel1LinkClick 145 | end 146 | end 147 | end 148 | -------------------------------------------------------------------------------- /demos/DemoStaticMap/uFrmMain.pas: -------------------------------------------------------------------------------- 1 | {**************************************************************************************************} 2 | { The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } 3 | { you may not use this file except in compliance with the License. You may obtain a copy of the } 4 | { License at http://www.mozilla.org/MPL/ } 5 | { } 6 | { Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } 7 | { ANY KIND, either express or implied. See the License for the specific language governing rights } 8 | { and limitations under the License. } 9 | { } 10 | { The Initial Developer of the Original Code is Wouter van Nifterick } 11 | { (wouter_van_nifterick@hotmail.com. } 12 | {**************************************************************************************************} 13 | unit uFrmMain; 14 | 15 | interface 16 | 17 | uses 18 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 19 | Dialogs, DelphiMaps.GoogleMaps, ExtCtrls, ComCtrls, ToolWin, 20 | Generics.Collections, DelphiMaps.StaticMap, pngimage, StdCtrls, 21 | DelphiMaps.WebImage, DelphiMaps.Location; 22 | 23 | type 24 | TfrmMain = class(TForm) 25 | Panel1: TPanel; 26 | FlowPanel1: TFlowPanel; 27 | Label1: TLabel; 28 | edCenter: TEdit; 29 | btnSetCenter: TButton; 30 | Label2: TLabel; 31 | cmbMapType: TComboBox; 32 | Label3: TLabel; 33 | cmbProvider: TComboBox; 34 | LinkLabel1: TLinkLabel; 35 | TrackBar1: TTrackBar; 36 | StaticMap1: TStaticMap; 37 | procedure TrackBar1Change(Sender: TObject); 38 | procedure FormCreate(Sender: TObject); 39 | procedure cmbMapTypeChange(Sender: TObject); 40 | procedure edCenterKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); 41 | procedure LinkLabel1LinkClick(Sender: TObject; const Link: string; LinkType: TSysLinkType); 42 | procedure cmbProviderChange(Sender: TObject); 43 | procedure btnSetCenterClick(Sender: TObject); 44 | private 45 | procedure GetMapTypes; 46 | procedure GetMapProviders; 47 | public 48 | end; 49 | 50 | var 51 | frmMain: TfrmMain; 52 | 53 | implementation 54 | 55 | uses ShellAPI; 56 | 57 | {$R *.dfm} 58 | 59 | procedure TfrmMain.GetMapTypes; 60 | var S: string; 61 | begin // Fill MapTypes combobox 62 | for S in cStaticMapTypeStr do 63 | cmbMapType.Items.Add(S); 64 | cmbMapType.ItemIndex := 1; 65 | end; 66 | 67 | procedure TfrmMain.GetMapProviders; 68 | var MP: TMapProviderRec; 69 | begin // Fill MapProviders combobox 70 | for MP in cMapProviders do 71 | cmbProvider.Items.Add(MP.Name); 72 | cmbProvider.ItemIndex := 0; 73 | end; 74 | 75 | procedure TfrmMain.btnSetCenterClick(Sender: TObject); 76 | begin 77 | StaticMap1.Center.Text := edCenter.Text; 78 | end; 79 | 80 | procedure TfrmMain.cmbMapTypeChange(Sender: TObject); 81 | begin 82 | StaticMap1.MapType := TStaticMapType(cmbMapType.ItemIndex) 83 | end; 84 | 85 | procedure TfrmMain.cmbProviderChange(Sender: TObject); 86 | begin 87 | StaticMap1.MapProvider := TStaticMapProvider(cmbProvider.ItemIndex) 88 | end; 89 | 90 | procedure TfrmMain.edCenterKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); 91 | begin 92 | case Key of 93 | VK_RETURN: 94 | StaticMap1.Center.Text := edCenter.Text; 95 | end; 96 | end; 97 | 98 | procedure TfrmMain.FormCreate(Sender: TObject); 99 | begin 100 | GetMapTypes; 101 | GetMapProviders; 102 | edCenter.Text := 'Ypenburg, Den Haag'; 103 | StaticMap1.Center.Text := edCenter.Text; 104 | StaticMap1.Zoom := TrackBar1.Position; 105 | 106 | end; 107 | 108 | procedure TfrmMain.LinkLabel1LinkClick(Sender: TObject; const Link: string; LinkType: TSysLinkType); 109 | begin 110 | case LinkType of 111 | sltURL: StaticMap1.OpenURL; 112 | end; 113 | end; 114 | 115 | procedure TfrmMain.TrackBar1Change(Sender: TObject); 116 | begin 117 | StaticMap1.Zoom := TrackBar1.Position; 118 | end; 119 | 120 | end. 121 | -------------------------------------------------------------------------------- /demos/DemoStreetView/DemoStreetView.dpr: -------------------------------------------------------------------------------- 1 | program DemoStreetView; 2 | 3 | uses 4 | Forms, 5 | uFrmMain in 'uFrmMain.pas' {frmMain}; 6 | 7 | {$R *.res} 8 | 9 | begin 10 | Application.Initialize; 11 | Application.MainFormOnTaskbar := True; 12 | Application.CreateForm(TfrmMain, frmMain); 13 | Application.Run; 14 | end. 15 | -------------------------------------------------------------------------------- /demos/DemoStreetView/DemoStreetView.dproj: -------------------------------------------------------------------------------- 1 | 2 | 3 | {93AE314B-63D1-4789-AA40-C205F2FC68D2} 4 | DemoStreetView.dpr 5 | 12.2 6 | True 7 | Debug 8 | Win32 9 | Application 10 | VCL 11 | DCC32 12 | 13 | 14 | true 15 | 16 | 17 | true 18 | Base 19 | true 20 | 21 | 22 | true 23 | Base 24 | true 25 | 26 | 27 | 00400000 28 | .\$(Config)\$(Platform) 29 | WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;$(DCC_UnitAlias) 30 | .\$(Config)\$(Platform) 31 | false 32 | false 33 | false 34 | false 35 | false 36 | 37 | 38 | DEBUG;$(DCC_Define) 39 | false 40 | true 41 | 42 | 43 | false 44 | RELEASE;$(DCC_Define) 45 | 0 46 | false 47 | 48 | 49 | 50 | MainSource 51 | 52 | 53 | 54 | 55 | 56 | Cfg_2 57 | Base 58 | 59 | 60 | Base 61 | 62 | 63 | Cfg_1 64 | Base 65 | 66 | 67 | 68 | 69 | 70 | Delphi.Personality.12 71 | 72 | 73 | 74 | 75 | False 76 | False 77 | 1 78 | 0 79 | 0 80 | 0 81 | False 82 | False 83 | False 84 | False 85 | False 86 | 1043 87 | 1252 88 | 89 | 90 | 91 | 92 | 1.0.0.0 93 | 94 | 95 | 96 | 97 | 98 | 1.0.0.0 99 | 100 | 101 | 102 | DemoStreetView.dpr 103 | 104 | 105 | 106 | True 107 | 108 | 109 | 12 110 | 111 | 112 | -------------------------------------------------------------------------------- /demos/DemoStreetView/DemoStreetView.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/WouterVanNifterick/delphi-maps/b16f46d3c99642d32c660d6632d4c1d2da572a9c/demos/DemoStreetView/DemoStreetView.res -------------------------------------------------------------------------------- /demos/DemoStreetView/uFrmMain.dfm: -------------------------------------------------------------------------------- 1 | object frmMain: TfrmMain 2 | Left = 0 3 | Top = 0 4 | Caption = 'DelphiMaps StreetView demo' 5 | ClientHeight = 421 6 | ClientWidth = 736 7 | Color = clBtnFace 8 | DoubleBuffered = True 9 | Font.Charset = DEFAULT_CHARSET 10 | Font.Color = clWindowText 11 | Font.Height = -11 12 | Font.Name = 'Tahoma' 13 | Font.Style = [] 14 | OldCreateOrder = False 15 | PixelsPerInch = 96 16 | TextHeight = 13 17 | object Splitter1: TSplitter 18 | Left = 121 19 | Top = 29 20 | Height = 392 21 | ExplicitLeft = 160 22 | ExplicitTop = 104 23 | ExplicitHeight = 100 24 | end 25 | object StreetView1: TStreetView 26 | Left = 124 27 | Top = 29 28 | Width = 612 29 | Height = 392 30 | JsVarName = 'StreetView1' 31 | Align = alClient 32 | end 33 | object FlowPanel1: TFlowPanel 34 | Left = 0 35 | Top = 0 36 | Width = 736 37 | Height = 29 38 | Align = alTop 39 | AutoSize = True 40 | TabOrder = 1 41 | object Label1: TLabel 42 | AlignWithMargins = True 43 | Left = 4 44 | Top = 4 45 | Width = 40 46 | Height = 13 47 | Caption = 'Center: ' 48 | end 49 | object edCenter: TEdit 50 | AlignWithMargins = True 51 | Left = 50 52 | Top = 4 53 | Width = 121 54 | Height = 21 55 | Hint = 'Type address or coordinates, and press [ENTER]' 56 | TabOrder = 0 57 | end 58 | object btnSetCenter: TButton 59 | Left = 174 60 | Top = 1 61 | Width = 27 62 | Height = 25 63 | Caption = 'Go' 64 | TabOrder = 1 65 | OnClick = btnSetCenterClick 66 | end 67 | object LinkLabel1: TLinkLabel 68 | AlignWithMargins = True 69 | Left = 204 70 | Top = 4 71 | Width = 83 72 | Height = 17 73 | Caption = 'Open in browser' 74 | TabOrder = 2 75 | UseVisualStyle = True 76 | end 77 | end 78 | object pnlLeft: TPanel 79 | Left = 0 80 | Top = 29 81 | Width = 121 82 | Height = 392 83 | Align = alLeft 84 | TabOrder = 2 85 | object lblHeading: TLabel 86 | AlignWithMargins = True 87 | Left = 4 88 | Top = 4 89 | Width = 113 90 | Height = 13 91 | Align = alTop 92 | Caption = 'Heading' 93 | ExplicitWidth = 39 94 | end 95 | object lblPitch: TLabel 96 | AlignWithMargins = True 97 | Left = 4 98 | Top = 46 99 | Width = 113 100 | Height = 13 101 | Align = alTop 102 | Caption = 'Pitch' 103 | ExplicitWidth = 23 104 | end 105 | object lblZoom: TLabel 106 | AlignWithMargins = True 107 | Left = 4 108 | Top = 88 109 | Width = 113 110 | Height = 13 111 | Align = alTop 112 | Caption = 'Zoom' 113 | ExplicitWidth = 26 114 | end 115 | object sbHeading: TScrollBar 116 | AlignWithMargins = True 117 | Left = 4 118 | Top = 23 119 | Width = 113 120 | Height = 17 121 | Align = alTop 122 | Max = 3600 123 | PageSize = 0 124 | Position = 180 125 | TabOrder = 0 126 | OnChange = OnPovChange 127 | end 128 | object sbPitch: TScrollBar 129 | AlignWithMargins = True 130 | Left = 4 131 | Top = 65 132 | Width = 113 133 | Height = 17 134 | Align = alTop 135 | Max = 500 136 | Min = -500 137 | PageSize = 0 138 | TabOrder = 1 139 | OnChange = OnPovChange 140 | end 141 | object sbZoom: TScrollBar 142 | AlignWithMargins = True 143 | Left = 4 144 | Top = 107 145 | Width = 113 146 | Height = 17 147 | Align = alTop 148 | Max = 30 149 | PageSize = 0 150 | Position = 15 151 | TabOrder = 2 152 | OnChange = OnPovChange 153 | end 154 | end 155 | end 156 | -------------------------------------------------------------------------------- /demos/DemoStreetView/uFrmMain.pas: -------------------------------------------------------------------------------- 1 | unit uFrmMain; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 7 | Dialogs, DelphiMaps.Browser, DelphiMaps.StreetView, ExtCtrls, StdCtrls; 8 | 9 | type 10 | TfrmMain = class(TForm) 11 | StreetView1: TStreetView; 12 | FlowPanel1: TFlowPanel; 13 | Label1: TLabel; 14 | edCenter: TEdit; 15 | btnSetCenter: TButton; 16 | LinkLabel1: TLinkLabel; 17 | pnlLeft: TPanel; 18 | lblHeading: TLabel; 19 | sbHeading: TScrollBar; 20 | lblPitch: TLabel; 21 | sbPitch: TScrollBar; 22 | lblZoom: TLabel; 23 | sbZoom: TScrollBar; 24 | Splitter1: TSplitter; 25 | procedure OnPovChange(Sender: TObject); 26 | procedure btnSetCenterClick(Sender: TObject); 27 | private 28 | { Private declarations } 29 | public 30 | { Public declarations } 31 | end; 32 | 33 | var 34 | frmMain: TfrmMain; 35 | 36 | implementation 37 | 38 | {$R *.dfm} 39 | 40 | procedure TfrmMain.btnSetCenterClick(Sender: TObject); 41 | begin 42 | StreetView1.Center.Text := edCenter.Text; 43 | end; 44 | 45 | procedure TfrmMain.OnPovChange(Sender: TObject); 46 | begin 47 | StreetView1.POV.SetAll( 48 | sbHeading.Position / 10, 49 | sbPitch.Position / 10, 50 | sbZoom.Position / 10 51 | ); 52 | end; 53 | 54 | end. 55 | -------------------------------------------------------------------------------- /demos/DemoWMS/DemoWMS.dpr: -------------------------------------------------------------------------------- 1 | program DemoWMS; 2 | 3 | uses 4 | Forms, 5 | uFrmMain in 'uFrmMain.pas' {frmMain}; 6 | 7 | {$R *.res} 8 | 9 | begin 10 | Application.Initialize; 11 | Application.MainFormOnTaskbar := True; 12 | Application.CreateForm(TfrmMain, frmMain); 13 | Application.Run; 14 | end. 15 | -------------------------------------------------------------------------------- /demos/DemoWMS/DemoWMS.dproj: -------------------------------------------------------------------------------- 1 | 2 | 3 | {765FBE89-52C3-48A8-8928-BDB70248F176} 4 | 12.2 5 | DemoWMS.dpr 6 | True 7 | Debug 8 | Win32 9 | Application 10 | VCL 11 | DCC32 12 | 13 | 14 | true 15 | 16 | 17 | true 18 | Base 19 | true 20 | 21 | 22 | true 23 | Base 24 | true 25 | 26 | 27 | 00400000 28 | .\$(Config)\$(Platform) 29 | WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;$(DCC_UnitAlias) 30 | .\$(Config)\$(Platform) 31 | 32 | 33 | DEBUG;$(DCC_Define) 34 | false 35 | true 36 | 37 | 38 | false 39 | RELEASE;$(DCC_Define) 40 | 0 41 | false 42 | 43 | 44 | 45 | MainSource 46 | 47 | 48 | 49 | 50 | 51 | Cfg_2 52 | Base 53 | 54 | 55 | Base 56 | 57 | 58 | Cfg_1 59 | Base 60 | 61 | 62 | 63 | 64 | 65 | Delphi.Personality.12 66 | 67 | 68 | 69 | 70 | DemoWMS.dpr 71 | 72 | 73 | False 74 | False 75 | 1 76 | 0 77 | 0 78 | 0 79 | False 80 | False 81 | False 82 | False 83 | False 84 | 1043 85 | 1252 86 | 87 | 88 | 89 | 90 | 1.0.0.0 91 | 92 | 93 | 94 | 95 | 96 | 1.0.0.0 97 | 98 | 99 | 100 | Embarcadero C++Builder Office 2000 Servers Package 101 | Embarcadero C++Builder Office XP Servers Package 102 | Microsoft Office 2000 Sample Automation Server Wrapper Components 103 | Microsoft Office XP Sample Automation Server Wrapper Components 104 | 105 | 106 | 107 | True 108 | 109 | 110 | 12 111 | 112 | 113 | -------------------------------------------------------------------------------- /demos/DemoWMS/DemoWMS.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/WouterVanNifterick/delphi-maps/b16f46d3c99642d32c660d6632d4c1d2da572a9c/demos/DemoWMS/DemoWMS.res -------------------------------------------------------------------------------- /demos/DemoWMS/uFrmMain.dfm: -------------------------------------------------------------------------------- 1 | object frmMain: TfrmMain 2 | Left = 0 3 | Top = 0 4 | Caption = 'DelphiMaps WMS demo' 5 | ClientHeight = 440 6 | ClientWidth = 604 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | OnCreate = FormCreate 15 | OnResize = WmsImage1Click 16 | PixelsPerInch = 96 17 | TextHeight = 13 18 | object wms: TWmsImage 19 | Left = 0 20 | Top = 0 21 | Width = 604 22 | Height = 440 23 | Align = alClient 24 | OnClick = WmsImage1Click 25 | URL = 26 | '?SERVICE=WMS&VERSION=1.1.0&REQUEST=GetMap&LAYERS=&STYLES=&BBOX=0' + 27 | ',0,0,0&WIDTH=256&HEIGHT=256&SRS=&FORMAT=image%2FPng32&TRANSPAREN' + 28 | 'T=TRUE' 29 | Version = '1.1.0' 30 | ImageFormat = mfPng32 31 | Transparent = True 32 | WWidth = 256 33 | WHeight = 256 34 | BackgroundColor = clNone 35 | Exceptions = 'application/vnd.ogc.se_inimage' 36 | ExplicitLeft = 64 37 | ExplicitTop = 48 38 | ExplicitWidth = 457 39 | ExplicitHeight = 321 40 | end 41 | end 42 | -------------------------------------------------------------------------------- /demos/DemoWMS/uFrmMain.pas: -------------------------------------------------------------------------------- 1 | unit uFrmMain; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 7 | Dialogs, ExtCtrls, DelphiMaps.WebImage, DelphiMaps.WMS.Client, StdCtrls, 8 | DelphiMaps.GoogleMaps; 9 | 10 | type 11 | TfrmMain = class(TForm) 12 | wms: TWmsImage; 13 | procedure FormCreate(Sender: TObject); 14 | procedure WmsImage1Click(Sender: TObject); 15 | end; 16 | 17 | var 18 | frmMain: TfrmMain; 19 | 20 | implementation 21 | 22 | {$R *.dfm} 23 | 24 | procedure TfrmMain.FormCreate(Sender: TObject); 25 | begin 26 | wms.ServerURL := 'http://82.94.235.124:8080/geoserver/SMIB/wms'; 27 | wms.SRS := 'EPSG:4326'; 28 | wms.BoundingBox.SouthWest.Lng := 3.597; 29 | wms.BoundingBox.SouthWest.Lat := 50.755; 30 | wms.BoundingBox.NorthEast.Lng := 7.228; 31 | wms.BoundingBox.NorthEast.Lat := 53.208; 32 | wms.Layers.Add('SMIB:nldnld___________00'); 33 | wms.WWidth := Width; 34 | wms.WHeight := Height; 35 | wms.ImageFormat := TGStaticMapsFormat.mfPng; 36 | wms.Exceptions := 'application/vnd.ogc.se_inimage'; 37 | wms.Refresh; 38 | end; 39 | 40 | procedure TfrmMain.WmsImage1Click(Sender: TObject); 41 | begin 42 | wms.WWidth := Width; 43 | wms.WHeight := Height; 44 | wms.Width := Width; 45 | wms.Height := Height; 46 | wms.Refresh; 47 | end; 48 | 49 | end. 50 | -------------------------------------------------------------------------------- /packages/DelphiMapsDesignTime.dpk: -------------------------------------------------------------------------------- 1 | package DelphiMapsDesignTime; 2 | 3 | {$R *.res} 4 | {$ALIGN 8} 5 | {$ASSERTIONS ON} 6 | {$BOOLEVAL OFF} 7 | {$DEBUGINFO ON} 8 | {$EXTENDEDSYNTAX ON} 9 | {$IMPORTEDDATA ON} 10 | {$IOCHECKS ON} 11 | {$LOCALSYMBOLS ON} 12 | {$LONGSTRINGS ON} 13 | {$OPENSTRINGS ON} 14 | {$OPTIMIZATION ON} 15 | {$OVERFLOWCHECKS OFF} 16 | {$RANGECHECKS OFF} 17 | {$REFERENCEINFO ON} 18 | {$SAFEDIVIDE OFF} 19 | {$STACKFRAMES OFF} 20 | {$TYPEDADDRESS OFF} 21 | {$VARSTRINGCHECKS ON} 22 | {$WRITEABLECONST OFF} 23 | {$MINENUMSIZE 1} 24 | {$IMAGEBASE $400000} 25 | {$DESCRIPTION 'DelphiMaps components'} 26 | {$LIBSUFFIX '2011'} 27 | {$DESIGNONLY} 28 | {$IMPLICITBUILD ON} 29 | 30 | requires 31 | rtl, 32 | vcl, 33 | vclie, 34 | vclx, 35 | vclimg, 36 | xmlrtl; 37 | 38 | contains 39 | DelphiMaps.DouglasPeuckers in '..\source\DelphiMaps.DouglasPeuckers.pas', 40 | DelphiMaps.GoogleMaps in '..\source\DelphiMaps.GoogleMaps.pas', 41 | DelphiMaps.LayerList in '..\source\DelphiMaps.LayerList.pas', 42 | DelphiMaps.WMS.Client in '..\source\DelphiMaps.WMS.Client.pas', 43 | DelphiMaps.Browser in '..\source\DelphiMaps.Browser.pas', 44 | DelphiMaps.Register in '..\source\DelphiMaps.Register.pas', 45 | DelphiMaps.StreetView in '..\source\DelphiMaps.StreetView.pas', 46 | DelphiMaps.WebImage in '..\source\DelphiMaps.WebImage.pas', 47 | DelphiMaps.GoogleDirectionsXML in '..\source\DelphiMaps.GoogleDirectionsXML.pas', 48 | DelphiMaps.GoogleDirections in '..\source\DelphiMaps.GoogleDirections.pas', 49 | DelphiMaps.Location in '..\source\DelphiMaps.Location.pas', 50 | DelphiMaps.GeoCoder in '..\source\DelphiMaps.GeoCoder.pas', 51 | DelphiMaps.GeoCoderXML in '..\source\DelphiMaps.GeoCoderXML.pas', 52 | DelphiMapsBrowserExternal_TLB in '..\source\DelphiMapsBrowserExternal_TLB.pas', 53 | DelphiMaps.Browser.NulContainer in '..\source\DelphiMaps.Browser.NulContainer.pas', 54 | DelphiMaps.Browser.External in '..\source\DelphiMaps.Browser.External.pas', 55 | DelphiMaps.Browser.ExternalContainer in '..\source\DelphiMaps.Browser.ExternalContainer.pas', 56 | DelphiMaps.Browser.IntfDocHostUIHandler in '..\source\DelphiMaps.Browser.IntfDocHostUIHandler.pas', 57 | DelphiMaps.Browser.Event in '..\source\DelphiMaps.Browser.Event.pas', 58 | DelphiMaps.StaticMap in '..\source\DelphiMaps.StaticMap.pas'; 59 | 60 | end. 61 | -------------------------------------------------------------------------------- /packages/DelphiMapsDesignTime.dproj: -------------------------------------------------------------------------------- 1 | 2 | 3 | {8139A956-88C0-4D9F-8291-50D32347FF09} 4 | DelphiMapsDesignTime.dpk 5 | True 6 | Debug 7 | Win32 8 | Package 9 | VCL 10 | DCC32 11 | 12.2 12 | 13 | 14 | true 15 | 16 | 17 | true 18 | Base 19 | true 20 | 21 | 22 | true 23 | Base 24 | true 25 | 26 | 27 | 2011 28 | true 29 | true 30 | 00400000 31 | WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;WinTypes=Windows;WinProcs=Windows;$(DCC_UnitAlias) 32 | DelphiMaps components 33 | false 34 | false 35 | true 36 | false 37 | false 38 | false 39 | 40 | 41 | false 42 | RELEASE;$(DCC_Define) 43 | 0 44 | false 45 | 46 | 47 | true 48 | true 49 | ..\source\ 50 | ..\bin 51 | DEBUG;$(DCC_Define) 52 | false 53 | true 54 | 55 | 56 | 57 | MainSource 58 | 59 | 60 | 61 | 62 | 63 | 64 | 65 | 66 | 67 | 68 | 69 | 70 | 71 | 72 | 73 | 74 | 75 | 76 | 77 | 78 | 79 | 80 | 81 | 82 | 83 | 84 | 85 | 86 | 87 | Cfg_2 88 | Base 89 | 90 | 91 | Base 92 | 93 | 94 | Cfg_1 95 | Base 96 | 97 | 98 | 99 | 100 | 101 | Delphi.Personality.12 102 | Package 103 | 104 | 105 | 106 | DelphiMapsDesignTime.dpk 107 | 108 | 109 | True 110 | False 111 | 1 112 | 0 113 | 0 114 | 0 115 | False 116 | False 117 | False 118 | False 119 | False 120 | 1043 121 | 1252 122 | 123 | 124 | 125 | 126 | 1.0.0.0 127 | 128 | 129 | 130 | 131 | 132 | 1.0.0.0 133 | 134 | 135 | 136 | Embarcadero C++Builder Office 2000 Servers Package 137 | Embarcadero C++Builder Office XP Servers Package 138 | Microsoft Office 2000 Sample Automation Server Wrapper Components 139 | Microsoft Office XP Sample Automation Server Wrapper Components 140 | 141 | 142 | 143 | True 144 | 145 | 146 | 12 147 | 148 | 149 | -------------------------------------------------------------------------------- /packages/DelphiMapsDesignTime.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/WouterVanNifterick/delphi-maps/b16f46d3c99642d32c660d6632d4c1d2da572a9c/packages/DelphiMapsDesignTime.res -------------------------------------------------------------------------------- /packages/DelphiMapsRunTime.dpk: -------------------------------------------------------------------------------- 1 | package DelphiMapsRunTime; 2 | 3 | {$R *.res} 4 | {$ALIGN 8} 5 | {$ASSERTIONS ON} 6 | {$BOOLEVAL OFF} 7 | {$DEBUGINFO ON} 8 | {$EXTENDEDSYNTAX ON} 9 | {$IMPORTEDDATA ON} 10 | {$IOCHECKS ON} 11 | {$LOCALSYMBOLS ON} 12 | {$LONGSTRINGS ON} 13 | {$OPENSTRINGS ON} 14 | {$OPTIMIZATION ON} 15 | {$OVERFLOWCHECKS OFF} 16 | {$RANGECHECKS OFF} 17 | {$REFERENCEINFO ON} 18 | {$SAFEDIVIDE OFF} 19 | {$STACKFRAMES OFF} 20 | {$TYPEDADDRESS OFF} 21 | {$VARSTRINGCHECKS ON} 22 | {$WRITEABLECONST OFF} 23 | {$MINENUMSIZE 1} 24 | {$IMAGEBASE $400000} 25 | {$DESCRIPTION 'DelphiMaps components'} 26 | {$LIBSUFFIX '2011'} 27 | {$IMPLICITBUILD ON} 28 | 29 | requires 30 | rtl, 31 | vcl, 32 | vclie, 33 | vclx, 34 | vclimg, 35 | DelphiMapsDesignTime; 36 | 37 | contains 38 | 39 | end. 40 | -------------------------------------------------------------------------------- /packages/DelphiMapsRunTime.dproj: -------------------------------------------------------------------------------- 1 | 2 | 3 | {C6C1EBD9-D948-4639-B635-FB91B4146F6D} 4 | DelphiMapsRunTime.dpk 5 | True 6 | Release 7 | Win32 8 | Package 9 | VCL 10 | DCC32 11 | 12.2 12 | 13 | 14 | true 15 | 16 | 17 | true 18 | Base 19 | true 20 | 21 | 22 | true 23 | Base 24 | true 25 | 26 | 27 | true 28 | 2011 29 | true 30 | WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;WinTypes=Windows;WinProcs=Windows;$(DCC_UnitAlias) 31 | Google Maps components 32 | 00400000 33 | false 34 | false 35 | true 36 | false 37 | false 38 | false 39 | 40 | 41 | false 42 | RELEASE;$(DCC_Define) 43 | 0 44 | false 45 | 46 | 47 | ..\source 48 | ..\bin 49 | DEBUG;$(DCC_Define) 50 | false 51 | true 52 | 53 | 54 | 55 | MainSource 56 | 57 | 58 | 59 | 60 | 61 | 62 | 63 | Cfg_2 64 | Base 65 | 66 | 67 | Base 68 | 69 | 70 | Cfg_1 71 | Base 72 | 73 | 74 | 75 | 76 | 77 | Delphi.Personality.12 78 | Package 79 | 80 | 81 | 82 | DelphiMapsRunTime.dpk 83 | 84 | 85 | True 86 | False 87 | 1 88 | 0 89 | 0 90 | 0 91 | False 92 | False 93 | False 94 | False 95 | False 96 | 1043 97 | 1252 98 | 99 | 100 | 101 | 102 | 1.0.0.0 103 | 104 | 105 | 106 | 107 | 108 | 1.0.0.0 109 | 110 | 111 | 112 | Embarcadero C++Builder Office 2000 Servers Package 113 | Embarcadero C++Builder Office XP Servers Package 114 | Microsoft Office 2000 Sample Automation Server Wrapper Components 115 | Microsoft Office XP Sample Automation Server Wrapper Components 116 | 117 | 118 | 119 | True 120 | 121 | 122 | 12 123 | 124 | 125 | -------------------------------------------------------------------------------- /packages/DelphiMapsRunTime.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/WouterVanNifterick/delphi-maps/b16f46d3c99642d32c660d6632d4c1d2da572a9c/packages/DelphiMapsRunTime.res -------------------------------------------------------------------------------- /source/DelphiMaps.Browser.Event.pas: -------------------------------------------------------------------------------- 1 | unit DelphiMaps.Browser.Event; 2 | 3 | interface 4 | 5 | uses 6 | Generics.Collections, 7 | DelphiMaps.Browser, 8 | DelphiMaps.Browser.External, 9 | DelphiMaps.Browser.ExternalContainer; 10 | 11 | type 12 | TJsEventHandler = reference to procedure; 13 | 14 | TJsListener = class (TJsClassWrapper) 15 | private 16 | FHandler: TJsEventHandler; 17 | FEventName: string; 18 | FInstance: IJsClassWrapper; 19 | FHandlerJs: string; 20 | 21 | procedure SetEventName(const Value: string); 22 | procedure SetHandler(const Value: TJsEventHandler); 23 | procedure SetInstance(const Value: IJsClassWrapper); 24 | procedure SetHandlerJs(const Value: string); 25 | function GetFullName: string; 26 | public 27 | constructor Create; overload;override; 28 | constructor Create(aInstance: IJsClassWrapper; aEventName: string; aHandler: TJsEventHandler; aHandlerJs: string);reintroduce;overload; 29 | function JsClassName: string; override; 30 | function Clone: TJsClassWrapper; override; 31 | function ToJavaScript: string; override; 32 | 33 | property Instance:IJsClassWrapper read FInstance write SetInstance; 34 | property EventName:string read FEventName write SetEventName; 35 | property Handler:TJsEventHandler read FHandler write SetHandler; 36 | property HandlerJs:string read FHandlerJs write SetHandlerJs; 37 | property FullName:string read GetFullName; 38 | end; 39 | 40 | TListenerList=class(TObjectList) 41 | end; 42 | 43 | TEvent = class 44 | private 45 | FBrowser: TBrowser; 46 | FListeners: TListenerList; 47 | FContainer:TExternalContainer; 48 | 49 | procedure HandleShowMessageEvent(const aText: WideString); 50 | procedure HandleTriggerEventEvent(const EventName: WideString); 51 | 52 | public 53 | constructor Create(aBrowser:TBrowser); 54 | procedure AddListener(aInstance: IJsClassWrapper; aEventName: string; aHandler: TJsEventHandler; aHandlerJs: string=''); 55 | destructor Destroy; override; 56 | end; 57 | 58 | implementation 59 | 60 | uses SysUtils, StrUtils, Dialogs; 61 | 62 | { TEvent } 63 | 64 | function TJsListener.Clone: TJsClassWrapper; 65 | begin 66 | Result := TJsListener.Create; 67 | with Result as TJsListener do 68 | begin 69 | Handler := FHandler; 70 | HandlerJs := FHandlerJs; 71 | Instance := FInstance; 72 | EventName := FEventName; 73 | end; 74 | end; 75 | 76 | constructor TJsListener.Create; 77 | begin 78 | inherited; 79 | 80 | end; 81 | 82 | constructor TJsListener.Create(aInstance: IJsClassWrapper; aEventName: string; aHandler: TJsEventHandler; aHandlerJs: string); 83 | begin 84 | FHandler := aHandler; 85 | FEventName:= aEventName; 86 | FInstance := aInstance; 87 | FHandlerJs:= aHandlerJs; 88 | end; 89 | 90 | 91 | function TJsListener.GetFullName: string; 92 | begin 93 | result:= Format('%s_%s',[ Instance.JsVarName, EventName ]); 94 | end; 95 | 96 | function TJsListener.JsClassName: string; 97 | begin 98 | result := 'google.maps.event'; 99 | end; 100 | 101 | procedure TJsListener.SetEventName(const Value: string); 102 | begin 103 | FEventName := Value; 104 | end; 105 | 106 | procedure TJsListener.SetHandler(const Value: TJsEventHandler); 107 | begin 108 | FHandler := Value; 109 | end; 110 | 111 | procedure TJsListener.SetHandlerJs(const Value: string); 112 | begin 113 | FHandlerJs := Value; 114 | end; 115 | 116 | procedure TJsListener.SetInstance(const Value: IJsClassWrapper); 117 | begin 118 | FInstance := Value; 119 | end; 120 | 121 | function TJsListener.ToJavaScript: string; 122 | var 123 | EscapedJs:string; 124 | begin 125 | // EscapedJs := ReplaceStr(HandlerJs,'"','\"'); 126 | 127 | EscapedJs := HandlerJs; 128 | 129 | result := format('%s.addListener(%s,"%s",function(){%s;%s});',[ 130 | JsClassName, 131 | Instance.JsVarName, 132 | EventName, 133 | EscapedJs, 134 | Format('external.triggerEvent("%s");',[ FullName ]) 135 | ]); 136 | end; 137 | 138 | { TEvents } 139 | 140 | procedure TEvent.AddListener(aInstance: IJsClassWrapper; aEventName: string; aHandler: TJsEventHandler; aHandlerJs: string=''); 141 | var 142 | Listener:TJsListener; 143 | begin 144 | Listener := TJsListener.Create(aInstance,aEventName,aHandler,aHandlerJs); 145 | FListeners.Add(Listener); 146 | FBrowser.ExecJavaScript( Listener.ToJavaScript ); 147 | 148 | end; 149 | 150 | constructor TEvent.Create(aBrowser: TBrowser); 151 | begin 152 | FListeners := TListenerList.Create; 153 | FListeners.OwnsObjects := True; 154 | FBrowser := aBrowser; 155 | FContainer := TExternalContainer.Create(FBrowser); 156 | FContainer.ExternalObj.OnShowMessage := HandleShowMessageEvent; 157 | FContainer.ExternalObj.OnTriggerEvent := HandleTriggerEventEvent; 158 | end; 159 | 160 | destructor TEvent.Destroy; 161 | begin 162 | FreeAndNil(FListeners); 163 | FreeAndNil(FContainer); 164 | inherited; 165 | end; 166 | 167 | procedure TEvent.HandleShowMessageEvent(const aText: WideString); 168 | begin 169 | Dialogs.ShowMessage(aText); 170 | end; 171 | 172 | procedure TEvent.HandleTriggerEventEvent(const EventName: WideString); 173 | var 174 | Listener: TJsListener; 175 | begin 176 | for Listener in FListeners do 177 | begin 178 | if Listener.FullName = EventName then 179 | Listener.FHandler(); 180 | end; 181 | 182 | end; 183 | 184 | end. 185 | -------------------------------------------------------------------------------- /source/DelphiMaps.Browser.External.pas: -------------------------------------------------------------------------------- 1 | { 2 | This demo application accompanies the article 3 | "How to call Delphi code from scripts running in a TWebBrowser" at 4 | http://www.delphidabbler.com/articles?article=22. 5 | 6 | This unit defines a class that extends the TWebBrowser's external object. 7 | 8 | This code is copyright (c) P D Johnson (www.delphidabbler.com), 2005-2006. 9 | 10 | v1.0 of 2005/05/09 - original version 11 | v1.1 of 2006/02/11 - changed base URL of programs to reflect current use 12 | } 13 | 14 | 15 | {$A8,B-,C+,D+,E-,F-,G+,H+,I+,J-,K-,L+,M-,N+,O+,P+,Q-,R-,S-,T-,U-,V+,W-,X+,Y+,Z1} 16 | {$WARN UNSAFE_TYPE OFF} 17 | 18 | 19 | unit 20 | DelphiMaps.Browser.External; 21 | 22 | interface 23 | 24 | uses 25 | Classes, ComObj, DelphiMapsBrowserExternal_TLB; 26 | 27 | type 28 | TShowMessageEvent = procedure(const aText: WideString) of object; 29 | TTriggerEventEvent = procedure (const EventName: WideString) of object; 30 | 31 | TDelphiMapsExternal = class(TAutoIntfObject, IDelphiMaps , IDispatch) 32 | private 33 | FOnTriggerEvent: TTriggerEventEvent; 34 | FOnShowMessage: TShowMessageEvent; 35 | procedure SetOnTriggerEvent(const Value: TTriggerEventEvent); 36 | procedure SetOnShowMessage(const Value: TShowMessageEvent); 37 | 38 | protected 39 | public 40 | constructor Create; 41 | destructor Destroy; override; 42 | procedure showMessage(const aText: WideString); safecall; 43 | procedure triggerEvent(const EventName: WideString); safecall; 44 | 45 | public 46 | property OnTriggerEvent:TTriggerEventEvent read FOnTriggerEvent write SetOnTriggerEvent; 47 | property OnShowMessage:TShowMessageEvent read FOnShowMessage write SetOnShowMessage; 48 | end; 49 | 50 | implementation 51 | 52 | uses 53 | Dialogs, SysUtils, ActiveX, StdActns; 54 | 55 | { TMyExternal } 56 | 57 | 58 | constructor TDelphiMapsExternal.Create; 59 | var 60 | TypeLib: ITypeLib; // type library information 61 | ExeName: WideString; // name of our program's exe file 62 | begin 63 | // Get name of application 64 | ExeName := ParamStr(0); 65 | // Load type library from application's resources 66 | OleCheck(LoadTypeLib(PWideChar(ExeName), TypeLib)); 67 | // Call inherited constructor 68 | inherited Create(TypeLib, IDelphiMaps); 69 | end; 70 | 71 | 72 | destructor TDelphiMapsExternal.Destroy; 73 | begin 74 | inherited; 75 | end; 76 | 77 | procedure TDelphiMapsExternal.SetOnShowMessage(const Value: TShowMessageEvent); 78 | begin 79 | FOnShowMessage := Value; 80 | end; 81 | 82 | procedure TDelphiMapsExternal.SetOnTriggerEvent( 83 | const Value: TTriggerEventEvent); 84 | begin 85 | FOnTriggerEvent := Value; 86 | end; 87 | 88 | procedure TDelphiMapsExternal.showMessage(const aText: WideString); 89 | begin 90 | if Assigned(FOnShowMessage) then 91 | FOnShowMessage(aText); 92 | end; 93 | 94 | procedure TDelphiMapsExternal.triggerEvent(const EventName: WideString); 95 | begin 96 | if Assigned(FOnTriggerEvent) then 97 | FOnTriggerEvent(EventName); 98 | end; 99 | 100 | end. 101 | -------------------------------------------------------------------------------- /source/DelphiMaps.Browser.ExternalContainer.pas: -------------------------------------------------------------------------------- 1 | { 2 | This demo application accompanies the article 3 | "How to call Delphi code from scripts running in a TWebBrowser" at 4 | http://www.delphidabbler.com/articles?article=22. 5 | 6 | This unit defines the IDocHostUIHandler implementation that provides the 7 | external object to the TWebBrowser. 8 | 9 | This code is copyright (c) P D Johnson (www.delphidabbler.com), 2005-2006. 10 | 11 | v1.0 of 2005/05/09 - original version named UExternalUIHandler.pas 12 | v2.0 of 2006/02/11 - revised to descend from new TNulWBContainer class 13 | 14 | vX.X of 2010/10/24 - (Wouter van Nifterick) : Made TExternalContainer a generic class 15 | } 16 | 17 | {$A8,B-,C+,D+,E-,F-,G+,H+,I+,J-,K-,L+,M-,N+,O+,P+,Q-,R-,S-,T-,U-,V+,W-,X+,Y+,Z1} 18 | unit DelphiMaps.Browser.ExternalContainer; 19 | 20 | interface 21 | 22 | uses 23 | // Delphi 24 | ActiveX, SHDocVw, 25 | // Project 26 | ComObj, 27 | DelphiMaps.Browser.IntfDocHostUIHandler, 28 | DelphiMaps.Browser.NulContainer, 29 | DelphiMaps.Browser.External; 30 | 31 | type 32 | 33 | TExternalContainer = class(TNulWBContainer, IDocHostUIHandler, IOleClientSite) 34 | private 35 | fExternalObj: IDispatch; 36 | function GEtExternalObj: T; 37 | protected 38 | function GetExternal(out ppDispatch: IDispatch): HResult; stdcall; 39 | public 40 | constructor Create(const HostedBrowser: TWebBrowser); 41 | property ExternalObj : T read GEtExternalObj; 42 | end; 43 | 44 | implementation 45 | 46 | { TExternalContainer } 47 | 48 | constructor TExternalContainer.Create(const HostedBrowser: TWebBrowser); 49 | begin 50 | inherited; 51 | fExternalObj := T.Create; 52 | end; 53 | 54 | function TExternalContainer.GetExternal(out ppDispatch: IDispatch): HResult; 55 | begin 56 | ppDispatch := fExternalObj; 57 | Result := S_OK; // indicates we've provided script 58 | end; 59 | 60 | function TExternalContainer.GEtExternalObj: T; 61 | begin 62 | Result := Self.fExternalObj as T; 63 | end; 64 | 65 | 66 | end. 67 | -------------------------------------------------------------------------------- /source/DelphiMaps.Browser.NulContainer.pas: -------------------------------------------------------------------------------- 1 | { 2 | This demo application accompanies the article 3 | "How to call Delphi code from scripts running in a TWebBrowser" at 4 | http://www.delphidabbler.com/articles?article=22. 5 | 6 | This unit provides a do-nothing implementation of a web browser OLE container 7 | object 8 | 9 | This code is copyright (c) P D Johnson (www.delphidabbler.com), 2005-2006. 10 | 11 | v1.0 of 2005/05/09 - original version named UBaseUIHandler.pas 12 | v2.0 of 2006/02/11 - total rewrite based on unit of same name from article at 13 | http://www.delphidabbler.com/articles?article=22 14 | } 15 | 16 | {$A8,B-,C+,D+,E-,F-,G+,H+,I+,J-,K-,L+,M-,N+,O+,P+,Q-,R-,S-,T-,U-,V+,W-,X+,Y+,Z1} 17 | {$WARN UNSAFE_TYPE OFF} 18 | unit DelphiMaps.Browser.NulContainer; 19 | 20 | interface 21 | 22 | uses 23 | Windows, ActiveX, SHDocVw, 24 | DelphiMaps.Browser.IntfDocHostUIHandler; 25 | 26 | type 27 | 28 | TNulWBContainer = class(TObject, IUnknown, IOleClientSite, IDocHostUIHandler) 29 | private 30 | fHostedBrowser: TWebBrowser; 31 | // Registration method 32 | procedure SetBrowserOleClientSite(const Site: IOleClientSite); 33 | protected 34 | { IUnknown } 35 | function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall; 36 | function _AddRef: Integer; stdcall; 37 | function _Release: Integer; stdcall; 38 | { IOleClientSite } 39 | function SaveObject: HResult; stdcall; 40 | function GetMoniker(dwAssign: Longint; dwWhichMoniker: Longint; out mk: IMoniker): HResult; stdcall; 41 | function GetContainer(out container: IOleContainer): HResult; stdcall; 42 | function ShowObject: HResult; stdcall; 43 | function OnShowWindow(fShow: BOOL): HResult; stdcall; 44 | function RequestNewObjectLayout: HResult; stdcall; 45 | { IDocHostUIHandler } 46 | function ShowContextMenu(const dwID: DWORD; const ppt: PPOINT; const pcmdtReserved: IUnknown; const pdispReserved: IDispatch): HResult; stdcall; 47 | function GetHostInfo(var pInfo: TDocHostUIInfo): HResult; stdcall; 48 | function ShowUI(const dwID: DWORD; const pActiveObject: IOleInPlaceActiveObject; const pCommandTarget: IOleCommandTarget; const pFrame: IOleInPlaceFrame; const pDoc: IOleInPlaceUIWindow): HResult; stdcall; 49 | function HideUI: HResult; stdcall; 50 | function UpdateUI: HResult; stdcall; 51 | function EnableModeless(const fEnable: BOOL): HResult; stdcall; 52 | function OnDocWindowActivate(const fActivate: BOOL): HResult; stdcall; 53 | function OnFrameWindowActivate(const fActivate: BOOL): HResult; stdcall; 54 | function ResizeBorder(const prcBorder: PRECT; const pUIWindow: IOleInPlaceUIWindow; const fFrameWindow: BOOL): HResult; stdcall; 55 | function TranslateAccelerator(const lpMsg: PMSG; const pguidCmdGroup: PGUID; const nCmdID: DWORD): HResult; stdcall; 56 | function GetOptionKeyPath(var pchKey: POLESTR; const dw: DWORD): HResult; stdcall; 57 | function GetDropTarget(const pDropTarget: IDropTarget; out ppDropTarget: IDropTarget): HResult; stdcall; 58 | function GetExternal(out ppDispatch: IDispatch): HResult; stdcall; 59 | function TranslateUrl(const dwTranslate: DWORD; const pchURLIn: POLESTR; var ppchURLOut: POLESTR): HResult; stdcall; 60 | function FilterDataObject(const pDO: IDataObject; out ppDORet: IDataObject): HResult; stdcall; 61 | public 62 | constructor Create(const HostedBrowser: TWebBrowser); 63 | destructor Destroy; override; 64 | property HostedBrowser: TWebBrowser read fHostedBrowser; 65 | end; 66 | 67 | implementation 68 | 69 | uses 70 | SysUtils; 71 | 72 | { TNulWBContainer } 73 | 74 | constructor TNulWBContainer.Create(const HostedBrowser: TWebBrowser); 75 | begin 76 | Assert(Assigned(HostedBrowser)); 77 | inherited Create; 78 | fHostedBrowser := HostedBrowser; 79 | SetBrowserOleClientSite(Self as IOleClientSite); 80 | end; 81 | 82 | destructor TNulWBContainer.Destroy; 83 | begin 84 | SetBrowserOleClientSite(nil); 85 | inherited; 86 | end; 87 | 88 | function TNulWBContainer.EnableModeless(const fEnable: BOOL): HResult; 89 | begin 90 | { Return S_OK to indicate we handled (ignored) OK } 91 | Result := S_OK; 92 | end; 93 | 94 | function TNulWBContainer.FilterDataObject(const pDO: IDataObject; out ppDORet: IDataObject): HResult; 95 | begin 96 | { Return S_FALSE to show no data object supplied. We *must* also set ppDORet to nil } 97 | ppDORet := nil; 98 | Result := S_FALSE; 99 | end; 100 | 101 | function TNulWBContainer.GetContainer(out container: IOleContainer): HResult; 102 | { Returns a pointer to the container's IOleContainer 103 | interface } 104 | begin 105 | { We do not support IOleContainer. However we *must* set container to nil } 106 | container := nil; 107 | Result := E_NOINTERFACE; 108 | end; 109 | 110 | function TNulWBContainer.GetDropTarget(const pDropTarget: IDropTarget; out ppDropTarget: IDropTarget): HResult; 111 | begin 112 | { Return E_FAIL since no alternative drop target supplied. 113 | We *must* also set ppDropTarget to nil } 114 | ppDropTarget := nil; 115 | Result := E_FAIL; 116 | end; 117 | 118 | function TNulWBContainer.GetExternal(out ppDispatch: IDispatch): HResult; 119 | begin 120 | { Return E_FAIL to indicate we failed to supply external object. 121 | We *must* also set ppDispatch to nil } 122 | ppDispatch := nil; 123 | Result := E_FAIL; 124 | end; 125 | 126 | function TNulWBContainer.GetHostInfo(var pInfo: TDocHostUIInfo): HResult; 127 | begin 128 | { Return S_OK to indicate UI is OK without changes } 129 | Result := S_OK; 130 | end; 131 | 132 | function TNulWBContainer.GetMoniker(dwAssign, dwWhichMoniker: Integer; out mk: IMoniker): HResult; 133 | { Returns a moniker to an object's client site } 134 | begin 135 | { We don't support monikers. However we *must* set mk to nil } 136 | mk := nil; 137 | Result := E_NOTIMPL; 138 | end; 139 | 140 | function TNulWBContainer.GetOptionKeyPath(var pchKey: POLESTR; const dw: DWORD): HResult; 141 | begin 142 | { Return E_FAIL to indicate we failed to override default registry settings } 143 | Result := E_FAIL; 144 | end; 145 | 146 | function TNulWBContainer.HideUI: HResult; 147 | begin 148 | { Return S_OK to indicate we handled (ignored) OK } 149 | Result := S_OK; 150 | end; 151 | 152 | function TNulWBContainer.OnDocWindowActivate(const fActivate: BOOL): HResult; 153 | begin 154 | { Return S_OK to indicate we handled (ignored) OK } 155 | Result := S_OK; 156 | end; 157 | 158 | function TNulWBContainer.OnFrameWindowActivate(const fActivate: BOOL): HResult; 159 | begin 160 | { Return S_OK to indicate we handled (ignored) OK } 161 | Result := S_OK; 162 | end; 163 | 164 | function TNulWBContainer.OnShowWindow(fShow: BOOL): HResult; 165 | { Notifies a container when an embedded object's window is about to become visible or invisible } 166 | begin 167 | { Return S_OK to pretend we've responded to this } 168 | Result := S_OK; 169 | end; 170 | 171 | function TNulWBContainer.QueryInterface(const IID: TGUID; out Obj): HResult; 172 | begin 173 | if GetInterface(IID, Obj) then 174 | Result := S_OK 175 | else 176 | Result := E_NOINTERFACE; 177 | end; 178 | 179 | function TNulWBContainer.RequestNewObjectLayout: HResult; 180 | { Asks container to allocate more or less space for displaying an embedded object } 181 | begin 182 | { We don't support requests for a new layout } 183 | Result := E_NOTIMPL; 184 | end; 185 | 186 | function TNulWBContainer.ResizeBorder(const prcBorder: PRECT; const pUIWindow: IOleInPlaceUIWindow; const fFrameWindow: BOOL): HResult; 187 | begin 188 | { Return S_FALSE to indicate we did nothing in response } 189 | Result := S_FALSE; 190 | end; 191 | 192 | function TNulWBContainer.SaveObject: HResult; 193 | { Saves the object associated with the client site } 194 | begin 195 | { Return S_OK to pretend we've done this } 196 | Result := S_OK; 197 | end; 198 | 199 | procedure TNulWBContainer.SetBrowserOleClientSite(const Site: IOleClientSite); 200 | var 201 | OleObj: IOleObject; 202 | begin 203 | Assert((Site = Self as IOleClientSite) or (Site = nil)); 204 | if not Supports(fHostedBrowser.DefaultInterface, IOleObject, OleObj) then 205 | raise Exception.Create('Browser''s Default interface does not support IOleObject'); 206 | OleObj.SetClientSite(Site); 207 | end; 208 | 209 | function TNulWBContainer.ShowContextMenu(const dwID: DWORD; const ppt: PPOINT; const pcmdtReserved: IInterface; const pdispReserved: IDispatch): HResult; 210 | begin 211 | { Return S_FALSE to notify we didn't display a menu and to let browser display its own menu } 212 | Result := S_FALSE 213 | end; 214 | 215 | function TNulWBContainer.ShowObject: HResult; 216 | { Tells the container to position the object so it is visible to the user } 217 | begin 218 | { Return S_OK to pretend we've done this } 219 | Result := S_OK; 220 | end; 221 | 222 | function TNulWBContainer.ShowUI(const dwID: DWORD; const pActiveObject: IOleInPlaceActiveObject; const pCommandTarget: IOleCommandTarget; const pFrame: IOleInPlaceFrame; const pDoc: IOleInPlaceUIWindow): HResult; 223 | begin 224 | { Return S_OK to say we displayed own UI } 225 | Result := S_OK; 226 | end; 227 | 228 | function TNulWBContainer.TranslateAccelerator(const lpMsg: PMSG; const pguidCmdGroup: PGUID; const nCmdID: DWORD): HResult; 229 | begin 230 | { Return S_FALSE to indicate no accelerators are translated } 231 | Result := S_FALSE; 232 | end; 233 | 234 | function TNulWBContainer.TranslateUrl(const dwTranslate: DWORD; const pchURLIn: POLESTR; var ppchURLOut: POLESTR): HResult; 235 | begin 236 | { Return E_FAIL to indicate that no translations took place } 237 | Result := E_FAIL; 238 | end; 239 | 240 | function TNulWBContainer.UpdateUI: HResult; 241 | begin 242 | { Return S_OK to indicate we handled (ignored) OK } 243 | Result := S_OK; 244 | end; 245 | 246 | function TNulWBContainer._AddRef: Integer; 247 | begin 248 | Result := -1; 249 | end; 250 | 251 | function TNulWBContainer._Release: Integer; 252 | begin 253 | Result := -1; 254 | end; 255 | 256 | end. 257 | -------------------------------------------------------------------------------- /source/DelphiMaps.Browser.pas: -------------------------------------------------------------------------------- 1 | {**************************************************************************************************} 2 | { The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } 3 | { you may not use this file except in compliance with the License. You may obtain a copy of the } 4 | { License at http://www.mozilla.org/MPL/ } 5 | { } 6 | { Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } 7 | { ANY KIND, either express or implied. See the License for the specific language governing rights } 8 | { and limitations under the License. } 9 | { } 10 | { The Original Code is DelphiMaps.GoogleMaps.pas } 11 | { } 12 | { The Initial Developer of the Original Code is Wouter van Nifterick } 13 | { (wouter_van_nifterick@hotmail.com. } 14 | {**************************************************************************************************} 15 | 16 | unit DelphiMaps.Browser; 17 | 18 | interface 19 | 20 | uses 21 | Controls, 22 | Graphics, 23 | Classes, 24 | SHDocVw, 25 | MSHTML; 26 | 27 | 28 | type 29 | // class that extends TWebBrowser with methods to easily execute JavaScript, 30 | // and to retrieve javascript variables and function results 31 | TBrowser=class(TWebBrowser) 32 | private 33 | procedure OnMouseOver; 34 | function GetHtmlWindow2: IHTMLWindow2; 35 | public 36 | constructor Create(AOwner: TComponent); override; 37 | published 38 | procedure ExecJavaScript(const aScript:String); 39 | procedure ExecJavaScriptFmt(const aScriptFormat:String;aParameters:Array of const); 40 | procedure WebBrowserDocumentComplete(ASender: TObject; const pDisp: IDispatch; var URL: OleVariant); 41 | function Eval(aJavaScript:String;Default:Variant):Variant; 42 | property HtmlWindow2:IHTMLWindow2 read GetHtmlWindow2; 43 | end; 44 | 45 | TJsObjectProcedure = procedure of object; 46 | TJsProcReference = reference to procedure; 47 | 48 | TJsEventObject = class(TInterfacedObject, IDispatch) 49 | private 50 | FOnEvent: TJsObjectProcedure; 51 | FOnEventDo: TJsProcReference; 52 | protected 53 | function GetTypeInfoCount(out Count: Integer): HResult; stdcall; 54 | function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall; 55 | function GetIDsOfNames(const IID: TGUID; Names: Pointer; NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall; 56 | function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall; 57 | public 58 | constructor Create(const OnEvent: TJsObjectProcedure);overload; 59 | constructor Create(const OnEvent: TJsProcReference);overload; 60 | property OnEvent: TJsObjectProcedure read FOnEvent write FOnEvent; 61 | property OnEventDo: TJsProcReference read FOnEventDo write FOnEventDo; 62 | end; 63 | 64 | IJsClassWrapper = interface(IInterface) 65 | function JsClassName: String; 66 | function GetJsVarName: String; 67 | procedure SetJsVarName(const aVarName: String); 68 | property JsVarName: String read GetJsVarName write SetJsVarName; 69 | function ToJavaScript: String; 70 | end; 71 | 72 | TJsClassWrapper=class abstract(TInterfacedObject,IJsClassWrapper) 73 | protected 74 | // FId:String; 75 | FJsVarName:String; 76 | function GetJsVarName:String; 77 | procedure SetJsVarName(const aVarName:String); 78 | public 79 | constructor Create; virtual; abstract; 80 | function JsClassName:String;virtual;abstract; 81 | function ToJavaScript:String;virtual;abstract; 82 | property JsVarName:String read GetJsVarName write SetJsVarName; 83 | function Clone:TJsClassWrapper;virtual;abstract; 84 | end; 85 | 86 | 87 | TBrowserControl=class(TCustomControl) 88 | strict private 89 | FBrowser:TBrowser; 90 | FJsVarName: String; 91 | procedure Init; 92 | procedure SetJsVarName(const Value: String); 93 | protected 94 | class function GetHTMLResourceName:String;virtual; 95 | procedure SaveHtml(const aFileName:string);virtual; 96 | procedure Loaded; override; 97 | public 98 | constructor Create(AOwner: TComponent);override; 99 | destructor Destroy;override; 100 | procedure HandleOnResize(Sender:TObject); 101 | procedure CheckResize; 102 | property Browser : TBrowser read FBrowser write FBrowser; 103 | published 104 | property JsVarName:String read FJsVarName write SetJsVarName; 105 | procedure ExecJavaScript(const aScript:String); 106 | procedure ExecJavaScriptFmt(const aScriptFormat:String;aParameters:Array of const); 107 | procedure WebBrowserDocumentComplete(ASender: TObject; const pDisp: IDispatch; var URL: OleVariant); 108 | property Align; 109 | property OnClick; 110 | property OnResize; 111 | // property OnEnter; 112 | // property OnExit; 113 | // property OnKeyDown; 114 | // property OnKeyPress; 115 | // property OnKeyUp; 116 | // property OnDblClick; 117 | property Anchors; 118 | property BoundsRect; 119 | property ShowHint; 120 | property Visible; 121 | end; 122 | 123 | 124 | function ColorToHtml(DColor:TColor):string; 125 | 126 | 127 | implementation 128 | 129 | uses 130 | Windows, 131 | SysUtils, 132 | ActiveX, 133 | StrUtils, 134 | Dialogs; 135 | 136 | 137 | function ColorToHtml(DColor:TColor):string; 138 | var 139 | tmpRGB : TColor; 140 | begin 141 | tmpRGB := ColorToRGB(DColor) ; 142 | Result:=Format('#%.2x%.2x%.2x', 143 | [GetRValue(tmpRGB), 144 | GetGValue(tmpRGB), 145 | GetBValue(tmpRGB)]) ; 146 | end; 147 | 148 | 149 | { TBrowser } 150 | 151 | constructor TBrowser.Create(AOwner: TComponent); 152 | begin 153 | inherited; 154 | // Navigate('about:blank'); 155 | // OleObject.document.body.style.overflowX := 'hidden'; 156 | // OleObject.document.body.style.overflowY := 'hidden'; 157 | 158 | // Switch off borders 159 | // OleObject.document.body.style.borderstyle := 'none'; 160 | 161 | end; 162 | 163 | procedure TBrowser.ExecJavaScript(const aScript: String); 164 | begin 165 | if (ReadyState <> READYSTATE_COMPLETE) then 166 | exit; 167 | 168 | if not Assigned(Document) then 169 | exit; 170 | 171 | try 172 | (Document as IHTMLDocument2).parentWindow.execScript(aScript, 'JavaScript'); 173 | except 174 | on e:Exception do 175 | ShowMessage('Error: "'+e.Message + #13#10#13#10 + 'Script:'#13#10+aScript); 176 | end; 177 | end; 178 | 179 | 180 | procedure TBrowser.ExecJavaScriptFmt(const aScriptFormat: String; aParameters: array of const); 181 | begin 182 | ExecJavaScript(Format(aScriptFormat,aParameters)); 183 | end; 184 | 185 | function TBrowser.GetHtmlWindow2: IHTMLWindow2; 186 | begin 187 | Result := (Document as IHTMLDocument2).parentWindow 188 | end; 189 | 190 | function TBrowser.Eval(aJavaScript: String;Default:Variant): Variant; 191 | var 192 | Window: IHTMLWindow2; 193 | begin 194 | Result := Default; 195 | if (csDesigning in ComponentState)then 196 | Exit; 197 | 198 | if (ReadyState <> READYSTATE_COMPLETE) then 199 | Exit; 200 | 201 | if not Assigned(Document) then 202 | Exit; 203 | 204 | Window := (Document as IHTMLDocument2).parentWindow; 205 | aJavaScript := ReplaceStr(aJavaScript, '"', '\"'); 206 | ExecJavaScriptFmt('window.status=eval("%s");', [aJavaScript]); 207 | Result := Window.status; 208 | Window.status := ''; 209 | end; 210 | 211 | procedure TBrowser.OnMouseOver; 212 | var 213 | element : IHTMLElement; 214 | begin 215 | element := (Document as IHTMLDocument2).parentWindow.event.srcElement; 216 | { 217 | if LowerCase(element.tagName) = 'a' then 218 | begin 219 | FLogLines.Add('LINK info...'); 220 | FLogLines.Add(Format('HREF : %s',[element.getAttribute('href',0)])); 221 | end 222 | else if LowerCase(element.tagName) = 'img' then 223 | begin 224 | FLogLines.Add('IMAGE info...'); 225 | FLogLines.Add(Format('SRC : %s',[element.getAttribute('src',0)])); 226 | end 227 | else 228 | begin 229 | FLogLines.Add(Format('TAG : %s',[element.tagName])); 230 | end; 231 | } 232 | end; 233 | 234 | 235 | 236 | procedure TBrowser.WebBrowserDocumentComplete(ASender: TObject; const pDisp: IDispatch; var URL: OleVariant); 237 | begin 238 | if Assigned(Document) then 239 | begin 240 | (Document as IHTMLDocument2).onmouseover := (TJsEventObject.Create(OnMouseOver) as IDispatch) ; 241 | // (FWebBrowser.Document as IHTMLDocument2).parentWindow.alert((FWebBrowser.Document as IHTMLDocument2).parentWindow.toString); 242 | end; 243 | end; 244 | 245 | { TJsEventObject } 246 | 247 | constructor TJsEventObject.Create(const OnEvent: TJsObjectProcedure) ; 248 | begin 249 | inherited Create; 250 | FOnEvent := OnEvent; 251 | end; 252 | 253 | constructor TJsEventObject.Create(const OnEvent: TJsProcReference); 254 | begin 255 | inherited Create; 256 | FOnEventDo := OnEvent; 257 | end; 258 | 259 | function TJsEventObject.GetIDsOfNames(const IID: TGUID; Names: Pointer; NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; 260 | begin 261 | Result := E_NOTIMPL; 262 | end; 263 | 264 | 265 | function TJsEventObject.GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; 266 | begin 267 | Result := E_NOTIMPL; 268 | end; 269 | 270 | function TJsEventObject.GetTypeInfoCount(out Count: Integer): HResult; 271 | begin 272 | Result := E_NOTIMPL; 273 | end; 274 | 275 | function TJsEventObject.Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; 276 | begin 277 | if (DispID = DISPID_VALUE) then 278 | begin 279 | if Assigned(FOnEvent) then 280 | FOnEvent; 281 | if Assigned(FOnEventDo) then 282 | FOnEventDo; 283 | Result := S_OK; 284 | end 285 | else 286 | Result := E_NOTIMPL; 287 | end; 288 | 289 | 290 | { TJsClassWrapper } 291 | 292 | function TJsClassWrapper.GetJsVarName: String; 293 | begin 294 | Result := FJsVarName; 295 | end; 296 | 297 | 298 | procedure TJsClassWrapper.SetJsVarName(const aVarName: String); 299 | begin 300 | JsVarName := aVarName; 301 | end; 302 | 303 | 304 | { TBrowserControl } 305 | 306 | procedure TBrowserControl.Init; 307 | begin 308 | Browser.OnDocumentComplete := WebBrowserDocumentComplete; 309 | end; 310 | 311 | constructor TBrowserControl.Create(AOwner: TComponent); 312 | begin 313 | inherited; 314 | FBrowser := TBrowser.Create(self); 315 | FBrowser.Resizable := False; 316 | FBrowser.Silent := True; 317 | TWinControl(FBrowser).Parent := Self; 318 | FBrowser.Align := alClient; 319 | FBrowser.Show; 320 | JsVarName := Name; 321 | Init; 322 | end; 323 | 324 | 325 | destructor TBrowserControl.Destroy; 326 | begin 327 | inherited; 328 | end; 329 | 330 | procedure TBrowserControl.ExecJavaScript(const aScript: String); 331 | begin 332 | Browser.ExecJavaScript(aScript); 333 | end; 334 | 335 | 336 | procedure TBrowserControl.ExecJavaScriptFmt(const aScriptFormat: String; aParameters: array of const); 337 | begin 338 | ExecJavaScript(Format(aScriptFormat,aParameters)); 339 | end; 340 | 341 | class function TBrowserControl.GetHTMLResourceName: String; 342 | begin 343 | Result := ''; 344 | end; 345 | 346 | procedure TBrowserControl.Loaded; 347 | begin 348 | inherited; 349 | JsVarName := Name; 350 | end; 351 | 352 | procedure TBrowserControl.WebBrowserDocumentComplete(ASender: TObject; 353 | const pDisp: IDispatch; var URL: OleVariant); 354 | begin 355 | 356 | end; 357 | 358 | procedure TBrowserControl.SaveHtml(const aFileName:String); 359 | var 360 | LResName: string; 361 | ResStream: TResourceStream; 362 | FileStream: TFileStream; 363 | begin 364 | LResName := GetHTMLResourceName; 365 | 366 | if LResName='' then 367 | Exit; 368 | 369 | ResStream := TResourceStream.Create(hInstance, LResName, RT_RCDATA) ; 370 | try 371 | FileStream := TFileStream.Create(aFileName, fmCreate) ; 372 | try 373 | FileStream.CopyFrom(ResStream, 0) ; 374 | finally 375 | FileStream.Free; 376 | end; 377 | finally 378 | ResStream.Free; 379 | end; 380 | end; 381 | 382 | 383 | procedure TBrowserControl.CheckResize; 384 | begin 385 | ExecJavaScript(JsVarName+'.checkResize();'); 386 | end; 387 | 388 | procedure TBrowserControl.HandleOnResize(Sender: TObject); 389 | begin 390 | CheckResize; 391 | end; 392 | 393 | 394 | procedure TBrowserControl.SetJsVarName(const Value: String); 395 | begin 396 | FJsVarName := Value; 397 | end; 398 | 399 | 400 | end. 401 | -------------------------------------------------------------------------------- /source/DelphiMaps.DouglasPeuckers.pas: -------------------------------------------------------------------------------- 1 | {**************************************************************************************************} 2 | { The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } 3 | { you may not use this file except in compliance with the License. You may obtain a copy of the } 4 | { License at http://www.mozilla.org/MPL/ } 5 | { } 6 | { Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } 7 | { ANY KIND, either express or implied. See the License for the specific language governing rights } 8 | { and limitations under the License. } 9 | { } 10 | { The Original Code is DMaps.DouglasPeuckers.pas. } 11 | { } 12 | { The Initial Developer of the Original Code is Nils Haeck (c) 2003 Simdesign (www.simdesign.nl). } 13 | { Portions created by Wouter van Nifterick 2008-05-17 : added 2D float } 14 | {**************************************************************************************************} 15 | 16 | unit DelphiMaps.DouglasPeuckers; 17 | { Implementation of the famous Douglas-Peucker polyline simplification 18 | algorithm. 19 | 20 | This file contains a 3D floating point implementation, for spatial 21 | polylines, as well as a 2D integer implementation for use with 22 | Windows GDI. 23 | 24 | Loosely based on C code from SoftSurfer (www.softsurfer.com) 25 | http://geometryalgorithms.com/Archive/algorithm_0205/algorithm_0205.htm 26 | 27 | References: 28 | David Douglas & Thomas Peucker, "Algorithms for the reduction of the number of 29 | points required to represent a digitized line or its caricature", The Canadian 30 | Cartographer 10(2), 112-122 (1973) 31 | 32 | Delphi code by Nils Haeck (c) 2003 Simdesign (www.simdesign.nl) 33 | http://www.simdesign.nl/components/douglaspeucker.html 34 | } 35 | 36 | 37 | interface 38 | 39 | uses 40 | Windows; 41 | 42 | type 43 | 44 | // Generalized float and int types 45 | TFloat = double; 46 | 47 | // Float point 2D 48 | TPointFloat2D = packed record 49 | X: TFloat; 50 | Y: TFloat; 51 | end; 52 | 53 | // Float point 3D 54 | TPointFloat3D = packed record 55 | X: TFloat; 56 | Y: TFloat; 57 | Z: TFloat; 58 | end; 59 | 60 | TInt2dPointAr = array of TPoint; 61 | TFloat2DPointAr = array of TPointFloat2D; 62 | TFloat3DPointAr = array of TPointFloat3D; 63 | 64 | { PolySimplify: 65 | Approximates the polyline with vertices in Orig, with a simplified 66 | version that will be returned in Simple. The maximum deviation from the 67 | original line is given in Tol. 68 | Input: Tol = approximation tolerance 69 | Orig[] = polyline array of vertex points 70 | Output: Simple[] = simplified polyline vertices. This array must initially 71 | have the same length as Orig 72 | Return: the number of points in Simple 73 | } 74 | function PolySimplifyInt2D(Tol: TFloat; const Orig: array of TPoint; var Simple: TInt2dPointAr): integer; 75 | function PolySimplifyFloat2D(Tol: TFloat; const Orig: array of TPointFloat2D; var Simple: TFloat2DPointAr): integer; 76 | function PolySimplifyFloat3D(Tol: TFloat; const Orig: array of TPointFloat3D; var Simple: TFloat3DPointAr): integer; 77 | 78 | procedure SimplifyFloat2D(var Tol2: TFloat; const Orig: array of TPointFloat2D; var Marker: array of boolean; j, k: integer); 79 | 80 | implementation 81 | 82 | uses Math; 83 | 84 | function VecMinFloat2D(const A, B: TPointFloat2D): TPointFloat2D; 85 | // Result = A - B 86 | begin 87 | Result.X := A.X - B.X; 88 | Result.Y := A.Y - B.Y; 89 | end; 90 | 91 | function VecMinFloat3D(const A, B: TPointFloat3D): TPointFloat3D; 92 | // Result = A - B 93 | begin 94 | Result.X := A.X - B.X; 95 | Result.Y := A.Y - B.Y; 96 | Result.Z := A.Z - B.Z; 97 | end; 98 | 99 | function DotProdFloat2D(const A, B: TPointFloat2D): TFloat; 100 | // Dotproduct = A * B 101 | begin 102 | Result := A.X * B.X + A.Y * B.Y; 103 | end; 104 | 105 | function DotProdFloat3D(const A, B: TPointFloat3D): TFloat; 106 | // Dotproduct = A * B 107 | begin 108 | Result := A.X * B.X + A.Y * B.Y + A.Z * B.Z; 109 | end; 110 | 111 | function NormSquaredFloat2D(const A: TPointFloat2D): TFloat; 112 | // Square of the norm |A| 113 | begin 114 | Result := A.X * A.X + A.Y * A.Y; 115 | end; 116 | 117 | function NormSquaredFloat3D(const A: TPointFloat3D): TFloat; 118 | // Square of the norm |A| 119 | begin 120 | Result := A.X * A.X + A.Y * A.Y + A.Z * A.Z; 121 | end; 122 | 123 | function DistSquaredFloat2D(const A, B: TPointFloat2D): TFloat; 124 | // Square of the distance from A to B 125 | begin 126 | Result := NormSquaredFloat2D(VecMinFloat2D(A, B)); 127 | end; 128 | 129 | function DistSquaredFloat3D(const A, B: TPointFloat3D): TFloat; 130 | // Square of the distance from A to B 131 | begin 132 | Result := NormSquaredFloat3D(VecMinFloat3D(A, B)); 133 | end; 134 | 135 | procedure SimplifyFloat2D(var Tol2: TFloat; const Orig: array of TPointFloat2D; var Marker: array of boolean; j, k: integer); 136 | // Simplify polyline in OrigList between j and k. Marker[] will be set to True 137 | // for each point that must be included 138 | var 139 | i, MaxI: integer; // Index at maximum value 140 | MaxD2: TFloat; // Maximum value squared 141 | CU, CW, B: TFloat; 142 | DV2: TFloat; 143 | P0, P1, PB, U, W: TPointFloat2D; 144 | begin 145 | // Is there anything to simplify? 146 | if k <= j + 1 then 147 | exit; 148 | 149 | P0 := Orig[j]; 150 | P1 := Orig[k]; 151 | U := VecMinFloat2D(P1, P0); // Segment vector 152 | CU := DotProdFloat2D(U, U); // Segment length squared 153 | MaxD2 := 0; 154 | MaxI := 0; 155 | 156 | // Loop through points and detect the one furthest away 157 | for i := j + 1 to k - 1 do 158 | begin 159 | W := VecMinFloat2D(Orig[i], P0); 160 | CW := DotProdFloat2D(W, U); 161 | 162 | // Distance of point Orig[i] from segment 163 | if CW <= 0 then 164 | begin 165 | // Before segment 166 | DV2 := DistSquaredFloat2D(Orig[i], P0) 167 | end 168 | else 169 | begin 170 | if CW > CU then 171 | begin 172 | // Past segment 173 | DV2 := DistSquaredFloat2D(Orig[i], P1); 174 | end 175 | else 176 | begin 177 | // Fraction of the segment 178 | if CU=0 then 179 | B := 0 180 | else 181 | B := CW / CU; 182 | PB.X := P0.X + B * U.X; 183 | PB.Y := P0.Y + B * U.Y; 184 | DV2 := DistSquaredFloat2D(Orig[i], PB); 185 | end; 186 | end; 187 | 188 | // test with current max distance squared 189 | if DV2 > MaxD2 then 190 | begin 191 | // Orig[i] is a new max vertex 192 | MaxI := i; 193 | MaxD2 := DV2; 194 | end; 195 | end; 196 | 197 | // If the furthest point is outside tolerance we must split 198 | if MaxD2 > Tol2 then 199 | begin // error is worse than the tolerance 200 | // split the polyline at the farthest vertex from S 201 | Marker[MaxI] := True; // mark Orig[maxi] for the simplified polyline 202 | 203 | // recursively simplify the two subpolylines at Orig[maxi] 204 | SimplifyFloat2D(Tol2, Orig, Marker, j, MaxI); // polyline Orig[j] to Orig[maxi] 205 | SimplifyFloat2D(Tol2, Orig, Marker, MaxI, k); // polyline Orig[maxi] to Orig[k] 206 | end; 207 | end; 208 | 209 | procedure SimplifyFloat3D(var Tol2: TFloat; const Orig: array of TPointFloat3D; var Marker: array of boolean; j, k: integer); 210 | // Simplify polyline in OrigList between j and k. Marker[] will be set to True 211 | // for each point that must be included 212 | var 213 | i, MaxI: integer; // Index at maximum value 214 | MaxD2: TFloat; // Maximum value squared 215 | CU, CW, B: TFloat; 216 | DV2: TFloat; 217 | P0, P1, PB, U, W: TPointFloat3D; 218 | begin 219 | // Is there anything to simplify? 220 | if k <= j + 1 then 221 | exit; 222 | 223 | P0 := Orig[j]; 224 | P1 := Orig[k]; 225 | U := VecMinFloat3D(P1, P0); // Segment vector 226 | CU := DotProdFloat3D(U, U); // Segment length squared 227 | MaxD2 := 0; 228 | MaxI := 0; 229 | 230 | // Loop through points and detect the one furthest away 231 | for i := j + 1 to k - 1 do 232 | begin 233 | W := VecMinFloat3D(Orig[i], P0); 234 | CW := DotProdFloat3D(W, U); 235 | 236 | // Distance of point Orig[i] from segment 237 | if CW <= 0 then 238 | begin 239 | // Before segment 240 | DV2 := DistSquaredFloat3D(Orig[i], P0) 241 | end 242 | else 243 | begin 244 | if CW > CU then 245 | begin 246 | // Past segment 247 | DV2 := DistSquaredFloat3D(Orig[i], P1); 248 | end 249 | else 250 | begin 251 | // Fraction of the segment 252 | if CU=0 then 253 | B := 0 254 | else 255 | B := CW / CU; 256 | PB.X := P0.X + B * U.X; 257 | PB.Y := P0.Y + B * U.Y; 258 | PB.Z := P0.Z + B * U.Z; 259 | DV2 := DistSquaredFloat3D(Orig[i], PB); 260 | end; 261 | end; 262 | 263 | // test with current max distance squared 264 | if DV2 > MaxD2 then 265 | begin 266 | // Orig[i] is a new max vertex 267 | MaxI := i; 268 | MaxD2 := DV2; 269 | end; 270 | end; 271 | 272 | // If the furthest point is outside tolerance we must split 273 | if MaxD2 > Tol2 then 274 | begin // error is worse than the tolerance 275 | 276 | // split the polyline at the farthest vertex from S 277 | Marker[MaxI] := True; // mark Orig[maxi] for the simplified polyline 278 | 279 | // recursively simplify the two subpolylines at Orig[maxi] 280 | SimplifyFloat3D(Tol2, Orig, Marker, j, MaxI); // polyline Orig[j] to Orig[maxi] 281 | SimplifyFloat3D(Tol2, Orig, Marker, MaxI, k); // polyline Orig[maxi] to Orig[k] 282 | end; 283 | end; 284 | 285 | function VecMinInt2D(const A, B: TPoint): TPoint; 286 | // Result = A - B 287 | begin 288 | Result.X := A.X - B.X; 289 | Result.Y := A.Y - B.Y; 290 | end; 291 | 292 | function DotProdInt2D(const A, B: TPoint): TFloat; 293 | // Dotproduct = A * B 294 | begin 295 | Result := A.X * B.X + A.Y * B.Y; 296 | end; 297 | 298 | function NormSquaredInt2D(const A: TPoint): TFloat; 299 | // Square of the norm |A| 300 | begin 301 | Result := A.X * A.X + A.Y * A.Y; 302 | end; 303 | 304 | function DistSquaredInt2D(const A, B: TPoint): TFloat; 305 | // Square of the distance from A to B 306 | begin 307 | Result := NormSquaredInt2D(VecMinInt2D(A, B)); 308 | end; 309 | 310 | procedure SimplifyInt2D(var Tol2: TFloat; const Orig: array of TPoint; var Marker: array of boolean; j, k: integer); 311 | // Simplify polyline in OrigList between j and k. Marker[] will be set to True 312 | // for each point that must be included 313 | var 314 | i, MaxI: integer; // Index at maximum value 315 | MaxD2: TFloat; // Maximum value squared 316 | CU, CW, B: TFloat; 317 | DV2: TFloat; 318 | p0, p1, pB, U, W: TPoint; 319 | begin 320 | // Is there anything to simplify? 321 | if k <= j + 1 then 322 | exit; 323 | 324 | p0 := Orig[j]; 325 | p1 := Orig[k]; 326 | U := VecMinInt2D(p1, p0); // Segment vector 327 | CU := DotProdInt2D(U, U); // Segment length squared 328 | MaxD2 := 0; 329 | MaxI := 0; 330 | 331 | // Loop through points and detect the one furthest away 332 | for i := j + 1 to k - 1 do 333 | begin 334 | W := VecMinInt2D(Orig[i], p0); 335 | CW := DotProdInt2D(W, U); 336 | 337 | // Distance of point Orig[i] from segment 338 | if CW <= 0 then 339 | begin 340 | // Before segment 341 | DV2 := DistSquaredInt2D(Orig[i], p0) 342 | end 343 | else 344 | begin 345 | if CW > CU then 346 | begin 347 | // Past segment 348 | DV2 := DistSquaredInt2D(Orig[i], p1); 349 | end 350 | else 351 | begin 352 | // Fraction of the segment 353 | if CU=0 then 354 | B := 0 355 | else 356 | B := CW / CU; 357 | pB.X := round(p0.X + B * U.X); 358 | pB.Y := round(p0.Y + B * U.Y); 359 | DV2 := DistSquaredInt2D(Orig[i], pB); 360 | end; 361 | end; 362 | 363 | // test with current max distance squared 364 | if DV2 > MaxD2 then 365 | begin 366 | // Orig[i] is a new max vertex 367 | MaxI := i; 368 | MaxD2 := DV2; 369 | end; 370 | end; 371 | 372 | // If the furthest point is outside tolerance we must split 373 | if MaxD2 > Tol2 then 374 | begin // error is worse than the tolerance 375 | 376 | // split the polyline at the farthest vertex from S 377 | Marker[MaxI] := True; // mark Orig[maxi] for the simplified polyline 378 | 379 | // recursively simplify the two subpolylines at Orig[maxi] 380 | SimplifyInt2D(Tol2, Orig, Marker, j, MaxI); // polyline Orig[j] to Orig[maxi] 381 | SimplifyInt2D(Tol2, Orig, Marker, MaxI, k); // polyline Orig[maxi] to Orig[k] 382 | 383 | end; 384 | end; 385 | 386 | function PolySimplifyFloat2D(Tol: TFloat; const Orig: array of TPointFloat2D; var Simple: TFloat2DPointAr): integer; 387 | var 388 | i, N: integer; 389 | MarkerAr: array of boolean; 390 | Tol2: TFloat; 391 | begin 392 | Result := 0; 393 | if length(Orig) < 2 then 394 | exit; 395 | Tol2 := sqr(Tol); 396 | 397 | // Create a marker array 398 | N := length(Orig); 399 | SetLength(MarkerAr, N); 400 | // Include first and last point 401 | MarkerAr[0] := True; 402 | MarkerAr[N - 1] := True; 403 | // Exclude intermediate for now 404 | for i := 1 to N - 2 do 405 | MarkerAr[i] := False; 406 | 407 | // Simplify 408 | SimplifyFloat2D(Tol2, Orig, MarkerAr, 0, N - 1); 409 | 410 | // prepare output list 411 | SetLength(Simple, N); 412 | for i := 0 to N - 1 do 413 | begin 414 | if MarkerAr[i] then 415 | begin 416 | Simple[Result] := Orig[i]; 417 | inc(Result); 418 | end; 419 | end; 420 | // crop output list 421 | SetLength(Simple, Result); 422 | end; 423 | 424 | function PolySimplifyFloat3D(Tol: TFloat; const Orig: array of TPointFloat3D; var Simple: TFloat3DPointAr): integer; 425 | var 426 | i, N: integer; 427 | Marker: array of boolean; 428 | Tol2: TFloat; 429 | begin 430 | Result := 0; 431 | if length(Orig) < 2 then 432 | exit; 433 | Tol2 := sqr(Tol); 434 | 435 | // Create a marker array 436 | N := length(Orig); 437 | SetLength(Marker, N); 438 | // Include first and last point 439 | Marker[0] := True; 440 | Marker[N - 1] := True; 441 | // Exclude intermediate for now 442 | for i := 1 to N - 2 do 443 | Marker[i] := False; 444 | 445 | // Simplify 446 | SimplifyFloat3D(Tol2, Orig, Marker, 0, N - 1); 447 | 448 | // prepare output list 449 | SetLength(Simple, N); 450 | for i := 0 to N - 1 do 451 | begin 452 | if Marker[i] then 453 | begin 454 | Simple[Result] := Orig[i]; 455 | inc(Result); 456 | end; 457 | end; 458 | // crop output list 459 | SetLength(Simple, Result); 460 | end; 461 | 462 | function PolySimplifyInt2D(Tol: TFloat; const Orig: array of TPoint; var Simple: TInt2dPointAr): integer; 463 | var 464 | i, N: integer; 465 | Marker: array of boolean; 466 | Tol2: TFloat; 467 | begin 468 | Result := 0; 469 | if length(Orig) < 2 then 470 | exit; 471 | Tol2 := sqr(Tol); 472 | 473 | // Create a marker array 474 | N := length(Orig); 475 | SetLength(Marker, N); 476 | // Include first and last point 477 | Marker[0] := True; 478 | Marker[N - 1] := True; 479 | // Exclude intermediate for now 480 | for i := 1 to N - 2 do 481 | Marker[i] := False; 482 | 483 | // Simplify 484 | SimplifyInt2D(Tol2, Orig, Marker, 0, N - 1); 485 | 486 | // Copy to resulting list 487 | 488 | // prepare output list 489 | SetLength(Simple, N); 490 | for i := 0 to N - 1 do 491 | begin 492 | if Marker[i] then 493 | begin 494 | Simple[Result] := Orig[i]; 495 | inc(Result); 496 | end; 497 | end; 498 | // crop output list 499 | SetLength(Simple, Result); 500 | end; 501 | 502 | end. 503 | -------------------------------------------------------------------------------- /source/DelphiMaps.GeoCoder.pas: -------------------------------------------------------------------------------- 1 | unit DelphiMaps.GeoCoder; 2 | 3 | interface 4 | 5 | uses 6 | Classes, 7 | SysUtils, 8 | Generics.Collections, 9 | DelphiMaps.GeoCoderXML, 10 | DelphiMaps.GoogleMaps; 11 | 12 | type 13 | EGeoCoding = Exception; 14 | 15 | TAddressRec=record 16 | StreetName:String; 17 | HouseNumer:String; 18 | City:String; 19 | ZipCode:string; 20 | Province:String; 21 | Country:String; 22 | Lat:Double; 23 | Lon:Double; 24 | FormattedName:string; 25 | procedure ReverseGeoCode; 26 | procedure GeoCode(aFormattedName:String=''); 27 | private 28 | procedure LoadFromXML(XMLGeocodeResponseType: IXMLGeocodeResponseType); 29 | procedure LoadFromXMLFile(aFileName: string); 30 | public 31 | procedure init; 32 | end; 33 | 34 | TGeocoderStatus= 35 | ( 36 | ERROR , // There was a problem contacting the Google servers. 37 | INVALID_REQUEST , // This GeocoderRequest was invalid. 38 | OK , // The response contains a valid GeocoderResponse. 39 | OVER_QUERY_LIMIT, // The webpage has gone over the requests limit in too short a period of time. 40 | REQUEST_DENIED , // The webpage is not allowed to use the geocoder. 41 | UNKNOWN_ERROR , // A geocoding request could not be processed due to a server error. The request may succeed if you try again. 42 | ZERO_RESULTS // No result was found for this GeocoderRequest. 43 | ); 44 | 45 | TGeocoderRequest=record 46 | Address : string ; // Address. Optional. 47 | Bounds : TGLatLngBounds; // LatLngBounds within which to search. Optional. 48 | Language : string ; // Preferred language for results. Optional. 49 | Location : TGLatLng ; // LatLng about which to search. Optional. 50 | Region : string ; // Country code top-level domain within which to search. Optional. 51 | end; 52 | 53 | TGeocoderAddressComponent = record 54 | long_name : string ; // The full text of the address component 55 | short_name : string ; // The abbreviated, short text of the given address component 56 | types : TStringList ; // An array of strings denoting the type of this address component 57 | end; 58 | 59 | TGeocoderGeometry = record 60 | 61 | end; 62 | 63 | TGeocoderResult=record 64 | address_components : Array of TGeocoderAddressComponent; // An array of GeocoderAddressComponents 65 | geometry : TGeocoderGeometry; // A GeocoderGeometry object 66 | types : TStringList; 67 | end; 68 | 69 | TGeoCoderCallBack = reference to procedure(Results:Array of TGeoCoderResult;Status:TGeocoderStatus); 70 | 71 | TGeoCoder=class 72 | class procedure GeoCode(const Request:TGeocoderRequest;const CallBack:TGeoCoderCallBack); 73 | end; 74 | 75 | function AddressToLatLon(const aAddress:string):TGLatLng; 76 | 77 | implementation 78 | 79 | uses 80 | IoUtils, StrUtils, ExtActns; 81 | 82 | resourcestring 83 | GeoCodingBaseURL='http://maps.google.com/maps/geo?q='; 84 | 85 | function AddressToLatLon(const aAddress:string):TGLatLng; 86 | var 87 | LocalURL, 88 | LocalURLAddress:String; 89 | SL:TStringList; 90 | // Accuracy:Integer; 91 | Download:TDownLoadURL; 92 | const 93 | GeoCodingBaseURL='http://maps.google.com/maps/geo?q='; 94 | // GeoCodingBaseURL='http://maps.google.com/maps/api/geocode/json?address='; 95 | begin 96 | Result := nil; 97 | LocalURLAddress := Trim(aAddress); 98 | LocalURLAddress := ReplaceStr(LocalURLAddress,' ','+'); 99 | LocalURLAddress := ReplaceStr(LocalURLAddress,#13,','); 100 | LocalURLAddress := ReplaceStr(LocalURLAddress,#10,''); 101 | LocalURL := GeoCodingBaseURL + LocalURLAddress + '&output=csv&sensor=false'; 102 | Download := TDownLoadURL.Create(nil); 103 | try 104 | Download.URL := LocalURL; 105 | Download.Filename := TPath.GetTempPath + 'GeoCodingResult.xml'; 106 | Download.ExecuteTarget(nil); 107 | 108 | Assert(FileExists(Download.Filename)); 109 | SL := TStringList.Create; 110 | try 111 | SL.Delimiter := ','; 112 | SL.StrictDelimiter := True; 113 | SL.DelimitedText := TFile.ReadAllText(Download.Filename); 114 | 115 | if(SL[0]<>'200') then 116 | raise EGeoCoding.Create('Geocoding: server reported error #'+SL[0]); 117 | 118 | if SL.Count<4 then 119 | raise EGeoCoding.Create('Geocoding: unexpected number of fields in result'); 120 | 121 | // Accuracy := StrToInt(SL[1]); 122 | FormatSettings.DecimalSeparator := '.'; 123 | Result := TGLatLng.Create(StrToFloat(SL[2]),StrToFloat(SL[3])); 124 | finally 125 | FreeAndNil(SL); 126 | end; 127 | finally 128 | FreeAndNil(Download); 129 | end; 130 | 131 | end; 132 | 133 | 134 | { TGeoCoder } 135 | 136 | class procedure TGeoCoder.GeoCode(const Request: TGeocoderRequest; 137 | const CallBack: TGeoCoderCallBack); 138 | var 139 | GeocoderResult:TGeocoderresult; 140 | AddressRec:TAddressrec; 141 | begin 142 | AddressRec.FormattedName := Request.Address; 143 | AddressRec.GeoCode; 144 | 145 | SetLength(GeocoderResult.address_components,1); 146 | GeocoderResult.address_components[0].long_name := AddressRec.FormattedName; 147 | GeocoderResult.address_components[0].short_name := AddressRec.FormattedName; 148 | 149 | 150 | CallBack([GeocoderResult],OK); 151 | end; 152 | 153 | { TAddressRec } 154 | 155 | procedure TAddressRec.GeoCode(aFormattedName:String=''); 156 | var 157 | LocalURL, 158 | LocalURLAddress:String; 159 | LFileName:String; 160 | LDownload:TDownLoadURL; 161 | const 162 | GeoCodingBaseURL='http://maps.google.com/maps/api/geocode/xml?address=%s&sensor=false'; 163 | begin 164 | if aFormattedName<>'' then 165 | FormattedName := aFormattedName; 166 | 167 | LocalURLAddress := Trim(FormattedName); 168 | LocalURLAddress := ReplaceStr(LocalURLAddress,' ','+'); 169 | LocalURLAddress := ReplaceStr(LocalURLAddress,#13,','); 170 | LocalURLAddress := ReplaceStr(LocalURLAddress,#10,''); 171 | LocalURL := Format( GeoCodingBaseURL, [LocalURLAddress]); 172 | 173 | // ForceDirectories(ExpandFileName('GeoCoding')); 174 | // LFileName:='Geocoding\'+ReplaceStr(ReplaceStr(LocalURLAddress,'+','_'),',','_')+'.xml'; 175 | LFileName := TPath.GetTempFileName; 176 | TFile.Delete(LFileName); 177 | LDownload := TDownLoadURL.Create(nil); 178 | try 179 | LDownload.URL := LocalURL; 180 | ForceDirectories( ExtractFilePath(LFileName) ); 181 | LDownload.Filename := LFileName; 182 | LDownload.ExecuteTarget(nil); 183 | finally 184 | FreeAndNil(LDownload); 185 | end; 186 | LoadFromXMLFile(LFileName); 187 | 188 | end; 189 | 190 | procedure TAddressRec.init; 191 | begin 192 | Initialize(Self); 193 | end; 194 | 195 | procedure TAddressRec.LoadFromXML(XMLGeocodeResponseType: IXMLGeocodeResponseType); 196 | begin 197 | if XMLGeocodeResponseType.Result.Count=0 then 198 | Exit; 199 | 200 | 201 | FormattedName := XMLGeocodeResponseType.Result[0].Formatted_address; 202 | Lat := XMLGeocodeResponseType.Result[0].Geometry.Location.Lat / 10000000; 203 | Lon := XMLGeocodeResponseType.Result[0].Geometry.Location.Lng / 10000000; 204 | 205 | // if XMLGeocodeResponseType.Result[0].Address_component.Count>0 then 206 | // HouseNumer := XMLGeocodeResponseType.Result[0].Address_component[0].Long_name; 207 | // if XMLGeocodeResponseType.Result[0].Address_component.Count>1 then 208 | // StreetName := XMLGeocodeResponseType.Result[0].Address_component[1].Long_name; 209 | // if XMLGeocodeResponseType.Result[0].Address_component.Count>2 then 210 | // City := XMLGeocodeResponseType.Result[0].Address_component[3].Long_name; 211 | // if XMLGeocodeResponseType.Result[0].Address_component.Count>3 then 212 | // Province := XMLGeocodeResponseType.Result[0].Address_component[4].Long_name; 213 | // if XMLGeocodeResponseType.Result[0].Address_component.Count>4 then 214 | // Country := XMLGeocodeResponseType.Result[0].Address_component[5].Long_name; 215 | // if XMLGeocodeResponseType.Result[0].Address_component.Count>5 then 216 | // ZipCode := XMLGeocodeResponseType.Result[0].Address_component[6].Long_name; 217 | end; 218 | 219 | procedure TAddressRec.LoadFromXMLFile(aFileName: string); 220 | var 221 | XMLGeocodeResponseType: IXMLGeocodeResponseType; 222 | begin 223 | XMLGeocodeResponseType := LoadGeocodeResponse(aFileName); 224 | LoadFromXML(XMLGeocodeResponseType); 225 | TFile.Delete(aFileName); 226 | end; 227 | 228 | 229 | 230 | procedure TAddressRec.ReverseGeoCode; 231 | var 232 | LocalURL, 233 | LocalURLAddress:String; 234 | LFileName:String; 235 | LDownload:TDownLoadURL; 236 | const 237 | GeoCodingBaseURL='http://maps.google.com/maps/api/geocode/xml?latlng=%.8f,%.8f&sensor=false'; 238 | begin 239 | LocalURLAddress := Trim(FormattedName); 240 | LocalURLAddress := ReplaceStr(LocalURLAddress,' ','+'); 241 | LocalURLAddress := ReplaceStr(LocalURLAddress,#13,','); 242 | LocalURLAddress := ReplaceStr(LocalURLAddress,#10,''); 243 | {$IFDEF VER220}FormatSettings.{$ENDIF}DecimalSeparator := '.'; 244 | LocalURL := Format( GeoCodingBaseURL, [Lat,Lon]); 245 | 246 | ForceDirectories('GeoCoding'); 247 | LFileName:='Geocoding\'+ReplaceStr(ReplaceStr(LocalURLAddress,'+','_'),',','_')+'.xml'; 248 | if not FileExists(LFileName) then 249 | begin 250 | LDownload := TDownLoadURL.Create(nil); 251 | try 252 | LDownload.URL := LFileName; 253 | LDownload.Filename := LocalURL; 254 | LDownload.ExecuteTarget(nil); 255 | finally 256 | FreeAndNil(LDownload); 257 | end; 258 | end; 259 | LoadFromXMLFile(LFileName); 260 | 261 | end; 262 | 263 | end. 264 | -------------------------------------------------------------------------------- /source/DelphiMaps.GoogleDirections.pas: -------------------------------------------------------------------------------- 1 | unit DelphiMaps.GoogleDirections; 2 | 3 | interface 4 | 5 | uses 6 | Classes, 7 | Generics.Collections, 8 | DelphiMaps.GoogleMaps, 9 | DelphiMaps.GoogleDirectionsXML, 10 | DelphiMaps.Location; 11 | 12 | type 13 | IDirections = DelphiMaps.GoogleDirectionsXML.IXMLDirectionsResponseType; 14 | 15 | // hen you calculate directions, you need to specify which transportation mode to use. 16 | // The following travel modes are currently supported: 17 | // 18 | // Note: Walking directions may sometimes not include clear pedestrian paths, 19 | // so walking directions will return warnings in the DirectionsResult which 20 | // you must display if you are not using the default DirectionsRenderer. 21 | TDirectionsTravelMode = (DRIVING, // Indicates standard driving directions using the road network. 22 | WALKING, // requests walking directions via pedestrian paths & sidewalks (where available). 23 | BICYCLING // BICYCLING requests bicycling directions via bicycle paths & preferred streets (currently only available in the US) 24 | ); 25 | 26 | 27 | 28 | // By default, directions are calculated and displayed using the unit system of 29 | // the origin's country or region. (Note: origins expressed using 30 | // latitude/longitude coordinates rather than addresses always default to metric 31 | // units.) For example, a route from "Chicago, IL" to "Toronto, ONT" will 32 | // display results in miles, while the reverse route will display results 33 | // in kilometers. You may override this unit system by setting one explicitly 34 | // within the request using one of the following DirectionsUnitSystem values: 35 | // 36 | // Note: this unit system setting only affects the text displayed to the user. 37 | // The directions result also contains distance values, not shown to the user, 38 | // which are always expressed in meters. 39 | TDirectionsUnitSystem = (METRIC, // specifies usage of the metric system. Distances are shown using kilometers. 40 | IMPERIAL // specifies usage of the Imperial (English) system. Distances are shown using miles. 41 | ); 42 | 43 | 44 | 45 | TDirectionsWaypoint = class 46 | Point:TLocation; 47 | end; 48 | 49 | TWayPoints=class(TList) 50 | function ToString:string; override; 51 | end; 52 | 53 | TGoogleDirectionsRequest = class(TComponent) 54 | private 55 | Fdestination: TLocation; 56 | FprovideRouteAlternatives: Boolean; 57 | Forigin: TLocation; 58 | Fwaypoints: TWayPoints; 59 | FoptimizeWaypoints: Boolean; 60 | FtravelMode: TDirectionsTravelMode; 61 | FunitSystem: TDirectionsUnitSystem; 62 | FavoidHighways: Boolean; 63 | Fregion: String; 64 | FavoidTolls: Boolean; 65 | procedure SetavoidHighways(const Value: Boolean); 66 | procedure SetavoidTolls(const Value: Boolean); 67 | procedure Setdestination(const Value: TLocation); 68 | procedure SetoptimizeWaypoints(const Value: Boolean); 69 | procedure Setorigin(const Value: TLocation); 70 | procedure SetprovideRouteAlternatives(const Value: Boolean); 71 | procedure Setregion(const Value: String); 72 | procedure SettravelMode(const Value: TDirectionsTravelMode); 73 | procedure SetunitSystem(const Value: TDirectionsUnitSystem); 74 | procedure Setwaypoints(const Value: TWayPoints); 75 | function GetURL: String; 76 | public 77 | constructor Create(AOwner: TComponent); override; 78 | destructor Destroy; override; 79 | 80 | published 81 | property Origin: TLocation read Forigin write Setorigin; // (required) specifies the start location from which to calculate directions. This value may either be specified as a String (e.g. "Chicago, IL") or as a LatLng value. 82 | property Destination: TLocation read Fdestination write Setdestination; // (required) specifies the end location to which to calculate directions. This value may either be specified as a String (e.g. "Chicago, IL") or as a LatLng value. 83 | property TravelMode: TDirectionsTravelMode read FtravelMode write SettravelMode; // (required) specifies what mode of transport to use when calculating directions. Valid values are specified in Travel Modes below. 84 | property UnitSystem: TDirectionsUnitSystem read FunitSystem write SetunitSystem; // (optional) specifies what unit system to use when displaying results. Valid values are specified in Unit Systems below. 85 | property Waypoints: TWayPoints read Fwaypoints write Setwaypoints; // (optional) specifies an array of DirectionsWaypoints. Waypoints alter a route by routing it through the specified location(s). A waypoint is specified as an object literal with fields shown below: 86 | property OptimizeWaypoints: Boolean read FoptimizeWaypoints write SetoptimizeWaypoints; // (optional) specifies that the route using the supplied waypoints may be optimized to provide the shortest possible route. If true, the Directions service will return the reordered waypoints in an waypoint_order field 87 | property ProvideRouteAlternatives: Boolean read FprovideRouteAlternatives write SetprovideRouteAlternatives; // (optional) when set to true specifies that the Directions service may provide more than one route alternative in the response. Note that providing route alternatives may increase the response time from the server. 88 | property AvoidHighways: Boolean read FavoidHighways write SetavoidHighways; // (optional) when set to true indicates that the calculated route(s) should avoid major highways, if possible. 89 | property AvoidTolls: Boolean read FavoidTolls write SetavoidTolls; // (optional) when set to true indicates that the calculated route(s) should avoid toll roads, if possible. 90 | property Region: String read Fregion write Setregion; // (optional) specifies the region code, specified as a ccTLD ("top-level domain") two-character value. 91 | 92 | property URL:String read GetURL; 93 | 94 | function GetResponse:IDirections; 95 | end; 96 | 97 | 98 | 99 | implementation 100 | 101 | uses 102 | WinInet, 103 | XmlDoc, 104 | XmlIntf, 105 | TypInfo, 106 | SysUtils; 107 | 108 | function HttpGet(url:string):String; 109 | var 110 | databuffer : array[0..4095] of AnsiChar; 111 | ResStr : AnsiString; 112 | hSession, hfile: hInternet; 113 | dwindex,dwcodelen,dwread,dwNumber:cardinal; 114 | dwcode : array[1..20] of Ansichar; 115 | res : pChar; 116 | Str : pAnsiChar; 117 | begin 118 | ResStr := ''; 119 | if pos('http://',lowercase(url))=0 then 120 | url := 'http://'+url; 121 | 122 | hSession := InternetOpen('InetURL:/1.0', INTERNET_OPEN_TYPE_PRECONFIG,nil, nil, 0); 123 | try 124 | if assigned(hsession) then 125 | begin 126 | hfile := InternetOpenUrl(hsession,pchar(url),nil,0,INTERNET_FLAG_RELOAD,0); 127 | dwIndex := 0; 128 | dwCodeLen := 10; 129 | HttpQueryInfo(hfile, HTTP_QUERY_STATUS_CODE, @dwcode, dwcodeLen, dwIndex); 130 | res := pChar(@dwcode); 131 | dwNumber := sizeof(databuffer)-1; 132 | 133 | // res=200 means that everything went ok.. 134 | // see http://www.w3.org/Protocols/rfc2616/rfc2616-sec10.html 135 | 136 | if (res ='200') or (res ='302') then 137 | begin 138 | while (InternetReadfile(hfile,@databuffer,dwNumber,DwRead)) do 139 | begin 140 | if dwRead =0 then 141 | break; 142 | databuffer[dwread]:=#0; 143 | Str := pAnsiChar(@databuffer); 144 | resStr := resStr + Str; 145 | end; 146 | end 147 | else 148 | raise Exception.CreateFmt('Http error %s',[Res]); 149 | 150 | if assigned(hfile) then 151 | InternetCloseHandle(hfile); 152 | end; 153 | finally 154 | InternetCloseHandle(hsession); 155 | end; 156 | Result := String(resStr); 157 | end; 158 | 159 | 160 | { TGoogleDirectionsRequest } 161 | 162 | constructor TGoogleDirectionsRequest.Create(AOwner: TComponent); 163 | begin 164 | inherited; 165 | Forigin := TLocation.Create; 166 | Fdestination := TLocation.Create; 167 | Fwaypoints := TWayPoints.Create; 168 | 169 | end; 170 | 171 | destructor TGoogleDirectionsRequest.Destroy; 172 | begin 173 | FreeAndNil(Forigin); 174 | FreeAndNil(Fdestination); 175 | FreeAndNil(Fwaypoints); 176 | inherited; 177 | end; 178 | 179 | function TGoogleDirectionsRequest.GetResponse: IDirections; 180 | var 181 | doc:IXMLDocument; 182 | LURL:string; 183 | XML : String; 184 | begin 185 | doc := TXMLDocument.Create(nil); 186 | LURL := GetURL; 187 | XML := HttpGet(LURL); 188 | doc.XML.Text := XML; 189 | Result := GetDirectionsResponse(doc); 190 | end; 191 | 192 | function TGoogleDirectionsRequest.GetURL: String; 193 | var 194 | SB:TStringBuilder; 195 | begin 196 | SB := TStringBuilder.Create; 197 | try 198 | SB.Append('http://maps.googleapis.com/maps/api/directions/xml?sensor=false'); 199 | SB.Append('&origin='); SB.Append(Forigin.ToString); 200 | SB.Append('&destination='); SB.Append(Fdestination.ToString); 201 | SB.Append('&travelMode='); SB.Append(GetEnumName(TypeInfo(TDirectionsTravelMode),ord(TravelMode))); 202 | SB.Append('&unitSystem='); SB.Append(GetEnumName(TypeInfo(TDirectionsUnitSystem),ord(UnitSystem))); 203 | SB.Append('&waypoints='); SB.Append(Waypoints); 204 | SB.Append('&optimizeWaypoints='); SB.Append(OptimizeWaypoints); 205 | SB.Append('&provideRouteAlternatives='); SB.Append(ProvideRouteAlternatives); 206 | SB.Append('&avoidHighways='); SB.Append(AvoidHighways); 207 | SB.Append('&avoidTolls='); SB.Append(AvoidTolls); 208 | SB.Append('®ion='); SB.Append(Region); 209 | Result := SB.ToString; 210 | finally 211 | SB.Free; 212 | end; 213 | end; 214 | 215 | procedure TGoogleDirectionsRequest.SetavoidHighways(const Value: Boolean); 216 | begin 217 | FavoidHighways := Value; 218 | end; 219 | 220 | procedure TGoogleDirectionsRequest.SetavoidTolls(const Value: Boolean); 221 | begin 222 | FavoidTolls := Value; 223 | end; 224 | 225 | procedure TGoogleDirectionsRequest.Setdestination(const Value: TLocation); 226 | begin 227 | Fdestination := Value; 228 | end; 229 | 230 | procedure TGoogleDirectionsRequest.SetoptimizeWaypoints(const Value: Boolean); 231 | begin 232 | FoptimizeWaypoints := Value; 233 | end; 234 | 235 | procedure TGoogleDirectionsRequest.Setorigin(const Value: TLocation); 236 | begin 237 | Forigin := Value; 238 | end; 239 | 240 | procedure TGoogleDirectionsRequest.SetprovideRouteAlternatives(const Value: Boolean); 241 | begin 242 | FprovideRouteAlternatives := Value; 243 | end; 244 | 245 | procedure TGoogleDirectionsRequest.Setregion(const Value: String); 246 | begin 247 | Fregion := Value; 248 | end; 249 | 250 | procedure TGoogleDirectionsRequest.SettravelMode(const Value: TDirectionsTravelMode); 251 | begin 252 | FtravelMode := Value; 253 | end; 254 | 255 | procedure TGoogleDirectionsRequest.SetunitSystem(const Value: TDirectionsUnitSystem); 256 | begin 257 | FunitSystem := Value; 258 | end; 259 | 260 | procedure TGoogleDirectionsRequest.Setwaypoints(const Value: TWayPoints); 261 | begin 262 | Fwaypoints := Value; 263 | end; 264 | 265 | { TWayPoints } 266 | 267 | function TWayPoints.ToString: string; 268 | begin 269 | Result := ''; 270 | end; 271 | 272 | end. 273 | 274 | -------------------------------------------------------------------------------- /source/DelphiMaps.GoogleMaps.dcr: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/WouterVanNifterick/delphi-maps/b16f46d3c99642d32c660d6632d4c1d2da572a9c/source/DelphiMaps.GoogleMaps.dcr -------------------------------------------------------------------------------- /source/DelphiMaps.GoogleMaps.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 11 | 14 | 29 | 30 | 31 |

32 | 33 | 34 | -------------------------------------------------------------------------------- /source/DelphiMaps.GoogleMaps_html.rc: -------------------------------------------------------------------------------- 1 | GOOGLE_MAPS_HTML RCDATA "DelphiMaps.GoogleMaps.html" 2 | -------------------------------------------------------------------------------- /source/DelphiMaps.GoogleMaps_html.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/WouterVanNifterick/delphi-maps/b16f46d3c99642d32c660d6632d4c1d2da572a9c/source/DelphiMaps.GoogleMaps_html.res -------------------------------------------------------------------------------- /source/DelphiMaps.LayerList.pas: -------------------------------------------------------------------------------- 1 | {**************************************************************************************************} 2 | { The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } 3 | { you may not use this file except in compliance with the License. You may obtain a copy of the } 4 | { License at http://www.mozilla.org/MPL/ } 5 | { } 6 | { Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } 7 | { ANY KIND, either express or implied. See the License for the specific language governing rights } 8 | { and limitations under the License. } 9 | { } 10 | { The Original Code is DelphiMaps.LayerList.pas } 11 | { } 12 | { The Initial Developer of the Original Code is Wouter van Nifterick } 13 | { (wouter_van_nifterick@hotmail.com. } 14 | {**************************************************************************************************} 15 | 16 | unit DelphiMaps.LayerList; 17 | 18 | interface 19 | 20 | uses 21 | Classes, 22 | Menus, 23 | CheckLst, 24 | DelphiMaps.GoogleMaps, 25 | ComCtrls, 26 | Controls; 27 | 28 | type 29 | TGoogleMapsLayersList=class(TTreeView) 30 | private 31 | FGoogleMaps:TGoogleMaps; 32 | miZoomtoOverlay1:TMenuItem; 33 | public 34 | Constructor Create(AOwner:TComponent);override; 35 | procedure Update; override; 36 | procedure miDeleteoverlay1Click(Sender: TObject); 37 | procedure miZoomtoOverlay1Click(Sender: TObject); 38 | procedure PopupMenu1Popup(Sender: TObject); 39 | procedure OnDoubleClick(Sender: TObject); 40 | published 41 | property GoogleMaps:TGoogleMaps read FGoogleMaps write FGoogleMaps; 42 | end; 43 | 44 | implementation 45 | 46 | 47 | { TGoogleMapsLayersList } 48 | 49 | constructor TGoogleMapsLayersList.Create(AOwner: TComponent); 50 | var 51 | Mi:TMenuItem; 52 | begin 53 | inherited; 54 | 55 | PopupMenu := TPopupMenu.Create(self); 56 | PopupMenu.OnPopup := PopupMenu1Popup; 57 | 58 | Mi := TMenuItem.Create(PopupMenu); 59 | Mi.Caption := '&Delete overlay'; 60 | Mi.OnClick := miDeleteoverlay1Click; 61 | PopupMenu.Items.Add(Mi); 62 | 63 | miZoomtoOverlay1 := TMenuItem.Create(PopupMenu); 64 | miZoomtoOverlay1 .Caption := '&Zoom to Overlay'; 65 | miZoomtoOverlay1 .OnClick := miZoomtoOverlay1Click; 66 | miZoomtoOverlay1 .Name := 'miZoomtoOverlay1'; 67 | 68 | self.OnDblClick := OnDoubleClick; 69 | end; 70 | 71 | procedure TGoogleMapsLayersList.OnDoubleClick(Sender: TObject); 72 | begin 73 | miZoomtoOverlay1Click(Sender); 74 | end; 75 | 76 | procedure TGoogleMapsLayersList.miDeleteoverlay1Click(Sender: TObject); 77 | begin 78 | inherited; 79 | if not Assigned(Selected) then 80 | Exit; 81 | 82 | 83 | 84 | if Selected.Index < 0 then Exit; 85 | 86 | if Selected.Index < FGoogleMaps.Overlays.Count then 87 | begin 88 | FGoogleMaps.RemoveOverlayByIndex(Selected.Index); 89 | Update; 90 | end; 91 | end; 92 | 93 | procedure TGoogleMapsLayersList.miZoomtoOverlay1Click(Sender: TObject); 94 | begin 95 | if not Assigned(Selected) then 96 | Exit; 97 | 98 | if Selected.Index < 0 then 99 | Exit; 100 | 101 | if Selected.Index < FGoogleMaps.Overlays.Count then 102 | begin 103 | if FGoogleMaps.Overlays[Selected.Index].JsClassName='GGeoXml' then 104 | TGGeoXml(FGoogleMaps.Overlays[Selected.Index]).gotoDefaultViewport(FGoogleMaps); 105 | end; 106 | end; 107 | 108 | procedure TGoogleMapsLayersList.PopupMenu1Popup(Sender: TObject); 109 | begin 110 | if not Assigned(Selected) then 111 | Exit; 112 | 113 | if Selected.Index < 0 then 114 | Exit; 115 | 116 | if Selected.Index < FGoogleMaps.Overlays.Count then 117 | miZoomtoOverlay1.Enabled := FGoogleMaps.Overlays[Selected.Index].JsClassName='GGeoXml'; 118 | end; 119 | 120 | procedure TGoogleMapsLayersList.Update; 121 | begin 122 | if not Assigned(FGoogleMaps) then 123 | Exit; 124 | 125 | 126 | Text := FGoogleMaps.Overlays.ToString; 127 | end; 128 | 129 | end. 130 | -------------------------------------------------------------------------------- /source/DelphiMaps.Location.pas: -------------------------------------------------------------------------------- 1 | unit DelphiMaps.Location; 2 | 3 | interface 4 | 5 | uses 6 | DelphiMaps.GoogleMaps, 7 | Classes; 8 | 9 | type 10 | 11 | TLocationType = (ltCoordinates, ltText); 12 | 13 | TLocation = class 14 | private 15 | FText: String; 16 | FPosition: TGLatLng; 17 | FOnChange: TNotifyEvent; 18 | FLocationType: TLocationType; 19 | procedure SetText(const Value: String); 20 | procedure SetPosition(const Value: TGLatLng); 21 | procedure SetOnChange(const Value: TNotifyEvent); 22 | procedure SetLocationType(const Value: TLocationType); 23 | procedure DoOnChange; 24 | public 25 | function ToString: String; override; 26 | constructor Create;overload; 27 | constructor Create(const aText: String); reintroduce; overload; 28 | constructor Create(aPosition: TGLatLng); reintroduce; overload; 29 | public 30 | property OnChange: TNotifyEvent read FOnChange write SetOnChange; 31 | property Text: String read FText write SetText; 32 | property Position: TGLatLng read FPosition write SetPosition; 33 | property LocationType: TLocationType read FLocationType write SetLocationType default ltText; 34 | end; 35 | 36 | implementation 37 | 38 | uses 39 | SysUtils; 40 | 41 | { TLocation } 42 | 43 | constructor TLocation.Create(const aText: String); 44 | begin 45 | Create; 46 | FLocationType := ltText; 47 | FText := aText; 48 | end; 49 | 50 | constructor TLocation.Create(aPosition: TGLatLng); 51 | begin 52 | Create; 53 | FreeAndNil(FPosition); 54 | FPosition := aPosition; 55 | FLocationType := ltCoordinates; 56 | end; 57 | 58 | constructor TLocation.Create; 59 | begin 60 | inherited; 61 | FPosition := TGLatLng.Create(0,0); 62 | end; 63 | 64 | procedure TLocation.DoOnChange; 65 | begin 66 | if Assigned(FOnChange) then 67 | FOnChange(Self); 68 | end; 69 | 70 | procedure TLocation.SetLocationType(const Value: TLocationType); 71 | begin 72 | if Value = FLocationType then 73 | Exit; 74 | 75 | FLocationType := Value; 76 | DoOnChange; 77 | end; 78 | 79 | procedure TLocation.SetOnChange(const Value: TNotifyEvent); 80 | begin 81 | FOnChange := Value; 82 | end; 83 | 84 | procedure TLocation.SetPosition(const Value: TGLatLng); 85 | begin 86 | if Value.Equals(FPosition) and (FLocationType = ltCoordinates) then 87 | Exit; 88 | 89 | FPosition := Value; 90 | FLocationType := ltCoordinates; 91 | DoOnChange; 92 | end; 93 | 94 | procedure TLocation.SetText(const Value: String); 95 | begin 96 | if (Value = FText) and (FLocationType = ltText) then 97 | Exit; 98 | 99 | FText := Value; 100 | FLocationType := ltText; 101 | DoOnChange; 102 | end; 103 | 104 | function TLocation.ToString: String; 105 | begin 106 | Result := ''; 107 | 108 | if (Text <> '') then 109 | begin 110 | LocationType := ltText; 111 | Exit(Text); 112 | end; 113 | 114 | LocationType := ltCoordinates; 115 | FormatSettings.DecimalSeparator := '.'; 116 | Exit(Format('%g,%g',[FPosition.Lat, FPosition.Lng]); 117 | end; 118 | 119 | end. 120 | -------------------------------------------------------------------------------- /source/DelphiMaps.Register.pas: -------------------------------------------------------------------------------- 1 | {**************************************************************************************************} 2 | { The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } 3 | { you may not use this file except in compliance with the License. You may obtain a copy of the } 4 | { License at http://www.mozilla.org/MPL/ } 5 | { } 6 | { Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } 7 | { ANY KIND, either express or implied. See the License for the specific language governing rights } 8 | { and limitations under the License. } 9 | { } 10 | { The Original Code is DelphiMaps.GoogleMaps.pas } 11 | { } 12 | { The Initial Developer of the Original Code is Wouter van Nifterick } 13 | { (wouter_van_nifterick@hotmail.com. } 14 | {**************************************************************************************************} 15 | unit DelphiMaps.Register; 16 | 17 | interface 18 | 19 | uses Classes; 20 | 21 | procedure Register; 22 | 23 | implementation 24 | 25 | uses 26 | DelphiMaps.Googlemaps, 27 | DelphiMaps.StreetView, 28 | DelphiMaps.LayerList, 29 | DelphiMaps.StaticMap, 30 | DelphiMaps.WebImage, 31 | DelphiMaps.WMS.Client; 32 | 33 | procedure Register; 34 | begin 35 | RegisterComponents('DelphiMaps', [ 36 | TGoogleMaps, 37 | TStreetView, 38 | TGoogleMapsLayersList, 39 | TStaticMap, 40 | TWebImage, 41 | TWmsImage 42 | ]); 43 | end; 44 | 45 | 46 | end. 47 | -------------------------------------------------------------------------------- /source/DelphiMaps.StaticMap.pas: -------------------------------------------------------------------------------- 1 | {**************************************************************************************************} 2 | { The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } 3 | { you may not use this file except in compliance with the License. You may obtain a copy of the } 4 | { License at http://www.mozilla.org/MPL/ } 5 | { } 6 | { Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } 7 | { ANY KIND, either express or implied. See the License for the specific language governing rights } 8 | { and limitations under the License. } 9 | { } 10 | { The Original Code is DelphiMaps.StaticMap.pas } 11 | { } 12 | { The Initial Developer of the Original Code is Wouter van Nifterick } 13 | { (wouter_van_nifterick@hotmail.com. } 14 | {**************************************************************************************************} 15 | unit DelphiMaps.StaticMap; 16 | 17 | interface 18 | 19 | uses 20 | Classes, 21 | Graphics, 22 | Generics.Collections, 23 | DelphiMaps.WebImage, 24 | DelphiMaps.Location, 25 | DelphiMaps.GoogleMaps; 26 | 27 | type 28 | TStaticMapProvider = (mpGoogleMaps, mpOpenStreetMap); 29 | TStaticMapAPIType = (apiGoogleMapsStatic); 30 | 31 | TMapProviderRec = record 32 | Name: String; 33 | ApiType: TStaticMapAPIType; 34 | RootURL: String; 35 | end; 36 | 37 | const 38 | cMapProviders: Array [TStaticMapProvider] of TMapProviderRec = 39 | ( 40 | ( 41 | Name: 'Google Maps'; 42 | ApiType: apiGoogleMapsStatic; 43 | RootURL: 'http://maps.google.com/maps/api/staticmap?' 44 | ), 45 | ( 46 | Name: 'OpenStreetMap'; 47 | ApiType: apiGoogleMapsStatic; 48 | RootURL: 'http://dev.openstreetmap.de/staticmap/staticmap.php?' 49 | ) 50 | ); 51 | 52 | type 53 | TGStaticMapsFormat = (mfPng, // use default png format 54 | mfPng8, // (default) specifies the 8-bit PNG format. 55 | mfPng32, // specifies the 32-bit PNG format. 56 | mfGif, // specifies the GIF format. 57 | mfJpg, // specifies the JPEG compression format. 58 | mfJpg_baseline // specifies a non-progressive JPEG compression format. 59 | ); 60 | 61 | const 62 | GStaticMapsFormatStr: array [TGStaticMapsFormat] of String = ('Png', // use default png format 63 | 'Png8', // (default) specifies the 8-bit PNG format. 64 | 'Png32', // specifies the 32-bit PNG format. 65 | 'Gif', // specifies the GIF format. 66 | 'Jpg', // specifies the JPEG compression format. 67 | 'Jpg-baseline' // specifies a non-progressive JPEG compression format. 68 | ); 69 | 70 | GStaticMapsFormatExt: array [TGStaticMapsFormat] of String = ('png', // use default png format 71 | 'png', // (default) specifies the 8-bit PNG format. 72 | 'png', // specifies the 32-bit PNG format. 73 | 'gif', // specifies the GIF format. 74 | 'jpg', // specifies the JPEG compression format. 75 | 'jpg' // specifies a non-progressive JPEG compression format. 76 | ); 77 | 78 | type 79 | 80 | TStaticPathStyle = class(TComponent) 81 | private 82 | FWeight: Integer; 83 | FColor: TColor; 84 | FTransparency: Byte; 85 | FFillColor: TColor; 86 | procedure SetWeight(const Value: Integer); 87 | procedure SetColor(const Value: TColor); 88 | procedure SetTransparency(const Value: Byte); 89 | procedure SetFillColor(const Value: TColor); 90 | public 91 | constructor Create(AOwner: TComponent); override; 92 | published 93 | 94 | property Weight: Integer read FWeight write SetWeight default -1; 95 | property Color: TColor read FColor write SetColor default clBlue; 96 | property Transparency: Byte read FTransparency write SetTransparency; 97 | property FillColor: TColor read FFillColor write SetFillColor default clNone; 98 | function ToString: String; override; 99 | end; 100 | 101 | TStaticPath = class(TList) 102 | private 103 | FStyle: TStaticPathStyle; 104 | procedure SetStyle(const Value: TStaticPathStyle); 105 | public 106 | function ToString: String; override; 107 | procedure Simplify(Tolerance: Integer); 108 | property Style: TStaticPathStyle read FStyle write SetStyle; 109 | end; 110 | 111 | TStaticPaths = class(TList) 112 | function ToString: String; override; 113 | end; 114 | 115 | TStaticMap = class(TWebImage) 116 | private 117 | FCenter: TLocation; 118 | FMapType: TStaticMapType; 119 | FMarkers: TList; 120 | FZoom: Integer; 121 | FFormat: TGStaticMapsFormat; 122 | FLanguage: String; 123 | FSensor: Boolean; 124 | FPaths: TStaticPaths; 125 | FUpdating:Boolean; 126 | procedure SetMapType(const Value: TStaticMapType); 127 | procedure SetMarkers(const Value: TList); 128 | procedure SetZoom(const Value: Integer); 129 | procedure SetFormat(const Value: TGStaticMapsFormat); 130 | procedure SetLanguage(const Value: String); 131 | procedure SetSensor(const Value: Boolean); 132 | private 133 | FMapProvider: TStaticMapProvider; 134 | function GetMapURL: String; 135 | function GetPaths: TStaticPaths; 136 | procedure SetPaths(const Value: TStaticPaths); 137 | procedure SetMapProvider(const Value: TStaticMapProvider); 138 | function getProviderInfo: TMapProviderRec; 139 | public 140 | destructor Destroy; override; 141 | constructor Create(AOwner: TComponent); override; 142 | procedure BeginUpdate; 143 | procedure Endupdate; 144 | { 145 | property Action; 146 | property ActionLink; 147 | property Align; 148 | property Anchors; 149 | property AutoSize; 150 | property BiDiMode; 151 | property BoundsRect; 152 | property Canvas; 153 | property Caption; 154 | property ClientHeight; 155 | property ClientOrigin; 156 | property ClientRect; 157 | property ClientWidth; 158 | property Color; 159 | property ComObject; 160 | property ComponentCount; 161 | property ComponentIndex; 162 | property ComponentState; 163 | property ComponentStyle; 164 | property Components; 165 | property Constraints; 166 | property ControlState; 167 | property ControlStyle; 168 | property DesignInfo; 169 | property DesktopFont; 170 | property DockOrientation; 171 | property DragCursor; 172 | property DragKind; 173 | property DragMode; 174 | property Enabled; 175 | property ExplicitHeight; 176 | property ExplicitLeft; 177 | property ExplicitTop; 178 | property ExplicitWidth; 179 | property Floating; 180 | property FloatingDockSiteClass; 181 | property Font; 182 | property HostDockSite; 183 | property IsControl; 184 | property LRDockWidth; 185 | property MouseCapture; 186 | property OnCanResize; 187 | property OnClick; 188 | property OnConstrainedResize; 189 | property OnContextPopup; 190 | property OnDblClick; 191 | property OnDragDrop; 192 | property OnDragOver; 193 | property OnEndDock; 194 | property OnEndDrag; 195 | property OnGesture; 196 | property OnMouseActivate; 197 | property OnMouseDown; 198 | property OnMouseEnter; 199 | property OnMouseLeave; 200 | property OnMouseMove; 201 | property OnMouseUp; 202 | property OnMouseWheel; 203 | property OnMouseWheelDown; 204 | property OnMouseWheelUp; 205 | property OnResize; 206 | property OnStartDock; 207 | property OnStartDrag; 208 | property Owner; 209 | property Parent; 210 | property ParentBiDiMode; 211 | property ParentColor; 212 | property ParentFont; 213 | property ParentShowHint; 214 | property PopupMenu; 215 | property ScalingFlags; 216 | property ShowHint; 217 | property TBDockHeight; 218 | property Text; 219 | property Touch; 220 | property UndockHeight; 221 | property UndockWidth; 222 | property VCLComObject; 223 | property Visible; 224 | property WheelAccumulator; 225 | property WindowProc; 226 | property WindowText; 227 | property Stretch; 228 | } 229 | procedure HandleOnCenterChange(Sender:TObject); 230 | 231 | published 232 | property Center: TLocation read FCenter; 233 | property Zoom: Integer read FZoom write SetZoom default 5; 234 | property MapType: TStaticMapType read FMapType write SetMapType; 235 | property Markers: TListread FMarkers write SetMarkers; 236 | property Format: TGStaticMapsFormat read FFormat write SetFormat; 237 | property Language: String read FLanguage write SetLanguage; 238 | property Paths: TStaticPaths read GetPaths write SetPaths; 239 | property Sensor: Boolean read FSensor write SetSensor; 240 | property ProviderInfo: TMapProviderRec read getProviderInfo; 241 | property MapProvider: TStaticMapProvider read FMapProvider write SetMapProvider; 242 | procedure Refresh;override; 243 | end; 244 | 245 | implementation 246 | 247 | uses 248 | SysUtils, 249 | StrUtils; 250 | 251 | 252 | function RGBToColor(R, G, B: Byte): TColor; 253 | begin 254 | Result := B Shl 16 Or G Shl 8 Or R; 255 | end; 256 | 257 | 258 | { TStaticMap } 259 | 260 | procedure TStaticMap.BeginUpdate; 261 | begin 262 | FUpdating := True; 263 | end; 264 | 265 | constructor TStaticMap.Create(AOwner: TComponent); 266 | begin 267 | inherited; 268 | FMarkers := TList.Create; 269 | FPaths := TStaticPaths.Create; 270 | FCenter := TLocation.Create; 271 | FCenter.OnChange := HandleOnCenterChange; 272 | FUpdating := False; 273 | end; 274 | 275 | destructor TStaticMap.Destroy; 276 | begin 277 | FreeAndNil(FMarkers); 278 | FreeAndNil(FPaths); 279 | FreeAndNil(FCenter); 280 | inherited; 281 | end; 282 | 283 | procedure TStaticMap.Endupdate; 284 | begin 285 | FUpdating := False; 286 | Refresh; 287 | end; 288 | 289 | function TStaticMap.GetMapURL: String; 290 | var 291 | LTolerance: Integer; 292 | SB: TStringBuilder; 293 | LPath:TStaticPath; 294 | begin 295 | LTolerance := 0; 296 | SB := TStringBuilder.Create; 297 | 298 | try 299 | repeat 300 | for LPath in Paths do 301 | LPath.Simplify(LTolerance); 302 | SB.Clear; 303 | SB.Append(cMapProviders[MapProvider].RootURL); 304 | SB.Append('sensor=' + ifthen(Sensor, 'true', 'false')); 305 | SB.Append('¢er=' + FCenter.ToString); 306 | SB.Append('&maptype=' + cStaticMapTypeStr[MapType]); 307 | SB.Append(Paths.ToString); 308 | SB.AppendFormat('&size=%dx%d', [Width, Height]); 309 | SB.Append('&zoom='); 310 | SB.Append(Zoom); 311 | Result := SB.ToString; 312 | Inc(LTolerance, 5); 313 | until (Length(Result) < 2000); 314 | finally 315 | SB.Free; 316 | end; 317 | end; 318 | 319 | function TStaticMap.GetPaths: TStaticPaths; 320 | begin 321 | Result := FPaths; 322 | end; 323 | 324 | function TStaticMap.getProviderInfo: TMapProviderRec; 325 | begin 326 | Result := cMapProviders[FMapProvider]; 327 | end; 328 | 329 | procedure TStaticMap.HandleOnCenterChange(Sender:TObject); 330 | begin 331 | Refresh; 332 | end; 333 | 334 | procedure TStaticMap.Refresh; 335 | begin 336 | URL := GetMapURL; 337 | end; 338 | 339 | 340 | procedure TStaticMap.SetFormat(const Value: TGStaticMapsFormat); 341 | begin 342 | FFormat := Value; 343 | Refresh; 344 | end; 345 | 346 | procedure TStaticMap.SetLanguage(const Value: String); 347 | begin 348 | FLanguage := Value; 349 | Refresh; 350 | end; 351 | 352 | procedure TStaticMap.SetMapProvider(const Value: TStaticMapProvider); 353 | begin 354 | FMapProvider := Value; 355 | Refresh; 356 | end; 357 | 358 | procedure TStaticMap.SetMapType(const Value: TStaticMapType); 359 | begin 360 | FMapType := Value; 361 | Refresh; 362 | end; 363 | 364 | procedure TStaticMap.SetMarkers(const Value: TList); 365 | begin 366 | FMarkers := Value; 367 | Refresh; 368 | end; 369 | 370 | procedure TStaticMap.SetPaths(const Value: TStaticPaths); 371 | begin 372 | FPaths := Value; 373 | Refresh; 374 | end; 375 | 376 | procedure TStaticMap.SetSensor(const Value: Boolean); 377 | begin 378 | FSensor := Value; 379 | Refresh; 380 | end; 381 | 382 | procedure TStaticMap.SetZoom(const Value: Integer); 383 | begin 384 | FZoom := Value; 385 | Refresh; 386 | end; 387 | 388 | { TStaticPathStyle } 389 | 390 | constructor TStaticPathStyle.Create(AOwner: TComponent); 391 | begin 392 | inherited; 393 | FWeight := 1; 394 | FColor := clBlue; 395 | FTransparency := 127; 396 | FFillColor := clNone; 397 | end; 398 | 399 | procedure TStaticPathStyle.SetColor(const Value: TColor); 400 | begin 401 | FColor := Value; 402 | end; 403 | 404 | procedure TStaticPathStyle.SetFillColor(const Value: TColor); 405 | begin 406 | FFillColor := Value; 407 | end; 408 | 409 | procedure TStaticPathStyle.SetTransparency(const Value: Byte); 410 | begin 411 | FTransparency := Value; 412 | end; 413 | 414 | procedure TStaticPathStyle.SetWeight(const Value: Integer); 415 | begin 416 | FWeight := Value; 417 | end; 418 | 419 | function TStaticPathStyle.ToString: String; 420 | begin 421 | Result := Format('color:%.2x%.6x|weight:%f,fillcolor:%.8x', [FTransparency, FColor, FWeight, Self.FFillColor]); 422 | end; 423 | 424 | { TStaticPath } 425 | 426 | procedure TStaticPath.SetStyle(const Value: TStaticPathStyle); 427 | begin 428 | FStyle := Value; 429 | end; 430 | 431 | procedure TStaticPath.Simplify(Tolerance: Integer); 432 | begin 433 | // 434 | end; 435 | 436 | function TStaticPath.ToString: String; 437 | var 438 | I: Integer; 439 | begin 440 | Result := ''; 441 | 442 | if Count = 0 then 443 | Exit; 444 | Result := Result + 'path='; 445 | Result := Result + FStyle.ToString; 446 | Result := Result + '|'; 447 | for I := 0 to Count - 1 do 448 | begin 449 | Result := Result + Items[I].Position.ToString + '|'; 450 | end; 451 | Result := Copy(Result, 1, Length(Result) - 1); 452 | end; 453 | 454 | { TStaticPaths } 455 | 456 | function TStaticPaths.ToString: String; 457 | var 458 | Path: TStaticPath; 459 | begin 460 | Result := ''; 461 | for Path in Self do 462 | Result := Result + Path.ToString; 463 | end; 464 | 465 | end. 466 | -------------------------------------------------------------------------------- /source/DelphiMaps.StreetView.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | Abf Viewer: Embedded StreetView 6 | 7 | 49 | 50 | 51 |

52 | 53 | 54 | -------------------------------------------------------------------------------- /source/DelphiMaps.StreetView.pas: -------------------------------------------------------------------------------- 1 | {**************************************************************************************************} 2 | { The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } 3 | { you may not use this file except in compliance with the License. You may obtain a copy of the } 4 | { License at http://www.mozilla.org/MPL/ } 5 | { } 6 | { Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } 7 | { ANY KIND, either express or implied. See the License for the specific language governing rights } 8 | { and limitations under the License. } 9 | { } 10 | { The Original Code is DelphiMaps.StreetView.pas } 11 | { } 12 | { The Initial Developer of the Original Code is Wouter van Nifterick } 13 | { (wouter_van_nifterick@hotmail.com. } 14 | {**************************************************************************************************} 15 | unit DelphiMaps.StreetView; 16 | 17 | interface 18 | 19 | uses 20 | Classes, 21 | DelphiMaps.Location, 22 | DelphiMaps.Browser; 23 | 24 | {$R DelphiMaps.StreetView_html.res} 25 | 26 | type 27 | TPOV = class 28 | private 29 | FPitch: Double; 30 | FHeading: Double; 31 | FZoom: Double; 32 | FOnChange: TNotifyEvent; 33 | procedure SetHeading(const Value: Double); 34 | procedure SetOnChange(const Value: TNotifyEvent); 35 | procedure SetPitch(const Value: Double); 36 | procedure SetZoom(const Value: Double); 37 | 38 | procedure DoOnChange; 39 | public 40 | function Equals(Obj: TPOV): Boolean; reintroduce; 41 | property Heading:Double read FHeading write SetHeading; 42 | property Pitch:Double read FPitch write SetPitch; 43 | property Zoom:Double read FZoom write SetZoom; 44 | property OnChange: TNotifyEvent read FOnChange write SetOnChange; 45 | procedure SetAll(aHeading,aPitch,aZoom:Double); 46 | end; 47 | 48 | TStreetView=class(TBrowserControl) 49 | procedure Init; 50 | private 51 | FCenter: TLocation; 52 | FPOV: TPOV; 53 | procedure SetCenter(const Value: TLocation); 54 | procedure SetPOV(const Value: TPOV); 55 | protected 56 | procedure Resize; override; 57 | public 58 | procedure HandleOnCenterChange(Sender:TObject); 59 | procedure HandleOnPOVChange(Sender:TObject); 60 | destructor Destroy; override; 61 | property Center:TLocation read FCenter write SetCenter; 62 | property POV:TPOV read FPOV write SetPOV; 63 | class function GetHTMLResourceName: String;override; 64 | constructor Create(AOwner: TComponent); override; 65 | 66 | end; 67 | 68 | implementation 69 | 70 | uses 71 | IoUtils, 72 | SysUtils; 73 | 74 | resourcestring 75 | StrSTREETVIEWHTML = 'STREETVIEW_HTML'; 76 | StrStreetViewFileName = 'StreetView.html'; 77 | 78 | { TStreetMap } 79 | 80 | constructor TStreetView.Create(AOwner: TComponent); 81 | begin 82 | inherited; 83 | 84 | FCenter := TLocation.Create; 85 | FCenter.OnChange := HandleOnCenterChange; 86 | 87 | FPov := TPOV.Create; 88 | FPov.OnChange := HandleOnPOVChange; 89 | 90 | Init; 91 | end; 92 | 93 | 94 | destructor TStreetView.Destroy; 95 | begin 96 | FreeAndNil(FPOV); 97 | FreeAndNil(FCenter); 98 | inherited; 99 | end; 100 | 101 | class function TStreetView.GetHTMLResourceName: String; 102 | begin 103 | Result := StrSTREETVIEWHTML; 104 | end; 105 | 106 | procedure TStreetView.HandleOnCenterChange(Sender: TObject); 107 | begin 108 | {$IFDEF VER220}FormatSettings.{$ENDIF}DecimalSeparator := '.'; 109 | case FCenter.LocationType of 110 | ltCoordinates : ExecJavaScript(Format('%s.setPosition(new google.maps.LatLng(%g,%g));',[JsVarName,FCenter.Position.Lat,FCenter.Position.Lng])); 111 | ltText : ExecJavaScript(Format('%s.setPosition( AddressToLatLng("%s") );',[JsVarName,FCenter.Text])); 112 | end; 113 | end; 114 | 115 | procedure TStreetView.HandleOnPOVChange(Sender: TObject); 116 | begin 117 | {$IFDEF VER220}FormatSettings.{$ENDIF}DecimalSeparator := '.'; 118 | ExecJavaScript(Format('%s.setPov({heading:%f,pitch:%f,zoom:%f});',[JsVarName,FPOV.Heading,FPOV.Pitch,FPOV.Zoom])); 119 | end; 120 | 121 | procedure TStreetView.Init; 122 | var 123 | LHtmlFileName : String; 124 | begin 125 | Browser.OnDocumentComplete := WebBrowserDocumentComplete; 126 | LHtmlFileName := TPath.GetTempPath+StrStreetViewFileName; 127 | SaveHtml(LHtmlFileName); 128 | if FileExists(LHtmlFileName) then 129 | Browser.Navigate('file://' + LHtmlFileName); 130 | end; 131 | 132 | procedure TStreetView.Resize; 133 | begin 134 | inherited; 135 | ExecJavaScript(Format('document.getElementById("StreetViewDiv").style.height="%dpx";',[Browser.Height-5 ])); 136 | end; 137 | 138 | procedure TStreetView.SetCenter(const Value: TLocation); 139 | begin 140 | if FCenter.Equals(Value) then 141 | Exit; 142 | 143 | FCenter := Value; 144 | ExecJavaScript(Format('%s.setPosition(new google.maps.LatLng(%g,%g));',[JsVarName,FCenter.Position.Lat,FCenter.Position.Lng])); 145 | end; 146 | 147 | procedure TStreetView.SetPOV(const Value: TPOV); 148 | begin 149 | if FPOV.Equals(Value) then 150 | Exit; 151 | 152 | FPOV := Value; 153 | FPOV.DoOnChange; 154 | // ExecJavaScript(Format('%s.setPov({heading:%g,pitch:0,zoom:1});',[JsVarName,FPOV.Heading,FPOV.Pitch,FPOV.Zoom])); 155 | end; 156 | 157 | { TPov } 158 | 159 | procedure TPOV.DoOnChange; 160 | begin 161 | if Assigned(FOnChange) then 162 | OnChange(self); 163 | end; 164 | 165 | function TPOV.Equals(Obj: TPOV): Boolean; 166 | begin 167 | Result := (FPitch =Obj.Pitch ) and 168 | (FHeading=Obj.Heading) and 169 | (FZoom =Obj.Zoom ); 170 | end; 171 | 172 | procedure TPOV.SetAll(aHeading, aPitch, aZoom: Double); 173 | begin 174 | FPitch := aPitch; 175 | FHeading := aHeading; 176 | FZoom := aZoom; 177 | DoOnChange; 178 | end; 179 | 180 | procedure TPOV.SetHeading(const Value: Double); 181 | begin 182 | FHeading := Value; 183 | DoOnChange; 184 | end; 185 | 186 | procedure TPOV.SetPitch(const Value: Double); 187 | begin 188 | FPitch := Value; 189 | DoOnChange; 190 | end; 191 | 192 | procedure TPOV.SetZoom(const Value: Double); 193 | begin 194 | FZoom := Value; 195 | DoOnChange; 196 | end; 197 | 198 | procedure TPOV.SetOnChange(const Value: TNotifyEvent); 199 | begin 200 | FOnChange := Value; 201 | end; 202 | 203 | end. 204 | -------------------------------------------------------------------------------- /source/DelphiMaps.StreetView_html.rc: -------------------------------------------------------------------------------- 1 | STREETVIEW_HTML RCDATA "DelphiMaps.StreetView.html" 2 | -------------------------------------------------------------------------------- /source/DelphiMaps.StreetView_html.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/WouterVanNifterick/delphi-maps/b16f46d3c99642d32c660d6632d4c1d2da572a9c/source/DelphiMaps.StreetView_html.res -------------------------------------------------------------------------------- /source/DelphiMaps.WebImage.pas: -------------------------------------------------------------------------------- 1 | unit DelphiMaps.WebImage; 2 | 3 | interface 4 | 5 | uses 6 | SysUtils, Classes, Controls, ExtCtrls, ExtActns, Menus, 7 | Graphics, PngImage, GifImg, Jpeg; 8 | 9 | type 10 | TWebImage = class(TPaintBox) 11 | strict protected 12 | FIsLoaded:Boolean; 13 | FPicture:TPicture; 14 | FBitmap:Graphics.TBitmap; 15 | FPopupMenu:TPopupMenu; 16 | procedure UpdateBitmap; 17 | private 18 | procedure DrawBitmap; 19 | protected 20 | FURL:String; 21 | function GetURL: String;virtual; 22 | procedure SetURL(const Value: String); 23 | procedure Paint; override; 24 | procedure Resize; override; 25 | procedure OnMiCopyURLClick(Sender:TObject); 26 | procedure OnMiOpenURLClick(Sender:TObject); 27 | function GetPropertyString: String;virtual; 28 | public 29 | constructor Create(AOwner: TComponent); override; 30 | procedure Refresh;virtual; 31 | destructor Destroy; override; 32 | procedure CopyURL; 33 | procedure OpenURL; 34 | procedure OnDownloadProgressEvent(Sender: TDownLoadURL; Progress, ProgressMax: Cardinal; StatusCode: TURLDownloadStatus; StatusText: String; var Cancel: Boolean); 35 | published 36 | property URL: String read GetURL write SetURL; 37 | property PropertyString:String read GetPropertyString; 38 | end; 39 | 40 | procedure Register; 41 | 42 | implementation 43 | 44 | uses 45 | Windows, 46 | StrUtils, 47 | ClipBrd, 48 | ShellAPI, 49 | IoUtils; 50 | 51 | resourcestring 52 | StrLoading = 'Loading...'; 53 | StrCopyURL = 'Copy URL'; 54 | StrOpenInBrowser = 'Open in browser'; 55 | 56 | procedure Register; 57 | begin 58 | RegisterComponents('DelphiMaps', []); 59 | end; 60 | 61 | { TWebImage } 62 | 63 | constructor TWebImage.Create(AOwner: TComponent); 64 | var 65 | Mi:TMenuItem; 66 | begin 67 | inherited; 68 | FIsLoaded := False; 69 | FBitmap := Graphics.TBitmap.Create; 70 | FPicture := TPicture.Create; 71 | 72 | FPopupMenu := TPopupMenu.Create(nil); 73 | PopupMenu := FPopupMenu; 74 | 75 | Mi := TMenuItem.Create(PopupMenu); 76 | Mi.Caption := StrCopyURL; 77 | Mi.OnClick := OnMiCopyURLClick; 78 | FPopupMenu.Items.Add(Mi); 79 | 80 | Mi := TMenuItem.Create(PopupMenu); 81 | Mi.Caption := StrOpenInBrowser; 82 | Mi.OnClick := OnMiOpenURLClick; 83 | FPopupMenu.Items.Add(Mi); 84 | 85 | 86 | end; 87 | 88 | destructor TWebImage.Destroy; 89 | begin 90 | FreeAndNil(FBitmap); 91 | FreeAndNil(FPicture); 92 | FreeAndNil(FPopupMenu); 93 | inherited; 94 | end; 95 | 96 | procedure TWebImage.OpenURL; 97 | begin 98 | ShellExecute(0, 'open', PChar(URL), nil, nil, SW_SHOWNORMAL); 99 | end; 100 | 101 | procedure TWebImage.CopyURL; 102 | begin 103 | ClipBoard.AsText := GetURL; 104 | end; 105 | 106 | function TWebImage.GetPropertyString: String; 107 | begin 108 | Result := URL; 109 | end; 110 | 111 | function TWebImage.GetURL: String; 112 | begin 113 | Result := FURL; 114 | end; 115 | 116 | procedure TWebImage.OnDownloadProgressEvent(Sender: TDownLoadURL; Progress, 117 | ProgressMax: Cardinal; StatusCode: TURLDownloadStatus; StatusText: String; 118 | var Cancel: Boolean); 119 | begin 120 | case StatusCode of 121 | dsFindingResource : Canvas.TextOut(5,Height-30,'Finding Resource...'); 122 | dsConnecting : Canvas.TextOut(5,Height-30,'Connecting...'); 123 | dsRedirecting : Canvas.TextOut(5,Height-30,'Redirecting...'); 124 | dsBeginDownloadData : Canvas.TextOut(5,Height-30,'Begin download'); 125 | dsDownloadingData : Canvas.TextOut(5,Height-30,'Downloading...'); 126 | dsEndDownloadData : Canvas.TextOut(5,Height-30,'Done.'); 127 | dsBeginDownloadComponents: ; 128 | dsInstallingComponents: ; 129 | dsEndDownloadComponents: ; 130 | dsUsingCachedCopy: ; 131 | dsSendingRequest: ; 132 | dsClassIDAvailable: ; 133 | dsMIMETypeAvailable: ; 134 | dsCacheFileNameAvailable: ; 135 | dsBeginSyncOperation: ; 136 | dsEndSyncOperation: ; 137 | dsBeginUploadData: ; 138 | dsUploadingData: ; 139 | dsEndUploadData: ; 140 | dsProtocolClassID: ; 141 | dsEncoding: ; 142 | dsVerifiedMIMETypeAvailable: ; 143 | dsClassInstallLocation: ; 144 | dsDecoding: ; 145 | dsLoadingMIMEHandler: ; 146 | dsContentDispositionAttach: ; 147 | dsFilterReportMIMEType: ; 148 | dsCLSIDCanInstantiate: ; 149 | dsIUnKnownAvailable: ; 150 | dsDirectBind: ; 151 | dsRawMIMEType: ; 152 | dsProxyDetecting: ; 153 | dsAcceptRanges: ; 154 | dsCookieSent: ; 155 | dsCompactPolicyReceived: ; 156 | dsCookieSuppressed: ; 157 | dsCookieStateUnknown: ; 158 | dsCookieStateAccept: ; 159 | dsCookeStateReject: ; 160 | dsCookieStatePrompt: ; 161 | dsCookieStateLeash: ; 162 | dsCookieStateDowngrade: ; 163 | dsPolicyHREF: ; 164 | dsP3PHeader: ; 165 | dsSessionCookieReceived: ; 166 | dsPersistentCookieReceived: ; 167 | dsSessionCookiesAllowed: ; 168 | end; 169 | end; 170 | 171 | procedure TWebImage.DrawBitmap; 172 | begin 173 | if Assigned(FBitmap) then 174 | if Assigned(Canvas) then 175 | Canvas.Draw((Width div 2) - (FBitmap.Width div 2), (Height div 2) - (FBitmap.Height div 2), FBitmap); 176 | end; 177 | 178 | procedure TWebImage.OnMiCopyURLClick(Sender: TObject); 179 | begin 180 | CopyURL; 181 | end; 182 | 183 | procedure TWebImage.OnMiOpenURLClick(Sender: TObject); 184 | begin 185 | OpenURL; 186 | end; 187 | 188 | procedure TWebImage.Paint; 189 | begin 190 | // inherited; 191 | DrawBitmap; 192 | end; 193 | 194 | procedure TWebImage.Refresh; 195 | begin 196 | // 197 | end; 198 | 199 | procedure TWebImage.Resize; 200 | begin 201 | inherited; 202 | Paint; 203 | end; 204 | 205 | procedure TWebImage.SetURL(const Value: String); 206 | begin 207 | if FURL=Value then 208 | Exit; 209 | 210 | FURL := Value; 211 | UpdateBitmap; 212 | end; 213 | 214 | procedure TWebImage.UpdateBitmap; 215 | var 216 | Download : TDownLoadURL; 217 | tmpName:string; 218 | S:String; 219 | begin 220 | if Width = 0 then 221 | Exit; 222 | 223 | if csLoading in ComponentState then 224 | Exit; 225 | 226 | Refresh; 227 | 228 | if FIsLoaded then 229 | begin 230 | Canvas.Brush.Color := clWhite; 231 | Canvas.Rectangle( 5, 5,Canvas.TextWidth(StrLoading)+25, 30 ); 232 | Canvas.TextOut( 10, 10, StrLoading ); 233 | Update; 234 | end; 235 | 236 | Download := TDownLoadURL.Create(nil); 237 | try 238 | Download.OnDownloadProgress := OnDownloadProgressEvent; 239 | Download.URL := FURL; 240 | TmpName := TPath.GetTempFileName; 241 | TmpName := ChangeFileExt(TmpName,'.png'); 242 | Download.Filename := TmpName; 243 | Download.ExecuteTarget(nil); 244 | if FileExists(TmpName) then 245 | begin 246 | try 247 | try 248 | FPicture.LoadFromFile(TmpName); 249 | FBitmap.SetSize( FPicture.Width, FPicture.Height ); 250 | FBitmap.Canvas.FillRect(FBitmap.Canvas.ClipRect); 251 | FBitmap.Canvas.Draw(0,0,FPicture.Graphic); 252 | DrawBitmap; 253 | FIsLoaded := true; 254 | except 255 | S := TFile.ReadAllText(TmpName); 256 | if Pos('',S)>0 then 257 | begin 258 | S := Copy( S, Pos('',S)+18, Pos('',S) - Pos('',S)-18); 259 | S := Trim(S); 260 | S := ReplaceStr(S,'"','"'); 261 | raise Exception.Create( S ); 262 | end 263 | else 264 | raise; 265 | end; 266 | finally 267 | TFile.Delete(TmpName); 268 | end; 269 | end; 270 | finally 271 | FreeAndNil(Download) 272 | end; 273 | end; 274 | 275 | end. 276 | -------------------------------------------------------------------------------- /source/DelphiMapsBrowserExternal.ridl: -------------------------------------------------------------------------------- 1 | // ************************************************************************ // 2 | // WARNING 3 | // ------- 4 | // This file is generated by the Type Library importer or Type Libary Editor. 5 | // Barring syntax errors, the Editor will parse modifications made to the file. 6 | // However, when applying changes via the Editor this file will be regenerated 7 | // and comments or formatting changes will be lost. 8 | // ************************************************************************ // 9 | // File generated on 28-10-2010 1:55:30 (- $Rev: 12980 $, 150189390). 10 | 11 | [ 12 | uuid(517F7078-5E73-4E5A-B8A2-8F0FF14EF21B), 13 | version(1.0), 14 | helpstring("DephiMaps Library") 15 | 16 | ] 17 | library DelphiMapsBrowserExternal 18 | { 19 | 20 | importlib("stdole2.tlb"); 21 | 22 | interface IDelphiMaps; 23 | 24 | 25 | [ 26 | uuid(49F434EE-0C48-4D7A-B32D-7D31D2C7154D), 27 | version(1.0), 28 | dual, 29 | oleautomation 30 | ] 31 | interface IDelphiMaps: IDispatch 32 | { 33 | [id(0x000000CA)] 34 | HRESULT _stdcall triggerEvent([in] BSTR EventName); 35 | [id(0x000000CB)] 36 | HRESULT _stdcall showMessage([in] BSTR aText); 37 | }; 38 | 39 | }; 40 | -------------------------------------------------------------------------------- /source/DelphiMapsBrowserExternal.tlb: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/WouterVanNifterick/delphi-maps/b16f46d3c99642d32c660d6632d4c1d2da572a9c/source/DelphiMapsBrowserExternal.tlb -------------------------------------------------------------------------------- /source/DelphiMapsBrowserExternal_TLB.pas: -------------------------------------------------------------------------------- 1 | unit DelphiMapsBrowserExternal_TLB; 2 | 3 | // ************************************************************************ // 4 | // WARNING 5 | // ------- 6 | // The types declared in this file were generated from data read from a 7 | // Type Library. If this type library is explicitly or indirectly (via 8 | // another type library referring to this type library) re-imported, or the 9 | // 'Refresh' command of the Type Library Editor activated while editing the 10 | // Type Library, the contents of this file will be regenerated and all 11 | // manual modifications will be lost. 12 | // ************************************************************************ // 13 | 14 | // $Rev: 31855 $ 15 | // File generated on 28-10-2010 1:54:02 from Type Library described below. 16 | 17 | // ************************************************************************ // 18 | // Type Lib: H:\Program Files\Borland\Delphi7\Lib\ARS\DelphiMaps\trunk\source\DelphiMapsBrowserExternal (1) 19 | // LIBID: {517F7078-5E73-4E5A-B8A2-8F0FF14EF21B} 20 | // LCID: 0 21 | // Helpfile: 22 | // HelpString: DephiMaps Library 23 | // DepndLst: 24 | // (1) v2.0 stdole, (H:\WINDOWS\system32\stdole2.tlb) 25 | // ************************************************************************ // 26 | {$TYPEDADDRESS OFF} // Unit must be compiled without type-checked pointers. 27 | {$WARN SYMBOL_PLATFORM OFF} 28 | {$WRITEABLECONST ON} 29 | {$VARPROPSETTER ON} 30 | {$ALIGN 4} 31 | interface 32 | 33 | uses Windows, ActiveX, Classes, Graphics, StdVCL, Variants; 34 | 35 | 36 | // *********************************************************************// 37 | // GUIDS declared in the TypeLibrary. Following prefixes are used: 38 | // Type Libraries : LIBID_xxxx 39 | // CoClasses : CLASS_xxxx 40 | // DISPInterfaces : DIID_xxxx 41 | // Non-DISP interfaces: IID_xxxx 42 | // *********************************************************************// 43 | const 44 | // TypeLibrary Major and minor versions 45 | DelphiMapsBrowserExternalMajorVersion = 1; 46 | DelphiMapsBrowserExternalMinorVersion = 0; 47 | 48 | LIBID_DelphiMapsBrowserExternal: TGUID = '{517F7078-5E73-4E5A-B8A2-8F0FF14EF21B}'; 49 | 50 | IID_IDelphiMaps: TGUID = '{49F434EE-0C48-4D7A-B32D-7D31D2C7154D}'; 51 | type 52 | 53 | // *********************************************************************// 54 | // Forward declaration of types defined in TypeLibrary 55 | // *********************************************************************// 56 | IDelphiMaps = interface; 57 | IDelphiMapsDisp = dispinterface; 58 | 59 | // *********************************************************************// 60 | // Interface: IDelphiMaps 61 | // Flags: (4416) Dual OleAutomation Dispatchable 62 | // GUID: {49F434EE-0C48-4D7A-B32D-7D31D2C7154D} 63 | // *********************************************************************// 64 | IDelphiMaps = interface(IDispatch) 65 | ['{49F434EE-0C48-4D7A-B32D-7D31D2C7154D}'] 66 | procedure triggerEvent(const EventName: WideString); safecall; 67 | procedure showMessage(const aText: WideString); safecall; 68 | end; 69 | 70 | // *********************************************************************// 71 | // DispIntf: IDelphiMapsDisp 72 | // Flags: (4416) Dual OleAutomation Dispatchable 73 | // GUID: {49F434EE-0C48-4D7A-B32D-7D31D2C7154D} 74 | // *********************************************************************// 75 | IDelphiMapsDisp = dispinterface 76 | ['{49F434EE-0C48-4D7A-B32D-7D31D2C7154D}'] 77 | procedure triggerEvent(const EventName: WideString); dispid 202; 78 | procedure showMessage(const aText: WideString); dispid 203; 79 | end; 80 | 81 | implementation 82 | 83 | uses ComObj; 84 | 85 | end. 86 | 87 | --------------------------------------------------------------------------------