jj 16.11 frmGoogle
This commit is contained in:
@@ -1,79 +1,112 @@
|
||||
Imports System.Web
|
||||
Imports System.Text
|
||||
Imports DevExpress.XtraMap
|
||||
Imports DevExpress.Map
|
||||
|
||||
Public Class frmGoogle
|
||||
|
||||
|
||||
Private ReadOnly Property SearchLayer() As InformationLayer
|
||||
'##################### SEARCH ##############################
|
||||
'Private ReadOnly Property SearchLayer() As InformationLayer
|
||||
' Get
|
||||
' Return CType(MapControl1.Layers("SearchLayer"), InformationLayer)
|
||||
' End Get
|
||||
'End Property
|
||||
|
||||
|
||||
'Private ReadOnly Property SearchProvider() As BingSearchDataProvider
|
||||
' Get
|
||||
' Return CType(SearchLayer.DataProvider, BingSearchDataProvider)
|
||||
' End Get
|
||||
'End Property
|
||||
|
||||
'##################### VECTOR ##############################
|
||||
Private ReadOnly Property VectorLayer() As VectorItemsLayer
|
||||
Get
|
||||
Return CType(MapControl1.Layers("SearchLayer"), InformationLayer)
|
||||
End Get
|
||||
End Property
|
||||
Private ReadOnly Property SearchProvider() As BingSearchDataProvider
|
||||
Get
|
||||
Return CType(SearchLayer.DataProvider, BingSearchDataProvider)
|
||||
Return CType(MapControl1.Layers("VectorLayer"), VectorItemsLayer)
|
||||
End Get
|
||||
End Property
|
||||
|
||||
Private Sub SearchLayer_DataRequestCompleted(ByVal sender As Object, ByVal e As RequestCompletedEventArgs)
|
||||
Private ReadOnly Property ItemStorage() As MapItemStorage
|
||||
Get
|
||||
Return CType(VectorLayer.Data, MapItemStorage)
|
||||
End Get
|
||||
End Property
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
|
||||
' Get the Google maps URL with defult zoom.
|
||||
Dim url = GoogleMapUrl(txtAdress.Text, cmbType.Text, 0)
|
||||
|
||||
' Display the URL in the WebBrowser control.
|
||||
WebBrowser1.Navigate(url)
|
||||
SearchProvider.Search(txtAdress.Text)
|
||||
MapControl1.ZoomToFitLayerItems()
|
||||
End Sub
|
||||
|
||||
Private Function GoogleMapUrl(query As String, map_type As String, zoom As Integer)
|
||||
|
||||
' Start with the base map URL.
|
||||
Dim _url As String = "http://maps.google.com/maps?"
|
||||
|
||||
' Add the query.
|
||||
_url &= "q=" + HttpUtility.UrlEncode(query, Encoding.UTF8)
|
||||
|
||||
'Add the type.
|
||||
map_type = GoogleMapTypeCode(map_type)
|
||||
If Not IsNothing(map_type) Then
|
||||
_url += "&t=" + map_type
|
||||
End If
|
||||
|
||||
|
||||
'Add the zoom level.
|
||||
If (zoom > 0) Then
|
||||
_url += "&z=" + zoom.ToString()
|
||||
End If
|
||||
|
||||
|
||||
Return _url
|
||||
End Function
|
||||
' Return a Google map type code.
|
||||
Private Function GoogleMapTypeCode(map_type As String)
|
||||
' Insert the proper type.
|
||||
Select Case map_type
|
||||
Case "Map"
|
||||
Return "m"
|
||||
Case "Satellite"
|
||||
Return "k"
|
||||
Case "Hybrid"
|
||||
Return "h"
|
||||
Case "Terrain"
|
||||
Return "p"
|
||||
Case "Google Earth"
|
||||
Return "e"
|
||||
Case Else
|
||||
Return Nothing
|
||||
End Select
|
||||
End Function
|
||||
|
||||
Private Sub frmGoogle_Load(sender As Object, e As EventArgs) Handles Me.Load
|
||||
InitializeComponent()
|
||||
' AddHandler SearchLayer.DataRequestCompleted, AddressOf SearchLayer_DataRequestCompleted
|
||||
'Events
|
||||
AddHandler MapControl1.MapItemClick, AddressOf MapControl1_MapItemClick
|
||||
|
||||
|
||||
MapControl1.ShowToolTips = True
|
||||
MapControl1.SetMapItemFactory(New MapItemFactory())
|
||||
|
||||
'Records holen
|
||||
Dim dt As DataTable = ClassDatabase.Return_Datatable("SELECT TOP 10 * FROM VWTEMP_PMO_FORM19")
|
||||
|
||||
Dim lat As Double = 50.6
|
||||
Dim lon As Double = 8.6
|
||||
|
||||
' Pins erstellen
|
||||
For Each row As DataRow In dt.Rows
|
||||
|
||||
' TODO: How to change PushPin Appearance when selected?
|
||||
' TODO: Make Pretty Permanent Tooltip like google maps?
|
||||
|
||||
' MapItemFactory
|
||||
' https://documentation.devexpress.com/#WindowsForms/DevExpressXtraMapMapControl_SetMapItemFactorytopic
|
||||
|
||||
Dim pushpin As New MapPushpin()
|
||||
pushpin.Location = New GeoPoint(lat, lon)
|
||||
pushpin.Text = row.Item("Record-ID")
|
||||
pushpin.Information = row
|
||||
|
||||
|
||||
pushpin.Attributes.Add(New MapItemAttribute() With {.Name = "SNumber", .Type = GetType(String), .Value = row.Item("Supplier_number")})
|
||||
pushpin.Attributes.Add(New MapItemAttribute() With {.Name = "SName", .Type = GetType(String), .Value = row.Item("Supplier_name")})
|
||||
|
||||
pushpin.ToolTipPattern = "Supplier Name: {SName} - Supplier Number: {SNumber}"
|
||||
ItemStorage.Items.Add(pushpin)
|
||||
|
||||
lat += 0.01
|
||||
lon += 0.01
|
||||
Next
|
||||
|
||||
End Sub
|
||||
End Class
|
||||
|
||||
Private Sub MapControl1_MapItemClick(sender As Object, e As MapItemClickEventArgs)
|
||||
Dim item As MapPushpin = e.Item
|
||||
Dim row As DataRow = item.Information
|
||||
Dim attrs As MapItemAttributeCollection = item.Attributes
|
||||
|
||||
ListBox1.Items.Clear()
|
||||
ListBox1.Items.Add(row.Item("Supplier_number"))
|
||||
ListBox1.Items.Add(row.Item("Supplier_name"))
|
||||
ListBox1.Items.Add(row.Item("MP_Number"))
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub MapControl1_DrawMapItem(sender As Object, e As DrawMapItemEventArgs) Handles MapControl1.DrawMapItem
|
||||
Dim colorOuter As Color = Color.White
|
||||
Dim colorInner As Color = Color.Blue
|
||||
Dim colorInnerHighlight As Color = Color.Red
|
||||
|
||||
e.Fill = If(e.IsSelected Or e.IsHighlighted, colorInnerHighlight, colorInner)
|
||||
e.Stroke = colorOuter
|
||||
e.StrokeWidth = If(e.IsSelected, 5, 2)
|
||||
End Sub
|
||||
|
||||
Public Class MapItemFactory
|
||||
Inherits DefaultMapItemFactory
|
||||
|
||||
Protected Overrides Sub InitializeItem(ByVal item As MapItem, ByVal obj As Object)
|
||||
MyBase.InitializeItem(item, obj)
|
||||
Dim rect As MapRectangle = TryCast(item, MapRectangle)
|
||||
If rect IsNot Nothing Then
|
||||
rect.Width = 1000
|
||||
rect.Height = 1000
|
||||
End If
|
||||
End Sub
|
||||
End Class
|
||||
End Class
|
||||
|
||||
Reference in New Issue
Block a user