Imports DevExpress.XtraEditors.Controls Public Class ClassControlValues 'Private Shared Function LoadControlAutoValue(ControlID As Integer, RecordID As Integer, control As Control) As String ' If TypeOf control Is Label Then ' Dim SQL = "SELECT SQL_COMMAND_1 FROM TBPMO_CONTROL WHERE GUID = " & ControlID ' Dim autoValue ' Dim result = ClassDatabase.Execute_Scalar(SQL) ' result = result.Replace("@FORM_ID", CURRENT_FORM_ID) ' result = result.Replace("@RECORD_ID", CURRENT_RECORD_ID) ' result = result.Replace("@RECORDID", CURRENT_RECORD_ID) ' result = result.Replace("@PARENTRECORD_ID", CURRENT_PARENTID) ' ' Wenn das SQL Command leer ist, hat dieses Control kein SQL Command ' ' Gib den ursprünlichen Text zurück ' If result = "" Then ' Return control.Text ' Else ' autoValue = ClassDatabase.Execute_Scalar(result) ' ' Wenn das SQL Command DBNull zurück gibt, ' ' Überschreibe den alten Wert mit " " (Leerzeichen) ' If IsDBNull(autoValue) Then ' SQL = "SELECT CONTROL_TEXT FROM TBPMO_CONTROL_SCREEN WHERE CONTROL_ID = " & ControlID ' Dim value = ClassDatabase.Execute_Scalar(SQL) ' Return value ' Else ' Return autoValue ' End If ' End If ' 'End If ' 'Return Nothing ' Else ' Return Nothing ' End If 'End Function 'Public Shared Sub LoadControlValue(RecordID As Integer, ControlID As Integer, control As Control) ' Try ' ' Dim DT1 As DataTable = ClassDatabase.Return_Datatable() ' Dim DT As DataTable = ClassDatabase.Return_Datatable("SELECT * FROM VWPMO_VALUES WHERE RECORD_ID = " & RecordID & " and CONTROL_ID = " & ControlID, "LaodControlValue: ReturnValues") ' If DT.Rows.Count = 0 Then ' Dim autoValue = LoadControlAutoValue(ControlID, RecordID, control) ' If Not String.IsNullOrEmpty(autoValue) Then ' control.Text = autoValue ' End If ' Exit Sub ' End If ' Dim result = DT.Rows(0).Item("VALUE") ' '22.06.2015 ' If Not IsDBNull(result) Then ' Select Case DT.Rows(0).Item("CONTROL_TYPE_ID") ' Case 1 'Label ' Dim label As Label = DirectCast(control, Label) ' Dim autoValue As String = LoadControlAutoValue(ControlID, RecordID, control) ' If Not IsNothing(autoValue) Then ' label.Text = autoValue ' End If ' Case 2 ' TextBox ' Dim textbox As TextBox = DirectCast(control, TextBox) ' textbox.Text = result ' Case 10 ' CheckBox ' Dim checkbox As CheckBox = DirectCast(control, CheckBox) ' checkbox.Checked = CBool(result) ' Case 11 'RadioButton ' Dim radio As RadioButton = DirectCast(control, RadioButton) ' radio.Checked = CBool(result) ' Case 3 ' ComboBox ' Dim cmbbox As ComboBox = DirectCast(control, System.Windows.Forms.ComboBox) ' cmbbox.Text = result ' 'If LogErrorsOnly = False Then ClassLogger.Add(">> control ComboBox", False) ' 'Dim cmbSql As String = "SELECT SQL_COMMAND_1 FROM TBPMO_CONTROL WHERE GUID = " & ControlID ' 'cmbSql = ClassDatabase.Execute_Scalar(cmbSql) ' 'If Not (cmbSql Is Nothing Or cmbSql = String.Empty) Then ' ' If cmbSql.ToString.Contains("@") Then ' ' cmbSql = cmbSql.ToString.Replace("@RECORDID", CURRENT_RECORD_ID) ' ' cmbSql = cmbSql.ToString.Replace("@RECORD_ID", CURRENT_RECORD_ID) ' ' cmbSql = cmbSql.ToString.Replace("@PARENTRECORD_ID", CURRENT_PARENTID) ' ' If LogErrorsOnly = False Then ClassLogger.Add(">> SQL Combobox: " & cmbSql, False) ' ' End If ' ' If LogErrorsOnly = False Then ClassLogger.Add(">> SQL Combobox: " & cmbSql, False) ' ' 'SQL-Command vorhanden also Ausführen des SQL ' ' Dim DT_ComboBox As DataTable = ClassDatabase.Return_Datatable(cmbSql, "LoadControlValues: Combobox") ' ' If DT_ComboBox Is Nothing = False Then ' ' cmbbox.DataSource = DT_ComboBox ' ' Select Case DT_ComboBox.Columns.Count ' ' Case 2 ' ' cmbbox.DisplayMember = DT_ComboBox.Columns(1).ColumnName ' ' cmbbox.ValueMember = DT_ComboBox.Columns(0).ColumnName ' ' Case 1 ' ' cmbbox.DisplayMember = DT_ComboBox.Columns(0).ColumnName ' ' cmbbox.ValueMember = DT_ComboBox.Columns(0).ColumnName ' ' End Select ' ' End If ' 'End If ' ''combobox.DataSource = Nothing ' 'If cmbbox.SelectedIndex = -1 Then ' ' cmbbox.DataSource = Nothing ' ' cmbbox.Text = result ' 'Else ' ' cmbbox.SelectedIndex = cmbbox.FindStringExact(result) ' 'End If ' Case 4 'DateTimePicker ' Dim datepicker As DevExpress.XtraEditors.DateEdit = DirectCast(control, DevExpress.XtraEditors.DateEdit) ' If result = "" Or result = "00:00:00" Then ' datepicker.DateTime = DateTime.MinValue ' Else ' datepicker.DateTime = Date.Parse(result) ' End If ' Case 13 ' Listbox ' Dim listbox As DevExpress.XtraEditors.ListBoxControl = DirectCast(control, DevExpress.XtraEditors.ListBoxControl) ' listbox.SelectedIndex = listbox.FindStringExact(result) ' Case Else ' If LogErrorsOnly = False Then ClassLogger.Add(">> Sub LoadControlValue - Control-Type nicht berücksichtigt: " & DT.Rows(0).Item("CONTROL_TYPE_ID"), False) ' 'MsgBox(DT.Rows(0).Item("CONTROL_TYPE_ID")) ' End Select ' Else ' ClassLogger.Add(" >> Achtung, der Value für Control-ID: " & ControlID & " ist DBNull", False) ' End If ' Catch ex As Exception ' MsgBox("Error in LoadControlValue:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) ' End Try 'End Sub #Region "#### ClassControlValues REWRITE ####" Public Shared Sub LoadControlValuesNeu(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 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) LoadControlValuesNeu(RecordId, ParentRecordId, FormId, groupbox.Controls) Else LoadControlValueNeu(RecordId, ParentRecordId, ControlId, control, value) End If Next Catch ex As Exception 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, 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, 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 MsgBox("Error in LoadControlValue:" & vbNewLine & ex.Message) End Try End Sub #End Region Public Shared Sub LoadControlValuesList(RecordID As Integer, ParentRecordId As Integer, FormID As Integer, controls As Control.ControlCollection) Try If controls.Count = 0 Then MsgBox("Control.ControlCollection is unexpected empty!", MsgBoxStyle.Exclamation) End If Dim SW As Stopwatch = Stopwatch.StartNew() For Each Ctrl As Control In controls If TypeOf Ctrl Is ComboBox Then Dim ControlId = Ctrl.Tag Dim swInner As Stopwatch = Stopwatch.StartNew() Dim Combobox = DirectCast(Ctrl, ComboBox) Dim SQL As String = String.Format("SELECT SQL_COMMAND_1 FROM TBPMO_CONTROL WHERE GUID = {0}", ControlId) 'CURRENT_FORM_ID, Ctrl.Name) Dim SQL2 As String = ClassDatabase.Execute_Scalar(SQL) If SQL2 = "" Then Continue For End If If SQL2.ToString.ToUpper.Contains("@") Then SQL2 = SQL2.ToString.Replace("@RECORDID", CURRENT_RECORD_ID) SQL2 = SQL2.ToString.Replace("@RECORD_ID", CURRENT_RECORD_ID) SQL2 = SQL2.ToString.Replace("@PARENTRECORD_ID", CURRENT_PARENTID) ' If LogErrorsOnly = False Then ClassLogger.Add(">> SQL Combobox: " & cmbSql, False) End If 'Dim controlId As Integer = GetControlID_for_Name(Combobox.Name, FormID) 'Dim DT_Combobox As DataTable = ClassDatabase.Return_Datatable(SQL2) ' Zuerst versuchen, DataTable aus dem Cache zu laden Dim DT_Combobox As DataTable = ClassControlValueCache.LoadFromCache(FormID, ControlId) ' Wenn DataTable nicht im Cache vorhanden, aus der Datenbank laden If IsNothing(DT_Combobox) Then DT_Combobox = ClassDatabase.Return_Datatable(SQL2) End If If DT_Combobox Is Nothing = False Then If DT_Combobox.Rows.Count > 0 Then Combobox.DataSource = DT_Combobox Combobox.DisplayMember = DT_Combobox.Columns(1).ColumnName Combobox.ValueMember = DT_Combobox.Columns(0).ColumnName ClassControlValueCache.SaveToCache(FormID, ControlId, DT_Combobox) End If Dim iWidestWidth As Integer = 300 For Each row As DataRow In DT_Combobox.Rows 'Die BReite der DropDown-Lsit anpassen Using g As Graphics = Combobox.CreateGraphics If g.MeasureString(row.Item(1).ToString, Combobox.Font).Width + 30 > iWidestWidth Then iWidestWidth = g.MeasureString(row.Item(1).ToString, Combobox.Font).Width + 30 End If g.Dispose() End Using ' control.Items.Add(row.Item(0).ToString) Next If iWidestWidth > 300 Then Combobox.DropDownWidth = Math.Max(iWidestWidth, Combobox.Width) End If 'LoadControlValue(RecordID, ControlId, Ctrl) LoadControlValueNeu(RecordID, ParentRecordId, ControlId, Ctrl, "") End If swInner.Stop() Console.WriteLine("Loading List for Control {0} took {1} milliseconds", Ctrl.Name, swInner.ElapsedMilliseconds) End If Next SW.Stop() Console.WriteLine("LoadControlValuesList took {0} milliseconds to load", SW.ElapsedMilliseconds) Catch ex As Exception MsgBox("Unexpected Error in LoadControlValuesList:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub 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_PARENTID) 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) OrElse autoValue = "" OrElse autoValue = "False" Then autoValue = Now End If datepicker.DateTime = 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 MsgBox("Error in GetControlValueForControlID:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) Return Nothing End Try End Function End Class