122 lines
3.9 KiB
VB.net
122 lines
3.9 KiB
VB.net
Imports System.Web
|
|
Imports System.Text
|
|
Imports DevExpress.XtraMap
|
|
Imports DevExpress.Map
|
|
|
|
Public Class frmGoogle
|
|
|
|
Public Sub New()
|
|
InitializeComponent()
|
|
|
|
mapControl1.SetMapItemFactory(New MapItemFactory())
|
|
End Sub
|
|
|
|
'##################### 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("VectorLayer"), VectorItemsLayer)
|
|
End Get
|
|
End Property
|
|
|
|
'Private Property ItemStorage() As MapItemStorage
|
|
' Get
|
|
' Return CType(VectorLayer.Data, MapItemStorage)
|
|
' End Get
|
|
'End Property
|
|
|
|
|
|
Private Sub frmGoogle_Load(sender As Object, e As EventArgs) Handles Me.Load
|
|
|
|
Dim items As New List(Of MapPushpin)
|
|
|
|
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.TextColor = Color.Aqua
|
|
|
|
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}"
|
|
|
|
items.Add(pushpin)
|
|
|
|
lat += 0.01
|
|
lon += 0.01
|
|
Next
|
|
|
|
Dim storage As New MapItemStorage()
|
|
Dim itemArray() As MapPushpin = items.ToArray()
|
|
|
|
storage.Items.AddRange(itemArray)
|
|
VectorLayer.Data = storage
|
|
|
|
End Sub
|
|
|
|
Private Sub MapControl1_MapItemClick(sender As Object, e As MapItemClickEventArgs) Handles MapControl1.MapItemClick
|
|
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.Green
|
|
Dim colorInner As Color = Color.Green
|
|
Dim colorInnerHighlight As Color = Color.Red
|
|
|
|
e.Fill = Color.Red
|
|
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
|