jj 16.11 frmGoogle

This commit is contained in:
JenneJ
2016-11-16 16:48:04 +01:00
parent ba4040e3e4
commit 1184ee0043
5 changed files with 153 additions and 164 deletions

View File

@@ -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