Imports DevExpress.XtraEditors.Controls Public Class ClassControlValues Public Shared Function ControlHasValue(control As Control) As Boolean Select Case control.GetType() Case GetType(TextBox) Dim textbox As TextBox = DirectCast(control, TextBox) If textbox.Text.Trim() = String.Empty Then Return False Else Return True End If Case GetType(ComboBox) Dim combobox As ComboBox = DirectCast(control, ComboBox) If combobox.Text.Trim() = String.Empty Then Return False Else Return True End If Case GetType(CheckBox) Dim checkbox As CheckBox = DirectCast(control, CheckBox) Return checkbox.Checked Case GetType(RadioButton) Dim radiobutton As RadioButton = DirectCast(control, RadioButton) Return radiobutton.Checked Case GetType(DevExpress.XtraEditors.DateEdit) Dim datepicker As DevExpress.XtraEditors.DateEdit = DirectCast(control, DevExpress.XtraEditors.DateEdit) If IsDBNull(datepicker.EditValue) Then Return False Else Return True End If Case GetType(DevExpress.XtraEditors.ListBoxControl) Dim listbox As DevExpress.XtraEditors.ListBoxControl = DirectCast(control, DevExpress.XtraEditors.ListBoxControl) If listbox.SelectedIndex = -1 Then Return False Else Return True End If Case GetType(DevExpress.XtraEditors.CheckedListBoxControl) Dim checkedlistbox = DirectCast(control, DevExpress.XtraEditors.CheckedListBoxControl) If checkedlistbox.CheckedItemsCount = 0 Then Return False Else Return True End If Case GetType(PictureBox) Dim picturebox = DirectCast(control, PictureBox) If IsNothing(picturebox.BackgroundImage) Then Return False Else Return True End If Case Else Return True End Select End Function ' Überprüft, welche Controls "Required" sind Public Shared Function CheckRequiredControlValues(controls As Control.ControlCollection, Optional isGroupbox As Boolean = False) As List(Of String) Dim missingValues As New List(Of String) 'If isGroupbox = True Then ' Dim radiobuttons As New List(Of RadioButton) ' Dim otherControls As New List(Of Control) ' ' Nach allen Radiobuttons suchen ' For Each c As Control In controls ' If TypeOf c Is RadioButton Then ' radiobuttons.Add(DirectCast(c, RadioButton)) ' Else ' otherControls.Add(c) ' End If ' Next ' ' Wenn mindestens 1 MussFeld-Radiobutton in der Groupbox ' Dim atLeastOneRadioButtonHasRequired = False ' For Each rb As RadioButton In radiobuttons ' If DirectCast(rb.Tag, ClassControlMetadata).Required = True Then ' atLeastOneRadioButtonHasRequired = True ' Exit For ' End If ' Next ' If atLeastOneRadioButtonHasRequired Then ' ' Alle RadioButtons die angeklickt wurden (ist meistens einer :o) ' Dim radioButtonsWithValue = (From rb As RadioButton In radiobuttons ' Where ControlHasValue(rb) ' Select rb.Name).ToArray() ' ' Wenn kein RadioButton angeklickt wurde, nehmen wir alle in einen String, ' ' da GENAU EINER angeklickt werden MUSS ' If radioButtonsWithValue Is Nothing Then ' Dim missingValue As String = String.Join(", ", radiobuttons) ' missingValues.Add(missingValue) ' End If ' End If 'End If For Each Control As Control In controls Dim metadata = DirectCast(Control.Tag, ClassControlMetadata) ' Groupbox muss rekursiv überprüft werden If TypeOf Control Is GroupBox Then Dim groupbox As GroupBox = DirectCast(Control, GroupBox) Dim gbfields As List(Of String) = CheckRequiredControlValues(groupbox.Controls, True) missingValues.AddRange(gbfields) Continue For End If 'Radio Buttons müssen nicht überprüft werden, da eine RadioButton Group 'immer ein Control mit Checked = true hat If TypeOf Control Is RadioButton Then Continue For End If If IsNothing(metadata.Required) OrElse metadata.Required = False Then Continue For End If If Not ControlHasValue(Control) Then missingValues.Add(Control.Name) End If Next Return missingValues.Distinct().ToList() End Function Public Shared Sub LoadControlValues(RecordId As Integer, ParentRecordId As Integer, FormId As Integer, controls As Control.ControlCollection, Entity_ID As Integer) Try 'Dim SQL As String = String.Format("SELECT * FROM VWPMO_VALUES WHERE VALUE <> '' AND RECORD_ID = {0}", RecordId) Dim SQL As String = String.Format("SELECT * FROM VWPMO_VALUES WHERE RECORD_ID = {0}", RecordId) Dim DT_ControlValues As DataTable = ClassDatabase.Return_Datatable(SQL, "LoadControlValues") If controls.Count = 0 Then ClassLogger.Add("the control-Collection in LoadControlValuesNeu is empty!", True) ENTITY_RELOAD_AFT_CONTROL_LOAD = True Exit Sub End If ' Zuerst alle Controls leeren ClearControlValues(controls) ' Load all Hints for controls LoadControlHints(controls) For Each control As Control In controls Dim ControlId As Integer = DirectCast(control.Tag, ClassControlMetadata).Id ' Wert per LINQ aus DT_ControlValues suchen der zur aktuellen controlId passt Dim values As List(Of Object) = (From row In DT_ControlValues.AsEnumerable() Where row.Item("CONTROL_ID") = ControlId Select row.Item("VALUE")).ToList() If TypeOf control Is GroupBox Then Dim groupbox As GroupBox = DirectCast(control, GroupBox) LoadControlValues(RecordId, ParentRecordId, FormId, groupbox.Controls, Entity_ID) Else LoadControlValue(RecordId, ParentRecordId, ControlId, control, values, Entity_ID) End If Next Catch ex As Exception ClassLogger.Add("Unexpected Error in LoadControlValuesNeu: " & ex.Message, True) MsgBox("Error in LoadControlValuesNeu:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub Public Shared Function GetControlValuesREC_CONTROL(RecordId As Integer, CONTROL_ID As Integer) Try 'Dim SQL As String = String.Format("SELECT * FROM VWPMO_VALUES WHERE VALUE <> '' AND RECORD_ID = {0}", RecordId) Dim SQL As String = String.Format("SELECT VALUE FROM VWPMO_VALUES WHERE RECORD_ID = {0} AND CONTROL_ID = {1}", RecordId, CONTROL_ID) Dim RESULT = ClassDatabase.Execute_Scalar(SQL) If IsNothing(RESULT) Then Return Nothing ElseIf RESULT = "" Then Return Nothing Else Return RESULT End If Catch ex As Exception ClassLogger.Add("Unexpected Error in GetControlValuesREC_CONTROL: " & ex.Message, True) MsgBox("Error in GetControlValuesREC_CONTROL:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) Return Nothing End Try End Function Private Shared Sub LoadControlHints(controls As Control.ControlCollection) For Each c As Control In controls Dim id As Integer = DirectCast(c.Tag, ClassControlMetadata).Id Dim sql As String = String.Format("SELECT HINT FROM TBPMO_CONTROL_LANGUAGE WHERE CONTROL_SCREEN_ID = (SELECT GUID FROM TBPMO_CONTROL_SCREEN WHERE CONTROL_ID = {0} AND SCREEN_ID = 1) AND LANGUAGE_TYPE = '{1}' AND HINT IS NOT NULL", id, USER_LANGUAGE) Dim hint = ClassDatabase.Execute_Scalar(sql) If IsNothing(hint) Then Continue For End If ClassControlValueCache.SaveHint(id, hint.ToString) Next End Sub Private Shared Sub LoadControlValue(recordId As Integer, parentRecordId As Integer, controlId As Integer, control As Control, values As List(Of Object), entity_ID As Integer) Try ' Für die meisten Controls wird nur das erste Element der Liste benötigt Dim value As String = Nothing If values.Count > 0 Then value = values.Item(0) End If Select Case control.GetType() Case GetType(TextBox) Dim textbox As TextBox = DirectCast(control, TextBox) ControlLoader.TextBox.LoadValue(textbox, recordId, parentRecordId, value, entity_ID) Case GetType(Label) Dim label As Label = DirectCast(control, Label) ControlLoader.Label.LoadValue(label, recordId, parentRecordId, value, entity_ID) Case GetType(ComboBox) Dim combobox As ComboBox = DirectCast(control, ComboBox) ControlLoader.Combobox.LoadValue(combobox, recordId, parentRecordId, value) Case GetType(CheckBox) Dim checkbox As CheckBox = DirectCast(control, CheckBox) ControlLoader.Checkbox.LoadValue(checkbox, value) Case GetType(RadioButton) If LogErrorsOnly = False Then ClassLogger.Add(" >> Sub LoadControlValueNeu - GetType(RadioButton) ", False) Dim radiobutton As RadioButton = DirectCast(control, RadioButton) ControlLoader.RadioButton.LoadValue(radiobutton, value) Case GetType(DevExpress.XtraEditors.DateEdit) Dim datepicker As DevExpress.XtraEditors.DateEdit = DirectCast(control, DevExpress.XtraEditors.DateEdit) ControlLoader.DateTimePicker.LoadValue(datepicker, value) Case GetType(DevExpress.XtraEditors.ListBoxControl) Dim listbox As DevExpress.XtraEditors.ListBoxControl = DirectCast(control, DevExpress.XtraEditors.ListBoxControl) ControlLoader.ListBox.LoadValue(listbox, value) Case GetType(DevExpress.XtraEditors.CheckedListBoxControl) Dim checkedlistbox As DevExpress.XtraEditors.CheckedListBoxControl = DirectCast(control, DevExpress.XtraEditors.CheckedListBoxControl) ControlLoader.CheckedListBox.LoadValue(checkedlistbox, values) Case GetType(PictureBox) Dim picturebox = DirectCast(control, PictureBox) LoadImage(recordId, controlId, picturebox) Case GetType(DataGridView) Dim gridview = DirectCast(control, DataGridView) ControlLoader.DataGridView.LoadValue(gridview, values) Case Else ClassLogger.Add(" >> Sub LoadControlValue - Control-Type nicht berücksichtigt: " & GetType(Control).ToString(), False) End Select Catch ex As Exception ClassLogger.Add("Unexpected Error in LoadControlValue: " & ex.Message, True) MsgBox("Error in LoadControlValue:" & vbNewLine & ex.Message) End Try End Sub Public Shared Sub LoadControlValuesList(FormID As Integer, controls As Control.ControlCollection) Try Dim sw As New Stopwatch sw.Start() If controls.Count = 0 Then 'MsgBox("LoadControlValuesList: Control.ControlCollection is unexpected empty!", MsgBoxStyle.Exclamation) ClassLogger.Add("LoadControlValuesList: Control.ControlCollection is unexpected empty!") Exit Sub End If Dim swsql As Stopwatch = Stopwatch.StartNew() ' Zuerst alle SQL Commands für FormID finden ' CONTROL_SQLCOMMAND_1 wird als SQL gealiast Dim SQL As String = String.Format("SELECT CONTROL_ID, CONTROL_CONNID_1,CONTROL_SQLCOMMAND_1 AS SQL FROM VWPMO_CONTROL_SCREEN WHERE FORM_ID = {0} AND CONTROL_SQLCOMMAND_1 NOT LIKE '%@%'", FormID) Dim dt As DataTable = ClassDatabase.Return_Datatable(SQL) Dim elapsed As Double elapsed = swsql.Elapsed.TotalSeconds swsql.Stop() If LogErrorsOnly = False Then ClassLogger.Add(String.Format(" >> LoadControlValuesList - Database took {0} to load", Format(elapsed, "0.000000000") & " seconds"), False) If dt.Rows.Count = 0 Then Exit Sub End If For Each Ctrl As Control In controls Dim controlTagId = DirectCast(Ctrl.Tag, ClassControlMetadata).Id 'If controlTagId = 474 Then ' MsgBox("Thats it") 'End If 'Datatable nach row mit CONTROL_ID wie Ctrl suchen Dim row As DataRow = dt.Select(String.Format("CONTROL_ID={0}", controlTagId)).FirstOrDefault() If IsNothing(row) Then Continue For End If Dim sqlcommand As String = row.Item("SQL") Dim ConnID = row.Item("CONTROL_CONNID_1") Select Case Ctrl.GetType() Case GetType(ComboBox) Dim combobox = DirectCast(Ctrl, ComboBox) ControlLoader.Combobox.LoadList(combobox, FormID, ConnID, sqlcommand) Case GetType(DevExpress.XtraEditors.ListBoxControl) Dim listbox = DirectCast(Ctrl, DevExpress.XtraEditors.ListBoxControl) ControlLoader.ListBox.LoadList(listbox, FormID, ConnID, sqlcommand) Case GetType(DevExpress.XtraEditors.CheckedListBoxControl) Dim chlistbox = DirectCast(Ctrl, DevExpress.XtraEditors.CheckedListBoxControl) ControlLoader.CheckedListBox.LoadList(chlistbox, FormID, ConnID, sqlcommand) End Select Next SW.Stop() elapsed = sw.Elapsed.TotalSeconds SW.Stop() SW.Reset() If LogErrorsOnly = False Then ClassLogger.Add(" >> LoadControlValuesList took " & Format(elapsed, "0.000000000") & " seconds", False) Catch ex As Exception ClassLogger.Add("Unexpected Error in LoadControlValuesList: " & ex.Message, True) MsgBox("Unexpected Error in LoadControlValuesList:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub Public Shared Sub LoadControlValuesListWithPlaceholders(FormId As Integer, RecordId As Integer, ParentRecordId As Integer, controls As Control.ControlCollection, entity_ID As Integer) Try If controls.Count = 0 Then 'MsgBox("LoadControlValuesListWithPlaceholders: Control.ControlCollection is unexpected empty!", MsgBoxStyle.Exclamation) ClassLogger.Add("LoadControlValuesListWithPlaceholders: Control.ControlCollection is unexpected empty!") Exit Sub End If Dim SQL As String = String.Format("SELECT CONTROL_ID, CONTROL_CONNID_1, CONTROL_SQLCOMMAND_1 AS SQL FROM VWPMO_CONTROL_SCREEN WHERE FORM_ID = {0} AND CONTROL_SQLCOMMAND_1 <> '' AND CONTROL_SQLCOMMAND_1 LIKE '%@%'", FormId) Dim SW As Stopwatch = Stopwatch.StartNew() Dim commands As New List(Of String) Dim dt As DataTable = ClassDatabase.Return_Datatable(SQL) If dt.Rows.Count = 0 Then Exit Sub End If For Each Ctrl As Control In controls Dim controlTagId = DirectCast(Ctrl.Tag, ClassControlMetadata).Id Dim row As DataRow = dt.Select(String.Format("CONTROL_ID={0}", controlTagId)).FirstOrDefault() If IsNothing(row) Then Continue For End If Dim connID = row.Item("CONTROL_CONNID_1") Dim sqlcommand As String = row.Item("SQL") sqlcommand = ReplaceSqlCommandPlaceholders(sqlcommand, RecordId, ParentRecordId, entity_ID) Select Case Ctrl.GetType() Case GetType(ComboBox) Dim combobox = DirectCast(Ctrl, ComboBox) ControlLoader.Combobox.LoadList(combobox, FormId, connID, sqlcommand) Case GetType(DevExpress.XtraEditors.ListBoxControl) Dim listbox = DirectCast(Ctrl, DevExpress.XtraEditors.ListBoxControl) ControlLoader.ListBox.LoadList(listbox, FormId, connID, sqlcommand) Case GetType(DevExpress.XtraEditors.CheckedListBoxControl) Dim chlistbox = DirectCast(Ctrl, DevExpress.XtraEditors.CheckedListBoxControl) ControlLoader.CheckedListBox.LoadList(chlistbox, FormId, connID, sqlcommand) End Select Next Dim elapsed As Double elapsed = SW.Elapsed.TotalSeconds SW.Stop() Console.WriteLine("LoadControlValuesListWithPlaceholders took {0} to load", Format(elapsed, "0.000000000") & " seconds") Catch ex As Exception ClassLogger.Add("Unexpected Error in LoadControlValuesListWithPlaceholders: " & ex.Message, True) MsgBox("Unexpected Error in LoadControlValuesListWithPlaceholders:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub Public Shared Function ReplaceSqlCommandPlaceholders(sqlCommand As String, recordId As Integer, parentRecordId As Integer, entity_Id As Integer) sqlCommand = sqlCommand.Replace("@RECORD_ID", recordId) sqlCommand = sqlCommand.Replace("@RECORDID", recordId) sqlCommand = sqlCommand.Replace("@ENTITY_ID", entity_Id) sqlCommand = sqlCommand.Replace("@PARENTRECORD_ID", parentRecordId) sqlCommand = sqlCommand.Replace("@PARENTRECORDID", parentRecordId) Return sqlCommand End Function Public Shared Sub UnloadControlValuesList(RecordID As Integer, FormID As Integer, controls As Control.ControlCollection) For Each C As Control In controls If TypeOf C Is ComboBox Then Dim Combobox = DirectCast(C, ComboBox) Dim currentValue As String = Combobox.Text Combobox.DataSource = Nothing Combobox.Text = currentValue End If Next End Sub Public Shared Sub LoadImage(RecordID As Integer, ControlID As Integer, control As Control) Dim picbox As PictureBox = DirectCast(control, PictureBox) Dim SQL As String = String.Format("SELECT IMG FROM TBPMO_CONTROL_IMAGE WHERE RECORD_ID = {0} AND CONTROL_ID = {1}", RecordID, ControlID) Dim bimage As Byte() = ClassDatabase.Execute_Scalar(SQL) If Not IsNothing(bimage) Then picbox.BackgroundImage = ByteArrayToBitmap(bimage) picbox.BackgroundImageLayout = ImageLayout.Zoom Else picbox.BackgroundImage = Nothing End If End Sub #Region "ClearControlValue" Public Shared Sub ClearControlValues(controls As Control.ControlCollection) For Each control In controls If control.GetType().Name = "GroupBox" Then Dim groupbox As GroupBox = control ClearControlValues(groupbox.Controls) Else ClearControlValue(control) End If Next End Sub Public Shared Sub ClearControlValue(control As Control) Select Case control.GetType() Case GetType(TextBox) DirectCast(control, TextBox).Text = String.Empty Case GetType(ComboBox) Dim combo As ComboBox = DirectCast(control, ComboBox) combo.SelectedIndex = -1 combo.Text = String.Empty Case GetType(CheckBox) DirectCast(control, CheckBox).Checked = False Case GetType(RadioButton) DirectCast(control, RadioButton).Checked = False Case GetType(DevExpress.XtraEditors.DateEdit) DirectCast(control, DevExpress.XtraEditors.DateEdit).DateTime = Now Case GetType(PictureBox) DirectCast(control, PictureBox).BackgroundImage = Nothing Case GetType(DevExpress.XtraEditors.CheckedListBoxControl) Dim chklbx As DevExpress.XtraEditors.CheckedListBoxControl = DirectCast(control, DevExpress.XtraEditors.CheckedListBoxControl) chklbx.UnCheckAll() Case GetType(DevExpress.XtraEditors.ListBoxControl) Dim lb As DevExpress.XtraEditors.ListBoxControl = DirectCast(control, DevExpress.XtraEditors.ListBoxControl) lb.SelectedIndex = -1 Case GetType(DataGridView) Dim dgv As DataGridView = DirectCast(control, DataGridView) dgv.Rows.Clear() End Select End Sub #End Region #Region "LoadDefaultValue" Public Shared Sub LoadDefaultValues(FormID As Integer, RecordID As Integer, controls As Control.ControlCollection) '' Zuerst alle Controls leeren 'ClearControlValues(controls) Dim i = 0 For Each control As Control In controls Dim CONTROL_ID = DirectCast(control.Tag, ClassControlMetadata).Id ' GetControlID_for_Name(control.Name, FormID) If Not (TypeOf control Is Label) Then i += 1 End If If TypeOf control Is GroupBox Then LoadDefaultValues(FormID, RecordID, DirectCast(control, GroupBox).Controls) End If LoadDefaultValue(CONTROL_ID, RecordID, control) 'Den Focus auf das erste Steuerelement setzen If i = 1 Then control.Focus() End If Next End Sub Public Shared Sub LoadDefaultValue(ControlID As Integer, RecordID As Integer, control As Control) Try Dim SQL = String.Format("SELECT CONTROL_DEF_VALUE FROM VWPMO_CONTROL_SCREEN WHERE CONTROL_ID = {0}", ControlID) Dim autoValue = ClassDatabase.Execute_Scalar(SQL) 'Dim SQL = "SELECT * FROM VWPMO_CONTROL_SCREEN WHERE CONTROL_ID = " & ControlID 'Dim DT As DataTable = ClassDatabase.Return_Datatable(SQL) 'Dim result = DT.Rows(0).Item("CONTROL_DEF_VALUE") Select Case control.GetType() Case GetType(TextBox) Dim textbox As TextBox = DirectCast(control, TextBox) If IsDBNull(autoValue) Then textbox.Text = "" Else Dim vorgabe = autoValue 'Wenn der Default Wert über einen Select kommt If vorgabe.ToString.ToLower.StartsWith("select") Then vorgabe = autoValue.Replace("@FORM_ID", CURRENT_FORM_ID) vorgabe = vorgabe.Replace("@RECORD_ID", CURRENT_RECORD_ID) vorgabe = vorgabe.Replace("@RECORDID", CURRENT_RECORD_ID) vorgabe = vorgabe.Replace("@PARENTRECORD_ID", CURRENT_PARENT_ID) autoValue = ClassDatabase.Execute_Scalar(vorgabe.ToString, True) If IsNothing(vorgabe) Then textbox.Text = "" End If End If textbox.Text = autoValue End If Case GetType(CheckBox) Dim checkbox As CheckBox = DirectCast(control, CheckBox) checkbox.Checked = StrToBool(autoValue) Case GetType(RadioButton) Dim radio As RadioButton = DirectCast(control, RadioButton) radio.Checked = StrToBool(autoValue) Case GetType(ComboBox) Dim combobox As ComboBox = DirectCast(control, ComboBox) If IsDBNull(autoValue) Then combobox.SelectedIndex = -1 Else combobox.SelectedIndex = combobox.FindStringExact(autoValue) End If Case GetType(DevExpress.XtraEditors.DateEdit) Dim datepicker As DevExpress.XtraEditors.DateEdit = DirectCast(control, DevExpress.XtraEditors.DateEdit) If IsDBNull(autoValue) Then autoValue = String.Empty End If Dim result As EnumDateTimePickerDefaultValueOptions = EnumDateTimePickerDefaultValueOptions.Empty Dim success = [Enum].TryParse(Of EnumDateTimePickerDefaultValueOptions)(autoValue, result) If success Then If result = EnumDateTimePickerDefaultValueOptions.Empty Then ' DBNull.Value leert das DateEdit control. autoValue = DBNull.Value ElseIf result = EnumDateTimePickerDefaultValueOptions.CurrentDate Then autoValue = Now End If Else 'Wenn der DefaultWert nicht gelesen werden konnte, DateEdit leeren autoValue = DBNull.Value End If ' Mit EditValue kann man auch den angezeigten Wert leeren 'datepicker.DateTime = autoValue datepicker.EditValue = autoValue End Select Catch ex As Exception MsgBox("Unexpected Error in LoadDefaultValue:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub #End Region Public Shared Function Get_Control_Value_for_ID(Control_ID As Integer, Record_ID As Integer) Try Return ClassDatabase.Execute_Scalar("SELECT VALUE FROM TBPMO_CONTROL_VALUE WHERE CONTROL_ID = " & Control_ID & " AND RECORD_ID = " & Record_ID, True) Catch ex As Exception ClassLogger.Add("Unexpected Error in GetControlValueForControlID: " & ex.Message, True) MsgBox("Error in GetControlValueForControlID:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) Return Nothing End Try End Function End Class