Imports System.ComponentModel Imports DD_LIB_Standards Imports DevExpress.XtraGrid Imports DevExpress.XtraGrid.Columns Imports DevExpress.XtraGrid.Views.Grid Imports DevExpress.XtraGrid.Views.Grid.ViewInfo Imports DigitalData.Controls.LookupGrid Imports DigitalData.Modules.Language.Utils Imports System.Drawing Imports DigitalData.GUIs.Common Public Class frmFormDesigner Public ProfileId As Integer Public ProfileName As String Public ProfileObjectType As String Public Designer_Locked As Boolean = True Public ControlSelected 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 Source_AllIndicies As List(Of String) Private Source_VectorIndicies As List(Of String) Private Source_SimpleIndicies As List(Of String) Private Source_LookupIndicies As List(Of String) Private CurrentColumnId As Integer = 0 Private Sub frmFormDesigner_Load(sender As Object, e As EventArgs) Handles Me.Load Try ClassControlCreator.Logger = LOGCONFIG.GetLoggerFor("ControlCreator") BarButtonItem3.Caption = "Designer locked" BarButtonItem3.ItemAppearance.Normal.BackColor = Color.Red Designer_Locked = True Mouse_IsPressed = False RibPGCtrlheight.Enabled = False RibPGCtrlWidth.Enabled = False rpggrp_controls.Enabled = False ' Setzt den typ des SQL-Befehls für frmSQL_DESIGNER CURRENT_DESIGN_TYPE = "INPUT_INDEX" CHANGES_FORM_DESIGN = False ' Profil Name in Fenstertitel setzen Text = $"Validation Designer - Profil: {ProfileName}" ' Try ' Windream initialisieren If IDB_ACTIVE = False Then clsWindream.Create_Session() bbtnitButton.Visibility = DevExpress.XtraBars.BarItemVisibility.Never Else bbtnitButton.Visibility = DevExpress.XtraBars.BarItemVisibility.Always End If 'Windream Abfragen, sollten einmal beim Start des Formulars geladen werden Dim unsortedIndicies Dim sortedIndicies As List(Of String) If IDB_ACTIVE = False Then unsortedIndicies = clsWD_GET.GetIndicesByObjecttype(CURRENT_OBJECTTYPE).ToList() sortedIndicies = unsortedIndicies '.OrderBy(Function(index As String) index).ToList() sortedIndicies = sortedIndicies.OrderBy(Function(index As String) index).ToList Else sortedIndicies = IDBData.GetIndicesByBE(CURRENT_OBJECTTYPE).ToList() End If Source_AllIndicies = sortedIndicies Source_VectorIndicies = Source_AllIndicies.FindAll(AddressOf IsVectorIndex) Source_SimpleIndicies = Source_AllIndicies.Except(Source_VectorIndicies).ToList() Source_LookupIndicies = Source_AllIndicies. Where(AddressOf IsNotVectorBooleanIndex). Where(AddressOf IsNotVectorDateIndex). Where(AddressOf IsNotVectorDatetimeIndex). Where(AddressOf IsNotBooleanIndex). Where(AddressOf IsNotDateIndex). ToList() If IDB_ACTIVE = False Then Windream_ChoiceLists = New List(Of String) Windream_ChoiceLists.Add(String.Empty) Windream_ChoiceLists.AddRange(clsWD_GET.GetChoiceLists()) End If 'Catch ex As Exception ' LOGGER.Error(ex) ' MsgBox("Fehler bei Initialisieren von windream: " & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Achtung:") 'End Try Try TBPM_PROFILE_CONTROLSTableAdapter.Connection.ConnectionString = CONNECTION_STRING_ECM TBDD_CONNECTIONTableAdapter.Connection.ConnectionString = CONNECTION_STRING_ECM TBWH_CHECK_PROFILE_CONTROLSTableAdapter.Connection.ConnectionString = CONNECTION_STRING_ECM TBPM_CONTROL_TABLETableAdapter.Connection.ConnectionString = CONNECTION_STRING_ECM TBDD_CONNECTIONTableAdapter.Fill(DD_DMSLiteDataSet.TBDD_CONNECTION) Catch ex As Exception LOGGER.Error(ex) MsgBox("Fehler bei Laden der Connection-Strings und Grunddaten: " & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Achtung:") End Try LoadControls() Catch ex As Exception LOGGER.Error(ex) 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 NOT IN ('BUTTON','LBL','LINE')" Dim dt As DataTable = DatabaseFallback.GetDatatableECM(sql) ', "frmFormDesigner_FormClosing") 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 frmColumn_Detail).Any Then frmColumn_Detail.Close() End If ' Setzt den typ des SQL-Befehls für frmSQL_DESIGNER CURRENT_DESIGN_TYPE = "FINAL_INDEX" ' Beim Schließen das PropertyGrid leeren pgControls.SelectedObject = Nothing End Sub ''' ''' Filtert aus der Liste von Indexen die Vektor Indexe heraus ''' Private Function IsVectorIndex(IndexName As String) As Boolean Dim oType As Integer If IDB_ACTIVE = False Then oType = clsWD_GET.GetTypeOfIndexAsIntByName(IndexName) Else oType = IDBData.GetTypeOfIndex(IndexName) End If Return FINALINDICES.IsVectorIndex(oType) End Function Private Function IsNotBooleanIndex(IndexName As String) As Boolean Dim oType As Integer '= clsWD_GET.GetTypeOfIndexAsIntByName(IndexName) If IDB_ACTIVE = False Then oType = clsWD_GET.GetTypeOfIndexAsIntByName(IndexName) Else oType = IDBData.GetTypeOfIndex(IndexName) End If Return oType <> FINALINDICES.INDEX_TYPE_BOOLEAN End Function Private Function IsNotDateIndex(IndexName As String) As Boolean Dim oType As Integer '= clsWD_GET.GetTypeOfIndexAsIntByName(IndexName) If IDB_ACTIVE = False Then oType = clsWD_GET.GetTypeOfIndexAsIntByName(IndexName) Else oType = IDBData.GetTypeOfIndex(IndexName) End If Return oType <> FINALINDICES.INDEX_TYPE_DATE End Function Private Function IsNotVectorBooleanIndex(IndexName As String) As Boolean Dim oType As Integer '= clsWD_GET.GetTypeOfIndexAsIntByName(IndexName) If IDB_ACTIVE = False Then oType = clsWD_GET.GetTypeOfIndexAsIntByName(IndexName) Else oType = IDBData.GetTypeOfIndex(IndexName) End If Return oType <> FINALINDICES.INDEX_TYPE_VECTOR_BOOLEAN End Function Private Function IsNotVectorDateIndex(IndexName As String) As Boolean Dim oType As Integer '= clsWD_GET.GetTypeOfIndexAsIntByName(IndexName) If IDB_ACTIVE = False Then oType = clsWD_GET.GetTypeOfIndexAsIntByName(IndexName) Else oType = IDBData.GetTypeOfIndex(IndexName) End If Return oType <> FINALINDICES.INDEX_TYPE_VECTOR_DATE End Function Private Function IsNotVectorDatetimeIndex(IndexName As String) As Boolean Dim oType As Integer '= clsWD_GET.GetTypeOfIndexAsIntByName(IndexName) If IDB_ACTIVE = False Then oType = clsWD_GET.GetTypeOfIndexAsIntByName(IndexName) Else oType = IDBData.GetTypeOfIndex(IndexName) End If Return oType <> FINALINDICES.INDEX_TYPE_VECTOR_DATETIME End Function Sub LoadControls() Try TBPM_PROFILE_CONTROLSTableAdapter.FillByProfil(DD_DMSLiteDataSet.TBPM_PROFILE_CONTROLS, USER_LANGUAGE, 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 oDTColumnsPerDevExGrid As DataTable = DatabaseFallback.GetDatatableECM($"SELECT * FROM TBPM_CONTROL_TABLE WHERE CONTROL_ID = {guid} ORDER BY [SEQUENCE]") ', "FDesignLaodControls") Dim table = ClassControlCreator.CreateExistingGridControl(row, oDTColumnsPerDevExGrid, True) AddHandler table.MouseClick, AddressOf gridControl_MouseClick ' AddHandler table.ColumnHeaderMouseClick, AddressOf table_ColumnHeaderMouseClick pnldesigner.Controls.Add(table) SetMovementHandlers(table) Case "LOOKUP" Dim lookup = ClassControlCreator.CreateExistingLookupControl(row, True) pnldesigner.Controls.Add(lookup) SetMovementHandlers(lookup) Case "LINE" Dim line = ClassControlCreator.CreateExistingLine(row, True) pnldesigner.Controls.Add(line) SetMovementHandlers(line) Case "BUTTON" Dim oButton = ClassControlCreator.CreateExistingButton(row, True) pnldesigner.Controls.Add(oButton) SetMovementHandlers(oButton) End Select Next CURRENT_CONTROL_LIST = pnldesigner.Controls.Cast(Of Control).ToList() Catch ex As Exception LOGGER.Error(ex) 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, btndtp.MouseDown, btnVektor.MouseDown, btnTabelle.MouseDown, btnCheckbox.MouseDown, btnLine.MouseDown, btnButton.MouseDown ' If Designer_Locked Then ' Exit Sub ' End If ' Mouse_IsPressed = True ' CurrentControl = Nothing ' Try ' TBPM_PROFILE_CONTROLSBindingSource.Clear() ' Catch ex As Exception ' LOGGER.Error(ex) ' End Try 'End Sub 'Private Sub DragDropButtons_MouseMove(sender As Object, e As MouseEventArgs) Handles btnlabel.MouseMove, btntextbox.MouseMove, btndtp.MouseMove, btnVektor.MouseMove, btnTabelle.MouseMove, btnCheckbox.MouseMove, btnLine.MouseMove, btnButton.MouseMove ' If Designer_Locked Then ' Exit Sub ' End If ' 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 ' Case "btnButton" ' dragDropData = ClassControlCreator.PREFIX_BUTTON ' 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, btndtp.MouseUp, btnVektor.MouseUp, btnTabelle.MouseUp, btnCheckbox.MouseUp, btnLine.MouseUp, btnButton.MouseUp ' Mouse_IsPressed = False 'End Sub 'Private Sub pnlDesigner_DragDrop(sender As Object, e As DragEventArgs) Handles pnldesigner.DragDrop ' If Designer_Locked Then ' Exit Sub ' End If ' Dim cursorPosition As Point = pnldesigner.PointToClient(Cursor.Position) ' Mouse_IsPressed = False ' Try ' 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, USER_USERNAME, label.Size.Height, label.Size.Width) ' CHANGES_IN_ADMINISTRATION = True ' CurrentControl = label ' CurrentControl.Tag = New ClassControlCreator.ControlMetadata() With { ' .Guid = GetLastID(), ' .ReadOnly = False ' } ' 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, USER_USERNAME, txt.Size.Height, txt.Size.Width) ' CHANGES_IN_ADMINISTRATION = True ' CurrentControl = txt ' CurrentControl.Tag = New ClassControlCreator.ControlMetadata() With { ' .Guid = GetLastID(), ' .ReadOnly = False ' } ' 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, USER_USERNAME, cmb.Size.Height, cmb.Size.Width) ' CHANGES_IN_ADMINISTRATION = True ' CurrentControl = cmb ' CurrentControl.Tag = New ClassControlCreator.ControlMetadata() With { ' .Guid = GetLastID(), ' .ReadOnly = False ' } ' 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, USER_USERNAME, dtp.Size.Height, dtp.Size.Width) ' CHANGES_IN_ADMINISTRATION = True ' CurrentControl = dtp ' CurrentControl.Tag = New ClassControlCreator.ControlMetadata() With { ' .Guid = GetLastID(), ' .ReadOnly = False ' } ' 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, USER_USERNAME, chk.Size.Height, chk.Size.Width) ' CHANGES_IN_ADMINISTRATION = True ' CurrentControl = chk ' CurrentControl.Tag = New ClassControlCreator.ControlMetadata() With { ' .Guid = GetLastID(), ' .ReadOnly = False ' } ' pnldesigner.Controls.Add(chk) ' Case ClassControlCreator.PREFIX_DATAGRIDVIEW ' Dim lc As LookupControl3 = ClassControlCreator.CreateNewLookupControl(cursorPosition) ' SetMovementHandlers(lc) ' TBPM_PROFILE_CONTROLSTableAdapter.cmdInsertAnlage(ProfileId, lc.Name, "LOOKUP", lc.Name, lc.Location.X, lc.Location.Y, USER_USERNAME, lc.Size.Height, lc.Size.Width) ' CHANGES_IN_ADMINISTRATION = True ' CurrentControl = lc ' CurrentControl.Tag = New ClassControlCreator.ControlMetadata() With { ' .Guid = GetLastID(), ' .ReadOnly = False ' } ' pnldesigner.Controls.Add(lc) ' Case ClassControlCreator.PREFIX_TABLE ' Dim tb = ClassControlCreator.CreateNewTable(cursorPosition) ' SetMovementHandlers(tb) ' AddHandler tb.MouseClick, AddressOf gridControl_MouseClick ' TBPM_PROFILE_CONTROLSTableAdapter.cmdInsertAnlage(ProfileId, tb.Name, "TABLE", tb.Name, tb.Location.X, tb.Location.Y, USER_USERNAME, tb.Size.Height, tb.Size.Width) ' CHANGES_IN_ADMINISTRATION = True ' Dim oControlId = GetLastID() ' CurrentControl = tb ' CurrentControl.Tag = New ClassControlCreator.ControlMetadata() With { ' .Guid = oControlId, ' .ReadOnly = False ' } ' TBPM_CONTROL_TABLETableAdapter.Insert(oControlId, "column1", "Column1", 95, USER_USERNAME) ' TBPM_CONTROL_TABLETableAdapter.Insert(oControlId, "column2", "Column2", 95, USER_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, USER_USERNAME, line.Size.Height, line.Size.Width) ' CHANGES_IN_ADMINISTRATION = True ' CurrentControl = line ' CurrentControl.Tag = New ClassControlCreator.ControlMetadata() With { ' .Guid = GetLastID(), ' .ReadOnly = False ' } ' pnldesigner.Controls.Add(line) ' Case ClassControlCreator.PREFIX_BUTTON ' Dim oButton = ClassControlCreator.CreateNewButton(cursorPosition) ' SetMovementHandlers(oButton) ' TBPM_PROFILE_CONTROLSTableAdapter.cmdInsertAnlage(ProfileId, oButton.Name, "BUTTON", oButton.Name, oButton.Location.X, oButton.Location.Y, USER_USERNAME, oButton.Size.Height, oButton.Size.Width) ' CHANGES_IN_ADMINISTRATION = True ' CurrentControl = oButton ' CurrentControl.Tag = New ClassControlCreator.ControlMetadata() With { ' .Guid = GetLastID(), ' .ReadOnly = False ' } ' pnldesigner.Controls.Add(oButton) ' End Select ' Catch ex As Exception ' LOGGER.Error(ex) ' LOGGER.Info($"Error while Adding new control {e.Data.GetData(DataFormats.Text)}:") ' LOGGER.Info(ex) ' End Try '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 DatabaseFallback.GetScalarValueECM(sql) End Function Sub SetActiveControlColor() If DirectCast(CurrentControl.Tag, ClassControlCreator.ControlMetadata).ReadOnly = False Then CurrentControl.BackColor = Color.DarkOrange End If ' Reset Color of all other controls For Each oControl As Control In Me.pnldesigner.Controls If oControl.Name <> CurrentControl.Name Then Dim oMetadata = DirectCast(oControl.Tag, ClassControlCreator.ControlMetadata) If oMetadata.ReadOnly = False Then Dim Type As String = oControl.GetType.ToString Select Case Type Case "System.Windows.Forms.TextBox" oControl.BackColor = Color.White Case "System.Windows.Forms.ComboBox" oControl.BackColor = Color.White Case "System.Windows.Forms.Label" oControl.BackColor = Color.Transparent Case "System.Windows.Forms.CheckBox" oControl.BackColor = Color.Transparent Case "DD_ProcessManager.ClassControlCreator+LineLabel" oControl.BackColor = oControl.ForeColor Case "DigitalData.Controls.LookupGrid.LookupControl3" oControl.BackColor = Color.White Case "System.Windows.Forms.Button" oControl.BackColor = SystemColors.Control End Select End If End If Next End Sub Public Sub gridControl_MouseClick(sender As GridControl, e As MouseEventArgs) Try If Designer_Locked = True Then Exit Sub End If Dim oView As GridView = sender.DefaultView Dim oHitinfo As GridHitInfo = oView.CalcHitInfo(sender.PointToClient(Cursor.Position)) CurrentControl = sender CURRENT_CONTROL_ID = DirectCast(sender.Tag, ClassControlCreator.ControlMetadata).Guid If oHitinfo.IsValid And oHitinfo.InColumn Then Dim oColumn As GridColumn = oHitinfo.Column If oColumn Is Nothing Then Exit Sub End If Dim oColumnCaption As String = oColumn.Caption Dim oColumnName As String = oColumn.FieldName Dim oColumnId = TBPM_CONTROL_TABLETableAdapter.getColumnID(CURRENT_CONTROL_ID, oColumnName) CurrentColumnId = oColumnId Dim frmTableColumn = New frmColumn_Detail() frmTableColumn.FillData(CurrentColumnId) frmTableColumn.Text = "Konfiguration von Spalte: " & oColumnCaption Dim oResult = frmTableColumn.ShowDialog() LoadControls() ElseIf oHitinfo.IsValid And e.Button = MouseButtons.Right Then GridControlContextMenu.Show(Cursor.Position.X, Cursor.Position.Y) End If Catch ex As Exception LOGGER.Error(ex) MsgBox("Error while loading Column Configuration: " & vbCrLf & ex.Message, MsgBoxStyle.Critical) End Try 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 TBPM_CONTROL_TABLETableAdapter.DeleteColumnsByControlId(controlId) TBPM_PROFILE_CONTROLSTableAdapter.Delete(controlId) LoadControls() End If End If Catch ex As Exception LOGGER.Error(ex) 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 ''' ''' 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 If Designer_Locked Then Exit Sub End If CurrentControl = sender Mouse_BeginLocation = e.Location sender.BringToFront() RibbonPageGroup3.Enabled = True Mouse_IsPressed = True RibPGCtrlheight.Enabled = True RibPGCtrlWidth.Enabled = True Console.WriteLine("CURRENT_CONTROL:" & CurrentControl.Name) End If End Sub Private Sub OnControl_MouseUp(sender As Control, e As MouseEventArgs) Try If Designer_Locked Then Exit Sub End If Mouse_IsPressed = False ' 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 CurrentPosition.X = OldPosition.X + 2 And CurrentPosition.Y = OldPosition.Y + 2 Then CurrentControl.Location = New Point(CurrentPosition.X - 2, CurrentPosition.Y - 2) MyBase.Cursor = Cursors.Default Exit Sub End If 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 Catch ex As Exception MsgBox(ex.Message, MsgBoxStyle.Critical) LOGGER.Error(ex) Mouse_IsMoving = False Mouse_IsPressed = False End Try End Sub Private Sub OnControl_MouseMove(sender As Control, e As MouseEventArgs) Try If Designer_Locked Then Exit Sub End If 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 LOGGER.Error(ex) 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.Active = StrToBool(row.Item("CONTROL_ACTIVE")) obj.Index = NotNull(row.Item("INDEX_NAME"), "") obj.DefaultValue = NotNull(row.Item("DEFAULT_VALUE"), Nothing) obj.SQLCommand = New SQLValue(row.Item("SQL_UEBERPRUEFUNG")) Return obj End Function Private Sub LoadControlProperties(sender As Control) Try Dim props Dim oDatatable As DataTable = DD_DMSLiteDataSet.TBPM_PROFILE_CONTROLS Dim oRow As DataRow pgControls.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 Try TBPM_PROFILE_CONTROLSTableAdapter.FillByProfil(DD_DMSLiteDataSet.TBPM_PROFILE_CONTROLS, USER_LANGUAGE, ProfileId) Catch ex As Exception LOGGER.Error(ex) LOGGER.Info("Error while executing TBPM_PROFILE_CONTROLSTableAdapter.FillByProfil in LoadControlProperties:") LOGGER.Info(ex) End Try Dim oControlId = DirectCast(sender.Tag, ClassControlCreator.ControlMetadata).Guid oRow = oDatatable.AsEnumerable().Where(Function(r As DataRow) Return r.Item("GUID") = oControlId End Function).SingleOrDefault() ' Control-Id wurde nicht in DataRow gefunden If IsNothing(oRow) Then LOGGER.Info($"Error while filtering Controls by Guid '{oControlId}' in LoadControlProperties:") MsgBox($"Control mit der Id {oControlId} wurde nicht gefunden!", MsgBoxStyle.Critical, "Fehler beim Laden der Control Eigenschaften") Exit Sub End If ' Globale Variablen setzen CurrentControl = sender CURRENT_CONTROL_ID = oControlId 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, oRow) props = lineProps ElseIf TypeOf sender Is Label Then Dim label As Label = sender Dim labelProps As LabelProperties = CreatePropsObject(New LabelProperties, oRow) labelProps.Text = label.Text props = labelProps ElseIf TypeOf sender Is CheckBox Then Dim check As CheckBox = sender Dim checkProps As CheckboxProperties = CreatePropsObjectWithIndicies(New CheckboxProperties, oRow, Source_AllIndicies) checkProps.Text = check.Text checkProps.Enable_SQL = New SQLValue(NotNull(oRow.Item("SQL_ENABLE"), "")) checkProps.Enable_SQL_OnLoad = New SQLValue(NotNull(oRow.Item("SQL_ENABLE_ON_LOAD"), "")) checkProps.SetControlData = New SQLValue(NotNull(oRow.Item("SET_CONTROL_DATA"), "")) props = checkProps ElseIf TypeOf sender Is TextBox Then Dim txt As TextBox = sender Dim txtProps As TextboxProperties = CreatePropsObjectWithIndicies(New TextboxProperties, oRow, Source_AllIndicies) txtProps.Regex = NotNull(oRow.Item("REGEX_MATCH"), String.Empty) txtProps.RegexMessage = NotNull(oRow.Item("REGEX_MESSAGE_DE"), String.Empty) txtProps.Enable_SQL = New SQLValue(NotNull(oRow.Item("SQL_ENABLE"), "")) txtProps.Enable_SQL_OnLoad = New SQLValue(NotNull(oRow.Item("SQL_ENABLE_ON_LOAD"), "")) txtProps.SetControlData = New SQLValue(NotNull(oRow.Item("SET_CONTROL_DATA"), "")) props = txtProps ElseIf TypeOf sender Is ComboBox Then Dim cmb As ComboBox = sender Dim cmbProps As ComboboxProperties = CreatePropsObjectWithIndicies(New ComboboxProperties, oRow, Source_AllIndicies) cmbProps.ChoiceLists = Windream_ChoiceLists cmbProps.ChoiceList = NotNull(oRow.Item("CHOICE_LIST"), String.Empty) cmbProps.Enable_SQL = New SQLValue(NotNull(oRow.Item("SQL_ENABLE"), "")) cmbProps.Enable_SQL_OnLoad = New SQLValue(NotNull(oRow.Item("SQL_ENABLE_ON_LOAD"), "")) cmbProps.SetControlData = New SQLValue(NotNull(oRow.Item("SET_CONTROL_DATA"), "")) props = cmbProps cmbProps.DisplayAsLookUpControl = False ElseIf TypeOf sender Is DateTimePicker Then Dim dtp As DateTimePicker = sender Dim dtpProps As DatepickerProperties = CreatePropsObjectWithIndicies(New DatepickerProperties, oRow, Source_AllIndicies) dtpProps.Enable_SQL = New SQLValue(NotNull(oRow.Item("SQL_ENABLE"), "")) dtpProps.Enable_SQL_OnLoad = New SQLValue(NotNull(oRow.Item("SQL_ENABLE_ON_LOAD"), "")) props = dtpProps ElseIf TypeOf sender Is DataGridView Then Dim grid As DataGridView = sender Dim gridProps As GridViewProperties = CreatePropsObjectWithIndicies(New GridViewProperties, oRow, Source_VectorIndicies) props = gridProps ElseIf TypeOf sender Is LookupControl3 Then Dim grid As LookupControl3 = sender Dim lookupProps As LookupControlProperties = CreatePropsObjectWithIndicies(New LookupControlProperties, oRow, Source_AllIndicies) lookupProps.MultiSelect = StrToBool(oRow.Item("MULTISELECT")) lookupProps.PreventDuplicates = StrToBool(oRow.Item("VKT_PREVENT_MULTIPLE_VALUES")) lookupProps.AllowAddNewValues = StrToBool(oRow.Item("VKT_ADD_ITEM")) lookupProps.DisplayAsComboBox = False lookupProps.Enable_SQL = New SQLValue(NotNull(oRow.Item("SQL_ENABLE"), "")) lookupProps.Enable_SQL_OnLoad = New SQLValue(NotNull(oRow.Item("SQL_ENABLE_ON_LOAD"), "")) lookupProps.SetControlData = New SQLValue(NotNull(oRow.Item("SET_CONTROL_DATA"), "")) props = lookupProps ElseIf TypeOf sender Is GridControl Then Dim oGridControl As GridControl = sender Dim oGridProps As GridControlProperties = CreatePropsObjectWithIndicies(New GridControlProperties, oRow, Source_VectorIndicies) oGridProps.AllowAddNewValues = StrToBool(oRow.Item("VKT_ADD_ITEM")) oGridProps.Enable_SQL = New SQLValue(NotNull(oRow.Item("SQL_ENABLE"), "")) oGridProps.Enable_SQL_OnLoad = New SQLValue(NotNull(oRow.Item("SQL_ENABLE_ON_LOAD"), "")) props = oGridProps ElseIf TypeOf sender Is Button Then Dim oButton As Button = sender Dim oButtonProps As ButtonProperties = CreatePropsObject(New ButtonProperties, oRow, Source_VectorIndicies) oButtonProps.Text = oButton.Text oButtonProps.SQLCommand = New SQLValue(oRow.Item("SQL_UEBERPRUEFUNG")) oButtonProps.Override_SQL = New SQLValue(NotNull(oRow.Item("SQL2"), "")) oButtonProps.Enable_SQL = New SQLValue(NotNull(oRow.Item("SQL_ENABLE"), "")) oButtonProps.Enable_SQL_OnLoad = New SQLValue(NotNull(oRow.Item("SQL_ENABLE_ON_LOAD"), "")) If Not IsDBNull(oRow.Item("IMAGE_CONTROL")) Then Dim obimg() As Byte = oRow.Item("IMAGE_CONTROL") Dim oBitmap As Bitmap = ByteArrayToBitmap(obimg) oButtonProps.CtrlImage = New ImageValue("IMAGE") oButton.Image = oBitmap End If props = oButtonProps 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 Catch ex As Exception MsgBox(ex.Message, MsgBoxStyle.Critical) End Try End Sub Private Sub pgControls_PropertyValueChanged(s As Object, e As PropertyValueChangedEventArgs) Handles pgControls.PropertyValueChanged Dim oldValue As Object = e.OldValue Dim newValue = e.ChangedItem.Value Dim prop As String = e.ChangedItem.Label Select Case prop Case "DisplayAsLookUpControl" If UpdateSingleValue("CTRL_TYPE", "LOOKUP") = True Then MsgBox("Type has been changed. Controls will be reloaded!", MsgBoxStyle.Information, "") LoadControls() End If Case "DisplayAsComboBox" If UpdateSingleValue("CTRL_TYPE", "CMB") = True Then MsgBox("Type has been changed. Controls will be reloaded!", MsgBoxStyle.Information, "") LoadControls() End If 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", CInt(font.Style)) CurrentControl.Font = font Case "TextColor" Dim color As Color = newValue UpdateSingleValue("FONT_COLOR", ColorTranslator.ToWin32(color)) CurrentControl.ForeColor = color Case "SQLCommand" UpdateSingleValue("SQL_UEBERPRUEFUNG", newValue) UpdateSingleValue("CONNECTION_ID", CURRENT_CONN_ID) UpdateSingleValue("CHOICE_LIST", "") Case "Enable_SQL" UpdateSingleValue("SQL_ENABLE", newValue) UpdateSingleValue("CONNECTION_ID", CURRENT_CONN_ID) UpdateSingleValue("CHOICE_LIST", "") Case "Enable_SQL_OnLoad" UpdateSingleValue("SQL_ENABLE_ON_LOAD", newValue) UpdateSingleValue("SQL_ENABLE_ON_LOAD_CONID", CURRENT_CONN_ID) UpdateSingleValue("CHOICE_LIST", "") Case "Override_SQL" UpdateSingleValue("SQL2", newValue) UpdateSingleValue("CONNECTION_ID", CURRENT_CONN_ID) UpdateSingleValue("CHOICE_LIST", "") Case "SetControlData" UpdateSingleValue("SET_CONTROL_DATA", newValue) UpdateSingleValue("CONNECTION_ID", CURRENT_CONN_ID) UpdateSingleValue("CHOICE_LIST", "") Case "ChoiceList" UpdateSingleValue("CHOICE_LIST", newValue) UpdateSingleValue("SQL_UEBERPRUEFUNG", "") UpdateSingleValue("CONNECTION_ID", "NULL") Case "MultiSelect" UpdateSingleValue("MULTISELECT", IIf(newValue = True, 1, 0)) Case "AllowAddNewValues" UpdateSingleValue("VKT_ADD_ITEM", IIf(newValue = True, 1, 0)) Case "PreventDuplicates" UpdateSingleValue("VKT_PREVENT_MULTIPLE_VALUES", IIf(newValue = True, 1, 0)) Case "DefaultValue" UpdateSingleValue("DEFAULT_VALUE", newValue) Case "Regex" UpdateSingleValue("REGEX_MATCH", newValue) Case "RegexMessage" UpdateSingleValue("REGEX_MESSAGE_DE", newValue) Case "Active" UpdateSingleValue("CONTROL_ACTIVE", IIf(newValue = True, 1, 0)) Case "CtrlImage" Dim myPath As ImageValue = newValue UpdateImage(myPath.Value) End Select End Sub Private Function UpdateImage(ImageLocation As String) Try Dim image As Bitmap = CType(System.Drawing.Image.FromFile(ImageLocation, True), Bitmap) Dim bimage() As Byte = BitmapToByteArray(image) 'UPDATE TBPMO_FORM_CONSTRUCTOR SET MENU_IMG = @MENU_IMG, WHERE GUID = @GUID" Dim SQL As String = "UPDATE TBPM_PROFILE_CONTROLS SET IMAGE_CONTROL = @MENU_IMG WHERE GUID = @GUID" Dim conn As SqlClient.SqlConnection = New SqlClient.SqlConnection(CONNECTION_STRING_ECM) Dim cmd As SqlClient.SqlCommand = New SqlClient.SqlCommand(SQL, conn) cmd.Parameters.Add("@MENU_IMG", SqlDbType.VarBinary).Value = bimage cmd.Parameters.Add("@GUID", SqlDbType.Int).Value = CURRENT_CONTROL_ID conn.Open() cmd.ExecuteNonQuery() conn.Close() tslblAenderungen.Visible = True tslblAenderungen.Text = "Änderungen gespeichert - " & Now CHANGES_FORM_DESIGN = True Return True Catch ex As Exception LOGGER.Error(ex) Dim oMsg = $"UpdateImage - Error while saving Control (Id: {CURRENT_CONTROL_ID}): {vbCrLf}{ex.Message}" MsgBox(oMsg) LOGGER.Info(oMsg) Return False End Try End Function Private Function 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 SQLValue Then Dim v As SQLValue = value escapedValue = $"'{v.Value.Replace("'", "''")}'" End If Try If DatabaseFallback.ExecuteNonQueryECM($"UPDATE TBPM_PROFILE_CONTROLS SET {columnName} = {escapedValue}, CHANGED_WHO = '{USER_USERNAME}' WHERE GUID = {guid}") = True Then tslblAenderungen.Visible = True tslblAenderungen.Text = "Änderungen gespeichert - " & Now If columnName.ToUpper = "CTRL_TEXT" Then Dim oSQL = $"EXEC PRPM_CHANGE_CONTROL_CAPTION {guid},{escapedValue},'{USER_USERNAME}','{USER_LANGUAGE}'" DatabaseFallback.ExecuteNonQueryECM(oSQL) End If CHANGES_FORM_DESIGN = True Return True End If Catch ex As Exception LOGGER.Error(ex) Dim oMsg = $"UpdateSingleValue - Fehler beim Speichern von Control (Id: {guid}, column: {columnName}): {vbCrLf}{ex.Message}" MsgBox(oMsg) LOGGER.Info(oMsg) Return False End Try End Function Private Sub MenuItemAddColumn_Click(sender As Object, e As EventArgs) Handles MenuItemAddColumn.Click Try Dim oGuid = clsTools.ShortGuid() Dim oColumnName As String = "colNew" & oGuid Dim oColumnCaption As String = "New Column " & oGuid If DatabaseFallback.ExecuteNonQueryECM($"INSERT INTO TBPM_CONTROL_TABLE (CONTROL_ID, SPALTENNAME, SPALTEN_HEADER, SPALTENBREITE) VALUES({CURRENT_CONTROL_ID}, '{oColumnName}', '{oColumnCaption}', 95)") = True Then tslblAenderungen.Visible = True tslblAenderungen.Text = "Änderungen gespeichert - " & Now LoadControls() End If Catch ex As Exception Dim oMsg = $"MenuItemAddColumn_Click - Fehler beim Hinzufügen von einer neuen Spalte: {vbCrLf}{ex.Message}" MsgBox(oMsg) LOGGER.Error(ex) End Try End Sub Private Sub bbtnItemFinishSQL_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles bbtnItemFinishSQL.ItemClick Try CURRENT_DESIGN_TYPE = "SQL_BTNFINISH" Dim oSQL = $"SELECT SQL_BTN_FINISH FROM TBPM_PROFILE WHERE GUID = {ProfileId}" Dim oldSQL = DatabaseFallback.GetScalarValueECM(oSQL) Dim oForm As New frmSQLEditor(LOGCONFIG, DatabaseECM) With { .SQLCommand = oldSQL, .SQLConnection = 1 } oForm.ShowDialog() If oForm.DialogResult = DialogResult.OK Then If oldSQL <> oForm.SQLCommand Then Dim oUpdate As String = $"Update TBPM_PROFILE SET CHANGED_WHO = '{USER_USERNAME}', SQL_BTN_FINISH = '{oForm.SQLCommand.Replace("'", "''")}' WHERE GUID = {CURRENT_ProfilGUID}" If DatabaseFallback.ExecuteNonQueryECM(oUpdate) = True Then tslblAenderungen.Text = $"Profile SQLFinish saved - {Now.ToLongTimeString}" tslblAenderungen.Visible = True CHANGES_FORM_DESIGN = True Else tslblAenderungen.Visible = False End If End If End If Catch ex As Exception MsgBox("Error in Saving Profile SQLFinish: " & vbNewLine & vbNewLine & ex.Message) LOGGER.Error(ex) End Try End Sub Private Sub BarButtonItem1_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles BarButtonItem1.ItemClick If CurrentControl Is Nothing = False Then DeleteControl(CurrentControl.Name) pgControls.Enabled = False CurrentControl = Nothing RibPGCtrlheight.Enabled = False RibPGCtrlWidth.Enabled = False End If End Sub Private Sub BarButtonItem2_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles BarButtonItem2.ItemClick LoadControls() End Sub Private Sub BarButtonItem3_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles BarButtonItem3.ItemClick If BarButtonItem3.Caption = "Designer locked" Then BarButtonItem3.Caption = "Designer active" BarButtonItem3.ItemAppearance.Normal.BackColor = Color.LightSteelBlue rpggrp_controls.Enabled = True Designer_Locked = False Else BarButtonItem3.Caption = "Designer locked" BarButtonItem3.ItemAppearance.Normal.BackColor = Color.Red Designer_Locked = True rpggrp_controls.Enabled = False If Me.Cursor = Cursors.Cross Then Mouse_IsPressed = False Me.Cursor = Cursors.Default End If End If End Sub Private Sub ControlBarItem_Clicked(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles bbtnitLabel.ItemClick, bbtnitLine.ItemClick, bbtnitButton.ItemClick, bbtnitCheckBox.ItemClick, bbtnitDatePicker.ItemClick, bbtnitLU.ItemClick, bbtnitTable.ItemClick, bbtnitTextBox.ItemClick If Designer_Locked Then Exit Sub End If Me.Cursor = Cursors.Cross Mouse_IsPressed = True CurrentControl = Nothing Select Case e.Item.Name Case "bbtnitLabel" ControlSelected = ClassControlCreator.PREFIX_LABEL Case "bbtnitTextBox" ControlSelected = ClassControlCreator.PREFIX_TEXTBOX Case "btncmb" ControlSelected = ClassControlCreator.PREFIX_COMBOBOX Case "bbtnitDatePicker" ControlSelected = ClassControlCreator.PREFIX_DATETIMEPICKER Case "btnVektor" ControlSelected = ClassControlCreator.PREFIX_DATAGRIDVIEW Case "bbtnitTable" ControlSelected = ClassControlCreator.PREFIX_TABLE Case "bbtnitCheckBox" ControlSelected = ClassControlCreator.PREFIX_CHECKBOX Case "bbtnitLine" ControlSelected = ClassControlCreator.PREFIX_LINE Case "bbtnitButton" ControlSelected = ClassControlCreator.PREFIX_BUTTON Case "bbtnitLU" ControlSelected = ClassControlCreator.PREFIX_LOOKUP End Select End Sub Private Sub frmFormDesigner_KeyUp(sender As Object, e As KeyEventArgs) Handles MyBase.KeyUp If e.KeyCode = Keys.Escape Then If Me.Cursor = Cursors.Cross Then Mouse_IsPressed = False Me.Cursor = Cursors.Default End If End If End Sub Private Sub pnldesigner_MouseDown(sender As Object, e As MouseEventArgs) Handles pnldesigner.MouseDown If Designer_Locked Then Exit Sub End If If Me.Cursor = Cursors.Cross And Mouse_IsPressed = True Then Dim cursorPosition As Point = pnldesigner.PointToClient(Cursor.Position) Mouse_IsPressed = False Try Select Case ControlSelected 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, USER_USERNAME, label.Size.Height, label.Size.Width) CHANGES_FORM_DESIGN = True CurrentControl = label CurrentControl.Tag = New ClassControlCreator.ControlMetadata() With { .Guid = GetLastID(), .ReadOnly = False } 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, USER_USERNAME, txt.Size.Height, txt.Size.Width) CHANGES_FORM_DESIGN = True CurrentControl = txt CurrentControl.Tag = New ClassControlCreator.ControlMetadata() With { .Guid = GetLastID(), .ReadOnly = False } 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, USER_USERNAME, cmb.Size.Height, cmb.Size.Width) CHANGES_FORM_DESIGN = True CurrentControl = cmb CurrentControl.Tag = New ClassControlCreator.ControlMetadata() With { .Guid = GetLastID(), .ReadOnly = False } 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, USER_USERNAME, dtp.Size.Height, dtp.Size.Width) CHANGES_FORM_DESIGN = True CurrentControl = dtp CurrentControl.Tag = New ClassControlCreator.ControlMetadata() With { .Guid = GetLastID(), .ReadOnly = False } 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, USER_USERNAME, chk.Size.Height, chk.Size.Width) CHANGES_FORM_DESIGN = True CurrentControl = chk CurrentControl.Tag = New ClassControlCreator.ControlMetadata() With { .Guid = GetLastID(), .ReadOnly = False } pnldesigner.Controls.Add(chk) Case ClassControlCreator.PREFIX_LOOKUP Dim lc As LookupControl3 = ClassControlCreator.CreateNewLookupControl(cursorPosition) SetMovementHandlers(lc) TBPM_PROFILE_CONTROLSTableAdapter.cmdInsertAnlage(ProfileId, lc.Name, "LOOKUP", lc.Name, lc.Location.X, lc.Location.Y, USER_USERNAME, lc.Size.Height, lc.Size.Width) CHANGES_FORM_DESIGN = True CurrentControl = lc CurrentControl.Tag = New ClassControlCreator.ControlMetadata() With { .Guid = GetLastID(), .ReadOnly = False } pnldesigner.Controls.Add(lc) Case ClassControlCreator.PREFIX_TABLE Dim tb = ClassControlCreator.CreateNewTable(cursorPosition) SetMovementHandlers(tb) AddHandler tb.MouseClick, AddressOf gridControl_MouseClick TBPM_PROFILE_CONTROLSTableAdapter.cmdInsertAnlage(ProfileId, tb.Name, "TABLE", tb.Name, tb.Location.X, tb.Location.Y, USER_USERNAME, tb.Size.Height, tb.Size.Width) CHANGES_FORM_DESIGN = True Dim oControlId = GetLastID() CurrentControl = tb CurrentControl.Tag = New ClassControlCreator.ControlMetadata() With { .Guid = oControlId, .ReadOnly = False } TBPM_CONTROL_TABLETableAdapter.Insert(oControlId, "column1", "Column1", 95, USER_USERNAME, "TEXT") TBPM_CONTROL_TABLETableAdapter.Insert(oControlId, "column2", "Column2", 95, USER_USERNAME, "TEXT") 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, USER_USERNAME, line.Size.Height, line.Size.Width) CHANGES_FORM_DESIGN = True CurrentControl = line CurrentControl.Tag = New ClassControlCreator.ControlMetadata() With { .Guid = GetLastID(), .ReadOnly = False } pnldesigner.Controls.Add(line) Case ClassControlCreator.PREFIX_BUTTON Dim oButton = ClassControlCreator.CreateNewButton(cursorPosition) SetMovementHandlers(oButton) TBPM_PROFILE_CONTROLSTableAdapter.cmdInsertAnlage(ProfileId, oButton.Name, "BUTTON", oButton.Name, oButton.Location.X, oButton.Location.Y, USER_USERNAME, oButton.Size.Height, oButton.Size.Width) CHANGES_FORM_DESIGN = True CurrentControl = oButton CurrentControl.Tag = New ClassControlCreator.ControlMetadata() With { .Guid = GetLastID(), .ReadOnly = False } pnldesigner.Controls.Add(oButton) End Select If Not IsNothing(CurrentControl) Then RibPGCtrlheight.Enabled = True RibPGCtrlWidth.Enabled = True End If Catch ex As Exception LOGGER.Error(ex) LOGGER.Info($"Error while Adding new control {ControlSelected}:") LOGGER.Info(ex) End Try Me.Cursor = Cursors.Default End If End Sub Private Sub bbtniwidth_plus_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles bbtniwidth_plus.ItemClick 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 bbtniwidth_min_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles bbtniwidth_min.ItemClick 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 bbtniheight_min_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles bbtniheight_min.ItemClick 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("HEIGHT", newHeight) End If End Sub Private Sub bbtniheight_plus_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles bbtniheight_plus.ItemClick 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("HEIGHT", newHeight) End If End Sub End Class