diff --git a/app/DD-Record-Organiser/ClassHelper.vb b/app/DD-Record-Organiser/ClassHelper.vb index 7826a5e..2b68d0a 100644 --- a/app/DD-Record-Organiser/ClassHelper.vb +++ b/app/DD-Record-Organiser/ClassHelper.vb @@ -213,17 +213,16 @@ Public Class ClassHelper Try Dim tbltemp As DataTable = Primary_DT.Clone() ' Nicht benötigt? Datumsspalten werden im Grid formatiert - 'For Each col As String In listdate - ' Dim colDate As DataColumn = tbltemp.Columns(col) - ' If Not IsNothing(colDate) Then - ' Try - ' colDate.DataType = GetType(DateTime) - ' Catch ex As Exception - - ' End Try - - ' End If - 'Next + For Each col As String In listdate + Dim colDate As DataColumn = tbltemp.Columns(col) + If Not IsNothing(colDate) Then + Try + colDate.DataType = GetType(Date) + Catch ex As Exception + MsgBox("Error in Format_GridColumns:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) + End Try + End If + Next For Each col1 As String In listcheck Dim collist As DataColumn = tbltemp.Columns(col1) If Not IsNothing(collist) Then diff --git a/app/DD-Record-Organiser/frmConstructor_Main.vb b/app/DD-Record-Organiser/frmConstructor_Main.vb index 319ada9..4430015 100644 --- a/app/DD-Record-Organiser/frmConstructor_Main.vb +++ b/app/DD-Record-Organiser/frmConstructor_Main.vb @@ -3,6 +3,7 @@ Imports DevExpress.XtraBars.Navigation Imports DevExpress.XtraEditors Imports DevExpress.XtraEditors.Controls Imports DevExpress.XtraEditors.Repository +Imports DevExpress.XtraGrid.Columns Imports DevExpress.XtraGrid.Views.Base Imports DevExpress.XtraGrid.Views.Tile Imports DevExpress.XtraGrid.Views.Grid @@ -3016,15 +3017,15 @@ Public Class frmConstructor_Main ' Alle Date Spalten durchgehen For Each col As String In listdate Dim date_edit As New DevExpress.XtraEditors.Repository.RepositoryItemTimeEdit - date_edit.Mask.MaskType = Mask.MaskType.DateTime - date_edit.Mask.EditMask = CURRENT_DATE_FORMAT - date_edit.Mask.UseMaskAsDisplayFormat = True - grvwGrid.Columns(col).ColumnEdit = date_edit - 'dateedit.DisplayFormat.FormatType = FormatType.DateTime - 'dateedit.DisplayFormat.FormatString = CURRENT_DATE_FORMAT - 'grvwGrid.Columns(col).DisplayFormat.FormatType = FormatType.DateTime - 'grvwGrid.Columns(col).DisplayFormat.FormatString = CURRENT_DATE_FORMAT + Dim date_column As GridColumn = grvwGrid.Columns(col) + date_column.DisplayFormat.FormatType = FormatType.DateTime + date_column.DisplayFormat.FormatString = CURRENT_DATE_FORMAT + date_column.OptionsFilter.FilterPopupMode = FilterPopupMode.Default + date_column.OptionsFilter.AutoFilterCondition = AutoFilterCondition.Contains + + date_column.ColumnEdit = date_edit + date_column.FilterMode = ColumnFilterMode.DisplayText Next Try grvwGrid.Columns("AddedWhen").DisplayFormat.FormatType = FormatType.DateTime diff --git a/app/DD-Record-Organiser/frmGoogle.Designer.vb b/app/DD-Record-Organiser/frmGoogle.Designer.vb index 762ba5c..cdf4d51 100644 --- a/app/DD-Record-Organiser/frmGoogle.Designer.vb +++ b/app/DD-Record-Organiser/frmGoogle.Designer.vb @@ -23,126 +23,79 @@ Partial Class frmGoogle _ Private Sub InitializeComponent() Me.components = New System.ComponentModel.Container() - Dim ImageTilesLayer1 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 ImageTilesLayer2 As DevExpress.XtraMap.ImageTilesLayer = New DevExpress.XtraMap.ImageTilesLayer() Dim BingMapDataProvider2 As DevExpress.XtraMap.BingMapDataProvider = New DevExpress.XtraMap.BingMapDataProvider() - Dim MiniMapVectorItemsLayer1 As DevExpress.XtraMap.MiniMapVectorItemsLayer = New DevExpress.XtraMap.MiniMapVectorItemsLayer() - Dim MapItemStorage1 As DevExpress.XtraMap.MapItemStorage = New DevExpress.XtraMap.MapItemStorage() - Me.Label1 = New System.Windows.Forms.Label() + Dim InformationLayer2 As DevExpress.XtraMap.InformationLayer = New DevExpress.XtraMap.InformationLayer() + Dim BingSearchDataProvider2 As DevExpress.XtraMap.BingSearchDataProvider = New DevExpress.XtraMap.BingSearchDataProvider() + 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.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.ListBox1 = New System.Windows.Forms.ListBox() + Me.ToolTipController1 = New DevExpress.Utils.ToolTipController(Me.components) CType(Me.MapControl1, System.ComponentModel.ISupportInitialize).BeginInit() 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 ' Me.ContextMenuStrip1.Name = "ContextMenuStrip1" 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 ' - 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) - BingMapDataProvider1.BingKey = "hQUTlqLLK70bETnonpfi~0jx1pIAq1yQ7gXqbIyzKrg~Au-Tewbty8afAxdbNilSv4JlU7qwU-fQKu0ou" & _ + BingMapDataProvider2.BingKey = "hQUTlqLLK70bETnonpfi~0jx1pIAq1yQ7gXqbIyzKrg~Au-Tewbty8afAxdbNilSv4JlU7qwU-fQKu0ou" & _ "H9e1uJmpIyVdA3jugVEWMdy1Rbt" - BingMapDataProvider1.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.Kind = DevExpress.XtraMap.BingMapKind.Road BingMapDataProvider2.TileSource = Nothing - MiniMapImageTilesLayer1.DataProvider = BingMapDataProvider2 - MiniMapVectorItemsLayer1.Data = MapItemStorage1 - MiniMap1.Layers.Add(MiniMapImageTilesLayer1) - MiniMap1.Layers.Add(MiniMapVectorItemsLayer1) - Me.MapControl1.MiniMap = MiniMap1 + ImageTilesLayer2.DataProvider = BingMapDataProvider2 + ImageTilesLayer2.Name = "ImageLayer" + BingSearchDataProvider2.BingKey = "hQUTlqLLK70bETnonpfi~0jx1pIAq1yQ7gXqbIyzKrg~Au-Tewbty8afAxdbNilSv4JlU7qwU-fQKu0ou" & _ + "H9e1uJmpIyVdA3jugVEWMdy1Rbt" + 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.Size = New System.Drawing.Size(659, 344) + Me.MapControl1.Size = New System.Drawing.Size(1188, 485) Me.MapControl1.TabIndex = 6 + Me.MapControl1.ToolTipController = Me.ToolTipController1 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 ' Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!) 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.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.Name = "frmGoogle" Me.Text = "frmGoogle" CType(Me.MapControl1, System.ComponentModel.ISupportInitialize).EndInit() Me.ResumeLayout(False) - Me.PerformLayout() End Sub - Friend WithEvents Label1 As System.Windows.Forms.Label 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 ListBox1 As System.Windows.Forms.ListBox + Friend WithEvents ToolTipController1 As DevExpress.Utils.ToolTipController End Class diff --git a/app/DD-Record-Organiser/frmGoogle.resx b/app/DD-Record-Organiser/frmGoogle.resx index 279a447..cbadab6 100644 --- a/app/DD-Record-Organiser/frmGoogle.resx +++ b/app/DD-Record-Organiser/frmGoogle.resx @@ -120,4 +120,7 @@ 17, 17 + + 174, 17 + \ No newline at end of file diff --git a/app/DD-Record-Organiser/frmGoogle.vb b/app/DD-Record-Organiser/frmGoogle.vb index 3245409..5550b30 100644 --- a/app/DD-Record-Organiser/frmGoogle.vb +++ b/app/DD-Record-Organiser/frmGoogle.vb @@ -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 \ No newline at end of file + + 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 diff --git a/app/DD-Record-Organiser/frmMain.vb b/app/DD-Record-Organiser/frmMain.vb index 1abb161..09ca4b1 100644 --- a/app/DD-Record-Organiser/frmMain.vb +++ b/app/DD-Record-Organiser/frmMain.vb @@ -843,6 +843,7 @@ Public Class frmMain End Sub Private Sub BarButtonItem24_ItemClick(sender As Object, e As ItemClickEventArgs) Handles BarButtonItem24.ItemClick - frmGoogle.ShowDialog() + + frmGoogle.Show() End Sub End Class