413 lines
16 KiB
VB.net
413 lines
16 KiB
VB.net
Imports DevExpress.XtraMap
|
|
Imports DevExpress.XtraEditors
|
|
Imports DevExpress.XtraGrid
|
|
Imports DevExpress.Map
|
|
Imports DevExpress.Utils
|
|
Imports DevExpress.XtraGrid.Columns
|
|
Imports DevExpress.XtraEditors.Repository
|
|
|
|
Public Class frmGeodataNavigation
|
|
|
|
Private BING_KEY As String = "hQUTlqLLK70bETnonpfi~0jx1pIAq1yQ7gXqbIyzKrg~Au-Tewbty8afAxdbNilSv4JlU7qwU-fQKu0ouH9e1uJmpIyVdA3jugVEWMdy1Rbt"
|
|
Private EntityId As Integer = Nothing
|
|
Private EntitySql As String = Nothing
|
|
Private EntityDataTable As DataTable = Nothing
|
|
Private ConstructorMain_Grid As GridControl = Nothing
|
|
Private CurrentPoint As GeoPoint = Nothing
|
|
|
|
|
|
#Region "MAP CONTROL"
|
|
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
|
|
|
|
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 rows As DataRow() = EntityDataTable.Select("LATITUDE IS NOT NULL AND LONGITUDE IS NOT NULL")
|
|
|
|
' PushPins
|
|
For Each row As DataRow In 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)
|
|
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 mit Koordinaten gefunden", items.Count)
|
|
|
|
'MapControl1.ZoomToFitLayerItems()
|
|
End Sub
|
|
#End Region
|
|
|
|
|
|
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.ConstructorMain_Grid = gridControl
|
|
'Me.EntityId = EntityId
|
|
'Me.EntitySql = String.Format("SELECT T.*, T1.LATITUDE, T1.LONGITUDE from VWPMO_ENTITY_TABLE{0} T,TBPMO_RECORD_GEODATA T1 WHERE T.[Record-ID] = T1.RECORD_ID", Me.EntityId)
|
|
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
|
|
|
|
Dim XMLPath = Get_Settings_Filename()
|
|
Dim layout As New ClassLayout(XMLPath)
|
|
Dim settings As New System.Collections.Generic.List(Of ClassSetting)
|
|
settings = layout.Load()
|
|
|
|
Dim centerX, centerY As Double
|
|
|
|
For Each setting In settings
|
|
Select Case setting._name
|
|
Case "MapControl_ZoomLevel"
|
|
MapControl1.ZoomLevel = Double.Parse(setting._value)
|
|
Case "MapControl_CenterX"
|
|
centerX = Double.Parse(setting._value)
|
|
Case "MapControl_CenterY"
|
|
centerY = Double.Parse(setting._value)
|
|
End Select
|
|
Next
|
|
|
|
Dim center As New GeoPoint(centerY, centerX)
|
|
MapControl1.SetCenterPoint(center, False)
|
|
|
|
|
|
EntitySql = Get_Grid_Sql(CURRENT_CONSTRUCTOR_ID, CURRENT_ENTITY_ID, CURRENT_CONSTRUCTOR_DETAIL_ID, frmConstructor_Main.GridType.Grid, USER_GUID, String.Empty, False, 1, 0, GridControlGeo, grvwMain, True)
|
|
LoadData()
|
|
|
|
Catch ex As Exception
|
|
MsgBox("Error while loading GeoData: " & vbNewLine & ex.Message)
|
|
End Try
|
|
End Sub
|
|
|
|
Private Sub frmGeodataNavigation_FormClosing(sender As Object, e As FormClosingEventArgs) Handles Me.FormClosing
|
|
Try
|
|
Dim gridView As Views.Grid.GridView = Me.ConstructorMain_Grid.FocusedView
|
|
gridView.ActiveFilterString = Nothing
|
|
|
|
Dim zoomLevel = MapControl1.ZoomLevel
|
|
Dim xCoord = MapControl1.CenterPoint.GetX
|
|
Dim yCoord = MapControl1.CenterPoint.GetY
|
|
|
|
Dim XMLPath = Get_Settings_Filename()
|
|
Dim layout As New ClassLayout(XMLPath)
|
|
Dim settings As New System.Collections.Generic.List(Of ClassSetting)
|
|
|
|
settings.Add(New ClassSetting("MapControl_ZoomLevel", zoomLevel))
|
|
settings.Add(New ClassSetting("MapControl_CenterX", xCoord))
|
|
settings.Add(New ClassSetting("MapControl_CenterY", yCoord))
|
|
|
|
layout.Save(settings)
|
|
|
|
Catch ex As Exception
|
|
MsgBox("Error in frmGeodataNavigation_FormClosing: " & vbNewLine & ex.Message)
|
|
End Try
|
|
End Sub
|
|
|
|
Private Function Get_Settings_Filename()
|
|
Dim Filename As String = String.Format("{0}-Geodata-Layout.xml", CURRENT_CONSTRUCTOR_ID)
|
|
Return System.IO.Path.Combine(Application.UserAppDataPath(), Filename)
|
|
End Function
|
|
|
|
Private Sub LoadData()
|
|
Dim rowhandle As Integer = grvwMain.FocusedRowHandle
|
|
|
|
EntityDataTable = ClassDatabase.Return_Datatable(EntitySql)
|
|
LoadItemList()
|
|
LoadGridData()
|
|
|
|
grvwMain.FocusedRowHandle = rowhandle
|
|
End Sub
|
|
|
|
|
|
Private Sub LoadGridData()
|
|
If IsNothing(EntityDataTable) Then
|
|
Exit Sub
|
|
End If
|
|
|
|
Dim gridFormatter As New ClassGridFormatter.ConstructorView(EntityDataTable, CURRENT_ENTITY_ID)
|
|
Dim DT_RESULT As DataTable = gridFormatter.FormatDatatable()
|
|
GridControlGeo.DataSource = DT_RESULT
|
|
gridFormatter.FormatGridView(grvwMain)
|
|
|
|
'Dim listcheck As List(Of String) = ClassHelper.Return_listcheck(CURRENT_ENTITY_ID)
|
|
'Dim listdate As List(Of String) = ClassHelper.Return_listdate(CURRENT_ENTITY_ID)
|
|
|
|
'Dim CheckBoxEditorForDisplay = New RepositoryItemCheckEdit()
|
|
'CheckBoxEditorForDisplay.ValueChecked = 1
|
|
'CheckBoxEditorForDisplay.ValueUnchecked = 0
|
|
'GridControlGeo.RepositoryItems.Add(CheckBoxEditorForDisplay)
|
|
|
|
'' Alle Checkbox Spalten durchgehen und CheckBoxEditor zuweisen
|
|
'For Each col As String In listcheck
|
|
' If Not IsNothing(grvwMain.Columns(col)) Then
|
|
' grvwMain.Columns(col).ColumnEdit = CheckBoxEditorForDisplay
|
|
' End If
|
|
'Next
|
|
|
|
'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
|
|
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.ConstructorMain_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
|
|
If e.RowHandle = DevExpress.XtraGrid.GridControl.AutoFilterRowHandle Then
|
|
e.Appearance.BackColor = Color.Orange 'LemonChiffon
|
|
End If
|
|
|
|
If e.RowHandle > 0 Then
|
|
Dim row As DataRowView = grvwMain.GetRow(e.RowHandle)
|
|
Dim LATITUDE = row.Item("LATITUDE")
|
|
Dim LONGITUDE = row.Item("LONGITUDE")
|
|
|
|
If IsDBNull(LATITUDE) Or IsDBNull(LONGITUDE) Then
|
|
e.Appearance.BackColor = Color.Red
|
|
e.HighPriority = True
|
|
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
|
|
|
|
If currentRow Is Nothing Then
|
|
Exit Sub
|
|
End If
|
|
|
|
If currentRow IsNot Nothing AndAlso Not IsDBNull(currentRow.Item("LATITUDE")) And Not IsDBNull(currentRow.Item("LONGITUDE")) Then
|
|
Dim validLat As Boolean = Decimal.TryParse(currentRow.Item("LATITUDE"), lat)
|
|
Dim validLon As Boolean = Decimal.TryParse(currentRow.Item("LONGITUDE"), lon)
|
|
|
|
If validLat And validLon Then
|
|
txtLat.Text = lat
|
|
txtLon.Text = lon
|
|
Else
|
|
txtLat.Text = String.Empty
|
|
txtLon.Text = String.Empty
|
|
End If
|
|
Else
|
|
txtLat.Text = String.Empty
|
|
txtLon.Text = String.Empty
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub btnOpenMap_Click(sender As Object, e As EventArgs) Handles btnOpenMap.Click
|
|
Dim point As GeoPoint = GetCurrentPoint()
|
|
|
|
Dim frm As New frmGeodataSelect(point)
|
|
Dim result = frm.ShowDialog()
|
|
|
|
If result = System.Windows.Forms.DialogResult.OK Then
|
|
Dim SelectedPoint As GeoPoint = frm.SelectedPoint
|
|
|
|
txtLat.Text = SelectedPoint.Latitude
|
|
txtLon.Text = SelectedPoint.Longitude
|
|
|
|
SaveCurrentPoint()
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub btnSave_Click(sender As Object, e As EventArgs) Handles btnSave.Click
|
|
SaveCurrentPoint()
|
|
End Sub
|
|
|
|
|
|
Private Sub SaveCurrentPoint()
|
|
Dim point As GeoPoint = GetCurrentPoint()
|
|
|
|
If point Is Nothing Then
|
|
' TODO: Add Error Mesg
|
|
Exit Sub
|
|
End If
|
|
|
|
Try
|
|
Dim currentRow As DataRowView = grvwMain.GetFocusedRow()
|
|
Dim RecordId As Integer = currentRow.Item("Record-ID")
|
|
|
|
Dim geoDataExists As Boolean = ClassDatabase.Execute_Scalar("SELECT RECORD_ID FROM TBPMO_RECORD_GEODATA WHERE RECORD_ID = " & RecordId)
|
|
|
|
If geoDataExists Then
|
|
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 = point.Latitude
|
|
cmd.Parameters.Add("@lon", SqlDbType.Decimal).Value = point.Longitude
|
|
cmd.Parameters.Add("@who", SqlDbType.VarChar).Value = Environment.UserName
|
|
cmd.Parameters.Add("@recordid", SqlDbType.Int).Value = RecordId
|
|
|
|
conn.Open()
|
|
cmd.ExecuteNonQuery()
|
|
conn.Close()
|
|
Else
|
|
Dim SQL As String = "INSERT INTO TBPMO_RECORD_GEODATA (LATITUDE,LONGITUDE,ADDED_WHO,RECORD_ID) VALUES (@lat,@lon,'@who',@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 = point.Latitude
|
|
cmd.Parameters.Add("@lon", SqlDbType.Decimal).Value = point.Longitude
|
|
cmd.Parameters.Add("@who", SqlDbType.VarChar).Value = Environment.UserName
|
|
cmd.Parameters.Add("@recordid", SqlDbType.Int).Value = RecordId
|
|
|
|
conn.Open()
|
|
cmd.ExecuteNonQuery()
|
|
conn.Close()
|
|
End If
|
|
|
|
LoadData()
|
|
Catch ex As Exception
|
|
MsgBox("Error while saving Coordinates: " & vbNewLine & ex.Message)
|
|
End Try
|
|
End Sub
|
|
|
|
Private Function GetCurrentPoint() As GeoPoint
|
|
Dim lat, lon As Decimal
|
|
|
|
Dim validLat As Boolean = Decimal.TryParse(txtLat.Text, lat)
|
|
Dim validLon As Boolean = Decimal.TryParse(txtLon.Text, lon)
|
|
|
|
If validLat And validLon Then
|
|
Return New GeoPoint(lat, lon)
|
|
Else
|
|
Return Nothing
|
|
End If
|
|
|
|
End Function
|
|
|
|
Private Sub ToolStripButton1_Click(sender As Object, e As EventArgs) Handles btnReload.Click
|
|
LoadData()
|
|
End Sub
|
|
|
|
Private Sub btnDelete_Click(sender As Object, e As EventArgs) Handles btnDelete.Click
|
|
Try
|
|
Dim result As DialogResult = MessageBox.Show("Wollen Sie die Koordinaten für diesen Datensatz löschen?", "Koordinaten löschen", MessageBoxButtons.YesNo, MessageBoxIcon.Question)
|
|
|
|
If result = System.Windows.Forms.DialogResult.Yes Then
|
|
Dim currentRow As DataRowView = grvwMain.GetFocusedRow()
|
|
Dim RecordId As Integer = currentRow.Item("Record-ID")
|
|
Dim sql = "DELETE FROM TBPMO_RECORD_GEODATA WHERE RECORD_ID = " & RecordId
|
|
|
|
ClassDatabase.Execute_Scalar(sql)
|
|
|
|
LoadData()
|
|
End If
|
|
Catch ex As Exception
|
|
MsgBox("Error while deleting Coordinates:" & vbNewLine & ex.Message)
|
|
End Try
|
|
End Sub
|
|
End Class |