Imports System.Windows.Forms Imports System.Text.RegularExpressions Public Class ClassControlBuilder Private _master_panel As Panel Private _current_control As Control Private _begin_location As Point Private _end_location As Point Private _mouse_down_handler As MouseEventHandler Private _mouse_up_handler As MouseEventHandler Private _mouse_move_handler As MouseEventHandler Private _mouse_click_handler As EventHandler Private _group_box_drag_drop_handler As DragEventHandler Private _tool_tip_handler As EventHandler Private _onRecordChangedName As String = "OnRecordChanged" Private _onMouseHoverName As String = "OnMouseHover" Private _events As System.ComponentModel.EventHandlerList = Nothing Protected ReadOnly Property Events() As System.ComponentModel.EventHandlerList Get If _events Is Nothing Then _events = New System.ComponentModel.EventHandlerList End If Return _events End Get End Property ' +++ RecordChanged Event +++ Public WatchRecordChanges As Boolean = True Public Custom Event OnRecordChanged As EventHandler AddHandler(value As EventHandler) Me.Events.AddHandler(_onRecordChangedName, value) End AddHandler RemoveHandler(value As EventHandler) Me.Events.RemoveHandler(_onRecordChangedName, value) End RemoveHandler RaiseEvent(sender As Object, e As EventArgs) CType(Me.Events(_onRecordChangedName), EventHandler).Invoke(sender, e) End RaiseEvent End Event Public Custom Event OnMouseHover As EventHandler AddHandler(value As EventHandler) Me.Events.AddHandler(_onMouseHoverName, value) End AddHandler RemoveHandler(value As EventHandler) Me.Events.RemoveHandler(_onMouseHoverName, value) End RemoveHandler RaiseEvent(sender As Object, e As EventArgs) CType(Me.Events(_onMouseHoverName), EventHandler).Invoke(sender, e) End RaiseEvent End Event ' ================================================================================== ' Handler für alle Controls ' ================================================================================== Public ControlsChanged As New List(Of Integer) Public Sub RecordChanged(sender As Object, ByVal e As EventArgs) Dim onRecordChangedHandler As EventHandler = CType(Me.Events(_onRecordChangedName), EventHandler) Dim ctrl As Control = DirectCast(sender, Control) Dim controlId As Integer = DirectCast(ctrl.Tag, ClassControlMetadata).Id If Not ControlsChanged.Contains(controlId) Then ControlsChanged.Add(controlId) End If If (onRecordChangedHandler IsNot Nothing And WatchRecordChanges) Then onRecordChangedHandler.Invoke(sender, e) End If End Sub ' CheckedListBox hat andere Handler Signatur Public Sub RecordChanged(sender As Object, ByVal e As DevExpress.XtraEditors.Controls.ItemCheckEventArgs) Dim onRecordChangedHandler As EventHandler = CType(Me.Events(_onRecordChangedName), EventHandler) Dim ctrl As Control = DirectCast(sender, Control) Dim controlId As Integer = DirectCast(ctrl.Tag, ClassControlMetadata).Id If Not ControlsChanged.Contains(controlId) Then ControlsChanged.Add(controlId) End If If (onRecordChangedHandler IsNot Nothing And WatchRecordChanges) Then onRecordChangedHandler.Invoke(sender, e) End If End Sub ' GridControl hat andere Handler Signatur Public Sub RecordChanged(sender As Object, ByVal e As DevExpress.XtraGrid.Views.Base.CellValueChangedEventArgs) Dim onRecordChangedHandler As EventHandler = CType(Me.Events(_onRecordChangedName), EventHandler) Dim ctrl As DevExpress.XtraGrid.Views.Grid.GridView = sender ' Dim ctrl As Control = sender 'DirectCast(sender, Control) Dim controlId As Integer = DirectCast(ctrl.GridControl.Tag, ClassControlMetadata).Id If Not ControlsChanged.Contains(controlId) Then ControlsChanged.Add(controlId) End If If (onRecordChangedHandler IsNot Nothing And WatchRecordChanges) Then onRecordChangedHandler.Invoke(sender, e) End If End Sub Public Sub RecordChanged(sender As Object, e As DevExpress.Data.SelectionChangedEventArgs) Dim onRecordChangedHandler As EventHandler = CType(Me.Events(_onRecordChangedName), EventHandler) Dim ctrl As DevExpress.XtraGrid.Views.Grid.GridView = sender Dim controlId As Integer = DirectCast(ctrl.GridControl.Tag, ClassControlMetadata).Id If Not ControlsChanged.Contains(controlId) Then ControlsChanged.Add(controlId) End If If (onRecordChangedHandler IsNot Nothing And WatchRecordChanges) Then onRecordChangedHandler.Invoke(sender, e) End If End Sub Public Sub MouseHover(sender As Object, e As EventArgs) Dim onMouseHoverHandler As EventHandler = CType(Me.Events(_onMouseHoverName), EventHandler) If onMouseHoverHandler IsNot Nothing Then onMouseHoverHandler.Invoke(sender, e) End If End Sub Private Sub OnEnabledChanged(sender As Object, e As EventArgs) Dim control As Control = DirectCast(sender, Control) ' Checkbox, radiobutton, label ist sonderfall If control.GetType() = GetType(CheckBox) Or _ control.GetType() = GetType(RadioButton) Or _ control.GetType() = GetType(Label) Then ' Hier wird nur die vordergrund-farbe geändert control.ForeColor = Color.Black Exit Sub End If If control.Enabled Then control.BackColor = Color.White control.ForeColor = Color.Black ElseIf control.Enabled = False Then control.BackColor = System.Drawing.SystemColors.Info control.ForeColor = Color.Black 'System.Drawing.SystemColors.InfoText End If End Sub ' Wie OnEnabledChanged, nur für TextBVi Private Sub OnReadOnlyChanged(sender As Object, e As EventArgs) Dim control As TextBox = DirectCast(sender, TextBox) If control.ReadOnly = False Then control.BackColor = Color.White control.ForeColor = Color.Black ElseIf control.ReadOnly = True Then control.BackColor = System.Drawing.SystemColors.Info control.ForeColor = Color.Black 'System.Drawing.SystemColors.InfoText End If End Sub Public Sub OnTextBoxFocus(sender As Object, ByVal e As EventArgs) Dim box As TextBox = sender box.BackColor = Color.LemonChiffon box.SelectAll() End Sub Public Sub OnTextBoxLostFocus(sender As Object, ByVal e As EventArgs) Dim box As TextBox = sender box.BackColor = Color.White End Sub Public Sub OnTextBoxTextChanged(sender As Object, ByVal e As EventArgs) End Sub Public Sub OnComboBoxFocus(sender As Object, ByVal e As EventArgs) Dim combo As CustomComboBox = sender combo.BackColor = Color.LemonChiffon End Sub Public Sub OnComboBoxLostFocus(sender As Object, ByVal e As EventArgs) Dim combo As CustomComboBox = sender combo.BackColor = Color.White End Sub Dim CONTROL_ID Public Sub Enable_Controls(control As Control, TableResult As DataTable, value As Object) Try If TableResult.Rows.Count = 0 Then Exit Sub End If If CURRENT_RECORD_ID = 0 Then Exit Sub End If For Each row As DataRow In TableResult.Rows Dim sqlcommand As String = row.Item("SQL_COMMAND_2") If IsNothing(sqlcommand) Then Continue For End If ' Versuchen, die RecordId zu ersetzen, falls eine existiert sqlcommand = sqlcommand.ToUpper.Replace("@RECORD_ID", CURRENT_RECORD_ID) ' ControlId Platzhalter suchen und ersetzen Dim regex As New System.Text.RegularExpressions.Regex("(@(\d+)@)") Dim match As System.Text.RegularExpressions.Match = regex.Match(sqlcommand) If match.Success Then ' DependingControlId bezeichnet das Control, das die Abhängigkeit enthält Dim dependingControlId As Integer = row.Item("GUID") 'Dim panel As Panel = DirectCast(control.Parent, Panel) Dim panel As Panel = CtrlBuilder.MasterPanel ' Über die Id das Control finden Dim dependingControl As Control = panel.Controls.OfType(Of Control)().Where(Function(c As Control) Return DirectCast(c.Tag, ClassControlMetadata).Id = dependingControlId End Function).SingleOrDefault() ' Wir ersetzen den platzhalter im sql command mit dem übergebenen wert sqlcommand = sqlcommand.Replace(match.Groups(1).Value, value) If LogErrorsOnly = False Then ClassLogger.Add(" >> " & String.Format("Executing SQL_COMMAND: '{0}' for controlID '{1}'", sqlcommand, dependingControlId), False) ' Jetzt wird das SQL Command ausgeführt, es MUSS einen Boolschen Wert zurückgeben, True, False, 0, 1 Dim dt_result As DataTable = Nothing dt_result = ClassDatabase.Return_Datatable(sqlcommand) If dt_result.Rows.Count = 1 Then Dim enabled As Boolean = CBool(dt_result.Rows(0).Item(0)) dependingControl.Enabled = enabled Else ClassLogger.Add(" >> Attention: RowCount for enabling control (" & dependingControlId.ToString & ") was '" & dt_result.Rows.Count.ToString & "' and not 1 as expected - Check SQL: '" & sqlcommand & "'", False) End If End If Next Catch ex As Exception MsgBox("Error in Enable Controls - " & CONTROL_ID.ToString & ": " & ex.Message, MsgBoxStyle.Critical) End Try End Sub Public Sub Depending_Controls(control As Control, TableResult As DataTable, value As String) Try If TableResult.Rows.Count = 0 Then Exit Sub End If If IsNothing(value) Then 'Kein Value also abhängige Controls auf "Leer" setzen For Each row As DataRow In TableResult.Rows ' DependingControlId bezeichnet das Control, das die Abhängigkeit enthält Dim dependingControlId As Integer = row.Item("GUID") Dim panel As Panel = DirectCast(control.Parent, Panel) ' Über die Id das Control finden Dim dependingControl As Control = panel.Controls.OfType(Of Control)().Where(Function(c As Control) Return DirectCast(c.Tag, ClassControlMetadata).Id = dependingControlId End Function).SingleOrDefault() Dim type = dependingControl.GetType().Name Select Case type Case "CustomComboBox" DirectCast(dependingControl, CustomComboBox).DataSource = Nothing Case "CheckedListBoxControl" DirectCast(dependingControl, DevExpress.XtraEditors.CheckedListBoxControl).DataSource = Nothing Case "Label" DirectCast(dependingControl, Label).Text = "" Case "TextBox" DirectCast(dependingControl, TextBox).Text = "" Case "GridControl" DirectCast(dependingControl, DevExpress.XtraGrid.GridControl).DataSource = Nothing End Select Next Exit Sub End If For Each row As DataRow In TableResult.Rows Dim sqlcommand As String = row.Item("SQL_COMMAND_1") If IsNothing(sqlcommand) Then Continue For End If sqlcommand = sqlcommand.ToUpper.Replace("@RECORD_ID", CURRENT_RECORD_ID) Dim regex As New System.Text.RegularExpressions.Regex("(@(\d+)@)") Dim match As System.Text.RegularExpressions.Match = regex.Match(sqlcommand) If match.Success Then Dim sqlguid = String.Format("SELECT GUID FROM TBPMO_CONTROL_VALUE WHERE CONTROL_ID = {0} AND RECORD_ID = {1}", CONTROL_ID, CURRENT_RECORD_ID) Dim ctrlvalID = ClassDatabase.Execute_Scalar(sqlguid) Select Case row.Item("FORMAT_TYPE") Case "Currency" value = Decimal.Parse(value, Globalization.NumberStyles.Currency).ToString Case "Decimal" value = Decimal.Parse(value, Globalization.NumberStyles.Integer) End Select Select Case row.Item("CONTROL_TYPE_ID") Case 4 'DatePicker Try value = CDate(Format(value, "dd-MM-yyyy")) Catch ex As Exception ClassLogger.Add("Unexpected Error in converting Value '" & value & "' to date - Control-ID: " & CONTROL_ID.ToString & "- Error: " & ex.Message) End Try End Select ' Diese Abfrage verhindert, dass Werte, die aus z.B. CheckedListBoxen kommen, ' nicht überschrieben werden. Diese Werte werden bereits mit UpdateMultipleValues gespeichert If (Not value.Contains(";")) Then If Not IsNothing(ctrlvalID) Then Dim upd1 = String.Format("UPDATE TBPMO_CONTROL_VALUE SET VALUE = '{0}',CHANGE_STEP = {1},CHANGED_WHO = '{2}' WHERE CONTROL_ID = {3} AND RECORD_ID = {4}", _ value.ToString, CURRENT_CHANGE_STEP, Environment.UserName, CONTROL_ID, CURRENT_RECORD_ID) ClassDatabase.Execute_non_Query(upd1) Else If CURRENT_RECORD_ID <> 0 Then Dim ins = String.Format("INSERT INTO TBPMO_CONTROL_VALUE (CONTROL_ID,RECORD_ID,VALUE,ADDED_WHO) VALUES ({0},{1},'{2}','{3}')", CONTROL_ID, CURRENT_RECORD_ID, value, Environment.UserName) ClassDatabase.Execute_non_Query(ins) End If ' If LogErrorsOnly = False Then ClassLogger.Add(" >> Value was nothing - Inserted the ControlValue '" & ins & "'") 'End If End If End If ' DependingControlId bezeichnet das Control, das die Abhängigkeit enthält Dim dependingControlId As Integer = row.Item("GUID") Dim panel As Panel = CtrlBuilder.MasterPanel 'Dim panel As Panel = DirectCast(control.Parent, Panel) ' Über die Id das Control finden Dim dependingControl As Control = panel.Controls.OfType(Of Control)().Where(Function(c As Control) Return DirectCast(c.Tag, ClassControlMetadata).Id = dependingControlId End Function).SingleOrDefault() sqlcommand = sqlcommand.Replace(match.Groups(1).Value, value) If LogErrorsOnly = False Then ClassLogger.Add(" >> " & String.Format("Executing SQL_COMMAND: '{0}' for controlID '{1}'", sqlcommand, dependingControlId)) Dim dt As DataTable = ClassDatabase.Return_Datatable(sqlcommand) Dim type = dependingControl.GetType().Name Select Case type Case "DateEdit" If dt.Rows.Count = 1 Then Try Dim val = dt.Rows(0).Item(0) Dim dateValue Try dateValue = CDate(Format(val, "dd-MM-yyyy")) Catch ex As Exception ClassLogger.Add("Unexpected Error in converting Value '" & value & "' to date - Control-ID: " & dependingControlId.ToString & "- Error: " & ex.Message) Continue For End Try ControlLoader.DateTimePicker.LoadValue(dependingControl, dateValue) Dim sql1 = String.Format("SELECT GUID FROM TBPMO_CONTROL_VALUE WHERE CONTROL_ID = {0} AND RECORD_ID = {1}", dependingControlId, CURRENT_RECORD_ID) Dim id = ClassDatabase.Execute_Scalar(sql1) If Not IsNothing(id) Then Dim upd = String.Format("UPDATE TBPMO_CONTROL_VALUE SET VALUE = '{0}' WHERE GUID = {1}", dateValue, id) If ClassDatabase.Execute_non_Query(upd) = True Then If LogErrorsOnly = False Then ClassLogger.Add(" >> Value was not nothing - Updated the ControlValue '" & upd) Else ClassLogger.Add(" >> Check Update depending control value as it was nothing and Update was not successful - Update-Command '" & upd & "'") End If Else Dim ins = String.Format("INSERT INTO TBPMO_CONTROL_VALUE (CONTROL_ID,RECORD_ID,VALUE,ADDED_WHO) VALUES ({0},{1},'{2}','{3}')", dependingControlId, CURRENT_RECORD_ID, dateValue, Environment.UserName) If ClassDatabase.Execute_non_Query(ins) = True Then If LogErrorsOnly = False Then ClassLogger.Add(" >> Value was nothing - Inserted the ControlValue '" & ins & "'") Else ClassLogger.Add(" >> Check Insert depending control value as it was nothing and Insert was not successful- Insert-Command '" & ins & "'") End If End If Catch ex As Exception ClassLogger.Add("Unexpectet Error in OnComboBoxValueChanged - TextBox: " & ex.Message, True) End Try Else ClassLogger.Add(" >> Attention: RowCount for depending control was '" & dt.Rows.Count.ToString & "' and not 1 as expected - Check SQL: '" & sqlcommand & "'") End If Case "CustomComboBox" ControlLoader.Combobox.SetDataSource(DirectCast(dependingControl, CustomComboBox), dt) Case "CheckedListBoxControl" Dim checkedlistbox = DirectCast(dependingControl, DevExpress.XtraEditors.CheckedListBoxControl) ControlLoader.CheckedListBox.SetDataSource(checkedlistbox, dt) ' Hier werden nun evtl schon gesetzte Werte für CheckedListBox angehakt ' Wert per LINQ aus DT_ControlValues suchen der zur aktuellen controlId passt Dim values As List(Of Object) = (From row1 In CURRENT_CONTROL_VALUES.AsEnumerable() Where row1.Item("CONTROL_ID") = dependingControlId Select row1.Item("VALUE")).ToList() 'ClassControlValues.LoadControlValue(CURRENT_RECORD_ID, CURRENT_PARENT_RECORD_ID, dependingControlId, dependingControl, values, CURRENT_FORM_ID) ControlLoader.CheckedListBox.LoadValue(checkedlistbox, values) Case "Label" If dt.Rows.Count = 1 Then Try ControlLoader.Label.LoadValue(DirectCast(dependingControl, Label), 9999, 9999, dt.Rows(0).Item(0).ToString, True) Catch ex As Exception ClassLogger.Add("Unexpectet Error in OnComboBoxValueChanged - Label: " & ex.Message, True) End Try End If Case "TextBox" If dt.Rows.Count = 1 Then Try Dim value1 As String = dt.Rows(0).Item(0) ControlLoader.TextBox.LoadValue(DirectCast(dependingControl, TextBox), 9999, 9999, value1, 999, True) Dim sqltextbox = String.Format("SELECT GUID FROM TBPMO_CONTROL_VALUE WHERE CONTROL_ID = {0} AND RECORD_ID = {1}", dependingControlId, CURRENT_RECORD_ID) Dim id = ClassDatabase.Execute_Scalar(sqltextbox) If Not IsNothing(id) Then Dim upd = String.Format("UPDATE TBPMO_CONTROL_VALUE SET VALUE = '{0}' WHERE GUID = {1}", value1, id) If ClassDatabase.Execute_non_Query(upd) = True Then If LogErrorsOnly = False Then ClassLogger.Add(" >> Value was not nothing - Updated the ControlValue '" & upd) Else ClassLogger.Add(" >> Check Update depending control value as it was nothing and Update was not successful - Update-Command '" & upd & "'") End If Else Dim ins = String.Format("INSERT INTO TBPMO_CONTROL_VALUE (CONTROL_ID,RECORD_ID,VALUE,ADDED_WHO) VALUES ({0},{1},'{2}','{3}')", dependingControlId, CURRENT_RECORD_ID, value1, Environment.UserName) If ClassDatabase.Execute_non_Query(ins) = True Then If LogErrorsOnly = False Then ClassLogger.Add(" >> Value was nothing - Inserted the ControlValue '" & ins & "'") Else ClassLogger.Add(" >> Check Insert depending control value as it was nothing and Insert was not successful- Insert-Command '" & ins & "'") End If End If Catch ex As Exception ClassLogger.Add("Unexpected Error in OnComboBoxValueChanged - TextBox: " & ex.Message, True) End Try Else ClassLogger.Add(" >> Attention: RowCount for depending control was '" & dt.Rows.Count.ToString & "' and not 1 as expected - Check SQL: '" & sqlcommand & "'") End If Case "GridControl" Dim gridControl = DirectCast(dependingControl, DevExpress.XtraGrid.GridControl) ControlLoader.DataGridViewCheckable.SetDataSource(gridControl, dt) Dim values As List(Of Object) = (From row1 In CURRENT_CONTROL_VALUES.AsEnumerable() Where row1.Item("CONTROL_ID") = dependingControlId Select row1.Item("VALUE")).ToList() ControlLoader.DataGridViewCheckable.LoadValue(gridControl, values) End Select End If Next Catch ex As Exception MsgBox("Error in DependingControls - " & CONTROL_ID.ToString & ": " & ex.Message, MsgBoxStyle.Critical) End Try End Sub Public Sub OnDateTimeValueChanged(sender As Object, ByVal e As EventArgs) If CURRENT_RECORD_ENABLED = False Then Exit Sub Try Dim control As Control = DirectCast(sender, Control) Dim controlId As Integer = DirectCast(control.Tag, ClassControlMetadata).Id CONTROL_ID = controlId 'SQL für abhängige Auswahllisten Dim SQL As String = String.Format("SELECT GUID, SQL_COMMAND_1,CONTROL_TYPE_ID,FORMAT_TYPE FROM TBPMO_CONTROL WHERE SQL_COMMAND_1 LIKE '%@{0}@%'", controlId) Dim value 'SQL für enable control Dim SQLenable As String = String.Format("SELECT GUID, SQL_COMMAND_2,CONTROL_TYPE_ID,FORMAT_TYPE FROM TBPMO_CONTROL WHERE SQL_COMMAND_2 LIKE '%@{0}@%'", controlId) value = DirectCast(control, DevExpress.XtraEditors.DateEdit).DateTime If String.IsNullOrEmpty(value) Then Exit Sub End If If CURRENT_RECORD_ID = 0 And CtrlCommandUI.IsInsert = True Then Exit Sub End If Dim datatable As DataTable = ClassDatabase.Return_Datatable(SQL) Dim datatable1 As DataTable = ClassDatabase.Return_Datatable(SQLenable) Depending_Controls(control, datatable, value) Enable_Controls(control, datatable1, value) Console.WriteLine("value changed") Catch ex As Exception If ex.Message.Contains("Objektverweis") Or ex.Message.Contains("reference not set") Then Else MsgBox("Error in OnComboBoxValueChanged - " & CONTROL_ID.ToString & ": " & ex.Message, MsgBoxStyle.Critical) End If End Try End Sub Public Sub OnComboBoxValueChanged(sender As Object, ByVal e As EventArgs) If CURRENT_RECORD_ENABLED = False Then Exit Sub Try Dim control As Control = DirectCast(sender, Control) Dim controlId As Integer = DirectCast(control.Tag, ClassControlMetadata).Id CONTROL_ID = controlId If CONTROL_ID = 29 Then Console.WriteLine("Obacht") End If 'SQL für abhängige Auswahllisten Dim SQL As String = String.Format("SELECT GUID, SQL_COMMAND_1, CONTROL_TYPE_ID,FORMAT_TYPE FROM TBPMO_CONTROL WHERE SQL_COMMAND_1 LIKE '%@{0}@%'", controlId) Dim value 'SQL für enable control Dim SQLenable As String = String.Format("SELECT GUID, SQL_COMMAND_2, CONTROL_TYPE_ID,FORMAT_TYPE FROM TBPMO_CONTROL WHERE SQL_COMMAND_2 LIKE '%@{0}@%'", controlId) ' Diese Befehle führen dazu, dass auch der ValueMember als Wert ausgelesen wird ' Das kann zu unerwarteten Ergebnissen führen, da der Benutzer nur den DisplayMember sieht. 'Select Case control.GetType() ' Case GetType(CustomComboBox) ' If IsNothing(DirectCast(control, CustomComboBox).ValueMember) Then ' value = DirectCast(control, CustomComboBox).Text ' Else ' value = DirectCast(control, CustomComboBox).SelectedValue ' End If ' Case Else ' Exit Sub 'End Select ' Die bessere Lösung ist für jetzt, einfach den angezeigten Wert auszulesen: value = DirectCast(control, CustomComboBox).Text If String.IsNullOrEmpty(value) Then Exit Sub End If If CURRENT_RECORD_ID = 0 And CtrlCommandUI.IsInsert = True Then Exit Sub End If Dim datatable As DataTable = ClassDatabase.Return_Datatable(SQL) Dim datatable1 As DataTable = ClassDatabase.Return_Datatable(SQLenable) Depending_Controls(control, datatable, value) Enable_Controls(control, datatable1, value) Console.WriteLine("value changed") Catch ex As Exception If ex.Message.Contains("Objektverweis") Or ex.Message.Contains("reference not set") Then Else MsgBox("Error in OnComboBoxValueChanged - " & CONTROL_ID.ToString & ": " & ex.Message, MsgBoxStyle.Critical) End If End Try End Sub Public Sub OnCheckedItemChanged(sender As Object, ByVal e As EventArgs) If CURRENT_RECORD_ENABLED = False Then Exit Sub Try Dim control As Control = DirectCast(sender, Control) Dim controlId As Integer = DirectCast(control.Tag, ClassControlMetadata).Id CONTROL_ID = controlId control.Update() If CONTROL_ID = 993 Then Console.WriteLine("Obacht") End If 'SQL für abhängige Auswahllisten Dim SQL As String = String.Format("SELECT GUID, SQL_COMMAND_1,CONTROL_TYPE_ID,FORMAT_TYPE FROM TBPMO_CONTROL WHERE SQL_COMMAND_1 LIKE '%@{0}@%'", controlId) 'SQL für enable control Dim SQLenable As String = String.Format("SELECT GUID, SQL_COMMAND_2,CONTROL_TYPE_ID,FORMAT_TYPE FROM TBPMO_CONTROL WHERE SQL_COMMAND_2 LIKE '%@{0}@%'", controlId) 'If CtrlCommandUI.IsInsert = True Then ' CtrlCommandUI.SaveRecord(0, CURRENT_FORM_ID, CURRENT_PARENT_ID) 'End If Dim CONTROL_VALUE As String = ClassControlCommandsUI.GetControlValue(control) If CURRENT_RECORD_ID = 0 Then Exit Sub End If ' Da wir beim Klick auf Hinzfügen einen Record anlegen, ' muss UpdateMultipleValues auch aufgerufen werden, wenn wir IsInsert = True ist 'If CtrlCommandUI.IsInsert = False Then ClassControlCommandsUI.UpdateMultipleValues(controlId, CURRENT_RECORD_ID, CONTROL_VALUE) 'End If Dim SQL1 As String = String.Format("SELECT * FROM VWPMO_VALUES WHERE RECORD_ID = {0}", CURRENT_RECORD_ID) Dim DT_ControlValues As DataTable = ClassDatabase.Return_Datatable(SQL1, "LoadControlValues") CURRENT_CONTROL_VALUES = DT_ControlValues Dim datatable As DataTable = ClassDatabase.Return_Datatable(SQL) Dim datatable1 As DataTable = ClassDatabase.Return_Datatable(SQLenable) Depending_Controls(control, datatable, CONTROL_VALUE) If IsNothing(CONTROL_VALUE) Then Exit Sub End If Enable_Controls(control, datatable1, CONTROL_VALUE) Dim values = New List(Of Object)(CONTROL_VALUE.Split(";").ToArray()) 'Jetzt noch die checked Items setzen ' ClassControlValues.LoadControlValue(CURRENT_RECORD_ID, CURRENT_PARENT_ID, controlId, control, values, 99) Catch ex As Exception If ex.Message.Contains("Objektverweis") Or ex.Message.Contains("reference not set") Then Else MsgBox("Error in OnCheckedItemChanged - " & CONTROL_ID.ToString & ": " & ex.Message, MsgBoxStyle.Critical) End If End Try End Sub Public Sub OnCheckedChanged(sender As Object, ByVal e As EventArgs) If CURRENT_RECORD_ENABLED = False Then Exit Sub Try Dim GridView As DevExpress.XtraGrid.Views.Grid.GridView = sender Dim control As Control = DirectCast(GridView.GridControl, Control) Dim controlId As Integer = DirectCast(GridView.GridControl.Tag, ClassControlMetadata).Id CONTROL_ID = controlId control.Update() 'SQL für abhängige Auswahllisten Dim SQL As String = String.Format("SELECT GUID, SQL_COMMAND_1,CONTROL_TYPE_ID,FORMAT_TYPE FROM TBPMO_CONTROL WHERE SQL_COMMAND_1 LIKE '%@{0}@%'", controlId) 'SQL für enable control Dim SQLenable As String = String.Format("SELECT GUID, SQL_COMMAND_2,CONTROL_TYPE_ID,FORMAT_TYPE FROM TBPMO_CONTROL WHERE SQL_COMMAND_2 LIKE '%@{0}@%'", controlId) 'If CtrlCommandUI.IsInsert = True Then ' CtrlCommandUI.SaveRecord(0, CURRENT_FORM_ID, CURRENT_PARENT_ID) 'End If Dim CONTROL_VALUE As String = ClassControlCommandsUI.GetControlValue(control) If CURRENT_RECORD_ID = 0 Then Exit Sub End If ' Da wir beim Klick auf Hinzfügen einen Record anlegen, ' muss UpdateMultipleValues auch aufgerufen werden, wenn wir IsInsert = True ist 'If CtrlCommandUI.IsInsert = False Then ClassControlCommandsUI.UpdateMultipleValues(controlId, CURRENT_RECORD_ID, CONTROL_VALUE) 'End If Dim SQL1 As String = String.Format("SELECT * FROM VWPMO_VALUES WHERE RECORD_ID = {0}", CURRENT_RECORD_ID) Dim DT_ControlValues As DataTable = ClassDatabase.Return_Datatable(SQL1, "LoadControlValues") CURRENT_CONTROL_VALUES = DT_ControlValues Dim datatable As DataTable = ClassDatabase.Return_Datatable(SQL) Dim datatable1 As DataTable = ClassDatabase.Return_Datatable(SQLenable) Depending_Controls(control, datatable, CONTROL_VALUE) If IsNothing(CONTROL_VALUE) Then Exit Sub End If Enable_Controls(control, datatable1, CONTROL_VALUE) Dim values = New List(Of Object)(CONTROL_VALUE.Split(";").ToArray()) 'Jetzt noch die checked Items setzen ' ClassControlValues.LoadControlValue(CURRENT_RECORD_ID, CURRENT_PARENT_ID, controlId, control, values, 99) Catch ex As Exception If ex.Message.Contains("Objektverweis") Or ex.Message.Contains("reference not set") Then Else MsgBox("Error in OnCheckedChanged - " & CONTROL_ID.ToString & ": " & ex.Message, MsgBoxStyle.Critical) End If End Try End Sub Public Sub CheckBoxChanged(sender As Object, ByVal e As EventArgs) If CURRENT_RECORD_ENABLED = False Then Exit Sub Try Dim control As Control = DirectCast(sender, Control) Dim controlId As Integer = DirectCast(control.Tag, ClassControlMetadata).Id CONTROL_ID = controlId Dim checkstate 'SQL für enable control Dim SQLenable As String = String.Format("SELECT GUID, SQL_COMMAND_2 FROM TBPMO_CONTROL WHERE SQL_COMMAND_2 LIKE '%@{0}@%'", controlId) Try ' Den CheckState setzen checkstate = DirectCast(control, CheckBox).Checked Catch ex As Exception Exit Sub End Try If CURRENT_RECORD_ID = 0 And CtrlCommandUI.IsInsert = True Then Exit Sub End If Dim datatable1 As DataTable = ClassDatabase.Return_Datatable(SQLenable) Enable_Controls(control, datatable1, checkstate) 'Dim sqlcommand As String = datatable.Rows(0).Item("SQL_COMMAND_1") 'If IsNothing(sqlcommand) Then ' Exit Sub 'End If 'If String.IsNullOrEmpty(value) Then ' Exit Sub 'End If 'Dim regex As New System.Text.RegularExpressions.Regex("(@(\d+)@)") 'Dim match As System.Text.RegularExpressions.Match = regex.Match(sqlcommand) 'If match.Success Then ' ' DependingControlId bezeichnet das Control, das die Abhängigkeit enthält ' Dim dependingControlId As Integer = datatable.Rows(0).Item("GUID") ' Dim panel As Panel = DirectCast(control.Parent, Panel) ' ' Über die Id das Control finden ' Dim dependingControl As CustomComboBox = panel.Controls.OfType(Of CustomComboBox)().Where(Function(c As CustomComboBox) ' Return DirectCast(c.Tag, ClassControlMetadata).Id = dependingControlId ' End Function).SingleOrDefault() ' sqlcommand = sqlcommand.Replace(match.Groups(1).Value, value) ' Console.WriteLine("Executing SQL_COMMAND: {0}", sqlcommand) ' Dim dt As DataTable = ClassDatabase.Return_Datatable(sqlcommand) ' ControlLoader.Combobox.SetDataSource(dependingControl, dt) 'End If Console.WriteLine("value changed") Catch ex As Exception If ex.Message.Contains("Objektverweis") Or ex.Message.Contains("reference not set") Then Else MsgBox("Error in OnComboBoxValueChanged - " & CONTROL_ID.ToString & ": " & ex.Message, MsgBoxStyle.Critical) End If End Try End Sub ' ================================================================================== ' Mouse Up/Down/Move-Handler für LevelDesigner festlegen ' RecordChanged-Handler für Constructor festlegen ' ================================================================================== Private Sub SetEventHandlers(control As Control) If Not IsNothing(_mouse_down_handler) Then AddHandler control.MouseDown, Me._mouse_down_handler AddHandler control.MouseUp, Me._mouse_up_handler AddHandler control.MouseMove, Me._mouse_move_handler AddHandler control.Click, Me._mouse_click_handler End If Dim type As String = control.GetType().Name Dim eventArgs As New System.EventArgs ' Hover Handler gilt für alle Controls AddHandler control.MouseHover, AddressOf MouseHover Select Case type Case "Label" Dim label As Label = CType(control, Label) AddHandler label.EnabledChanged, AddressOf OnEnabledChanged Case "TextBox" Dim textbox As TextBox = CType(control, TextBox) AddHandler textbox.TextChanged, AddressOf RecordChanged AddHandler textbox.GotFocus, AddressOf OnTextBoxFocus AddHandler textbox.LostFocus, AddressOf OnTextBoxLostFocus AddHandler textbox.TextChanged, AddressOf OnTextBoxTextChanged AddHandler textbox.ReadOnlyChanged, AddressOf OnReadOnlyChanged Case "CustomComboBox" Dim combo As CustomComboBox = CType(control, CustomComboBox) AddHandler combo.SelectedValueChanged, AddressOf RecordChanged AddHandler combo.SelectedValueChanged, AddressOf OnComboBoxValueChanged AddHandler combo.TextChanged, AddressOf RecordChanged 'AddHandler combo.GotFocus, AddressOf OnComboBoxFocus 'AddHandler combo.LostFocus, AddressOf OnComboBoxLostFocus AddHandler combo.EnabledChanged, AddressOf OnEnabledChanged Case "RadioButton" Dim radiobutton As RadioButton = CType(control, RadioButton) AddHandler radiobutton.CheckedChanged, AddressOf RecordChanged AddHandler radiobutton.EnabledChanged, AddressOf OnEnabledChanged Case "CheckBox" Dim checkbox As CheckBox = CType(control, CheckBox) AddHandler checkbox.CheckedChanged, AddressOf RecordChanged AddHandler checkbox.EnabledChanged, AddressOf OnEnabledChanged AddHandler checkbox.CheckedChanged, AddressOf CheckBoxChanged Case "PictureBox" Dim picturebox As PictureBox = CType(control, PictureBox) AddHandler picturebox.BackgroundImageChanged, AddressOf RecordChanged AddHandler picturebox.EnabledChanged, AddressOf OnEnabledChanged Case "DateEdit" Dim datetimepick As DevExpress.XtraEditors.DateEdit = CType(control, DevExpress.XtraEditors.DateEdit) AddHandler datetimepick.DateTimeChanged, AddressOf RecordChanged AddHandler datetimepick.DateTimeChanged, AddressOf OnDateTimeValueChanged AddHandler datetimepick.EnabledChanged, AddressOf OnEnabledChanged Case "ListBoxControl" Dim listbox As DevExpress.XtraEditors.ListBoxControl = CType(control, DevExpress.XtraEditors.ListBoxControl) AddHandler listbox.SelectedValueChanged, AddressOf RecordChanged AddHandler listbox.EnabledChanged, AddressOf OnEnabledChanged Case "CheckedListBoxControl" Dim chklistbox As DevExpress.XtraEditors.CheckedListBoxControl = CType(control, DevExpress.XtraEditors.CheckedListBoxControl) AddHandler chklistbox.ItemCheck, AddressOf RecordChanged AddHandler chklistbox.ItemCheck, AddressOf OnCheckedItemChanged ' AddHandler chklistbox.EnabledChanged, AddressOf OnEnabledChanged Case "DataGridView" Dim gridview As DataGridView = CType(control, DataGridView) AddHandler gridview.RowsAdded, AddressOf RecordChanged AddHandler gridview.CellValueChanged, AddressOf RecordChanged AddHandler gridview.RowsRemoved, AddressOf RecordChanged AddHandler gridview.EnabledChanged, AddressOf OnEnabledChanged Case "GridControl" Dim gridcontrol As DevExpress.XtraGrid.GridControl = CType(control, DevExpress.XtraGrid.GridControl) Dim gridview As DevExpress.XtraGrid.Views.Grid.GridView = gridcontrol.MainView AddHandler gridview.SelectionChanged, AddressOf RecordChanged AddHandler gridview.SelectionChanged, AddressOf OnCheckedChanged AddHandler gridview.CustomDrawColumnHeader, AddressOf OnDrawColumnHeader End Select End Sub Private Sub OnDrawColumnHeader(sender As Object, e As DevExpress.XtraGrid.Views.Grid.ColumnHeaderCustomDrawEventArgs) Console.WriteLine() End Sub Private Sub SetDragDropHandler(groupbox As GroupBox) If Not IsNothing(_group_box_drag_drop_handler) Then AddHandler groupbox.DragDrop, Me._group_box_drag_drop_handler AddHandler groupbox.DragEnter, AddressOf Me.GroupBoxDragEnter End If End Sub Private Sub GroupBoxDragEnter(sender As Object, e As DragEventArgs) ' Check the format of the data being dropped. If (e.Data.GetDataPresent(DataFormats.Text)) Then ' Display the copy cursor. e.Effect = DragDropEffects.Copy Else ' Display the no-drop cursor. e.Effect = DragDropEffects.None End If End Sub Private Sub selectAll_Click(sender As Object, e As EventArgs) Dim item As ToolStripMenuItem = DirectCast(sender, ToolStripMenuItem) Dim menu As ContextMenuStrip = item.Owner Dim chklb As DevExpress.XtraEditors.CheckedListBoxControl = menu.SourceControl chklb.CheckAll() End Sub Private Sub deselectAll_Click(sender As Object, e As EventArgs) Dim item As ToolStripMenuItem = DirectCast(sender, ToolStripMenuItem) Dim menu As ContextMenuStrip = item.Owner Dim chklb As DevExpress.XtraEditors.CheckedListBoxControl = menu.SourceControl chklb.UnCheckAll() End Sub Private Sub itemAdd_Click(sender As Object, e As EventArgs) Dim item As ToolStripMenuItem = DirectCast(sender, ToolStripMenuItem) Dim menu As ContextMenuStrip = item.Owner Dim pb As PictureBox = menu.SourceControl Dim dialog As New OpenFileDialog() dialog.Filter = "Bilddateien|*.png;*.jpg;*.jpeg" If dialog.ShowDialog() = DialogResult.OK Then pb.BackgroundImageLayout = ImageLayout.Zoom pb.BackgroundImage = CType(Drawing.Image.FromFile(dialog.FileName, True), Bitmap) End If End Sub Private Sub itemDel_Click(sender As Object, e As EventArgs) Dim item As ToolStripMenuItem = DirectCast(sender, ToolStripMenuItem) Dim menu As ContextMenuStrip = item.Owner Dim pb As PictureBox = menu.SourceControl Dim answer = MessageBox.Show("Wollen sie dieses Bild wirklich löschen?", "Bild löschen", MessageBoxButtons.YesNo) If answer = DialogResult.Yes Then pb.BackgroundImage = Nothing End If End Sub Private Sub itemSave_Click(sender As Object, e As EventArgs) Dim item As ToolStripMenuItem = DirectCast(sender, ToolStripMenuItem) Dim menu As ContextMenuStrip = item.Owner Dim pb As PictureBox = menu.SourceControl If IsNothing(pb.BackgroundImage) Then MsgBox("Kein Bild ausgewählt!", MsgBoxStyle.Exclamation) Exit Sub End If Dim dialog As New SaveFileDialog() dialog.Filter = "PNG-Bilddateien|*.png|JPEG-Bilddateien|*.jpg" Try If dialog.ShowDialog() = DialogResult.OK Then Dim filename As String = dialog.FileName Dim ext As String = System.IO.Path.GetExtension(filename) Select Case ext Case ".png" pb.BackgroundImage.Save(filename, System.Drawing.Imaging.ImageFormat.Png) Case ".jpg" pb.BackgroundImage.Save(filename, System.Drawing.Imaging.ImageFormat.Jpeg) End Select End If Catch ex As Exception MsgBox("Fehler beim Speichern des Bildes:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub ' +++ Panel Interaction +++ Private Sub AddToPanel(control As Control) _master_panel.Controls.Add(control) End Sub ' +++ GroupBox Interaction +++ Private Sub AddToGroupBox(Parent As GroupBox, Child As Control) Parent.Controls.Add(Child) End Sub Private Sub RemoveFromPanel(control As Control) Dim controls As Control.ControlCollection = Me._master_panel.Controls controls.Remove(control) End Sub ' +++ Constructor +++ Public Sub New(MasterPanel As Panel, MouseDownHandler As MouseEventHandler, MouseUpHandler As MouseEventHandler, MouseMoveHandler As MouseEventHandler, MouseClickHandler As EventHandler, GroupBoxDragDropHandler As DragEventHandler) Me._master_panel = MasterPanel Me._mouse_down_handler = MouseDownHandler Me._mouse_up_handler = MouseUpHandler Me._mouse_move_handler = MouseMoveHandler Me._mouse_click_handler = MouseClickHandler Me._group_box_drag_drop_handler = GroupBoxDragDropHandler End Sub Public Sub New(MasterPanel As Panel) Me._master_panel = MasterPanel End Sub ' +++ Public Properties +++ Public Property CurrentControl As Control Get Return Me._current_control End Get Set(control As Control) Me._current_control = control End Set End Property Public Property BeginLocation As Point Get Return _begin_location End Get Set(value As Point) _begin_location = value End Set End Property Public Property EndLocation As Point Get Return _end_location End Get Set(value As Point) _end_location = value End Set End Property Public ReadOnly Property AllControls As Control.ControlCollection Get Return _master_panel.Controls End Get End Property Public ReadOnly Property MasterPanel As Panel Get Return _master_panel End Get End Property ' ========================= ' Textbox Format Handlers ' ========================= Private Sub AddTextHandler(control As TextBox, format As String) If format = "Currency" Then AddHandler control.Leave, AddressOf Textbox_Currency_Handler ElseIf format = "Decimal" Then AddHandler control.Leave, AddressOf TextBox_Decimal_Handler End If End Sub Private Sub AddComboHandler(control As CustomComboBox, format As String) If format = "Currency" Then AddHandler control.Leave, AddressOf Combo_Currency_Handler ElseIf format = "Decimal" Then AddHandler control.Leave, AddressOf Combo_Decimal_Handler End If AddHandler control.KeyUp, AddressOf AutoCompleteCombo_KeyUp End Sub Public Function IsValidCurrency(currencyValue As String) As Boolean Dim pattern As String = "\p{Sc}+\s*\d+" Dim currencyRegex As New Regex(pattern) Return currencyRegex.IsMatch(currencyValue) End Function Private Sub Textbox_Currency_Handler(sender As Object, e As EventArgs) Dim control As TextBox = DirectCast(sender, TextBox) If control.Text <> "" Then Dim controlvalue = control.Text If controlvalue.Contains(".") Then controlvalue = controlvalue.Replace(".", ",") End If Dim value As Double If Double.TryParse(controlvalue, Globalization.NumberStyles.Currency, Nothing, value) Then 'Valid. control.Text = value.ToString("c"c) Else 'Invalid. MessageBox.Show("Please enter a valid curreny amount.") control.Focus() control.SelectAll() End If End If 'Dim i = IsValidCurrency(control.Text) 'If IsValidCurrency(control.Text) = False Then ' MsgBox("Sorry but some input characters are invalid for the format currency!", MsgBoxStyle.Exclamation) ' control.Focus() ' control.SelectAll() 'End If 'Dim currencyRegex = New System.Text.RegularExpressions.Regex("[0-9,\.]*") 'Dim match = currencyRegex.Match(control.Text) 'If match.Success Then 'End If 'If Decimal.TryParse(control.Text.Trim(), value) Then ' 'control.Text = value.ToString("c") ' 'control.SelectionStart = control.SelectionStart + 1 ' 'control.Text = FormatCurrency(control.Text) ' 'value = FormatNumber(value, -1, TriState.UseDefault, TriState.UseDefault, TriState.True) ' 'control.Text = value.ToString("n") 'End If End Sub Private Sub TextBox_Decimal_Handler(sender As Object, e As EventArgs) Dim control As TextBox = DirectCast(sender, TextBox) Dim value As Decimal If Decimal.TryParse(control.Text.Trim(), value) Then control.Text = value.ToString("###,###") End If End Sub Private Sub Combo_Currency_Handler(sender As Object, e As EventArgs) Dim control As CustomComboBox = DirectCast(sender, CustomComboBox) Dim value As Decimal If Decimal.TryParse(control.Text.Trim(), value) Then control.Text = value.ToString("c") control.SelectionStart = control.SelectionStart + 1 'value = FormatNumber(value, -1, TriState.UseDefault, TriState.UseDefault, TriState.True) 'control.Text = value.ToString("n") End If End Sub Private Sub Combo_Decimal_Handler(sender As Object, e As EventArgs) Dim control As CustomComboBox = DirectCast(sender, CustomComboBox) Dim value As Decimal If Decimal.TryParse(control.Text.Trim(), value) Then control.Text = value.ToString("###,###") End If End Sub ' +++ Public Helper Methods +++ Public Function GetCursorPosition() As Point Return Me._master_panel.PointToClient(Cursor.Position) End Function Public Function GetControlByName(name As String) For Each c In _master_panel.Controls If c.name = name Then Return c End If Next Return Nothing End Function Public Sub SetActiveColor(ActiveControl As Control) Dim ActiveColor As Color = Color.DarkOrange Dim CurrentType As String = ActiveControl.GetType().Name Select Case CurrentType Case "TextBox" ActiveControl.BackColor = ActiveColor Case "CustomComboBox" 'Case "System.Windows.Forms.ComboBox" ActiveControl.BackColor = ActiveColor Case "Label" ActiveControl.BackColor = ActiveColor Case "CheckBox" ActiveControl.BackColor = ActiveColor Case "Button" ActiveControl.BackColor = ActiveColor Case "DataGridView" Dim current As DataGridView = DirectCast(ActiveControl, DataGridView) current.BackgroundColor = ActiveColor Case "DateEdit" ActiveControl.BackColor = ActiveColor Case "GroupBox" ActiveControl.BackColor = ActiveColor Case "PictureBox" ActiveControl.BackColor = ActiveColor Case "CheckedListBoxControl" ActiveControl.BackColor = ActiveColor Case "ListBoxControl" ActiveControl.BackColor = ActiveColor End Select End Sub Public Sub ResetActiveColor(ActiveControl As Control) For Each inctrl As Control In Me._master_panel.Controls If inctrl.Name <> ActiveControl.Name Then Dim Type As String = inctrl.GetType().Name Select Case Type Case "TextBox" inctrl.BackColor = Color.White Case "CustomComboBox" 'Case "System.Windows.Forms.ComboBox" inctrl.BackColor = Color.White Case "Label" inctrl.BackColor = Color.Transparent Case "CheckBox" inctrl.BackColor = Color.Transparent Case "DataGridView" Dim ctrl As DataGridView = DirectCast(inctrl, DataGridView) ctrl.BackgroundColor = SystemColors.ControlDark Case "DateEdit" inctrl.BackColor = Color.White Case "Button" inctrl.BackColor = SystemColors.Control Case "GroupBox" inctrl.BackColor = SystemColors.Control Case "CheckedListBoxControl" inctrl.BackColor = Color.White Case "ListBoxControl" inctrl.BackColor = Color.White Case "PictureBox" inctrl.BackColor = SystemColors.ControlDark For Each gbctrl As Control In inctrl.Controls If gbctrl.Name <> ActiveControl.Name Then Dim gbType As String = gbctrl.GetType.ToString Select Case gbType Case "TextBox" gbctrl.BackColor = Color.White Case "CustomComboBox" 'Case "System.Windows.Forms.ComboBox" gbctrl.BackColor = Color.White Case "Label" gbctrl.BackColor = Color.Transparent Case "CheckBox" gbctrl.BackColor = Color.Transparent Case "DataGridView" Dim ctrl As DataGridView = DirectCast(gbctrl, DataGridView) ctrl.BackgroundColor = SystemColors.ControlDark Case "DateEdit" gbctrl.BackColor = Color.White Case "Button" gbctrl.BackColor = SystemColors.Control Case "PictureBox" inctrl.BackColor = SystemColors.ControlDark Case "CheckedListBoxControl" inctrl.BackColor = Color.White Case "ListBoxControl" inctrl.BackColor = Color.White End Select End If Next End Select End If Next End Sub Public Sub SetAllActiveColor() SetActiveColor(_current_control) ' Remove Active Color from all other Controls ResetActiveColor(_current_control) End Sub ' +++ Public Methods +++ Public Sub ClearControls() Me._master_panel.Controls.Clear() End Sub Public Sub RemoveControl(name As String) For Each ctrl As Control In Me._master_panel.Controls If (name = ctrl.Name) Then Me._master_panel.Controls.Remove(ctrl) Exit Sub End If Next End Sub Public Sub AddLabel(id As Integer, name As String, text As String, x As Integer, y As Integer, fontfamily As String, fontcolor As Integer, fontsize As Integer, fontstyle As Integer, sqlcommand As String, _new As Boolean, Optional parent As GroupBox = Nothing, Optional _designMode As Boolean = False) Try Dim control As Label = New Label Dim defaultSize As Size = New Size(200, 27) Dim metadata As New ClassControlMetadata() metadata.Id = id metadata.Name = name control.Tag = metadata control.Name = name control.Text = text control.Font = New Font(fontfamily, fontsize, CType(fontstyle, FontStyle)) control.ForeColor = IntToColor(fontcolor) control.AutoSize = True If _new And IsNothing(parent) Then control.Location = Me.GetCursorPosition() control.Size = defaultSize ElseIf _new And Not IsNothing(parent) Then Dim cursor = Me.GetCursorPosition() control.Location = New Point(cursor.X - parent.Location.X, cursor.Y - parent.Location.Y) Else control.Location = New Point(x, y) control.Size = defaultSize End If If _designMode = True Then control.Cursor = Cursors.Hand End If 'SQL-Command vorhanden also Ausführen des SQL If sqlcommand.Length > 1 Then Dim result If sqlcommand.Contains("@RECORD_ID") Or sqlcommand.Contains("@RECORDID") Or sqlcommand.Contains("@ENTITY_ID") Or sqlcommand.Contains("@PARENTRECORD_ID") Or sqlcommand.Contains("@PARENTRECORDID") Then result = Nothing Else result = ClassDatabase.Execute_Scalar(sqlcommand, True) End If If Not IsNothing(result) Then If Not IsDBNull(result) Then If Not IsNothing(result) Then control.Text = result.ToString End If End If End If End If Me.SetEventHandlers(control) Me.CurrentControl = DirectCast(control, Label) If Not IsNothing(parent) Then control.Parent = parent Me.AddToGroupBox(parent, control) Else control.Parent = _master_panel Me.AddToPanel(control) End If Catch ex As Exception MsgBox("Error in AddLabel: " + vbNewLine + ex.Message) End Try End Sub Public Sub AddTextBox(id As Integer, name As String, x As Integer, y As Integer, fontfamily As String, fontcolor As Integer, fontsize As Integer, fontstyle As Integer, tabindex As Integer, tabstop As Integer, vwidth As Integer, vheight As Integer, multiline As Boolean, read_only As Boolean, required As Boolean, format As String, _new As Boolean, Optional parent As GroupBox = Nothing, Optional _designMode As Boolean = False) Try Dim control As New TextBox Dim defaultSize As Size = New Size(200, 27) Dim metadata As New ClassControlMetadata() metadata.Id = id metadata.Name = name metadata.Required = required control.Tag = metadata control.Name = name control.Font = New Font(fontfamily, fontsize, CType(fontstyle, FontStyle)) control.ForeColor = IntToColor(fontcolor) control.TabIndex = tabindex control.TabStop = tabstop control.BorderStyle = BorderStyle.FixedSingle control.ReadOnly = read_only AddTextHandler(DirectCast(control, Control), format) 'Console.WriteLine("setting tabindex of control " & name & " to " & tabindex) If multiline = True Then control.Multiline = True control.AcceptsReturn = True control.AcceptsTab = True control.ScrollBars = ScrollBars.Vertical End If If _new And IsNothing(parent) Then control.Location = Me.GetCursorPosition() control.Size = defaultSize ElseIf _new And Not IsNothing(parent) Then Dim cursor = Me.GetCursorPosition() control.Location = New Point(cursor.X - parent.Location.X, cursor.Y - parent.Location.Y) Else control.Location = New Point(x, y) control.Size = New Size(vwidth, vheight) End If If _designMode = True Then control.Cursor = Cursors.Hand End If If Not read_only Or _designMode Then Me.SetEventHandlers(control) End If Me.CurrentControl = DirectCast(control, TextBox) If Not IsNothing(parent) Then control.Parent = parent Me.AddToGroupBox(parent, control) Else control.Parent = _master_panel Me.AddToPanel(control) End If Catch ex As Exception MsgBox("Error in AddTextBox: " + vbNewLine + ex.Message) End Try End Sub Public Sub AddCheckBox(id As Integer, name As String, text As String, Checked As Boolean, x As Integer, y As Integer, fontfamily As String, fontcolor As Integer, fontsize As Integer, fontstyle As Integer, tabindex As Integer, tabstop As Boolean, vwidth As Integer, vheight As Integer, _new As Boolean, read_only As Boolean, required As Boolean, Optional parent As GroupBox = Nothing, Optional _designMode As Boolean = False) Try Dim control As New CheckBox Dim defaultSize As Size = New Size(150, 27) Dim metadata As New ClassControlMetadata() metadata.Id = id metadata.Name = name metadata.Required = required control.Tag = metadata control.Checked = Checked control.Name = name control.Font = New Font(fontfamily, fontsize, CType(fontstyle, FontStyle)) control.ForeColor = IntToColor(fontcolor) control.Text = text control.TabIndex = tabindex control.TabStop = tabstop control.AutoCheck = True If _designMode = True Then control.AutoCheck = False control.Cursor = Cursors.Hand Else control.AutoCheck = True End If If Not _designMode And read_only Then control.Enabled = Not read_only End If If _new And IsNothing(parent) Then control.Location = Me.GetCursorPosition() control.Size = defaultSize ElseIf _new And Not IsNothing(parent) Then Dim cursor = Me.GetCursorPosition() control.Location = New Point(cursor.X - parent.Location.X, cursor.Y - parent.Location.Y) Else control.Location = New Point(x, y) control.Size = New Size(vwidth, vheight) End If Me.SetEventHandlers(control) Me.CurrentControl = DirectCast(control, CheckBox) If Not IsNothing(parent) Then control.Parent = parent Me.AddToGroupBox(parent, control) Else control.Parent = _master_panel Me.AddToPanel(control) End If Catch ex As Exception MsgBox("Error in AddCheckBox: " + vbNewLine + ex.Message) End Try End Sub Public Sub AddRadioButton(id As Integer, name As String, text As String, Checked As Boolean, x As Integer, y As Integer, fontfamily As String, fontcolor As Integer, fontsize As Integer, fontstyle As Integer, tabindex As Integer, tabstop As Boolean, vwidth As Integer, vheight As Integer, _new As Boolean, read_only As Boolean, required As Boolean, Optional parent As GroupBox = Nothing, Optional _designMode As Boolean = False) Try Dim control As New RadioButton Dim defaultSize As Size = New Size(150, 27) Dim metadata As New ClassControlMetadata() metadata.Id = id metadata.Name = name metadata.Required = required control.Tag = metadata control.Name = name control.Font = New Font(fontfamily, fontsize, CType(fontstyle, FontStyle)) control.ForeColor = IntToColor(fontcolor) control.Text = text control.TabIndex = tabindex control.TabStop = tabstop control.AutoCheck = True control.Checked = Checked If _new And IsNothing(parent) Then control.Location = Me.GetCursorPosition() control.Size = defaultSize ElseIf _new And Not IsNothing(parent) Then Dim cursor = Me.GetCursorPosition() control.Location = New Point(cursor.X - parent.Location.X, cursor.Y - parent.Location.Y) Else control.Location = New Point(x, y) control.Size = New Size(vwidth, vheight) End If If Not _designMode And read_only Then control.Enabled = Not read_only End If If _designMode = True Then control.Cursor = Cursors.Hand End If Me.SetEventHandlers(control) Me.CurrentControl = DirectCast(control, RadioButton) If Not IsNothing(parent) Then control.Parent = parent Me.AddToGroupBox(parent, control) Else control.Parent = _master_panel Me.AddToPanel(control) End If Catch ex As Exception MsgBox("Error in AddRadioButton: " + vbNewLine + ex.Message) End Try End Sub Public Sub AddComboBox(id As Integer, name As String, x As Integer, y As Integer, fontfamily As String, fontcolor As Integer, fontsize As Integer, fontstyle As Integer, tabindex As Integer, tabstop As Boolean, vwidth As Integer, vheight As Integer, vformat As String, _new As Boolean, read_only As Boolean, required As Boolean, static_list As String, sqlcommand As String, Optional parent As GroupBox = Nothing, Optional _designMode As Boolean = False) Try Dim _control As New ComboBox Dim control As New CustomComboBox Dim defaultSize As Size = New Size(120, 24) Dim metadata As New ClassControlMetadata() metadata.Id = id metadata.Name = name metadata.Required = required control.Tag = metadata control.Name = name control.Font = New Font(fontfamily, fontsize, CType(fontstyle, FontStyle)) control.ForeColor = IntToColor(fontcolor) control.TabIndex = tabindex control.TabStop = tabstop control.Parent = _master_panel control.DropDownStyle = ComboBoxStyle.DropDown control.FormattingEnabled = True control.AutoCompleteMode = AutoCompleteMode.Append control.AutoCompleteSource = AutoCompleteSource.ListItems If (Not _designMode And read_only) Then control.Enabled = Not read_only End If AddComboHandler(control, vformat) If _new And IsNothing(parent) Then control.Location = Me.GetCursorPosition() control.Size = defaultSize ElseIf _new And Not IsNothing(parent) Then Dim cursor = Me.GetCursorPosition() control.Location = New Point(cursor.X - parent.Location.X, cursor.Y - parent.Location.Y) Else control.Location = New Point(x, y) control.Size = New Size(vwidth, vheight) End If ' Wenn statische liste vorhanden, werte splitten und einfügen If static_list.Length > 0 Then Dim items() As String = static_list.Split(";") For Each item As String In items control.Items.Add(item) Next End If Me.SetEventHandlers(control) Me.CurrentControl = DirectCast(control, CustomComboBox) If Not IsNothing(parent) Then control.Parent = parent Me.AddToGroupBox(parent, control) Else control.Parent = _master_panel Me.AddToPanel(control) End If Catch ex As Exception MsgBox("Error in AddComboBox: " + vbNewLine + ex.Message) End Try End Sub Public Sub AutoCompleteCombo_KeyUp(ByVal cbo As CustomComboBox, ByVal e As KeyEventArgs) ''Allow select keys without Autocompleting Select Case e.KeyCode Case Keys.Back, Keys.Left, Keys.Right, Keys.Up, Keys.Delete, Keys.Down Return End Select Dim iFoundIndex As Integer iFoundIndex = cbo.FindStringExact(cbo.Text) 'cbo.SelectedIndex = iFoundIndex 'Dim sTypedText As String 'Dim iFoundIndex As Integer 'Dim oFoundItem As Object 'Dim sFoundText As String 'Dim sAppendText As String ''Get the Typed Text and Find it in the list 'sTypedText = cbo.Text 'iFoundIndex = cbo.FindString(sTypedText) ''If we found the Typed Text in the list then Autocomplete 'If iFoundIndex >= 0 Then ' 'Get the Item from the list (Return Type depends if Datasource was bound ' ' or List Created) ' oFoundItem = cbo.Items(iFoundIndex) ' 'Use the ListControl.GetItemText to resolve the Name in case the Combo ' ' was Data bound ' sFoundText = cbo.GetItemText(oFoundItem) ' 'Append then found text to the typed text to preserve case ' sAppendText = sFoundText.Substring(sTypedText.Length) ' cbo.Text = sTypedText & sAppendText ' 'Select the Appended Text ' cbo.SelectionStart = sTypedText.Length ' cbo.SelectionLength = sAppendText.Length 'End If End Sub Public Sub AutoCompleteCombo_Leave(ByVal cbo As CustomComboBox) Dim iFoundIndex As Integer iFoundIndex = cbo.FindStringExact(cbo.Text) cbo.SelectedIndex = iFoundIndex End Sub Public Sub AddDateTimePicker(id As Integer, name As String, x As Integer, y As Integer, fontfamily As String, fontsize As Integer, fontstyle As Integer, tabindex As Integer, tabstop As Boolean, vwidth As Integer, vheight As Integer, read_only As Boolean, required As Boolean, _new As Boolean, Optional parent As GroupBox = Nothing, Optional _designMode As Boolean = False) Try Dim control As New DevExpress.XtraEditors.DateEdit 'Dim control As New DateTimePicker Dim defaultSize As Size = New Size(90, 20) Dim metadata As New ClassControlMetadata() metadata.Id = id metadata.Name = name metadata.Required = required control.Tag = metadata control.Name = name 'control.Format = DateTimePickerFormat.Short 'control.Font = New Font(fontfamily, fontsize, CType(fontstyle, FontStyle)) 'control.CalendarFont = New Font(fontfamily, fontsize, CType(fontstyle, FontStyle)) control.Font = New Font(fontfamily, fontsize, CType(fontstyle, FontStyle)) control.TabIndex = tabindex control.TabStop = tabstop control.Parent = _master_panel control.Properties.NullDate = DateTime.MinValue control.Properties.NullText = String.Empty control.Properties.ReadOnly = read_only If _new And IsNothing(parent) Then control.Location = Me.GetCursorPosition() control.Size = defaultSize ElseIf _new And Not IsNothing(parent) Then Dim cursor = Me.GetCursorPosition() control.Location = New Point(cursor.X - parent.Location.X, cursor.Y - parent.Location.Y) Else control.Location = New Point(x, y) control.Size = New Size(vwidth, vheight) End If If Not read_only Or _designMode Then Me.SetEventHandlers(control) End If 'Me.CurrentControl = DirectCast(control, DateTimePicker) Me.CurrentControl = DirectCast(control, DevExpress.XtraEditors.DateEdit) If Not IsNothing(parent) Then control.Parent = parent Me.AddToGroupBox(parent, control) Else control.Parent = _master_panel Me.AddToPanel(control) End If Catch ex As Exception MsgBox("Error in AddDateTimePicker: " + vbNewLine + ex.Message) End Try End Sub Public Sub AddDataGridView(id As Integer, name As String, x As Integer, y As Integer, vwidth As Integer, vheight As Integer, _new As Boolean, read_only As Boolean, required As Boolean, columnTitle As String, Optional parent As GroupBox = Nothing, Optional _designMode As Boolean = False) Dim control As New DataGridView Dim column As New DataGridViewTextBoxColumn Dim defaultSize = New Size(130, 150) Dim metadata As New ClassControlMetadata() metadata.Id = id metadata.Name = name metadata.Required = required control.Tag = metadata control.Name = name control.BackgroundColor = SystemColors.ControlDark control.AllowUserToAddRows = True control.AllowUserToDeleteRows = True control.AllowUserToResizeColumns = False control.AllowUserToResizeRows = False control.Parent = _master_panel control.ReadOnly = read_only column.HeaderText = columnTitle column.Name = "column1" control.Columns.Add(column) If _new And IsNothing(parent) Then control.Location = Me.GetCursorPosition() control.Size = defaultSize ElseIf _new And Not IsNothing(parent) Then Dim cursor = Me.GetCursorPosition() control.Location = New Point(cursor.X - parent.Location.X, cursor.Y - parent.Location.Y) Else control.Location = New Point(x, y) control.Size = New Size(vwidth, vheight) End If If _designMode = True Then control.Cursor = Cursors.Hand End If Me.SetEventHandlers(control) Me.CurrentControl = DirectCast(control, DataGridView) If Not IsNothing(parent) Then control.Parent = parent Me.AddToGroupBox(parent, control) Else control.Parent = _master_panel Me.AddToPanel(control) End If End Sub Public Sub AddDataGridViewCheckable(id As Integer, name As String, x As Integer, y As Integer, vwidth As Integer, vheight As Integer, _new As Boolean, tabindex As Integer, tabstop As Boolean, read_only As Boolean, required As Boolean, columnTitle As String, Optional parent As GroupBox = Nothing, Optional _designMode As Boolean = False) Dim control As New DevExpress.XtraGrid.GridControl Dim gridview As New DevExpress.XtraGrid.Views.Grid.GridView control.MainView = gridview Dim defaultSize = New Size(200, 150) gridview.OptionsView.ShowGroupPanel = False gridview.OptionsView.EnableAppearanceEvenRow = True gridview.Appearance.EvenRow.BackColor = Color.Aqua gridview.OptionsSelection.MultiSelect = True gridview.OptionsSelection.MultiSelectMode = DevExpress.XtraGrid.Views.Grid.GridMultiSelectMode.CheckBoxRowSelect gridview.OptionsSelection.CheckBoxSelectorColumnWidth = 30 If Not _designMode Then ' Filter funktioniert nicht mit den MouseEvents des LevelDesigners gridview.OptionsView.ShowAutoFilterRow = True End If If _designMode Then Dim DataColumn = gridview.Columns.Add() DataColumn.Caption = "Data" DataColumn.FieldName = "DATA" 'DataColumn.UnboundType = DevExpress.Data.UnboundColumnType.Object DataColumn.Visible = True gridview.OptionsBehavior.ReadOnly = True gridview.OptionsBehavior.Editable = False ' Beispieldaten hinzufügen Dim dt As New DataTable dt.Columns.Add(DataColumn.FieldName) Dim row1 As DataRow = dt.NewRow() row1.Item(DataColumn.FieldName) = "Datensatz 1" dt.Rows.Add(row1) Dim row2 As DataRow = dt.NewRow() row2.Item(DataColumn.FieldName) = "Datensatz 2" dt.Rows.Add(row2) control.DataSource = dt End If Dim metadata As New ClassControlMetadata() metadata.Id = id metadata.Name = name metadata.Required = required control.Tag = metadata control.Name = name control.Parent = _master_panel If _new And IsNothing(parent) Then control.Location = Me.GetCursorPosition() control.Size = defaultSize ElseIf _new And Not IsNothing(parent) Then Dim cursor = Me.GetCursorPosition() control.Location = New Point(cursor.X - parent.Location.X, cursor.Y - parent.Location.Y) Else control.Location = New Point(x, y) control.Size = New Size(vwidth, vheight) End If If _designMode = True Then control.Cursor = Cursors.Hand End If Me.SetEventHandlers(control) Me.CurrentControl = DirectCast(control, DevExpress.XtraGrid.GridControl) If Not IsNothing(parent) Then control.Parent = parent Me.AddToGroupBox(parent, control) Else control.Parent = _master_panel Me.AddToPanel(control) End If End Sub Public Sub AddPictureBox(id As Integer, name As String, x As Integer, y As Integer, vwidth As Integer, vheight As Integer, _new As Boolean, read_only As Boolean, required As Boolean, Optional parent As GroupBox = Nothing, Optional _designMode As Boolean = False) Dim control As New PictureBox Dim defaultSize = New Size(200, 100) Dim ctx As New ContextMenuStrip() Dim itemAdd As New ToolStripMenuItem() Dim itemDel As New ToolStripMenuItem() Dim itemSave As New ToolStripMenuItem() itemAdd.Text = "Bild auswählen.." itemDel.Text = "Bild löschen" itemSave.Text = "Bild speichern unter.." AddHandler itemAdd.Click, AddressOf itemAdd_Click AddHandler itemDel.Click, AddressOf itemDel_Click AddHandler itemSave.Click, AddressOf itemSave_Click 'Nur bei ReadOnly alle Auswahlmöglichkeiten If read_only = False Then ctx.Items.Add(itemAdd) ctx.Items.Add(itemDel) End If ctx.Items.Add(itemSave) Dim metadata As New ClassControlMetadata() metadata.Id = id metadata.Name = name metadata.Required = required control.Tag = metadata control.Name = name control.Parent = _master_panel control.BorderStyle = BorderStyle.FixedSingle control.ContextMenuStrip = ctx control.BackgroundImage = My.Resources.ImageListControl_683 control.BackgroundImageLayout = ImageLayout.Zoom If _new And IsNothing(parent) Then control.Location = Me.GetCursorPosition() control.Size = defaultSize ElseIf _new And Not IsNothing(parent) Then Dim cursor = Me.GetCursorPosition() control.Location = New Point(cursor.X - parent.Location.X, cursor.Y - parent.Location.Y) Else control.Location = New Point(x, y) control.Size = New Size(vwidth, vheight) End If If _designMode = True Then control.Cursor = Cursors.Hand End If Me.SetEventHandlers(control) Me.CurrentControl = DirectCast(control, PictureBox) If Not IsNothing(parent) Then control.Parent = parent Me.AddToGroupBox(parent, control) Else control.Parent = _master_panel Me.AddToPanel(control) End If End Sub Public Sub AddGroupBox(id As Integer, name As String, Caption As String, x As Integer, y As Integer, vwidth As Integer, vheight As Integer, backcolor As Integer, fontcolor As Integer, fontfamily As String, fontsize As Integer, fontstyle As Integer, _new As Boolean, Optional parent As GroupBox = Nothing, Optional _designMode As Boolean = False) Dim control As New GroupBox Dim defaultSize = New Size(200, 100) Dim metadata As New ClassControlMetadata() metadata.Id = id metadata.Name = name control.Tag = metadata control.Name = name control.Parent = _master_panel control.Text = Caption 'control.Font = New Font(fontfamily, fontsize, CType(fontstyle, FontStyle)) control.ForeColor = IntToColor(fontcolor) control.BackColor = IntToColor(backcolor) If _new And IsNothing(parent) Then control.Location = Me.GetCursorPosition() control.Size = defaultSize ElseIf _new And Not IsNothing(parent) Then Dim cursor = Me.GetCursorPosition() control.Location = New Point(cursor.X - parent.Location.X, cursor.Y - parent.Location.Y) Else control.Location = New Point(x, y) control.Size = New Size(vwidth, vheight) End If If _designMode = True Then control.Cursor = Cursors.Hand End If control.AllowDrop = True Me.SetEventHandlers(control) Me.SetDragDropHandler(control) Me.CurrentControl = DirectCast(control, GroupBox) If Not IsNothing(parent) Then control.Parent = parent Me.AddToGroupBox(parent, control) Else control.Parent = _master_panel Me.AddToPanel(control) End If End Sub Public Sub FunctionAddAppointment(id As Integer, name As String, text As String, x As Integer, y As Integer, vwidth As Integer, vheight As Integer, _new As Boolean, Optional parent As GroupBox = Nothing, Optional _designMode As Boolean = False) Try Dim control As Button = New Button Dim defaultSize As Size = New Size(200, 27) Dim metadata As New ClassControlMetadata() metadata.Id = id metadata.Name = name control.Tag = metadata control.Name = name control.Text = text control.TabStop = False control.Image = My.Resources.calendar_add control.ImageAlign = ContentAlignment.MiddleRight control.TextAlign = ContentAlignment.MiddleLeft If _new And IsNothing(parent) Then control.Location = Me.GetCursorPosition() control.Size = defaultSize ElseIf _new And Not IsNothing(parent) Then Dim cursor = Me.GetCursorPosition() control.Location = New Point(cursor.X - parent.Location.X, cursor.Y - parent.Location.Y) Else control.Location = New Point(x, y) control.Size = New Size(vwidth, vheight) End If If _designMode = True Then control.Cursor = Cursors.Hand End If Me.SetEventHandlers(control) Me.CurrentControl = DirectCast(control, Button) If Not IsNothing(parent) Then control.Parent = parent Me.AddToGroupBox(parent, control) Else control.Parent = _master_panel Me.AddToPanel(control) End If Catch ex As Exception MsgBox("Error in FunctionAddAppointment: " + vbNewLine + ex.Message) End Try End Sub Public Sub FunctionAddFormData(id As Integer, name As String, text As String, x As Integer, y As Integer, vwidth As Integer, vheight As Integer, _new As Boolean, Optional parent As GroupBox = Nothing, Optional _designMode As Boolean = False) Try Dim control As Button = New Button Dim defaultSize As Size = New Size(30, 21) Dim metadata As New ClassControlMetadata() metadata.Id = id metadata.Name = name control.Tag = metadata control.Name = name control.Text = "" control.TabStop = False control.Image = My.Resources.add1 If _new And IsNothing(parent) Then control.Location = Me.GetCursorPosition() control.Size = defaultSize ElseIf _new And Not IsNothing(parent) Then Dim cursor = Me.GetCursorPosition() control.Location = New Point(cursor.X - parent.Location.X, cursor.Y - parent.Location.Y) Else control.Location = New Point(x, y) control.Size = New Size(vwidth, vheight) End If If _designMode = True Then control.Cursor = Cursors.Hand End If Me.SetEventHandlers(control) Me.CurrentControl = DirectCast(control, Button) If Not IsNothing(parent) Then control.Parent = parent Me.AddToGroupBox(parent, control) Else control.Parent = _master_panel Me.AddToPanel(control) End If Catch ex As Exception MsgBox("Fehler: " + vbNewLine + ex.Message) End Try End Sub Public Sub AddCheckedListBox(id As Integer, name As String, x As Integer, y As Integer, fontfamily As String, fontcolor As Integer, fontsize As Integer, fontstyle As Integer, tabindex As Integer, tabstop As Boolean, vwidth As Integer, vheight As Integer, _new As Boolean, read_only As Boolean, required As Boolean, static_list As String, sqlcommand As String, Optional parent As GroupBox = Nothing, Optional _designMode As Boolean = False) Try Dim control As New DevExpress.XtraEditors.CheckedListBoxControl Dim defaultSize As Size = New Size(180, 140) 'control.CheckOnClick = True ' control.CheckStyle = DevExpress.XtraEditors.Controls.CheckStyles.Style3 Dim metadata As New ClassControlMetadata() metadata.Id = id metadata.Name = name metadata.Required = required control.Tag = metadata control.Name = name control.Font = New Font(fontfamily, fontsize, CType(fontstyle, FontStyle)) control.ForeColor = IntToColor(fontcolor) control.TabIndex = tabindex control.TabStop = tabstop control.Parent = _master_panel 'Bei clicken checken control.CheckOnClick = True If Not _designMode And read_only Then control.Enabled = Not read_only End If Dim ctx As New ContextMenuStrip() Dim selectAll As New ToolStripMenuItem() Dim deselectAll As New ToolStripMenuItem() selectAll.Text = "Select all" deselectAll.Text = "Deselect all" AddHandler selectAll.Click, AddressOf selectAll_Click AddHandler deselectAll.Click, AddressOf deselectAll_Click ctx.Items.Add(selectAll) ctx.Items.Add(deselectAll) control.ContextMenuStrip = ctx If _new And IsNothing(parent) Then control.Location = Me.GetCursorPosition() control.Size = defaultSize ElseIf _new And Not IsNothing(parent) Then Dim cursor = Me.GetCursorPosition() control.Location = New Point(cursor.X - parent.Location.X, cursor.Y - parent.Location.Y) Else control.Location = New Point(x, y) control.Size = New Size(vwidth, vheight) End If 'SQL-Command vorhanden? If sqlcommand.Length > 1 Then 'Ja also überprüfen ob parametrisiert?? If Not sqlcommand.ToString.Contains("@") Then 'SQL-Command vorhanden also Ausführen des SQL Dim DT_ListBox As DataTable = ClassDatabase.Return_Datatable(sqlcommand) If DT_ListBox Is Nothing = False Then If DT_ListBox.Rows.Count > 0 Then control.DataSource = DT_ListBox If DT_ListBox.Columns.Count = 1 Then control.DisplayMember = DT_ListBox.Columns(0).ColumnName control.ValueMember = DT_ListBox.Columns(0).ColumnName Else Try control.ValueMember = DT_ListBox.Columns(0).ColumnName control.DisplayMember = DT_ListBox.Columns(1).ColumnName Catch ex As Exception Dim colstring = "" For Each Col As DataColumn In DT_ListBox.Columns colstring = colstring & ";" & Col.ColumnName Next ClassLogger.Add("Error in Binding CheckedListBox: " & ex.Message & " - Columns: " & colstring) control.DisplayMember = DT_ListBox.Columns(0).ColumnName End Try End If End If End If End If End If ' Wenn statische liste vorhanden, werte splitten und einfügen If static_list.Length > 0 Then Dim items() As String = static_list.Split(";") For Each item As String In items control.Items.Add(item) Next End If Me.SetEventHandlers(control) Me.CurrentControl = DirectCast(control, DevExpress.XtraEditors.CheckedListBoxControl) If Not IsNothing(parent) Then control.Parent = parent Me.AddToGroupBox(parent, control) Else control.Parent = _master_panel Me.AddToPanel(control) End If Catch ex As Exception ClassLogger.Add("Unexpected Error in AddCheckedListBox: " & ex.Message) MsgBox("Error in AddCheckedListBox: " + vbNewLine + ex.Message) End Try End Sub Public Sub AddListBox(id As Integer, name As String, x As Integer, y As Integer, fontfamily As String, fontcolor As Integer, fontsize As Integer, fontstyle As Integer, tabindex As Integer, tabstop As Boolean, vwidth As Integer, vheight As Integer, _new As Boolean, read_only As Boolean, required As Boolean, static_list As String, sqlcommand As String, Optional parent As GroupBox = Nothing, Optional _designMode As Boolean = False) Try Dim control As New DevExpress.XtraEditors.ListBoxControl Dim defaultSize As Size = New Size(180, 140) 'control.CheckOnClick = True ' control.CheckStyle = DevExpress.XtraEditors.Controls.CheckStyles.Style3 Dim metadata As New ClassControlMetadata() metadata.Id = id metadata.Name = name metadata.Required = required control.Tag = metadata control.Name = name control.Font = New Font(fontfamily, fontsize, CType(fontstyle, FontStyle)) control.ForeColor = IntToColor(fontcolor) control.TabIndex = tabindex control.TabStop = tabstop control.Parent = _master_panel If Not _designMode And read_only Then control.Enabled = Not read_only End If If _new And IsNothing(parent) Then control.Location = Me.GetCursorPosition() control.Size = defaultSize ElseIf _new And Not IsNothing(parent) Then Dim cursor = Me.GetCursorPosition() control.Location = New Point(cursor.X - parent.Location.X, cursor.Y - parent.Location.Y) Else control.Location = New Point(x, y) control.Size = New Size(vwidth, vheight) End If 'SQL-Command vorhanden also Ausführen des SQL If sqlcommand.Length > 1 Then If Not sqlcommand.ToString.Contains("@") Then 'SQL-Command vorhanden also Ausführen des SQL Dim DT_ListBox As DataTable = ClassDatabase.Return_Datatable(sqlcommand) If DT_ListBox Is Nothing = False Then If DT_ListBox.Rows.Count > 0 Then control.DataSource = DT_ListBox control.DisplayMember = DT_ListBox.Columns(1).ColumnName control.ValueMember = DT_ListBox.Columns(0).ColumnName End If End If End If End If ' Wenn statische liste vorhanden, werte splitten und einfügen If static_list.Length > 0 Then Dim items() As String = static_list.Split(";") For Each item As String In items control.Items.Add(item) Next End If Me.SetEventHandlers(control) Me.CurrentControl = DirectCast(control, DevExpress.XtraEditors.ListBoxControl) If Not IsNothing(parent) Then control.Parent = parent Me.AddToGroupBox(parent, control) Else control.Parent = _master_panel Me.AddToPanel(control) End If Catch ex As Exception MsgBox("Error in AddListBox: " + vbNewLine + ex.Message) End Try End Sub End Class