Imports DD_LIB_Standards Public Class frmFormDesigner Public ProfileId As Integer Public ProfileName As String Public ProfileObjectType As String ' Control Variables Private CurrentControl As Control = Nothing ' Movement Variables Private Mouse_IsPressed As Boolean Private Mouse_IsMoving As Boolean Private Mouse_BeginLocation As Point Private Mouse_EndLocation As Point ' Windream List Data Private Windream_ChoiceLists As List(Of String) Private Windream_Indicies As List(Of String) Private Windream_VectorIndicies As List(Of String) Private Sub frmFormDesigner_Load(sender As Object, e As EventArgs) Handles Me.Load Try ' Profil Name in Fenstertitel setzen Text = $"{Text} - Profil: {ProfileName}" Try ' Windream initialisieren clsWindream.Create_Session() 'Windream Abfragen, sollten einmal beim Start des Formulars geladen werden Windream_Indicies = clsWD_GET.GetIndicesByObjecttype(CURRENT_OBJECTTYPE).ToList() Windream_ChoiceLists = clsWD_GET.GetChoiceLists() Windream_VectorIndicies = Windream_Indicies.FindAll(AddressOf IsVectorIndex) Catch ex As Exception MsgBox("Fehler bei Initialisieren von windream: " & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Achtung:") End Try Try TBPM_PROFILE_CONTROLSTableAdapter.Connection.ConnectionString = MyConnectionString TBPM_CONNECTIONTableAdapter.Connection.ConnectionString = MyConnectionString TBWH_CHECK_PROFILE_CONTROLSTableAdapter.Connection.ConnectionString = MyConnectionString TBPM_CONTROL_TABLETableAdapter.Connection.ConnectionString = MyConnectionString TBPM_CONNECTIONTableAdapter.Fill(DD_DMSLiteDataSet.TBPM_CONNECTION) Catch ex As Exception MsgBox("Fehler bei Laden der Connection-Strings und Grunddaten: " & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Achtung:") End Try LoadControls() Catch ex As Exception MsgBox(ex.Message, MsgBoxStyle.Critical, "error loading form:") End Try End Sub Private Sub frmFormDesigner_FormClosing(sender As Object, e As FormClosingEventArgs) Handles Me.FormClosing If ProfileId > 0 Then Dim sql As String = $"SELECT NAME, INDEX_NAME FROM TBPM_PROFILE_CONTROLS WHERE PROFIL_ID = {ProfileId} AND CTRL_TYPE <> 'LBL' AND CTRL_TYPE <> 'LINE'" Dim dt As DataTable = ClassDatabase.Return_Datatable(sql) Dim missingIndexControls As New List(Of String) For Each row As DataRow In dt.Rows If NotNull(row.Item("INDEX_NAME"), String.Empty) = String.Empty Then missingIndexControls.Add(row.Item("NAME")) End If Next If missingIndexControls.Count > 0 Then e.Cancel = True Dim missingControls As String = String.Join(vbCrLf, missingIndexControls.ToArray()) MsgBox($"Für die folgenden Controls wurden noch keine Indexdefinitionen hinterlegt: {vbCrLf}{vbCrLf}{missingControls}") End If End If If Application.OpenForms().OfType(Of frmControl_Detail).Any Then frmControl_Detail.Close() End If End Sub ''' ''' Filtert aus der Liste von Indexen die Vektor Indexe heraus ''' Private Function IsVectorIndex(index As String) As Boolean Dim type As Integer = clsWD_GET.GetTypeOfIndexAsIntByName(index) 'Vektor Zahl Oder Vektor String Return (type = 4107 Or type = 4097) End Function Sub LoadControls() Try TBPM_PROFILE_CONTROLSTableAdapter.FillByProfil(DD_DMSLiteDataSet.TBPM_PROFILE_CONTROLS, ProfileId) TBPM_CONTROL_TABLETableAdapter.FillAll(DD_DMSLiteDataSet.TBPM_CONTROL_TABLE) ' löscht alle Controls pnldesigner.Controls.Clear() Dim dt As DataTable = DD_DMSLiteDataSet.TBPM_PROFILE_CONTROLS For Each row As DataRow In dt.Rows ' Ein Base Control erstellen Dim guid As Integer = row.Item("GUID") Dim name As String = row.Item("NAME") Dim x As Integer = row.Item("X_LOC") Dim y As Integer = row.Item("Y_LOC") Dim style As FontStyle = NotNull(row.Item("FONT_STYLE"), FontStyle.Regular) Dim size As Single = NotNull(row.Item("FONT_SIZE"), 10) Dim familyString As String = NotNull(row.Item("FONT_FAMILY"), "Arial") Dim family As FontFamily = New FontFamily(familyString) Dim font As New Font(family, size, style, GraphicsUnit.Point) Dim color As Color = IntToColor(NotNull(row.Item("FONT_COLOR"), 0)) ' Jetzt die Control spezifischen Eigenschaften zuweisen Select Case row.Item("CTRL_TYPE") Case "TXT" Dim txt = ClassControlCreator.CreateExistingTextbox(row, True) pnldesigner.Controls.Add(txt) SetMovementHandlers(txt) Case "LBL" Dim lbl = ClassControlCreator.CreateExistingLabel(row, True) pnldesigner.Controls.Add(lbl) SetMovementHandlers(lbl) Case "CMB" Dim cmb = ClassControlCreator.CreateExistingCombobox(row, True) pnldesigner.Controls.Add(cmb) SetMovementHandlers(cmb) Case "DTP" Dim dtp = ClassControlCreator.CreateExistingDatepicker(row, True) pnldesigner.Controls.Add(dtp) SetMovementHandlers(dtp) Case "CHK" Dim chk = ClassControlCreator.CreateExisingCheckbox(row, True) pnldesigner.Controls.Add(chk) SetMovementHandlers(chk) Case "DGV" Dim dgv = ClassControlCreator.CreateExistingDataGridView(row, True) pnldesigner.Controls.Add(dgv) SetMovementHandlers(dgv) Case "TABLE" Dim findControlColumnsQuery = (From r As DD_DMSLiteDataSet.TBPM_CONTROL_TABLERow In DD_DMSLiteDataSet.TBPM_CONTROL_TABLE Where r.CONTROL_ID = guid Select r) Dim columns As List(Of DD_DMSLiteDataSet.TBPM_CONTROL_TABLERow) = findControlColumnsQuery.ToList() Dim table = ClassControlCreator.CreateExistingTable(row, columns, True) AddHandler table.ColumnHeaderMouseClick, AddressOf table_ColumnHeaderMouseClick pnldesigner.Controls.Add(table) SetMovementHandlers(table) Case "LINE" Dim line = ClassControlCreator.CreateExistingLine(row, True) pnldesigner.Controls.Add(line) SetMovementHandlers(line) End Select Next Catch ex As Exception MsgBox("Fehler bei LoadControls " & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Achtung:") End Try End Sub Private Sub DragDropButtons_MouseDown(sender As Object, e As MouseEventArgs) Handles btnlabel.MouseDown, btntextbox.MouseDown, btncmb.MouseDown, btndtp.MouseDown, btnVektor.MouseDown, btnTabelle.MouseDown, btnCheckbox.MouseDown, btnLine.MouseDown Mouse_IsPressed = True CurrentControl = Nothing Try TBPM_PROFILE_CONTROLSBindingSource.Clear() Catch ex As Exception End Try End Sub Private Sub DragDropButtons_MouseMove(sender As Object, e As MouseEventArgs) Handles btnlabel.MouseMove, btntextbox.MouseMove, btncmb.MouseMove, btndtp.MouseMove, btnVektor.MouseMove, btnTabelle.MouseMove, btnCheckbox.MouseMove, btnLine.MouseMove If Mouse_IsPressed Then Dim btn As Button = sender Dim dragDropData As String Select Case btn.Name Case "btnlabel" dragDropData = ClassControlCreator.PREFIX_LABEL Case "btntextbox" dragDropData = ClassControlCreator.PREFIX_TEXTBOX Case "btncmb" dragDropData = ClassControlCreator.PREFIX_COMBOBOX Case "btndtp" dragDropData = ClassControlCreator.PREFIX_DATETIMEPICKER Case "btnVektor" dragDropData = ClassControlCreator.PREFIX_DATAGRIDVIEW Case "btnTabelle" dragDropData = ClassControlCreator.PREFIX_TABLE Case "btnCheckbox" dragDropData = ClassControlCreator.PREFIX_CHECKBOX Case "btnLine" dragDropData = ClassControlCreator.PREFIX_LINE End Select btn.DoDragDrop(dragDropData, DragDropEffects.Copy) End If End Sub Private Sub DragDropButtons_MouseUp(sender As Object, e As MouseEventArgs) Handles btnlabel.MouseUp, btntextbox.MouseUp, btncmb.MouseUp, btndtp.MouseUp, btnVektor.MouseUp, btnTabelle.MouseUp, btnCheckbox.MouseUp, btnLine.MouseUp Mouse_IsPressed = False End Sub Private Sub pnlDesigner_DragDrop(sender As Object, e As DragEventArgs) Handles pnldesigner.DragDrop Dim cursorPosition As Point = pnldesigner.PointToClient(Cursor.Position) Mouse_IsPressed = False Select Case e.Data.GetData(DataFormats.Text) Case ClassControlCreator.PREFIX_LABEL Dim label = ClassControlCreator.CreateNewLabel(cursorPosition) SetMovementHandlers(label) TBPM_PROFILE_CONTROLSTableAdapter.cmdInsertAnlage(ProfileId, label.Name, "LBL", label.Text, label.Location.X, label.Location.Y, Environment.UserName, label.Size.Height, label.Size.Width) CurrentControl = label CurrentControl.Tag = GetLastID() pnldesigner.Controls.Add(label) Case ClassControlCreator.PREFIX_TEXTBOX Dim txt = ClassControlCreator.CreateNewTextBox(cursorPosition) SetMovementHandlers(txt) TBPM_PROFILE_CONTROLSTableAdapter.cmdInsertAnlage(ProfileId, txt.Name, "TXT", txt.Name, txt.Location.X, txt.Location.Y, Environment.UserName, txt.Size.Height, txt.Size.Width) CurrentControl = txt CurrentControl.Tag = GetLastID() pnldesigner.Controls.Add(txt) Case ClassControlCreator.PREFIX_COMBOBOX Dim cmb = ClassControlCreator.CreateNewCombobox(cursorPosition) SetMovementHandlers(cmb) TBPM_PROFILE_CONTROLSTableAdapter.cmdInsertAnlage(ProfileId, cmb.Name, "CMB", cmb.Name, cmb.Location.X, cmb.Location.Y, Environment.UserName, cmb.Size.Height, cmb.Size.Width) CurrentControl = cmb CurrentControl.Tag = GetLastID() pnldesigner.Controls.Add(cmb) Case ClassControlCreator.PREFIX_DATETIMEPICKER Dim dtp = ClassControlCreator.CreateNewDatetimepicker(cursorPosition) SetMovementHandlers(dtp) TBPM_PROFILE_CONTROLSTableAdapter.cmdInsertAnlage(ProfileId, dtp.Name, "DTP", dtp.Name, dtp.Location.X, dtp.Location.Y, Environment.UserName, dtp.Size.Height, dtp.Size.Width) CurrentControl = dtp CurrentControl.Tag = GetLastID() pnldesigner.Controls.Add(dtp) Case ClassControlCreator.PREFIX_CHECKBOX Dim chk = ClassControlCreator.CreateNewCheckbox(cursorPosition) SetMovementHandlers(chk) TBPM_PROFILE_CONTROLSTableAdapter.cmdInsertAnlage(ProfileId, chk.Name, "CHK", chk.Text, chk.Location.X, chk.Location.Y, Environment.UserName, chk.Size.Height, chk.Size.Width) CurrentControl = chk CurrentControl.Tag = GetLastID() pnldesigner.Controls.Add(chk) Case ClassControlCreator.PREFIX_DATAGRIDVIEW Dim dgv = ClassControlCreator.CreateNewDatagridview(cursorPosition) SetMovementHandlers(dgv) TBPM_PROFILE_CONTROLSTableAdapter.cmdInsertAnlage(ProfileId, dgv.Name, "DGV", dgv.Name, dgv.Location.X, dgv.Location.Y, Environment.UserName, dgv.Size.Height, dgv.Size.Width) CurrentControl = dgv CurrentControl.Tag = GetLastID() pnldesigner.Controls.Add(dgv) Case ClassControlCreator.PREFIX_TABLE Dim tb = ClassControlCreator.CreateNewTable(cursorPosition) SetMovementHandlers(tb) AddHandler tb.ColumnHeaderMouseClick, AddressOf table_ColumnHeaderMouseClick TBPM_PROFILE_CONTROLSTableAdapter.cmdInsertAnlage(ProfileId, tb.Name, "TABLE", tb.Name, tb.Location.X, tb.Location.Y, Environment.UserName, tb.Size.Height, tb.Size.Width) CurrentControl = tb CurrentControl.Tag = GetLastID() TBPM_CONTROL_TABLETableAdapter.Insert(CurrentControl.Tag, "column1", "Column1", 95, Environment.UserName) TBPM_CONTROL_TABLETableAdapter.Insert(CurrentControl.Tag, "column2", "Column2", 95, Environment.UserName) pnldesigner.Controls.Add(tb) Case ClassControlCreator.PREFIX_LINE Dim line = ClassControlCreator.CreateNewLine(cursorPosition) SetMovementHandlers(line) TBPM_PROFILE_CONTROLSTableAdapter.cmdInsertAnlage(ProfileId, line.Name, "LINE", line.Name, line.Location.X, line.Location.Y, Environment.UserName, line.Size.Height, line.Size.Width) CurrentControl = line CurrentControl.Tag = GetLastID() pnldesigner.Controls.Add(line) End Select End Sub Private Sub pnlDesigner_DragEnter(sender As System.Object, e As DragEventArgs) Handles pnldesigner.DragEnter ' Check the format of the data being dropped. If (e.Data.GetDataPresent(DataFormats.Text)) Then ' Display the copy cursor. e.Effect = DragDropEffects.Copy Else ' Display the no-drop cursor. e.Effect = DragDropEffects.None End If End Sub Private Function GetLastID() Dim sql = String.Format("SELECT MAX(GUID) FROM TBPM_PROFILE_CONTROLS WHERE PROFIL_ID = {0}", ProfileId) Return ClassDatabase.Execute_Scalar(sql, MyConnectionString, True) End Function Sub SetActiveControlColor() CurrentControl.BackColor = Color.DarkOrange ' Reset Color of all other controls For Each inctrl As Control In Me.pnldesigner.Controls If inctrl.Name <> CurrentControl.Name Then Dim Type As String = inctrl.GetType.ToString Select Case Type Case "System.Windows.Forms.TextBox" inctrl.BackColor = Color.White Case "System.Windows.Forms.ComboBox" inctrl.BackColor = Color.White Case "System.Windows.Forms.Label" inctrl.BackColor = Color.Transparent Case "System.Windows.Forms.CheckBox" inctrl.BackColor = Color.Transparent Case "DD_PM_WINDREAM.ClassControlCreator+LineLabel" inctrl.BackColor = inctrl.ForeColor End Select End If Next End Sub Public Sub table_ColumnHeaderMouseClick(sender As System.Object, e As DataGridViewCellMouseEventArgs) CurrentControl = sender Dim dgv As DataGridView = sender CurrentControl = dgv Dim dgvColumn As DataGridViewColumn = dgv.Columns(e.ColumnIndex) Dim columnId = TBPM_CONTROL_TABLETableAdapter.getColumnID(CURRENT_CONTROL_ID, dgvColumn.Name) Dim frmTableColumn = New frmControl_Detail() frmTableColumn.FillData(columnId) frmTableColumn.Text = "Konfiguration von Spalte: " & dgvColumn.Name frmTableColumn.Show() End Sub Sub DeleteControl(controlName As String) Try Dim result As MsgBoxResult = MsgBox("Wollen Sie das Control: " & controlName & " wirklich löschen?", MsgBoxStyle.YesNo, "Bestätigung:") ' wenn Speichern ja If result = MsgBoxResult.Yes Then Dim controlId As Integer = TBPM_PROFILE_CONTROLSTableAdapter.cmdGetGUID(ProfileId, controlName) If controlId > 0 Then Me.TBPM_CONTROL_TABLETableAdapter.Delete(controlId) TBPM_PROFILE_CONTROLSTableAdapter.Delete(controlId) LoadControls() End If End If Catch ex As Exception MsgBox(ex.Message, MsgBoxStyle.Critical, "DeleteControl:") End Try End Sub ' +++ Public Helper Methods +++ Public Function GetCursorPosition() As Point Return pnldesigner.PointToClient(Cursor.Position) End Function Private Sub btndelete_Click(sender As System.Object, e As EventArgs) Handles btndelete.Click If CurrentControl Is Nothing = False Then DeleteControl(CurrentControl.Name) TabControlEigenschaften.Enabled = False End If End Sub Private Sub btnwidth_plus_Click(sender As System.Object, e As EventArgs) Handles btnwidth_plus.Click If CurrentControl Is Nothing = False Then CurrentControl.Size = New Size(CurrentControl.Width + 5, CurrentControl.Height) UpdateSingleValue("WIDTH", CurrentControl.Size.Width) End If End Sub Private Sub btnwidth_minus_Click(sender As System.Object, e As EventArgs) Handles btnwidth_minus.Click If CurrentControl Is Nothing = False Then Dim newWidth = CurrentControl.Width - 5 ' Verhindert, dass das Control unsichtbar wird If newWidth > 1 Then Exit Sub End If CurrentControl.Size = New Size(newWidth, CurrentControl.Height) UpdateSingleValue("WIDTH", CurrentControl.Size.Width) End If End Sub Private Sub btnheight_plus_Click(sender As System.Object, e As EventArgs) Handles btnheight_plus.Click If CurrentControl Is Nothing = False Then Dim newHeight As Integer = CurrentControl.Height + 5 If newHeight > 21 And TypeOf CurrentControl Is TextBox Then DirectCast(CurrentControl, TextBox).Multiline = True End If CurrentControl.Size = New Size(CurrentControl.Width, newHeight) UpdateSingleValue("WIDTH", newHeight) End If End Sub Private Sub btnheight_minus_Click(sender As System.Object, e As EventArgs) Handles btnheight_minus.Click If CurrentControl Is Nothing = False Then Dim newHeight As Integer = CurrentControl.Height - 5 If newHeight < 22 And TypeOf CurrentControl Is TextBox Then DirectCast(CurrentControl, TextBox).Multiline = True End If ' Verhindert, dass das Control unsichtbar wird If newHeight > 1 Then Exit Sub End If CurrentControl.Size = New Size(CurrentControl.Width, newHeight) UpdateSingleValue("WIDTH", newHeight) End If End Sub Private Sub btnrefresh_Click(sender As Object, e As EventArgs) Handles btnrefresh.Click LoadControls() End Sub ''' ''' Setzt die Eventhandler für ein Control, die für die Bewegung via Drag & Drop und das Laden der Eigentschaften verantwortlich sind ''' ''' Das Control, für das die Eventhandler gesetzt werden sollen Private Sub SetMovementHandlers(control As Control) AddHandler control.MouseDown, AddressOf OnControl_MouseDown AddHandler control.MouseUp, AddressOf OnControl_MouseUp AddHandler control.MouseMove, AddressOf OnControl_MouseMove End Sub Private Sub OnControl_MouseDown(sender As Control, e As MouseEventArgs) If e.Button = MouseButtons.Left Then CurrentControl = sender Mouse_BeginLocation = e.Location sender.BringToFront() Mouse_IsPressed = True Console.WriteLine("CURRENT_CONTROL:" & CurrentControl.Name) End If End Sub Private Sub OnControl_MouseUp(sender As Control, e As MouseEventArgs) Mouse_IsPressed = False ' Ersten Tab anzeigen TabControlEigenschaften.SelectTab(0) ' Control Eigenschaften laden LoadControlProperties(sender) If Mouse_IsMoving = False Then MyBase.Cursor = Cursors.Default Exit Sub End If Mouse_IsMoving = False Dim CurrentPosition = CurrentControl.Location Dim OldPosition As Point = DirectCast(pgControls.SelectedObject, BaseProperties).Location If Not Point.op_Inequality(CurrentPosition, OldPosition) Then MyBase.Cursor = Cursors.Default Exit Sub End If ' Das Control sollte nicht außerhalb des Panels geschoben werden (Koordinaten kleiner 0) If CurrentPosition.X < 0 Then CurrentControl.Location = New Point(0, CurrentControl.Location.Y) End If If CurrentPosition.Y < 0 Then CurrentControl.Location = New Point(CurrentControl.Location.X, 0) End If ' Ebenso nicht über die Größe des Panels (X-Achse) If CurrentPosition.X > pnldesigner.Width Then CurrentControl.Location = New Point(pnldesigner.Width - CurrentControl.Width, CurrentControl.Location.Y) End If ' Ebenso nicht über die Größe des Panels (Y-Achse) If CurrentPosition.Y > pnldesigner.Height Then CurrentControl.Location = New Point(CurrentControl.Location.X, pnldesigner.Height - CurrentControl.Height) End If DirectCast(pgControls.SelectedObject, BaseProperties).Location = CurrentControl.Location UpdateSingleValue("X_LOC", CurrentControl.Location.X) UpdateSingleValue("Y_LOC", CurrentControl.Location.Y) MyBase.Cursor = Cursors.Default End Sub Private Sub OnControl_MouseMove(sender As Control, e As MouseEventArgs) Try If CurrentControl Is Nothing Then Exit Sub End If Mouse_IsMoving = True If Mouse_IsPressed Then Cursor = Cursors.Hand Refresh() Dim CurrentPosition As Point = GetCursorPosition() If Point.op_Inequality(CurrentPosition, Mouse_BeginLocation) Then CurrentControl.Location = New Point(CurrentPosition.X - Mouse_BeginLocation.X, CurrentPosition.Y - Mouse_BeginLocation.Y) End If End If Catch ex As Exception Mouse_IsMoving = False End Try End Sub ''' ''' Weist die grundlegenden Eigenschaften zu einem Properties Objekt zu ''' Die Properties werden an das Property Grid weitergegeben ''' ''' Das grundlegende Properties Objekt ''' Die DataRow, die die Eigenschaften des Controls enthält ''' Das gefüllt Properties Objekt Private Function CreatePropsObject(obj As BaseProperties, row As DataRow, Optional indicies As List(Of String) = Nothing) obj.ID = row.Item("GUID") obj.Location = New Point(row.Item("X_LOC"), row.Item("Y_LOC")) obj.Name = row.Item("NAME") obj.Size = New Size(row.Item("WIDTH"), row.Item("HEIGHT")) obj.ChangedAt = NotNull(row.Item("CHANGED_WHEN"), Nothing) obj.ChangedWho = NotNull(row.Item("CHANGED_WHO"), "") Dim style As FontStyle = NotNull(row.Item("FONT_STYLE"), FontStyle.Regular) Dim size As Single = NotNull(row.Item("FONT_SIZE"), 10) Dim familyString As String = NotNull(row.Item("FONT_FAMILY"), "Arial") Dim family As FontFamily = New FontFamily(familyString) obj.Font = New Font(family, size, style) Dim color As Integer = NotNull(row.Item("FONT_COLOR"), 0) obj.TextColor = IntToColor(color) Return obj End Function ''' ''' Funktioniert wie CreatePropsObject mit dem Unterschied, dass zusätzlich noch eine Liste von Indicies übergeben wird ''' Diese können dann im PropertyGrid angezeigt und ausgewählt werden. ''' Außerdem werden noch einige Eigenschaften gesetzt, die alle Controls (außer reine Anzeige-Controls) haben ''' ''' Das grundlegende Properties Objekt ''' Die DataRow, die die Eigenschaften des Controls enthält ''' Eine Liste von Indicies ''' Das gefüllt Properties Objekt Private Function CreatePropsObjectWithIndicies(obj As InputProperties, row As DataRow, indicies As List(Of String)) obj = CreatePropsObject(obj, row) obj.Indicies = indicies obj.ReadOnly = StrToBool(row.Item("READ_ONLY")) obj.Required = StrToBool(row.Item("VALIDATION")) obj.Index = NotNull(row.Item("INDEX_NAME"), "") obj.SQLCommand = New InputProperties.SQLValue(row.Item("SQL_UEBERPRUEFUNG")) Return obj End Function Private Sub LoadControlProperties(sender As Control) Dim props Dim dt As DataTable = DD_DMSLiteDataSet.TBPM_PROFILE_CONTROLS Dim row As DataRow TabControlEigenschaften.Enabled = True ' Beim Laden der Eigenschaften eines Controls muss die ganze Datatable neu geladen werden ' Nicht wirklich, aber gibt gerade keine bessere Möglichkeit, ohne alle SQL Abfragen selbst auszuführen TBPM_PROFILE_CONTROLSTableAdapter.FillByProfil(DD_DMSLiteDataSet.TBPM_PROFILE_CONTROLS, ProfileId) row = dt.AsEnumerable().Where(Function(r As DataRow) Return r.Item("GUID") = sender.Tag End Function).Single() ' Globale Variablen setzen CurrentControl = sender CURRENT_CONTROL_ID = sender.Tag SetActiveControlColor() ' Mithilfe von CreatePropsObject(WithIndicies) wird ein Basis Objekt mit grundlegenden ' Eigenschaften angelegt. Danach können für jeden Control Typ spezifische Eigenschaften festgelegt werden. If TypeOf sender Is ClassControlCreator.LineLabel Then Dim line As ClassControlCreator.LineLabel = sender Dim lineProps As LineLabelProperties = CreatePropsObject(New LineLabelProperties, row) props = lineProps ElseIf TypeOf sender Is Label Then Dim label As Label = sender Dim labelProps As LabelProperties = CreatePropsObject(New LabelProperties, row) labelProps.Text = label.Text props = labelProps ElseIf TypeOf sender Is CheckBox Then Dim check As CheckBox = sender Dim checkProps As CheckboxProperties = CreatePropsObjectWithIndicies(New CheckboxProperties, row, Windream_Indicies) checkProps.Text = check.Text props = checkProps ElseIf TypeOf sender Is TextBox Then Dim txt As TextBox = sender Dim txtProps As TextboxProperties = CreatePropsObjectWithIndicies(New TextboxProperties, row, Windream_Indicies) props = txtProps ElseIf TypeOf sender Is ComboBox Then Dim cmb As ComboBox = sender Dim cmbProps As ComboboxProperties = CreatePropsObjectWithIndicies(New ComboboxProperties, row, Windream_Indicies) cmbProps.ChoiceLists = Windream_ChoiceLists cmbProps.ChoiceList = NotNull(row.Item("CHOICE_LIST"), "") props = cmbProps ElseIf TypeOf sender Is DateTimePicker Then Dim dtp As DateTimePicker = sender Dim dtpProps As DatepickerProperties = CreatePropsObjectWithIndicies(New DatepickerProperties, row, Windream_Indicies) props = dtpProps ElseIf TypeOf sender Is DataGridView Then Dim grid As DataGridView = sender Dim gridProps As GridViewProperties = CreatePropsObjectWithIndicies(New GridViewProperties, row, Windream_VectorIndicies) props = gridProps Else MsgBox("This is not a supported control type!") Exit Sub End If ' Zum Schluss wird das Eigenschaften-Objekt ins PropertyGrid geladen pgControls.SelectedObject = props End Sub Private Sub pgControls_PropertyValueChanged(s As Object, e As PropertyValueChangedEventArgs) Handles pgControls.PropertyValueChanged Dim oldValue As Object = e.OldValue Dim newValue As Object = e.ChangedItem.Value Dim prop As String = e.ChangedItem.Label Select Case prop Case "Location" UpdateSingleValue("X_LOC", DirectCast(newValue, Point).X) UpdateSingleValue("Y_LOC", DirectCast(newValue, Point).Y) CurrentControl.Location = newValue Case "X" UpdateSingleValue("X_LOC", CInt(newValue)) CurrentControl.Location = New Point(newValue, CurrentControl.Location.Y) Case "Y" UpdateSingleValue("Y_LOC", CInt(newValue)) CurrentControl.Location = New Point(CurrentControl.Location.X, newValue) Case "Size" UpdateSingleValue("WIDTH", DirectCast(newValue, Size).Width) UpdateSingleValue("HEIGHT", DirectCast(newValue, Size).Height) CurrentControl.Size = newValue Case "Width" UpdateSingleValue("WIDTH", CInt(newValue)) CurrentControl.Size = New Size(newValue, CurrentControl.Size.Height) Case "Height" UpdateSingleValue("HEIGHT", CInt(newValue)) CurrentControl.Size = New Size(CurrentControl.Size.Width, newValue) Case "Name" UpdateSingleValue("NAME", newValue) CurrentControl.Name = newValue Case "Index" UpdateSingleValue("INDEX_NAME", newValue) Case "Text" UpdateSingleValue("CTRL_TEXT", newValue) CurrentControl.Text = newValue Case "Required" UpdateSingleValue("VALIDATION", IIf(newValue = True, 1, 0)) Case "ReadOnly" UpdateSingleValue("READ_ONLY", IIf(newValue = True, 1, 0)) Case "Font" Dim font As Font = newValue Dim fontSize As Integer = Math.Truncate(font.SizeInPoints) UpdateSingleValue("FONT_SIZE", fontSize) UpdateSingleValue("FONT_FAMILY", font.FontFamily.Name) UpdateSingleValue("FONT_STYLE", font.Style.ToString) CurrentControl.Font = font Case "TextColor" Dim color As Color = newValue UpdateSingleValue("FONT_COLOR", ColorToInt(color)) CurrentControl.ForeColor = color Case "SQLCommand" UpdateSingleValue("SQL_UEBERPRUEFUNG", newValue) UpdateSingleValue("CHOICE_LIST", "") Case "ChoiceList" UpdateSingleValue("CHOICE_LIST", newValue) UpdateSingleValue("SQL_UEBERPRUEFUNG", "") End Select End Sub Private Sub UpdateSingleValue(columnName As String, value As Object) Dim guid As Integer = CURRENT_CONTROL_ID Dim escapedValue = value ' Strings und SQL-Commands müssen vor dem Speichern escaped und mit Anführungszeichen versehen werden If TypeOf value Is String Then escapedValue = $"'{value}'" ElseIf TypeOf value Is InputProperties.SQLValue Then Dim v As InputProperties.SQLValue = value escapedValue = $"'{v.Value.Replace("'", "''")}'" End If Try ClassDatabase.Execute_non_Query($"UPDATE TBPM_PROFILE_CONTROLS SET {columnName} = {escapedValue}, CHANGED_WHO = '{Environment.UserName}' WHERE GUID = {guid}") tslblAenderungen.Visible = True tslblAenderungen.Text = "Änderungen gespeichert - " & Now Catch ex As Exception Dim msg = $"UpdateSingleValue - Fehler beim Speichern von Control (Id: {guid}): {vbCrLf}{ex.Message}" MsgBox(msg) ClassLogger.Add(msg) End Try End Sub End Class