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 _FormulaSqlColumns As New Dictionary(Of String, FormulaSqlDefinition)(StringComparer.OrdinalIgnoreCase)
Private _isRefreshingFormula As Boolean = False ' *** NEU: Flag für Formel-Refresh ***
Private _currencySymbol As String = "€"
'''
''' SHARED Dictionary: Speichert das aktuelle Währungssymbol PRO GridView (via Name).
''' Dies ist notwendig, weil UpdateCurrencyFormat auf einer NEUEN GridControl-Instanz
''' aufgerufen wird, der CustomColumnDisplayText-Handler aber auf der URSPRÜNGLICHEN
''' Instanz registriert wurde. Durch das Shared Dictionary können alle Instanzen
''' auf das aktuelle Symbol zugreifen.
'''
Private Shared _CurrencySymbolByGridName As New Dictionary(Of String, String)(StringComparer.OrdinalIgnoreCase)
'''
''' Definiert eine SQL-basierte Formelspalte mit allen nötigen Metadaten.
'''
Private Class FormulaSqlDefinition
Public Property SqlTemplate As String
Public Property ReferencedColumns As List(Of String)
End Class
'''
''' Extrahiert alle {#TBCOL#ColumnName}-Platzhalter aus einem SQL-Template.
'''
Private Function GetReferencedSqlColumnNames(sqlTemplate As String) As List(Of String)
Dim columnNames As New List(Of String)
Dim pattern As String = "\{#TBCOL#([^}]+)\}"
Dim matches = Regex.Matches(sqlTemplate, pattern)
For Each match As Match In matches
Dim colName = match.Groups(1).Value
If Not columnNames.Contains(colName, StringComparer.OrdinalIgnoreCase) Then
columnNames.Add(colName)
End If
Next
Return columnNames
End Function
'''
''' Ersetzt alle {#TBCOL#ColumnName}-Platzhalter durch die aktuellen Zeilenwerte.
''' Gibt den ausführbaren SQL-String zurück.
'''
Private Function ResolveSqlTemplate(sqlTemplate As String, pView As GridView, rowHandle As Integer) As String
Dim resolvedSql As String = sqlTemplate
Dim pattern As String = "\{#TBCOL#([^}]+)\}"
Dim matches = Regex.Matches(sqlTemplate, pattern)
For Each match As Match In matches
Dim colName = match.Groups(1).Value
Dim cellValue = pView.GetRowCellValue(rowHandle, colName)
Dim safeValue As String
If cellValue Is Nothing OrElse IsDBNull(cellValue) Then
safeValue = "NULL"
ElseIf TypeOf cellValue Is String Then
' SQL-Injection-Schutz: Einfache Anführungszeichen escapen
safeValue = "'" & cellValue.ToString().Replace("'", "''") & "'"
ElseIf TypeOf cellValue Is Boolean Then
safeValue = If(CBool(cellValue), "1", "0")
Else
' Numerische Werte: Invariant-Format (Punkt als Dezimaltrenner)
safeValue = Convert.ToString(cellValue, CultureInfo.InvariantCulture)
End If
resolvedSql = resolvedSql.Replace(match.Value, safeValue)
_Logger.Debug("Resolved SQL placeholder [{0}] with value [{1}] → {2}", match.Value, cellValue, safeValue)
Next
_Logger.Debug("Final resolved SQL: {0}", resolvedSql)
Return resolvedSql
End Function
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
'''
''' Setzt den Shared Currency-Cache zurück. Muss beim Laden eines neuen Dokuments
''' aufgerufen werden, bevor UpdateCurrencyFormat die neuen Werte schreibt.
''' Verhindert, dass ein veraltetes Währungssymbol aus einem vorherigen Dokument
''' durch den CustomColumnDisplayText-Handler verwendet wird.
'''
Public Shared Sub ResetCurrencySymbolCache()
SyncLock _CurrencySymbolByGridName
_CurrencySymbolByGridName.Clear()
End SyncLock
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)
Dim oFormulaSql = ObjectEx.NotNull(oRow.Item("FORMULA_SQL"), String.Empty)
' *** VALIDIERUNG: Beides gleichzeitig ist nicht erlaubt ***
If oFormulaExpression <> String.Empty AndAlso oFormulaSql <> String.Empty Then
_Logger.Warn("⚠️ [CreateGridColumns] Column [{0}] has BOTH FORMULA_EXPRESSION and FORMULA_SQL – FORMULA_SQL will be ignored.", oColumn.ColumnName)
' FORMULA_EXPRESSION hat Vorrang → nur Expression wird als DataTable.Expression gesetzt
End If
If oFormulaExpression <> String.Empty Then
' FORMULA_EXPRESSION: Expression merken, aber erst später setzen (DataTable.Expression)
columnsWithExpressions.Add(New Tuple(Of DataColumn, String)(oColumn, oFormulaExpression))
' HINWEIS: FORMULA_SQL-Spalten bekommen KEINE DataTable.Expression,
' da deren Werte programmatisch via SetRowCellValue gesetzt werden.
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
'''
''' Setzt das Währungssymbol für ein bestimmtes Grid im Shared Cache.
''' Muss bei JEDEM Dokumentwechsel aufgerufen werden (auch bei EUR),
''' damit der CustomColumnDisplayText-Handler sofort den korrekten Wert hat.
'''
Public Shared Sub SetCurrencySymbolForGrid(gridName As String, currencySymbol As String)
SyncLock _CurrencySymbolByGridName
_CurrencySymbolByGridName(gridName) = currencySymbol
End SyncLock
End Sub
' Hilfsroutine: passt NUR das Summary-Item an (ohne FormatInfo)
Private Sub ApplyCurrencySummaryFormat(oCol As GridColumn)
oCol.SummaryItem.SummaryType = DevExpress.Data.SummaryItemType.Sum
_Logger.Debug("Applying currency summary format for column [{0}] with symbol [{1}]", oCol.FieldName, _currencySymbol)
' Variante B: Kulturunabhängig, Symbol explizit anhängen
oCol.SummaryItem.DisplayFormat = $"{{0:N2}} {_currencySymbol}"
End Sub
'''
''' Aktualisiert die Währungsformatierung für alle CURRENCY-Spalten mit neuem Währungssymbol.
''' Betrifft DisplayFormat, ColumnEdit (für editierbare Spalten) und Summary-Footer.
'''
'''
'''
Public Sub UpdateCurrencyFormat(pColumnTable As DataTable, pGridView As GridView, pGrid As DevExpress.XtraGrid.GridControl, pNewCurrencySymbol As String)
Try
_Logger.Info("[UpdateCurrencyFormat] *** START *** [{0}] → [{1}] für [{2}]", _currencySymbol, pNewCurrencySymbol, pGrid.Name)
' *** KERN-FIX: Speichere Symbol im SHARED Dictionary ***
Dim gridName As String = pGrid.Name
SyncLock _CurrencySymbolByGridName
If _CurrencySymbolByGridName.ContainsKey(gridName) Then
_CurrencySymbolByGridName(gridName) = pNewCurrencySymbol
Else
_CurrencySymbolByGridName.Add(gridName, pNewCurrencySymbol)
End If
End SyncLock
_Logger.Debug("[UpdateCurrencyFormat] Shared Dictionary updated: [{0}] = [{1}]", gridName, pNewCurrencySymbol)
_currencySymbol = pNewCurrencySymbol
Dim oCultureInfo As CultureInfo = New CultureInfo("de-DE")
oCultureInfo.NumberFormat.CurrencySymbol = _currencySymbol
Dim riTextEdit As New RepositoryItemTextEdit()
riTextEdit.MaskSettings.Configure(Of MaskSettings.Numeric)(
Sub(settings)
settings.MaskExpression = "c"
settings.Culture = oCultureInfo
End Sub)
riTextEdit.UseMaskAsDisplayFormat = False
riTextEdit.DisplayFormat.FormatType = FormatType.Custom
riTextEdit.DisplayFormat.FormatString = $"#,##0.00 {_currencySymbol}"
_Logger.Debug("[UpdateCurrencyFormat] riTextEdit: DisplayFormat=[{0}]",
riTextEdit.DisplayFormat.FormatString)
pGridView.BeginUpdate()
Try
' Schritt 1: Altes RepositoryItem entfernen (ohne vorher ColumnEdit=Nothing)
Dim oldItems = pGrid.RepositoryItems.OfType(Of RepositoryItemTextEdit)().
Where(Function(item) item.MaskSettings.MaskExpression = "c").ToList()
For Each oldItem In oldItems
_Logger.Debug("[UpdateCurrencyFormat] Removing old riTextEdit: DisplayFormat=[{0}]",
oldItem.DisplayFormat.FormatString)
pGrid.RepositoryItems.Remove(oldItem)
Next
' Schritt 2: CURRENCY-Spalten konfigurieren
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
If ObjectEx.NotNull(oColumnData.Item("TYPE_COLUMN"), String.Empty).ToString() <> "CURRENCY" Then Continue For
Dim oIsFormulaExpression As Boolean =
ObjectEx.NotNull(oColumnData.Item("FORMULA_EXPRESSION"), String.Empty) <> String.Empty
Dim oIsFormulaSql As Boolean =
ObjectEx.NotNull(oColumnData.Item("FORMULA_SQL"), String.Empty) <> String.Empty
' Entweder/Oder: Beide gleichzeitig → Expression gewinnt, SQL ignoriert
If oIsFormulaExpression AndAlso oIsFormulaSql Then
_Logger.Warn("[UpdateCurrencyFormat] Column [{0}] has BOTH FORMULA_EXPRESSION and FORMULA_SQL – treating as EXPRESSION only.", oCol.FieldName)
oIsFormulaSql = False
End If
' Spalte ist eine Formel-Spalte (Expression ODER SQL) → ReadOnly, kein ColumnEdit
Dim oIsAnyFormula As Boolean = oIsFormulaExpression OrElse oIsFormulaSql
' DisplayFormat immer aktualisieren
oCol.DisplayFormat.FormatType = FormatType.Custom
oCol.DisplayFormat.FormatString = $"#,##0.00 {_currencySymbol}"
If Not oIsAnyFormula AndAlso oCol.OptionsColumn.AllowEdit Then
' Nur editierbare Nicht-Formel-Spalten bekommen ein ColumnEdit
oCol.ColumnEdit = riTextEdit
_Logger.Debug("[UpdateCurrencyFormat] ColumnEdit=[{0}] für [{1}]",
DirectCast(oCol.ColumnEdit, RepositoryItemTextEdit).DisplayFormat.FormatString,
oCol.FieldName)
Else
_Logger.Debug("[UpdateCurrencyFormat] [{0}]: ReadOnly/Formula – nur DisplayFormat aktualisiert (IsExpression=[{1}], IsSql=[{2}])",
oCol.FieldName, oIsFormulaExpression, oIsFormulaSql)
End If
If ObjectEx.NotNull(oColumnData.Item("SUMMARY_FUNCTION"), String.Empty) =
Constants.AGGREGATE_TOTAL_CURRENCY Then
oCol.SummaryItem.SummaryType = DevExpress.Data.SummaryItemType.Sum
oCol.SummaryItem.DisplayFormat = $"{{0:N2}} {_currencySymbol}"
End If
Next
Finally
pGridView.EndUpdate()
End Try
pGridView.LayoutChanged()
For i As Integer = 0 To pGridView.DataRowCount - 1
pGridView.InvalidateRow(i)
Next
pGridView.UpdateTotalSummary()
_Logger.Info("[UpdateCurrencyFormat] *** END *** _currencySymbol=[{0}]", _currencySymbol)
Catch ex As Exception
_Logger.Error("[UpdateCurrencyFormat] Fehler: {0}", ex.Message)
_Logger.Error(ex)
End Try
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
Dim oSQLExpression = ObjectEx.NotNull(oColumnData.Item("FORMULA_SQL"), String.Empty)
If oSQLExpression <> 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"
' *** DisplayFormat wird NICHT hier gesetzt ***
' ConfigureViewColumnsCurrency übernimmt die CURRENCY-Formatierung
' mit dem korrekten _currencySymbol. Dieses Standardformat würde
' später von UpdateCurrencyFormat überschrieben werden müssen –
' für Formel-Spalten (kein ColumnEdit) greift aber nur DisplayFormat,
' weshalb ein falscher Initialwert hier persistent bleibt.
_Logger.Debug("CURRENCY column [{0}]: DisplayFormat wird von ConfigureViewColumnsCurrency gesetzt", oCol.FieldName)
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 = "{0:N0}"
oShouldDisplayFooter = True
Case Constants.AGGREGATE_TOTAL_FLOAT
oCol.SummaryItem.SummaryType = DevExpress.Data.SummaryItemType.Sum
oCol.SummaryItem.DisplayFormat = "{0:N2}"
oShouldDisplayFooter = True
Case Constants.AGGREGATE_TOTAL_CURRENCY
_Logger.Debug(Of String)("Applying currency summary format for column [{0}]", oCol.FieldName)
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 = False
riTextEdit.DisplayFormat.FormatType = FormatType.Custom
riTextEdit.DisplayFormat.FormatString = $"#,##0.00 {_currencySymbol}"
_Logger.Debug("[ConfigureViewColumnsCurrency] riTextEdit erstellt: DisplayFormat=[{0}], HashCode=[{1}]",
riTextEdit.DisplayFormat.FormatString, riTextEdit.GetHashCode())
_Logger.Debug("[ConfigureViewColumnsCurrency] pGrid.RepositoryItems.Count VOR Schleife=[{0}]",
pGrid.RepositoryItems.Count)
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
Dim oColumnType As String = ObjectEx.NotNull(oColumnData.Item("TYPE_COLUMN"), String.Empty).ToString()
If oColumnType <> "CURRENCY" Then Continue For
Dim oFormulaExpression = ObjectEx.NotNull(oColumnData.Item("FORMULA_EXPRESSION"), String.Empty)
Dim oFormulaSql = ObjectEx.NotNull(oColumnData.Item("FORMULA_SQL"), String.Empty)
' Entweder/Oder: Beide gleichzeitig → Expression gewinnt, SQL ignoriert
If oFormulaExpression <> String.Empty AndAlso oFormulaSql <> String.Empty Then
_Logger.Warn("[ConfigureViewColumnsCurrency] Column [{0}] has BOTH FORMULA_EXPRESSION and FORMULA_SQL – treating as EXPRESSION only.", oCol.FieldName)
oFormulaSql = String.Empty
End If
' Spalte ist eine Formel-Spalte (Expression ODER SQL) → nur DisplayFormat, kein ColumnEdit
Dim oIsAnyFormula As Boolean = oFormulaExpression <> String.Empty OrElse oFormulaSql <> String.Empty
If oIsAnyFormula Then
' Formel-Spalten (Expression oder SQL): nur DisplayFormat setzen
oCol.DisplayFormat.FormatType = FormatType.Custom
oCol.DisplayFormat.FormatString = $"#,##0.00 {_currencySymbol}"
_Logger.Debug("[ConfigureViewColumnsCurrency] Formel-Spalte [{0}] (IsExpression=[{1}], IsSql=[{2}]): DisplayFormat=[{3}], RepositoryItems.Count=[{4}]",
oCol.FieldName,
oFormulaExpression <> String.Empty,
oFormulaSql <> String.Empty,
oCol.DisplayFormat.FormatString,
pGrid.RepositoryItems.Count)
ElseIf oCol.OptionsColumn.AllowEdit Then
_Logger.Debug("[ConfigureViewColumnsCurrency] [{0}] VOR ColumnEdit: RepositoryItems.Count=[{1}]",
oCol.FieldName, pGrid.RepositoryItems.Count)
oCol.ColumnEdit = riTextEdit
_Logger.Debug("[ConfigureViewColumnsCurrency] [{0}] NACH ColumnEdit: RepositoryItems.Count=[{1}]",
oCol.FieldName, pGrid.RepositoryItems.Count)
Dim assignedEdit = TryCast(oCol.ColumnEdit, RepositoryItemTextEdit)
_Logger.Debug("[ConfigureViewColumnsCurrency] [{0}]: IsSameObject=[{1}], ColumnEdit.DisplayFormat=[{2}], ColumnEdit.HashCode=[{3}]",
oCol.FieldName,
Object.ReferenceEquals(assignedEdit, riTextEdit),
If(assignedEdit IsNot Nothing, assignedEdit.DisplayFormat.FormatString, "N/A"),
If(assignedEdit IsNot Nothing, assignedEdit.GetHashCode(), -1))
For i As Integer = 0 To pGrid.RepositoryItems.Count - 1
_Logger.Debug("[ConfigureViewColumnsCurrency] RepositoryItems[{0}]: Type=[{1}], HashCode=[{2}]",
i, pGrid.RepositoryItems(i).GetType().Name, pGrid.RepositoryItems(i).GetHashCode())
Next
End If
Next
Dim oTestFired As Boolean = False
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
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 currentSymbol As String = _currencySymbol
Dim gridName As String = pGrid.Name
SyncLock _CurrencySymbolByGridName
If _CurrencySymbolByGridName.ContainsKey(gridName) Then
currentSymbol = _CurrencySymbolByGridName(gridName)
End If
End SyncLock
Dim oValue As Double
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()
Dim oDeCulture As CultureInfo = New CultureInfo("de-DE")
If Double.TryParse(oStringValue, NumberStyles.Currency Or NumberStyles.Number, oDeCulture, oValue) Then
ElseIf Double.TryParse(oStringValue, NumberStyles.Currency Or NumberStyles.Number, CultureInfo.InvariantCulture, oValue) Then
Else
oValue = Convert.ToDouble(oStringValue, CultureInfo.CurrentCulture)
End If
Else
oValue = Convert.ToDouble(e.Value)
End If
Dim oDeCultureInfo As CultureInfo = New CultureInfo("de-DE")
e.DisplayText = oValue.ToString("N2", oDeCultureInfo) & " " & currentSymbol
_Logger.Debug("[CustomColumnDisplayText] CURRENCY [{0}]: DisplayText=[{1}], Symbol=[{2}] (from Shared Dict in ConfigureViewColumnsCurrency)",
e.Column.FieldName, e.DisplayText, currentSymbol)
Catch ex As Exception
_Logger.Warn("⚠️ Could not format currency value [{0}] for column [{1}]: {2}",
e.Value, e.Column.FieldName, ex.Message)
Dim fallbackSymbol As String = _currencySymbol
SyncLock _CurrencySymbolByGridName
If _CurrencySymbolByGridName.ContainsKey(pGrid.Name) Then
fallbackSymbol = _CurrencySymbolByGridName(pGrid.Name)
End If
End SyncLock
e.DisplayText = e.Value.ToString() & " " & fallbackSymbol
End Try
End If
End Sub
End Sub
Public Sub ConfigureViewEvents(pColumnTable As DataTable, pGridView As GridView, pControl As Windows.Forms.Control, pControlId As Integer)
' *** Formel-Spalten einmalig cachen + Validierung: Entweder EXPRESSION oder SQL, nie beides ***
_FormulaColumnNames.Clear()
_FormulaSqlColumns.Clear()
For Each r As DataRow In pColumnTable.Rows
Dim oColName = r.Item("SPALTENNAME").ToString()
Dim oExpr = ObjectEx.NotNull(r.Item("FORMULA_EXPRESSION"), String.Empty).ToString()
Dim oSql = ObjectEx.NotNull(r.Item("FORMULA_SQL"), String.Empty).ToString()
' *** VALIDIERUNG: Beides gleichzeitig ist nicht erlaubt ***
If oExpr <> String.Empty AndAlso oSql <> String.Empty Then
_Logger.Warn("⚠️ Column [{0}] has BOTH FORMULA_EXPRESSION and FORMULA_SQL – this is not allowed! FORMULA_SQL will be ignored.", oColName)
MsgBox(String.Format(
"Die Spalte '{0}' enthält sowohl eine FORMULA_EXPRESSION als auch eine FORMULA_SQL." & vbCrLf &
"Es darf nur eine der beiden Formeln gesetzt sein." & vbCrLf &
"FORMULA_SQL wird ignoriert. Bitte korrigieren Sie die Konfiguration im Tabellen-Designer.",
oColName), MsgBoxStyle.Exclamation, "Ungültige Spalten-Konfiguration")
' FORMULA_EXPRESSION hat Vorrang → SQL ignorieren
oSql = String.Empty
End If
If oExpr <> String.Empty Then
_FormulaColumnNames.Add(oColName)
_Logger.Debug("[ConfigureViewEvents] Column [{0}] registered as FORMULA_EXPRESSION column.", oColName)
ElseIf oSql <> String.Empty Then
Dim oConnectionId As Integer = r.ItemEx("CONNECTION_ID", 0)
_FormulaSqlColumns(oColName) = New FormulaSqlDefinition() With {
.SqlTemplate = oSql,
.ReferencedColumns = GetReferencedSqlColumnNames(oSql)
}
' SQL-Spalten auch in _FormulaColumnNames aufnehmen → Editor-Blockade + ReadOnly
_FormulaColumnNames.Add(oColName)
_Logger.Debug("[ConfigureViewEvents] Column [{0}] registered as FORMULA_SQL column. ReferencedColumns=[{1}]",
oColName, String.Join(", ", GetReferencedSqlColumnNames(oSql)))
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
' *** KERN-FIX: Hole Symbol aus SHARED Dictionary statt Instanz-Feld ***
Dim currentSymbol As String = _currencySymbol ' Fallback
Dim gridName As String = pControl.Name
SyncLock _CurrencySymbolByGridName
If _CurrencySymbolByGridName.ContainsKey(gridName) Then
currentSymbol = _CurrencySymbolByGridName(gridName)
End If
End SyncLock
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) & " " & currentSymbol
_Logger.Debug("[CustomColumnDisplayText] CURRENCY [{0}]: DisplayText=[{1}], Symbol=[{2}] (from Shared Dict in ConfigureViewEvents)",
e.Column.FieldName, e.DisplayText, currentSymbol)
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
Dim fallbackSymbol As String = _currencySymbol
SyncLock _CurrencySymbolByGridName
If _CurrencySymbolByGridName.ContainsKey(pControl.Name) Then
fallbackSymbol = _CurrencySymbolByGridName(pControl.Name)
End If
End SyncLock
e.DisplayText = e.Value.ToString() & " " & fallbackSymbol
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 As String = oRow.Item("SPALTENNAME").ToString()
If oColumnName <> e.Column.FieldName Then Continue For
Dim oEditorExists = GridTables_TestEditorExistsByControlAndColumn(pControlId, oColumnName)
If oEditorExists Then
' Combobox/Lookup-Editor aus GridTables: immer zuweisen
Dim oEditor = _GridTables.Item(pControlId).Item(oColumnName)
_Logger.Debug("Assigning Editor to Column [{0}]", oColumnName)
e.RepositoryItem = oEditor
Else
Dim oColumnType As String = ObjectEx.NotNull(oRow.Item("TYPE_COLUMN"), String.Empty).ToString()
If oColumnType = "CURRENCY" Then
If _FormulaColumnNames.Contains(oColumnName) Then
_Logger.Debug("CURRENCY column [{0}] is formula/readonly – CustomColumnDisplayText handles display", oColumnName)
Else
_Logger.Debug("CURRENCY column [{0}] – NO e.RepositoryItem set. Display via CustomColumnDisplayText, Edit via GridColumn.ColumnEdit", oColumnName)
End If
Else
_Logger.Debug("Editor for Column [{0}] does not exist", oColumnName)
End If
End If
Exit For
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
' *** LIVE-REFRESH bei JEDER Eingabe (nur für FORMULA_EXPRESSION!) ***
' FORMULA_SQL wird NICHT hier behandelt – SQL-Refresh erfolgt nur über CellValueChanged
If view.FocusedColumn IsNot Nothing AndAlso view.ActiveEditor IsNot Nothing Then
Dim oFocusedColumnName As String = view.FocusedColumn.FieldName
' Prüfen ob diese Spalte von FORMULA_EXPRESSION-Spalten referenziert wird
Dim oFormulaColumnsToRefresh As New List(Of String)
For Each oColumnData As DataRow In pColumnTable.Rows
Dim oColName = oColumnData.Item("SPALTENNAME").ToString()
Dim oExpr = ObjectEx.NotNull(oColumnData.Item("FORMULA_EXPRESSION"), String.Empty).ToString()
' Nur FORMULA_EXPRESSION – FORMULA_SQL wird über CellValueChanged behandelt
If oExpr = String.Empty Then
Continue For
End If
' Spalte darf keine FORMULA_SQL haben (wurde oben validiert, Sicherheitsprüfung)
Dim oSqlExpr = ObjectEx.NotNull(oColumnData.Item("FORMULA_SQL"), String.Empty).ToString()
If oSqlExpr <> String.Empty Then
_Logger.Debug("[FormulaRefresh] Column [{0}] has both FORMULA_EXPRESSION and FORMULA_SQL – skipping live refresh.", oColName)
Continue For
End If
Dim referencedColumns = GetReferencedColumnNames(oExpr)
If referencedColumns.Any(Function(col) String.Equals(col, oFocusedColumnName, StringComparison.OrdinalIgnoreCase)) Then
oFormulaColumnsToRefresh.Add(oColName)
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 (gilt für EXPRESSION UND SQL)
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 (Expression or SQL).", 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
' *** FORMULA_EXPRESSION-Refresh via CellValueChanged (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
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
' Nur FORMULA_EXPRESSION – kein SQL
Dim oSqlExpr = ObjectEx.NotNull(oColumnData.Item("FORMULA_SQL"), String.Empty).ToString()
If oSqlExpr <> 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
' Kein FORMULA_EXPRESSION-Refresh nötig – weiter zu FORMULA_SQL
Else
Dim oRowHandle As Integer = e.RowHandle
_Logger.Debug("[FormulaRefresh] CellValueChanged FALLBACK – refreshing EXPRESSION columns 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))
End If
Catch ex As Exception
_Logger.Error(ex)
End Try
' *** FORMULA_SQL-Refresh via CellValueChanged ***
' SQL wird NUR hier ausgeführt (nicht in EditValueChanged) um DB-Roundtrips zu minimieren
Try
Dim oView As GridView = TryCast(sender, GridView)
If oView Is Nothing OrElse e.Column Is Nothing Then Return
' Finde alle SQL-Formelspalten, die die geänderte Spalte referenzieren
Dim oSqlColumnsToRefresh As New List(Of String)
For Each kvp In _FormulaSqlColumns
If kvp.Value.ReferencedColumns.Any(
Function(col) String.Equals(col, e.Column.FieldName, StringComparison.OrdinalIgnoreCase)) Then
oSqlColumnsToRefresh.Add(kvp.Key)
End If
Next
If oSqlColumnsToRefresh.Count = 0 Then Return
Dim oRowHandle As Integer = e.RowHandle
_Logger.Debug("[FormulaSql] CellValueChanged – column [{0}] triggers SQL refresh for: [{1}]",
e.Column.FieldName, String.Join(", ", oSqlColumnsToRefresh))
' BeginInvoke: UI nicht blockieren, GridView in stabilem Zustand
oView.GridControl.BeginInvoke(New Action(
Sub()
Try
If Not oView.IsValidRowHandle(oRowHandle) Then Return
For Each oSqlColumnName As String In oSqlColumnsToRefresh
Dim oDefinition = _FormulaSqlColumns(oSqlColumnName)
' Prüfen ob ALLE referenzierten Spalten einen Wert haben
Dim allValuesPresent As Boolean = True
For Each refCol In oDefinition.ReferencedColumns
Dim cellVal = oView.GetRowCellValue(oRowHandle, refCol)
If cellVal Is Nothing OrElse IsDBNull(cellVal) Then
_Logger.Debug("[FormulaSql] Column [{0}] has NULL value – skipping SQL for [{1}]", refCol, oSqlColumnName)
allValuesPresent = False
Exit For
End If
Next
If Not allValuesPresent Then Continue For
' Pattern ersetzen und SQL ausführen
Dim resolvedSql = ResolveSqlTemplate(oDefinition.SqlTemplate, oView, oRowHandle)
_Logger.Debug("[FormulaSql] Executing SQL for [{0}]: [{1}]", oSqlColumnName, resolvedSql)
Try
Dim oResultTable As DataTable = DatabaseFallback.GetDatatable(
New GetDatatableOptions(resolvedSql, DatabaseType.ECM))
If oResultTable IsNot Nothing AndAlso oResultTable.Rows.Count > 0 Then
Dim oResult = oResultTable.Rows(0).Item(0)
_Logger.Debug("[FormulaSql] Result for [{0}]: [{1}]", oSqlColumnName, oResult)
_isRefreshingFormula = True
Try
oView.SetRowCellValue(oRowHandle, oSqlColumnName,
If(oResult Is Nothing OrElse IsDBNull(oResult), DBNull.Value, oResult))
oView.RefreshRowCell(oRowHandle, oView.Columns.ColumnByFieldName(oSqlColumnName))
Finally
_isRefreshingFormula = False
End Try
Else
_Logger.Warn("[FormulaSql] No result returned for [{0}]", oSqlColumnName)
End If
Catch sqlEx As Exception
_Logger.Warn("⚠️ [FormulaSql] SQL execution failed for [{0}]: {1}", oSqlColumnName, sqlEx.Message)
_Logger.Error(sqlEx)
End Try
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