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

@ -213,17 +213,16 @@ Public Class ClassHelper
Try Try
Dim tbltemp As DataTable = Primary_DT.Clone() Dim tbltemp As DataTable = Primary_DT.Clone()
' Nicht benötigt? Datumsspalten werden im Grid formatiert ' Nicht benötigt? Datumsspalten werden im Grid formatiert
'For Each col As String In listdate For Each col As String In listdate
' Dim colDate As DataColumn = tbltemp.Columns(col) Dim colDate As DataColumn = tbltemp.Columns(col)
' If Not IsNothing(colDate) Then If Not IsNothing(colDate) Then
' Try Try
' colDate.DataType = GetType(DateTime) colDate.DataType = GetType(Date)
' Catch ex As Exception Catch ex As Exception
MsgBox("Error in Format_GridColumns:" & vbNewLine & ex.Message, MsgBoxStyle.Critical)
' End Try End Try
End If
' End If Next
'Next
For Each col1 As String In listcheck For Each col1 As String In listcheck
Dim collist As DataColumn = tbltemp.Columns(col1) Dim collist As DataColumn = tbltemp.Columns(col1)
If Not IsNothing(collist) Then If Not IsNothing(collist) Then

View File

@ -23,126 +23,79 @@ Partial Class frmGoogle
<System.Diagnostics.DebuggerStepThrough()> _ <System.Diagnostics.DebuggerStepThrough()> _
Private Sub InitializeComponent() Private Sub InitializeComponent()
Me.components = New System.ComponentModel.Container() Me.components = New System.ComponentModel.Container()
Dim ImageTilesLayer1 As DevExpress.XtraMap.ImageTilesLayer = New DevExpress.XtraMap.ImageTilesLayer() Dim ImageTilesLayer2 As DevExpress.XtraMap.ImageTilesLayer = New DevExpress.XtraMap.ImageTilesLayer()
Dim BingMapDataProvider1 As DevExpress.XtraMap.BingMapDataProvider = New DevExpress.XtraMap.BingMapDataProvider()
Dim MiniMap1 As DevExpress.XtraMap.MiniMap = New DevExpress.XtraMap.MiniMap()
Dim FixedMiniMapBehavior1 As DevExpress.XtraMap.FixedMiniMapBehavior = New DevExpress.XtraMap.FixedMiniMapBehavior()
Dim MiniMapImageTilesLayer1 As DevExpress.XtraMap.MiniMapImageTilesLayer = New DevExpress.XtraMap.MiniMapImageTilesLayer()
Dim BingMapDataProvider2 As DevExpress.XtraMap.BingMapDataProvider = New DevExpress.XtraMap.BingMapDataProvider() Dim BingMapDataProvider2 As DevExpress.XtraMap.BingMapDataProvider = New DevExpress.XtraMap.BingMapDataProvider()
Dim MiniMapVectorItemsLayer1 As DevExpress.XtraMap.MiniMapVectorItemsLayer = New DevExpress.XtraMap.MiniMapVectorItemsLayer() Dim InformationLayer2 As DevExpress.XtraMap.InformationLayer = New DevExpress.XtraMap.InformationLayer()
Dim MapItemStorage1 As DevExpress.XtraMap.MapItemStorage = New DevExpress.XtraMap.MapItemStorage() Dim BingSearchDataProvider2 As DevExpress.XtraMap.BingSearchDataProvider = New DevExpress.XtraMap.BingSearchDataProvider()
Me.Label1 = New System.Windows.Forms.Label() Dim VectorItemsLayer2 As DevExpress.XtraMap.VectorItemsLayer = New DevExpress.XtraMap.VectorItemsLayer()
Dim MapItemStorage2 As DevExpress.XtraMap.MapItemStorage = New DevExpress.XtraMap.MapItemStorage()
Me.ContextMenuStrip1 = New System.Windows.Forms.ContextMenuStrip(Me.components) Me.ContextMenuStrip1 = New System.Windows.Forms.ContextMenuStrip(Me.components)
Me.txtAdress = New System.Windows.Forms.TextBox()
Me.Button1 = New System.Windows.Forms.Button()
Me.WebBrowser1 = New System.Windows.Forms.WebBrowser()
Me.cmbType = New System.Windows.Forms.ComboBox()
Me.MapControl1 = New DevExpress.XtraMap.MapControl() Me.MapControl1 = New DevExpress.XtraMap.MapControl()
Me.ListBox1 = New System.Windows.Forms.ListBox()
Me.ToolTipController1 = New DevExpress.Utils.ToolTipController(Me.components)
CType(Me.MapControl1, System.ComponentModel.ISupportInitialize).BeginInit() CType(Me.MapControl1, System.ComponentModel.ISupportInitialize).BeginInit()
Me.SuspendLayout() Me.SuspendLayout()
' '
'Label1
'
Me.Label1.AutoSize = True
Me.Label1.Location = New System.Drawing.Point(12, 12)
Me.Label1.Name = "Label1"
Me.Label1.Size = New System.Drawing.Size(38, 13)
Me.Label1.TabIndex = 0
Me.Label1.Text = "Label1"
'
'ContextMenuStrip1 'ContextMenuStrip1
' '
Me.ContextMenuStrip1.Name = "ContextMenuStrip1" Me.ContextMenuStrip1.Name = "ContextMenuStrip1"
Me.ContextMenuStrip1.Size = New System.Drawing.Size(61, 4) Me.ContextMenuStrip1.Size = New System.Drawing.Size(61, 4)
' '
'txtAdress
'
Me.txtAdress.Location = New System.Drawing.Point(56, 9)
Me.txtAdress.Name = "txtAdress"
Me.txtAdress.Size = New System.Drawing.Size(282, 21)
Me.txtAdress.TabIndex = 2
'
'Button1
'
Me.Button1.Location = New System.Drawing.Point(489, 7)
Me.Button1.Name = "Button1"
Me.Button1.Size = New System.Drawing.Size(75, 23)
Me.Button1.TabIndex = 3
Me.Button1.Text = "Button1"
Me.Button1.UseVisualStyleBackColor = True
'
'WebBrowser1
'
Me.WebBrowser1.Anchor = CType((((System.Windows.Forms.AnchorStyles.Top Or System.Windows.Forms.AnchorStyles.Bottom) _
Or System.Windows.Forms.AnchorStyles.Left) _
Or System.Windows.Forms.AnchorStyles.Right), System.Windows.Forms.AnchorStyles)
Me.WebBrowser1.Location = New System.Drawing.Point(15, 38)
Me.WebBrowser1.MinimumSize = New System.Drawing.Size(20, 20)
Me.WebBrowser1.Name = "WebBrowser1"
Me.WebBrowser1.Size = New System.Drawing.Size(671, 344)
Me.WebBrowser1.TabIndex = 4
'
'cmbType
'
Me.cmbType.FormattingEnabled = True
Me.cmbType.Items.AddRange(New Object() {"Map", "Satellite", "Hybrid", "Terrain", "Google Earth"})
Me.cmbType.Location = New System.Drawing.Point(344, 9)
Me.cmbType.Name = "cmbType"
Me.cmbType.Size = New System.Drawing.Size(139, 21)
Me.cmbType.TabIndex = 5
'
'MapControl1 'MapControl1
' '
Me.MapControl1.Anchor = CType((((System.Windows.Forms.AnchorStyles.Top Or System.Windows.Forms.AnchorStyles.Bottom) _
Or System.Windows.Forms.AnchorStyles.Left) _
Or System.Windows.Forms.AnchorStyles.Right), System.Windows.Forms.AnchorStyles)
Me.MapControl1.CenterPoint = New DevExpress.XtraMap.GeoPoint(45.0R, 16.0R) Me.MapControl1.CenterPoint = New DevExpress.XtraMap.GeoPoint(45.0R, 16.0R)
BingMapDataProvider1.BingKey = "hQUTlqLLK70bETnonpfi~0jx1pIAq1yQ7gXqbIyzKrg~Au-Tewbty8afAxdbNilSv4JlU7qwU-fQKu0ou" & _ BingMapDataProvider2.BingKey = "hQUTlqLLK70bETnonpfi~0jx1pIAq1yQ7gXqbIyzKrg~Au-Tewbty8afAxdbNilSv4JlU7qwU-fQKu0ou" & _
"H9e1uJmpIyVdA3jugVEWMdy1Rbt" "H9e1uJmpIyVdA3jugVEWMdy1Rbt"
BingMapDataProvider1.Kind = DevExpress.XtraMap.BingMapKind.Road BingMapDataProvider2.Kind = DevExpress.XtraMap.BingMapKind.Road
BingMapDataProvider1.TileSource = Nothing
ImageTilesLayer1.DataProvider = BingMapDataProvider1
Me.MapControl1.Layers.Add(ImageTilesLayer1)
Me.MapControl1.Location = New System.Drawing.Point(719, 38)
MiniMap1.Alignment = DevExpress.XtraMap.MiniMapAlignment.BottomRight
FixedMiniMapBehavior1.CenterPoint = New DevExpress.XtraMap.GeoPoint(45.0R, 18.0R)
MiniMap1.Behavior = FixedMiniMapBehavior1
BingMapDataProvider2.BingKey = "YOUR BING MAPS KEY"
BingMapDataProvider2.TileSource = Nothing BingMapDataProvider2.TileSource = Nothing
MiniMapImageTilesLayer1.DataProvider = BingMapDataProvider2 ImageTilesLayer2.DataProvider = BingMapDataProvider2
MiniMapVectorItemsLayer1.Data = MapItemStorage1 ImageTilesLayer2.Name = "ImageLayer"
MiniMap1.Layers.Add(MiniMapImageTilesLayer1) BingSearchDataProvider2.BingKey = "hQUTlqLLK70bETnonpfi~0jx1pIAq1yQ7gXqbIyzKrg~Au-Tewbty8afAxdbNilSv4JlU7qwU-fQKu0ou" & _
MiniMap1.Layers.Add(MiniMapVectorItemsLayer1) "H9e1uJmpIyVdA3jugVEWMdy1Rbt"
Me.MapControl1.MiniMap = MiniMap1 InformationLayer2.DataProvider = BingSearchDataProvider2
InformationLayer2.Name = "SearchLayer"
VectorItemsLayer2.Data = MapItemStorage2
VectorItemsLayer2.Name = "VectorLayer"
Me.MapControl1.Layers.Add(ImageTilesLayer2)
Me.MapControl1.Layers.Add(InformationLayer2)
Me.MapControl1.Layers.Add(VectorItemsLayer2)
Me.MapControl1.Location = New System.Drawing.Point(200, 2)
Me.MapControl1.Name = "MapControl1" Me.MapControl1.Name = "MapControl1"
Me.MapControl1.Size = New System.Drawing.Size(659, 344) Me.MapControl1.Size = New System.Drawing.Size(1188, 485)
Me.MapControl1.TabIndex = 6 Me.MapControl1.TabIndex = 6
Me.MapControl1.ToolTipController = Me.ToolTipController1
Me.MapControl1.ZoomLevel = 10.0R Me.MapControl1.ZoomLevel = 10.0R
' '
'ListBox1
'
Me.ListBox1.FormattingEnabled = True
Me.ListBox1.Location = New System.Drawing.Point(3, 2)
Me.ListBox1.Name = "ListBox1"
Me.ListBox1.Size = New System.Drawing.Size(191, 485)
Me.ListBox1.TabIndex = 7
'
'ToolTipController1
'
Me.ToolTipController1.Rounded = True
Me.ToolTipController1.ToolTipStyle = DevExpress.Utils.ToolTipStyle.WindowsXP
Me.ToolTipController1.ToolTipType = DevExpress.Utils.ToolTipType.SuperTip
'
'frmGoogle 'frmGoogle
' '
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!) Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
Me.ClientSize = New System.Drawing.Size(1390, 394) Me.ClientSize = New System.Drawing.Size(1390, 490)
Me.Controls.Add(Me.ListBox1)
Me.Controls.Add(Me.MapControl1) Me.Controls.Add(Me.MapControl1)
Me.Controls.Add(Me.cmbType)
Me.Controls.Add(Me.WebBrowser1)
Me.Controls.Add(Me.Button1)
Me.Controls.Add(Me.txtAdress)
Me.Controls.Add(Me.Label1)
Me.Font = New System.Drawing.Font("Tahoma", 8.25!, System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, CType(0, Byte)) Me.Font = New System.Drawing.Font("Tahoma", 8.25!, System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, CType(0, Byte))
Me.Name = "frmGoogle" Me.Name = "frmGoogle"
Me.Text = "frmGoogle" Me.Text = "frmGoogle"
CType(Me.MapControl1, System.ComponentModel.ISupportInitialize).EndInit() CType(Me.MapControl1, System.ComponentModel.ISupportInitialize).EndInit()
Me.ResumeLayout(False) Me.ResumeLayout(False)
Me.PerformLayout()
End Sub End Sub
Friend WithEvents Label1 As System.Windows.Forms.Label
Friend WithEvents ContextMenuStrip1 As System.Windows.Forms.ContextMenuStrip Friend WithEvents ContextMenuStrip1 As System.Windows.Forms.ContextMenuStrip
Friend WithEvents txtAdress As System.Windows.Forms.TextBox
Friend WithEvents Button1 As System.Windows.Forms.Button
Friend WithEvents WebBrowser1 As System.Windows.Forms.WebBrowser
Friend WithEvents cmbType As System.Windows.Forms.ComboBox
Friend WithEvents MapControl1 As DevExpress.XtraMap.MapControl Friend WithEvents MapControl1 As DevExpress.XtraMap.MapControl
Friend WithEvents ListBox1 As System.Windows.Forms.ListBox
Friend WithEvents ToolTipController1 As DevExpress.Utils.ToolTipController
End Class End Class

View File

@ -120,4 +120,7 @@
<metadata name="ContextMenuStrip1.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a"> <metadata name="ContextMenuStrip1.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
<value>17, 17</value> <value>17, 17</value>
</metadata> </metadata>
<metadata name="ToolTipController1.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
<value>174, 17</value>
</metadata>
</root> </root>

View File

@ -1,79 +1,112 @@
Imports System.Web Imports System.Web
Imports System.Text Imports System.Text
Imports DevExpress.XtraMap Imports DevExpress.XtraMap
Imports DevExpress.Map
Public Class frmGoogle 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 Get
Return CType(MapControl1.Layers("SearchLayer"), InformationLayer) Return CType(MapControl1.Layers("VectorLayer"), VectorItemsLayer)
End Get
End Property
Private ReadOnly Property SearchProvider() As BingSearchDataProvider
Get
Return CType(SearchLayer.DataProvider, BingSearchDataProvider)
End Get End Get
End Property 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 Private Sub frmGoogle_Load(sender As Object, e As EventArgs) Handles Me.Load
InitializeComponent() 'Events
' AddHandler SearchLayer.DataRequestCompleted, AddressOf SearchLayer_DataRequestCompleted 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 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

View File

@ -843,6 +843,7 @@ Public Class frmMain
End Sub End Sub
Private Sub BarButtonItem24_ItemClick(sender As Object, e As ItemClickEventArgs) Handles BarButtonItem24.ItemClick Private Sub BarButtonItem24_ItemClick(sender As Object, e As ItemClickEventArgs) Handles BarButtonItem24.ItemClick
frmGoogle.ShowDialog()
frmGoogle.Show()
End Sub End Sub
End Class End Class