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 As String = "SELECT CONTROL_TYPE_ID FROM TBPMO_CONTROL WHERE GUID = " & ControlID Dim type As Integer = ClassDatabase.Execute_Scalar(SQL) ' Wenn kein/leerer Wert gefunden, suche nach einem SQL Command für Automatischen Wert If type = 1 Then Dim autoValue SQL = "SELECT SQL_COMMAND_1 FROM TBPMO_CONTROL WHERE GUID = " & ControlID 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 End If End Function Public Shared Sub LoadControlValue(RecordID As Integer, ControlID As Integer, control As Control) Try 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 combobox As ComboBox = DirectCast(control, ComboBox) combobox.SelectedIndex = combobox.FindStringExact(result) Case 4 'DateTimePicker If result = "" Then result = Now End If Dim datepicker As DevExpress.XtraEditors.DateEdit = DirectCast(control, DevExpress.XtraEditors.DateEdit) datepicker.DateTime = Date.Parse(result) 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 Public Shared Sub LoadControlValues(RecordID As Integer, FormID As Integer, controls As Control.ControlCollection) Try Dim CONTROL_ID As Integer ClearControlValues(controls) For Each control As Control In controls 'Überhaupt Columns in Grid? CONTROL_ID = GetControlID_for_RecordID(control.Name, RecordID) If CONTROL_ID = -1 Then CONTROL_ID = GetControlID_for_Name(control.Name, FormID) End If If LogErrorsOnly = False Then ClassLogger.Add(">> CONTROL_ID:" & CONTROL_ID, False) ClearControlValue(control) If TypeOf control Is GroupBox Then LoadControlValues(RecordID, FormID, DirectCast(control, GroupBox).Controls) End If If TypeOf control Is PictureBox Then LoadImage(RecordID, CONTROL_ID, control) End If 'EINE CheckedListBoxControl If TypeOf control Is DevExpress.XtraEditors.CheckedListBoxControl Then If LogErrorsOnly = False Then ClassLogger.Add(">> control DevExpress.XtraEditors.CheckedListBoxControl", False) Dim chklbx As DevExpress.XtraEditors.CheckedListBoxControl chklbx = DirectCast(control, DevExpress.XtraEditors.CheckedListBoxControl) Dim chklbSql As String = "SELECT SQL_COMMAND_1 FROM TBPMO_CONTROL WHERE GUID = " & CONTROL_ID chklbSql = ClassDatabase.Execute_Scalar(chklbSql) If Not (chklbSql Is Nothing Or chklbSql = String.Empty) Then If chklbSql.ToString.Contains("@") Then chklbSql = chklbSql.ToString.Replace("@RECORDID", CURRENT_RECORD_ID) chklbSql = chklbSql.ToString.Replace("@RECORD_ID", CURRENT_RECORD_ID) chklbSql = chklbSql.ToString.Replace("@PARENTRECORD_ID", CURRENT_PARENTID) If LogErrorsOnly = False Then ClassLogger.Add(">> SQL CheckedListBox: " & chklbSql, False) 'SQL-Command vorhanden also Ausführen des SQL Dim DT_ListBox As DataTable = ClassDatabase.Return_Datatable(chklbSql, "LoadControlValues: CheckedListBox") If DT_ListBox Is Nothing = False Then chklbx.DataSource = DT_ListBox Select Case DT_ListBox.Columns.Count Case 2 chklbx.DisplayMember = DT_ListBox.Columns(1).ColumnName chklbx.ValueMember = DT_ListBox.Columns(0).ColumnName Case 1 chklbx.DisplayMember = DT_ListBox.Columns(0).ColumnName chklbx.ValueMember = DT_ListBox.Columns(0).ColumnName End Select End If End If ElseIf (chklbSql = String.Empty) Then ' Wenn keine SQL Command ein leerer String ist, ' lade das Control ohne Datenbank, da es wahrscheinlich eine Static List ist chklbSql = "SELECT VALUE FROM VWPMO_VALUES WHERE CONTROL_ID = " & CONTROL_ID & " AND RECORD_ID = " & RecordID Dim result As String = ClassDatabase.Execute_Scalar(chklbSql) If Not IsNothing(result) Then If result.ToString <> String.Empty Then Dim entries() As String = result.Split(";") For Each entry As String In entries Dim position = chklbx.FindStringExact(entry) chklbx.SetItemCheckState(position, CheckState.Checked) Next End If End If Continue For Else If LogErrorsOnly = False Then ClassLogger.Add(">> chklbSql is nothing", False) End If chklbx.UnCheckAll() 'Recorddatensätze durchlaufen und überprüfen ob angehakt?? Dim index As Integer = 0 For i As Integer = 0 To chklbx.ItemCount - 1 Dim item = chklbx.GetItem(i) Dim row As DataRowView = CType(item, DataRowView) If CInt(row(0)) > 0 Then 'Überprüfen ob es den Record gibt Dim SQL = "SELECT COUNT(*) FROM TBPMO_RECORD_CONNECT WHERE RECORD1_ID = " & CURRENT_RECORD_ID & " AND RECORD2_ID = " & CInt(row(0)) If ClassDatabase.Execute_Scalar(SQL) = 1 Then chklbx.SetItemChecked(i, True) End If End If Next ElseIf TypeOf control Is DevExpress.XtraEditors.ListBoxControl Then If LogErrorsOnly = False Then ClassLogger.Add(">> control DevExpress.XtraEditors.ListBoxControl", False) Dim lbx As DevExpress.XtraEditors.ListBoxControl lbx = DirectCast(control, DevExpress.XtraEditors.ListBoxControl) Dim lbSql As String = "SELECT SQL_COMMAND_1 FROM TBPMO_CONTROL WHERE GUID = " & CONTROL_ID lbSql = ClassDatabase.Execute_Scalar(lbSql) If Not (lbSql Is Nothing Or lbSql = String.Empty) Then If lbSql.ToString.Contains("@") Then lbSql = lbSql.ToString.Replace("@RECORDID".ToUpper, CURRENT_RECORD_ID) lbSql = lbSql.ToString.Replace("@RECORD_ID".ToUpper, CURRENT_RECORD_ID) lbSql = lbSql.ToString.Replace("@PARENTRECORD_ID".ToUpper, CURRENT_PARENTID) If LogErrorsOnly = False Then ClassLogger.Add(">> SQL ListBox: " & lbSql, False) 'SQL-Command vorhanden also Ausführen des SQL Dim DT_ListBox As DataTable = ClassDatabase.Return_Datatable(lbSql, "LoadControlValues: ListBoxControl") If DT_ListBox Is Nothing = False Then lbx.DataSource = DT_ListBox Select Case DT_ListBox.Columns.Count Case 2 lbx.DisplayMember = DT_ListBox.Columns(1).ColumnName lbx.ValueMember = DT_ListBox.Columns(0).ColumnName Case 1 lbx.DisplayMember = DT_ListBox.Columns(0).ColumnName lbx.ValueMember = DT_ListBox.Columns(0).ColumnName End Select If DT_ListBox.Columns.Count > 1 Then End If Else If LogErrorsOnly = False Then ClassLogger.Add(">> DT_ListBox is nothing", False) End If Else If LogErrorsOnly = False Then ClassLogger.Add(">> lbSql.ToString NOT Contains(@)", False) End If ElseIf (lbSql = String.Empty) Then ' Wenn keine SQL Command ein leerer String ist, ' lade das Control ohne Datenbank, da es wahrscheinlich eine Static List ist LoadControlValue(RecordID, CONTROL_ID, control) Continue For Else If LogErrorsOnly = False Then ClassLogger.Add(">> lbSql is nothing", False) End If ElseIf CONTROL_ID <> -1 Then 'If LogErrorsOnly = False Then ClassLogger.Add(">> LoadControlValues CONTROL_ID: " & CONTROL_ID, False) LoadControlValue(RecordID, CONTROL_ID, control) End If Next Catch ex As Exception MsgBox("Unexpected Error in LoadControlValues:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try 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 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) Dim type = control.GetType().Name Select Case type Case "TextBox" DirectCast(control, TextBox).Text = String.Empty Case "ComboBox" Dim combo As ComboBox = DirectCast(control, ComboBox) combo.SelectedIndex = -1 combo.Text = String.Empty Case "CheckBox" DirectCast(control, CheckBox).Checked = False Case "RadioButton" DirectCast(control, RadioButton).Checked = False Case "DateEdit" DirectCast(control, DevExpress.XtraEditors.DateEdit).DateTime = Now Case "PictureBox" DirectCast(control, PictureBox).BackgroundImage = Nothing Case "CheckedListBoxControl" Dim chklbx As DevExpress.XtraEditors.CheckedListBoxControl = DirectCast(control, DevExpress.XtraEditors.CheckedListBoxControl) If IsNothing(chklbx.DataSource) Then chklbx.UnCheckAll() End If 'Case "ListBoxControl" ' Dim lbx As DevExpress.XtraEditors.ListBoxControl ' lbx = DirectCast(control, DevExpress.XtraEditors.ListBoxControl) ' lbx.DataSource = Nothing Case Else End Select End Sub Public Shared Sub LoadDefaultValues(FormID As Integer, RecordID As Integer, controls As Control.ControlCollection) Dim CONTROL_ID As Integer ' Zuerst alle Controls leeren ClearControlValues(controls) Dim i = 0 For Each control As Control In controls CONTROL_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) ElseIf TypeOf control Is DevExpress.XtraEditors.CheckedListBoxControl Then Dim chklbx As DevExpress.XtraEditors.CheckedListBoxControl chklbx = DirectCast(control, DevExpress.XtraEditors.CheckedListBoxControl) chklbx.UnCheckAll() End If If CONTROL_ID <> -1 Then LoadDefaultValue(CONTROL_ID, RecordID, control) End If '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 = "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 DT.Rows(0).Item("CTRLTYPE_ID") Case 2 ' TextBox Dim textbox As TextBox = DirectCast(control, TextBox) If IsDBNull(result) Then textbox.Text = "" Else Dim vorgabe = result 'Wenn der Default Wert über einen Select kommt If vorgabe.ToString.ToLower.StartsWith("select") Then vorgabe = result.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) result = ClassDatabase.Execute_Scalar(vorgabe.ToString, True) If IsNothing(vorgabe) Then textbox.Text = "" End If End If textbox.Text = result End If Case 10 ' CheckBox Dim checkbox As CheckBox = DirectCast(control, CheckBox) checkbox.Checked = StrToBool(result) Case 11 'RadioButton Dim radio As RadioButton = DirectCast(control, RadioButton) radio.Checked = StrToBool(result) Case 3 ' ComboBox Dim combobox As ComboBox = DirectCast(control, ComboBox) If IsDBNull(result) Then combobox.SelectedIndex = -1 Else combobox.SelectedIndex = combobox.FindStringExact(result) End If Case 4 'DateTimePicker Dim datepicker As DevExpress.XtraEditors.DateEdit = DirectCast(control, DevExpress.XtraEditors.DateEdit) If IsDBNull(result) OrElse result = "" OrElse result = "False" Then result = Now End If datepicker.DateTime = result End Select Catch ex As Exception MsgBox("Unexpected Error in LoadDefaultValue:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub 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