From c249aa890ddcf78c6b825c2e9d36c959adb78ef2 Mon Sep 17 00:00:00 2001 From: Developer01 Date: Thu, 29 Jan 2026 10:46:09 +0100 Subject: [PATCH] Messpunkte integriert --- app/TaskFlow/ClassControlCreator.vb | 2 +- app/TaskFlow/ClassParamRefresh.vb | 2 + app/TaskFlow/ModuleMySettings.vb | 2 +- app/TaskFlow/frmMain.vb | 6 +- app/TaskFlow/frmValidator.vb | 1424 ++++++++++++++------------- 5 files changed, 736 insertions(+), 700 deletions(-) diff --git a/app/TaskFlow/ClassControlCreator.vb b/app/TaskFlow/ClassControlCreator.vb index c0fddec..4506b94 100644 --- a/app/TaskFlow/ClassControlCreator.vb +++ b/app/TaskFlow/ClassControlCreator.vb @@ -93,7 +93,7 @@ Public Class ClassControlCreator Public Attribute As String Public [ReadOnly] As Boolean = False Public BackColor As Color = Color.White - + Public Property IsDirty As Boolean = False End Class Public Sub New(pLogConfig As LogConfig) diff --git a/app/TaskFlow/ClassParamRefresh.vb b/app/TaskFlow/ClassParamRefresh.vb index 042aaf4..30d4bbb 100644 --- a/app/TaskFlow/ClassParamRefresh.vb +++ b/app/TaskFlow/ClassParamRefresh.vb @@ -73,6 +73,8 @@ Public Class ClassParamRefresh ElseIf oMode = "PM.DEBUG_LOG" Then DEBUG = True LOGCONFIG.Debug = True + ElseIf oMode = "PM.LOG_HOTSPOTS" Then + LOG_HOTSPOTS = True ElseIf oMode.StartsWith("OPERATION_MODE_FS") Then OPERATION_MODE_FS = oMode.Replace("OPERATION_MODE_FS=", "") If OPERATION_MODE_FS = ClassConstants.OpModeFS_IDBWM Then diff --git a/app/TaskFlow/ModuleMySettings.vb b/app/TaskFlow/ModuleMySettings.vb index f0fbf36..a518ab4 100644 --- a/app/TaskFlow/ModuleMySettings.vb +++ b/app/TaskFlow/ModuleMySettings.vb @@ -14,7 +14,7 @@ Public Property NO_DETAIL_PROFILES As Boolean = False ' Debug Settings Public Property DEBUG As Boolean = False - + Public Property LOG_HOTSPOTS As Boolean = False Public Property INDEX_DMS_ERSTELLT = "DMS erstellt" Public Property INDEX_DMS_ERSTELLT_ZEIT = "DMS erstellt (Zeit)" diff --git a/app/TaskFlow/frmMain.vb b/app/TaskFlow/frmMain.vb index 87758aa..b7bb1e6 100644 --- a/app/TaskFlow/frmMain.vb +++ b/app/TaskFlow/frmMain.vb @@ -2544,10 +2544,10 @@ FROM VWPM_PROFILE_ACTIVE T WHERE T.GUID IN (SELECT PROFILE_ID FROM [dbo].[FNPM_G Handling_DEBUG_USER() - Dim oSQL = $"SELECT * FROM TBDD_NOTIFICATIONS_SYSTEM NOTE - INNER JOIN (SELECT * FROM TBDD_NOTIFICATIONS_SYSTEM WHERE LANG_CODE = '{USER_LANGUAGE}' OR LANG_CODE = 'ALL') LANG ON NOTE.GUID = LANG.GUID + Dim oSQL = $"SELECT * FROM TBDD_NOTIFICATIONS_SYSTEM NOTE WITH (NOLOCK) + INNER JOIN (SELECT * FROM TBDD_NOTIFICATIONS_SYSTEM WITH (NOLOCK) WHERE LANG_CODE = '{USER_LANGUAGE}' OR LANG_CODE = 'ALL') LANG ON NOTE.GUID = LANG.GUID where (CONVERT(DATE,GETDATE()) <= NOTE.DISPLAY_UNTIL or NOTE.DISPLAY_UNTIL IS NULL) AND NOTE.MODULE = 'PM' - AND NOTE.GUID NOT IN (SELECT NOTIFY_ID FROM TBDD_NOTIFICATIONS_USER_HISTORY WHERE USR_ID = {USER_ID})" + AND NOTE.GUID NOT IN (SELECT NOTIFY_ID FROM TBDD_NOTIFICATIONS_USER_HISTORY WITH (NOLOCK) WHERE USR_ID = {USER_ID})" Dim oDT As DataTable = DatabaseFallback.GetDatatable("TBDD_NOTIFICATIONS_SYSTEM", New GetDatatableOptions(oSQL, DatabaseType.ECM)) If Not IsNothing(oDT) Then diff --git a/app/TaskFlow/frmValidator.vb b/app/TaskFlow/frmValidator.vb index 3944db7..d07dc8e 100644 --- a/app/TaskFlow/frmValidator.vb +++ b/app/TaskFlow/frmValidator.vb @@ -178,16 +178,15 @@ Public Class frmValidator Return False ' Punkt ist außerhalb aller sichtbaren Bereiche End Function Private Sub frmValidation_Load(sender As Object, e As System.EventArgs) Handles Me.Load + ' === MESSPUNKT 1: Start === + Dim perfStart As DateTime = If(LOG_HOTSPOTS, DateTime.Now, Nothing) + Dim perfLastCheck As DateTime = perfStart + If LOG_HOTSPOTS Then MyValidationLogger.Info($"[PERF] frmValidation_Load START") Try - - - If LOG_PERF Then PerformanceLogger.Info("frmValidation_Load") MyValidationLogger.Debug("###frmValidation_Load###") MyValidationLogger.Debug("Current User Language: [{0}]", USER_LANGUAGE) - ' Operation mode is either guessed from service settings - ' or explictly set from OperationModeOverride in Params OperationMode = GetOperationMode() DD_Documentloader = New Loader(LOGCONFIG, OperationMode, Environment.Service.Client, Environment.User) @@ -198,18 +197,21 @@ Public Class frmValidator SplitContainer1.Panel2Collapsed = True first_control = Nothing _FormClosing = False - _FormLoaded = False + If LOG_HOTSPOTS Then + MyValidationLogger.Info($"[PERF] Nach Initialisierung: {(DateTime.Now - perfLastCheck).TotalMilliseconds}ms") + perfLastCheck = DateTime.Now + End If + Catch ex As Exception MyValidationLogger.Warn($"Error in frmValidation_load1: {ex.Message}") End Try Try + ' === MESSPUNKT 3: Form-Position wiederherstellen === If My.Settings.frmValidatorPosition.IsEmpty = False Then - If IsPositionVisible(My.Settings.frmValidatorPosition) Then - ' Position ist sichtbar, das Formular wird dort angezeigt Try ScreenEx.RestoreFormPosition(Me, My.Settings.frmValidatorPosition) Catch ex As Exception @@ -222,17 +224,13 @@ Public Class frmValidator Try MyValidationLogger.Debug($"!! Invalid PositionData X({My.Settings.frmValidatorPosition.X}), Y({My.Settings.frmValidatorPosition.Y})") Catch ex As Exception - End Try - End If - Else - ' Position ist unsichtbar, Standardposition verwenden Me.StartPosition = FormStartPosition.CenterScreen - End If End If + If My.Settings.frmValidatorSize.IsEmpty = False Then If My.Settings.frmValidatorSize.Width > 0 And My.Settings.frmValidatorSize.Height > 0 Then If My.Settings.frmValidatorWindowState = "Normal" Then @@ -242,41 +240,61 @@ Public Class frmValidator End If End If End If + + If LOG_HOTSPOTS Then + MyValidationLogger.Info($"[PERF] Nach Position/Size: {(DateTime.Now - perfLastCheck).TotalMilliseconds}ms") + perfLastCheck = DateTime.Now + End If + Catch ex As Exception MyValidationLogger.Info($"Error loading position: {ex.Message}") End Try Dim _step = 0 Try + ' === MESSPUNKT 4: DocumentViewer Init === Dim oDVSettings As New DigitalData.Controls.DocumentViewer.DocumentViewer.ToolbarSettings() With { - .ShowPrintButton = True, - .ShowRotateButton = True, - .ShowFlipButton = True, - .ShowSettingButton = True - } + .ShowPrintButton = True, + .ShowRotateButton = True, + .ShowFlipButton = True, + .ShowSettingButton = True + } DocumentViewer1.Init(LOGCONFIG, GDPICTURE_LICENSE, oDVSettings) + If LOG_HOTSPOTS Then + MyValidationLogger.Info($"[PERF] Nach DocumentViewer.Init: {(DateTime.Now - perfLastCheck).TotalMilliseconds}ms") + perfLastCheck = DateTime.Now + End If + Catch ex As Exception MyValidationLogger.Error(ex) End Try + Try _step = 1 _step = 2 + ' === MESSPUNKT 5: Profile Data laden (KRITISCH) === DTVWCONTROL_INDEX.Clear() Dim oExpression = $"PROFIL_ID = {CURRENT_ProfilGUID}" DTVWCONTROLS_INDEX.Select(oExpression, "Y_LOC, X_LOC").CopyToDataTable(DTVWCONTROL_INDEX, LoadOption.PreserveChanges) + If LOG_HOTSPOTS Then + MyValidationLogger.Info($"[PERF] Nach DTVWCONTROL_INDEX laden ({DTVWCONTROL_INDEX.Rows.Count} Rows): {(DateTime.Now - perfLastCheck).TotalMilliseconds}ms") + perfLastCheck = DateTime.Now + End If + _step = 3 MyValidationLogger.Debug("Profile Data loaded") + Catch ex As Exception MyValidationLogger.Error(ex) MsgBox("Error LOADING profile-data(" & _step.ToString & "):" & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Attention:") MyValidationLogger.Info(">> Error in LOADING profile-data: " & ex.Message, True) Me.Close() End Try - MyValidationLogger.Debug("frmValidation_Load finished till Step 3!") + MyValidationLogger.Debug("frmValidation_Load finished till Step 3!") Try If CURRENT_DT_PROFILE.Rows.Count = 0 Then @@ -284,16 +302,21 @@ Public Class frmValidator MsgBox("ProfileData could not be loaded - Profile: " & CURRENT_ProfilName, MsgBoxStyle.Critical, "Attention:") Me.Close() End If + _step = 4 MyValidationLogger.Debug("Step 4") + If CURRENT_DT_PROFILE.Rows.Count > 1 Then MsgBox("More than 1 profile (" & CURRENT_DT_PROFILE.Rows.Count & ") returned!!", MsgBoxStyle.Critical, "Attention:") Else _step = 5 MyValidationLogger.Debug("Step 5") + If CURRENT_DT_PROFILE.Rows.Count = 1 Then _step = 6 MyValidationLogger.Debug("Step 6") + + ' === MESSPUNKT 6: Profile-Properties verarbeiten === For Each oProfileRow As DataRow In CURRENT_DT_PROFILE.Rows PROFIL_FINISH_SQL = oProfileRow.Item("SQL_BTN_FINISH") PROFIL_VEKTORINDEX = oProfileRow.Item("PM_VEKTOR_INDEX") @@ -305,6 +328,13 @@ Public Class frmValidator REJECTION_ACTIVE = False PROFIL_LOGINDEX = oProfileRow.Item("LOG_INDEX") CURRENT_PROFILE_LOG_INDEX = PROFIL_LOGINDEX + + If LOG_HOTSPOTS Then + MyValidationLogger.Info($"[PERF] Nach Profile-Properties: {(DateTime.Now - perfLastCheck).TotalMilliseconds}ms") + perfLastCheck = DateTime.Now + End If + + ' === MESSPUNKT 7: Language-Strings laden (potentiell langsam) === Dim oProfileTitle As String = "" Dim oProfileDescription As String = "" @@ -327,6 +357,11 @@ Public Class frmValidator End If Next + If LOG_HOTSPOTS Then + MyValidationLogger.Info($"[PERF] Nach Language-Loop ({CURRENT_DT_PROFILE_LANGUAGE.Rows.Count} Rows): {(DateTime.Now - perfLastCheck).TotalMilliseconds}ms") + perfLastCheck = DateTime.Now + End If + If oProfileTitle = "" Then oProfileTitle = oProfileRow.Item("TITLE") End If @@ -355,6 +390,8 @@ Public Class frmValidator finalProfile = oProfileRow.Item("FINAL_PROFILE") Move2Folder = IIf(IsDBNull(oProfileRow.Item("MOVE2Folder")), "", oProfileRow.Item("MOVE2Folder")) + + ' === MESSPUNKT 8: Button-Texte setzen === Try If finalProfile = True Then If oProfileFinalText = "" Then @@ -362,41 +399,45 @@ Public Class frmValidator Else oProfileFinalText = $"{oProfileFinalText} (F2)" End If - btnSave.Text = oProfileFinalText Else oProfileFinalText = IIf(IsDBNull(oProfileRow.Item("FINAL_TEXT")), "", oProfileRow.Item("FINAL_TEXT") & (" (F2)")) - 'btnSave.Text = ClassAllgemeineFunktionen.GUI_LANGUAGE_INFO("frmValidator.ValidationButton") If oProfileFinalText = String.Empty Then oProfileFinalText = ClassAllgemeineFunktionen.GUI_LANGUAGE_INFO("frmValidator.ValidationButton") End If btnSave.Text = oProfileFinalText End If MyValidationLogger.Debug("Buttontext validation loaded") + + If LOG_HOTSPOTS Then + MyValidationLogger.Info($"[PERF] Nach Button-Setup: {(DateTime.Now - perfLastCheck).TotalMilliseconds}ms") + perfLastCheck = DateTime.Now + End If + Catch ex As Exception MyValidationLogger.Error(ex) MsgBox("Error loading final profile text:" & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Attention:") MyValidationLogger.Info(">> Error loading final profile text: " & ex.Message, True) End Try + + ' === MESSPUNKT 9: Rejection/NotResponsible-Buttons konfigurieren === Dim PROF_BTN_RE_CAPT = oProfileRow.Item("BTN_REJECT_CAPTION") Dim PROF_SQL_BTN_REJECT = oProfileRow.Item("SQL_BTN_REJECT") oProfile_REJECT_SQL_REASONS = oProfileRow.Item("REJECT_SQL_REASONS") oProfile_NOT_RESP_SQL = oProfileRow.Item("NOT_RESP_SQL") - If oProfileRejectionText = String.Empty Then oProfileRejectionText = PROF_BTN_RE_CAPT End If - - MyValidationLogger.Debug($"oProfileRejectionText: " + oProfileRejectionText) MyValidationLogger.Debug($"oProfile_REJECT_SQL_REASONS: " + oProfile_REJECT_SQL_REASONS) MyValidationLogger.Debug($"oProfileNotResponsibleText: " + oProfileNotResponsibleText) MyValidationLogger.Debug($"oProfile_NOT_RESP_SQL: " + oProfile_NOT_RESP_SQL) - MyValidationLogger.Debug($"oProfileRejectionText: " + oProfileRejectionText) + Dim functBtnReject As Boolean = False Dim functBtnNR As Boolean = False + If oProfileRejectionText <> String.Empty And oProfile_REJECT_SQL_REASONS <> String.Empty Then functBtnReject = True End If @@ -405,6 +446,7 @@ Public Class frmValidator functBtnNR = True End If End If + If functBtnReject = False And functBtnNR = False Then MyValidationLogger.Debug($"!Keine Ablehnung und Nicht zuständig Funktion konfiguriert!") SplitContainerReject_NotResp.Visible = False @@ -454,16 +496,20 @@ Public Class frmValidator End If End If + If LOG_HOTSPOTS Then + MyValidationLogger.Info($"[PERF] Nach Rejection/NR-Setup: {(DateTime.Now - perfLastCheck).TotalMilliseconds}ms") + perfLastCheck = DateTime.Now + End If bbtniNext.Visibility = BarItemVisibility.Never If CURRENT_JUMP_DOC_GUID <> 0 Then Amount_Docs2Validate = 1 Else - Amount_Docs2Validate = 0 End If Next + MyValidationLogger.Debug(" >> profiledata saved:") MyValidationLogger.Debug(" >> finalProfile: " & finalProfile) MyValidationLogger.Debug(" >> Move2Folder: " & Move2Folder) @@ -471,38 +517,43 @@ Public Class frmValidator PROFIL_sortbynewest = CURRENT_DT_PROFILE.Rows(0).Item("SORT_BY_LATEST") MyValidationLogger.Debug("PROFIL_sortbynewest: " & PROFIL_sortbynewest.ToString) - 'Delete Button anzeigen ja/nein + If USER_RIGHT_FILE_DELETE = True Then bbtniDelete.Visibility = BarItemVisibility.Always - Else bbtniDelete.Visibility = BarItemVisibility.Never End If If CBool(CURRENT_DT_PROFILE.Rows(0).Item("ANNOTATE_WORK_HISTORY_ENTRY")) = True Then bbtniAnnotation.Visibility = BarItemVisibility.Always - Else bbtniAnnotation.Visibility = BarItemVisibility.Never End If - MyValidationLogger.Debug("Right_Delete: " & USER_RIGHT_FILE_DELETE.ToString) - Create_Controls() + MyValidationLogger.Debug("Right_Delete: " & USER_RIGHT_FILE_DELETE.ToString) + ' === MESSPUNKT 10: Create_Controls (KRITISCH - wahrscheinlich größter Hotspot) === + If LOG_HOTSPOTS Then MyValidationLogger.Info($"[PERF] Vor Create_Controls") + Create_Controls() + If LOG_HOTSPOTS Then + MyValidationLogger.Info($"[PERF] Nach Create_Controls: {(DateTime.Now - perfLastCheck).TotalMilliseconds}ms") + perfLastCheck = DateTime.Now + End If End If End If - 'oErrMsgMissingInput = ClassAllgemeineFunktionen.GUI_LANGUAGE_INFO("frmValidator.MissingInput") - ' oErrMsgMissingInput = S.Bitte_validieren_Sie_die_rot_markierten_Felder_ - ' frmError.ShowDialog() MyValidationLogger.Debug("frmValidation_Load finished!") + ' === MESSPUNKT 11: Gesamt-Zeit === + If LOG_HOTSPOTS Then + MyValidationLogger.Info($"[PERF] GESAMT frmValidation_Load: {(DateTime.Now - perfStart).TotalMilliseconds}ms") + End If + Catch ex As Exception MyValidationLogger.Error(ex) MsgBox("Error LOADING Profile-Data1:" & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Attention:") MyValidationLogger.Info("Unexpected error in LOADING Profile-Data1: " & ex.Message) End Try - End Sub @@ -936,6 +987,7 @@ Public Class frmValidator AddHandler txt.GotFocus, AddressOf OnTextBoxFocus AddHandler txt.LostFocus, AddressOf OnTextBoxLostFocus AddHandler txt.KeyUp, AddressOf OnTextBoxKeyUp + AddHandler txt.EditValueChanged, AddressOf OnTextBoxEditValueChanged oMyControl = txt MyValidationLogger.Debug($"[{oControlInfo}] - TXT Created!!") @@ -1144,7 +1196,8 @@ Public Class frmValidator Dim oGrid = ControlCreator.CreateExistingGridControl(oControlRow, oFilteredDatatable, False, DocCurrency) oMyControl = oGrid - 'AddHandler oGrid.Views(0).c AddressOf GridView_CustomColumnDisplayText + ' NEU: GridView Event registrieren + AddHandler DirectCast(oGrid.MainView, GridView).CellValueChanged, AddressOf GridView_CellValueChanged Case "LINE" oMyControl = ControlCreator.CreateExistingLine(oControlRow, False) @@ -1243,13 +1296,19 @@ Public Class frmValidator If oMeta.ReadOnly = False Then oTextbox.BackColor = oMeta.BackColor oTextbox.ForeColor = GraphicsEx.GetContrastedColor(oMeta.BackColor) + End If + ' NEU: Dirty-Flag setzen - OHNE .Modified Property + ' Stattdessen prüfen wir, ob das Control bereits als dirty markiert wurde + ' oder setzen es bei jedem LostFocus (einfachste Lösung) + If Not oMeta.IsDirty Then + oMeta.IsDirty = True + MyValidationLogger.Debug($"Control [{oMeta.Name}] marked as dirty") End If SetControlValues_FromControl(oTextbox) Controls2beEnabled(oTextbox.Name) ControlCreator.GridTables_HandleControlValueChange(PanelValidatorControl, DT_COLUMNS_GRID_WITH_SQL_WITH_CTRL_PLACEHOLDER) - End Sub Private Function GetControlID(ByVal PROFILEID As Integer, Controlname As String) @@ -1257,7 +1316,19 @@ Public Class frmValidator Next End Function + Private Sub OnTextBoxEditValueChanged(sender As Object, e As EventArgs) + If _FormLoaded = False Or _Indexe_Loaded = False Then + Exit Sub + End If + + Dim oTextbox As BaseEdit = sender + Dim oMeta As ClassControlCreator.ControlMetadata = oTextbox.Tag + If Not oMeta.IsDirty Then + oMeta.IsDirty = True + MyValidationLogger.Debug($"TextBox [{oMeta.Name}] marked as dirty") + End If + End Sub Public Sub OnTextBoxKeyUp(sender As Object, e As KeyEventArgs) If _ControlHandleStarted = True Then @@ -1566,6 +1637,18 @@ Public Class frmValidator Try Dim oLookup As RepositoryItemLookupControl3 = sender + ' NEU: Dirty-Flag setzen - Suche den zugehörigen LookupControl + For Each oControl In PanelValidatorControl.Controls + If TypeOf oControl Is LookupControl3 Then + Dim oLookupControl As LookupControl3 = DirectCast(oControl, LookupControl3) + If oLookupControl.Properties Is oLookup Then + Dim oMeta As ClassControlCreator.ControlMetadata = oLookupControl.Tag + oMeta.IsDirty = True + MyValidationLogger.Debug($"LookupControl [{oMeta.Name}] marked as dirty") + Exit For + End If + End If + Next listChangedLookup.Add(oLookup.Name) ControlCreator.GridTables_HandleControlValueChange(PanelValidatorControl, DT_COLUMNS_GRID_WITH_SQL_WITH_CTRL_PLACEHOLDER) @@ -1589,7 +1672,14 @@ Public Class frmValidator End Try End Sub + Private Sub GridView_CellValueChanged(sender As Object, e As DevExpress.XtraGrid.Views.Base.CellValueChangedEventArgs) + Dim oView As GridView = sender + Dim oGrid As GridControl = oView.GridControl + Dim oMeta As ClassControlCreator.ControlMetadata = oGrid.Tag + oMeta.IsDirty = True + MyValidationLogger.Debug($"GridControl [{oMeta.Name}] marked as dirty (Row {e.RowHandle}, Col {e.Column.FieldName})") + End Sub Public Sub onCheckBox_CheckedChange(sender As Object, e As EventArgs) MyValidationLogger.Debug("onCheckBox_CheckedChange") @@ -1597,6 +1687,11 @@ Public Class frmValidator Exit Sub End If Dim oCheckbox As CheckBox = sender + ' Dirty-Flag setzen + Dim oMeta As ClassControlCreator.ControlMetadata = oCheckbox.Tag + oMeta.IsDirty = True + MyValidationLogger.Debug($"CheckBox [{oMeta.Name}] marked as dirty") + Try CheckBox_DependingControls(oCheckbox) Checkbox_EnablingControls(oCheckbox) @@ -2189,6 +2284,10 @@ Public Class frmValidator Public Sub OnCmbselectedIndex(sender As System.Object, e As System.EventArgs) Dim oCombobox As Windows.Forms.ComboBox = sender If oCombobox.SelectedIndex <> -1 And _Indexe_Loaded = True Then + ' Dirty-Flag setzen + Dim oMeta As ClassControlCreator.ControlMetadata = oCombobox.Tag + oMeta.IsDirty = True + MyValidationLogger.Debug($"ComboBox [{oMeta.Name}] marked as dirty") If oCombobox.Name = last_control.Name Then 'Abschluss() Else @@ -4894,342 +4993,212 @@ Public Class frmValidator Dim oControlId As String Try Dim oMissing As Boolean = False - 'Jedes Control auf panel durchlaufen + + ' ========== OPTIMIERUNG: Nur geänderte Controls durchlaufen ========== For Each oControl As Control In Me.PanelValidatorControl.Controls - 'Der input der Box,Cmb muss jedes mal geleert werden - Dim oMyInput As String = "" - 'Jedes Control in Konfig Tab durchlaufn - For Each oControlRow As DataRow In DTVWCONTROL_INDEX.Rows - Dim oCtrlType = oControlRow.Item("CTRL_TYPE").ToString - 'Den Indexnamen auslesen - Dim oIndexName As String = oControlRow.Item("INDEX_NAME") - If oCtrlType = "LBL" Or oCtrlType = "LINE" Or oCtrlType = "BUTTON" Then - Continue For - End If - If oIndexName = "@@DISPLAY_ONLY" Then - 'Logger.Debug($"Index [{oIndexName}] will be skipped") - Continue For - End If + Dim oMeta As ClassControlCreator.ControlMetadata = Nothing + Try + oMeta = DirectCast(oControl.Tag, ClassControlCreator.ControlMetadata) + Catch + Continue For ' Control ohne Metadata überspringen + End Try + ' Suche die Control-Definition + Dim oControlRow = (From form In DTVWCONTROL_INDEX.AsEnumerable() + Where form.Item("GUID") = oMeta.Guid).SingleOrDefault() - Dim oDBControlName = oControlRow.Item("CTRL_NAME").ToString - Dim oIsRequired As Boolean = CBool(oControlRow.Item("VALIDATION")) - Dim oSQLCheckCommand As String = IIf(IsDBNull(oControlRow.Item("SQL_UEBERPRUEFUNG")), "", oControlRow.Item("SQL_UEBERPRUEFUNG")) - Dim oIsReadOnly As Boolean = CBool(oControlRow.Item("READ_ONLY")) - Dim oSaveChangeEnabledFalse As Boolean = CBool(oControlRow.Item("SAVE_CHANGE_ON_ENABLED")) - 'Wenn eine Ablehnung aktiv ist und der Index identisch ist, dann skipping - If REJECTION_ACTIVE = True And (oIndexName = PROFIL_REJECT_ACTIONS_ATTRIBUTE Or oIndexName = PROFIL_REJECT_COMMENT_ATTRIBUTE) Then - MyValidationLogger.Debug($"Index [{oIndexName}] will be skipped as Rejection is in progress!") - Continue For - End If - 'Readonly felder werden über finale indexe gefüllt, nicht mit SetControlData - If oIsReadOnly = True And oSaveChangeEnabledFalse = False Then - MyValidationLogger.Debug($"Skipping ReadOnly ControlName [{oDBControlName}] !") - Continue For - End If + If oControlRow Is Nothing Then Continue For + Dim oCtrlType = oControlRow.Item("CTRL_TYPE").ToString + Dim oIndexName As String = oControlRow.Item("INDEX_NAME") + Dim oIsRequired As Boolean = CBool(oControlRow.Item("VALIDATION")) + Dim oIsReadOnly As Boolean = CBool(oControlRow.Item("READ_ONLY")) + Dim oSaveChangeEnabledFalse As Boolean = CBool(oControlRow.Item("SAVE_CHANGE_ON_ENABLED")) - Dim oControlType As String = oControlRow.Item("CTRL_TYPE") - Dim oIDBTyp As Integer - If IDB_ACTIVE Then - oIDBTyp = oControlRow.Item("IDB_TYP") - End If + ' Überspringe System-Controls + If oCtrlType = "LBL" Or oCtrlType = "LINE" Or oCtrlType = "BUTTON" Then + Continue For + End If + If oIndexName = "@@DISPLAY_ONLY" Then + Continue For + End If - oControlId = oControlRow.Item("GUID") - Dim oRegexMatch As String = ObjectEx.NotNull(oControlRow.Item("REGEX_MATCH"), String.Empty) - Dim oRegexMessage As String = ObjectEx.NotNull(oControlRow.Item("REGEX_MESSAGE_DE"), String.Empty) - oControlName = oControlRow.Item("CTRL_NAME") - Dim oOVERWRITE_DATA = oControlRow.Item("OVERWRITE_DATA") - - 'Nur wenn der Name der Zeile entspricht und der Index READ_ONLY FALSE ist - If oDBControlName = oControl.Name And Not {"@@DISPLAY_ONLY", "DD PM-ONLY FOR DISPLAY"}.Contains(oIndexName) Then - MyValidationLogger.Debug("Indexierung für Control (" & oControlId & ") '" & oControlName & "' gestartet. Indexname '" & oIndexName & "'") - If oIndexName = "" Then - MyValidationLogger.Info(">> Indexname is unexpected empty.") - Continue For - End If - Select Case True - Case oControl.GetType = GetType(LookupControl3) - Try - Dim lookup As LookupControl3 = oControl - If lookup.Properties.SelectedValues.Count = 0 And oIsRequired = True Then - oMissing = True - oErrMsgMissingInput = $"Kein Auswahl getroffen in LookupGrid '{oControl.Name}'" - MyValidationLogger.Warn($"Kein Auswahl getroffen in LookupGrid '{oControl.Name}'") - oControl.BackColor = Color.Red - frmError.ShowDialog() - Exit For - Else + ' Überspringe ReadOnly-Controls (außer SAVE_CHANGE_ON_ENABLED) + If oIsReadOnly = True And oSaveChangeEnabledFalse = False Then + MyValidationLogger.Debug($"Skipping ReadOnly ControlName [{oControl.Name}]!") + Continue For + End If - If lookup.Properties.MultiSelect = True Then - Dim oLookupRows As Integer = lookup.Properties.SelectedValues.Count - - 'Wenn kein Wert ausgewählt wurde und der Index aber gesetzt werden muss - If oLookupRows > 0 Then - Dim ZeilenGrid As Integer = 0 - Dim myVektorArr As String() - 'Jeden Werte des Datagridviews durchlaufen - For Each value As String In lookup.Properties.SelectedValues - If value Is Nothing = False Then - 'Das Array anpassen - ReDim Preserve myVektorArr(ZeilenGrid) - 'Den Wert im Array speichern - myVektorArr(ZeilenGrid) = value - ZeilenGrid += 1 - End If + ' ========== KERN-OPTIMIERUNG: Dirty-Check ========== + ' Überspringe unveränderte, nicht-required Controls + If Not oMeta.IsDirty And Not oIsRequired Then + MyValidationLogger.Debug($"Skipping unchanged control [{oMeta.Name}]") + Continue For + End If + ' ========== ENDE OPTIMIERUNG ========== - Next - If IDB_ACTIVE = False Then + ' Rejection-Handling + If REJECTION_ACTIVE = True And (oIndexName = PROFIL_REJECT_ACTIONS_ATTRIBUTE Or oIndexName = PROFIL_REJECT_COMMENT_ATTRIBUTE) Then + MyValidationLogger.Debug($"Index [{oIndexName}] will be skipped as Rejection is in progress!") + Continue For + End If - If Indexiere_File(CURRENT_WMFILE, oIndexName, myVektorArr) = False Then - oMissing = True - oErrMsgMissingInput = "Error while indexing von LookupGrid - ERROR: " & idxerr_message - MyValidationLogger.Warn($"Error while indexing [{oIndexName}] von LookupGrid - ERROR: " & idxerr_message) - frmError.ShowDialog() - Exit For - End If - Else - Dim oMyDT = DT_FOR_ARRAY(myVektorArr) + ' ========== AB HIER: Bestehender Validierungs-Code ========== + Dim oMyInput As String = "" + Dim oSQLCheckCommand As String = IIf(IsDBNull(oControlRow.Item("SQL_UEBERPRUEFUNG")), "", oControlRow.Item("SQL_UEBERPRUEFUNG")) + Dim oControlType As String = oControlRow.Item("CTRL_TYPE") + Dim oIDBTyp As Integer + If IDB_ACTIVE Then + oIDBTyp = oControlRow.Item("IDB_TYP") + End If - If IDBData.SetVariableValue(oIndexName, oMyDT, oOVERWRITE_DATA, oIDBTyp) = False Then - oMissing = True - oErrMsgMissingInput = "Error while indexing IDB-Object LookupGrid" - MyValidationLogger.Warn($"Error while indexing IDB-Object LookupGrid [{oIndexName}] ") - frmError.ShowDialog() - Exit For - End If - End If - Else - Dim oValues As New List(Of Object) From {String.Empty} - If IDB_ACTIVE = False Then - If Indexiere_File(CURRENT_WMFILE, oIndexName, oValues.ToArray) = False Then - oMissing = True - oErrMsgMissingInput = "Error while indexing von LookupGrid - ERROR: " & idxerr_message - MyValidationLogger.Warn($"Error while indexing LookupGrid [{oIndexName}] ") - frmError.ShowDialog() - Exit For - End If - Else - For Each ochangedLookub In listChangedLookup - If lookup.Name = ochangedLookub Then - IDBData.Delete_AttributeData(CURRENT_DOC_ID, oIndexName) - Exit For - End If - Next - End If - End If + oControlId = oControlRow.Item("GUID") + Dim oRegexMatch As String = ObjectEx.NotNull(oControlRow.Item("REGEX_MATCH"), String.Empty) + Dim oRegexMessage As String = ObjectEx.NotNull(oControlRow.Item("REGEX_MESSAGE_DE"), String.Empty) + oControlName = oControlRow.Item("CTRL_NAME") + Dim oOVERWRITE_DATA = oControlRow.Item("OVERWRITE_DATA") + + MyValidationLogger.Debug("Indexierung für Control (" & oControlId & ") '" & oControlName & "' gestartet. Indexname '" & oIndexName & "'") + If oIndexName = "" Then + MyValidationLogger.Info(">> Indexname is unexpected empty.") + Continue For + End If + ' ========== SELECT CASE: Control-Type-Handling (wie bisher) ========== + Select Case True + Case oControl.GetType = GetType(LookupControl3) + Try + Dim lookup As LookupControl3 = oControl + If lookup.Properties.SelectedValues.Count = 0 And oIsRequired = True Then + oMissing = True + oErrMsgMissingInput = $"Kein Auswahl getroffen in LookupGrid '{oControl.Name}'" + MyValidationLogger.Warn($"Kein Auswahl getroffen in LookupGrid '{oControl.Name}'") + oControl.BackColor = Color.Red + frmError.ShowDialog() + Exit For + Else + If lookup.Properties.MultiSelect = True Then + Dim oLookupRows As Integer = lookup.Properties.SelectedValues.Count + If oLookupRows > 0 Then + Dim ZeilenGrid As Integer = 0 + Dim myVektorArr As String() + For Each value As String In lookup.Properties.SelectedValues + If value Is Nothing = False Then + ReDim Preserve myVektorArr(ZeilenGrid) + myVektorArr(ZeilenGrid) = value + ZeilenGrid += 1 + End If + Next + If IDB_ACTIVE = False Then + If Indexiere_File(CURRENT_WMFILE, oIndexName, myVektorArr) = False Then + oMissing = True + oErrMsgMissingInput = "Error while indexing von LookupGrid - ERROR: " & idxerr_message + MyValidationLogger.Warn($"Error while indexing [{oIndexName}] von LookupGrid - ERROR: " & idxerr_message) + frmError.ShowDialog() + Exit For + End If Else - oMyInput = lookup.Properties.SelectedValues.FirstOrDefault() - If IsNothing(oMyInput) And oIsRequired = True Then + Dim oMyDT = DT_FOR_ARRAY(myVektorArr) + If IDBData.SetVariableValue(oIndexName, oMyDT, oOVERWRITE_DATA, oIDBTyp) = False Then oMissing = True - oErrMsgMissingInput = $"Could not get FirstOrDefault-Value of LookUpGrid! - LookUPGridName: {lookup.Name}" - MyValidationLogger.Warn(oErrMsgMissingInput) + oErrMsgMissingInput = "Error while indexing IDB-Object LookupGrid" + MyValidationLogger.Warn($"Error while indexing IDB-Object LookupGrid [{oIndexName}] ") + frmError.ShowDialog() Exit For - ElseIf IsNothing(oMyInput) And oIsRequired = False Then - For Each ochangedLookub In listChangedLookup - If lookup.Name = ochangedLookub Then - IDBData.Delete_AttributeData(CURRENT_DOC_ID, oIndexName) - Exit For - End If - Next - Continue For End If - 'den aktuellen Wert in windream auslesen - Dim oValueFromObject - - If oIndexName.StartsWith("[%VKT") Then - oValueFromObject = ReturnVektor_IndexValue(oIndexName) - Else - oValueFromObject = GetVariableValuefromSource(oIndexName, oIDBTyp) - Dim oValueIsIndifferent As Boolean = False - If Not IsNothing(oValueFromObject) Then - - If IDB_ACTIVE = False Then - If oValueFromObject.ToString = "System.Object[]" Then - If oValueFromObject.Length = 1 Then - oValueFromObject = oValueFromObject(0) - Else ' - MyValidationLogger.Info(" >> Vectorfield " & oIndexName & "' contains more then one value - First value will be used") - oValueFromObject = oValueFromObject(0) - End If - End If - End If - Else - oValueFromObject = "" - End If - - If IsNothing(oValueFromObject) Then - MyValidationLogger.Debug($"CheckUpdateIndex.LookUpGrid: oValueFromObject is NOTHING!") - oValueIsIndifferent = True - End If - If oValueIsIndifferent = False Then - If IsDBNull(oValueFromObject) Then - MyValidationLogger.Debug($"CheckUpdateIndex.LookUpGrid: oValueFromObject is DBNULL!") - oValueIsIndifferent = True - End If - End If - Dim oValueSourceIsDifferent As Boolean = False - If oValueIsIndifferent = False Then - MyValidationLogger.Debug($"CheckUpdateIndex.LookUpGrid: oValueFromObject is [{oValueFromObject}]") - Try - If oValueFromObject <> oMyInput Then - oValueSourceIsDifferent = True - MyValidationLogger.Debug($"CheckUpdateIndex.LookUpGrid: There is a difference between oValueFromObject and [{oValueFromObject}]") - End If - Catch ex As Exception - oValueSourceIsDifferent = True - MyValidationLogger.Debug($"oValueFromObject <> oMyInput not possible as one object might be a multiple row object") - End Try - - Else - - End If - - 'wenn Wert in Windream <> der Eingabe darf indexiert werden - 'IsNothing(oValueFromObject) Or oValueFromObject <> oMyInput - If (oValueIsIndifferent = True Or oValueSourceIsDifferent = True) Then - 'Wenn der Wert in ein Vektorfeld geschrieben wird - If oIndexName.StartsWith("[%VKT") Then - oMyInput = Return_PM_VEKTOR(oMyInput, oIndexName) - 'Hier muss nun separat as Vektorfeld indexiert werden - If WMIndexVectofield(oMyInput, PROFIL_VEKTORINDEX) = True Then - oMissing = True - oErrMsgMissingInput = "Error while indexing Textbox as VEKTOR - ERROR: " & idxerr_message - MyValidationLogger.Warn(oErrMsgMissingInput) - frmError.ShowDialog() - Exit For - End If - Else - If IDB_ACTIVE = False Then - Dim result() As String - ReDim Preserve result(0) - result(0) = oMyInput - If Indexiere_File(CURRENT_WMFILE, oIndexName, result) = False Then - oMissing = True - oErrMsgMissingInput = "Error while indexing Textbox - ERROR: " & idxerr_message - MyValidationLogger.Warn(oErrMsgMissingInput) - frmError.ShowDialog() - Exit For - End If - Else - If IDBData.SetVariableValue(oIndexName, oMyInput) = False Then - Exit For - End If - End If - If IDB_ACTIVE = False Then - If PROFIL_LOGINDEX <> "" Then - Dim oLogStr = Return_LOGString(oMyInput, oValueFromObject, oIndexName) - WMIndexVectofield(oLogStr, PROFIL_LOGINDEX) - 'Else - ' IDBData.SetVariableValue(PROFIL_LOGINDEX, oLogStr) - End If - End If - 'Nun das Logging - - - End If - End If + End If + Else + Dim oValues As New List(Of Object) From {String.Empty} + If IDB_ACTIVE = False Then + If Indexiere_File(CURRENT_WMFILE, oIndexName, oValues.ToArray) = False Then + oMissing = True + oErrMsgMissingInput = "Error while indexing von LookupGrid - ERROR: " & idxerr_message + MyValidationLogger.Warn($"Error while indexing LookupGrid [{oIndexName}] ") + frmError.ShowDialog() + Exit For End If + Else + For Each ochangedLookub In listChangedLookup + If lookup.Name = ochangedLookub Then + IDBData.Delete_AttributeData(CURRENT_DOC_ID, oIndexName) + Exit For + End If + Next End If - End If - Catch ex As Exception - MyValidationLogger.Error(ex) - - End Try - - Case oControl.GetType = GetType(DevExpress.XtraEditors.TextEdit) Or oControl.GetType = GetType(MemoEdit) - Try - 'Dim oWrongInputMessage = ClassAllgemeineFunktionen.GUI_LANGUAGE_INFO("frmValidator.WrongInputControl") - Dim oWrongInputMessage = S.Falsche_Eingabe - Dim oDevexpressTextEdit As DevExpress.XtraEditors.TextEdit = oControl - MyValidationLogger.Debug("Validating Textbox..") - - If oRegexMatch <> String.Empty AndAlso Not Regex.IsMatch(oDevexpressTextEdit.EditValue, oRegexMatch) Then + Else + ' Single-Select Lookup + oMyInput = lookup.Properties.SelectedValues.FirstOrDefault() + If IsNothing(oMyInput) And oIsRequired = True Then oMissing = True - - oErrMsgMissingInput = oWrongInputMessage & " textbox '" & oControl.Name & "'" + oErrMsgMissingInput = $"Could not get FirstOrDefault-Value of LookUpGrid! - LookUPGridName: {lookup.Name}" MyValidationLogger.Warn(oErrMsgMissingInput) - If oRegexMessage <> String.Empty Then - oErrMsgMissingInput &= ":" & vbCrLf & oRegexMessage - End If - oControl.BackColor = Color.Red - OpenfrmError(oErrMsgMissingInput) Exit For + ElseIf IsNothing(oMyInput) And oIsRequired = False Then + For Each ochangedLookub In listChangedLookup + If lookup.Name = ochangedLookub Then + IDBData.Delete_AttributeData(CURRENT_DOC_ID, oIndexName) + Exit For + End If + Next + Continue For End If - 'as erstes überprüfen ob überhaupt etwas eingetragen worden ist - If Check_Missing_Control_Value(oControl, "txt") = True And oIsRequired = True Then 'NICHTS EINGETRAGEN - oMissing = True - oErrMsgMissingInput = oWrongInputMessage & " textbox '" & oControl.Name & "'" - MyValidationLogger.Warn(oErrMsgMissingInput) - oControl.BackColor = Color.Red - frmError.ShowDialog() - Exit For + Dim oValueFromObject + If oIndexName.StartsWith("[%VKT") Then + oValueFromObject = ReturnVektor_IndexValue(oIndexName) Else - MyValidationLogger.Debug("Reading current value from Textbox") - - Dim oTextEdit As BaseEdit = DirectCast(oControl, BaseEdit) - oMyInput = ClassFormat.GetStringValue(oTextEdit.EditValue) - - MyValidationLogger.Debug("Form Value: [{0}]", oMyInput) - - 'den aktuellen Wert in windream auslesen - Dim oSourceValue = GetVariableValuefromSource(oIndexName, oIDBTyp) - - MyValidationLogger.Debug("Current Value: [{0}]", oSourceValue) - - If oIndexName.StartsWith("[%VKT") Then - oSourceValue = ReturnVektor_IndexValue(oIndexName) - Else - 'wertWD = CURRENT_WMFILE.GetVariableValue(oIndexName) - If Not IsNothing(oSourceValue) Then - If oSourceValue.ToString = "System.Object[]" Then - If oSourceValue.Length = 1 Then - oSourceValue = oSourceValue(0) - Else ' + oValueFromObject = GetVariableValuefromSource(oIndexName, oIDBTyp) + Dim oValueIsIndifferent As Boolean = False + If Not IsNothing(oValueFromObject) Then + If IDB_ACTIVE = False Then + If oValueFromObject.ToString = "System.Object[]" Then + If oValueFromObject.Length = 1 Then + oValueFromObject = oValueFromObject(0) + Else MyValidationLogger.Info(" >> Vectorfield " & oIndexName & "' contains more then one value - First value will be used") - oSourceValue = oSourceValue(0) + oValueFromObject = oValueFromObject(0) End If End If - Else - oSourceValue = "" End If + Else + oValueFromObject = "" End If - Dim oSetValue As Boolean = False - If IsDBNull(oSourceValue) Then - oSetValue = True + + If IsNothing(oValueFromObject) Then + MyValidationLogger.Debug($"CheckUpdateIndex.LookUpGrid: oValueFromObject is NOTHING!") + oValueIsIndifferent = True End If - If oSetValue = False Then - If IsNothing(oSourceValue) Then - oSetValue = True + If oValueIsIndifferent = False Then + If IsDBNull(oValueFromObject) Then + MyValidationLogger.Debug($"CheckUpdateIndex.LookUpGrid: oValueFromObject is DBNULL!") + oValueIsIndifferent = True End If End If - If oSetValue = False Then + + Dim oValueSourceIsDifferent As Boolean = False + If oValueIsIndifferent = False Then + MyValidationLogger.Debug($"CheckUpdateIndex.LookUpGrid: oValueFromObject is [{oValueFromObject}]") Try - If oSourceValue <> oMyInput Then - oSetValue = True + If oValueFromObject <> oMyInput Then + oValueSourceIsDifferent = True + MyValidationLogger.Debug($"CheckUpdateIndex.LookUpGrid: There is a difference between oValueFromObject and [{oValueFromObject}]") End If Catch ex As Exception - oSetValue = True + oValueSourceIsDifferent = True + MyValidationLogger.Debug($"oValueFromObject <> oMyInput not possible as one object might be a multiple row object") End Try End If - MyValidationLogger.Debug("Preparing Indexing for Textbox") - - 'wenn Wert in Windream <> der Eingabe darf indexiert werden - If oSetValue = True Then - 'Wenn der Wert in ein Vektorfeld geschrieben wird + If (oValueIsIndifferent = True Or oValueSourceIsDifferent = True) Then If oIndexName.StartsWith("[%VKT") Then oMyInput = Return_PM_VEKTOR(oMyInput, oIndexName) - 'Hier muss nun separat as Vektorfeld indexiert werden If WMIndexVectofield(oMyInput, PROFIL_VEKTORINDEX) = True Then oMissing = True - oErrMsgMissingInput = $"Error while indexing Textbox {oControl} - Attribute {oIndexName} as VEKTOR - ERROR: " & idxerr_message + oErrMsgMissingInput = "Error while indexing Textbox as VEKTOR - ERROR: " & idxerr_message MyValidationLogger.Warn(oErrMsgMissingInput) - OpenfrmError(oErrMsgMissingInput) + frmError.ShowDialog() Exit For End If Else @@ -5237,14 +5206,11 @@ Public Class frmValidator Dim result() As String ReDim Preserve result(0) result(0) = oMyInput - - MyValidationLogger.Debug("Indexing Index [{0}] with value [{1}]", oMyInput, oIndexName) - If Indexiere_File(CURRENT_WMFILE, oIndexName, result) = False Then oMissing = True - oErrMsgMissingInput = $"Error while indexing Textbox {oControl} - Attribute {oIndexName} - ERROR: " & idxerr_message + oErrMsgMissingInput = "Error while indexing Textbox - ERROR: " & idxerr_message MyValidationLogger.Warn(oErrMsgMissingInput) - OpenfrmError(oErrMsgMissingInput) + frmError.ShowDialog() Exit For End If Else @@ -5254,437 +5220,505 @@ Public Class frmValidator End If If IDB_ACTIVE = False Then If PROFIL_LOGINDEX <> "" Then - Dim oMyLogString = Return_LOGString(oMyInput, oSourceValue, oIndexName) - WMIndexVectofield(oMyLogString, PROFIL_LOGINDEX) - 'Else - 'IDBData.SetVariableValue(PROFIL_LOGINDEX, oMyLogString) + Dim oLogStr = Return_LOGString(oMyInput, oValueFromObject, oIndexName) + WMIndexVectofield(oLogStr, PROFIL_LOGINDEX) End If End If End If End If End If - Catch ex As Exception - oErrMsgMissingInput = "Unexpected error in Check_UpdateIndexe TextBox '" & oControl.Name & "' - Check the log" - MyValidationLogger.Error(ex) - Dim st As New StackTrace(True) - st = New StackTrace(ex, True) - MyValidationLogger.Warn("Unexpected error in Check_UpdateIndexe TextBox :" & ex.Message, True) - OpenfrmError(oErrMsgMissingInput) - Return False - End Try - - Case oControl.GetType = GetType(System.Windows.Forms.ComboBox) - Try - MyValidationLogger.Debug($"Working on Combobox...") - Dim cmb As Windows.Forms.ComboBox = oControl - 'Wenn kein Wert ausgewählt wurde und der Index aber gesetzt werden muss - If cmb.SelectedIndex = -1 And oIsRequired = True Then - oMissing = True - oErrMsgMissingInput = "Please Choose an entry out of ComboBox '" & cmb.Name & "'" - MyValidationLogger.Warn(oErrMsgMissingInput) - OpenfrmError(oErrMsgMissingInput) - Exit For - 'ElseIf cmb.SelectedIndex <> -1 Then - Else 'Änderung 28.08.2018: Ein leerer Wert in der Combobox wird in den Index geschrieben - oMyInput = cmb.Text - MyValidationLogger.Debug($"inputvalue Combobox: {cmb.Text}") - Dim oValue - 'den aktuellen Wert in windream auslesen - If oIndexName.StartsWith("[%VKT") Then - oValue = ReturnVektor_IndexValue(oIndexName) - Else - oValue = GetVariableValuefromSource(oIndexName, oIDBTyp) - End If - If IsNothing(oValue) Then - MyValidationLogger.Debug($"oValue is nothing...Value EmptyString will be used") - oValue = String.Empty - End If - Dim oIndexType As String = "Index" - Try - If oValue.ToString = "System.Object[]" Then - oIndexType = "Vector" - End If - Catch ex As Exception - MyValidationLogger.Debug($"Exception while oValue.ToString = System.Object[]...") - End Try - If oIndexType = "Vector" Then - MyValidationLogger.Debug($"Control with ID{oControlId} is a vectorfield...") - If oValue.Length = 1 Then - oValue = oValue(0).ToString - Else ' - MyValidationLogger.Info(" >> Vectorfield " & oIndexName & "' contains more then one value - First value will be used") - oValue = oValue(0).ToString - End If - Else - MyValidationLogger.Debug($"oValue is a regular item...") - Dim oitsadifference As Boolean = False - Try - If oValue.ToString <> oMyInput.ToString Then - oitsadifference = True - End If - Catch ex As Exception - MyValidationLogger.Warn($"Could not convert the oValue of Control with ID{oControlId}...") - MyValidationLogger.Error(ex.Message) - oitsadifference = True - End Try - 'wenn Wert in Windream <> der Eingabe darf indexiert werden - If oitsadifference = True Then - MyValidationLogger.Debug($"Index with ID{oControlId} will now be indexed...") - 'Wenn der Wert in ein Vektorfeld geschrieben wird - If oIndexName.StartsWith("[%VKT") Then - oMyInput = Return_PM_VEKTOR(oMyInput, oIndexName) - 'Hier muss nun separat as Vektorfeld indexiert werden - If WMIndexVectofield(oMyInput, PROFIL_VEKTORINDEX) = True Then - oMissing = True - oErrMsgMissingInput = "Error while indexing Combobox as VEKTOR - ERROR: " & idxerr_message - MyValidationLogger.Warn(oErrMsgMissingInput) - OpenfrmError(oErrMsgMissingInput) - Exit For - End If - Else - If IDB_ACTIVE = False Then - Dim result() As String - ReDim Preserve result(0) - result(0) = oMyInput - If Indexiere_File(CURRENT_WMFILE, oIndexName, result) = False Then - cmb.DroppedDown = True - oMissing = True - oErrMsgMissingInput = "Error while indexing Combobox - ERROR: " & idxerr_message - MyValidationLogger.Warn(oErrMsgMissingInput) - OpenfrmError(oErrMsgMissingInput) - Exit For - End If - Else - If IDBData.SetVariableValue(oIndexName, oMyInput) = False Then - cmb.DroppedDown = True - oMissing = True - oErrMsgMissingInput = "Error indexing combobox idb" - MyValidationLogger.Warn(oErrMsgMissingInput) - OpenfrmError(oErrMsgMissingInput) - Exit For - End If - End If - If IDB_ACTIVE = False Then - If PROFIL_LOGINDEX <> "" Then - Dim ologStr = Return_LOGString(oMyInput, oValue, oIndexName) - WMIndexVectofield(ologStr, PROFIL_LOGINDEX) - 'Else - 'IDBData.SetVariableValue(PROFIL_LOGINDEX, ologStr) - End If - - End If - 'Nun das Logging - - End If - Else - MyValidationLogger.Debug($"oitsadifference = False...Index with ID {oControlId} will not be indexed...") - 'Wenn der Wert in ein Vektorfeld geschrieben wird - End If - End If + End If + End If + Catch ex As Exception + MyValidationLogger.Error(ex) + End Try + Case oControl.GetType = GetType(DevExpress.XtraEditors.TextEdit) Or oControl.GetType = GetType(MemoEdit) + Try + Dim oWrongInputMessage = S.Falsche_Eingabe + Dim oDevexpressTextEdit As DevExpress.XtraEditors.TextEdit = oControl + MyValidationLogger.Debug("Validating Textbox..") + + If oRegexMatch <> String.Empty AndAlso Not Regex.IsMatch(oDevexpressTextEdit.EditValue, oRegexMatch) Then + oMissing = True + oErrMsgMissingInput = oWrongInputMessage & " textbox '" & oControl.Name & "'" + MyValidationLogger.Warn(oErrMsgMissingInput) + If oRegexMessage <> String.Empty Then + oErrMsgMissingInput &= ":" & vbCrLf & oRegexMessage + End If + oControl.BackColor = Color.Red + OpenfrmError(oErrMsgMissingInput) + Exit For + End If + If Check_Missing_Control_Value(oControl, "txt") = True And oIsRequired = True Then + oMissing = True + oErrMsgMissingInput = oWrongInputMessage & " textbox '" & oControl.Name & "'" + MyValidationLogger.Warn(oErrMsgMissingInput) + oControl.BackColor = Color.Red + frmError.ShowDialog() + Exit For + Else + MyValidationLogger.Debug("Reading current value from Textbox") + Dim oTextEdit As BaseEdit = DirectCast(oControl, BaseEdit) + oMyInput = ClassFormat.GetStringValue(oTextEdit.EditValue) + MyValidationLogger.Debug("Form Value: [{0}]", oMyInput) - End If - Catch ex As Exception - MyValidationLogger.Error(ex) - Dim st As New StackTrace(True) - st = New StackTrace(ex, True) - MsgBox($"Unexpected error in Check_UpdateIndexe Combobox : ID{oControlId} " & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Error:") - MyValidationLogger.Info($"Unexpected error in Check_UpdateIndexe Combobox : ID{oControlId}" & ex.Message) - Return False - End Try + Dim oSourceValue = GetVariableValuefromSource(oIndexName, oIDBTyp) + MyValidationLogger.Debug("Current Value: [{0}]", oSourceValue) - Case oControl.GetType = GetType(DateTimePicker) - Try - Dim dtp As DateTimePicker = oControl - 'Wenn kein Wert ausgewählt wurde und der Index aber gesetzt werden muss - If oIsRequired = True And dtp.Value.ToString = String.Empty Then - oMissing = True - oErrMsgMissingInput = "Please Choose DateValue for field'" & dtp.Name & "'" - MyValidationLogger.Warn(oErrMsgMissingInput) - OpenfrmError(oErrMsgMissingInput) - Exit For - ElseIf dtp.Value.ToString <> "01.01.0001 00:00:00" Then - oMyInput = CDate(dtp.Value) - 'den aktuellen Wert in windream auslesen - ' Dim wertWD As String = CURRENT_WMFILE.GetVariableValue(_IDXName) - Dim oObjectValue - If oIndexName.StartsWith("[%VKT") Then - oObjectValue = ReturnVektor_IndexValue(oIndexName) - Else - oObjectValue = GetVariableValuefromSource(oIndexName, oIDBTyp) - End If - If IsNothing(oObjectValue) Or IsDBNull(oObjectValue) Then - oObjectValue = CDate("01.01.1900") - End If - 'wenn Wert in Windream <> der Eingabe darf indexiert werden - If oObjectValue <> oMyInput Then - 'Wenn der WErt in ein Vektorfeld geschrieben wird - If oIndexName.StartsWith("[%VKT") Then - 'Input = die String komponente as String - oMyInput = Return_PM_VEKTOR(oMyInput, oIndexName) - 'Hier muss nun separat as Vektorfeld indexiert werden - If WMIndexVectofield(oMyInput, PROFIL_VEKTORINDEX) = True Then - oMissing = True - oErrMsgMissingInput = "Error while indexing DatePicker as VEKTOR - ERROR: " & idxerr_message - MyValidationLogger.Warn(oErrMsgMissingInput) - OpenfrmError(oErrMsgMissingInput) - Exit For - End If + If oIndexName.StartsWith("[%VKT") Then + oSourceValue = ReturnVektor_IndexValue(oIndexName) + Else + If Not IsNothing(oSourceValue) Then + If oSourceValue.ToString = "System.Object[]" Then + If oSourceValue.Length = 1 Then + oSourceValue = oSourceValue(0) Else - If IDB_ACTIVE = False Then - Dim result() - ReDim Preserve result(0) - result(0) = CDate(oMyInput) - If Indexiere_File(CURRENT_WMFILE, oIndexName, result) = False Then - oMissing = True - oErrMsgMissingInput = "Error while indexing DatePicker- ERROR: " & idxerr_message - MyValidationLogger.Warn(oErrMsgMissingInput) - OpenfrmError(oErrMsgMissingInput) - Exit For - End If - Else - If IDBData.SetVariableValue(oIndexName, oMyInput) = False Then - oMissing = True - oErrMsgMissingInput = "Error indexing datepicker idb" - MyValidationLogger.Warn(oErrMsgMissingInput) - OpenfrmError(oErrMsgMissingInput) - Exit For - End If - End If - If IDB_ACTIVE = False Then - If PROFIL_LOGINDEX <> "" Then - Dim oLogstr = Return_LOGString(oMyInput, oObjectValue, oIndexName) - WMIndexVectofield(oLogstr, PROFIL_LOGINDEX) - 'Else - 'IDBData.SetVariableValue(PROFIL_LOGINDEX, oLogstr) - End If - End If + MyValidationLogger.Info(" >> Vectorfield " & oIndexName & "' contains more then one value - First value will be used") + oSourceValue = oSourceValue(0) End If - Else - MyValidationLogger.Debug("Value WD ('" & oObjectValue.ToString & "') = Input-value ('" & oMyInput.ToString & "')") - End If Else - MyValidationLogger.Debug("DateValue is 01.01.0001 00:00:00") + oSourceValue = "" End If - Catch ex As Exception - MyValidationLogger.Error(ex) - End Try - - Case oControl.GetType = GetType(CheckBox) - Try - Dim chk As CheckBox = oControl - oMyInput = chk.Checked.ToString + End If - If chk.CheckState = CheckState.Indeterminate And oIsRequired = True Then - oMissing = True - oErrMsgMissingInput = "Please set Checkbox value for field '" & chk.Name & "'" - MyValidationLogger.Warn(oErrMsgMissingInput) - OpenfrmError(oErrMsgMissingInput) - Exit For + Dim oSetValue As Boolean = False + If IsDBNull(oSourceValue) Then + oSetValue = True + End If + If oSetValue = False Then + If IsNothing(oSourceValue) Then + oSetValue = True End If + End If + If oSetValue = False Then + Try + If oSourceValue <> oMyInput Then + oSetValue = True + End If + Catch ex As Exception + oSetValue = True + End Try + End If + + MyValidationLogger.Debug("Preparing Indexing for Textbox") - 'den aktuellen Wert in windream auslesen - Dim WertWD As String - Dim oBoolValue As Boolean + If oSetValue = True Then If oIndexName.StartsWith("[%VKT") Then - WertWD = ReturnVektor_IndexValue(oIndexName) - If WertWD = "" Then - oBoolValue = False - Else - oBoolValue = CBool(WertWD) + oMyInput = Return_PM_VEKTOR(oMyInput, oIndexName) + If WMIndexVectofield(oMyInput, PROFIL_VEKTORINDEX) = True Then + oMissing = True + oErrMsgMissingInput = $"Error while indexing Textbox {oControl} - Attribute {oIndexName} as VEKTOR - ERROR: " & idxerr_message + MyValidationLogger.Warn(oErrMsgMissingInput) + OpenfrmError(oErrMsgMissingInput) + Exit For End If Else - Dim _Value - Dim oObjectCheck = GetVariableValuefromSource(oIndexName, oIDBTyp) - - If IsNothing(oObjectCheck) Or IsDBNull(oObjectCheck) Then - oBoolValue = False + If IDB_ACTIVE = False Then + Dim result() As String + ReDim Preserve result(0) + result(0) = oMyInput + MyValidationLogger.Debug("Indexing Index [{0}] with value [{1}]", oMyInput, oIndexName) + If Indexiere_File(CURRENT_WMFILE, oIndexName, result) = False Then + oMissing = True + oErrMsgMissingInput = $"Error while indexing Textbox {oControl} - Attribute {oIndexName} - ERROR: " & idxerr_message + MyValidationLogger.Warn(oErrMsgMissingInput) + OpenfrmError(oErrMsgMissingInput) + Exit For + End If Else - If oObjectCheck.ToString = "System.Object[]" Then - If oObjectCheck.Length = 1 Then - _Value = oObjectCheck(0) - Else ' - MyValidationLogger.Info(" >> Vectorfield " & oIndexName & "' contains more then one value - First value will be used") - _Value = oObjectCheck(0) - End If - Else - _Value = oObjectCheck + If IDBData.SetVariableValue(oIndexName, oMyInput) = False Then + Exit For + End If + End If + If IDB_ACTIVE = False Then + If PROFIL_LOGINDEX <> "" Then + Dim oMyLogString = Return_LOGString(oMyInput, oSourceValue, oIndexName) + WMIndexVectofield(oMyLogString, PROFIL_LOGINDEX) End If - oBoolValue = CBool(_Value) End If - End If + End If + End If + Catch ex As Exception + oErrMsgMissingInput = "Unexpected error in Check_UpdateIndexe TextBox '" & oControl.Name & "' - Check the log" + MyValidationLogger.Error(ex) + Dim st As New StackTrace(True) + st = New StackTrace(ex, True) + MyValidationLogger.Warn("Unexpected error in Check_UpdateIndexe TextBox :" & ex.Message, True) + OpenfrmError(oErrMsgMissingInput) + ' Nach Fehler: Dirty-Flag zurücksetzen + oMeta.IsDirty = False + Return False + End Try - - ' Dim Bool_WD = CBool(CURRENT_WMFILE.GetVariableValue(_IDXName)) - 'wenn Wert in Windream <> der Eingabe darf indexiert werden - If oBoolValue <> chk.Checked Then - Dim result() As String - ReDim Preserve result(0) - If chk.Checked Then - result(0) = 1 - Else - result(0) = 0 + Case oControl.GetType = GetType(System.Windows.Forms.ComboBox) + ' ... (Dein bestehender ComboBox-Code bleibt gleich) ... + Try + MyValidationLogger.Debug($"Working on Combobox...") + Dim cmb As Windows.Forms.ComboBox = oControl + If cmb.SelectedIndex = -1 And oIsRequired = True Then + oMissing = True + oErrMsgMissingInput = "Please Choose an entry out of ComboBox '" & cmb.Name & "'" + MyValidationLogger.Warn(oErrMsgMissingInput) + OpenfrmError(oErrMsgMissingInput) + Exit For + Else + oMyInput = cmb.Text + MyValidationLogger.Debug($"inputvalue Combobox: {cmb.Text}") + Dim oValue + If oIndexName.StartsWith("[%VKT") Then + oValue = ReturnVektor_IndexValue(oIndexName) + Else + oValue = GetVariableValuefromSource(oIndexName, oIDBTyp) + End If + If IsNothing(oValue) Then + MyValidationLogger.Debug($"oValue is nothing...Value EmptyString will be used") + oValue = String.Empty + End If + Dim oIndexType As String = "Index" + Try + If oValue.ToString = "System.Object[]" Then + oIndexType = "Vector" + End If + Catch ex As Exception + MyValidationLogger.Debug($"Exception while oValue.ToString = System.Object[]...") + End Try + If oIndexType = "Vector" Then + MyValidationLogger.Debug($"Control with ID{oControlId} is a vectorfield...") + If oValue.Length = 1 Then + oValue = oValue(0).ToString + Else + MyValidationLogger.Info(" >> Vectorfield " & oIndexName & "' contains more then one value - First value will be used") + oValue = oValue(0).ToString + End If + Else + MyValidationLogger.Debug($"oValue is a regular item...") + Dim oitsadifference As Boolean = False + Try + If oValue.ToString <> oMyInput.ToString Then + oitsadifference = True End If - + Catch ex As Exception + MyValidationLogger.Warn($"Could not convert the oValue of Control with ID{oControlId}...") + MyValidationLogger.Error(ex.Message) + oitsadifference = True + End Try + If oitsadifference = True Then + MyValidationLogger.Debug($"Index with ID{oControlId} will now be indexed...") If oIndexName.StartsWith("[%VKT") Then - 'Input = die String komponente mit Boolean as String - oMyInput = Return_PM_VEKTOR(chk.Checked.ToString, oIndexName) - 'Hier muss nun separat as Vektorfeld indexiert werden + oMyInput = Return_PM_VEKTOR(oMyInput, oIndexName) If WMIndexVectofield(oMyInput, PROFIL_VEKTORINDEX) = True Then oMissing = True - oErrMsgMissingInput = "Error while indexing Checkbox as VEKTOR - ERROR: " & idxerr_message + oErrMsgMissingInput = "Error while indexing Combobox as VEKTOR - ERROR: " & idxerr_message MyValidationLogger.Warn(oErrMsgMissingInput) OpenfrmError(oErrMsgMissingInput) Exit For End If Else If IDB_ACTIVE = False Then + Dim result() As String + ReDim Preserve result(0) + result(0) = oMyInput If Indexiere_File(CURRENT_WMFILE, oIndexName, result) = False Then + cmb.DroppedDown = True oMissing = True - oErrMsgMissingInput = "Error while indexing Checkbox - ERROR: " & idxerr_message + oErrMsgMissingInput = "Error while indexing Combobox - ERROR: " & idxerr_message MyValidationLogger.Warn(oErrMsgMissingInput) OpenfrmError(oErrMsgMissingInput) Exit For End If Else - If IDBData.SetVariableValue(oIndexName, chk.Checked.ToString) Then - oErrMsgMissingInput = "error indexing checkbox idb" + If IDBData.SetVariableValue(oIndexName, oMyInput) = False Then + cmb.DroppedDown = True + oMissing = True + oErrMsgMissingInput = "Error indexing combobox idb" + MyValidationLogger.Warn(oErrMsgMissingInput) OpenfrmError(oErrMsgMissingInput) Exit For End If End If If IDB_ACTIVE = False Then If PROFIL_LOGINDEX <> "" Then - Dim oLogstr = Return_LOGString(CBool(result(0)).ToString, WertWD, oIndexName) - WMIndexVectofield(oLogstr, PROFIL_LOGINDEX) - 'Else - 'IDBData.SetVariableValue(PROFIL_LOGINDEX, oLogstr) + Dim ologStr = Return_LOGString(oMyInput, oValue, oIndexName) + WMIndexVectofield(ologStr, PROFIL_LOGINDEX) End If End If - End If + Else + MyValidationLogger.Debug($"oitsadifference = False...Index with ID {oControlId} will not be indexed...") End If - Catch ex As Exception - MyValidationLogger.Error(ex) - End Try + End If + End If + Catch ex As Exception + MyValidationLogger.Error(ex) + Dim st As New StackTrace(True) + st = New StackTrace(ex, True) + MsgBox($"Unexpected error in Check_UpdateIndexe Combobox : ID{oControlId} " & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Error:") + MyValidationLogger.Info($"Unexpected error in Check_UpdateIndexe Combobox : ID{oControlId}" & ex.Message) + oMeta.IsDirty = False + Return False + End Try - Case oControl.GetType = GetType(DataGridView) - Try - Dim dgv As DataGridView = oControl - - Dim Zeilen As Integer = 0 - For Each row As DataGridViewRow In dgv.Rows - Dim exists = False - ' MsgBox(row.Cells(0).Value.GetType.ToString) - If row.Cells(0).Value Is Nothing = False Then - Zeilen += 1 + Case oControl.GetType = GetType(DateTimePicker) + ' ... (Dein bestehender DateTimePicker-Code) ... + Try + Dim dtp As DateTimePicker = oControl + If oIsRequired = True And dtp.Value.ToString = String.Empty Then + oMissing = True + oErrMsgMissingInput = "Please Choose DateValue for field'" & dtp.Name & "'" + MyValidationLogger.Warn(oErrMsgMissingInput) + OpenfrmError(oErrMsgMissingInput) + Exit For + ElseIf dtp.Value.ToString <> "01.01.0001 00:00:00" Then + oMyInput = CDate(dtp.Value) + Dim oObjectValue + If oIndexName.StartsWith("[%VKT") Then + oObjectValue = ReturnVektor_IndexValue(oIndexName) + Else + oObjectValue = GetVariableValuefromSource(oIndexName, oIDBTyp) + End If + If IsNothing(oObjectValue) Or IsDBNull(oObjectValue) Then + oObjectValue = CDate("01.01.1900") + End If + If oObjectValue <> oMyInput Then + If oIndexName.StartsWith("[%VKT") Then + oMyInput = Return_PM_VEKTOR(oMyInput, oIndexName) + If WMIndexVectofield(oMyInput, PROFIL_VEKTORINDEX) = True Then + oMissing = True + oErrMsgMissingInput = "Error while indexing DatePicker as VEKTOR - ERROR: " & idxerr_message + MyValidationLogger.Warn(oErrMsgMissingInput) + OpenfrmError(oErrMsgMissingInput) + Exit For End If - Next - 'Wenn kein Wert ausgewählt wurde und der Index aber gesetzt werden muss - If oIsRequired = True And Zeilen = 0 Then - oMissing = True - oErrMsgMissingInput = "Fehlende Eingabe in Vektorfeld '" & dgv.Name & "'" - MyValidationLogger.Warn(oErrMsgMissingInput) - OpenfrmError(oErrMsgMissingInput) - Exit For - ElseIf Zeilen > 0 Then - Dim ZeilenGrid As Integer = 0 - Dim myVektorArr As String() - 'Jeden Werte des Datagridviews durchlaufen - For Each row As DataGridViewRow In dgv.Rows - Dim exists = False - Select Case oControlType - Case "TABLE" - ' MsgBox(row.Cells(0).Value.GetType.ToString) - Dim str As String - If row.Cells(0).Value Is Nothing = False Then - 'Das Array anpassen - ReDim Preserve myVektorArr(ZeilenGrid) - For i = 0 To row.Cells.Count - 1 - Select Case i - Case 0 - str = row.Cells(i).Value - Case Else - str = str & PMDelimiter & row.Cells(i).Value - End Select - - Next - 'Den Wert im Array speichern - myVektorArr(ZeilenGrid) = str - ZeilenGrid += 1 - - End If - Case Else - ' MsgBox(row.Cells(0).Value.GetType.ToString) - If row.Cells(0).Value Is Nothing = False Then - 'Das Array anpassen - ReDim Preserve myVektorArr(ZeilenGrid) - 'Den Wert im Array speichern - myVektorArr(ZeilenGrid) = row.Cells(0).Value.ToString - ZeilenGrid += 1 - End If - End Select - - Next + Else If IDB_ACTIVE = False Then - If Indexiere_File(CURRENT_WMFILE, oIndexName, myVektorArr) = False Then + Dim result() + ReDim Preserve result(0) + result(0) = CDate(oMyInput) + If Indexiere_File(CURRENT_WMFILE, oIndexName, result) = False Then oMissing = True - oErrMsgMissingInput = "Error while indexing Vektorfeld - ERROR: " & idxerr_message + oErrMsgMissingInput = "Error while indexing DatePicker- ERROR: " & idxerr_message MyValidationLogger.Warn(oErrMsgMissingInput) OpenfrmError(oErrMsgMissingInput) Exit For End If Else - Dim oDT As DataTable = DT_FOR_ARRAY(myVektorArr) - If oDT.Rows.Count > 0 Then - If IDBData.SetVariableValue(oIndexName, oDT, True) = False Then - oMissing = True - oErrMsgMissingInput = "Error indexing Datagridview idb" - MyValidationLogger.Warn(oErrMsgMissingInput) - OpenfrmError(oErrMsgMissingInput) - Exit For - End If + If IDBData.SetVariableValue(oIndexName, oMyInput) = False Then + oMissing = True + oErrMsgMissingInput = "Error indexing datepicker idb" + MyValidationLogger.Warn(oErrMsgMissingInput) + OpenfrmError(oErrMsgMissingInput) + Exit For + End If + End If + If IDB_ACTIVE = False Then + If PROFIL_LOGINDEX <> "" Then + Dim oLogstr = Return_LOGString(oMyInput, oObjectValue, oIndexName) + WMIndexVectofield(oLogstr, PROFIL_LOGINDEX) End If End If - 'Jetzt die Datei indexieren End If - Catch ex As Exception - MyValidationLogger.Error(ex) - End Try + Else + MyValidationLogger.Debug("Value WD ('" & oObjectValue.ToString & "') = Input-value ('" & oMyInput.ToString & "')") + End If + Else + MyValidationLogger.Debug("DateValue is 01.01.0001 00:00:00") + End If + Catch ex As Exception + MyValidationLogger.Error(ex) + oMeta.IsDirty = False + End Try - Case oControl.GetType = GetType(GridControl) - Dim oGrid As GridControl = oControl - Dim oSettings = New ControlSettings() With { - .IndexName = oIndexName, - .ControlType = GetType(GridControl).ToString, - .Name = oControlName, - .IsRequired = oIsRequired, - .IDBAttributeType = oIDBTyp - } - Dim oGridColumnDefinition As DataTable = DT_COLUMNS_GRID.Clone() - Dim oExpression = $"CONTROL_ID = {oControlRow.Item("GUID")}" - DT_COLUMNS_GRID.Select(oExpression, "SEQUENCE").CopyToDataTable(oGridColumnDefinition, LoadOption.PreserveChanges) - - Dim oResult = ValidateGridControl(oGrid, oSettings, oGridColumnDefinition, oMissing, oErrMsgMissingInput) - If oResult = False Then - Exit For + Case oControl.GetType = GetType(CheckBox) + ' ... (Dein bestehender CheckBox-Code) ... + Try + Dim chk As CheckBox = oControl + oMyInput = chk.Checked.ToString + + If chk.CheckState = CheckState.Indeterminate And oIsRequired = True Then + oMissing = True + oErrMsgMissingInput = "Please set Checkbox value for field '" & chk.Name & "'" + MyValidationLogger.Warn(oErrMsgMissingInput) + OpenfrmError(oErrMsgMissingInput) + Exit For + End If + + Dim WertWD As String + Dim oBoolValue As Boolean + If oIndexName.StartsWith("[%VKT") Then + WertWD = ReturnVektor_IndexValue(oIndexName) + If WertWD = "" Then + oBoolValue = False + Else + oBoolValue = CBool(WertWD) + End If + Else + Dim _Value + Dim oObjectCheck = GetVariableValuefromSource(oIndexName, oIDBTyp) + If IsNothing(oObjectCheck) Or IsDBNull(oObjectCheck) Then + oBoolValue = False + Else + If oObjectCheck.ToString = "System.Object[]" Then + If oObjectCheck.Length = 1 Then + _Value = oObjectCheck(0) + Else + MyValidationLogger.Info(" >> Vectorfield " & oIndexName & "' contains more then one value - First value will be used") + _Value = oObjectCheck(0) + End If + Else + _Value = oObjectCheck + End If + oBoolValue = CBool(_Value) End If + End If + If oBoolValue <> chk.Checked Then + Dim result() As String + ReDim Preserve result(0) + If chk.Checked Then + result(0) = 1 + Else + result(0) = 0 + End If - End Select - End If 'End If für Control und ReadOnly = False - Next + If oIndexName.StartsWith("[%VKT") Then + oMyInput = Return_PM_VEKTOR(chk.Checked.ToString, oIndexName) + If WMIndexVectofield(oMyInput, PROFIL_VEKTORINDEX) = True Then + oMissing = True + oErrMsgMissingInput = "Error while indexing Checkbox as VEKTOR - ERROR: " & idxerr_message + MyValidationLogger.Warn(oErrMsgMissingInput) + OpenfrmError(oErrMsgMissingInput) + Exit For + End If + Else + If IDB_ACTIVE = False Then + If Indexiere_File(CURRENT_WMFILE, oIndexName, result) = False Then + oMissing = True + oErrMsgMissingInput = "Error while indexing Checkbox - ERROR: " & idxerr_message + MyValidationLogger.Warn(oErrMsgMissingInput) + OpenfrmError(oErrMsgMissingInput) + Exit For + End If + Else + If IDBData.SetVariableValue(oIndexName, chk.Checked.ToString) Then + oErrMsgMissingInput = "error indexing checkbox idb" + OpenfrmError(oErrMsgMissingInput) + Exit For + End If + End If + If IDB_ACTIVE = False Then + If PROFIL_LOGINDEX <> "" Then + Dim oLogstr = Return_LOGString(CBool(result(0)).ToString, WertWD, oIndexName) + WMIndexVectofield(oLogstr, PROFIL_LOGINDEX) + End If + End If + End If + End If + Catch ex As Exception + MyValidationLogger.Error(ex) + oMeta.IsDirty = False + End Try + + Case oControl.GetType = GetType(DataGridView) + ' ... (Dein bestehender DataGridView-Code) ... + Try + Dim dgv As DataGridView = oControl + Dim Zeilen As Integer = 0 + For Each row As DataGridViewRow In dgv.Rows + Dim exists = False + If row.Cells(0).Value Is Nothing = False Then + Zeilen += 1 + End If + Next + If oIsRequired = True And Zeilen = 0 Then + oMissing = True + oErrMsgMissingInput = "Fehlende Eingabe in Vektorfeld '" & dgv.Name & "'" + MyValidationLogger.Warn(oErrMsgMissingInput) + OpenfrmError(oErrMsgMissingInput) + Exit For + ElseIf Zeilen > 0 Then + Dim ZeilenGrid As Integer = 0 + Dim myVektorArr As String() + For Each row As DataGridViewRow In dgv.Rows + Dim exists = False + Select Case oControlType + Case "TABLE" + Dim str As String + If row.Cells(0).Value Is Nothing = False Then + ReDim Preserve myVektorArr(ZeilenGrid) + For i = 0 To row.Cells.Count - 1 + Select Case i + Case 0 + str = row.Cells(i).Value + Case Else + str = str & PMDelimiter & row.Cells(i).Value + End Select + Next + myVektorArr(ZeilenGrid) = str + ZeilenGrid += 1 + End If + Case Else + If row.Cells(0).Value Is Nothing = False Then + ReDim Preserve myVektorArr(ZeilenGrid) + myVektorArr(ZeilenGrid) = row.Cells(0).Value.ToString + ZeilenGrid += 1 + End If + End Select + Next + If IDB_ACTIVE = False Then + If Indexiere_File(CURRENT_WMFILE, oIndexName, myVektorArr) = False Then + oMissing = True + oErrMsgMissingInput = "Error while indexing Vektorfeld - ERROR: " & idxerr_message + MyValidationLogger.Warn(oErrMsgMissingInput) + OpenfrmError(oErrMsgMissingInput) + Exit For + End If + Else + Dim oDT As DataTable = DT_FOR_ARRAY(myVektorArr) + If oDT.Rows.Count > 0 Then + If IDBData.SetVariableValue(oIndexName, oDT, True) = False Then + oMissing = True + oErrMsgMissingInput = "Error indexing Datagridview idb" + MyValidationLogger.Warn(oErrMsgMissingInput) + OpenfrmError(oErrMsgMissingInput) + Exit For + End If + End If + End If + End If + Catch ex As Exception + MyValidationLogger.Error(ex) + oMeta.IsDirty = False + End Try + + Case oControl.GetType = GetType(GridControl) + Dim oGrid As GridControl = oControl + Dim oSettings = New ControlSettings() With { + .IndexName = oIndexName, + .ControlType = GetType(GridControl).ToString, + .Name = oControlName, + .IsRequired = oIsRequired, + .IDBAttributeType = oIDBTyp + } + Dim oGridColumnDefinition As DataTable = DT_COLUMNS_GRID.Clone() + Dim oExpression = $"CONTROL_ID = {oControlRow.Item("GUID")}" + DT_COLUMNS_GRID.Select(oExpression, "SEQUENCE").CopyToDataTable(oGridColumnDefinition, LoadOption.PreserveChanges) + + Dim oResult = ValidateGridControl(oGrid, oSettings, oGridColumnDefinition, oMissing, oErrMsgMissingInput) + If oResult = False Then + Exit For + End If + End Select + + ' ========== NEU: Dirty-Flag nach erfolgreicher Indexierung zurücksetzen ========== + oMeta.IsDirty = False + + Next ' End For Each oControl - ' If Error happened in inner For, exit the outer as well - If oMissing = True Then - MyValidationLogger.Info("oMissing = True...Exiting") - Exit For - End If - Next If oMissing = True Then MyValidationLogger.Warn("Check_UpdateIndexe: ERROR or Missing Indexing - returning False") Return False