Imports System.ComponentModel Imports System.Text.RegularExpressions Imports DevExpress.Utils Imports DevExpress.XtraEditors Imports DevExpress.XtraEditors.Controls Imports DevExpress.XtraEditors.NavigatorButtons Imports DevExpress.XtraEditors.Repository Imports DevExpress.XtraGrid Imports DevExpress.XtraGrid.Columns Imports DevExpress.XtraGrid.Views.Base Imports DevExpress.XtraGrid.Views.Grid Imports DigitalData.Controls.LookupGrid Imports DigitalData.GUIs.Common Imports DigitalData.Modules.Logging Imports DigitalData.Modules.EDMI.API.DatabaseWithFallback Imports DigitalData.Modules.EDMI.API.Constants Imports DigitalData.Modules.Base Public Class ClassControlCreator ''' ''' Konstanten ''' Private Const DEFAULT_TEXT = "Bezeichnung definieren" Private Const DEFAULT_FONT_SIZE As Integer = 10 Private Const DEFAULT_FONT_FAMILY As String = "Arial" Private Const DEFAULT_FONT_STYLE As FontStyle = FontStyle.Regular Private Const DEFAULT_COLOR As Integer = 0 Private Const DEFAULT_WIDTH As Integer = 170 Private Const DEFAULT_HEIGHT As Integer = 20 Private Const DEFAULT_HEIGHT_TABLE As Integer = 150 Public Const PREFIX_TEXTBOX = "TXT" Public Const PREFIX_LABEL = "LBL" Public Const PREFIX_CHECKBOX = "CHK" Public Const PREFIX_COMBOBOX = "CMB" Public Const PREFIX_DATETIMEPICKER = "DTP" Public Const PREFIX_DATAGRIDVIEW = "DGV" Public Const PREFIX_LOOKUP = "LU" Public Const PREFIX_TABLE = "TB" Public Const PREFIX_LINE = "LINE" Public Const PREFIX_BUTTON = "BTN" Public Const AGGREGATE_NONE = "NONE" Public Const AGGREGATE_TOTAL_INTEGER = "TOTAL_INTEGER" Public Const AGGREGATE_TOTAL_FLOAT = "TOTAL_FLOAT" Public Const AGGREGATE_TOTAL_CURRENCY = "TOTAL_CURRENCY" Public Const AGGREGATE_TOTAL_MIN = "TOTAL_MIN" Public Const AGGREGATE_TOTAL_MAX = "TOTAL_MAX" Public Const AGGREGATE_TOTAL_AVG = "TOTAL_AVG" Public Const AGGREGATE_TOTAL_COUNT = "TOTAL_COUNT" Public Const CONTROL_TYPE_TEXT = "TEXT" Public Const CONTROL_TYPE_INTEGER = "INTEGER" Public Const CONTROL_TYPE_BOOLEAN = "BOOLEAN" Public Const CONTROL_TYPE_DOUBLE = "DOUBLE" Public Const CONTROL_TYPE_CURRENCY = "CURRENCY" Public Const CONTROL_TYPE_DATE = "DATE" Public Const CONTROL_TYPE_DATETIME = "DATETIME" Public ReadOnly Property Logger As Logger Public ReadOnly Property LogConfig As LogConfig ''' ''' Saves the column data for each grid and each column in that grid ''' Public Property GridTables As New Dictionary(Of Integer, Dictionary(Of String, RepositoryItem)) Public Property GridColumns As New Dictionary(Of Integer, DataTable) Private _globalLookupEventGuard As Boolean = False Public Property GlobalLookupEventGuard As Boolean Get Return _globalLookupEventGuard End Get Set(value As Boolean) _globalLookupEventGuard = value Logger.Debug($"GlobalLookupEventGuard -> gesetzt auf [{value}]") End Set End Property ''' ''' Standard Eigenschaften für alle Controls ''' Private Class ControlDBProps Public Guid As Integer Public Name As String Public Attribute As String Public Location As Point Public [Font] As Font Public [Color] As Color Public [ReadOnly] As Boolean Public AddNewItems As Boolean = False End Class Public Class ControlMetadata Public Guid As Integer Public Name As String 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) LogConfig = pLogConfig Logger = pLogConfig.GetLogger() End Sub Private Function TransformDataRow(row As DataRow) As ControlDBProps Dim x As Integer = row.Item("X_LOC") Dim y As Integer = row.Item("Y_LOC") Dim style As FontStyle = ClassAllgemeineFunktionen.NotNullString(row.Item("FONT_STYLE"), DEFAULT_FONT_STYLE) Dim size As Single = ClassAllgemeineFunktionen.NotNullString(row.Item("FONT_SIZE"), DEFAULT_FONT_SIZE) Dim familyString As String = ClassAllgemeineFunktionen.NotNullString(row.Item("FONT_FAMILY"), DEFAULT_FONT_FAMILY) Dim family As FontFamily = New FontFamily(familyString) Dim oGuid As Integer = row.Item("GUID") Dim oControlName As String = ClassAllgemeineFunktionen.NotNullString(row.Item("NAME"), "") Dim oAttribute As String = ClassAllgemeineFunktionen.NotNullString(row.Item("INDEX_NAME"), "") Dim oLocation As New Point(x, y) Dim oFont As New Font(family, size, style, GraphicsUnit.Point) Dim oColor As Color = IntToColor(ClassAllgemeineFunktionen.NotNullString(row.Item("FONT_COLOR"), DEFAULT_COLOR)) Dim oReadOnly As Boolean = row.Item("READ_ONLY") Dim oAddNewItems As Boolean = row.Item("VKT_ADD_ITEM") If oAttribute = "@@DISPLAY_ONLY" And oReadOnly = False Then Logger.Info($"Override oReadOnly = True for Control [{oControlName}] as Attribute is @@DISPLAY_ONLY and ReadOnly = False") oReadOnly = True End If Return New ControlDBProps() With { .Guid = oGuid, .Name = oControlName, .Attribute = oAttribute, .Location = oLocation, .Font = oFont, .Color = oColor, .ReadOnly = oReadOnly, .AddNewItems = oAddNewItems } End Function Public Function CreateBaseControl(ctrl As Control, OControlRow As DataRow, designMode As Boolean) As Control Try Dim props As ControlDBProps = TransformDataRow(OControlRow) ctrl.Tag = New ControlMetadata() With { .Guid = props.Guid, .Attribute = props.Attribute, .ReadOnly = props.ReadOnly, .Name = props.Name } ctrl.Name = props.Name ctrl.Location = props.Location ctrl.Font = props.Font ctrl.ForeColor = props.Color If designMode Then ctrl.Cursor = Cursors.Hand End If If props.ReadOnly Then ctrl.BackColor = Color.LightGray End If Return ctrl Catch ex As Exception Logger.Error(ex) Return Nothing End Try End Function ' ----------------------- NEW CONTROLS ----------------------- Public Function CreateNewTextBox(location As Point) As TextEdit Dim control As New TextEdit With { .Name = $"{PREFIX_TEXTBOX}_{ClassAllgemeineFunktionen.NewShortGuid()}", .Size = New Size(DEFAULT_WIDTH, DEFAULT_HEIGHT), .Location = location, .ReadOnly = True, .BackColor = Color.White, .Cursor = Cursors.Hand } Return control End Function Public Function CreateNewLabel(location As Point) As Label Dim control As New Label With { .Name = $"{PREFIX_LABEL}_{ClassAllgemeineFunktionen.NewShortGuid}", .Text = DEFAULT_TEXT, .AutoSize = True, .Location = location, .Cursor = Cursors.Hand } Return control End Function Public Function CreateNewCheckbox(location As Point) As CheckBox Dim control As New CheckBox With { .Name = $"{PREFIX_CHECKBOX}_{ClassAllgemeineFunktionen.NewShortGuid}", .AutoSize = True, .Text = DEFAULT_TEXT, .Cursor = Cursors.Hand, .Location = location, .CheckState = CheckState.Indeterminate } Return control End Function Public Function CreateNewCombobox(location As Point) As Windows.Forms.ComboBox Dim control As New Windows.Forms.ComboBox With { .Name = $"{PREFIX_COMBOBOX}_{ClassAllgemeineFunktionen.NewShortGuid}", .Size = New Size(DEFAULT_WIDTH, DEFAULT_HEIGHT), .Cursor = Cursors.Hand, .Location = location } Return control End Function Public Function CreateNewDatetimepicker(location As Point) As DateTimePicker Dim control As New DateTimePicker With { .Name = $"{PREFIX_DATETIMEPICKER}_{ClassAllgemeineFunktionen.NewShortGuid}", .Size = New Size(DEFAULT_WIDTH, DEFAULT_HEIGHT), .Cursor = Cursors.Hand, .Location = location, .Format = DateTimePickerFormat.Short } Return control End Function Public Function CreateNewDatagridview(location As Point) As DataGridView Dim control As New DataGridView With { .Name = $"{PREFIX_DATAGRIDVIEW}_{ClassAllgemeineFunktionen.NewShortGuid}", .Size = New Size(DEFAULT_WIDTH, DEFAULT_HEIGHT_TABLE), .Cursor = Cursors.Hand, .Location = location, .AllowUserToAddRows = False, .AllowUserToDeleteRows = False, .AllowUserToResizeColumns = False, .AllowUserToResizeRows = False } control.Columns.Add(New DataGridViewTextBoxColumn With { .HeaderText = "", .Name = "column1" }) Return control End Function Friend Function CreateNewLookupControl(location As Point) As LookupControl3 Dim control As New LookupControl3 With { .Name = $"{PREFIX_LOOKUP}_{ClassAllgemeineFunktionen.NewShortGuid}", .Size = New Size(DEFAULT_WIDTH, DEFAULT_HEIGHT), .Cursor = Cursors.Hand, .Location = location } Return control End Function Public Function CreateNewTable(location As Point) As GridControl Dim oControl As New GridControl With { .Name = $"{PREFIX_TABLE}_{ClassAllgemeineFunktionen.NewShortGuid}", .Size = New Size(DEFAULT_WIDTH, DEFAULT_HEIGHT_TABLE), .Cursor = Cursors.Hand, .Location = location, .UseEmbeddedNavigator = True } oControl.ForceInitialize() Dim oView As GridView = oControl.DefaultView oView.OptionsView.ShowGroupPanel = False Dim oDatatable As New DataTable() oDatatable.Columns.Add("column1", GetType(String)) oDatatable.Columns.Add("column2", GetType(String)) oControl.DataSource = oDatatable Return oControl End Function Public Function CreateNewLine(location As Point) As LineLabel Dim control As New LineLabel With { .Name = $"{PREFIX_LINE}_{ClassAllgemeineFunktionen.NewShortGuid}", .Text = "---------------------------------", .Size = New Size(100, 5), .Location = location } Return control End Function Public Function CreateNewButton(location As Point) As Button Dim control As New Button With { .Name = $"{PREFIX_BUTTON}_{ClassAllgemeineFunktionen.NewShortGuid}", .Size = New Size(108, 28), .Cursor = Cursors.Hand, .Location = location } Return control End Function ' ----------------------- EXISITING CONTROLS ----------------------- Public Function CreateExistingTextbox(oControlRow As DataRow, designMode As Boolean) As BaseEdit Try Dim oHeight = oControlRow.ItemEx("HEIGHT", 0) Dim oWidth = oControlRow.ItemEx("WIDTH", 0) Dim oReadOnly = oControlRow.ItemEx("READ_ONLY", False) Dim oFormatString = oControlRow.ItemEx("FORMAT_STRING", String.Empty) Dim oBackColorIf = oControlRow.ItemEx("CTRL_BACKCOLOR_IF", String.Empty) Dim oIndexname = oControlRow.ItemEx("INDEX_NAME", String.Empty) Dim oAlignment = oControlRow.ItemEx("TEXT_ALIGNMENT", "Near") Dim oControl As BaseEdit = Nothing If oHeight >= 27 Then oControl = CreateBaseControl(New MemoEdit(), oControlRow, designMode) Else oControl = CreateBaseControl(New TextEdit(), oControlRow, designMode) End If Dim oMeta As ControlMetadata = oControl.Tag oControl.BackColor = Color.White oMeta.BackColor = Color.White oControl.Height = oHeight oControl.Width = oWidth If oAlignment = "Near" Then oControl.Properties.Appearance.TextOptions.HAlignment = DevExpress.Utils.HorzAlignment.Near ElseIf oAlignment = "Center" Then oControl.Properties.Appearance.TextOptions.HAlignment = DevExpress.Utils.HorzAlignment.Center ElseIf oAlignment = "Far" Then oControl.Properties.Appearance.TextOptions.HAlignment = DevExpress.Utils.HorzAlignment.Far End If If Not designMode Then oControl.ReadOnly = oReadOnly oControl.TabStop = Not oReadOnly oControl.BackColor = IIf(oReadOnly, Color.LightGray, Color.White) ' If there is a format string defined, set it for display only. ' Editing will be without format string, according to current user-culture. If oFormatString <> String.Empty Then oControl.Properties.DisplayFormat.FormatType = FormatType.Custom oControl.Properties.DisplayFormat.FormatString = ClassFormat.GetFormatString(oFormatString) 'ElseIf oReadOnly Then ' ' For read only controls, don't show the raw value when a user clicks into it ' oControl.Properties.EditFormat.FormatType = FormatType.Custom ' oControl.Properties.EditFormat.FormatString = ClassFormat.GetFormatString(oFormatString) End If Else oControl.ReadOnly = True End If Return oControl Catch ex As Exception Logger.Error(ex) Return Nothing End Try End Function Public Function CreateExistingLabel(row As DataRow, designMode As Boolean) As Label Dim oControl As Label = CreateBaseControl(New Label(), row, designMode) Try oControl.Text = row.Item("CTRL_CAPTION_LANG") Catch ex As Exception Logger.Warn("⚠️ Label [{0}] does not have a translation!", oControl.Name) oControl.Text = row.Item("CTRL_TEXT") End Try Dim oAlignment = row.ItemEx("TEXT_ALIGNMENT", "Near") If oAlignment = "Near" Then oControl.TextAlign = ContentAlignment.MiddleLeft ElseIf oAlignment = "Center" Then oControl.TextAlign = ContentAlignment.MiddleCenter ElseIf oAlignment = "Far" Then oControl.TextAlign = ContentAlignment.MiddleRight End If oControl.AutoSize = True Return oControl End Function Public Function CreateExistingButton(row As DataRow, designMode As Boolean) As Button Dim oControl As Button = CreateBaseControl(New Button(), row, designMode) Dim ctrl_image As Bitmap = Nothing Dim oBitmap As Bitmap If Not IsDBNull(row.Item("IMAGE_CONTROL")) Then Dim obimg() As Byte = row.Item("IMAGE_CONTROL") oBitmap = ByteArrayToBitmap(obimg) ctrl_image = oBitmap End If Try oControl.Text = row.Item("CTRL_CAPTION_LANG") Catch ex As Exception oControl.Text = row.Item("CTRL_TEXT") End Try oControl.Height = row.Item("HEIGHT") oControl.Width = row.Item("WIDTH") If Not IsNothing(ctrl_image) And Not IsNothing(oBitmap) Then oControl.Image = oBitmap oControl.ImageAlign = ContentAlignment.MiddleLeft oControl.TextAlign = ContentAlignment.MiddleRight End If oControl.AutoSize = True Return oControl End Function Public Function CreateExistingCombobox(pRow As DataRow, designMode As Boolean) As Windows.Forms.ComboBox Dim oControl As Windows.Forms.ComboBox = CreateBaseControl(New Windows.Forms.ComboBox(), pRow, designMode) oControl.Size = New Size(pRow.Item("WIDTH"), pRow.Item("HEIGHT")) If Not designMode Then oControl.Enabled = Not pRow.Item("READ_ONLY") oControl.TabStop = Not pRow.Item("READ_ONLY") oControl.BackColor = IIf(pRow.Item("READ_ONLY"), Color.LightGray, Color.White) oControl.AutoCompleteMode = AutoCompleteMode.SuggestAppend oControl.AutoCompleteSource = AutoCompleteSource.ListItems End If '' Apply text alignment by owner-drawing based on oAlignment 'Dim oAlignment = pRow.ItemEx("TEXT_ALIGNMENT", "Near") '' Ensure owner-draw so we can control text alignment 'oControl.DrawMode = Global.System.Windows.Forms.DrawMode.OwnerDrawFixed '' Attach handler with inline drawing logic respecting alignment 'AddHandler oControl.DrawItem, 'Sub(sender As Object, e As DrawItemEventArgs) ' Dim cmb = TryCast(sender, Windows.Forms.ComboBox) ' If cmb Is Nothing Then Return ' e.DrawBackground() ' If e.Index >= 0 AndAlso e.Index < cmb.Items.Count Then ' Dim text As String = cmb.GetItemText(cmb.Items(e.Index)) ' Dim sf As New StringFormat(StringFormatFlags.NoWrap) ' Select Case oAlignment ' Case "Near" ' sf.Alignment = StringAlignment.Near ' Case "Center" ' sf.Alignment = StringAlignment.Center ' Case "Far" ' sf.Alignment = StringAlignment.Far ' Case Else ' sf.Alignment = StringAlignment.Near ' End Select ' sf.LineAlignment = StringAlignment.Center ' Using foreBrush As New SolidBrush(If((e.State And DrawItemState.Selected) = DrawItemState.Selected, SystemColors.HighlightText, cmb.ForeColor)) ' e.Graphics.DrawString(text, e.Font, foreBrush, e.Bounds, sf) ' End Using ' End If ' e.DrawFocusRectangle() 'End Sub Return oControl End Function Public Function CreateExistingDatepicker(row As DataRow, designMode As Boolean) As DateTimePicker Dim control As DateTimePicker = CreateBaseControl(New DateTimePicker(), row, designMode) control.Size = New Size(row.Item("WIDTH"), row.Item("HEIGHT")) control.Format = DateTimePickerFormat.Short If Not designMode Then control.Enabled = Not row.Item("READ_ONLY") control.TabStop = Not row.Item("READ_ONLY") End If Return control End Function Public Function CreateExisingCheckbox(row As DataRow, designMode As Boolean) As CheckBox Dim oCheckBox As CheckBox = CreateBaseControl(New CheckBox(), row, designMode) oCheckBox.AutoSize = True Try oCheckBox.Text = row.Item("CTRL_CAPTION_LANG") Catch ex As Exception oCheckBox.Text = row.Item("CTRL_TEXT") End Try oCheckBox.CheckState = CheckState.Indeterminate If Not designMode Then oCheckBox.Enabled = Not row.Item("READ_ONLY") oCheckBox.TabStop = Not row.Item("READ_ONLY") End If Return oCheckBox End Function Public Function CreateExistingDataGridView(row As DataRow, designMode As Boolean) As DataGridView Dim control As DataGridView = CreateBaseControl(New DataGridView(), row, designMode) control.Size = New Size(row.Item("WIDTH"), row.Item("HEIGHT")) control.AllowUserToAddRows = False control.AllowUserToDeleteRows = False control.AllowUserToResizeColumns = False control.AllowUserToResizeRows = False control.AlternatingRowsDefaultCellStyle.BackColor = Color.Aqua Dim col As New DataGridViewTextBoxColumn col.HeaderText = "" col.Name = "column1" col.Width = control.Width - 30 control.Columns.Add(col) If Not designMode Then control.Enabled = Not row.Item("READ_ONLY") control.TabStop = Not row.Item("READ_ONLY") End If Return control End Function Public Function CreateExistingLookupControl(pRow As DataRow, pDesignMode As Boolean) As LookupControl3 Dim oControl As LookupControl3 = CreateBaseControl(New LookupControl3(), pRow, pDesignMode) oControl.Properties.Name = oControl.Name oControl.Width = pRow.Item("WIDTH") oControl.ReadOnly = pRow.Item("READ_ONLY") oControl.Properties.AllowAddNewValues = pRow.Item("VKT_ADD_ITEM") Dim oAlignment = pRow.ItemEx("TEXT_ALIGNMENT", "Near") If oAlignment = "Near" Then oControl.Properties.Appearance.TextOptions.HAlignment = DevExpress.Utils.HorzAlignment.Near ElseIf oAlignment = "Center" Then oControl.Properties.Appearance.TextOptions.HAlignment = DevExpress.Utils.HorzAlignment.Center ElseIf oAlignment = "Far" Then oControl.Properties.Appearance.TextOptions.HAlignment = DevExpress.Utils.HorzAlignment.Far End If If pDesignMode Then oControl.Cursor = Cursors.Hand End If Return oControl 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, 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 oView.OptionsView.ShowGroupPanel = False oControl.ContextMenu = Nothing Dim oGridBuilder As New GridBuilder(oView) oGridBuilder.WithClipboardHandler() If Not designMode Then oView.OptionsBehavior.Editable = Not row.Item("READ_ONLY") oView.OptionsBehavior.ReadOnly = row.Item("READ_ONLY") 'oView.OptionsBehavior.EditorShowMode = EditorShowMode.Click If oView.OptionsBehavior.ReadOnly = True Then oView.OptionsBehavior.Editable = False End If oControl.UseEmbeddedNavigator = Not row.Item("READ_ONLY") oView.OptionsBehavior.EditorShowMode = EditorShowMode.MouseDown ' Copy single cell value in CTRL+C instead of whole row oView.OptionsSelection.MultiSelectMode = GridMultiSelectMode.CellSelect oView.OptionsSelection.MultiSelect = True oView.OptionsClipboard.CopyColumnHeaders = DefaultBoolean.False 'oView.OptionsView.ColumnAutoWidth = True If oView.OptionsBehavior.ReadOnly = False Then If row.Item("VKT_ADD_ITEM") = True Then oView.OptionsBehavior.AllowAddRows = DefaultBoolean.True oView.OptionsBehavior.AllowDeleteRows = DefaultBoolean.True oView.OptionsView.NewItemRowPosition = NewItemRowPosition.Bottom Else oView.OptionsBehavior.Editable = False oView.OptionsView.NewItemRowPosition = NewItemRowPosition.None End If End If End If oControl.Size = New Size(row.Item("WIDTH"), row.Item("HEIGHT")) ' Add and configure navigator to delete rows oControl.UseEmbeddedNavigator = True With oControl.EmbeddedNavigator.Buttons .CancelEdit.Visible = False .Edit.Visible = False .EndEdit.Visible = False .First.Visible = False .Last.Visible = False .Next.Visible = False .NextPage.Visible = False .PrevPage.Visible = False .Prev.Visible = False End With If GridColumns.ContainsKey(oControlId) Then GridColumns.Item(oControlId) = DT_MY_COLUMNS Else GridColumns.Add(oControlId, DT_MY_COLUMNS) End If If GridTables.ContainsKey(oControlId) Then GridTables.Item(oControlId).Clear() Else GridTables.Add(oControlId, New Dictionary(Of String, RepositoryItem)()) End If Dim oDataTable = oGridControlCreator.CreateGridColumns(DT_MY_COLUMNS) GridTables = oGridControlCreator.FillGridTables(DT_MY_COLUMNS, oControlId, oControl.Name) oView.PopulateColumns(oDataTable) oControl.DataSource = oDataTable oControl.RefreshDataSource() oControl.ForceInitialize() If row.Item("TABLE_ORDER_COLUMN") <> String.Empty Then Try Dim oSortTerm = row.Item("TABLE_ORDER_COLUMN").ToString Dim oSortOrder As DevExpress.Data.ColumnSortOrder = DevExpress.Data.ColumnSortOrder.Ascending If oSortTerm.Contains(" ASC") Then oSortTerm = oSortTerm.Replace(" ASC", "") ElseIf oSortTerm.Contains(" DESC") Then oSortOrder = DevExpress.Data.ColumnSortOrder.Descending oSortTerm = oSortTerm.Replace(" DESC", "") End If oView.BeginDataUpdate() Try oView.ClearSorting() oView.Columns(oSortTerm).SortOrder = oSortOrder Finally oView.EndDataUpdate() End Try Catch ex As Exception End Try End If ' *** 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) oView.FocusInvalidRow() Return oControl End Function Private newRowModified As Boolean = False Public Function CreateExistingLine(row As DataRow, designMode As Boolean) As LineLabel Dim control As LineLabel = CreateBaseControl(New LineLabel(), row, designMode) control.Text = "------------------------------" control.BorderStyle = BorderStyle.None control.AutoSize = False control.BackColor = IntToColor(ClassAllgemeineFunktionen.NotNullString(row.Item("FONT_COLOR"), DEFAULT_COLOR)) control.Size = New Size(row.Item("WIDTH"), row.Item("HEIGHT")) Return control End Function ' ----------------------- CUSTOM LABEL/LINE CLASS ----------------------- Public Class LineLabel Inherits Label Protected Overrides Sub OnPaint(e As PaintEventArgs) 'MyBase.OnPaint(e) Dim size As New Size(e.ClipRectangle.Width, 2) Dim rect As New Rectangle(New Point(0, 0), size) 'ControlPaint.DrawBorder(e.Graphics, rect, Me.ForeColor, ButtonBorderStyle.Solid) e.Graphics.DrawLine(New Pen(ForeColor, 100), New Point(0, 0), New Point(e.ClipRectangle.Width, 2)) End Sub End Class Public Function GET_CONTROL_PROPERTIES(DT_CONTROL As DataTable, ControlName As String) Try CURRENT_CONTROL_ID = 0 CURR_CON_ID = 0 CURR_SELECT_CONTROL = "" CURR_CHOICE_LIST = "" Dim dt As New DataTable dt = DT_CONTROL ' Define the filter Dim filter As String = "NAME = '" & ControlName & "'" ' Filter the rows using Select() method of DataTable Dim FilteredRows As DataRow() = dt.Select(filter) If FilteredRows.Count = 1 Then For Each row As DataRow In FilteredRows CURRENT_CONTROL_ID = row("GUID") CURR_CON_ID = IIf(IsDBNull(row("CONNECTION_ID")), 0, row("CONNECTION_ID")) If CURR_CON_ID = 0 Then Logger.Info("CONNECTION NOT DEFINED - CTRL_GUID:" & CURRENT_CONTROL_ID) End If CURR_SELECT_CONTROL = IIf(IsDBNull(row("SQL_UEBERPRUEFUNG")), "", row("SQL_UEBERPRUEFUNG")) CURR_CHOICE_LIST = IIf(IsDBNull(row("CHOICE_LIST")), "", row("CHOICE_LIST")) Next Return 1 Else Return 0 End If Catch ex As Exception Logger.Error(ex) Logger.Info("Unexpected Error in GET_CONTROL_PROPERTIES (" & ControlName & "):" & ex.Message) Return 0 End Try End Function Public Function GET_CONTROL_PROPERTY(DT_CONTROL As DataTable, ControlGUID As Integer, ColNAME As String) Try CURRENT_CONTROL_ID = 0 CURR_CON_ID = 0 CURR_SELECT_CONTROL = "" CURR_CHOICE_LIST = "" Dim dt As New DataTable dt = DT_CONTROL ' Define the filter Dim filter As String = "GUID = " & ControlGUID ' Filter the rows using Select() method of DataTable Dim FilteredRows As DataRow() = dt.Select(filter) If FilteredRows.Count = 1 Then Dim oRESULT = FilteredRows(0).Item(ColNAME) If IsDBNull(oRESULT) Then Return Nothing Return oRESULT Else Return Nothing End If Catch ex As Exception Logger.Error(ex) Logger.Info("Unexpected Error in GET_CONTROL_PROPERTY (" & ControlGUID & "#" & ColNAME & "):" & ex.Message) Return Nothing End Try End Function Public Function GetDependingControls(DT_CONTROLS As DataTable, ControlName As String) As Boolean Try Dim dt As New DataTable dt = DT_CONTROLS ' Define the filter Dim filter As String = String.Format("SQL_UEBERPRUEFUNG LIKE '%{0}%'", ControlName) Dim FilteredRows As DataRow() = dt.Select(filter) CURR_DT_DEPENDING_CONTROLS = Nothing If FilteredRows.Length > 0 Then CURR_DT_DEPENDING_CONTROLS = FilteredRows.CopyToDataTable End If Return True Catch ex As Exception Logger.Error(ex) Logger.Info("Unexpected Error in GET_DEPENDING_CONTROLS (" & ControlName & "):" & ex.Message) Return False End Try End Function Public Function GET_CONNECTION_INFO(CON_ID As Integer) As DataRow() Try Dim dt As New DataTable dt = BASEDATA_DT_TBDD_CONNECTION ' Define the filter Dim filter As String = "GUID = " & CON_ID ' Filter the rows using Select() method of DataTable Dim FilteredRows As DataRow() = dt.Select(filter) If FilteredRows.Count = 1 Then Return FilteredRows Else Return Nothing End If Catch ex As Exception Logger.Error(ex) Logger.Info("Unexpected Error in GET_CONNECTION_INFO (" & CON_ID.ToString & "):" & ex.Message) Return Nothing End Try End Function Public Sub GridTables_CacheDatatableForColumn(pControlId As Object, pColumnName As Object, pSqlStatement As Object, pConnectionId As Integer, pAdvancedLookup As Boolean) Try 'Dim oTable As DataTable = ClassDatabase.Return_Datatable_ConId(pSqlStatement, pConnectionId) Dim oTable As DataTable = DatabaseFallback.GetDatatable(New GetDatatableOptions(pSqlStatement, DatabaseType.ECM) With { .ConnectionId = pConnectionId }) ' If no columns for this control have been added, create an empty dict now If Not GridTables.ContainsKey(pControlId) Then GridTables.Add(pControlId, New Dictionary(Of String, RepositoryItem)) End If Dim oRepositoryItem = GridTables_GetRepositoryItemForColumn(pColumnName, oTable, pAdvancedLookup) Dim oColumnDictionary = GridTables.Item(pControlId) If oColumnDictionary.ContainsKey(pColumnName) Then oColumnDictionary.Item(pColumnName) = oRepositoryItem Else oColumnDictionary.Add(pColumnName, oRepositoryItem) End If Catch ex As Exception Logger.Error(ex) End Try End Sub Public Function GridTables_GetRepositoryItemForColumn(pColumnName As String, pDataTable As DataTable, pIsAdvancedLookup As Boolean) As RepositoryItem If pIsAdvancedLookup Then Dim oEditor = New RepositoryItemLookupControl3 If pDataTable IsNot Nothing Then oEditor.DisplayMember = pDataTable.Columns.Item(0).ColumnName oEditor.ValueMember = pDataTable.Columns.Item(0).ColumnName oEditor.DataSource = pDataTable End If Return oEditor Else Dim oEditor = New RepositoryItemComboBox() Dim oItems As New List(Of String) AddHandler oEditor.Validating, Sub(_sender As ComboBoxEdit, _e As CancelEventArgs) If oItems.Contains(_sender.EditValue) Then _e.Cancel = False Else _e.Cancel = True End If End Sub If pDataTable IsNot Nothing Then For Each oRow2 As DataRow In pDataTable.Rows Dim oValue = oRow2.Item(0) Try If oRow2.ItemArray.Length > 1 Then oValue &= $" | {oRow2.Item(1)}" End If Catch ex As Exception End Try oEditor.Items.Add(oValue) oItems.Add(oValue) Next End If Return oEditor End If End Function Public Sub GridTables_HandleControlValueChange(pControlPanel As XtraScrollableControl, pColumnsWithSqlAndControlPlaceholders As DataTable) If pColumnsWithSqlAndControlPlaceholders Is Nothing OrElse pColumnsWithSqlAndControlPlaceholders.Rows.Count = 0 Then Logger.Debug("No depending controls with SQL statements defined, skipping handling control value change.") Return End If ' ============================================================================ ' Schritt 1 - Sichere ALLE Lookup-Werte VOR SQL-Reload ' ============================================================================ Dim lookupBackups As New Dictionary(Of String, Object) For Each oControl As Control In pControlPanel.Controls If TypeOf oControl Is LookupControl3 Then Try Dim lookup = DirectCast(oControl, LookupControl3) ' Speichere den aktuellen EditValue (kann einzelner Wert oder Liste sein) If lookup.EditValue IsNot Nothing Then Dim controlName As String = lookup.Name lookupBackups(controlName) = lookup.EditValue Logger.Debug($"GridTables_HandleControlValueChange -> Backup für Lookup [{controlName}]: [{lookup.EditValue}]") End If Catch ex As Exception Logger.Error($"GridTables_HandleControlValueChange -> Fehler beim Backup von Lookup: {ex.Message}") End Try End If Next ' ============================================================================ ' Schritt 2 - Verarbeite Grid-Columns mit SQL-Abhängigkeiten ' ============================================================================ For Each oRow As DataRow In pColumnsWithSqlAndControlPlaceholders.Rows Try Dim oSqlStatement = oRow.ItemEx("SQL_COMMAND", String.Empty) Dim oConnectionId = oRow.ItemEx("CONNECTION_ID", -1) Dim oControlId = oRow.Item("CONTROL_ID") Dim oColumnName = oRow.Item("SPALTENNAME") Dim oAdvancedLookup = oRow.Item("ADVANCED_LOOKUP") If oSqlStatement <> String.Empty AndAlso oConnectionId > -1 Then oSqlStatement = clsPatterns.ReplaceAllValues(oSqlStatement, pControlPanel, True) GridTables_CacheDatatableForColumn(oControlId, oColumnName, oSqlStatement, oConnectionId, oAdvancedLookup) ' Force-setting Editor for GridColumns Logger.Debug("Force-setting Editor for all Gridcells..") For Each oControl As Control In pControlPanel.Controls Try If oControl.Tag IsNot Nothing AndAlso TypeOf oControl.Tag Is ControlMetadata Then Dim oMeta = DirectCast(oControl.Tag, ControlMetadata) If oMeta.Guid = oControlId AndAlso TypeOf oControl Is GridControl Then Dim oGrid As GridControl = DirectCast(oControl, GridControl) If oGrid.FocusedView IsNot Nothing AndAlso TypeOf oGrid.FocusedView Is GridView Then DirectCast(oGrid.FocusedView, GridView).FocusInvalidRow() Logger.Debug($"Force-setting Editor for Grid [{oGrid.Name}]") End If Exit For End If End If Catch ex As Exception Logger.Error($"GridTables_HandleControlValueChange -> Fehler beim Force-setting Editor: {ex.Message}") End Try Next End If Catch ex As Exception Logger.Error(ex) Logger.Info($"Unexpected Error in Display SQL result for grid column: {oRow.Item("CONTROL_ID")} - ERROR: {ex.Message}") End Try Next ' ============================================================================ ' Schritt 3 - Prüfe und restauriere Lookup-Werte mit SQL-Abhängigkeiten ' ============================================================================ If lookupBackups.Count > 0 Then Logger.Debug($"GridTables_HandleControlValueChange -> Prüfe {lookupBackups.Count} Lookups auf Wiederherstellung...") For Each oControl As Control In pControlPanel.Controls If TypeOf oControl Is LookupControl3 Then Try Dim lookup = DirectCast(oControl, LookupControl3) Dim controlName As String = lookup.Name ' Wenn wir einen Backup für dieses Lookup haben If lookupBackups.ContainsKey(controlName) Then Dim oldValue = lookupBackups(controlName) ' Prüfe ob Lookup ein DataSource hat (könnte durch SQL neu geladen worden sein) If lookup.Properties.DataSource IsNot Nothing AndAlso TypeOf lookup.Properties.DataSource Is DataTable Then Dim currentDataSource = DirectCast(lookup.Properties.DataSource, DataTable) ' Wenn DataSource Rows hat, versuche Werte wiederherzustellen If currentDataSource.Rows.Count > 0 Then RestoreLookupValues(lookup, oldValue, currentDataSource, controlName) End If End If End If Catch ex As Exception Logger.Error($"GridTables_HandleControlValueChange -> Fehler beim Prüfen von Lookup: {ex.Message}") Logger.Error(ex) End Try End If Next End If End Sub Private Sub RestoreLookupValues(lookup As LookupControl3, oldValue As Object, newDataSource As DataTable, controlName As String) If lookup Is Nothing OrElse oldValue Is Nothing OrElse newDataSource Is Nothing Then Logger.Warn($"RestoreLookupValues -> [{controlName}] Ungültige Parameter") Return End If Try ' Bestimme ValueColumn Dim valueColumn As String = String.Empty If String.IsNullOrEmpty(lookup.Properties.ValueMember) AndAlso newDataSource.Columns.Count > 0 Then valueColumn = newDataSource.Columns(0).ColumnName ElseIf Not String.IsNullOrEmpty(lookup.Properties.ValueMember) Then valueColumn = lookup.Properties.ValueMember Else Logger.Warn($"RestoreLookupValues -> [{controlName}] Keine ValueColumn verfügbar") Return End If ' Build HashSet für effiziente Suche Dim availableValues As New HashSet(Of String)(StringComparer.OrdinalIgnoreCase) For Each row As DataRow In newDataSource.Rows If Not IsDBNull(row(valueColumn)) Then availableValues.Add(row(valueColumn).ToString()) End If Next ' Prüfe ob der alte Wert noch in der neuen DataSource existiert Dim validValue As Object = Nothing ' Behandle verschiedene Datentypen (String, List, Array, etc.) If TypeOf oldValue Is String Then Dim valueStr As String = oldValue.ToString() If availableValues.Contains(valueStr) Then validValue = oldValue Logger.Debug($"RestoreLookupValues -> [{controlName}] Wert [{valueStr}] ✓ gefunden") Else Logger.Warn($"RestoreLookupValues -> [{controlName}] Wert [{valueStr}] ✗ nicht mehr vorhanden") End If ElseIf TypeOf oldValue Is IEnumerable Then ' Behandle Listen/Arrays Dim validValues As New List(Of Object) For Each item As Object In DirectCast(oldValue, IEnumerable) If item IsNot Nothing Then Dim itemStr As String = item.ToString() If availableValues.Contains(itemStr) Then validValues.Add(item) Logger.Debug($"RestoreLookupValues -> [{controlName}] Wert [{itemStr}] ✓ gefunden") Else Logger.Warn($"RestoreLookupValues -> [{controlName}] Wert [{itemStr}] ✗ nicht mehr vorhanden") End If End If Next If validValues.Count > 0 Then validValue = validValues End If Else ' Fallback für andere Typen Dim valueStr As String = oldValue.ToString() If availableValues.Contains(valueStr) Then validValue = oldValue Logger.Debug($"RestoreLookupValues -> [{controlName}] Wert [{valueStr}] ✓ gefunden") Else Logger.Warn($"RestoreLookupValues -> [{controlName}] Wert [{valueStr}] ✗ nicht mehr vorhanden") End If End If ' Gültige Werte wiederherstellen If validValue IsNot Nothing Then ' Event-Guard temporär aktivieren um Endlosschleifen zu vermeiden Dim oldGuard As Boolean = GlobalLookupEventGuard GlobalLookupEventGuard = True Try ' Prüfe ob bereits korrekt gesetzt Dim currentValue = lookup.EditValue If currentValue IsNot Nothing AndAlso currentValue.Equals(validValue) Then Logger.Debug($"RestoreLookupValues -> [{controlName}] Wert bereits korrekt gesetzt") Return End If ' Setze den Wert neu lookup.EditValue = Nothing Application.DoEvents() lookup.EditValue = validValue lookup.Refresh() Application.DoEvents() ' Validierung Dim newValue = lookup.EditValue If newValue IsNot Nothing AndAlso newValue.Equals(validValue) Then Logger.Debug($"RestoreLookupValues -> [{controlName}] ✓ erfolgreich wiederhergestellt: [{validValue}]") Else Logger.Error($"RestoreLookupValues -> [{controlName}] ✗ Fehler beim Wiederherstellen! Erwartet: [{validValue}], Ist: [{If(newValue, "NULL")}]") ' Retry mit BeginUpdate/EndUpdate Logger.Debug($"RestoreLookupValues -> [{controlName}] Versuche alternative Methode mit BeginUpdate...") lookup.Properties.BeginUpdate() Try lookup.EditValue = Nothing Application.DoEvents() lookup.EditValue = validValue Finally lookup.Properties.EndUpdate() End Try lookup.Refresh() Application.DoEvents() Dim retryValue = lookup.EditValue If retryValue IsNot Nothing AndAlso retryValue.Equals(validValue) Then Logger.Debug($"RestoreLookupValues -> [{controlName}] ✓ Alternative Methode erfolgreich") Else Logger.Error($"RestoreLookupValues -> [{controlName}] ✗ Auch alternative Methode fehlgeschlagen!") End If End If Finally ' Event-Guard wiederherstellen GlobalLookupEventGuard = oldGuard End Try Else Logger.Info($"RestoreLookupValues -> [{controlName}] Keine gültigen Werte zum Wiederherstellen") End If Catch ex As Exception Logger.Error($"RestoreLookupValues -> Fehler bei [{controlName}]: {ex.Message}") Logger.Error(ex) End Try End Sub End Class