Imports DD_Record_Organizer.ClassDatabase Imports DD_Record_Organizer.ClassControlBuilder Imports DD_LIB_Standards Imports System.Data.SqlClient Public Class ClassControlCommandsUI Private _CtrlBuilder As ClassControlBuilder Private _AddAppointmentHandler As System.EventHandler Private _AddFormDataHandler As System.EventHandler Private _ContextMenuStrip As ContextMenuStrip Private _isinsert As Boolean = False Private _isedit As Boolean = False Public Property IsInsert As Boolean Get Return _isinsert End Get Set(value As Boolean) _isinsert = value _CtrlBuilder.IsInsert = value End Set End Property Public Property IsEdit As Boolean Get Return _isedit End Get Set(value As Boolean) _isedit = value _CtrlBuilder.IsEdit = value End Set End Property ''' ''' Erstellt eine neue Instanz der ClassControlCommandsUI Klasse ''' ''' Eine ControlBuilder Instanz ''' Ein Delegate, der auf eine AddAppointment-Methode verweist, mit AddressOf verwenden ''' Ein Delegate, der auf eine AddFormData-Methode verweist, mit AddressOf verwenden ''' Sub New(ControlBuilder As ClassControlBuilder, ContextMenuStrip As ContextMenuStrip, AddAppointmentDelegate As System.EventHandler) ', AddFormDataDelegate As System.EventHandler) _CtrlBuilder = ControlBuilder _ContextMenuStrip = ContextMenuStrip _AddAppointmentHandler = AddAppointmentDelegate ' _AddFormDataHandler = AddFormDataDelegate End Sub Sub LoadControls(FormId As Integer) _CtrlBuilder.ClearControls() _CtrlBuilder.MasterPanel.SuspendLayout() Dim sw As New SW("LoadControls") 'Dim SQL As String = String.Format("SELECT T.*, dbo.FNPMO_GET_CONTROL_CAPTION ('{2}', {3},T.CONTROL_ID) AS 'CAPTION' FROM VWPMO_CONTROL_SCREEN T WHERE T.SCREEN_ID = {0} AND T.FORM_ID = {1} AND T.CONTROL_VISIBLE = 1", CURRENT_SCREEN_ID, FormId, USER_LANGUAGE, CURRENT_SCREEN_ID) Dim expression As String = String.Format("SCREEN_ID = {0} AND FORM_ID = {1} AND CONTROL_VISIBLE = 1", CURRENT_SCREEN_ID, FormId) Dim DT As DataTable = ClassHelper.FILTER_DATATABLE(DT_VWPMO_CONTROL_SCREEN, expression, "") ' ClassDatabase.Return_Datatable(Sql, True) For Each dr As DataRow In DT.Rows Dim parent As GroupBox = Nothing If (dr.Item("CONTROL_PARENT_ID") <> 0) Then Dim parentname As String = Get_Name_for_ControlID(dr.Item("CONTROL_PARENT_ID"), FormId) parent = _CtrlBuilder.GetControlByName(parentname) End If Dim control As String Select Case dr.Item("CTRLTYPE_ID") Case 1 ' Label _CtrlBuilder.AddLabel(dr.Item("CONTROL_ID"), dr.Item("CONTROL_NAME"), dr.Item("CAPTION"), dr.Item("CTRLSCR_X_LOC"), dr.Item("CTRLSCR_Y_LOC"), dr.Item("CTRLSCR_FONT_FAMILY"), dr.Item("CTRLSCR_FONT_COLOR"), dr.Item("CTRLSCR_FONT_SIZE"), dr.Item("CTRLSCR_FONT_STYLE"), dr.Item("CONTROL_SQLCOMMAND_1"), False, parent) control = "Label - " & dr.Item("CONTROL_ID") Case 2 ' TextBox _CtrlBuilder.AddTextBox(dr.Item("CONTROL_ID"), dr.Item("CONTROL_NAME"), dr.Item("CTRLSCR_X_LOC"), dr.Item("CTRLSCR_Y_LOC"), dr.Item("CTRLSCR_FONT_FAMILY"), dr.Item("CTRLSCR_FONT_COLOR"), dr.Item("CTRLSCR_FONT_SIZE"), dr.Item("CTRLSCR_FONT_STYLE"), dr.Item("CTRLSCR_TAB_INDEX"), dr.Item("CTRLSCR_TAB_STOP"), dr.Item("CTRLSCR_WIDTH"), dr.Item("CTRLSCR_HEIGHT"), dr.Item("CONTROL_MULTILINE"), dr.Item("CONTROL_READ_ONLY"), dr.Item("CONTROL_REQUIRED"), dr.Item("CONTROL_FORMAT_TYPE"), dr.Item("CONTROL_AUTO_SUGGEST"), False, parent) control = "Text - " & dr.Item("CONTROL_ID") Case 3 ' ComboBox _CtrlBuilder.AddComboBox(dr.Item("CONTROL_ID"), dr.Item("CONTROL_NAME"), dr.Item("CTRLSCR_X_LOC"), dr.Item("CTRLSCR_Y_LOC"), dr.Item("CTRLSCR_FONT_FAMILY"), dr.Item("CTRLSCR_FONT_COLOR"), dr.Item("CTRLSCR_FONT_SIZE"), dr.Item("CTRLSCR_FONT_STYLE"), dr.Item("CTRLSCR_TAB_INDEX"), dr.Item("CTRLSCR_TAB_STOP"), dr.Item("CTRLSCR_WIDTH"), dr.Item("CTRLSCR_HEIGHT"), dr.Item("CONTROL_FORMAT_TYPE"), False, dr.Item("CONTROL_READ_ONLY"), dr.Item("CONTROL_SELECT_ONLY"), dr.Item("CONTROL_REQUIRED"), dr.Item("CONTROL_STATIC_LIST"), dr.Item("CONTROL_SQLCOMMAND_1"), parent) Case 4 ' DateTimePicker _CtrlBuilder.AddDateTimePicker(dr.Item("CONTROL_ID"), dr.Item("CONTROL_NAME"), dr.Item("CTRLSCR_X_LOC"), dr.Item("CTRLSCR_Y_LOC"), dr.Item("CTRLSCR_FONT_FAMILY"), dr.Item("CTRLSCR_FONT_SIZE"), dr.Item("CTRLSCR_FONT_STYLE"), dr.Item("CTRLSCR_TAB_INDEX"), dr.Item("CTRLSCR_TAB_STOP"), dr.Item("CTRLSCR_WIDTH"), dr.Item("CTRLSCR_HEIGHT"), dr.Item("CONTROL_READ_ONLY"), dr.Item("CONTROL_REQUIRED"), False, parent) control = "DatePicker - " & dr.Item("CONTROL_ID") Case 5 ' GroupBox _CtrlBuilder.AddGroupBox(dr.Item("CONTROL_ID"), dr.Item("CONTROL_NAME"), dr.Item("CTRLSCR_CAPTION"), dr.Item("CTRLSCR_X_LOC"), dr.Item("CTRLSCR_Y_LOC"), dr.Item("CTRLSCR_WIDTH"), dr.Item("CTRLSCR_HEIGHT"), dr.Item("CTRLSCR_BACK_COLOR"), dr.Item("CTRLSCR_FONT_COLOR"), dr.Item("CTRLSCR_FONT_FAMILY"), dr.Item("CTRLSCR_FONT_SIZE"), dr.Item("CTRLSCR_FONT_STYLE"), False, parent) control = "GroupBox - " & dr.Item("CONTROL_ID") Case 6 ' PictureBox _CtrlBuilder.AddPictureBox(dr.Item("CONTROL_ID"), dr.Item("CONTROL_NAME"), dr.Item("CTRLSCR_X_LOC"), dr.Item("CTRLSCR_Y_LOC"), dr.Item("CTRLSCR_WIDTH"), dr.Item("CTRLSCR_HEIGHT"), False, dr.Item("CONTROL_READ_ONLY"), dr.Item("CONTROL_REQUIRED"), parent) Case 7 ' DataGridView _CtrlBuilder.AddDataGridView(dr.Item("CONTROL_ID"), dr.Item("CONTROL_NAME"), dr.Item("CTRLSCR_X_LOC"), dr.Item("CTRLSCR_Y_LOC"), dr.Item("CTRLSCR_WIDTH"), dr.Item("CTRLSCR_HEIGHT"), False, dr.Item("CONTROL_READ_ONLY"), dr.Item("CONTROL_REQUIRED"), dr.Item("CONTROL_COL_NAME"), parent) control = "Datagridview - " & dr.Item("CONTROL_ID") Case 10 ' Checkbox Dim Checked As Boolean = False 'If IsDBNull(dr.Item("CONTROL_DEF_VALUE")) Then ' Checked = False 'Else ' Checked = StrToBool(dr.Item("CONTROL_DEF_VALUE")) 'End If _CtrlBuilder.AddCheckBox(dr.Item("CONTROL_ID"), dr.Item("CONTROL_NAME"), dr.Item("CTRLSCR_CAPTION"), Checked, dr.Item("CTRLSCR_X_LOC"), dr.Item("CTRLSCR_Y_LOC"), dr.Item("CTRLSCR_FONT_FAMILY"), dr.Item("CTRLSCR_FONT_COLOR"), dr.Item("CTRLSCR_FONT_SIZE"), dr.Item("CTRLSCR_FONT_STYLE"), dr.Item("CTRLSCR_TAB_INDEX"), dr.Item("CTRLSCR_TAB_STOP"), dr.Item("CTRLSCR_WIDTH"), dr.Item("CTRLSCR_HEIGHT"), False, dr.Item("CONTROL_READ_ONLY"), dr.Item("CONTROL_REQUIRED"), parent) control = "CheckBox - " & dr.Item("CONTROL_ID") Case 8 ' Function AddAppointment _CtrlBuilder.FunctionAddAppointment(dr.Item("CONTROL_ID"), dr.Item("CONTROL_NAME"), dr.Item("CTRLSCR_CAPTION"), dr.Item("CTRLSCR_X_LOC"), dr.Item("CTRLSCR_Y_LOC"), dr.Item("CTRLSCR_WIDTH"), dr.Item("CTRLSCR_HEIGHT"), False, parent) AddHandler _CtrlBuilder.CurrentControl.Click, _AddAppointmentHandler control = "Appointment - " & dr.Item("CONTROL_ID") Case 9 ' Function AddFormData _CtrlBuilder.FunctionAddFormData(dr.Item("CONTROL_ID"), dr.Item("CONTROL_NAME"), dr.Item("CTRLSCR_CAPTION"), dr.Item("CTRLSCR_X_LOC"), dr.Item("CTRLSCR_Y_LOC"), dr.Item("CTRLSCR_WIDTH"), dr.Item("CTRLSCR_HEIGHT"), False, parent) AddHandler _CtrlBuilder.CurrentControl.Click, _AddFormDataHandler control = "AddFormData - " & dr.Item("CONTROL_ID") Case 11 ' RadioButton Dim Checked As Boolean = False 'If IsDBNull(dr.Item("CONTROL_DEF_VALUE")) Then ' Checked = False 'Else ' Checked = StrToBool(dr.Item("CONTROL_DEF_VALUE")) 'End If _CtrlBuilder.AddRadioButton(dr.Item("CONTROL_ID"), dr.Item("CONTROL_NAME"), dr.Item("CTRLSCR_CAPTION"), Checked, dr.Item("CTRLSCR_X_LOC"), dr.Item("CTRLSCR_Y_LOC"), dr.Item("CTRLSCR_FONT_FAMILY"), dr.Item("CTRLSCR_FONT_COLOR"), dr.Item("CTRLSCR_FONT_SIZE"), dr.Item("CTRLSCR_FONT_STYLE"), dr.Item("CTRLSCR_TAB_INDEX"), dr.Item("CTRLSCR_TAB_STOP"), dr.Item("CTRLSCR_WIDTH"), dr.Item("CTRLSCR_HEIGHT"), False, dr.Item("CONTROL_READ_ONLY"), dr.Item("CONTROL_REQUIRED"), parent) control = "Radiobutton - " & dr.Item("CONTROL_ID") Case 12 'CheckedListBox _CtrlBuilder.AddCheckedListBox(dr.Item("CONTROL_ID"), dr.Item("CONTROL_NAME"), dr.Item("CTRLSCR_X_LOC"), dr.Item("CTRLSCR_Y_LOC"), dr.Item("CTRLSCR_FONT_FAMILY"), dr.Item("CTRLSCR_FONT_COLOR"), dr.Item("CTRLSCR_FONT_SIZE"), dr.Item("CTRLSCR_FONT_STYLE"), dr.Item("CTRLSCR_TAB_INDEX"), dr.Item("CTRLSCR_TAB_STOP"), dr.Item("CTRLSCR_WIDTH"), dr.Item("CTRLSCR_HEIGHT"), False, dr.Item("CONTROL_READ_ONLY"), dr.Item("CONTROL_REQUIRED"), dr.Item("CONTROL_STATIC_LIST"), dr.Item("CONTROL_SQLCOMMAND_1"), parent) control = "CheckedlistBox - " & dr.Item("CONTROL_ID") Case 13 'CheckedListBox _CtrlBuilder.AddListBox(dr.Item("CONTROL_ID"), dr.Item("CONTROL_NAME"), dr.Item("CTRLSCR_X_LOC"), dr.Item("CTRLSCR_Y_LOC"), dr.Item("CTRLSCR_FONT_FAMILY"), dr.Item("CTRLSCR_FONT_COLOR"), dr.Item("CTRLSCR_FONT_SIZE"), dr.Item("CTRLSCR_FONT_STYLE"), dr.Item("CTRLSCR_TAB_INDEX"), dr.Item("CTRLSCR_TAB_STOP"), dr.Item("CTRLSCR_WIDTH"), dr.Item("CTRLSCR_HEIGHT"), False, dr.Item("CONTROL_READ_ONLY"), dr.Item("CONTROL_REQUIRED"), dr.Item("CONTROL_STATIC_LIST"), dr.Item("CONTROL_SQLCOMMAND_1"), parent) control = "Listbox - " & dr.Item("CONTROL_ID") Case 14 'DataGridViewCheckable _CtrlBuilder.AddDataGridViewCheckable(dr.Item("CONTROL_ID"), dr.Item("CONTROL_NAME"), dr.Item("CTRLSCR_X_LOC"), dr.Item("CTRLSCR_Y_LOC"), dr.Item("CTRLSCR_WIDTH"), dr.Item("CTRLSCR_HEIGHT"), False, dr.Item("CTRLSCR_TAB_INDEX"), dr.Item("CTRLSCR_TAB_STOP"), dr.Item("CONTROL_READ_ONLY"), dr.Item("CONTROL_REQUIRED"), dr.Item("CONTROL_COL_NAME"), parent) control = "DataGridViewCheckable - " & dr.Item("CONTROL_ID") Case 15 ' Line _CtrlBuilder.AddLine(dr.Item("CONTROL_ID"), dr.Item("CONTROL_NAME"), dr.Item("CTRLSCR_X_LOC"), dr.Item("CTRLSCR_Y_LOC"), dr.Item("CTRLSCR_FONT_COLOR"), dr.Item("CTRLSCR_WIDTH"), dr.Item("CTRLSCR_HEIGHT"), False, parent) control = "Line - " & dr.Item("CONTROL_ID") End Select ' ContextMenuStrip zuweisen ' MasterDataID im ContextMenuStrip Speichern If dr.Item("CTRLSCR_MASTER_DATA_ID") <> 0 Then _CtrlBuilder.CurrentControl.ContextMenuStrip = _ContextMenuStrip ' Tag wird für ControlId verwendet, master data id bei rechtsklick herausfinden '_CtrlBuilder.CurrentControl.Tag = dr.Item("CTRLSCR_MASTER_DATA_ID") End If Next sw.Done() _CtrlBuilder.MasterPanel.ResumeLayout() End Sub Function DeleteRecord(RecordID As Integer) Return ClassHelper.DeleteRecord(RecordID) End Function Function SaveRecord(RecordID As Integer, FormID As Integer) As String Try Dim ADDED_WHO As String = USER_USERNAME LOGGER.Debug("(SaveRecord) Update RecordID: " & RecordID, False) If UpdateAllControls(FormID, RecordID, _CtrlBuilder.AllControls) = True Then Return "Datensatz aktualisiert - " & Now Else Return "ERROR" End If 'End If Catch ex As Exception MsgBox("Unexpected Error in SaveRecord: " & ex.Message, MsgBoxStyle.Critical) End Try End Function Private Sub InsertAllControls(FormID As Integer, RecordID As Integer, controls As Control.ControlCollection) For Each ctrl As Control In controls Dim CONTROL_ID As Integer = DirectCast(ctrl.Tag, ClassControlMetadata).Id 'GetControlID_for_Name(ctrl.Name, FormID) Dim CONTROL_VALUE As String = Nothing If TypeOf ctrl Is PictureBox Then 'Dim id As Integer = GetControlID_for_Name(ctrl.Name, FormID) UpsertImage(CONTROL_ID, RecordID, ctrl.BackgroundImage) Continue For End If ' Control existiert If CONTROL_ID <> -1 Then CONTROL_VALUE = GetControlValue(ctrl) End If 'If TypeName(ctrl).ToString = "DateEdit" Then ' CONTROL_VALUE = CDate(CONTROL_VALUE) 'End If 'If CONTROL_ID = 489 Then ' Console.WriteLine(TypeName(ctrl)) 'End If ' Kein Bekanntes Control oder Groupbox If IsNothing(CONTROL_VALUE) Then If TypeOf ctrl Is GroupBox Then InsertAllControls(FormID, RecordID, DirectCast(ctrl, GroupBox).Controls) End If Else CreateControlProcedure(CONTROL_ID, RecordID, CONTROL_VALUE, CURRENT_ENTITY_ID) End If Next End Sub Private Sub UpsertImage(ControlID As Integer, RecordID As Integer, image As Bitmap) Dim existsSQL As String = "SELECT GUID FROM TBPMO_CONTROL_IMAGE WHERE CONTROL_ID = " & ControlID & " AND RECORD_ID = " & RecordID Dim exists = ClassDatabase.Execute_Scalar(existsSQL) If IsNothing(exists) Then InsertImage(ControlID, RecordID, image) Else UpdateImage(ControlID, RecordID, image) End If End Sub Private Sub InsertImage(ControlID As Integer, RecordID As Integer, image As Bitmap) Try Dim bimage() As Byte Dim SQL As String = "INSERT INTO TBPMO_CONTROL_IMAGE (CONTROL_ID, RECORD_ID, IMG, ADDED_WHO) VALUES (@CONTROL_ID, @RECORD_ID, @IMG, @ADDED_WHO)" Dim conn As New SqlClient.SqlConnection(MyConnectionString) Dim cmd As New SqlClient.SqlCommand(SQL, conn) If IsNothing(image) Then DeleteImage(ControlID, RecordID) Exit Sub End If bimage = BitmapToByteArray(image) cmd.Parameters.Add("@CONTROL_ID", SqlDbType.Int).Value = ControlID cmd.Parameters.Add("@RECORD_ID", SqlDbType.Int).Value = RecordID cmd.Parameters.Add("@RECORDID", SqlDbType.Int).Value = RecordID cmd.Parameters.Add("@IMG", SqlDbType.VarBinary).Value = bimage cmd.Parameters.Add("@ADDED_WHO", SqlDbType.VarChar).Value = USER_USERNAME conn.Open() cmd.ExecuteNonQuery() conn.Close() LinkImage(ControlID, RecordID) Catch ex As Exception MsgBox("Error in InsertImage: ", ex.Message, vbCritical) End Try End Sub Private Sub LinkImage(ControlID As Integer, RecordID As Integer) Try Dim SQL = String.Format("SELECT GUID FROM TBPMO_CONTROL_IMAGE WHERE CONTROL_ID = {0} AND RECORD_ID = {1}", ControlID, RecordID) Dim ImageID As Integer = ClassDatabase.Execute_Scalar(SQL) SQL = String.Format("SELECT GUID FROM TBPMO_CONTROL_VALUE WHERE CONTROL_ID = {0} AND RECORD_ID = {1}", ControlID, RecordID) Dim valueExists = ClassDatabase.Execute_Scalar(SQL) Dim VALUE = "%%" & ImageID.ToString & "%%" If valueExists Then SQL = String.Format("UPDATE TBPMO_CONTROL_VALUE SET VALUE = '{0}', CHANGED_WHO = '{1}' WHERE CONTROL_ID = {2} AND RECORD_ID = {3}", VALUE, USER_USERNAME, ControlID, RecordID) Else SQL = String.Format("INSERT INTO TBPMO_CONTROL_VALUE (RECORD_ID, CONTROL_ID, VALUE, ADDED_WHO) VALUES ({0}, {1}, '{2}', '{3}')", RecordID, ControlID, VALUE, USER_USERNAME) End If ClassDatabase.Execute_non_Query(SQL) Catch ex As Exception MsgBox("Error in LinkImage: " & vbNewLine & ex.Message) End Try End Sub Private Sub UpdateImage(ControlID As Integer, RecordID As Integer, image As Bitmap) Try Dim bimage() As Byte Dim SQL As String = "UPDATE TBPMO_CONTROL_IMAGE SET IMG = @IMG, CHANGED_WHO = @CHANGED_WHO WHERE CONTROL_ID = @CONTROL_ID AND RECORD_ID = @RECORD_ID" Dim conn As New SqlClient.SqlConnection(MyConnectionString) Dim cmd As New SqlClient.SqlCommand(SQL, conn) If IsNothing(image) Then DeleteImage(ControlID, RecordID) Exit Sub End If bimage = BitmapToByteArray(image) cmd.Parameters.Add("@CONTROL_ID", SqlDbType.Int).Value = ControlID cmd.Parameters.Add("@RECORD_ID", SqlDbType.Int).Value = RecordID cmd.Parameters.Add("@RECORDID", SqlDbType.Int).Value = RecordID cmd.Parameters.Add("@IMG", SqlDbType.VarBinary).Value = bimage cmd.Parameters.Add("@CHANGED_WHO", SqlDbType.VarChar).Value = USER_USERNAME conn.Open() cmd.ExecuteNonQuery() conn.Close() LinkImage(ControlID, RecordID) Catch ex As Exception MsgBox("Error in UpdateImage: ", ex.Message, vbCritical) End Try End Sub Private Sub DeleteImage(ControlID As Integer, RecordID As Integer) Try ' Delete Image Dim SQL = String.Format("DELETE FROM TBPMO_CONTROL_IMAGE WHERE CONTROL_ID = {0} AND RECORD_ID = {1}", ControlID, RecordID) Dim result = ClassDatabase.Execute_non_Query(SQL) ' Delete Value SQL = String.Format("DELETE FROM TBPMO_CONTROL_VALUE WHERE CONTROL_ID = {0} AND RECORD_ID = {1}", ControlID, RecordID) result = ClassDatabase.Execute_non_Query(SQL) Catch ex As Exception MsgBox("Fehler beim löschen des Bildes:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub Private Function UpdateAllControls(FormID As Integer, RecordID As Integer, controls As Control.ControlCollection) Try Dim _error As Boolean = False Dim sw As New SW("UpdateAllControls") Dim del = String.Format("DELETE FROM TBPMO_CONTROL_VALUE_CHANGE_HISTORY WHERE UPPER(ADDED_WHO) = '{0}'", USER_USERNAME.ToUpper) ClassDatabase.Execute_non_Query(del) CURRENT_CHANGE_STEP += 1 Dim sel = String.Format("SELECT RECORD_ID, CONTROL_ID FROM VWPMO_VALUES WHERE RECORD_ID = {0}", RecordID) Dim VALUE_EXISTS_DT As DataTable = ClassDatabase.Return_Datatable(sel, True) For Each ctrl As Control In controls Console.WriteLine("Updating Control " + ctrl.Name) Dim CONTROL_ID As Integer = DirectCast(ctrl.Tag, ClassControlMetadata).Id 'GetControlID_for_RecordID(ctrl.Name, RecordID) LOGGER.Debug("CONTROL_ID: " & CONTROL_ID, False) Dim CONTROL_VALUE As String = GetControlValue(ctrl) Dim controltype = ctrl.GetType.ToString If TypeOf ctrl Is PictureBox Then Dim id As Integer = DirectCast(ctrl.Tag, ClassControlMetadata).Id 'GetControlID_for_Name(ctrl.Name, FormID) UpsertImage(id, RecordID, ctrl.BackgroundImage) Continue For End If If TypeOf ctrl Is DevExpress.XtraEditors.DateEdit Then Console.WriteLine("Updating DateEdit " + ctrl.Name) End If If TypeOf ctrl Is GroupBox Then Dim ctrls As Control.ControlCollection = DirectCast(ctrl, GroupBox).Controls UpdateAllControls(FormID, RecordID, ctrls) Continue For End If If TypeOf ctrl Is System.Windows.Forms.DataGridView Then Dim id As Integer = DirectCast(ctrl.Tag, ClassControlMetadata).Id UpdateMultipleValues(id, RecordID, CONTROL_VALUE) Continue For End If ' UpdateMultipleValues wird für diese Controls bereits beim CheckedChanged-Event ausgeführt If TypeOf ctrl Is DevExpress.XtraGrid.GridControl Or TypeOf ctrl Is DevExpress.XtraEditors.CheckedListBoxControl Then Continue For End If 'Dim ValueExists = ClassDatabase.Execute_Scalar(String.Format("SELECT RECORD_ID FROM VWPMO_VALUES WHERE RECORD_ID = {0} AND CONTROL_ID = {1}", RecordID, CONTROL_ID)) Dim ValueExists = VALUE_EXISTS_DT.Select(String.Format("CONTROL_ID = {0}", CONTROL_ID)) Dim ValueChanged As Boolean = _CtrlBuilder.ControlsChanged.Contains(CONTROL_ID) If Not ValueChanged Then Continue For End If If ValueExists.Length = 0 Then ' Neues Control 'If CONTROL_ID = 995 Or CONTROL_ID = 996 Or CONTROL_ID = 997 Or CONTROL_ID = 810 Then ' Console.WriteLine("sdasd") 'End If LOGGER.Debug("InsertControlValue: " & CONTROL_ID & "|" & RecordID & "|" & CONTROL_VALUE, False) If Not IsNothing(CONTROL_VALUE) Then If TypeOf ctrl Is CustomComboBox And CONTROL_VALUE = "" Then 'Exit Sub - Zuviel des guten Continue For End If If CONTROL_VALUE <> "" Then If CreateControlProcedure(CONTROL_ID, RecordID, CONTROL_VALUE, CURRENT_ENTITY_ID) = 0 Then _error = True End If End If End If Else ' Update Control Dim isEmptyValue As Boolean = IsNothing(CONTROL_VALUE) Or CONTROL_VALUE = String.Empty Dim isDateEdit = TypeOf ctrl Is DevExpress.XtraEditors.DateEdit Dim isTextBox = TypeOf ctrl Is TextBox Dim isComboBox = TypeOf ctrl Is CustomComboBox ' Bei bestimmten Controls soll der Wert in CONTROL_VALUES gelöscht werden ' wenn der Wert im Control leer ist If (isDateEdit Or isTextBox Or isComboBox) And isEmptyValue Then Dim sql As String = $"DELETE FROM TBPMO_CONTROL_VALUE WHERE RECORD_ID = {RecordID} AND CONTROL_ID = {CONTROL_ID}" If ClassDatabase.Execute_non_Query(sql) = True Then If LICENSE_PROXY = True Or clsDatabase.DB_PROXY_INITIALIZED = True Then ClassDatabase.Execute_non_Query(sql, True) End If End If Else If Not IsNothing(CONTROL_VALUE) Then Dim sw2 As New SW("UpdateControlValue") UpdateControlValue(CONTROL_ID, RecordID, CONTROL_VALUE, CURRENT_ENTITY_ID) sw2.Done() End If End If End If Next sw.Done() If _error = True Then Return False Else Return True End If Catch ex As Exception MsgBox("Unexpected Error in UpdateAllControls: " & vbNewLine & ex.Message, MsgBoxStyle.Critical) Return False End Try End Function Public Shared Sub UpdateMultipleValues(ControlId As Integer, RecordId As Integer, value As String) Try Dim val = String.Format("SELECT VALUE FROM TBPMO_CONTROL_VALUE WHERE CONTROL_ID = {0} AND RECORD_ID = {1}", ControlId, RecordId) Dim dt As DataTable = ClassDatabase.Return_Datatable(val, True) If IsNothing(dt) Then Exit Sub End If ' Konvertiere datatable zu liste Dim oldValues = dt.AsEnumerable().Select(Of String)(Function(r) Return r.Item("VALUE") End Function).ToList() If (IsNothing(value) Or value = String.Empty) And dt.Rows.Count = 0 Then Exit Sub End If Dim values As New List(Of String) If Not IsNothing(value) Then values = New List(Of String)(value.Split(";")) Else values.Add("") End If 'Dim values As New List(Of String)(value.Split(";")) Dim AddValues = values.Except(oldValues).ToList() Dim RemoveValues = oldValues.Except(values).ToList() For Each _addValue As String In AddValues If Not _addValue = "" Then Dim converted_value = Check_and_Format_Value(ControlId, RecordId, _addValue) If Not IsNothing(converted_value) Then ClassControlCommandsUI.CreateControlProcedure(ControlId, RecordId, converted_value, CURRENT_ENTITY_ID) End If End If Next For Each v As String In RemoveValues ClassDatabase.Execute_non_Query(String.Format("DELETE FROM TBPMO_CONTROL_VALUE WHERE CONTROL_ID = {0} AND RECORD_ID = {1} AND VALUE = '{2}'", ControlId, RecordId, v)) ' ClassProxy.PRPROXY_CONTROL_DEL(RecordId, CURRENT_ENTITY_ID, ControlId) Next ClassProxy.PRPROXY_CONTROL_VALUE_UPD_INS(CURRENT_ENTITY_ID, ControlId, RecordId, "") Catch ex As Exception MsgBox("Error in UpdateMultipleValues:" & vbNewLine & ex.Message) End Try End Sub Public Shared Function GetControlValue(ctrl As Control) As String Dim type = ctrl.GetType().Name Dim CONTROL_ID As Integer = DirectCast(ctrl.Tag, ClassControlMetadata).Id ' GetControlID_for_RecordID(ctrl.Name, CURRENT_RECORD_ID) LOGGER.Debug("GetControlValue CONTROL_ID: " & CONTROL_ID, False) Dim CONTROL_VALUE As String = Nothing LOGGER.Debug("type = " & type.ToString, False) Select Case type Case "TextBox" Return DirectCast(ctrl, TextBox).Text Case "CustomComboBox" LOGGER.Debug("Return Value: " & DirectCast(ctrl, CustomComboBox).Text, False) Return DirectCast(ctrl, CustomComboBox).Text Case "CheckBox" Return DirectCast(ctrl, CheckBox).Checked.ToString() Case "RadioButton" Return DirectCast(ctrl, RadioButton).Checked.ToString() Case "DateEdit" Dim Value = DirectCast(ctrl, DevExpress.XtraEditors.DateEdit).EditValue If IsDBNull(Value) Or IsNothing(Value) Then Return "" Else Dim datevalue = DirectCast(ctrl, DevExpress.XtraEditors.DateEdit).DateTime.ToString("yyyy-MM-dd") If datevalue = "0001-01-01" Then Return "" Else Return datevalue End If End If Case "PictureBox" 'Return "PictureBox" 'Es ist egal was für ein String hier zurückgegeben wird, hauptsache nicht Nothing Case "CheckedListBoxControl" Dim chklbx As DevExpress.XtraEditors.CheckedListBoxControl chklbx = DirectCast(ctrl, DevExpress.XtraEditors.CheckedListBoxControl) Dim SQL_COMAMND = ClassDatabase.Execute_Scalar("SELECT UPPER(SQL_COMMAND_1) FROM TBPMO_CONTROL WHERE GUID = " & CONTROL_ID, True) 'TODO: Wenn keine Datasource vorhanden, angecheckte einträge als string speichern If IsNothing(chklbx.DataSource) Then Dim result As New List(Of String) Dim result_string As String For Each item As DevExpress.XtraEditors.Controls.CheckedListBoxItem In chklbx.CheckedItems result.Add(item.Value.ToString.Trim) Next result_string = String.Join(";", result) ' Hier wird ein String zurückgegeben, der als VALUE gespeichert werden soll ' Überspringt den Rest der funktion Return result_string End If If SQL_COMAMND.ToString.StartsWith("SELECT [RECORD_ID]") Or SQL_COMAMND.ToString.StartsWith("SELECT [RECORD-ID]") Then 'Alle Recorddatensätze durchlaufen und überprüfen ob nicht angehakt 'Wenn nicht angehakt dann Record löschen Dim index As Integer = 0 For i As Integer = 0 To chklbx.ItemCount - 1 Dim item = chklbx.GetItem(i) Dim row As DataRowView = CType(item, DataRowView) If chklbx.GetItemCheckState(i) = 0 Then If CInt(row(0)) > 0 Then 'Überprüfen ob es den Record gibt Dim SQL = "SELECT COUNT(*) FROM TBPMO_RECORD_CONNECT WHERE RECORD1_ID = " & CURRENT_RECORD_ID & " AND RECORD2_ID = " & CInt(row(0)) If ClassDatabase.Execute_Scalar(SQL, True) = 1 Then SQL = "DELETE FROM TBPMO_RECORD_CONNECT WHERE RECORD1_ID = " & CURRENT_RECORD_ID & " AND RECORD2_ID = " & CInt(row(0)) If ClassDatabase.Execute_non_Query(SQL) = True Then LOGGER.Debug("TBPMO_RECORD_CONNECT-Entry after 'deselect CheckedListBox' deleted", False) End If End If End If End If Next End If 'Für jeden gecheckten Eintrag den Record der Stammentität mit dem selektierten linken Dim checked_result As New List(Of String) Dim checked_result_string As String If SQL_COMAMND.ToString.StartsWith("SELECT [RECORD_ID]") Or SQL_COMAMND.ToString.StartsWith("SELECT [RECORD-ID]") Then For Each item As Object In DirectCast(ctrl, DevExpress.XtraEditors.CheckedListBoxControl).CheckedItems Dim row As DataRowView = CType(item, DataRowView) Try If CInt(row(0)) > 0 Then Dim rid = CInt(row(0)) Dim checked_value = row(1) checked_result.Add(checked_value) checked_result_string = String.Join(";", checked_result) Dim SQL = "SELECT COUNT(*) FROM TBPMO_RECORD_CONNECT WHERE RECORD1_ID = " & CURRENT_RECORD_ID & " AND RECORD2_ID = " & CInt(row(0)) If ClassDatabase.Execute_Scalar(SQL, True) = 0 Then If CURRENT_RECORD_ID = 0 Then MsgBox("Attention: no current record Selected!", MsgBoxStyle.Exclamation) Else If ClassRecordCommands.ConnectRecord(CURRENT_RECORD_ID, CInt(row(0)), "CheckedListBox;" & ctrl.Name) = True Then LOGGER.Debug("Checked ListBox record '" & rid.ToString & "' was linked successfully.", False) End If End If End If End If Catch ex As Exception LOGGER.Warn("Error in CheckedListBoxGetControlValue: " & ex.Message) End Try Next Else For Each item As Object In DirectCast(ctrl, DevExpress.XtraEditors.CheckedListBoxControl).CheckedItems Dim row As DataRowView = CType(item, DataRowView) If row.DataView.Table.Columns.Count = 1 Then Dim checked_value = row(0) checked_result.Add(checked_value) ElseIf row.DataView.Table.Columns.Count = 2 Then Dim checked_value = row(1) checked_result.Add(checked_value) End If checked_result_string = String.Join(";", checked_result) Next End If ' Hier wird ein String zurückgegeben, der als VALUE gespeichert werden soll ' Überspringt den Rest der funktion If Not IsNothing(checked_result_string) Then 'Dim sql = String.Format("select count(*) from TBPMO_CONTROL_VALUE where CONTROL_ID = {0} and RECORD_ID = {1}", CONTROL_ID, CURRENT_RECORD_ID) 'If ClassDatabase.Execute_Scalar(sql) = 0 Then ' InsertControlValue(CONTROL_ID, CURRENT_RECORD_ID, "") 'End If Return checked_result_string Else 'In jedem Fall Nothing zurückgeben Return Nothing End If Case "GridControl" Dim chk_grid As DevExpress.XtraGrid.GridControl chk_grid = DirectCast(ctrl, DevExpress.XtraGrid.GridControl) Dim gridview As DevExpress.XtraGrid.Views.Grid.GridView = chk_grid.MainView Dim SQL_COMAMND = ClassDatabase.Execute_Scalar("SELECT UPPER(SQL_COMMAND_1) FROM TBPMO_CONTROL WHERE GUID = " & CONTROL_ID, True) Dim result As New List(Of String) Dim result_string As String For Each index As Integer In gridview.GetSelectedRows() Dim fieldName As String = gridview.Columns(0).FieldName Dim value As String = gridview.GetRowCellValue(index, fieldName) result.Add(value) Next CURRENT_CONTROL_VALUE_COUNT = result.Count result_string = String.Join(";", result) If Not IsNothing(result_string) Then Return result_string Else Return Nothing End If Case "ListBoxControl" Dim listbox As DevExpress.XtraEditors.ListBoxControl = DirectCast(ctrl, DevExpress.XtraEditors.ListBoxControl) Return listbox.SelectedValue Case "DataGridView" Dim list As New List(Of String) Dim dgv As DataGridView = DirectCast(ctrl, DataGridView) For Each row As DataGridViewRow In dgv.Rows Dim cell As DataGridViewCell = row.Cells(0) If Not IsNothing(cell.Value) Then list.Add(cell.Value) End If Next Return String.Join(";", list) Case Else Return Nothing End Select End Function Public Class MyBaseClass End Class Public Class MyDerivedClass : Inherits MyBaseClass End Class Public Shared Function Check_and_Format_Value(ControlID As Integer, RecordID As Integer, Value As String) Try Dim expression As String expression = "GUID = " & ControlID Dim CONTROL_ROW() As DataRow ' Use the Select method to find all rows matching the filter. CONTROL_ROW = CURRENT_TBPMO_CONTROL.Select(expression) Dim i As Integer Dim FORMAT_TYPE As String, CONTROL_TYPE As Integer For i = 0 To CONTROL_ROW.GetUpperBound(0) FORMAT_TYPE = CONTROL_ROW(i)("FORMAT_TYPE") CONTROL_TYPE = CONTROL_ROW(i)("CONTROL_TYPE_ID") Next If CONTROL_TYPE = 0 And FORMAT_TYPE Is Nothing Then If IsDate(Value) Then CONTROL_TYPE = 4 End If End If Select Case FORMAT_TYPE Case "Currency" If Not Value = String.Empty Then Value = Decimal.Parse(Value, Globalization.NumberStyles.Currency).ToString End If Case "Decimal" If Not Value = String.Empty Then Value = Decimal.Parse(Value, Globalization.NumberStyles.Integer) End If End Select Select Case CONTROL_TYPE Case 4 Dim oDate = ClassHelper.Convert_to_Database_Date(Value) Value = oDate.ToString() End Select Value = Value.Replace("'", "´") Return Value Catch ex As Exception MsgBox("Unexpected Error in Check_and_Format_Value: " & vbNewLine & ex.Message, MsgBoxStyle.Critical) LOGGER.Warn("Unexpected Error in Check_and_Format_Value: " & ex.Message) Return Nothing End Try End Function Public Shared Function CreateControlProcedure(ControlID As Integer, RecordID As Integer, Value As String, ENTITY_ID As Integer) Try Dim _result As Integer Dim converted_value = Check_and_Format_Value(ControlID, RecordID, Value) If Not IsNothing(converted_value) Then Dim connection As New SqlConnection connection.ConnectionString = MyConnectionString Using cmd As New SqlCommand("PRPMO_CREATE_CONTROL_VALUE", connection) cmd.CommandType = CommandType.StoredProcedure cmd.Parameters.AddWithValue("@pRECORD_ID", RecordID) cmd.Parameters.AddWithValue("@pCONTROL_ID", ControlID) cmd.Parameters.AddWithValue("@pVALUE", converted_value) cmd.Parameters.AddWithValue("@pADDED_WHO", USER_USERNAME) cmd.Parameters.Add("@pRESULT", SqlDbType.Int) cmd.Parameters("@pRESULT").Direction = ParameterDirection.Output connection.Open() cmd.ExecuteNonQuery() connection.Close() _result = cmd.Parameters("@pRESULT").Value If _result = 1 And clsDatabase.DB_PROXY_INITIALIZED = True Then ClassProxy.PRPROXY_CONTROL_VALUE_UPD_INS(ENTITY_ID, ControlID, RecordID, converted_value) End If Return _result End Using Else _result = 0 End If Catch ex As Exception Dim name = clsDatabase.Execute_Scalar("SELECT NAME FROM TBPMO_CONTROL WHERE GUID = " & ControlID, True) MsgBox(ex.Message, MsgBoxStyle.Critical, "Error in CreateControlProcedure für Control: " & name) LOGGER.Warn("Error in CreateControlProcedure: " & ex.Message, True) Return 0 End Try End Function Public Shared Function InsertControlValueOld(ControlID As Integer, RecordID As Integer, Value As String, ENTITY_ID As Integer) Try Dim AddedWho = USER_USERNAME Dim converted_value = Check_and_Format_Value(ControlID, RecordID, Value) If Not IsNothing(converted_value) Then converted_value = converted_value.Replace("'", "´") Dim ins As String = String.Format("INSERT INTO TBPMO_CONTROL_VALUE (CONTROL_ID, RECORD_ID, VALUE, ADDED_WHO) VALUES ({0}, {1}, '{2}', '{3}')", ControlID, RecordID, converted_value, AddedWho) If LICENSE_PROXY = True Or clsDatabase.DB_PROXY_INITIALIZED = True Then If ClassDatabase.Execute_non_Query(ins) = True Then Return ClassProxy.PRPROXY_CONTROL_VALUE_UPD_INS(ENTITY_ID, ControlID, RecordID, converted_value) Else Return False End If Else Return ClassDatabase.Execute_non_Query(ins) End If Else Return False End If Catch ex As Exception MsgBox("Unexpected Error in inserting Control-Value: " & vbNewLine & ex.Message, MsgBoxStyle.Critical) LOGGER.Warn("Unexpected Error in inserting Control-Value: " & ex.Message) Return False End Try End Function Public Shared Function UpdateControlValue(ControlID As Integer, RecordID As Integer, Value As String, ENTITY_ID As Integer) Try Dim CHANGED_WHO = USER_USERNAME Dim converted_value = Check_and_Format_Value(ControlID, RecordID, Value) Dim def = "SELECT FORMAT_TYPE,CONTROL_TYPE_ID FROM TBPMO_CONTROL WHERE GUID = " & ControlID Dim upd = String.Format("UPDATE TBPMO_CONTROL_VALUE SET VALUE = '{0}', CHANGED_WHO = '{1}', CHANGE_STEP = {2} WHERE CONTROL_ID = {3} AND RECORD_ID = {4}", converted_value, CHANGED_WHO, CURRENT_CHANGE_STEP, ControlID, RecordID) If ControlID = 279 Or ControlID = 745 Then LOGGER.Warn(upd) End If If LICENSE_PROXY = True Or clsDatabase.DB_PROXY_INITIALIZED = True Then If ClassDatabase.Execute_non_Query(upd) = True Then Return ClassProxy.PRPROXY_CONTROL_VALUE_UPD_INS(ENTITY_ID, ControlID, RecordID, converted_value) Else Return False End If Else Return ClassDatabase.Execute_non_Query(upd) End If Catch ex As Exception LOGGER.Warn("Unerwarteter Fehler in UpdateControlValue: " & ex.Message) Return False End Try End Function End Class