Imports DevExpress.XtraEditors Imports System.Text.RegularExpressions Public Class ClassRecordView Private DTControls As DataTable Private DTValues As DataTable Private RecordId As Integer Private FormId 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) Me.RecordId = recordId Me.LoadControls(Me.Panel) Me.LoadValues(Me.Panel.Controls) End Sub #Region "Helper Functions" Private Sub Noop() ' Verhindert Bestimmte Events End Sub Private Function GetFormId() As Integer Dim SQL = String.Format("SELECT FORM_ID FROM TBPMO_RECORD WHERE GUID = {0}", Me.RecordId) Me.FormId = ClassDatabase.Execute_Scalar(SQL) Return Me.FormId End Function Private Function MapRowToProps(r As DataRow) As ControlProps 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 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) c.Location = New Point(props.X, props.Y) c.Width = props.Width c.Height = props.Height c.Tag = props Return c 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 If (New Regex(STATIC_PATTERN).IsMatch(sqlcommand)) Then sqlcommand = sqlcommand _ .Replace("@RECORD_ID", Me.RecordId) _ .Replace("@RECORDID", Me.RecordId) ' TODO: Add more placeholders End If Return sqlcommand 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 = ClassDatabase.Execute_Scalar(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 = ClassDatabase.Return_Datatable(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(panel As Panel) Dim controls As New List(Of Control) DTControls = ClassDatabase.Return_Datatable(String.Format("SELECT * FROM VWPMO_CONTROL_SCREEN WHERE FORM_ID = {0}", GetFormId())) 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) End Select If control IsNot Nothing Then controls.Add(control) End If Next panel.Controls.Clear() panel.Controls.AddRange(controls.ToArray()) End Sub Private Sub LoadValues(controlCollection As Control.ControlCollection) Dim controls As New List(Of Control) DTValues = ClassDatabase.Return_Datatable(String.Format("SELECT * FROM VWPMO_VALUES WHERE RECORD_ID = {0}", Me.RecordId)) ' 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 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 Then Continue For Else LoadValue(control, values) End If Next End Sub Public Sub LoadValue(control As Control, values As List(Of Object)) Dim controlType As String = DirectCast(control.Tag, ControlProps).Type Dim value = Nothing If values.Count > 0 Then value = values(0) Else Exit Sub 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" Try DirectCast(control, TextBox).Text = DateTime.Parse(value).ToShortDateString() Catch ex As Exception End Try Case "Checkbox" Try DirectCast(control, CheckBox).Checked = Boolean.Parse(value) Catch ex As Exception DirectCast(control, CheckBox).Checked = False End Try Case "RadioButton" Try DirectCast(control, RadioButton).Checked = Boolean.Parse(value) Catch ex As Exception DirectCast(control, RadioButton).Checked = False End Try Case "Datagridview" Try Dim datagridview As ListBoxControl = DirectCast(control, ListBoxControl) datagridview.Items.AddRange(values.ToArray()) Catch ex As Exception End Try Case "ListBox" Try Dim listbox As ListBoxControl = DirectCast(control, ListBoxControl) listbox.Items.AddRange(values.ToArray()) Catch ex As Exception 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 End Try End Select 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 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.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 End Function Private Function LoadTextBox(props As ControlProps) As TextBox 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.ReadOnly = True Return textbox End Function ' Die Combobox wird als Textbox dargestellt Private Function LoadCombobox(props As ControlProps) As TextBox 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.ReadOnly = True Return combo End Function ' Der Datepicker wird als Textbox dargestellt Private Function LoadDatePicker(props As ControlProps) As TextBox 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.ReadOnly = True Return dtp End Function Private Function LoadCheckBox(props As ControlProps) As CheckBox Dim check As CheckBox = SetBaseProps(New CheckBox, props) check.Text = props.Caption check.Enabled = False Return check End Function Private Function LoadRadioButton(props As ControlProps) As RadioButton Dim radio As RadioButton = SetBaseProps(New RadioButton, props) radio.Text = props.Caption radio.Enabled = False Return radio 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 Dim checklistbox As CheckedListBoxControl = SetBaseProps(New CheckedListBoxControl, props) props = LoadDataSource(props) 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 End Function #End Region End Class