Imports DevExpress.XtraEditors.Controls Public Class ClassControlValues Public Shared Sub LoadControlValues(RecordId As Integer, ParentRecordId As Integer, FormId As Integer, controls As Control.ControlCollection) 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) End If ' Zuerst alle Controls leeren ClearControlValues(controls) For Each control As Control In controls Dim ControlId As Integer = CInt(control.Tag) ' Wert per LINQ aus DT_ControlValues suchen der zur aktuellen controlId passt Dim value = (From row In DT_ControlValues.AsEnumerable() Where row.Item("CONTROL_ID") = ControlId Select row.Item("VALUE")).SingleOrDefault() If TypeOf control Is GroupBox Then Dim groupbox As GroupBox = DirectCast(control, GroupBox) LoadControlValues(RecordId, ParentRecordId, FormId, groupbox.Controls) Else LoadControlValueNeu(RecordId, ParentRecordId, ControlId, control, value) 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 Private Shared Sub LoadControlValueNeu(recordId As Integer, parentRecordId As Integer, controlId As Integer, control As Control, value As Object) Try Select Case control.GetType() Case GetType(TextBox) Dim textbox As TextBox = DirectCast(control, TextBox) ControlLoader.TextBox.LoadValue(textbox, recordId, parentRecordId, value) Case GetType(Label) Dim label As Label = DirectCast(control, Label) ControlLoader.Label.LoadValue(label, recordId, parentRecordId, value) 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) 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, value) Case GetType(PictureBox) Dim picturebox = DirectCast(control, PictureBox) LoadImage(recordId, controlId, picturebox) Case Else If LogErrorsOnly = False Then 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 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 SW As Stopwatch = Stopwatch.StartNew() 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_SQLCOMMAND_1 AS SQL FROM VWPMO_CONTROL_SCREEN WHERE FORM_ID = {0} AND CONTROL_SQLCOMMAND_1 <> '' AND CONTROL_SQLCOMMAND_1 NOT LIKE '%@%'", FormID) Dim dt As DataTable = ClassDatabase.Return_Datatable(SQL) swsql.Stop() Console.WriteLine("LoadControlValuesList - Database took {0} milliseconds to load", swsql.ElapsedMilliseconds) If dt.Rows.Count = 0 Then Exit Sub End If For Each Ctrl As Control In controls Dim swcontrol As Stopwatch = Stopwatch.StartNew() Dim controlTagId = CInt(Ctrl.Tag) '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") Select Case Ctrl.GetType() Case GetType(ComboBox) Dim combobox = DirectCast(Ctrl, ComboBox) ControlLoader.Combobox.LoadList(combobox, FormID, sqlcommand) Case GetType(DevExpress.XtraEditors.ListBoxControl) Dim listbox = DirectCast(Ctrl, DevExpress.XtraEditors.ListBoxControl) ControlLoader.ListBox.LoadList(listbox, FormID, sqlcommand) Case GetType(DevExpress.XtraEditors.CheckedListBoxControl) Dim chlistbox = DirectCast(Ctrl, DevExpress.XtraEditors.CheckedListBoxControl) ControlLoader.CheckedListBox.LoadList(chlistbox, FormID, sqlcommand) End Select swcontrol.Stop() Console.WriteLine("LoadControlValuesList Loading {0} took {1} milliseconds to load", Ctrl.Name, swcontrol.ElapsedMilliseconds) Next SW.Stop() Console.WriteLine("LoadControlValuesList took {0} milliseconds to load", SW.ElapsedMilliseconds) 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) 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_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 = CInt(Ctrl.Tag) 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") sqlcommand = ReplaceSqlCommandPlaceholders(sqlcommand, RecordId, ParentRecordId) Select Case Ctrl.GetType() Case GetType(ComboBox) Dim combobox = DirectCast(Ctrl, ComboBox) ControlLoader.Combobox.LoadList(combobox, FormId, sqlcommand) Case GetType(DevExpress.XtraEditors.ListBoxControl) Dim listbox = DirectCast(Ctrl, DevExpress.XtraEditors.ListBoxControl) ControlLoader.ListBox.LoadList(listbox, FormId, sqlcommand) Case GetType(DevExpress.XtraEditors.CheckedListBoxControl) Dim chlistbox = DirectCast(Ctrl, DevExpress.XtraEditors.CheckedListBoxControl) ControlLoader.CheckedListBox.LoadList(chlistbox, FormId, sqlcommand) End Select Next SW.Stop() Console.WriteLine("LoadControlValuesListWithPlaceholders took {0} milliseconds to load", SW.ElapsedMilliseconds) 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) sqlCommand = sqlCommand.Replace("@RECORD_ID", recordId) sqlCommand = sqlCommand.Replace("@RECORDID", recordId) 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 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 = control.Tag ' 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) 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