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("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.Tag = "ADDAPPOINTMENT" Then Return 8 ElseIf control.Tag = "ADDFORMDATA" Then Return 9 End If Case CurrentType.Contains("CheckedListBoxControl".ToUpper) Return 12 Case CurrentType.Contains("ListBoxControl".ToUpper) Return 13 Case Else Return -1 End Select End Function ' +++ Public Functions +++ Public Shared Function GetControlGuid(name As String) Try Return ClassDatabase.Execute_Scalar("SELECT GUID FROM TBPMO_CONTROL WHERE NAME = '" & name & "'") 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_FORM_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_FORM_ID & ", " & CONTROL_TYPE_ID & ", '', '" & NAME & "', '" & NAME & "', " & PARENT_CONTROL_ID & ", '')" 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_FORM_ID) Else Throw New Exception() End If Catch ex As Exception MsgBox("Fehler beim Einfügen des Elements:" + vbNewLine + ex.Message, MsgBoxStyle.Critical) Return False End Try End Function Public Shared Function InsertControlScreen(guid As Integer, control As Control, CURRENT_FORM_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 FORM_ID = " & CURRENT_FORM_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, TAB_INDEX) VALUES (" & guid & ", 1, '" & CONTROL_TEXT & "', " & X_LOC & ", " & Y_LOC & ", " & HEIGHT & ", " & WIDTH & ", " & TAB_INDEX & ")" If ClassDatabase.Execute_non_Query(SQL) Then Return True Else Throw New Exception() End If Catch ex As Exception MsgBox("Fehler beim Einfügen der Ansichtseigenschaften des Elements:" + 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_FORM_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 = '" & Environment.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 MsgBox("Fehler beim Aktualisieren der Elementposition:" & 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 CurrentType As String = control.GetType.Name Dim SQL As String Dim NAME As String Dim REQUIRED As Integer Dim READ_ONLY As Integer Dim CHANGED_WHO As String = Environment.UserName Dim COL_NAME As String Dim SQLCommand 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 NAME = properties.Name If propExists(properties, "Multiline") Then MULTILINE = BoolToInt(properties.Multiline) Else MULTILINE = 0 End If If propExists(properties, "ColumnTitle") Then COL_NAME = properties.ColumnTitle Else COL_NAME = String.Empty End If If CurrentType = "RadioButton" AndAlso propExistsWithType(properties, "DefaultValue", GetType(Boolean)) Then DEFAULTVALUE = properties.DefaultValue ElseIf CurrentType = "CheckBox" AndAlso propExistsWithType(properties, "DefaultValue", GetType(Boolean)) Then DEFAULTVALUE = properties.DefaultValue ElseIf propExists(properties, "DefaultValue") Then DEFAULTVALUE = properties.DefaultValue Else DEFAULTVALUE = "" End If If CurrentType = "TextBox" OrElse CurrentType = "ComboBox" OrElse CurrentType = "CheckBox" OrElse CurrentType = "RadioButton" OrElse CurrentType = "CheckedListBoxControl" OrElse CurrentType = "ListBoxControl" Then SHOW_COLUMN = BoolToInt(properties.ShowColumn) Else SHOW_COLUMN = BoolToInt(True) End If If CurrentType = "TextBox" AndAlso propExists(properties, "Format") Then FORMAT_TYPE = properties.Format.ToString ElseIf CurrentType = "ComboBox" AndAlso propExists(properties, "Format") Then FORMAT_TYPE = properties.Format.ToString Else FORMAT_TYPE = EnumFormat.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, "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, "StaticList") Then STATIC_LIST = properties.StaticList 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 & "', CHANGED_WHO = '" & CHANGED_WHO & "', COL_NAME = '" & COL_NAME & "', MULTILINE = " & MULTILINE & ", MASTER_DATA_ID = " & MASTER_DATA_ID & ", STATIC_LIST = '" & STATIC_LIST & "' 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 MsgBox("Fehler beim Aktualisieren des Elements:" + 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 = Environment.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 X_LOC = properties.Location.X Y_LOC = properties.Location.Y HEIGHT = properties.Size.Height WIDTH = properties.Size.Width If propExists(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 If ClassDatabase.Execute_non_Query(SQL) = True Then If CurrentType.Contains("Button") Then If control.Tag = "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_FORM_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_FORM_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.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 MsgBox("Fehler beim Aktualisieren der Ansichtseigenschaften des Elements:" + vbNewLine + ex.Message, MsgBoxStyle.Critical) Return False End Try End Function Public Shared Function DeleteControl() Try If CURRENT_CONTROL_ID = Nothing Then MsgBox("Kein Element ausgewählt", MsgBoxStyle.Information) End If If DeleteControlValues(CURRENT_CONTROL_ID) = True Then If DeleteControlScreen(CURRENT_CONTROL_ID) = True Then If ClassFunctionCommands.DeleteFunction(CURRENT_CONTROL_ID) = True Then Dim SQL = "DELETE FROM TBPMO_CONTROL_IMAGE WHERE CONTROL_ID = " & CURRENT_CONTROL_ID If ClassDatabase.Execute_non_Query(SQL) = True Then SQL = "DELETE FROM TBPMO_CONTROL WHERE GUID = " & CURRENT_CONTROL_ID If ClassDatabase.Execute_non_Query(SQL) = True Then Return True End If Else Return False End If End If Else Return False End If Else Return False End If Catch ex As Exception MsgBox("Fehler beim Löschen des Elements:" + vbNewLine + ex.Message, MsgBoxStyle.Critical) Return False End Try End Function Public Shared Function DeleteControl(id As Integer) Try If DeleteControlValues(id) = True Then If DeleteControlScreen(id) = True Then If ClassFunctionCommands.DeleteFunction(id) = True Then Dim SQL = "DELETE FROM TBPMO_CONTROL WHERE GUID = " & id If ClassDatabase.Execute_non_Query(SQL) = True Then Return True Else Throw New Exception() End If End If End If End If Catch ex As Exception MsgBox("Fehler beim Löschen des Elements:" + 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_SCREEN WHERE CONTROL_ID = " & id If ClassDatabase.Execute_non_Query(SQL) = True Then Return True Else Throw New Exception() End If Catch ex As Exception MsgBox("Fehler beim Löschen der Ansichtseigenschaften des Elements:" + 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 MsgBox("Fehler beim Löschen der Werte des Elements:" + 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