Imports DevExpress.XtraEditors Imports System.Text.RegularExpressions Public Class ClassRecordView Public RecordId As Integer Private DTControls As DataTable Private DTValues As DataTable Private Entity_ID As Integer Private Panel As Panel Private Const CONTROL_ID_PATTERN = "@\d{1,}@" Private Const STATIC_PATTERN = "@\w{1,}" ''' ''' Initialisiert die RecordView Klasse ''' Public Sub New(panel As Panel) Me.Panel = panel End Sub ''' ''' Lädt die Controls und Werte für die angegebene RecordId ''' Public Sub LoadRecord(recordId As Integer) Try Me.RecordId = recordId Me.LoadControls() Me.LoadValues(Me.Panel.Controls) Me.PreventControlValueChanges() Catch ex As Exception End Try End Sub #Region "Helper Functions" Private Sub Noop() ' Verhindert Bestimmte Events End Sub Private Function GetEntityId() As Integer Dim SQL = String.Format("SELECT FORM_ID FROM TBPMO_RECORD WHERE GUID = {0}", RecordId) Me.Entity_ID = MYDB_ECM.GetScalarValue(SQL) Return Me.Entity_ID End Function Private Function MapRowToProps(r As DataRow) As ControlProps Try Dim props As New ControlProps props.Id = r.Item("CONTROL_ID") props.Name = r.Item("CONTROL_NAME").ToString props.Type = r.Item("CTRLTYPE_NAME").ToString props.Caption = r.Item("CTRLSCR_CAPTION").ToString props.X = r.Item("CTRLSCR_X_LOC") props.Y = r.Item("CTRLSCR_Y_LOC") props.Height = r.Item("CTRLSCR_HEIGHT") props.Width = r.Item("CTRLSCR_WIDTH") props.FontFamily = r.Item("CTRLSCR_FONT_FAMILY") props.FontSize = r.Item("CTRLSCR_FONT_SIZE") props.FontStyle = CType(r.Item("CTRLSCR_FONT_STYLE"), FontStyle) props.FontColor = IntToColor(r.Item("CTRLSCR_FONT_COLOR")) props.BackColor = IntToColor(r.Item("CTRLSCR_BACK_COLOR")) props.Font = New Font(props.FontFamily, props.FontSize, props.FontStyle) props.SqlCommand1 = r.Item("CONTROL_SQLCOMMAND_1").ToString() props.SqlCommand2 = r.Item("CONTROL_SQLCOMMAND_2").ToString() props.StaticList = r.Item("CONTROL_STATIC_LIST").ToString() Return props Catch ex As Exception End Try End Function ''' ''' Hilfsfunktion, die allgemeine Eigenschaften für alle Controls setzt ''' ''' Das zu initialisierende Control ''' Das Eigenschaften Objekt ''' Das Control mit den allgemeinen Eigenschaften Private Function SetBaseProps(c As Control, props As ControlProps) Try c.Location = New Point(props.X, props.Y) c.Width = props.Width c.Height = props.Height c.Tag = props Return c Catch ex As Exception End Try End Function #End Region #Region "Data Loading Functions" Private Function LoadStaticList(props As ControlProps) As List(Of String) Dim staticlist As String = props.StaticList Dim list As List(Of String) = Nothing ' Wenn StaticList Elemente enthält, werden diese ' als DataSource aufbnereitet If (staticlist.Length > 0) Then list = staticlist.Split(";").ToList() End If Return list End Function Private Function ReplaceStaticPlaceholders(sqlcommand As String) As String Try If (New Regex(STATIC_PATTERN).IsMatch(sqlcommand)) Then Dim FormId As Integer = ClassControlCommands.GetFormId(Me.RecordId) Dim ParentRecordId As Integer = ClassControlCommands.GetParentRecordId(Me.RecordId) sqlcommand = sqlcommand _ .Replace("@RECORD_ID", Me.RecordId) _ .Replace("@RECORDID", Me.RecordId) _ .Replace("@FORM_ID", FormId) _ .Replace("@ENTITY_ID", FormId) If ParentRecordId > 0 Then sqlcommand = sqlcommand _ .Replace("@PARENTRECORDID", ParentRecordId) _ .Replace("@PARENTRECORD_ID", ParentRecordId) End If End If Return sqlcommand Catch ex As Exception Return sqlcommand End Try End Function Private Function LoadSQLList(props As ControlProps) As DataTable Dim sqllist As DataTable = Nothing Dim sqlcommand = props.SqlCommand1 Dim ControlIdRegex As New Regex(CONTROL_ID_PATTERN) If sqlcommand.Length = 0 Then Return sqllist End If ' Replace Dynamic Placeholders like @993@ If ControlIdRegex.IsMatch(sqlcommand) Then Dim match As String = ControlIdRegex.Match(sqlcommand).Value 'Get Full Match to replace later Dim controlId As Integer = Integer.Parse(match.Replace("@", "")) 'Get Value after removing @-chars Dim controlSQL = String.Format("SELECT VALUE FROM VWPMO_VALUES WHERE CONTROL_ID = {0} AND RECORD_ID = {1}", controlId, Me.RecordId) Dim controlValue = MYDB_ECM.GetScalarValue(controlSQL) 'Get the actual value sqlcommand = sqlcommand.Replace(match, controlValue.ToString()) 'Replace the actual value with the placeholder string/match End If ' Replace Static Placeholders like @RECORD_ID@ sqlcommand = ReplaceStaticPlaceholders(sqlcommand) sqllist = MYDB_ECM.GetDatatable(sqlcommand) Return sqllist End Function Private Function TransformSQLCommand(props As ControlProps) As ControlProps Return props End Function Private Function LoadDataSource(props As ControlProps) As ControlProps Dim datasource As Object = Nothing Dim staticList = LoadStaticList(props) Dim dynamicList = LoadSQLList(props) If staticList IsNot Nothing Then datasource = staticList End If If dynamicList IsNot Nothing Then datasource = dynamicList End If props.DataSource = datasource Return props End Function #End Region Private Sub LoadControls() Try Dim controls As New List(Of Control) DTControls = MYDB_ECM.GetDatatable(String.Format("SELECT * FROM VWPMO_CONTROL_SCREEN WHERE FORM_ID = {0}", GetEntityId())) For Each row As DataRow In DTControls.Rows Dim props As ControlProps = MapRowToProps(row) Dim control As Control = Nothing Select Case props.Type Case "Label" control = LoadLabel(props) Case "Textbox" control = LoadTextBox(props) Case "Combobox" control = LoadCombobox(props) Case "Datepicker" control = LoadDatePicker(props) Case "Datagridview" control = LoadDataGridView(props) Case "ListBox" control = LoadListBox(props) Case "CheckedListBox" control = LoadCheckedListBox(props) Case "Checkbox" control = LoadCheckBox(props) Case "Radiobutton" control = LoadRadioButton(props) Case "Picturebox" control = LoadPictureBox(props) End Select If control IsNot Nothing Then controls.Add(control) End If Next Me.Panel.Controls.Clear() Me.Panel.Controls.AddRange(controls.ToArray()) Catch ex As Exception End Try End Sub Private Sub PreventControlValueChanges() Try For Each c As Control In Me.Panel.Controls Dim type As String = DirectCast(c.Tag, ControlProps).Type If type = "CheckedListBox" Then Dim checklistbox = DirectCast(c, CheckedListBoxControl) AddHandler checklistbox.ItemChecking, Sub(sender As Object, e As DevExpress.XtraEditors.Controls.ItemCheckingEventArgs) e.Cancel = True End Sub End If Next Catch ex As Exception End Try End Sub Private Sub LoadValues(controlCollection As Control.ControlCollection) Try Dim controls As New List(Of Control) Dim oValueSQL = $"SELECT * FROM VWPMO_VALUES WHERE RECORD_ID = {Me.RecordId}" DTValues = MYDB_ECM.GetDatatable(oValueSQL) ' ControlCollection in eine List konvertieren controls = controlCollection.Cast(Of Control)().ToList() For Each control As Control In controls Dim controlId As Integer = DirectCast(control.Tag, ControlProps).Id Dim controlType As String = DirectCast(control.Tag, ControlProps).Type Dim values As List(Of Object) = (From row In DTValues.AsEnumerable() Where row.Item("CONTROL_ID") = controlId Select row.Item("VALUE")).ToList() ' Wenn kein Wert existiert, keinen Wert laden If values.Count = 0 And Not controlType = "Picturebox" Then Continue For Else LoadValue(control, values) End If Next Catch ex As Exception End Try End Sub Public Sub LoadValue(control As Control, values As List(Of Object)) Try Dim controlType As String = DirectCast(control.Tag, ControlProps).Type Dim value = Nothing If values.Count > 0 Then value = values(0) End If Select Case controlType Case "Label" ' Hier muss kein Wert geladen werden Exit Select Case "Textbox" DirectCast(control, TextBox).Text = value.ToString() Case "Combobox" DirectCast(control, TextBox).Text = value.ToString() Case "Datepicker" Dim dtp As TextBox = DirectCast(control, TextBox) Try dtp.Text = DateTime.Parse(value).ToShortDateString() Catch ex As Exception dtp.Text = "Invalid Date" End Try Case "Checkbox" Dim checkbox = DirectCast(control, CheckBox) Try checkbox.Checked = Boolean.Parse(value) Catch ex As Exception checkbox.Checked = False End Try Case "RadioButton" Dim radio = DirectCast(control, RadioButton) Try radio.Checked = Boolean.Parse(value) Catch ex As Exception radio.Checked = False End Try Case "Datagridview" Try Dim datagridview As ListBoxControl = DirectCast(control, ListBoxControl) datagridview.Items.AddRange(values.ToArray()) Catch ex As Exception ' Keine Items hinzufügen End Try Case "ListBox" Try Dim listbox As ListBoxControl = DirectCast(control, ListBoxControl) listbox.Items.AddRange(values.ToArray()) Catch ex As Exception ' Keine Items hinzufügen End Try Case "CheckedListBox" Try Dim checkedlist As CheckedListBoxControl = DirectCast(control, CheckedListBoxControl) For Each v As String In values Dim posBefore As Integer = 0 While (checkedlist.FindStringExact(v, posBefore) > -1) Dim pos = checkedlist.FindStringExact(v, posBefore) ' Wenn v gefunden wurde, anhaken If pos >= 0 Then checkedlist.SetItemCheckState(pos, CheckState.Checked) posBefore = pos + 1 End If ' Verhindere Endlosschleife If pos = 100 Then Exit While End If End While Next Catch ex As Exception ' Keine Items anchecken End Try Case "Picturebox" Try Dim pb As PictureBox = DirectCast(control, PictureBox) Dim controlId As Integer = DirectCast(control.Tag, ControlProps).Id Dim sql = String.Format("SELECT IMG FROM TBPMO_CONTROL_IMAGE WHERE RECORD_ID = {0} AND CONTROL_ID = {1}", Me.RecordId, controlId) Dim bimg() As Byte = MYDB_ECM.GetScalarValue(SQL) If Not IsNothing(bimg) Then Dim img As Bitmap = ByteArrayToBitmap(bimg) pb.BackgroundImage = img pb.BackgroundImageLayout = ImageLayout.Zoom End If Catch ex As Exception ' Kein Bild laden MsgBox(ex.Message) End Try End Select Catch ex As Exception End Try End Sub Class ControlProps ' Base Props Public Id As Integer Public Name As String Public Type As String Public Caption As String ' Position/Size Props Public X As Integer Public Y As Integer Public Height As Integer Public Width As Integer ' Font/Color Props Public FontColor As Color Public FontSize As Integer Public FontStyle As FontStyle Public FontFamily As String Public Font As Font Public BackColor As Color ' Flag Props Public IsRequired As Boolean Public IsReadOnly As Boolean Public IsMultiline As Boolean ' Data Props Public SqlCommand1 As String Public SqlCommand2 As String Public StaticList As String Public DataSource As Object ' Misc Props Public FormatType As String End Class #Region "Control Builder Simple" Private Function LoadLabel(props As ControlProps) As Label Try Dim label As Label = SetBaseProps(New Label, props) label.Text = props.Caption label.Font = props.Font label.ForeColor = props.FontColor 'label.BackColor = props.BackColor label.BackColor = Color.White label.AutoSize = True props = LoadDataSource(props) If (Not IsNothing(props.DataSource)) Then If props.DataSource.GetType() Is GetType(DataTable) Then Dim row0 As DataRow = DirectCast(props.DataSource, DataTable).Rows(0) Dim value = row0.Item(0) label.Text = value Else label.Text = props.DataSource.ToString() End If End If Return label Catch ex As Exception End Try End Function Private Function LoadTextBox(props As ControlProps) As TextBox Try Dim textbox As TextBox = SetBaseProps(New TextBox, props) textbox.BorderStyle = BorderStyle.FixedSingle textbox.Font = props.Font textbox.ForeColor = props.FontColor 'textbox.BackColor = props.BackColor textbox.BackColor = Color.White textbox.ReadOnly = True Return textbox Catch ex As Exception Return Nothing End Try End Function ' Die Combobox wird als Textbox dargestellt Private Function LoadCombobox(props As ControlProps) As TextBox Try Dim combo As TextBox = SetBaseProps(New TextBox, props) combo.BorderStyle = BorderStyle.FixedSingle combo.Font = props.Font combo.ForeColor = props.FontColor 'combo.BackColor = props.BackColor combo.BackColor = Color.White combo.ReadOnly = True Return combo Catch ex As Exception End Try End Function ' Der Datepicker wird als Textbox dargestellt Private Function LoadDatePicker(props As ControlProps) As TextBox Try Dim dtp As TextBox = SetBaseProps(New TextBox, props) dtp.BorderStyle = BorderStyle.FixedSingle dtp.Font = props.Font dtp.ForeColor = props.FontColor 'dtp.BackColor = props.BackColor dtp.BackColor = Color.White dtp.ReadOnly = True Return dtp Catch ex As Exception End Try End Function Private Function LoadCheckBox(props As ControlProps) As CheckBox Try Dim check As CheckBox = SetBaseProps(New CheckBox, props) check.Text = props.Caption check.AutoCheck = False Return check Catch ex As Exception End Try End Function Private Function LoadRadioButton(props As ControlProps) As RadioButton Try Dim radio As RadioButton = SetBaseProps(New RadioButton, props) radio.Text = props.Caption radio.AutoCheck = False Return radio Catch ex As Exception End Try End Function Private Function LoadListBox(props As ControlProps) As ListBoxControl Dim listbox As ListBoxControl = SetBaseProps(New ListBoxControl, props) Return listbox End Function Private Function LoadDataGridView(props As ControlProps) As ListBoxControl Dim datagridview As ListBoxControl = SetBaseProps(New ListBoxControl, props) Return datagridview End Function Private Function LoadCheckedListBox(props As ControlProps) As CheckedListBoxControl Try Dim checklistbox As CheckedListBoxControl = SetBaseProps(New CheckedListBoxControl, props) props = LoadDataSource(props) If Not IsNothing(props.StaticList) Then checklistbox.DataSource = props.StaticList End If If Not IsNothing(props.DataSource) Then If props.DataSource.GetType() Is GetType(DataTable) Then Dim dt As DataTable = props.DataSource If dt.Columns.Count = 1 Then checklistbox.DisplayMember = dt.Columns(0).ColumnName checklistbox.ValueMember = dt.Columns(0).ColumnName ElseIf dt.Columns.Count = 2 Then checklistbox.DisplayMember = dt.Columns(1).ColumnName checklistbox.ValueMember = dt.Columns(0).ColumnName End If End If checklistbox.DataSource = props.DataSource End If Return checklistbox Catch ex As Exception End Try End Function Private Function LoadPictureBox(props As ControlProps) As PictureBox Dim pb As PictureBox = SetBaseProps(New PictureBox, props) pb.BorderStyle = BorderStyle.FixedSingle Return pb End Function #End Region End Class