6 Commits

Author SHA1 Message Date
Developer01
969e07eb17 Vor Controls2B_EnDisabled Change 2026-03-11 16:43:34 +01:00
Developer01
7629d54fe1 2.8.4 Beta IDB replace Hochkomma bei Delete, Währungskonvertierung 2026-03-11 12:08:46 +01:00
Developer01
41e46f9dbb Version 2.8.3 zu Test an MK und HE 2026-03-03 12:55:01 +01:00
Developer01
a192267d96 MS Anpassung Speicherung IDBData 2026-03-02 16:29:14 +01:00
Developer01
a0d3a487d8 Vor Ändeurng LoogUpControl 2026-02-27 11:46:09 +01:00
Developer01
54744a0531 Vor GridControl Length 2026-02-26 10:37:05 +01:00
11 changed files with 2576 additions and 1295 deletions

View File

@@ -69,6 +69,8 @@ Public Class ClassControlCreator
Public Property GridTables As New Dictionary(Of Integer, Dictionary(Of String, RepositoryItem))
Public Property GridColumns As New Dictionary(Of Integer, DataTable)
''' <summary>
''' Standard Eigenschaften für alle Controls
''' </summary>
@@ -533,12 +535,11 @@ Public Class ClassControlCreator
End Function
Public Function CreateExistingGridControl(row As DataRow, DT_MY_COLUMNS As DataTable, designMode As Boolean, pcurrencySymbol As String) As GridControl
Dim oGridControlCreator = New ControlCreator.GridControl(LogConfig, GridTables)
Dim oGridControlCreator = New ControlCreator.GridControl(LogConfig, GridTables, pcurrencySymbol)
Dim oControl As GridControl = CreateBaseControl(New GridControl(), row, designMode)
Dim oControlId = DirectCast(oControl.Tag, ControlMetadata).Guid
Dim oView As GridView
Dim oControlName = oControl.Name
oControl.ForceInitialize()
oView = oControl.MainView
@@ -635,9 +636,13 @@ Public Class ClassControlCreator
End Try
End If
oGridControlCreator.ConfigureViewColumns(DT_MY_COLUMNS, oView, oControl, pcurrencySymbol)
' *** KORRIGIERT: ConfigureViewColumns OHNE currencySymbol-Parameter ***
oGridControlCreator.ConfigureViewColumns(DT_MY_COLUMNS, oView, oControl)
' *** NEU: ConfigureViewColumnsCurrency() für editierbare Währungsspalten ***
oGridControlCreator.ConfigureViewColumnsCurrency(DT_MY_COLUMNS, oView, oControl)
oGridControlCreator.ConfigureViewEvents(DT_MY_COLUMNS, oView, oControl, oControlId)
' 08.11.2021: Fix editor being empty on first open
oView.FocusInvalidRow()
Return oControl

View File

@@ -28,6 +28,99 @@ Public Class ClassFormat
End Select
End Function
''' <summary>
''' Normalisiert einen numerischen String für die invariante Kultur-Konvertierung.
''' Entfernt Tausendertrennzeichen und ersetzt Dezimaltrennzeichen durch Punkt.
''' </summary>
Private Shared Function NormalizeNumericString(pValue As String) As String
If String.IsNullOrWhiteSpace(pValue) Then
Return pValue
End If
Dim normalized As String = pValue.Trim()
LOGGER.Debug($"[NormalizeNumericString] Input: [{pValue}]")
' Entferne Währungssymbole und Leerzeichen
normalized = System.Text.RegularExpressions.Regex.Replace(normalized, "[€$£¥\s]", "")
Dim hasDot As Boolean = normalized.Contains(".")
Dim hasComma As Boolean = normalized.Contains(",")
LOGGER.Debug($"[NormalizeNumericString] After cleanup: [{normalized}], HasDot={hasDot}, HasComma={hasComma}")
If hasDot AndAlso hasComma Then
' Beide vorhanden: Das letzte ist der Dezimaltrenner
Dim lastDotPos As Integer = normalized.LastIndexOf(".")
Dim lastCommaPos As Integer = normalized.LastIndexOf(",")
LOGGER.Debug($"[NormalizeNumericString] Both separators found: LastDotPos={lastDotPos}, LastCommaPos={lastCommaPos}")
If lastDotPos > lastCommaPos Then
normalized = normalized.Replace(",", "")
Else
normalized = normalized.Replace(".", "").Replace(",", ".")
End If
ElseIf hasComma Then
Dim commaCount As Integer = normalized.Count(Function(c) c = ","c)
LOGGER.Debug($"[NormalizeNumericString] Only comma found: CommaCount={commaCount}")
If commaCount = 1 Then
Dim lastCommaPos As Integer = normalized.LastIndexOf(",")
Dim digitsAfterComma As Integer = normalized.Length - lastCommaPos - 1
LOGGER.Debug($"[NormalizeNumericString] Single comma: DigitsAfterComma={digitsAfterComma}")
If digitsAfterComma <= 3 Then
normalized = normalized.Replace(",", ".")
Else
normalized = normalized.Replace(",", "")
End If
Else
normalized = normalized.Replace(",", "")
End If
ElseIf hasDot Then
Dim dotCount As Integer = normalized.Count(Function(c) c = "."c)
LOGGER.Debug($"[NormalizeNumericString] Only dot found: DotCount={dotCount}")
If dotCount = 1 Then
Dim lastDotPos As Integer = normalized.LastIndexOf(".")
Dim digitsAfterDot As Integer = normalized.Length - lastDotPos - 1
LOGGER.Debug($"[NormalizeNumericString] Single dot: DigitsAfterDot={digitsAfterDot}")
' ✅ KRITISCHE ÄNDERUNG: Prüfe auch Stellen VOR dem Punkt
Dim digitsBeforeDot As Integer = lastDotPos
' Heuristik: Wenn <= 3 Stellen nach Punkt UND >= 1 Stelle davor → Dezimaltrenner
' Wenn > 3 Stellen davor UND <= 3 Stellen nach Punkt → unklar, vermutlich Dezimal
' Wenn > 3 Stellen nach Punkt → definitiv KEIN Dezimaltrenner
If digitsAfterDot > 3 Then
LOGGER.Warn($"⚠️ [NormalizeNumericString] Dot with {digitsAfterDot} digits after → treating as THOUSAND separator!")
normalized = normalized.Replace(".", "")
ElseIf digitsAfterDot >= 1 AndAlso digitsAfterDot <= 3 Then
' Wahrscheinlich Dezimaltrenner (z.B. 5464.17 oder 120.5)
LOGGER.Debug($"[NormalizeNumericString] Dot treated as decimal separator ({digitsBeforeDot} digits before, {digitsAfterDot} after)")
Else
' digitsAfterDot = 0 → Punkt am Ende, vermutlich Fehler
LOGGER.Warn($"⚠️ [NormalizeNumericString] Dot at end of string → removing")
normalized = normalized.Replace(".", "")
End If
Else
' Mehrere Punkte → Tausendertrenner
LOGGER.Debug($"[NormalizeNumericString] Multiple dots → removing all")
normalized = normalized.Replace(".", "")
End If
Else
LOGGER.Debug($"[NormalizeNumericString] No separators found → integer or already normalized")
End If
LOGGER.Debug($"[NormalizeNumericString] Output: [{normalized}]")
Return normalized
End Function
''' <summary>
''' Converts a string according to the type information, using the invariant culture
@@ -41,25 +134,40 @@ Public Class ClassFormat
Select Case pType
Case ClassControlCreator.CONTROL_TYPE_DOUBLE
If Double.TryParse(pValue, NumberStyles.Float, CultureInfo.InvariantCulture, oConvertedValue) Then
Return oConvertedValue
End If
Case ClassControlCreator.CONTROL_TYPE_CURRENCY
Try
LOGGER.Debug($"GetConvertedValue: Converting {pValue.ToString} to Currency ")
If Double.TryParse(pValue, NumberStyles.Currency, CultureInfo.InvariantCulture, oConvertedValue) Then
' ✅ IMMER normalisieren auch für DB-Werte!
Dim normalizedValue As String = NormalizeNumericString(pValue?.ToString())
If Double.TryParse(normalizedValue, NumberStyles.Float, CultureInfo.InvariantCulture, oConvertedValue) Then
Return oConvertedValue
End If
Catch ex As Exception
LOGGER.Error(ex)
End Try
Case ClassControlCreator.CONTROL_TYPE_CURRENCY
Try
' ✅ KRITISCH: Normalisierung VOR Konvertierung
Dim normalizedValue As String = NormalizeNumericString(pValue?.ToString())
LOGGER.Debug($"GetConvertedValue CURRENCY: Original=[{pValue}], Normalized=[{normalizedValue}]")
Case ClassControlCreator.CONTROL_TYPE_INTEGER
If Integer.TryParse(pValue, NumberStyles.Integer, CultureInfo.InvariantCulture, oConvertedValue) Then
If Double.TryParse(normalizedValue, NumberStyles.Float, CultureInfo.InvariantCulture, oConvertedValue) Then
Return oConvertedValue
End If
Catch ex As Exception
LOGGER.Error($"Currency conversion failed for [{pValue}]: {ex.Message}")
LOGGER.Error(ex)
End Try
Case ClassControlCreator.CONTROL_TYPE_INTEGER
Try
Dim normalizedValue As String = NormalizeNumericString(pValue?.ToString())
If Integer.TryParse(normalizedValue, NumberStyles.Integer, CultureInfo.InvariantCulture, oConvertedValue) Then
Return oConvertedValue
End If
Catch ex As Exception
LOGGER.Error(ex)
End Try
Case Else
LOGGER.Debug($"GetConvertedValue - Case ELSE - pType is {pType}")
Try
@@ -68,7 +176,6 @@ Public Class ClassFormat
LOGGER.Warn($"Error in GetConvertedValue: pType is {pType} - converting value to String")
oConvertedValue = ""
End Try
End Select
Return oConvertedValue
@@ -76,26 +183,32 @@ Public Class ClassFormat
''' <summary>
''' Converts values to their respective data type and then back to string
''' according to the current culture
''' using INVARIANT culture for consistency across systems.
''' </summary>
''' <param name="pValue"></param>
''' <returns></returns>
Public Shared Function GetStringValue(pValue As Object) As String
' ✅ FIX: Immer InvariantCulture verwenden für DB-Speicherung
Select Case pValue.GetType
Case GetType(Single)
Return DirectCast(pValue, Single).ToString(CultureInfo.CurrentCulture)
' ✅ NEU: InvariantCulture statt CurrentCulture
Return DirectCast(pValue, Single).ToString(CultureInfo.InvariantCulture)
Case GetType(Double)
Return DirectCast(pValue, Double).ToString(CultureInfo.CurrentCulture)
' ✅ NEU: InvariantCulture statt CurrentCulture
Return DirectCast(pValue, Double).ToString(CultureInfo.InvariantCulture)
Case GetType(Decimal)
Return DirectCast(pValue, Decimal).ToString(CultureInfo.CurrentCulture)
' ✅ NEU: InvariantCulture statt CurrentCulture
Return DirectCast(pValue, Decimal).ToString(CultureInfo.InvariantCulture)
Case GetType(Date)
Return DirectCast(pValue, Date).ToString(CultureInfo.CurrentCulture)
' Datum: ISO 8601 Format für Culture-Unabhängigkeit
Return DirectCast(pValue, Date).ToString("yyyy-MM-dd", CultureInfo.InvariantCulture)
Case GetType(DateTime)
Return DirectCast(pValue, DateTime).ToString(CultureInfo.CurrentCulture)
' DateTime: ISO 8601 Format
Return DirectCast(pValue, DateTime).ToString("yyyy-MM-dd HH:mm:ss", CultureInfo.InvariantCulture)
Case Else
Return pValue.ToString

View File

@@ -1,5 +1,75 @@
Public Class ClassIDBData
Public DTVWIDB_BE_ATTRIBUTE As DataTable
Public IDBSystemIndices As List(Of String)
''' <summary>
''' Wenn True, werden SQL-Statements nicht sofort ausgeführt,
''' sondern in <see cref="_sqlBatch"/> gesammelt.
''' </summary>
Public Property BatchMode As Boolean = False
Private _sqlBatch As New List(Of String)
''' <summary>
''' Startet den Batch-Sammelmodus.
''' </summary>
Public Sub BeginBatch()
_sqlBatch.Clear()
BatchMode = True
End Sub
''' <summary>
''' Führt alle gesammelten SQL-Statements als einen einzigen String
''' an ExecuteNonQueryIDB weiter. Jeder Block wird in BEGIN...END
''' gekapselt, damit DECLARE-Variablen nicht kollidieren.
''' </summary>
''' <returns>True wenn erfolgreich</returns>
Public Function CommitBatch() As Boolean
BatchMode = False
If _sqlBatch.Count = 0 Then Return True
Try
Dim oStatements = _sqlBatch.
Where(Function(s) Not String.IsNullOrWhiteSpace(s)).
ToList()
' @NEW_OBJ_MD_ID pro Statement eindeutig umbenennen → kein Namenskonflikt im Batch
Dim oNumberedStatements As New List(Of String)
Dim oIndex As Integer = 0
For Each oStatement As String In oStatements
Dim oNumbered = oStatement.Replace("@NEW_OBJ_MD_ID", $"@NEW_OBJ_MD_ID_{oIndex}")
oNumberedStatements.Add(oNumbered)
oIndex += 1
Next
Dim oBatchSQL = String.Join(vbNewLine, oNumberedStatements)
LOGGER.Debug($"⚡ CommitBatch - Executing {oStatements.Count} statements as one batch:{vbNewLine}{oBatchSQL}")
Dim oResult = DatabaseFallback.ExecuteNonQueryIDB(oBatchSQL)
_sqlBatch.Clear()
Return oResult
Catch ex As Exception
LOGGER.Error(ex)
_sqlBatch.Clear()
Return False
End Try
End Function
''' <summary>
''' Verwirft alle gesammelten Statements ohne Ausführung.
''' </summary>
Public Sub RollbackBatch()
_sqlBatch.Clear()
BatchMode = False
End Sub
''' <summary>
''' Führt ein SQL-Statement aus sofort oder gesammelt je nach BatchMode.
''' </summary>
Private Function ExecuteOrQueue(oSQL As String) As Boolean
If BatchMode Then
_sqlBatch.Add(oSQL)
LOGGER.Debug($"BatchMode - Queued statement: {oSQL}")
Return True
Else
Return DatabaseFallback.ExecuteNonQueryIDB(oSQL)
End If
End Function
''' <summary>
''' Gets all indices by BusinessEntity.
''' </summary>
@@ -7,15 +77,16 @@
''' <returns>Array with all Indices</returns>
''' <remarks></remarks>
'''
Public Function Init()
Public Function Init() As Boolean
Dim oSQL = $"SELECT DISTINCT ATTR_TITLE, TYP_ID, TYP_ID as [TYPE_ID] FROM VWIDB_BE_ATTRIBUTE WHERE SYS_ATTRIBUTE = 0 ORDER BY ATTR_TITLE"
DTVWIDB_BE_ATTRIBUTE = DatabaseFallback.GetDatatableIDB(oSQL)
If IsNothing(DTVWIDB_BE_ATTRIBUTE) Then
oSQL = $"SELECT DISTINCT ATTR_TITLE, TYP_ID, TYP_ID as [TYPE_ID] FROM VWIDB_BE_ATTRIBUTE ORDER BY ATTR_TITLE "
DTVWIDB_BE_ATTRIBUTE = DatabaseFallback.GetDatatableIDB(oSQL)
End If
Return True
End Function
Public IDBSystemIndices As List(Of String)
Public Function GetIndicesByBE(ByVal BusinessEntity As String) As String()
Try
Dim aNames(4) As String
@@ -118,7 +189,7 @@
LOGGER.Debug($"oAttributeValue for Attribute [{oAttributeName}] is so far nothing..Now trying FNIDB_PM_GET_VARIABLE_VALUE ")
End If
Dim oFNSQL = $"SELECT * FROM [dbo].[FNIDB_PM_GET_VARIABLE_VALUE] ({CURRENT_DOC_ID},'{oAttributeName}','{USER_LANGUAGE}',CONVERT(BIT,'{IDB_USES_WMFILESTORE}'))"
LOGGER.Debug($"GetVariableValue: {oFNSQL}")
LOGGER.Debug($": {oFNSQL}")
oAttributeValue = DatabaseFallback.GetDatatableIDB(oFNSQL)
Dim odt As DataTable = oAttributeValue
If odt.Rows.Count = 1 Then
@@ -138,10 +209,11 @@
If IDB_USES_WMFILESTORE Then
oID_IS_FOREIGN = 1
End If
Dim oDELSQL = $"EXEC PRIDB_DELETE_TERM_OBJECT_METADATA {CURRENT_DOC_ID},'{oAttributeName}','{oTerm2Delete}','{USER_USERNAME}','{USER_LANGUAGE}',{oID_IS_FOREIGN}"
DatabaseFallback.ExecuteNonQueryIDB(oDELSQL)
oTerm2Delete = oTerm2Delete.Replace("'", "''")
Dim oDELSQL = $"EXEC PRIDB_DELETE_TERM_OBJECT_METADATA {CURRENT_DOC_ID},'{oAttributeName}','{oTerm2Delete}','{USER_USERNAME}','{USER_LANGUAGE}',{oID_IS_FOREIGN};"
LOGGER.Debug($"Delete_Term_Object_From_Metadata: {oDELSQL}")
'DatabaseFallback.ExecuteNonQueryIDB(oDELSQL)
Return ExecuteOrQueue(oDELSQL)
Catch ex As Exception
LOGGER.Error(ex)
Return Nothing
@@ -150,9 +222,10 @@
End Function
Public Function Delete_AttributeData(pIDB_OBJID As Int64, pAttributeName As String) As Object
Try
Dim oDELSQL = $"EXEC PRIDB_DELETE_ATTRIBUTE_DATA {pIDB_OBJID},'{pAttributeName}','{USER_USERNAME}'"
DatabaseFallback.ExecuteNonQueryIDB(oDELSQL)
Dim oDELSQL = $"EXEC PRIDB_DELETE_ATTRIBUTE_DATA {pIDB_OBJID},'{pAttributeName}','{USER_USERNAME}';"
LOGGER.Debug($"Delete_Attribute_Data: {oDELSQL}")
' DatabaseFallback.ExecuteNonQueryIDB(oDELSQL)
Return ExecuteOrQueue(oDELSQL)
Catch ex As Exception
LOGGER.Error(ex)
Return Nothing
@@ -162,18 +235,23 @@
Public Function SetVariableValue(oAttributeName As String, oNewValue As Object, Optional CheckDeleted As Boolean = False, Optional oIDBTyp As Integer = 0)
Try
Dim omsg = $"IDBData - SetVariableValue - Attribute: [{oAttributeName}] - NewValue: [{oNewValue}] - CheckDeleted: [{CheckDeleted.ToString}] - oIDBTyp: [{oIDBTyp}]"
LOGGER.Debug(omsg)
Dim omytype = oNewValue.GetType.ToString
If omytype = "System.Data.DataTable" Then
Dim oDTMyNewValues As DataTable = oNewValue
Dim oOldAttributeResult
Dim oAttributeResultFromDB
Dim oTypeOldResult
' Für DataTable (Mehrfachauswahl/Vektor) IMMER auf gelöschte Werte prüfen,
' unabhängig vom übergebenen CheckDeleted-Parameter.
Dim oEffectiveCheckDeleted As Boolean = True
If CheckDeleted = True Then
oOldAttributeResult = GetVariableValue(oAttributeName, oIDBTyp)
oTypeOldResult = oOldAttributeResult.GetType.ToString
If oTypeOldResult = "System.Data.DataTable" Then
Dim myOldValues As DataTable = oOldAttributeResult
If myOldValues.Rows.Count > 1 Then
If oEffectiveCheckDeleted = True Then
oAttributeResultFromDB = GetVariableValue(oAttributeName, oIDBTyp)
oTypeOldResult = oAttributeResultFromDB.GetType.ToString
If TypeOf oAttributeResultFromDB Is DataTable Then
Dim myOldValues As DataTable = oAttributeResultFromDB
If myOldValues.Rows.Count >= 1 Then
'now Checking whether the old row still remains in Vector? If not it will be deleted as it cannot be replaced in multivalues
For Each oOldValueRow As DataRow In myOldValues.Rows
@@ -199,27 +277,26 @@
'### Old Value is a single value ###
If oDTMyNewValues.Rows.Count > 1 Then
'### there is more than one new value ###
Dim oExists As Boolean
Dim oExists As Boolean = False
For Each oNewValueRow As DataRow In oDTMyNewValues.Rows
oExists = False
Dim oInfo1 = $"Checking oldValue[{oOldAttributeResult}] vs NewValue [{oNewValueRow.Item(1)}]"
If oNewValueRow.Item(1).ToString.ToUpper = oOldAttributeResult.ToString.ToUpper Then
LOGGER.Debug($"Checking oldValue[{oAttributeResultFromDB}] vs NewValue [{oNewValueRow.Item(1)}]")
If oNewValueRow.Item(1).ToString.ToUpper = oAttributeResultFromDB.ToString.ToUpper Then
oExists = True
Exit For ' ← sobald gefunden, abbrechen
End If
Next
If oExists = False Then
Dim oInfo2 = $"Value [{oOldAttributeResult}] no longer existing in Vector-Attribute [{oAttributeName}] - will be deleted!"
LOGGER.Debug(oInfo2)
LOGGER.Debug($"Value [{oAttributeResultFromDB}] no longer existing in Attribute [{oAttributeName}] - will be deleted!")
'SetVariableValue(CURRENT_PROFILE_LOG_INDEX, oInfo2)
Delete_Term_Object_From_Metadata(oAttributeName, oOldAttributeResult)
Delete_Term_Object_From_Metadata(oAttributeName, oAttributeResultFromDB)
End If
Else
'### there is only ONE new value ###
If oDTMyNewValues.Rows(0).Item(1) <> oOldAttributeResult Then
Dim oInfo = $"Value [{oOldAttributeResult}] of Attribute [{oAttributeName}] obviously was updated during runtime - will be deleted!"
If oDTMyNewValues.Rows(0).Item(1) <> oAttributeResultFromDB Then
Dim oInfo = $"Value [{oAttributeResultFromDB}] of Attribute [{oAttributeName}] obviously was updated during runtime - will be deleted!"
LOGGER.Debug(oInfo)
SetVariableValue(CURRENT_PROFILE_LOG_INDEX, oInfo)
Delete_Term_Object_From_Metadata(oAttributeName, oOldAttributeResult)
Delete_Term_Object_From_Metadata(oAttributeName, oAttributeResultFromDB)
Else
LOGGER.Debug($"Attributvalue of [{oAttributeName}] did not change!")
End If
@@ -231,22 +308,25 @@
End If
For Each oNewValueRow As DataRow In oDTMyNewValues.Rows
Dim oSuccess As Boolean = False
'Dim oSuccess As Boolean = False
Dim oVALUE = oNewValueRow.Item(1).ToString
oVALUE = oVALUE.Replace("'", "''")
Dim oPRSQL = $"DECLARE @NEW_OBJ_MD_ID BIGINT " & vbNewLine & $"EXEC PRIDB_NEW_OBJ_DATA {CURRENT_DOC_ID},'{oAttributeName}','{USER_USERNAME}','{oVALUE}','{USER_LANGUAGE}',0,@OMD_ID = @NEW_OBJ_MD_ID OUTPUT"
Dim oPRSQL = $"DECLARE @NEW_OBJ_MD_ID BIGINT " & vbNewLine & $"EXEC PRIDB_NEW_OBJ_DATA {CURRENT_DOC_ID},'{oAttributeName}','{USER_USERNAME}','{oVALUE}','{USER_LANGUAGE}',0,@OMD_ID = @NEW_OBJ_MD_ID OUTPUT;"
LOGGER.Debug(oPRSQL)
oSuccess = DatabaseFallback.ExecuteNonQueryIDB(oPRSQL)
If oSuccess = False Then
Return False
End If
'oSuccess = DatabaseFallback.ExecuteNonQueryIDB(oPRSQL)
If Not ExecuteOrQueue(oPRSQL) Then Return False
'If oSuccess = False Then
' Return False
'End If
Next
Return True
Else
'oNewValue = oNewValue.Replace("'", "' + NCHAR(39) + '")
Dim oFNSQL = $"DECLARE @NEW_OBJ_MD_ID BIGINT " & vbNewLine & $"EXEC PRIDB_NEW_OBJ_DATA {CURRENT_DOC_ID},'{oAttributeName}','{USER_USERNAME}','{oNewValue}','{USER_LANGUAGE}',0,@OMD_ID = @NEW_OBJ_MD_ID OUTPUT"
LOGGER.Debug(oFNSQL)
Return DatabaseFallback.ExecuteNonQueryIDB(oFNSQL)
oNewValue = oNewValue.Replace("'", "''")
Dim oPRIDB_NEW_OBJ_DATA = $"DECLARE @NEW_OBJ_MD_ID BIGINT " & vbNewLine & $"EXEC PRIDB_NEW_OBJ_DATA {CURRENT_DOC_ID},'{oAttributeName}','{USER_USERNAME}','{oNewValue}','{USER_LANGUAGE}',0,@OMD_ID = @NEW_OBJ_MD_ID OUTPUT;"
LOGGER.Debug(oPRIDB_NEW_OBJ_DATA)
' Return DatabaseFallback.ExecuteNonQueryIDB(oPRIDB_NEW_OBJ_DATA)
Return ExecuteOrQueue(oPRIDB_NEW_OBJ_DATA)
End If
Catch ex As Exception

View File

@@ -25,11 +25,14 @@ Namespace ControlCreator
Private newRowModified As Boolean
Private isApplyingInheritedValue As Boolean
Public Sub New(pLogConfig As LogConfig, pGridTables As Dictionary(Of Integer, Dictionary(Of String, RepositoryItem)))
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
@@ -200,15 +203,15 @@ Namespace ControlCreator
End If
End Function
' Hilfsroutine: passt NUR das Summary-Item an (ohne FormatInfo)
Private Sub ApplyCurrencySummaryFormat(oCol As GridColumn, currencySymbol As String)
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}"
oCol.SummaryItem.DisplayFormat = $"SUM: {{0:N2}} {_currencySymbol}"
End Sub
Public Sub ConfigureViewColumns(pColumnTable As DataTable, pGridView As GridView, pGrid As DevExpress.XtraGrid.GridControl, pcurrencySymbol As String)
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.
@@ -254,7 +257,8 @@ Namespace ControlCreator
Case "CURRENCY"
oCol.DisplayFormat.FormatType = FormatType.Custom
oCol.DisplayFormat.FormatString = "C2"
oCol.DisplayFormat.FormatString = $"N2 {_currencySymbol}"
End Select
Dim oSummaryFunction As String = oColumnData.Item("SUMMARY_FUNCTION")
@@ -271,7 +275,7 @@ Namespace ControlCreator
oShouldDisplayFooter = True
Case Constants.AGGREGATE_TOTAL_CURRENCY
ApplyCurrencySummaryFormat(oCol, pcurrencySymbol)
ApplyCurrencySummaryFormat(oCol)
oShouldDisplayFooter = True
Case Constants.AGGREGATE_TOTAL_AVG
@@ -306,16 +310,16 @@ Namespace ControlCreator
End With
End If
End Sub
Public Sub ConfigureViewColumnsCurrency(pColumnTable As DataTable, pGridView As GridView, pGrid As DevExpress.XtraGrid.GridControl, pCurrency As String)
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 = pCurrency
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 'Optional
riTextEdit.UseMaskAsDisplayFormat = True
pGrid.RepositoryItems.Add(riTextEdit)
For Each oCol As GridColumn In pGridView.Columns
@@ -327,16 +331,39 @@ Namespace ControlCreator
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"
oCol.DisplayFormat.FormatType = FormatType.Custom
' *** 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")
@@ -362,6 +389,55 @@ Namespace ControlCreator
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
@@ -394,30 +470,233 @@ Namespace ControlCreator
End Sub
AddHandler pGridView.PopupMenuShowing, AddressOf View_PopupMenuShowing
AddHandler pGridView.InvalidRowException, AddressOf View_InvalidRowException
AddHandler pGridView.ValidatingEditor, AddressOf View_ValidatingEditor
' AddHandler pGridView.CustomColumnDisplayText, AddressOf View_CustomColumnDisplayText
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
' These handlers are all used for the custom DefaultValue functionality, additionally some code in the 'InitNewRow' event.
' https://supportcenter.devexpress.com/ticket/details/t1035580/how-to-default-a-value-in-a-column-when-add-new-row-in-data-grid
AddHandler pGridView.ShowingEditor, AddressOf View_ShowingEditor
AddHandler pGridView.ShownEditor, AddressOf View_ShownEditor
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
@@ -579,16 +858,7 @@ Namespace ControlCreator
Return entry
End Function
Private Sub View_CustomColumnDisplayText(ByVal eSender As Object, ByVal e As CustomColumnDisplayTextEventArgs)
If IsNothing(e.Value) Then
Exit Sub
End If
Dim view As GridView = eSender
'Dim view As GridView = TryCast(GridView1, GridView)
If e.Column.FieldName = "SpalteCurrency" Then
' e.DisplayText = e.Value.ToString().Replace("€", "CHF")
End If
End Sub
Private Sub View_PopupMenuShowing(sender As Object, e As PopupMenuShowingEventArgs)
Dim view As GridView = TryCast(sender, GridView)
Dim oFocusedColumn As GridColumn = view.FocusedColumn
@@ -642,28 +912,12 @@ Namespace ControlCreator
End If
End Sub
Private Sub View_ShowingEditor(sender As Object, e As CancelEventArgs)
Dim view As GridView = TryCast(sender, GridView)
_Logger.Debug("Showing editor.")
If view.IsNewItemRow(view.FocusedRowHandle) AndAlso Not newRowModified Then
_Logger.Debug("Adding new row.")
view.AddNewRow()
End If
End Sub
Private Sub View_ShownEditor(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
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)

View File

@@ -13,7 +13,7 @@ Imports System.Runtime.InteropServices
<Assembly: AssemblyDescription("")>
<Assembly: AssemblyCompany("Digital Data")>
<Assembly: AssemblyProduct("taskFLOW")>
<Assembly: AssemblyCopyright("Copyright © Digital Data 2025")>
<Assembly: AssemblyCopyright("Digital Data 2026")>
<Assembly: AssemblyTrademark("")>
<Assembly: ComVisible(False)>
@@ -32,6 +32,6 @@ Imports System.Runtime.InteropServices
' übernehmen, indem Sie "*" eingeben:
' <Assembly: AssemblyVersion("1.0.*")>
<Assembly: AssemblyVersion("2.8.2.0")>
<Assembly: AssemblyVersion("2.8.4.0")>
<Assembly: AssemblyFileVersion("1.0.0.0")>
<Assembly: NeutralResourcesLanguage("")>

View File

@@ -98,8 +98,13 @@ Public Class clsPatterns
lookup.Properties.SelectedValues = New List(Of String) From {newValue.ToString()}
End If
Case GetType(Windows.Forms.ComboBox)
DirectCast(ctrl, ComboBox).Text = newValue?.ToString()
' ========== FIX START: Beide ComboBox-Typen unterstützen ==========
Case GetType(System.Windows.Forms.ComboBox)
DirectCast(ctrl, System.Windows.Forms.ComboBox).Text = newValue?.ToString()
Case GetType(DevExpress.XtraEditors.ComboBoxEdit)
DirectCast(ctrl, DevExpress.XtraEditors.ComboBoxEdit).Text = newValue?.ToString()
' ========== FIX END ==========
Case GetType(CheckBox)
If TypeOf newValue Is Boolean Then

View File

@@ -2,8 +2,21 @@
Public Class frmError
Public ValidatorError As String = ""
Private _isClosing As Boolean = False
Private Sub OK_Button_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles OK_Button.Click
Me.Close()
' ========== FIX 1: Event-Handler SOFORT deregistrieren ==========
RemoveHandler OK_Button.Click, AddressOf OK_Button_Click
' ========== DIAGNOSE: StackTrace ausgeben ==========
Dim st As New StackTrace(True)
LOGGER.Debug($"[frmError] OK_Button_Click aufgerufen von:")
For Each frame As StackFrame In st.GetFrames()
LOGGER.Debug($" {frame.GetMethod()?.DeclaringType?.Name}.{frame.GetMethod()?.Name} (Zeile {frame.GetFileLineNumber()})")
Next
' ========== ENDE DIAGNOSE ==========
CloseDialog()
End Sub
Private Sub frmError_Load(sender As Object, e As System.EventArgs) Handles Me.Load
@@ -27,7 +40,45 @@ Public Class frmError
End If
End Sub
Private Sub frmError_Shown(sender As Object, e As System.EventArgs) Handles Me.Shown
Me.Label1.Focus()
Private Sub CloseDialog()
' ========== FIX 2: Guard mit Dispose-Check ==========
If _isClosing OrElse Me.IsDisposed Then
LOGGER.Debug($"[frmError] CloseDialog blockiert (isClosing={_isClosing}, IsDisposed={Me.IsDisposed})")
Exit Sub
End If
_isClosing = True
LOGGER.Debug($"[frmError] CloseDialog: Flag gesetzt, starte verzögerten Close")
' ========== FIX 3: VERZÖGERTER Close via BeginInvoke ==========
' KRITISCH: Close wird NACH Abschluss des aktuellen Event-Handlers ausgeführt
Me.BeginInvoke(New Action(Sub()
If Not Me.IsDisposed Then
Me.DialogResult = DialogResult.OK
Me.Close()
LOGGER.Debug($"[frmError] Dialog geschlossen via BeginInvoke")
End If
End Sub))
' ========== ENDE FIX 3 ==========
End Sub
Private Sub frmError_Shown(sender As Object, e As EventArgs) Handles Me.Shown
Me.Label1.Focus()
LOGGER.Debug($"[frmError] Dialog angezeigt - Enabled: {Me.Enabled}")
End Sub
Private Sub frmError_Activated(sender As Object, e As EventArgs) Handles Me.Activated
LOGGER.Debug($"[frmError] Dialog aktiviert")
End Sub
' ========== FIX 4: FormClosing-Handler hinzufügen ==========
Private Sub frmError_FormClosing(sender As Object, e As FormClosingEventArgs) Handles Me.FormClosing
If _isClosing Then
LOGGER.Debug($"[frmError] FormClosing: Close bereits aktiv, erlauben")
Return
End If
' Falls Close von außen (z.B. [X]-Button) ausgelöst wurde
_isClosing = True
LOGGER.Debug($"[frmError] FormClosing: Flag gesetzt via FormClosing")
End Sub
' ========== ENDE FIX 4 ==========
End Class

View File

@@ -125,7 +125,7 @@
AAEAAAD/////AQAAAAAAAAAMAgAAAFdTeXN0ZW0uV2luZG93cy5Gb3JtcywgVmVyc2lvbj00LjAuMC4w
LCBDdWx0dXJlPW5ldXRyYWwsIFB1YmxpY0tleVRva2VuPWI3N2E1YzU2MTkzNGUwODkFAQAAACZTeXN0
ZW0uV2luZG93cy5Gb3Jtcy5JbWFnZUxpc3RTdHJlYW1lcgEAAAAERGF0YQcCAgAAAAkDAAAADwMAAADw
CAAAAk1TRnQBSQFMAgEBAgEAAcABCwHAAQsBEAEAARABAAT/AQkBAAj/AUIBTQE2AQQGAAE2AQQCAAEo
CAAAAk1TRnQBSQFMAgEBAgEAAfABCwHwAQsBEAEAARABAAT/AQkBAAj/AUIBTQE2AQQGAAE2AQQCAAEo
AwABQAMAARADAAEBAQABCAYAAQQYAAGAAgABgAMAAoABAAGAAwABgAEAAYABAAKAAgADwAEAAcAB3AHA
AQAB8AHKAaYBAAEzBQABMwEAATMBAAEzAQACMwIAAxYBAAMcAQADIgEAAykBAANVAQADTQEAA0IBAAM5
AQABgAF8Af8BAAJQAf8BAAGTAQAB1gEAAf8B7AHMAQABxgHWAe8BAAHWAucBAAGQAakBrQIAAf8BMwMA
@@ -2105,7 +2105,7 @@
<value>True</value>
</metadata>
<metadata name="$this.TrayHeight" type="System.Int32, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>147</value>
<value>123</value>
</metadata>
<data name="$this.AutoScaleDimensions" type="System.Drawing.SizeF, System.Drawing">
<value>9, 19</value>

View File

@@ -15,6 +15,7 @@ Imports DevExpress.XtraGrid.Views.Grid
Imports DevExpress.XtraGrid.Views.Grid.ViewInfo
Imports DevExpress.XtraNavBar
Imports DevExpress.XtraPrinting
Imports DevExpress.XtraSplashScreen
Imports DigitalData.GUIs.Common
Imports DigitalData.Modules.Base
Imports DigitalData.Modules.EDMI.API.Constants
@@ -61,6 +62,7 @@ Public Class frmMain
Private DetailLinkActive As Boolean = False
Private FRONTEND_ACTION As String = "NONE"
Private Ev_Filter_Panel_Closed As Boolean = False
Private _overlayActive As Boolean = False
Dim omsgOpenWorkflow As String
Dim omsgTitleWarning As String
@@ -1398,6 +1400,13 @@ Public Class frmMain
' HAUPTLADEMETHODE - Koordiniert den gesamten Ladevorgang
' ========================================
Private Async Function Decide_Load(pIsFormLoad As Boolean, Optional ForceReload As Boolean = False) As Tasks.Task
Dim oHandle As Object = Nothing
Dim overlayStartedHere As Boolean = False
If Not _overlayActive Then
oHandle = SplashScreenManager.ShowOverlayForm(Me)
_overlayActive = True
overlayStartedHere = True
End If
Dim perfStart As DateTime = DateTime.MinValue
Dim refreshWasEnabled As Boolean = False
@@ -1436,10 +1445,10 @@ Public Class frmMain
LOGGER.Info("[PERF Decide_Load] ruft LoadOverviewData auf...")
End If
' UI vorbereiten
If Not PrepareGridForLoading() Then
Exit Function
End If
'' UI vorbereiten
'If Not PrepareGridForLoading() Then
' Exit Function
'End If
Await Task.Yield()
@@ -1451,10 +1460,10 @@ Public Class frmMain
LOGGER.Info("[PERF Decide_Load] ruft LoadProfileData auf...")
End If
' UI vorbereiten
If Not PrepareGridForLoading() Then
Exit Function
End If
'' UI vorbereiten
'If Not PrepareGridForLoading() Then
' Exit Function
'End If
Await Task.Yield()
@@ -1477,7 +1486,10 @@ Public Class frmMain
LOGGER.Info("Unexpected error in Decide_load: " & ex.Message)
Finally
FRONTEND_ACTION = FA_NONE
If overlayStartedHere Then
_overlayActive = False
SplashScreenManager.CloseOverlayForm(oHandle)
End If
If refreshWasEnabled Then
TimerRefresh.Start()
End If
@@ -1491,33 +1503,6 @@ Public Class frmMain
End If
End Try
End Function
' ========================================
' UI-VORBEREITUNG - Macht Grid sichtbar und zeigt LoadingPanel
' ========================================
Private Function PrepareGridForLoading() As Boolean
Try
' Grid sichtbar machen
If GridControlWorkflows.Visible = False Then
GridControlWorkflows.Visible = True
End If
' UI-Thread Zeit geben
Application.DoEvents()
' LoadingPanel anzeigen
GridViewWorkflows.ShowLoadingPanel()
' Nochmal Zeit zum Rendern
Application.DoEvents()
Return True
Catch ex As Exception
LOGGER.Error(ex)
Return False
End Try
End Function
' ========================================
' OVERVIEW DATEN LADEN - Spezialisiert auf Overview
' ========================================
@@ -1686,9 +1671,6 @@ Public Class frmMain
GridControlWorkflows.EndUpdate()
End If
' LoadingPanel verstecken (NUR HIER!)
GridViewWorkflows.HideLoadingPanel()
If LOG_HOTSPOTS Then
Dim totalElapsed = (DateTime.Now - perfStart).TotalMilliseconds
If totalElapsed > 4000 Then
@@ -1759,9 +1741,6 @@ Public Class frmMain
If gridUpdateStarted Then
GridControlWorkflows.EndUpdate()
End If
' LoadingPanel verstecken (NUR HIER!)
GridViewWorkflows.HideLoadingPanel()
End Try
End Function
@@ -1998,6 +1977,8 @@ Public Class frmMain
Dim useWaitCursorApplied As Boolean = False
Dim previousMessage As String = bsiMessage.Caption
Dim messageApplied As Boolean = False
Dim oHandle As Object = Nothing
Dim overlayStartedHere As Boolean = False
If LOG_HOTSPOTS Then
perfStart = DateTime.Now
@@ -2008,6 +1989,14 @@ Public Class frmMain
CURRENT_ProfilGUID = pProfilID
WM_AHWF_docPath = String.Empty
' ========== OVERLAY ANZEIGEN ==========
If Not _overlayActive Then
oHandle = SplashScreenManager.ShowOverlayForm(Me)
_overlayActive = True
overlayStartedHere = True
End If
' ========== UI-VORBEREITUNG ==========
Me.UseWaitCursor = True
useWaitCursorApplied = True
@@ -2112,6 +2101,13 @@ Public Class frmMain
MsgBox("Unexpected error in Load_Profil_from_Grid: " & ex.Message & vbNewLine & ADDITIONAL_TITLE & " will try to reload the overview - Please try again!", MsgBoxStyle.Information, ADDITIONAL_TITLE)
Dim task = Decide_Load(False, True)
Finally
' ========== OVERLAY SCHLIESSEN (FALLBACK) ==========
If overlayStartedHere AndAlso _overlayActive Then
SplashScreenManager.CloseOverlayForm(oHandle)
LOGGER.Debug("Overlay closed in Load_Profil_from_Grid")
_overlayActive = False
End If
' ========== UI AUFRÄUMEN ==========
If useWaitCursorApplied Then
Me.UseWaitCursor = False
@@ -2287,6 +2283,13 @@ Public Class frmMain
Exit Function
End If
If oIds.Count > 1000 Then
Dim omsg = String.Format("You chose more than 1000 Workflows. Please select fewer items.", vbNewLine)
FormHelper.ShowInfoMessage(omsg, omsgTitleAttention)
Exit Function
End If
' ========== DB-OPERATIONEN ==========
LOGGER.Debug("Cleaning up queued DocIds..")
Dim oDelete = $"DELETE FROM TBPM_VALIDATION_PROFILE_GROUP_USER WHERE UserID = {USER_ID}"
@@ -2548,11 +2551,9 @@ Public Class frmMain
Dim viewUpdateStarted As Boolean = False
Dim layoutRestored As Boolean = False
Dim resetLayoutTriggered As Boolean = False
Dim showLoadingPanel As Boolean = False
Dim useWaitCursorApplied As Boolean = False
Dim previousMessage As String = bsiMessage.Caption
Dim loadingMessageApplied As Boolean = False
Dim gridWasMadeVisible As Boolean = False
If LOG_HOTSPOTS Then
perfStart = DateTime.Now
@@ -2564,24 +2565,11 @@ Public Class frmMain
' SCHRITT 1: Grid sichtbar machen
If GridControlWorkflows.Visible = False Then
GridControlWorkflows.Visible = True
gridWasMadeVisible = True
End If
GRID_LOAD_TYPE = "OVERVIEW"
CURRENT_CLICKED_PROFILE_ID = 0
' SCHRITT 2: UI-Thread Zeit geben, das Grid zu rendern
Application.DoEvents()
Await Task.Delay(100)
' SCHRITT 3: LoadingPanel anzeigen (jetzt ist das Grid definitiv sichtbar!)
GridViewWorkflows.ShowLoadingPanel()
showLoadingPanel = True
' SCHRITT 4: UI-Thread Zeit zum Rendern des LoadingPanels geben
Application.DoEvents()
Await Task.Delay(150)
If LOG_HOTSPOTS Then
Dim elapsed = (DateTime.Now - perfStep).TotalMilliseconds
If elapsed > 4000 Then
@@ -2876,7 +2864,6 @@ Public Class frmMain
Finally
' ========== AUFRÄUMEN ==========
' EndUpdate IMMER aufrufen (vor dem Verstecken des LoadingPanel)
If viewUpdateStarted Then
GridViewWorkflows.EndUpdate()
End If
@@ -2884,11 +2871,6 @@ Public Class frmMain
GridControlWorkflows.EndUpdate()
End If
' LoadingPanel SOFORT nach EndUpdate verstecken
If showLoadingPanel Then
GridViewWorkflows.HideLoadingPanel()
End If
' WaitCursor entfernen
If useWaitCursorApplied Then
Me.UseWaitCursor = False
@@ -3474,11 +3456,26 @@ FROM VWPM_PROFILE_ACTIVE T WHERE T.GUID IN (SELECT PROFILE_ID FROM [dbo].[FNPM_G
End Sub
Private Sub bwBasicData_RunWorkerCompleted(sender As Object, e As RunWorkerCompletedEventArgs) Handles bwBasicData.RunWorkerCompleted
Try
If e.Error IsNot Nothing Then
LOGGER.Error(e.Error)
LOGGER.Warn($"bwBasicData completed with error: {e.Error.Message}")
End If
If USER_IS_ADMIN Then
'bsiDebug.Caption = $"{ClassAllgemeineFunktionen.GUI_LANGUAGE_INFO("LicenseCountCaption")}: {USERCOUNT_LOGGED_IN}"
bsiDebug.Caption = String.Format(S.Anzahl_Lizenzen___0_, USERCOUNT_LOGGED_IN)
End If
Catch ex As Exception
LOGGER.Error(ex)
Finally
BarEditItem1.Visibility = DevExpress.XtraBars.BarItemVisibility.Never
' Caption zurücksetzen, falls sie noch auf "busy" steht
If bsiMessage.Caption = "bwBasicData is busy - no Refreshing" Then
bsiMessage.Caption = ""
bsiMessage.ItemAppearance.Normal.BackColor = Color.Transparent
bsiMessage.ItemAppearance.Normal.ForeColor = Color.Empty
End If
End Try
End Sub
Private Sub bwBasicData_ProgressChanged(sender As Object, e As ProgressChangedEventArgs) Handles bwBasicData.ProgressChanged

File diff suppressed because it is too large Load Diff

View File

@@ -624,6 +624,12 @@
<Compile Include="frmError.vb">
<SubType>Form</SubType>
</Compile>
<Compile Include="frmExpression_Designer.Designer.vb">
<DependentUpon>frmExpression_Designer.vb</DependentUpon>
</Compile>
<Compile Include="frmExpression_Designer.vb">
<SubType>Form</SubType>
</Compile>
<Compile Include="frmFileInfo.Designer.vb">
<DependentUpon>frmFileInfo.vb</DependentUpon>
</Compile>
@@ -868,6 +874,9 @@
<DependentUpon>frmError.vb</DependentUpon>
<SubType>Designer</SubType>
</EmbeddedResource>
<EmbeddedResource Include="frmExpression_Designer.resx">
<DependentUpon>frmExpression_Designer.vb</DependentUpon>
</EmbeddedResource>
<EmbeddedResource Include="frmFileInfo.resx">
<DependentUpon>frmFileInfo.vb</DependentUpon>
<SubType>Designer</SubType>