Public Class ClassControlCommands ' +++ Helper Functions +++ 'Public Shared Function BoolToInt(bool As Boolean) As Integer ' ' Wandelt einen Boolean Wert in einen Int um ' Return IIf(bool, 1, 0) 'End Function Public Shared Function ControlToTypeId(control As Control) As Integer Dim CurrentType As String = control.GetType.ToString.ToUpper Select Case True Case CurrentType.Contains("LineLabel".ToUpper) Return 15 Case CurrentType.Contains("Label".ToUpper) Return 1 Case CurrentType.Contains("TextBox".ToUpper) Return 2 Case CurrentType.Contains("ComboBox".ToUpper) Return 3 Case CurrentType.Contains("DateTimePicker".ToUpper) Return 4 Case CurrentType.Contains("DevExpress.XtraEditors.DateEdit".ToUpper) Return 4 Case CurrentType.Contains("GroupBox".ToUpper) Return 5 Case CurrentType.Contains("PictureBox".ToUpper) Return 6 Case CurrentType.Contains("DataGridView".ToUpper) Return 7 Case CurrentType.Contains("CheckBox".ToUpper) Return 10 Case CurrentType.Contains("RadioButton".ToUpper) Return 11 Case CurrentType.Contains("Button".ToUpper) If control.Name.Contains("f_addappointment") Then Return 8 ElseIf control.Name.Contains("f_addformdata") Then Return 9 End If Case CurrentType.Contains("DEVEXPRESS.XTRAGRID.GRIDCONTROL".ToUpper) Return 14 Case CurrentType.Contains("CheckedListBoxControl".ToUpper) Return 12 Case CurrentType.Contains("ListBoxControl".ToUpper) Return 13 ' Id 14 ist DataGridView Checkable - nicht verwendet Case Else Return -1 End Select End Function ' +++ Public Functions +++ Public Shared Function GetParentRecordId(RecordId As Integer) As Integer Try Dim parentId = ClassDatabase.Execute_Scalar("SELECT RECORD1_ID FROM TBPMO_RECORD_CONNECT WHERE RECORD2_ID = " & RecordId, True) If IsNothing(parentId) Then Return 0 Else Return parentId End If Catch ex As Exception MsgBox("Error in GetFormId:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Function Public Shared Function GetFormId(RecordId As Integer) As Integer Try Dim FormId = ClassDatabase.Execute_Scalar("SELECT FORM_ID FROM VWPMO_VALUES WHERE RECORD_ID = " & RecordId, True) Return FormId Catch ex As Exception MsgBox("Error in GetFormId:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Function Public Shared Function GetControlGuid(name As String) Try Dim sql = "SELECT GUID FROM TBPMO_CONTROL WHERE UPPER(NAME) = UPPER('" & name & "')" Return ClassDatabase.Execute_Scalar(sql, True) Catch ex As Exception Return -1 End Try End Function Public Shared Function InsertControl(control As Control) Try Dim SQL As String Dim NAME As String Dim CONTROL_TYPE_ID As Integer Dim PARENT_CONTROL_ID As Integer = 0 Dim DEFVALUE As String = "" If (control.Parent.GetType().Name = "GroupBox") Then Dim ParentID As Integer = GetControlID_for_Name(control.Parent.Name, CURRENT_ENTITY_ID) PARENT_CONTROL_ID = ParentID End If NAME = control.Name CONTROL_TYPE_ID = ControlToTypeId(control) ' SQL Befehl für CONTROL TABELLE ' SQL_COMMAND_1 auf leeren String setzen SQL = $"INSERT INTO TBPMO_CONTROL (FORM_ID, CONTROL_TYPE_ID, DEFAULT_VALUE, NAME, COL_NAME, PARENT_CONTROL_ID, SQL_COMMAND_1) VALUES ({CURRENT_ENTITY_ID}, {CONTROL_TYPE_ID}, '', '{NAME}', '{NAME}', {PARENT_CONTROL_ID}, '')" 'LOGGER.Debug(SQL) If ClassDatabase.Execute_non_Query(SQL) = True Then SQL = "SELECT MAX(GUID) FROM TBPMO_CONTROL" Dim GUID = ClassDatabase.Execute_Scalar(SQL) Return InsertControlScreen(GUID, control, CURRENT_ENTITY_ID) Else Throw New Exception() End If Catch ex As Exception LOGGER.Warn("Unexpected Error in InsertControl: " & ex.Message) MsgBox("Unexpected Error in InsertControl:" + vbNewLine + ex.Message, MsgBoxStyle.Critical) Return False End Try End Function Public Shared Function InsertControlScreen(guid As Integer, ByRef control As Control, CURRENT_ENTITY_ID As Integer) Try Dim CurrentType As String = control.GetType.ToString Dim SQL As String Dim X_LOC, Y_LOC, WIDTH, HEIGHT As Integer Dim CONTROL_TEXT As String X_LOC = control.Location.X Y_LOC = control.Location.Y WIDTH = control.Width HEIGHT = control.Height CONTROL_TEXT = control.Text 'Dim TAB_INDEX 'SQL = "SELECT MAX(TAB_INDEX) FROM TBPMO_CONTROL_SCREEN WHERE CONTROL_ID IN (SELECT GUID FROM TBPMO_CONTROL WHERE CURRENT_ENTITY_ID = " & CURRENT_ENTITY_ID & ")" 'TAB_INDEX = ClassDatabase.Execute_Scalar(SQL) 'If Not TAB_INDEX Is Nothing Then ' If IsDBNull(TAB_INDEX) Then ' TAB_INDEX = 1 ' Else ' TAB_INDEX = CInt(TAB_INDEX) + 1 ' End If 'Else ' TAB_INDEX = 1 'End If SQL = "INSERT TBPMO_CONTROL_SCREEN (CONTROL_ID, SCREEN_ID, CONTROL_TEXT, X_LOC, Y_LOC, HEIGHT, WIDTH) VALUES (" & guid & ", 1, '" & CONTROL_TEXT & "', " & X_LOC & ", " & Y_LOC & ", " & HEIGHT & ", " & WIDTH & ")" If ClassDatabase.Execute_non_Query(SQL) Then ' Die Guid in die Metadaten des Controls zurückschreiben Dim metadata = DirectCast(control.Tag, ClassControlMetadata) metadata.Id = guid control.Tag = metadata SQL = "SELECT MAX(GUID) FROM TBPMO_CONTROL_SCREEN WHERE CONTROL_ID = " & guid & " AND SCREEN_ID = " & CURRENT_SCREEN_ID Dim ctrl_screen_Id = ClassDatabase.Execute_Scalar(SQL) SQL = String.Format("INSERT INTO TBPMO_CONTROL_LANGUAGE (LANGUAGE_TYPE,CONTROL_SCREEN_ID,CAPTION,ADDED_WHO) VALUES ('{0}',{1},'{2}','{3}')", USER_LANGUAGE, ctrl_screen_Id, CONTROL_TEXT, USER_USERNAME) ClassDatabase.Execute_non_Query(SQL) Return True Else Throw New Exception() End If Catch ex As Exception LOGGER.Warn("Unexpected Error in InsertControlScreen: " & ex.Message) MsgBox("Unexpected Error in InsertControlScreen (Adding ViewProperties:" + vbNewLine + ex.Message, MsgBoxStyle.Critical) Return False End Try End Function Public Shared Function UpdateControlPosition(ByVal x As Integer, ByVal y As Integer, control As Control) Try Dim CONTROL_ID = GetControlID_for_Name(control.Name, CURRENT_ENTITY_ID) 'If (ParentIsGroupBox(control)) Then ' Console.WriteLine("Before:" & x & ":" & y) ' x = x - control.Parent.Location.X ' y = y - control.Parent.Location.Y ' Console.WriteLine("After:" & x & ":" & y) 'End If Dim SQL = "UPDATE TBPMO_CONTROL_SCREEN SET X_LOC = " & x & ", Y_LOC = " & y & ", CHANGED_WHO = '" & USER_USERNAME & "' WHERE CONTROL_ID = " & CONTROL_ID If ClassDatabase.Execute_non_Query(SQL) = True Then Return True Else Throw New Exception() End If Catch ex As Exception LOGGER.Warn("Unexpected Error in UpdateControlPosition: " & ex.Message) MsgBox("Unexpected Error in UpdateControlPosition:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) Return False End Try End Function Public Shared Function UpdateControl(control As Control, properties As Object) Try ' Nach Typ den Update Befehl anpassen Dim type As String = control.GetType.Name Dim SQL As String Dim NAME As String Dim REQUIRED As Integer Dim READ_ONLY As Integer Dim SELECT_ONLY As Integer Dim CHANGED_WHO As String = USER_USERNAME Dim COL_NAME As String Dim SQLCommand As String Dim SQL_ENABLED_WHEN As String Dim MULTILINE As Integer Dim MASTER_DATA_ID As Integer Dim DEFAULTVALUE As String Dim FORMAT_TYPE As String Dim SHOW_COLUMN As Integer Dim STATIC_LIST As String Dim VISIBLE As Integer Dim TREE_VIEW As Integer Dim AUTO_SUGGEST As Integer ' So sollte diese Funktion später mal aussehen :( 'Select Case type ' Case "TextBox" ' NAME = properties.Name ' MULTILINE = ClassConverter.BoolToInt(properties.Multiline) ' COL_NAME = ClassConverter.ToStringOrDefault(properties.ColumnTitle) ' DEFAULTVALUE = ClassConverter.ToStringOrDefault(properties.DefaultValue) ' SHOW_COLUMN = ClassConverter.BoolToInt(properties.ShowColumn) ' FORMAT_TYPE = properties.Format.ToString() ' REQUIRED = ClassConverter.BoolToInt(properties.IsRequired) ' READ_ONLY = ClassConverter.BoolToInt(properties.IsReadOnly) ' SQLCommand = ClassConverter.SQLValueToString(properties.SQLCommand) 'End Select NAME = properties.Name VISIBLE = BoolToInt(properties.Visible) If propExists(properties, "Multiline") Then MULTILINE = BoolToInt(properties.Multiline) Else MULTILINE = 0 End If If propExists(properties, "AutoSuggest") Then AUTO_SUGGEST = BoolToInt(properties.AutoSuggest) Else AUTO_SUGGEST = 0 End If If propExists(properties, "ColumnTitle") Then COL_NAME = properties.ColumnTitle Else COL_NAME = String.Empty End If If Not (type = "RadioButton" Or type = "CheckBox" Or type = "GroupBox") Then TREE_VIEW = BoolToInt(properties.TreeView) End If If type = "RadioButton" Then DEFAULTVALUE = properties.DefaultValue ElseIf type = "CheckBox" Then DEFAULTVALUE = properties.DefaultValue ElseIf type = "CustomComboBox" Then DEFAULTVALUE = properties.DefaultValue ElseIf type = "DateEdit" Then DEFAULTVALUE = ClassConverter.ToDateTimePickerOptionsOrDefault(properties.DefaultValue) ElseIf type = "TextBox" Then DEFAULTVALUE = properties.DefaultValue End If If propExists(properties, "ShowColumn") Then SHOW_COLUMN = BoolToInt(properties.ShowColumn) End If If type = "TextBox" AndAlso propExists(properties, "Format") Then FORMAT_TYPE = properties.Format.ToString ElseIf type = "ComboBox" AndAlso propExists(properties, "Format") Then FORMAT_TYPE = properties.Format.ToString Else FORMAT_TYPE = EnumFormatOptions.String.ToString End If If propExists(properties, "IsRequired") Then REQUIRED = BoolToInt(properties.IsRequired) Else REQUIRED = BoolToInt(False) End If If propExists(properties, "IsReadOnly") Then READ_ONLY = BoolToInt(properties.IsReadOnly) Else READ_ONLY = BoolToInt(False) End If If propExists(properties, "IsSelectOnly") Then SELECT_ONLY = BoolToInt(properties.IsSelectOnly) Else SELECT_ONLY = BoolToInt(False) End If If propExists(properties, "SQLCommand") Then Dim value As SQLValue = DirectCast(properties.SQLCommand, SQLValue) SQLCommand = value.Value 'Maskieren von Hochkommata damit der Insert angenommen wird If SQLCommand.Contains("'") Then SQLCommand = SQLCommand.Replace("'", "''") End If Else SQLCommand = String.Empty End If If propExists(properties, "EnabledWhen") Then Dim value As SQLValue = DirectCast(properties.EnabledWhen, SQLValue) SQL_ENABLED_WHEN = value.Value If SQL_ENABLED_WHEN.Contains("'") Then SQL_ENABLED_WHEN = SQL_ENABLED_WHEN.Replace("'", "''") End If Else SQL_ENABLED_WHEN = String.Empty End If If propExists(properties, "StaticList") Then Dim value As StaticListValue = DirectCast(properties.StaticList, StaticListValue) STATIC_LIST = value.Value Else STATIC_LIST = String.Empty End If If propExists(properties, "MasterDataId") Then MASTER_DATA_ID = properties.MasterDataId Else MASTER_DATA_ID = 0 End If ' If CURRENT_CONTROL_ID isn't equal to ID in Properties Window, make it equal If CURRENT_CONTROL_ID <> properties.ID Then CURRENT_CONTROL_ID = properties.ID End If SQL = $"UPDATE TBPMO_CONTROL SET REQUIRED = {REQUIRED}, READ_ONLY = {READ_ONLY}, SHOW_COLUMN = {SHOW_COLUMN}, FORMAT_TYPE = '{FORMAT_TYPE}', DEFAULT_VALUE = '{DEFAULTVALUE}', NAME = '{NAME}', SQL_COMMAND_1 = '{SQLCommand}', SQL_COMMAND_2 = '{SQL_ENABLED_WHEN}', CHANGED_WHO = '{CHANGED_WHO}', COL_NAME = '{COL_NAME}', MULTILINE = {MULTILINE}, MASTER_DATA_ID = {MASTER_DATA_ID}, STATIC_LIST = '{STATIC_LIST}', VISIBLE = {VISIBLE}, TREE_VIEW = {TREE_VIEW}, SELECT_ONLY = {SELECT_ONLY}, AUTO_SUGGEST = {AUTO_SUGGEST} WHERE GUID = {CURRENT_CONTROL_ID}" If ClassDatabase.Execute_non_Query(SQL) = True Then Return UpdateControlScreen(control, properties) Else Throw New Exception() End If Catch ex As Exception LOGGER.Warn("Unexpected Error in UpdateControl: " & ex.Message) MsgBox("Unexpected Error in UpdateControl:" + vbNewLine + ex.Message, MsgBoxStyle.Critical) Return False End Try End Function Public Shared Function UpdateControlScreen(control As Control, properties As Object) Try Dim SQL As String Dim CurrentType As String = control.GetType.ToString Dim X_LOC, Y_LOC As Integer Dim HEIGHT, WIDTH As Integer Dim CHANGED_WHO As String = USER_USERNAME Dim CONTROL_TEXT As String Dim TAB_INDEX As Integer Dim TAB_STOP As Integer Dim FONT_FAMILY As String Dim FONT_COLOR As Integer Dim FONT_SIZE As Integer Dim FONT_STYLE As Integer Dim BACK_COLOR As Integer Dim HINT As String = properties.Hint X_LOC = properties.Location.X Y_LOC = properties.Location.Y HEIGHT = properties.Size.Height WIDTH = properties.Size.Width If propExists(properties, "Font") AndAlso Not IsNothing(properties.Font) Then Dim f As Font = properties.Font FONT_FAMILY = f.FontFamily.Name FONT_SIZE = CType(f.Size, Integer) FONT_STYLE = CType(f.Style, Integer) Else FONT_FAMILY = "Segoe UI" FONT_SIZE = 8 FONT_STYLE = 0 End If If propExists(properties, "FontColor") Then Dim c As Color = properties.FontColor FONT_COLOR = ColorToInt(c) Else Dim c As Color = Color.Black FONT_COLOR = ColorToInt(c) End If If propExists(properties, "TabIndex") Then TAB_INDEX = properties.TabIndex Else TAB_INDEX = 0 End If If propExists(properties, "TabStop") Then TAB_STOP = BoolToInt(properties.TabStop) Else TAB_STOP = BoolToInt(False) End If If propExists(properties, "Caption") Then CONTROL_TEXT = properties.Caption Else CONTROL_TEXT = String.Empty End If If propExists(properties, "BackColor") Then BACK_COLOR = ColorToInt(properties.BackColor) Else BACK_COLOR = ColorToInt(SystemColors.Control) End If SQL = "UPDATE TBPMO_CONTROL_SCREEN SET TAB_INDEX = " & TAB_INDEX & ", TAB_STOP = " & TAB_STOP & ", X_LOC = " & X_LOC & ", Y_LOC = " & Y_LOC & ", HEIGHT = " & HEIGHT & ", WIDTH = " & WIDTH & ", CONTROL_TEXT = '" & CONTROL_TEXT & "', CHANGED_WHO = '" & CHANGED_WHO & "', FONT_COLOR = " & FONT_COLOR & ", FONT_SIZE = " & FONT_SIZE & ", FONT_STYLE = " & FONT_STYLE & ", FONT_FAMILY = '" & FONT_FAMILY & "' , BACK_COLOR = " & BACK_COLOR & " WHERE CONTROL_ID = " & CURRENT_CONTROL_ID & " AND SCREEN_ID = " & CURRENT_SCREEN_ID If ClassDatabase.Execute_non_Query(SQL) = True Then Dim upd = String.Format("UPDATE TBPMO_CONTROL_LANGUAGE SET CAPTION = '{0}', HINT = '{1}' WHERE LANGUAGE_TYPE = '{2}' AND " & _ "CONTROL_SCREEN_ID = (SELECT GUID FROM TBPMO_CONTROL_SCREEN WHERE CONTROL_ID = " & _ CURRENT_CONTROL_ID & " AND SCREEN_ID = " & CURRENT_SCREEN_ID & ")", CONTROL_TEXT, HINT, USER_LANGUAGE) ClassDatabase.Execute_non_Query(upd) If CurrentType.Contains("Button") Then 'If control.Tag = "ADDAPPOINTMENT" Then If control.Name.Contains("f_addappointment") Then Dim ControlId = properties.ID Dim FromDateId, ToDateId As Integer Dim SubjectString, Subject2String, PlaceString, DescString As String If propExists(properties, "FromDate") And Not String.IsNullOrWhiteSpace(properties.FromDate) Then FromDateId = GetControlID_for_Name(properties.FromDate, CURRENT_ENTITY_ID) If FromDateId = -1 Then Throw New Exception("Das Element für 'fromDate' mit dem Namen " & properties.FromDate & " existiert nicht!") End If End If If propExists(properties, "ToDate") And Not String.IsNullOrWhiteSpace(properties.ToDate) Then ToDateId = GetControlID_for_Name(properties.ToDate, CURRENT_ENTITY_ID) If ToDateId = -1 Then Throw New Exception("Das Element für 'ToDate' mit dem Namen " & properties.ToDate & " existiert nicht!") End If End If If propExists(properties, "Subject") Then SubjectString = properties.Subject Else SubjectString = String.Empty End If If propExists(properties, "Subject2") Then Subject2String = properties.Subject2 Else Subject2String = String.Empty End If If propExists(properties, "Place") Then PlaceString = properties.Place Else PlaceString = String.Empty End If If propExists(properties, "Description") Then DescString = properties.Description Else DescString = String.Empty End If ClassFunctionCommands.UpdateAddAppointmentFunction(ControlId, FromDateId, ToDateId, SubjectString, Subject2String, PlaceString, DescString) ElseIf control.Name.Contains("f_addformdata") Then 'ElseIf control.Tag = "ADDFORMDATA" Then Dim ControlId = properties.ID Dim FormID, ScreenID As Integer If propExists(properties, "FormID") And Not String.IsNullOrWhiteSpace(properties.FormID) Then FormID = properties.FormID End If If propExists(properties, "ScreenID") And Not String.IsNullOrWhiteSpace(properties.ScreenID) Then ScreenID = properties.ScreenID End If ClassFunctionCommands.UpdateAddFormDataFunction(ControlId, FormID, ScreenID) End If End If Return True Else Throw New Exception() End If Catch ex As Exception LOGGER.Warn("Unexpected Error in UpdateControlScreen: " & ex.Message) MsgBox("Unexpected Error in UpdateControlScreen:" + vbNewLine + ex.Message, MsgBoxStyle.Critical) Return False End Try End Function Public Shared Function DeleteControl(ID As Integer) Try Dim del = "EXEC [dbo].[PRPMO_DELETE_CONTROL] " & ID.ToString If ClassDatabase.Execute_non_Query(del) = True Then Return True Else Return False End If Catch ex As Exception LOGGER.Warn("Unexpected Error in Delete Control: " & ex.Message) MsgBox("Unexpected Error in Delete Control:" + vbNewLine + ex.Message, MsgBoxStyle.Critical) Return False End Try End Function Public Shared Function DeleteControlScreen(id As Integer) Try Dim SQL = "DELETE FROM TBPMO_CONTROL_LANGUAGE WHERE CONTROL_SCREEN_ID IN (SELECT GUID FROM TBPMO_CONTROL_SCREEN WHERE CONTROL_ID = " & id & ")" If ClassDatabase.Execute_non_Query(SQL) = True Then SQL = "DELETE FROM TBPMO_CONTROL_SCREEN WHERE CONTROL_ID = " & id If ClassDatabase.Execute_non_Query(SQL) = True Then Return True Else Throw New Exception() End If Else Throw New Exception() End If Catch ex As Exception LOGGER.Warn("Unexpected Error in DeleteControlScreen: " & ex.Message) MsgBox("Unexpected Error in DeleteControlScreen:" + vbNewLine + ex.Message, MsgBoxStyle.Critical) Return False End Try End Function Public Shared Function DeleteControlValues(id As Integer) Try Dim SQL = "DELETE FROM TBPMO_CONTROL_VALUE WHERE CONTROL_ID = " & id If ClassDatabase.Execute_non_Query(SQL) = True Then Return True Else Throw New Exception() End If Catch ex As Exception LOGGER.Warn("Unexpected Error in DeleteControlValues: " & ex.Message) MsgBox("Unexpected Error in DeleteControlValues:" + vbNewLine + ex.Message, MsgBoxStyle.Critical) Return False End Try End Function Public Shared Function CTRL_EXISTSinPARENT(ctrlName As String, parent As Control) As Boolean Dim bResult As Boolean = False For Each elem As Control In parent.Controls If elem.Name = ctrlName Then bResult = True Exit For End If Next Return bResult End Function End Class