Imports System.Data.SqlClient Imports Oracle.ManagedDataAccess.Client Imports DigitalData.Controls.LookupGrid Public Class ClassControls Private Property Form As frmIndex Private Property Panel As Panel Public Class ControlMeta Public Property IndexName As String Public Property IndexType As String Public Property MultipleValues As Boolean = False End Class Public Sub New(Panel As Panel, Form As frmIndex) Me.Form = Form Me.Panel = Panel End Sub 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) 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 oSql = ClassPatterns.ReplaceInternalValues(oSql) oSql = ClassPatterns.ReplaceUserValues(oSql, USER_PRENAME, USER_SURNAME, USER_SHORTNAME, USER_LANGUAGE, USER_EMAIL, USER_ID, CURRENT_DOKART_ID) 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) 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.FormLoaded = 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) MsgBox(ex.Message, MsgBoxStyle.Critical, "Unvorhergesehener Unexpected error in Renew_ComboboxResults:") End Try End Sub Public Function AddTextBox(indexname As String, y As Integer, text As String, DataType As String) As DevExpress.XtraEditors.TextEdit Dim oEdit As New DevExpress.XtraEditors.TextEdit With { .Name = "txt" & indexname, .Size = New Size(260, 27), .Location = New Point(11, y), .Tag = New ControlMeta() With { .IndexName = indexname, .IndexType = DataType } } Select Case DataType 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, Vorgabe 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 } } If Vorgabe.ToUpper = "$NULL" Then oPicker.EditValue = Nothing ElseIf Vorgabe IsNot Nothing Then oPicker.EditValue = Vorgabe End If 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