Imports DevExpress.XtraMap Imports DevExpress.XtraEditors Imports DevExpress.XtraGrid Imports DevExpress.Utils Imports DevExpress.XtraGrid.Columns Public Class frmGeodataNavigation Private BING_KEY As String = "hQUTlqLLK70bETnonpfi~0jx1pIAq1yQ7gXqbIyzKrg~Au-Tewbty8afAxdbNilSv4JlU7qwU-fQKu0ouH9e1uJmpIyVdA3jugVEWMdy1Rbt" Private EntityId As Integer = Nothing Private EntitySql As String = Nothing Private Grid As GridControl = Nothing Private CurrentPoint As GeoPoint = Nothing Private ReadOnly Property ImageLayer() As ImageTilesLayer Get Return CType(MapControl1.Layers("ImageLayer"), ImageTilesLayer) End Get End Property Private ReadOnly Property VectorLayer() As VectorItemsLayer Get Return CType(MapControl1.Layers("VectorLayer"), VectorItemsLayer) End Get End Property Public Sub New(ByRef gridControl As GridControl, ByVal EntityId As Integer) ' Dieser Aufruf ist für den Designer erforderlich. InitializeComponent() ' Fügen Sie Initialisierungen nach dem InitializeComponent()-Aufruf hinzu. Me.Grid = gridControl Me.EntityId = EntityId Me.EntitySql = String.Format("SELECT T.*, T1.LATITUDE, T1.LONGITUDE from VWTEMP_PMO_FORM{0} T,TBPMO_RECORD_GEODATA T1 WHERE T.[Record-ID] = T1.RECORD_ID", Me.EntityId) End Sub Private Function CreateItemList() ' Liste für PushPins anlegen 'Dim items As New List(Of MapPushpin) Dim items As New List(Of MapCustomElementEx) ' Datensätze mit Lat,Lon Werten laden Dim dt As DataTable = ClassDatabase.Return_Datatable(Me.EntitySql) ' PushPins For Each row As DataRow In dt.Rows Dim lat As Double = row.Item("LATITUDE") Dim lon As Double = row.Item("LONGITUDE") Dim customElement = New MapCustomElementEx() With { .Location = New GeoPoint(lat, lon), .Text = row.Item("Record-ID").ToString(), .Information = row.Item("Record-ID") } customElement.Image = New Bitmap(My.Resources.pushpin, New Size(30, 30)) customElement.Padding = New Padding(10, 5, 10, 5) customElement.SelectedFill = Color.White items.Add(customElement) 'Dim pushpin As New MapPushpin() 'pushpin.Location = New GeoPoint(lat, lon) 'pushpin.Text = row.Item("Record-ID").ToString() 'pushpin.Information = row.Item("Record-ID") 'items.Add(pushpin) Next Return items End Function Private Sub LoadItemList() 'Dim items As List(Of MapPushpin) = CreateItemList() Dim items As List(Of MapCustomElementEx) = CreateItemList() Dim storage As New MapItemStorage() storage.Items.Clear() storage.Items.AddRange(items.ToArray()) VectorLayer.Data = storage tsLabelRecordCount.Text = String.Format("{0} Elemente gefunden", items.Count) MapControl1.ZoomToFitLayerItems() End Sub Private Sub frmGeodataNavigation_FormClosing(sender As Object, e As FormClosingEventArgs) Handles Me.FormClosing Try Dim gridView As Views.Grid.GridView = Me.Grid.FocusedView gridView.ActiveFilterString = Nothing Catch ex As Exception MsgBox("Error in frmGeodataNavigation_FormClosing: " & vbNewLine & ex.Message) End Try End Sub Private Sub frmGeodataNavigation_Load(sender As Object, e As EventArgs) Handles MyBase.Load Try Dim dataProvider As New BingMapDataProvider() dataProvider.BingKey = BING_KEY ImageLayer.DataProvider = dataProvider LoadItemList() Dim sql = Get_Grid_Sql(CURRENT_CONSTRUCTOR_ID, CURRENT_FORM_ID, CURRENT_CONSTRUCTOR_DETAIL_ID, frmConstructor_Main.GridType.Grid, USER_GUID, String.Empty, False, 1, 0, GridControlGeo, grvwMain, True) If Not IsNothing(sql) Then Dim DT_GEO As DataTable = ClassDatabase.Return_Datatable(sql) GridControlGeo.DataSource = DT_GEO End If Dim listcheck As List(Of String) = ClassHelper.Return_listcheck(CURRENT_FORM_ID) Dim listdate As List(Of String) = ClassHelper.Return_listdate(CURRENT_FORM_ID) For Each col As String In listdate Dim date_edit As New DevExpress.XtraEditors.Repository.RepositoryItemTimeEdit Dim date_column As GridColumn = grvwMain.Columns(col) date_column.DisplayFormat.FormatType = FormatType.DateTime date_column.DisplayFormat.FormatString = CURRENT_DATE_FORMAT date_column.OptionsFilter.FilterPopupMode = FilterPopupMode.Date date_column.ColumnEdit = date_edit date_column.FilterMode = ColumnFilterMode.Value ' was DisplayText date_edit.DisplayFormat.FormatType = FormatType.DateTime date_edit.DisplayFormat.FormatString = CURRENT_DATE_FORMAT date_edit.Mask.MaskType = Mask.MaskType.DateTime date_edit.Mask.EditMask = CURRENT_DATE_FORMAT date_edit.Mask.UseMaskAsDisplayFormat = True Next ' Styles for GridControl grvwMain.FocusRectStyle = DevExpress.XtraGrid.Views.Grid.DrawFocusRectStyle.None grvwMain.OptionsBehavior.Editable = False grvwMain.OptionsSelection.EnableAppearanceFocusedCell = False grvwMain.OptionsSelection.EnableAppearanceFocusedRow = False grvwMain.OptionsSelection.EnableAppearanceHideSelection = False grvwMain.Columns("AddedWhen").DisplayFormat.FormatType = FormatType.DateTime grvwMain.Columns("AddedWhen").DisplayFormat.FormatString = CURRENT_DATE_FORMAT & " HH:MM:ss" grvwMain.Columns("ChangedWhen").DisplayFormat.FormatType = FormatType.DateTime grvwMain.Columns("ChangedWhen").DisplayFormat.FormatString = CURRENT_DATE_FORMAT & " HH:MM:ss" grvwMain.Columns("Record-ID").Visible = False grvwMain.Columns("Form-ID").Visible = False grvwMain.Columns("ROW_COLOR").Visible = False Catch ex As Exception MsgBox("Error while loading GeoData: " & vbNewLine & ex.Message) End Try End Sub Private Sub SetGridFilter(records As List(Of Integer)) Try Dim filter As New List(Of String) For Each id As Integer In records filter.Add(String.Format("[Record-Id] = {0}", id)) Next Dim gridView As Views.Grid.GridView = Me.Grid.FocusedView gridView.ActiveFilterString = String.Join(" OR ", filter.ToArray()) Catch ex As Exception MsgBox("Error in SetGridFilter: " & vbNewLine & ex.Message) End Try End Sub Private Sub MapControl1_SelectionChanged(sender As Object, e As MapSelectionChangedEventArgs) Handles MapControl1.SelectionChanged Dim items As List(Of Object) = e.Selection Dim records As New List(Of Integer) For Each item As Object In items Try 'Dim pin As MapPushpin = CType(item, MapPushpin) 'Dim recordId As Integer = pin.Information Dim el As MapCustomElementEx = CType(item, MapCustomElementEx) Dim recordId As Integer = el.Information records.Add(recordId) Catch ex As Exception MsgBox("Cannot convert selection to MapCustomElementEx") End Try Next SetGridFilter(records) End Sub Class MapCustomElementEx Inherits MapCustomElement Public Property Information As Object End Class Private Sub XtraTabControl1_TabIndexChanged(sender As Object, e As EventArgs) Handles XtraTabControl1.TabIndexChanged End Sub Private Sub grvwMain_RowStyle(sender As Object, e As Views.Grid.RowStyleEventArgs) Handles grvwMain.RowStyle 'TODO: Make Rows without geodata RED If e.RowHandle <> -1 Then Dim row As DataRowView = grvwMain.GetRow(e.RowHandle) Dim LATITUDE = row.Item("LATITUDE") Dim LONGITUDE = row.Item("LONGITUDE") If LATITUDE Is Nothing Or LONGITUDE Is Nothing Then e.Appearance.BackColor = Color.Red End If End If End Sub Private Sub grvwMain_FocusedRowChanged(sender As Object, e As Views.Base.FocusedRowChangedEventArgs) Handles grvwMain.FocusedRowChanged Dim currentRow As DataRowView = grvwMain.GetFocusedRow() Dim lat, lon As Decimal Try lat = currentRow.Item("LATITUDE") lon = currentRow.Item("LONGITUDE") Catch ex As InvalidCastException lat = -1 lon = -1 End Try If lat = -1 And lon = -1 Then txtLat.Text = String.Empty txtLon.Text = String.Empty CurrentPoint = Nothing Else txtLat.Text = lat txtLon.Text = lon CurrentPoint = New GeoPoint(lat, lon) End If End Sub Private Sub btnOpenMap_Click(sender As Object, e As EventArgs) Handles btnOpenMap.Click Dim lat, lon As Double Dim point As GeoPoint Try lat = Double.Parse(txtLat.Text) lon = Double.Parse(txtLon.Text) point = New GeoPoint(lat, lon) Catch ex As Exception point = Nothing Finally Dim frm As New frmGeodataSelect(point) Dim result = frm.ShowDialog() If result = Windows.Forms.DialogResult.OK Then Dim SelectedPoint As GeoPoint = frm.SelectedPoint txtLat.Text = SelectedPoint.Latitude txtLon.Text = SelectedPoint.Longitude CurrentPoint = SelectedPoint End If End Try End Sub Private Sub btnSave_Click(sender As Object, e As EventArgs) Handles btnSave.Click If CurrentPoint Is Nothing Then MsgBox("Es wurden keine Koodinaten angegeben!", MsgBoxStyle.Critical) Exit Sub End If Try Dim lat As Decimal = CurrentPoint.Latitude Dim lon As Decimal = CurrentPoint.Longitude Dim currentRow As DataRowView = grvwMain.GetFocusedRow() Dim RecordId As Integer = currentRow.Item("Record-ID") Dim SQL As String = "UPDATE TBPMO_RECORD_GEODATA SET LATITUDE = @lat, LONGITUDE = @lon, CHANGED_WHO = @who WHERE RECORD_ID = @recordid" Dim conn As SqlClient.SqlConnection = New SqlClient.SqlConnection(MyConnectionString) Dim cmd As SqlClient.SqlCommand = New SqlClient.SqlCommand(SQL, conn) cmd.Parameters.Add("@lat", SqlDbType.Decimal).Value = lat cmd.Parameters.Add("@lon", SqlDbType.Decimal).Value = lon cmd.Parameters.Add("@who", SqlDbType.VarChar).Value = Environment.UserName cmd.Parameters.Add("@recordid", SqlDbType.Int).Value = RecordId conn.Open() cmd.ExecuteNonQuery() conn.Close() Catch ex As Exception MsgBox("Error while saving Coordinates: " & vbNewLine & ex.Message) End Try End Sub End Class