Imports DevExpress.XtraEditors Imports DevExpress.XtraGrid Imports DevExpress.XtraGrid.Views.Base Imports DevExpress.XtraGrid.Views.Grid Imports DevExpress.XtraTab Imports DigitalData.Modules.Logging Public Class ClassControlCreator 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_WIDTH_GRIDVIEW As Integer = 150 Private Const DEFAULT_HEIGHT_GRIDVIEW 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_GRIDCONTROL = "GRID" Public Const PREFIX_LINE = "LINE" Public Const PREFIX_BUTTON = "BTN" Public Shared GridTables As New Dictionary(Of String, DataTable) Private Logger As Logger Private Property Form As frmSearchStart Private Property TabPage As XtraTabPage Public Class ControlMeta Public Property IndexName As String Public Property IndexType As String Public Property MultipleValues As Boolean = False End Class ''' ''' Standard Eigenschaften für alle Controls ''' Private Class ControlDBProps Public Guid As Integer Public Name As String Public Location As Point Public [Font] As Font Public [Color] As Color End Class Public Class ControlMetadata Public Guid As Integer Public AttrID As Integer Public AttrTitle As String Public AttrType As String Public DTSource As DataTable Public MinValue As String Public MaxValue As String End Class Private Shared Function TransformDataRow(row As DataRow, pXPosition As Integer, pYPosition As Integer) As ControlDBProps Dim oxPos As Integer = pXPosition Dim oYPos As Integer = pYPosition ' Dim style As FontStyle = NotNull(row.Item("FONT_STYLE"), DEFAULT_FONT_STYLE) ' Dim size As Single = NotNull(row.Item("FONT_SIZE"), DEFAULT_FONT_SIZE) ' Dim familyString As String = NotNull(row.Item("FONT_FAMILY"), DEFAULT_FONT_FAMILY) 'Dim family As FontFamily = New FontFamily(familyString) Dim oGuid As Integer = row.Item("GUID") Dim oName As String = row.Item("ATTRIBUTE_TITLE") Dim oLocation As New Point(oxPos, oYPos) 'Dim oFont As New Font(family, size, style, GraphicsUnit.Point) 'Dim oColor As Color = IntToColor(NotNull(row.Item("FONT_COLOR"), DEFAULT_COLOR)) 'Dim oReadOnly As Boolean = row.Item("READ_ONLY") Return New ControlDBProps() With { .Guid = oGuid, .Name = oName, .Location = oLocation} '.Font = oFont, '.Color = oColor End Function Public Function CreateBaseControl(ctrl As Control, pAttributeRow As DataRow, pXPosition As Integer, pYPosition As Integer) As Control Try Dim props As ControlDBProps = TransformDataRow(pAttributeRow, pXPosition, pYPosition) Dim oSourceSQL As String = pAttributeRow.Item("SOURCE_SQL").ToString oSourceSQL = oSourceSQL.Replace("@USER_LANGUAGE", My.Application.User.Language) oSourceSQL = oSourceSQL.Replace("@pUSER_ID", My.Application.User.UserId) oSourceSQL = oSourceSQL.Replace("@RESULT_TITLE", pAttributeRow.Item("ATTRIBUTE_TITLE").ToString) Dim oDTSource As DataTable = My.Database_IDB.GetDatatable(oSourceSQL) Dim oMinValue As String = "" Dim oMaxValue As String = "" If Not IsNothing(oDTSource) Then oMinValue = oDTSource.Rows(0).Item(0) oMaxValue = oDTSource.Rows(oDTSource.Rows.Count - 1).Item(0) End If ctrl.Tag = New ControlMetadata() With { .Guid = CType(pAttributeRow.Item("GUID"), Integer), .AttrID = CType(pAttributeRow.Item("ATTRIBUTE_ID"), Integer), .AttrTitle = CType(pAttributeRow.Item("ATTRIBUTE_TITLE"), String), .DTSource = CType(oDTSource, DataTable), .MinValue = oMinValue, .MaxValue = oMaxValue } ctrl.Name = props.Name ctrl.Location = props.Location ctrl.Font = props.Font ctrl.ForeColor = props.Color Return ctrl Catch ex As Exception Logger.Error(ex) End Try End Function Public Sub New(pTabPage As XtraTabPage, pForm As frmSearchStart) Me.Form = pForm Me.TabPage = pTabPage Logger = My.LogConfig.GetLogger() End Sub Public Function CreateExistingCheckbox(pAttributeRow As DataRow, pXPosition As Integer, pYPosition As Integer) As CheckBox Dim oCheckBox As CheckBox = CType(CreateBaseControl(New CheckBox(), pAttributeRow, pXPosition, pYPosition), CheckBox) oCheckBox.AutoSize = True Try oCheckBox.Text = pAttributeRow.Item("ATTRIBUTE_TITLE") Catch ex As Exception oCheckBox.Text = "NO CAPTION AVAILABLE" End Try oCheckBox.CheckState = CheckState.Indeterminate Return oCheckBox End Function Public Function CreateExistingDatepicker(pAttributeRow As DataRow, pXPosition As Integer, pYPosition As Integer) As DateEdit Dim oDateControl As DateEdit = CType(CreateBaseControl(New DateEdit(), pAttributeRow, pXPosition, pYPosition), DateEdit) oDateControl.Size = New Size(100, 20) oDateControl.Properties.HighlightTodayCell = True oDateControl.Properties.ShowWeekNumbers = True oDateControl.Properties.ShowClear = True Try Dim oMinDate As Date = DirectCast(oDateControl.Tag, ClassControlCreator.ControlMetadata).MinValue oDateControl.Properties.MinValue = oMinDate Catch ex As Exception End Try Try Dim oMaxDate As Date = DirectCast(oDateControl.Tag, ClassControlCreator.ControlMetadata).MaxValue oDateControl.Properties.MaxValue = oMaxDate Catch ex As Exception End Try Return oDateControl End Function Public Function CreateExistingGridControl(pAttributeRow As DataRow, pXPosition As Integer, pYPosition As Integer) As GridControl Dim oMyNewGridControl As GridControl = CreateBaseControl(New GridControl(), pAttributeRow, pXPosition, pYPosition) Dim oDatatable As New DataTable Dim oView As DevExpress.XtraGrid.Views.Grid.GridView oMyNewGridControl.ForceInitialize() oView = CType(oMyNewGridControl.MainView, GridView) oView.OptionsView.ShowGroupPanel = False oMyNewGridControl.ContextMenu = Nothing oView.Appearance.EvenRow.BackColor = Color.LightBlue oView.OptionsBehavior.Editable = False oView.OptionsBehavior.ReadOnly = True oView.OptionsBehavior.AllowAddRows = False oView.OptionsBehavior.AllowDeleteRows = False oView.OptionsView.NewItemRowPosition = NewItemRowPosition.None oView.OptionsView.ShowAutoFilterRow = True oView.OptionsView.EnableAppearanceEvenRow = True oMyNewGridControl.Size = New Size(CInt(pAttributeRow.Item("WIDTH")), CInt(pAttributeRow.Item("HEIGHT"))) ' Add and configure navigator to delete rows oMyNewGridControl.UseEmbeddedNavigator = True With oMyNewGridControl.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 GridTables.Clear() 'Dim oColumn = New DataColumn() With { ' .DataType = GetType(String), ' .ColumnName = pAttributeRow.Item("ATTRIBUTE_TITLE").ToString, ' .Caption = pAttributeRow.Item("ATTRIBUTE_TITLE").ToString, ' .ReadOnly = False ' } 'oDatatable.Columns.Add(oColumn) 'For Each oRow As DataRow In DT_MY_COLUMNS.Rows ' ' Create Columns in Datatable ' Dim oColumn = New DataColumn() With { ' .DataType = GetType(String), ' .ColumnName = pAttributeRow.Item("ATTRIBUTE_TITLE").ToString, ' .Caption = pAttributeRow.Item("ATTRIBUTE_TITLE").ToString, ' .ReadOnly = False ' } ' oDatatable.Columns.Add(oColumn) ' ' Fetch and cache Combobox results ' Dim oConnectionId As Integer = NotNull(oRow.Item("CONNECTION_ID"), 0) ' Dim oSqlCommand As String = NotNull(oRow.Item("SQL_COMMAND"), "") ' If Not clsPatterns.HasComplexPatterns(oSqlCommand) Then ' If oConnectionId > 0 And oSqlCommand <> "" Then ' Try ' Dim oComboboxDataTable As DataTable = ClassDatabase.Return_Datatable_ConId(oSqlCommand, oConnectionId) ' GridTables.Add(oRow.Item("SPALTENNAME"), oComboboxDataTable) ' Catch ex As Exception ' Logger.Warn("Could not load data for column {0} in control {1}", oRow.Item("SPALTENNAME"), oControl.Name) ' Logger.Error(ex) ' End Try ' End If ' End If 'Next Dim oDTSource As DataTable = DirectCast(oMyNewGridControl.Tag, ClassControlCreator.ControlMetadata).DTSource oMyNewGridControl.DataSource = oDTSource oView.PopulateColumns() oMyNewGridControl.RefreshDataSource() oMyNewGridControl.ForceInitialize() 'Try ' oView.Columns(0).Caption = "Existierende Werte" 'Catch ex As Exception 'End Try 'AddHandler oView.CustomRowCellEdit, Sub(sender As Object, e As CustomRowCellEditEventArgs) ' For Each oRow As DataRow In DT_MY_COLUMNS.Rows ' If oRow.Item("SPALTENNAME") = e.Column.FieldName Then ' If GridTables.ContainsKey(e.Column.FieldName) Then ' Dim oComboboxDataTable As DataTable = GridTables.Item(e.Column.FieldName) ' Dim oEditor As 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 ' For Each oRow2 As DataRow In oComboboxDataTable.Rows ' Dim oValue = oRow2.Item(0) ' Try ' oValue &= $" | {oRow2.Item(1)}" ' Catch ex As Exception ' End Try ' oEditor.Items.Add(oValue) ' oItems.Add(oValue) ' Next ' e.RepositoryItem = oEditor ' End If ' End If ' Next ' End Sub 'AddHandler oView.CellValueChanged, Sub(sender As Object, e As CellValueChangedEventArgs) ' Dim oValue = e.Value.ToString() ' Dim oView2 As GridView = TryCast(sender, GridView) ' If oValue.Contains(" | ") Then ' oValue = oValue.Split(" | ").ToList().Item(0) ' oView2.SetRowCellValue(e.RowHandle, e.Column, oValue) ' End If ' End Sub Return oMyNewGridControl End Function Public Function AddCheckBox(indexname As String, y As Integer, vorbelegung As String, caption As String) Try Dim value As Boolean = False Dim chk As New CheckBox chk.Name = "chk" & indexname chk.Size = New Size(100, 27) chk.Location = New Point(11, y) chk.Tag = New ControlMeta() With { .IndexName = indexname, .IndexType = "BOOLEAN" } If caption <> "" Then chk.Text = caption chk.Size = New Size(CInt(caption.Length * 15), 27) End If If Boolean.TryParse(vorbelegung, value) = False Then If vorbelegung = "1" Or vorbelegung = "0" Then chk.Checked = CBool(vorbelegung) Else chk.Checked = False End If Else chk.Checked = value End If AddHandler chk.CheckedChanged, AddressOf Checkbox_CheckedChanged Return chk Catch ex As Exception Logger.Info("Unhandled Exception in AddCheckBox: " & ex.Message) Logger.Error(ex.Message) Return Nothing End Try End Function Public Sub Checkbox_CheckedChanged(sender As CheckBox, e As EventArgs) 'PrepareDependingControl(sender) End Sub 'Public Function AddVorschlag_ComboBox(indexname As String, y As Integer, conid As Integer, sql_Vorschlag As String, Multiselect As Boolean, DataType As String, Optional Vorgabe As String = "", Optional AddNewValues As Boolean = False, Optional PreventDuplicateValues As Boolean = False, Optional SQLSuggestion As Boolean = False) As Control ' Try ' Dim oSql As String = sql_Vorschlag ' Dim oConnectionString As String ' Dim oControl As New DigitalData.Controls.LookupGrid.LookupControl2 With { ' .Multiselect = Multiselect, ' .AllowAddNewValues = AddNewValues, ' .PreventDuplicates = PreventDuplicateValues, ' .Location = New Point(11, y), ' .Size = New Size(300, 27), ' .Name = "cmbMulti" & indexname, ' .Tag = New ControlMeta() With { ' .IndexName = indexname, ' .IndexType = DataType ' } ' } ' oControl.Properties.AppearanceFocused.BackColor = Color.Lime ' If Not String.IsNullOrEmpty(Vorgabe) Then ' Dim oDefaultValues As New List(Of String) ' If Vorgabe.Contains(",") Then ' oDefaultValues = Vorgabe. ' Split(",").ToList(). ' Select(Function(item) item.Trim()). ' ToList() ' Else ' oDefaultValues = Vorgabe. ' Split(ClassConstants.VECTORSEPARATOR).ToList(). ' Select(Function(item) item.Trim()). ' ToList() ' End If ' oControl.SelectedValues = oDefaultValues ' End If ' AddHandler oControl.SelectedValuesChanged, AddressOf Lookup_SelectedValuesChanged ' oConnectionString = ClassFormFunctions.GetConnectionString(conid) ' If oConnectionString IsNot Nothing And oSql.Length > 0 And SQLSuggestion = True Then ' Logger.Debug("Connection String (redacted): [{0}]", oConnectionString.Substring(0, 30)) ' If ClassPatterns.HasComplexPatterns(oSql) Then ' Logger.Debug(" >>sql enthält Platzhalter und wird erst während der Laufzeit gefüllt!", False) ' Else ' Dim oDatatable = ClassDatabase.Return_Datatable_Combined(oSql, oConnectionString, False) ' oControl.DataSource = oDatatable ' End If ' Else ' Logger.Warn("Connection String for control [{0}] is empty!", oControl.Name) ' End If ' Return oControl ' Catch ex As Exception ' Logger.Info(" - Unvorhergesehener Unexpected error in AddVorschlag_ComboBox - Indexname: " & indexname & " - Fehler: " & vbNewLine & ex.Message) ' Logger.Error(ex.Message) ' MsgBox(ex.Message, MsgBoxStyle.Critical, "Unvorhergesehener Unexpected error in AddVorschlag_ComboBox:") ' Return Nothing ' End Try 'End Function 'Private Sub Lookup_SelectedValuesChanged(sender As LookupControl2, SelectedValues As List(Of String)) ' PrepareDependingControl(sender) 'End Sub Function AddCombobox(indexname As String, y As Integer) Dim cmb As New ComboBox cmb.Name = "cmb" & indexname cmb.AutoSize = True cmb.Size = New Size(300, 27) cmb.Location = New Point(11, y) cmb.Tag = New ControlMeta() With { .IndexName = indexname } AddHandler cmb.SelectedIndexChanged, AddressOf OncmbSIndexChanged AddHandler cmb.GotFocus, AddressOf OncmbGotFocus AddHandler cmb.LostFocus, AddressOf OncmbLostFocus 'AddHandler cmb.KeyDown, AddressOf OncmbKeyDown Return cmb End Function 'Public Sub OncmbKeyDown(sender As System.Object, e As System.EventArgs) ' Dim cmb As ComboBox = sender ' ' Verhindert, dass Auswahlliste und Autocompleteliste übereinander liegen ' If cmb.DroppedDown = True Then ' cmb.DroppedDown = False ' End If 'End Sub Public Sub OncmbGotFocus(sender As System.Object, e As System.EventArgs) Dim cmb As ComboBox = sender cmb.BackColor = Color.Lime End Sub Public Sub OncmbLostFocus(sender As System.Object, e As System.EventArgs) Dim cmb As ComboBox = sender cmb.BackColor = Color.White End Sub Public Sub OncmbSIndexChanged(sender As System.Object, e As System.EventArgs) If Form.FormShown = False Then Exit Sub End If Dim cmb As ComboBox = sender If cmb.SelectedIndex <> -1 Then If cmb.Text.Length > 15 Then Dim g As Graphics = cmb.CreateGraphics cmb.Width = g.MeasureString(cmb.Text, cmb.Font).Width + 30 g.Dispose() End If ' Get_NextComboBoxResults(cmb) SendKeys.Send("{TAB}") End If End Sub 'Private Sub Get_NextComboBoxResults(cmb As ComboBox) ' Try ' Dim indexname = cmb.Name.Replace("cmb", "") ' Dim sql = "SELECT GUID,NAME,SQL_RESULT FROM TBDD_INDEX_MAN where SUGGESTION = 1 AND SQL_RESULT like '%@" & indexname & "%' and DOK_ID = " & CURRENT_DOKART_ID & " ORDER BY SEQUENCE" ' Dim DT As DataTable = ClassDatabase.Return_Datatable(sql, True) ' If Not IsNothing(DT) Then ' If DT.Rows.Count > 0 Then ' Dim cmbname = "cmb" & DT.Rows(0).Item("NAME") ' Renew_ComboboxResults(DT.Rows(0).Item("GUID"), indexname, cmb.Text) ' End If ' End If ' Catch ex As Exception ' MsgBox("Error in Get_NextComboBoxResults:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) ' End Try 'End Sub 'Private Sub Renew_ComboboxResults(INDEX_GUID As Integer, SearchString As String, Resultvalue As String) ' Try ' Dim connectionString As String ' Dim sqlCnn As SqlConnection ' Dim sqlCmd As SqlCommand ' Dim adapter As New SqlDataAdapter ' Dim oracleConn As OracleConnection ' Dim oracleCmd As OracleCommand ' Dim oracleadapter As New OracleDataAdapter ' Dim NewDataset As New DataSet ' Dim i As Integer ' Dim DT_INDEX As DataTable = ClassDatabase.Return_Datatable("select * FROM TBDD_INDEX_MAN WHERE GUID = " & INDEX_GUID, True) ' If IsNothing(DT_INDEX) Then ' Exit Sub ' End If ' Dim conid = DT_INDEX.Rows(0).Item("CONNECTION_ID") ' Dim sql_result = DT_INDEX.Rows(0).Item("SQL_RESULT") ' Dim NAME = DT_INDEX.Rows(0).Item("NAME") ' If Not IsNothing(conid) And Not IsNothing(sql_result) And Not IsNothing(NAME) Then ' For Each ctrl As Control In Me.Panel.Controls ' If ctrl.Name = "cmb" & NAME.ToString Then ' Dim cmb As ComboBox = ctrl ' Dim sql As String = sql_result.ToString.ToUpper.Replace("@" & SearchString.ToUpper, Resultvalue) ' connectionString = ClassFormFunctions.GetConnectionString(conid) ' If connectionString Is Nothing = False Then ' 'SQL Befehl füllt die Auswahlliste ' If connectionString.Contains("Initial Catalog=") Then ' sqlCnn = New SqlConnection(connectionString) ' sqlCnn.Open() ' sqlCmd = New SqlCommand(sql, sqlCnn) ' adapter.SelectCommand = sqlCmd ' adapter.Fill(NewDataset) ' ElseIf connectionString.StartsWith("Data Source=") And connectionString.Contains("SERVICE_NAME") Then ' oracleConn = New OracleConnection(connectionString) ' ' Try ' oracleConn.Open() ' oracleCmd = New OracleCommand(sql, oracleConn) ' oracleadapter.SelectCommand = oracleCmd ' oracleadapter.Fill(NewDataset) ' End If ' If NewDataset.Tables(0).Rows.Count > 0 Then ' cmb.Items.Clear() ' 'Die Standargrösse definieren ' Dim newWidth As Integer = 300 ' For i = 0 To NewDataset.Tables(0).Rows.Count - 1 ' 'MsgBox(NewDataset.Tables(0).Rows(i).Item(0)) ' cmb.Items.Add(NewDataset.Tables(0).Rows(i).Item(0)) ' Try ' Dim text As String = NewDataset.Tables(0).Rows(i).Item(0) ' If text.Length > 15 Then ' Dim g As Graphics = cmb.CreateGraphics ' If g.MeasureString(text, cmb.Font).Width + 30 > newWidth Then ' newWidth = g.MeasureString(text, cmb.Font).Width + 30 ' End If ' g.Dispose() ' End If ' Catch ex As Exception ' MsgBox(ex.Message, MsgBoxStyle.Critical, "Unexpected error in Anpassung Breite ComboBox:") ' End Try ' Next ' cmb.Size = New Size(newWidth, 27) ' cmb.AutoCompleteSource = AutoCompleteSource.ListItems ' cmb.AutoCompleteMode = AutoCompleteMode.Suggest ' End If ' If connectionString.Contains("Initial Catalog=") Then ' Try ' adapter.Dispose() ' sqlCmd.Dispose() ' sqlCnn.Close() ' Catch ex As Exception ' End Try ' Else ' Try ' oracleadapter.Dispose() ' oracleCmd.Dispose() ' oracleConn.Close() ' Catch ex As Exception ' End Try ' End If ' End If ' End If ' Next ' End If ' Catch ex As Exception ' Logger.Info(" - Unvorhergesehener Unexpected error in Renew_ComboboxResults - Fehler: " & vbNewLine & ex.Message) ' Logger.Error(ex.Message) ' MsgBox(ex.Message, MsgBoxStyle.Critical, "Unvorhergesehener Unexpected error in Renew_ComboboxResults:") ' End Try 'End Sub Public Function AddTextBox(pAttrName As String, y As Integer, text As String, pAttrDataType As String) As DevExpress.XtraEditors.TextEdit Dim oEdit As New DevExpress.XtraEditors.TextEdit With { .Name = "txt" & pAttrName, .Size = New Size(260, 27), .Location = New Point(11, y), .Tag = New ControlMeta() With { .IndexName = pAttrName, .IndexType = pAttrDataType } } Select Case pAttrDataType Case "INTEGER" oEdit.Properties.Mask.MaskType = DevExpress.XtraEditors.Mask.MaskType.Numeric oEdit.Properties.Mask.EditMask = "d" Console.WriteLine() End Select If text IsNot Nothing Then oEdit.Text = text oEdit.SelectAll() End If AddHandler oEdit.GotFocus, AddressOf OnTextBoxFocus AddHandler oEdit.LostFocus, AddressOf OnTextBoxLostFocus AddHandler oEdit.KeyUp, AddressOf OnTextBoxKeyUp AddHandler oEdit.TextChanged, AddressOf OnTextBoxTextChanged Return oEdit End Function Public Sub OnTextBoxFocus(sender As System.Object, e As System.EventArgs) Dim oTextbox As DevExpress.XtraEditors.TextEdit = sender oTextbox.BackColor = Color.Lime oTextbox.SelectAll() End Sub Public Sub OnTextBoxTextChanged(sender As System.Object, e As System.EventArgs) Dim oTextbox As DevExpress.XtraEditors.TextEdit = sender Using oGraphics As Graphics = oTextbox.CreateGraphics() oTextbox.Width = oGraphics.MeasureString(oTextbox.Text, oTextbox.Font).Width + 15 End Using End Sub Public Sub OnTextBoxLostFocus(sender As System.Object, e As System.EventArgs) Dim oTextbox As DevExpress.XtraEditors.TextEdit = sender oTextbox.BackColor = Color.White End Sub Public Sub OnTextBoxKeyUp(sender As System.Object, e As System.Windows.Forms.KeyEventArgs) Dim oTextbox As DevExpress.XtraEditors.TextEdit = sender If oTextbox.Text = String.Empty Then Exit Sub End If If e.KeyCode = Keys.Return Or e.KeyCode = Keys.Enter Or e.KeyCode = Keys.Tab Then 'PrepareDependingControl(oTextbox) End If If (e.KeyCode = Keys.Return) Then SendKeys.Send("{TAB}") End If End Sub Public Function AddDateTimePicker(indexname As String, y As Integer, DataType As String) As DevExpress.XtraEditors.DateEdit Dim oPicker As New DevExpress.XtraEditors.DateEdit With { .Name = "dtp" & indexname, .Size = New Size(260, 27), .Location = New Point(11, y), .Tag = New ControlMeta() With { .IndexName = indexname, .IndexType = DataType } } oPicker.Properties.AppearanceFocused.BackColor = Color.Lime Return oPicker End Function Sub OndtpChanged() 'offen was hier zu tun ist End Sub 'Private Sub PrepareDependingControl(Control As Control) ' If TypeOf Control Is Label Then ' Exit Sub ' End If ' Try ' Dim oMeta = DirectCast(Control.Tag, ClassControls.ControlMeta) ' Dim oIndexName As String = oMeta.IndexName ' Dim oSQL = $"SELECT * FROM TBDD_INDEX_MAN WHERE SQL_RESULT LIKE '%{oIndexName}%'" ' Dim oDatatable As DataTable = ClassDatabase.Return_Datatable(oSQL) ' If Not IsNothing(oDatatable) Then ' Logger.Debug("Found [{0}] depending controls for [{1}]", oDatatable.Rows.Count, Control.Name) ' For Each oRow As DataRow In oDatatable.Rows ' Dim oControlName As String = NotNull(oRow.Item("NAME"), "") ' Dim oConnectionId As Integer = NotNull(oRow.Item("CONNECTION_ID"), -1) ' Dim oControlSql As String = NotNull(oRow.Item("SQL_RESULT"), "") ' If oConnectionId = -1 Or oControlSql = String.Empty Then ' Logger.Warn("Missing SQL Query or ConnectionId for Control [{0}]! Continuing.", oControlName) ' Continue For ' End If ' oControlSql = ClassPatterns.ReplaceUserValues(oControlSql, USER_PRENAME, USER_SURNAME, USER_SHORTNAME, USER_LANGUAGE, USER_EMAIL, USER_ID, CURRENT_DOKART_ID) ' oControlSql = ClassPatterns.ReplaceInternalValues(oControlSql) ' oControlSql = ClassPatterns.ReplaceControlValues(oControlSql, Panel) ' Logger.Debug("SQL After Preparing: [{0}]", oControlSql) ' Logger.Debug("Setting new value for [{0}]", oControlName) ' SetDependingControlResult(oControlName, oControlSql, oConnectionId) ' Next ' End If ' Catch ex As Exception ' Logger.Error(ex) ' End Try 'End Sub 'Private Sub SetDependingControlResult(IndexName As String, SqlCommand As String, SqlConnectionId As Integer) ' Try ' If SqlCommand Is Nothing OrElse SqlCommand = String.Empty Then ' Logger.Warn("New Value for Index [{0}] could not be set. Supplied SQL is empty.") ' Exit Sub ' End If ' Dim oConnectionString = ClassFormFunctions.GetConnectionString(SqlConnectionId) ' Dim oDatatable As DataTable = ClassDatabase.Return_Datatable_CS(SqlCommand, oConnectionString) ' Dim oFoundControl As Control = Nothing ' For Each oControl As Control In Panel.Controls ' If TypeOf oControl Is Label Then ' Continue For ' End If ' Dim oMeta = DirectCast(oControl.Tag, ClassControls.ControlMeta) ' Dim oIndex As String = oMeta.IndexName ' If oIndex = IndexName Then ' oFoundControl = oControl ' Exit For ' End If ' Next ' If oFoundControl Is Nothing Then ' Logger.Warn("Depending Control for Index [{0}] not found!", IndexName) ' End If ' If oDatatable Is Nothing Then ' Logger.Warn("Error in SQL Command: {0}", SqlCommand) ' End If ' Select Case oFoundControl.GetType.Name ' Case GetType(DevExpress.XtraEditors.TextEdit).Name ' If oDatatable.Rows.Count > 0 Then ' Dim oFirstRow As DataRow = oDatatable.Rows.Item(0) ' If oFirstRow.ItemArray.Length > 0 Then ' Dim oValue = oFirstRow.Item(0).ToString() ' Logger.Debug("Setting Value for TextEdit [{0}]: [{1}]", oFoundControl.Name, oValue) ' DirectCast(oFoundControl, DevExpress.XtraEditors.TextEdit).Text = oValue ' End If ' End If ' Case GetType(LookupControl2).Name ' Logger.Debug("Setting Value for LookupControl [{0}]: [{1}]", oFoundControl.Name, "DATATABLE") ' DirectCast(oFoundControl, LookupControl2).DataSource = oDatatable ' Case GetType(ComboBox).Name ' Logger.Debug("Setting Value for Combobox [{0}]: [{1}]", oFoundControl.Name, "DATATABLE") ' DirectCast(oFoundControl, ComboBox).DataSource = oDatatable ' Case Else ' Logger.Debug("Could not set depending control result for [{0}]", oFoundControl.GetType.Name) ' End Select ' Catch ex As Exception ' Logger.Error(ex) ' End Try 'End Sub End Class