Files
TaskFlow/app/TaskFlow/ControlCreator/GridControl.vb

996 lines
52 KiB
VB.net
Raw Blame History

This file contains ambiguous Unicode characters
This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
Imports DevExpress.Utils
Imports DevExpress.XtraEditors
Imports DevExpress.XtraEditors.Repository
Imports DevExpress.XtraGrid.Columns
Imports DevExpress.XtraGrid.Views.Grid
Imports DigitalData.Controls.LookupGrid
Imports DigitalData.Modules.EDMI.API.Constants
Imports DigitalData.Modules.EDMI.API.DatabaseWithFallback
Imports DigitalData.Modules.Logging
Imports DigitalData.Modules.Base
Imports System.ComponentModel
Imports DevExpress.XtraEditors.Controls
Imports DevExpress.XtraGrid.Views.Base
Imports System.Text.RegularExpressions
Imports System.Globalization
Imports DevExpress.Xpo.Helpers.AssociatedCollectionCriteriaHelper
Imports DevExpress.XtraEditors.Mask
Imports System.Windows.Forms
Namespace ControlCreator
Public Class GridControl
Private ReadOnly _LogConfig As LogConfig
Private ReadOnly _Logger As Logger
Private ReadOnly _GridTables As Dictionary(Of Integer, Dictionary(Of String, RepositoryItem))
Private newRowModified As Boolean
Private isApplyingInheritedValue As Boolean
Private _FormulaColumnNames As New HashSet(Of String)(StringComparer.OrdinalIgnoreCase)
Private _isRefreshingFormula As Boolean = False ' *** NEU: Flag für Formel-Refresh ***
Private _currencySymbol As String = ""
Public Sub New(pLogConfig As LogConfig, pGridTables As Dictionary(Of Integer, Dictionary(Of String, RepositoryItem)), pCurrencySymbol As String)
_LogConfig = pLogConfig
_Logger = pLogConfig.GetLogger()
_GridTables = pGridTables
_currencySymbol = pCurrencySymbol
End Sub
Public Function CreateGridColumns(pColumnTable As DataTable) As DataTable
Dim oDataTable As New DataTable
Dim columnsWithExpressions As New List(Of Tuple(Of DataColumn, String))
For Each oRow As DataRow In pColumnTable.Rows
' Create Columns in Datatable
Dim oColumn = New DataColumn() With {
.ColumnName = oRow.Item("SPALTENNAME"),
.Caption = oRow.Item("SPALTEN_HEADER_LANG"),
.ReadOnly = False
}
Select Case oRow.Item("TYPE_COLUMN")
Case Constants.CONTROL_TYPE_TEXT
oColumn.DataType = GetType(String)
Case Constants.CONTROL_TYPE_INTEGER
oColumn.DataType = GetType(Integer)
Case Constants.CONTROL_TYPE_DOUBLE
oColumn.DataType = GetType(Double)
Case Constants.CONTROL_TYPE_CURRENCY
oColumn.DataType = GetType(Double)
Case Constants.CONTROL_TYPE_BOOLEAN
oColumn.DataType = GetType(Boolean)
Case Else
oColumn.DataType = GetType(String)
End Select
Dim oFormulaExpression = ObjectEx.NotNull(oRow.Item("FORMULA_EXPRESSION"), String.Empty)
If oFormulaExpression <> String.Empty Then
' Expression merken, aber erst später setzen
columnsWithExpressions.Add(New Tuple(Of DataColumn, String)(oColumn, oFormulaExpression))
End If
Try
oDataTable.Columns.Add(oColumn)
Catch ex As Exception
_Logger.Warn("⚠️ Could not add column {0} to DataTable", oColumn.ColumnName)
_Logger.Error(ex)
End Try
Next
' Jetzt alle Expressions setzen, nachdem alle Spalten existieren
For Each columnExpressionPair In columnsWithExpressions
Dim oColumn = columnExpressionPair.Item1
Dim oExpression = columnExpressionPair.Item2
Try
_Logger.Debug("Setting expression for column [{0}]: {1}", oColumn.ColumnName, oExpression)
' Prüfe, ob alle referenzierten Spalten existieren
Dim referencedColumns = GetReferencedColumnNames(oExpression)
For Each refCol In referencedColumns
If Not oDataTable.Columns.Contains(refCol) Then
_Logger.Warn("⚠️ Referenced column [{0}] does not exist in DataTable!", refCol)
MsgBox(String.Format("Referenced column [{0}] does not exist in DataTable!", refCol), MsgBoxStyle.Exclamation)
Else
_Logger.Debug("Referenced column [{0}] exists with DataType: {1}", refCol, oDataTable.Columns(refCol).DataType.Name)
End If
Next
oColumn.Expression = oExpression
oColumn.ReadOnly = True
_Logger.Info("✓ Expression successfully set for column [{0}]: {1}", oColumn.ColumnName, oColumn.Expression)
Catch ex As Exception
_Logger.Warn("⚠️ Invalid FORMULA_EXPRESSION for column {0}: {1}", oColumn.ColumnName, oExpression)
_Logger.Error(ex)
MsgBox(String.Format("The column '{0}' inlcudes an invalid formula: {1}. Please check the FORMULA_EXPRESSION in the table designer." & vbCrLf &
"Error: {2}", oColumn.ColumnName, oExpression, ex.Message), MsgBoxStyle.Exclamation, "Ungültige Formel")
End Try
Next
Return oDataTable
End Function
Private Function GetReferencedColumnNames(expression As String) As List(Of String)
Dim columnNames As New List(Of String)
Dim pattern As String = "\[([^\]]+)\]"
Dim matches = Regex.Matches(expression, pattern)
For Each match As Match In matches
columnNames.Add(match.Groups(1).Value)
Next
Return columnNames
End Function
Public Function FillGridTables(pColumnTable As DataTable, pControlId As Integer, pControlName As String) As Dictionary(Of Integer, Dictionary(Of String, RepositoryItem))
For Each oRow As DataRow In pColumnTable.Rows
' Fetch and cache Combobox results
Dim oConnectionId As Integer = oRow.ItemEx("CONNECTION_ID", 0)
Dim oSqlCommand As String = oRow.ItemEx("SQL_COMMAND", "")
If oSqlCommand <> "" Then
Try
Dim oComboboxDataTable As DataTable = Nothing
Dim oColumnName As String = oRow.Item("SPALTENNAME")
_Logger.Debug("Working on SQL for Column[{0}]...", oColumnName)
If Not clsPatterns.HasComplexPatterns(oSqlCommand) Then
_Logger.Debug("SQL has no complex patterns!")
'oComboboxDataTable = ClassDatabase.Return_Datatable_ConId(oSqlCommand, oConnectionId)
oComboboxDataTable = DatabaseFallback.GetDatatable(New GetDatatableOptions(oSqlCommand, DatabaseType.ECM) With {
.ConnectionId = oConnectionId
})
Else
_Logger.Debug("...has complex patterns!!")
End If
Dim oRepositoryItem = GridTables_GetRepositoryItemForColumn(oColumnName, oComboboxDataTable, oRow.Item("ADVANCED_LOOKUP"))
If _GridTables.Item(pControlId).ContainsKey(oColumnName) Then
_GridTables.Item(pControlId).Item(oColumnName) = oRepositoryItem
Else
_GridTables.Item(pControlId).Add(oColumnName, oRepositoryItem)
End If
Catch ex As Exception
_Logger.Warn("⚠️ Could not load data for column {0} in control {1}", oRow.Item("SPALTENNAME"), pControlName)
_Logger.Error(ex)
End Try
End If
Next
Return _GridTables
End Function
Private Function GridTables_GetRepositoryItemForColumn(pColumnName As String, pDataTable As DataTable, pIsAdvancedLookup As Boolean) As RepositoryItem
If pIsAdvancedLookup Then
Dim oEditor = New RepositoryItemLookupControl3
If pDataTable IsNot Nothing Then
oEditor.DisplayMember = pDataTable.Columns.Item(0).ColumnName
oEditor.ValueMember = pDataTable.Columns.Item(0).ColumnName
oEditor.DataSource = pDataTable
End If
Return oEditor
Else
Dim oEditor = New RepositoryItemComboBox()
Dim oItems As New List(Of String)
AddHandler oEditor.Validating, Sub(_sender As ComboBoxEdit, _e As CancelEventArgs)
If oItems.Contains(_sender.EditValue) Then
_e.Cancel = False
Else
_e.Cancel = True
End If
End Sub
If pDataTable IsNot Nothing Then
For Each oRow2 As DataRow In pDataTable.Rows
Dim oValue = oRow2.Item(0)
Try
If oRow2.ItemArray.Length > 1 Then
oValue &= $" | {oRow2.Item(1)}"
End If
Catch ex As Exception
End Try
oEditor.Items.Add(oValue)
oItems.Add(oValue)
Next
End If
Return oEditor
End If
End Function
' Hilfsroutine: passt NUR das Summary-Item an (ohne FormatInfo)
Private Sub ApplyCurrencySummaryFormat(oCol As GridColumn)
oCol.SummaryItem.SummaryType = DevExpress.Data.SummaryItemType.Sum
' Variante A: Standard-Währungsformat aus aktueller Kultur
' oCol.SummaryItem.DisplayFormat = "SUM: {0:C2}"
' Variante B: Kulturunabhängig, Symbol explizit anhängen
oCol.SummaryItem.DisplayFormat = $"SUM: {{0:N2}} {_currencySymbol}"
End Sub
Public Sub ConfigureViewColumns(pColumnTable As DataTable, pGridView As GridView, pGrid As DevExpress.XtraGrid.GridControl)
Dim oShouldDisplayFooter As Boolean = False
For Each oCol As GridColumn In pGridView.Columns
Dim oColumnData As DataRow = pColumnTable.
Select($"SPALTENNAME = '{oCol.FieldName}'").
FirstOrDefault()
If oColumnData Is Nothing Then
Continue For
End If
Dim oSequence As Integer = oColumnData.Item("SEQUENCE")
oCol.VisibleIndex = oSequence
' READ_ONLY Eigenschaft verarbeiten
Dim oIsReadOnly As Boolean = False
Dim oReadOnlyValue = ObjectEx.NotNull(oColumnData.Item("READ_ONLY"), False)
If TypeOf oReadOnlyValue Is Boolean Then
oIsReadOnly = CBool(oReadOnlyValue)
Else
Dim oReadOnlyInt As Integer
oIsReadOnly = Integer.TryParse(oReadOnlyValue.ToString(), oReadOnlyInt) AndAlso oReadOnlyInt = 1
End If
Dim oFormulaExpression = ObjectEx.NotNull(oColumnData.Item("FORMULA_EXPRESSION"), String.Empty)
If oFormulaExpression <> String.Empty Then
oIsReadOnly = True
End If
oCol.OptionsColumn.AllowEdit = Not oIsReadOnly
Dim oColumnType As String = oColumnData.Item("TYPE_COLUMN")
Select Case oColumnType
Case "INTEGER"
oCol.DisplayFormat.FormatType = FormatType.Custom
oCol.DisplayFormat.FormatString = "N0"
Case "DOUBLE"
oCol.DisplayFormat.FormatType = FormatType.Custom
oCol.DisplayFormat.FormatString = "N2"
Case "CURRENCY"
oCol.DisplayFormat.FormatType = FormatType.Custom
oCol.DisplayFormat.FormatString = $"N2 {_currencySymbol}"
End Select
Dim oSummaryFunction As String = oColumnData.Item("SUMMARY_FUNCTION")
Select Case oSummaryFunction
Case Constants.AGGREGATE_TOTAL_INTEGER
oCol.SummaryItem.SummaryType = DevExpress.Data.SummaryItemType.Sum
oCol.SummaryItem.DisplayFormat = "SUM: {0:N0}"
oShouldDisplayFooter = True
Case Constants.AGGREGATE_TOTAL_FLOAT
oCol.SummaryItem.SummaryType = DevExpress.Data.SummaryItemType.Sum
oCol.SummaryItem.DisplayFormat = "SUM: {0:N2}"
oShouldDisplayFooter = True
Case Constants.AGGREGATE_TOTAL_CURRENCY
ApplyCurrencySummaryFormat(oCol)
oShouldDisplayFooter = True
Case Constants.AGGREGATE_TOTAL_AVG
oCol.SummaryItem.SummaryType = DevExpress.Data.SummaryItemType.Average
oCol.SummaryItem.DisplayFormat = "AVG: {0}"
oShouldDisplayFooter = True
Case Constants.AGGREGATE_TOTAL_MAX
oCol.SummaryItem.SummaryType = DevExpress.Data.SummaryItemType.Max
oCol.SummaryItem.DisplayFormat = "MAX: {0}"
oShouldDisplayFooter = True
Case Constants.AGGREGATE_TOTAL_MIN
oCol.SummaryItem.SummaryType = DevExpress.Data.SummaryItemType.Min
oCol.SummaryItem.DisplayFormat = "MIN: {0}"
oShouldDisplayFooter = True
Case Constants.AGGREGATE_TOTAL_COUNT
oCol.SummaryItem.SummaryType = DevExpress.Data.SummaryItemType.Count
oCol.SummaryItem.DisplayFormat = "NUM: {0}"
oShouldDisplayFooter = True
End Select
Next
pGridView.OptionsView.ShowFooter = oShouldDisplayFooter
If oShouldDisplayFooter Then
With pGridView.Appearance.FooterPanel
.Options.UseFont = True
.Font = New Font(.Font.FontFamily, 8.0F, FontStyle.Bold)
End With
End If
End Sub
Public Sub ConfigureViewColumnsCurrency(pColumnTable As DataTable, pGridView As GridView, pGrid As DevExpress.XtraGrid.GridControl)
Dim oCultureInfo As CultureInfo = New CultureInfo("de-DE")
oCultureInfo.NumberFormat.CurrencySymbol = _currencySymbol
Dim riTextEdit As RepositoryItemTextEdit = New RepositoryItemTextEdit()
riTextEdit.MaskSettings.Configure(Of MaskSettings.Numeric)(Sub(settings)
settings.MaskExpression = "c"
settings.Culture = oCultureInfo
End Sub)
riTextEdit.UseMaskAsDisplayFormat = True
pGrid.RepositoryItems.Add(riTextEdit)
For Each oCol As GridColumn In pGridView.Columns
Dim oColumnData As DataRow = pColumnTable.
Select($"SPALTENNAME = '{oCol.FieldName}'").
FirstOrDefault()
If oColumnData Is Nothing Then
Continue For
End If
' *** NEU: Prüfe ob Spalte editierbar ist ***
If Not oCol.OptionsColumn.AllowEdit Then
_Logger.Debug("Skipping ColumnEdit for read-only column [{0}]", oCol.FieldName)
Continue For
End If
' Formel-Spalten dürfen kein ColumnEdit bekommen, da der RepositoryItem-Cache
' den berechneten Wert nach RefreshRowCell überschreibt.
Dim oFormulaExpression = ObjectEx.NotNull(oColumnData.Item("FORMULA_EXPRESSION"), String.Empty)
If oFormulaExpression <> String.Empty Then
_Logger.Debug("Skipping ColumnEdit assignment for formula column [{0}] using DisplayFormat only.", oCol.FieldName)
Continue For
End If
Dim oColumnType As String = oColumnData.Item("TYPE_COLUMN")
Select Case oColumnType
Case "CURRENCY"
' *** WICHTIG: NUR ColumnEdit setzen, KEIN DisplayFormat mehr! ***
oCol.ColumnEdit = riTextEdit
End Select
Next
End Sub
Public Sub ConfigureViewEvents(pColumnTable As DataTable, pGridView As GridView, pControl As Windows.Forms.Control, pControlId As Integer)
' Formel-Spalten-Namen einmalig cachen für View_ShowingEditor
_FormulaColumnNames.Clear()
For Each r As DataRow In pColumnTable.Rows
Dim oExpr = ObjectEx.NotNull(r.Item("FORMULA_EXPRESSION"), String.Empty).ToString()
If oExpr <> String.Empty Then
_FormulaColumnNames.Add(r.Item("SPALTENNAME").ToString())
End If
Next
AddHandler pGridView.InitNewRow, Sub(sender As Object, e As InitNewRowEventArgs)
Try
_Logger.Debug("Initialzing new row")
For Each oColumnData As DataRow In pColumnTable.Rows
For Each oGridColumn As GridColumn In pGridView.Columns
If oGridColumn.FieldName <> oColumnData.Item("SPALTENNAME") Then
Continue For
End If
Dim oDefaultValue = ObjectEx.NotNull(oColumnData.Item("DEFAULT_VALUE"), String.Empty)
If oDefaultValue <> String.Empty Then
_Logger.Debug("Setting default value [{0}] for column [{1}]", oDefaultValue, oGridColumn.FieldName)
pGridView.SetRowCellValue(e.RowHandle, oGridColumn.FieldName, oDefaultValue)
End If
Next
Next
Catch ex As Exception
_Logger.Error(ex)
Finally
newRowModified = False
End Try
End Sub
' *** NEU: CustomColumnDisplayText für robuste CURRENCY-Formatierung ***
AddHandler pGridView.CustomColumnDisplayText,
Sub(sender As Object, e As CustomColumnDisplayTextEventArgs)
If e.Column Is Nothing OrElse e.Value Is Nothing OrElse IsDBNull(e.Value) Then
Return
End If
' Prüfe ob Spalte vom Typ CURRENCY ist
Dim oColumnData As DataRow = pColumnTable.
Select($"SPALTENNAME = '{e.Column.FieldName}'").
FirstOrDefault()
If oColumnData IsNot Nothing AndAlso
oColumnData.Item("TYPE_COLUMN").ToString() = "CURRENCY" Then
Try
Dim oValue As Double
' *** KRITISCH: Robustes Parsing unabhängig vom Dezimaltrenner ***
If TypeOf e.Value Is Double OrElse TypeOf e.Value Is Decimal Then
oValue = Convert.ToDouble(e.Value)
ElseIf TypeOf e.Value Is String Then
Dim oStringValue As String = e.Value.ToString().Trim()
' Versuche zuerst deutsches Format (1.234,56)
Dim oDeCulture As CultureInfo = New CultureInfo("de-DE")
If Double.TryParse(oStringValue, NumberStyles.Currency Or NumberStyles.Number, oDeCulture, oValue) Then
' Erfolgreich mit deutschem Format geparst
ElseIf Double.TryParse(oStringValue, NumberStyles.Currency Or NumberStyles.Number, CultureInfo.InvariantCulture, oValue) Then
' Erfolgreich mit invariantem Format (Punkt als Dezimaltrenner)
Else
' Fallback: Systemkultur
oValue = Convert.ToDouble(oStringValue, CultureInfo.CurrentCulture)
End If
Else
oValue = Convert.ToDouble(e.Value)
End If
' Formatierung IMMER mit deutscher Kultur (Komma als Dezimaltrenner)
Dim oDeCultureInfo As CultureInfo = New CultureInfo("de-DE")
e.DisplayText = oValue.ToString("N2", oDeCultureInfo) & " " & _currencySymbol
Catch ex As Exception
_Logger.Warn("⚠️ Could not format currency value [{0}] for column [{1}]: {2}",
e.Value, e.Column.FieldName, ex.Message)
' Fallback: Original-Wert + Symbol
e.DisplayText = e.Value.ToString() & " " & _currencySymbol
End Try
End If
End Sub
AddHandler pGridView.CustomRowCellEdit, Sub(sender As Object, e As CustomRowCellEditEventArgs)
Try
For Each oRow As DataRow In pColumnTable.Rows
Dim oColumnName = oRow.Item("SPALTENNAME")
Dim oEditorExists = GridTables_TestEditorExistsByControlAndColumn(pControlId, oColumnName)
If oColumnName <> e.Column.FieldName Then
Continue For
End If
If oEditorExists Then
Dim oEditor = _GridTables.Item(pControlId).Item(oColumnName)
_Logger.Debug("Assigning Editor to Column [{0}]", oColumnName)
e.RepositoryItem = oEditor
Else
_Logger.Debug("Editor for Column [{0}] does not exist", oColumnName)
End If
Next
Catch ex As Exception
_Logger.Warn("⚠️ Error in CustomRowCellEdit for [{0}]", e.CellValue)
_Logger.Error(ex)
End Try
End Sub
AddHandler pGridView.ValidatingEditor, Sub(sender As Object, e As BaseContainerValidateEditorEventArgs)
Dim oRow As DataRowView = pGridView.GetRow(pGridView.FocusedRowHandle)
Dim oColumnName = pGridView.FocusedColumn.FieldName
_Logger.Debug("Validating Editor for Column [{0}]", oColumnName)
GridTables_ValidateColumn(pGridView, pColumnTable, oColumnName, e.Value, e.Valid, e.ErrorText)
End Sub
AddHandler pGridView.PopupMenuShowing, AddressOf View_PopupMenuShowing
AddHandler pGridView.InvalidRowException, AddressOf View_InvalidRowException
AddHandler pGridView.ValidatingEditor, AddressOf View_ValidatingEditor
AddHandler pGridView.ShownEditor,
Sub(sender As Object, e As EventArgs)
Dim view As GridView = TryCast(sender, GridView)
If view.IsNewItemRow(view.FocusedRowHandle) Then
_Logger.Debug("Attaching Modified Handler.")
AddHandler view.ActiveEditor.Modified, Sub()
_Logger.Debug("Row was modified.")
newRowModified = True
End Sub
End If
' *** KRITISCH: LIVE-REFRESH bei JEDER Eingabe (auch NewItemRow!) ***
If view.FocusedColumn IsNot Nothing AndAlso view.ActiveEditor IsNot Nothing Then
Dim oFocusedColumnName As String = view.FocusedColumn.FieldName
' Prüfen ob diese Spalte von Formel-Spalten referenziert wird
Dim oFormulaColumnsToRefresh As New List(Of String)
For Each oColumnData As DataRow In pColumnTable.Rows
Dim oExpr = ObjectEx.NotNull(oColumnData.Item("FORMULA_EXPRESSION"), String.Empty).ToString()
If oExpr = String.Empty Then Continue For
Dim referencedColumns = GetReferencedColumnNames(oExpr)
If referencedColumns.Any(Function(col) String.Equals(col, oFocusedColumnName, StringComparison.OrdinalIgnoreCase)) Then
oFormulaColumnsToRefresh.Add(oColumnData.Item("SPALTENNAME").ToString())
End If
Next
If oFormulaColumnsToRefresh.Count > 0 Then
_Logger.Debug("[FormulaRefresh] Attaching EditValueChanged handler for LIVE formula updates on column [{0}].", oFocusedColumnName)
' Handler für LIVE Aktualisierung während JEDER Eingabe
AddHandler view.ActiveEditor.EditValueChanged,
Sub(editorSender As Object, editorArgs As EventArgs)
Try
Dim oRowHandle As Integer = view.FocusedRowHandle
If Not view.IsValidRowHandle(oRowHandle) Then Return
Dim oEditor As DevExpress.XtraEditors.BaseEdit = TryCast(editorSender, DevExpress.XtraEditors.BaseEdit)
If oEditor Is Nothing Then Return
Dim isNewItemRow As Boolean = view.IsNewItemRow(oRowHandle)
Try
Dim oValue As Object = oEditor.EditValue
If TypeOf oEditor Is DevExpress.XtraEditors.TextEdit Then
Dim oTextEdit As DevExpress.XtraEditors.TextEdit = DirectCast(oEditor, DevExpress.XtraEditors.TextEdit)
If oTextEdit.Properties.MaskSettings IsNot Nothing Then
oValue = oEditor.EditValue
End If
End If
If isNewItemRow Then
_Logger.Debug("[FormulaRefresh] EditValueChanged (NewItemRow) setting value for [{0}] = [{1}].", oFocusedColumnName, oValue)
_isRefreshingFormula = True
Try
' Wert setzen
view.SetRowCellValue(oRowHandle, oFocusedColumnName, If(oValue Is Nothing, DBNull.Value, oValue))
' *** KRITISCH: DoEvents() damit SetRowCellValue processed wird ***
view.UpdateCurrentRow()
' Formel-Spalten SOFORT refreshen
For Each oFormulaColumnName As String In oFormulaColumnsToRefresh
Dim oGridColumn As GridColumn = view.Columns.ColumnByFieldName(oFormulaColumnName)
If oGridColumn IsNot Nothing Then
view.RefreshRowCell(oRowHandle, oGridColumn)
_Logger.Debug("[FormulaRefresh] (NewItemRow) Refreshed [{0}], current value: [{1}]",
oFormulaColumnName, view.GetRowCellValue(oRowHandle, oGridColumn))
End If
Next
Finally
_isRefreshingFormula = False
End Try
Else
' Bestehende Row
Dim oDataRow As DataRow = view.GetDataRow(oRowHandle)
If oDataRow IsNot Nothing Then
_Logger.Debug("[FormulaRefresh] EditValueChanged setting value for [{0}] in DataTable.", oFocusedColumnName)
oDataRow.Item(oFocusedColumnName) = If(oValue Is Nothing, DBNull.Value, oValue)
For Each oFormulaColumnName As String In oFormulaColumnsToRefresh
Dim oGridColumn As GridColumn = view.Columns.ColumnByFieldName(oFormulaColumnName)
If oGridColumn IsNot Nothing Then
view.RefreshRowCell(oRowHandle, oGridColumn)
Dim currentValue = view.GetRowCellValue(oRowHandle, oGridColumn)
_Logger.Debug("[FormulaRefresh] Current value for [{0}]: [{1}]", oFormulaColumnName, currentValue)
End If
Next
End If
End If
Catch parseEx As Exception
_Logger.Debug("[FormulaRefresh] Parse error during EditValueChanged: {0}", parseEx.Message)
End Try
Catch ex As Exception
_Logger.Error(ex)
End Try
End Sub
End If
End If
End Sub
AddHandler pGridView.ValidateRow, AddressOf View_ValidateRow
AddHandler pControl.LostFocus, AddressOf Control_LostFocus
AddHandler pGridView.ShowingEditor,
Sub(sender As Object, e As CancelEventArgs)
Try
Dim oView As GridView = TryCast(sender, GridView)
If oView Is Nothing Then Return
_Logger.Debug("Showing editor.")
' Formel-Spalten dürfen keinen Editor öffnen
If oView.FocusedColumn IsNot Nothing Then
Dim oFieldName As String = oView.FocusedColumn.FieldName
If _FormulaColumnNames.Contains(oFieldName) Then
_Logger.Debug("Cancelling editor column [{0}] is a formula column.", oFieldName)
e.Cancel = True
Return
End If
End If
If oView.IsNewItemRow(oView.FocusedRowHandle) AndAlso Not newRowModified Then
_Logger.Debug("Adding new row.")
oView.AddNewRow()
End If
Catch ex As Exception
_Logger.Error(ex)
End Try
End Sub
AddHandler pGridView.FocusedColumnChanged,
Sub(sender As Object, e As FocusedColumnChangedEventArgs)
Try
Dim oView As GridView = TryCast(sender, GridView)
If oView Is Nothing Then Return
Dim oRowHandle As Integer = oView.FocusedRowHandle
If oView.IsNewItemRow(oRowHandle) Then Return
If Not oView.IsValidRowHandle(oRowHandle) Then Return
If oView.FocusedColumn IsNot Nothing AndAlso
_FormulaColumnNames.Contains(oView.FocusedColumn.FieldName) Then
_Logger.Debug("[FormulaRefresh] FocusedColumnChanged closing editor on formula column [{0}].", oView.FocusedColumn.FieldName)
oView.CloseEditor()
End If
Catch ex As Exception
_Logger.Error(ex)
End Try
End Sub
AddHandler pGridView.CellValueChanged,
Sub(sender As Object, e As CellValueChangedEventArgs)
' *** HandleInheritedColumnValue MUSS zuerst aufgerufen werden ***
Try
HandleInheritedColumnValue(TryCast(sender, GridView), pColumnTable, e)
Catch ex As Exception
_Logger.Error(ex)
End Try
' *** Formel-Refresh via CellValueChanged ist FALLBACK ***
' (EditValueChanged macht das normalerweise schon LIVE)
Try
Dim oView As GridView = TryCast(sender, GridView)
If oView Is Nothing OrElse e.Column Is Nothing Then Return
' Prüfen ob überhaupt eine Formel-Spalte referenziert wird
Dim oFormulaColumnsToRefresh As New List(Of String)
For Each oColumnData As DataRow In pColumnTable.Rows
Dim oExpr = ObjectEx.NotNull(oColumnData.Item("FORMULA_EXPRESSION"), String.Empty).ToString()
If oExpr = String.Empty Then Continue For
Dim referencedColumns = GetReferencedColumnNames(oExpr)
If referencedColumns.Any(Function(col) String.Equals(col, e.Column.FieldName, StringComparison.OrdinalIgnoreCase)) Then
oFormulaColumnsToRefresh.Add(oColumnData.Item("SPALTENNAME").ToString())
End If
Next
If oFormulaColumnsToRefresh.Count = 0 Then
Return
End If
' *** FALLBACK: Nur wenn EditValueChanged NICHT gefeuert hat ***
' (z.B. bei programmatischer SetRowCellValue oder Paste)
Dim oRowHandle As Integer = e.RowHandle
_Logger.Debug("[FormulaRefresh] CellValueChanged FALLBACK refreshing for row [{0}] after column [{1}] changed.", oRowHandle, e.Column.FieldName)
oView.GridControl.BeginInvoke(New Action(
Sub()
Try
If Not oView.IsValidRowHandle(oRowHandle) Then Return
For Each oFormulaColumnName As String In oFormulaColumnsToRefresh
Dim oGridColumn As GridColumn = oView.Columns.ColumnByFieldName(oFormulaColumnName)
If oGridColumn Is Nothing Then Continue For
oView.RefreshRowCell(oRowHandle, oGridColumn)
_Logger.Debug("[FormulaRefresh] FALLBACK DisplayText for [{0}]: [{1}]",
oFormulaColumnName, oView.GetRowCellDisplayText(oRowHandle, oGridColumn))
Next
Catch ex As Exception
_Logger.Error(ex)
End Try
End Sub))
Catch ex As Exception
_Logger.Error(ex)
End Try
End Sub
End Sub
Private Sub HandleInheritedColumnValue(pView As GridView, pColumnDefinition As DataTable, pArgs As CellValueChangedEventArgs)
If pView Is Nothing OrElse pArgs Is Nothing OrElse pArgs.Column Is Nothing Then
Return
End If
' *** NEU: Bei Formel-Refresh überspringen ***
If _isRefreshingFormula Then
_Logger.Debug("Skipping HandleInheritedColumnValue during formula refresh.")
Return
End If
If isApplyingInheritedValue OrElse pArgs.RowHandle = DevExpress.XtraGrid.GridControl.InvalidRowHandle Then
Return
End If
Dim oColumnData As DataRow = pColumnDefinition.
Select($"SPALTENNAME = '{pArgs.Column.FieldName}'").
FirstOrDefault()
If oColumnData Is Nothing Then
Return
End If
Dim inheritRaw = ObjectEx.NotNull(oColumnData.Item("INHERIT_VALUE"), 0)
Dim inheritEnabled As Boolean
If TypeOf inheritRaw Is Boolean Then
inheritEnabled = CBool(inheritRaw)
Else
Dim inheritInt As Integer
inheritEnabled = Integer.TryParse(inheritRaw.ToString(), inheritInt) AndAlso inheritInt = 1
End If
If Not inheritEnabled Then
Return
End If
Dim listIndex = pView.GetDataSourceRowIndex(pArgs.RowHandle)
If listIndex = DevExpress.XtraGrid.GridControl.InvalidRowHandle Then
Return
End If
' Benutzerbestätigung für Wertvererbung
Dim valueToApply = pArgs.Value
Dim affectedRowsCount = pView.DataRowCount - listIndex - 1
Dim confirmationEntry = GetInheritanceConfirmationEntry(pArgs.Column.FieldName)
If affectedRowsCount > 0 AndAlso confirmationEntry.Count < InheritanceMsgAmount Then
Dim confirmMessage As String = String.Format(
"Möchten Sie den Wert '{0}' an {1} nachfolgende Zeile(n) vererben?",
valueToApply,
affectedRowsCount)
If USER_LANGUAGE <> "de-DE" Then
confirmMessage = String.Format(
"Do you want to inherit the value '{0}' to {1} subsequent row(s)?",
valueToApply,
affectedRowsCount)
End If
Dim confirmTitle As String = "Wertevererbung bestätigen"
If USER_LANGUAGE <> "de-DE" Then
confirmTitle = "Confirm Value Inheritance"
End If
Dim result = MessageBox.Show(
confirmMessage,
confirmTitle,
MessageBoxButtons.YesNo,
MessageBoxIcon.Question,
MessageBoxDefaultButton.Button1)
If result <> DialogResult.Yes Then
_Logger.Debug("User cancelled value inheritance")
Return
End If
Dim newCount = confirmationEntry.Count + 1
confirmationEntry.Count = newCount
SetInheritanceConfirmationCount(confirmationEntry.ColumnName, newCount)
_Logger.Info("User confirmed value inheritance. Confirmation count: {0}", newCount)
ElseIf affectedRowsCount > 0 AndAlso confirmationEntry.Count = InheritanceMsgAmount Then
' Schwellenwert erreicht - User fragen, ob er weiterhin gefragt werden möchte
Dim continueAskingMessage As String = "Sie haben diese Bestätigung bereits mehrfach durchgeführt. Möchten Sie in Zukunft weiterhin gefragt werden?"
If USER_LANGUAGE <> "de-DE" Then
continueAskingMessage = "You have confirmed this action multiple times. Do you want to continue being asked in the future?"
End If
Dim continueAskingTitle As String = "Bestätigungen fortsetzen?"
If USER_LANGUAGE <> "de-DE" Then
continueAskingTitle = "Continue Confirmations?"
End If
Dim continueResult = MessageBox.Show(
continueAskingMessage,
continueAskingTitle,
MessageBoxButtons.YesNo,
MessageBoxIcon.Question,
MessageBoxDefaultButton.Button2)
If continueResult = DialogResult.Yes Then
' User möchte weiterhin gefragt werden - Counter zurücksetzen
confirmationEntry.Count = 0
SetInheritanceConfirmationCount(confirmationEntry.ColumnName, 0)
_Logger.Info("User wants to continue being asked. Counter reset to 0.")
Else
' User möchte nicht mehr gefragt werden - Counter erhöhen
Dim newCount = confirmationEntry.Count + 1
confirmationEntry.Count = newCount
SetInheritanceConfirmationCount(confirmationEntry.ColumnName, newCount)
_Logger.Info("User does not want to be asked anymore. Counter increased to {0}.", newCount)
End If
ElseIf affectedRowsCount > 0 Then
_Logger.Info("Skipping confirmation dialog (already confirmed {0} times)", confirmationEntry.Count)
End If
isApplyingInheritedValue = True
Try
_Logger.Info(String.Format("Inherit Value is active for column. So inheritting the value [{0}]...", valueToApply))
For dataIndex As Integer = listIndex + 1 To pView.DataRowCount - 1
Dim targetHandle = pView.GetRowHandle(dataIndex)
If targetHandle = DevExpress.XtraGrid.GridControl.InvalidRowHandle OrElse pView.IsGroupRow(targetHandle) Then
Continue For
End If
If pView.IsNewItemRow(targetHandle) Then
Exit For
End If
Dim existingValue = pView.GetRowCellValue(targetHandle, pArgs.Column.FieldName)
If Equals(existingValue, valueToApply) Then
Continue For
End If
pView.SetRowCellValue(targetHandle, pArgs.Column.FieldName, valueToApply)
Next
Finally
isApplyingInheritedValue = False
End Try
End Sub
Private Sub SetInheritanceConfirmationCount(columnName As String, newCount As Integer)
Dim entries = UserInheritance_ConfirmationByColumn
If entries Is Nothing Then
Return
End If
Dim entryIndex = entries.FindIndex(Function(item) String.Equals(item.ColumnName, columnName, StringComparison.OrdinalIgnoreCase))
If entryIndex < 0 Then
Return
End If
Dim entry = entries(entryIndex)
entry.Count = newCount
entries(entryIndex) = entry
End Sub
Private Function GetInheritanceConfirmationEntry(columnName As String) As UserInheritanceConfirmation
Dim entries = UserInheritance_ConfirmationByColumn
If entries Is Nothing Then
entries = New List(Of UserInheritanceConfirmation)()
UserInheritance_ConfirmationByColumn = entries
End If
Dim entry = entries.FirstOrDefault(Function(item) String.Equals(item.ColumnName, columnName, StringComparison.OrdinalIgnoreCase))
If entry Is Nothing Then
entry = New UserInheritanceConfirmation With {
.ColumnName = columnName,
.Count = 0
}
entries.Add(entry)
End If
Return entry
End Function
Private Sub View_PopupMenuShowing(sender As Object, e As PopupMenuShowingEventArgs)
Dim view As GridView = TryCast(sender, GridView)
Dim oFocusedColumn As GridColumn = view.FocusedColumn
If IsNothing(oFocusedColumn) Then
MsgBox("Please focus a column first.", MsgBoxStyle.Information, "No Column focused")
Exit Sub
End If
Dim oColumnType As Type = oFocusedColumn.ColumnType
Dim oColumnName As String = oFocusedColumn.FieldName
If e.MenuType = GridMenuType.Column AndAlso oColumnType Is GetType(Boolean) Then
e.Menu.Items.Add(New DevExpress.Utils.Menu.DXMenuItem(
"Alle Zeilen anhaken",
Sub(_sender As Object, _e As EventArgs)
SetCellValuesForBooleanColumn(view, oColumnName, True)
End Sub,
My.Resources.itemtypechecked,
DevExpress.Utils.Menu.DXMenuItemPriority.Normal))
e.Menu.Items.Add(New DevExpress.Utils.Menu.DXMenuItem(
"Alle Zeilen abhaken",
Sub(_sender As Object, _e As EventArgs)
SetCellValuesForBooleanColumn(view, oColumnName, False)
End Sub,
My.Resources.itemtypechecked,
DevExpress.Utils.Menu.DXMenuItemPriority.Normal))
End If
End Sub
Private Sub SetCellValuesForBooleanColumn(pView As GridView, pColumnName As String, pValue As Boolean)
Dim oRowHandle = 0
While (pView.IsValidRowHandle(oRowHandle))
Dim oRow = pView.GetDataRow(oRowHandle)
Dim oValue = oRow.ItemEx(pColumnName, False)
oRow.Item(pColumnName) = pValue
oRowHandle += 1
End While
End Sub
Private Sub Control_LostFocus(sender As DevExpress.XtraGrid.GridControl, e As EventArgs)
Dim oView2 As GridView = sender.FocusedView
' 19.08.2022:
' Calling UpdateCurrentRow when newRowModified Is true
' leads to some weird jumping of focus in the current cell.
' This seems to fix it.
If newRowModified = False Then
oView2.UpdateCurrentRow()
End If
End Sub
Private Sub View_ValidateRow(sender As Object, e As ValidateRowEventArgs)
Dim view As GridView = TryCast(sender, GridView)
' RowHandle für RowUpdated merken, bevor er sich nach dem Commit ändert
If view.IsNewItemRow(e.RowHandle) AndAlso Not newRowModified Then
_Logger.Debug("Deleting unused row")
view.DeleteRow(e.RowHandle)
End If
_Logger.Debug("Validating row. Resetting Modified.")
newRowModified = False
End Sub
Private Sub View_ValidatingEditor(sender As Object, e As BaseContainerValidateEditorEventArgs)
Dim oValue As String = ObjectEx.NotNull(e.Value, "")
If oValue.Contains(" | ") Then
oValue = oValue.Split(" | ").ToList().First()
e.Value = oValue
End If
End Sub
Private Sub View_InvalidRowException(sender As Object, e As InvalidRowExceptionEventArgs)
e.ExceptionMode = ExceptionMode.NoAction
End Sub
Private Function GridTables_TestEditorExistsByControlAndColumn(oControlId As Integer, pColumn As String) As Boolean
If _GridTables.ContainsKey(oControlId) Then
Dim oContainsKey = _GridTables.Item(oControlId).ContainsKey(pColumn)
If oContainsKey AndAlso _GridTables.Item(oControlId).Item(pColumn) IsNot Nothing Then
Return True
Else
Return False
End If
Else
Return False
End If
End Function
Private Function GridTables_ValidateColumn(pView As GridView, pColumnDefinition As DataTable, ColumnName As String, pValue As Object, ByRef pIsValid As Boolean, ByRef pErrorText As String) As Boolean
Dim oColumn As DataRow = (From r As DataRow In pColumnDefinition.Rows
Where r.Item("SPALTENNAME") = ColumnName
Select r).FirstOrDefault()
Dim oGridColumn As GridColumn = (From c As GridColumn In pView.Columns
Where c.FieldName = ColumnName
Select c).FirstOrDefault()
Dim oIsRequired = oColumn.Item("VALIDATION")
Try
Dim oRegex = ObjectEx.NotNull(oColumn.Item("REGEX_MATCH"), String.Empty)
Dim oRegexMessage = ObjectEx.NotNull(oColumn.Item("REGEX_MESSAGE_DE"), String.Empty)
If oRegex <> String.Empty Then
Dim oMatch = New Regex(oRegex).IsMatch(pValue.ToString)
Dim oDefaultMessage = "Wert entspricht nicht dem gefordertem Format!"
Dim oMessage = IIf(oRegexMessage <> String.Empty, oRegexMessage, oDefaultMessage)
If oMatch = False Then
pErrorText = oMessage
pIsValid = False
Return False
End If
End If
Catch ex As Exception
_Logger.Error(ex)
End Try
If oIsRequired And (pValue IsNot Nothing AndAlso pValue.ToString = "") Then
pErrorText = "Spalte muss ausgefüllt werden!"
pIsValid = False
Return False
End If
Return True
End Function
End Class
End Namespace