Public Class frmTool_ControlProperties Private Shared _Instance As frmTool_ControlProperties = Nothing Private CurrentProperties As Object = Nothing Public Shared Function Instance() As frmTool_ControlProperties If _Instance Is Nothing OrElse _Instance.IsDisposed = True Then _Instance = New frmTool_ControlProperties End If _Instance.BringToFront() Return _Instance End Function Private Sub frmTool_ControlProperties_Load(sender As Object, e As EventArgs) Handles MyBase.Load ClassWindowLocation.LoadFormLocationSize(Me, 1, CURRENT_SCREEN_ID, "frmTool_ControlProperties") End Sub Private Sub frmTool_ControlProperties_FormClosing(sender As Object, e As FormClosingEventArgs) Handles MyBase.FormClosing Try ClassWindowLocation.SaveFormLocationSize(Me, 1, CURRENT_SCREEN_ID, "frmTool_ControlProperties") My.Settings.Save() Catch ex As Exception MsgBox("Settings could not be saved.\n" & ex.ToString) End Try End Sub ' ADDED 25.11 ' Lade Control Eigenschaften und zeige diese an ' Wird von frmLevelDesigner aufgerufen Public Sub LoadControlProperties(ctrl As Control) Try Dim sql As String = "SELECT CTRLSCR_ID FROM VWPMO_CONTROL_SCREEN WHERE CONTROL_NAME = '" & ctrl.Name & "' AND FORM_ID = " & CURRENT_FORM_ID & " and SCREEN_ID = " & CURRENT_SCREEN_ID Dim CTRLSCR_ID = ClassDatabase.Execute_Scalar(sql) If CTRLSCR_ID > 0 Then Dim DT As DataTable = ClassDatabase.Return_Datatable("SELECT * FROM VWPMO_CONTROL_SCREEN WHERE CTRLSCR_ID = " & CTRLSCR_ID) If DT.Rows.Count = 1 Then Dim row As DataRow = DT.Rows(0) Dim type As String = row.Item("CTRLTYPE_NAME") Dim props As Object = Nothing Dim fontcolor As Color Dim fontfamily As String Dim fontstyle As FontStyle Dim fontsize As Single Dim isreadonly As Boolean Dim isrequired As Boolean Dim columntitle As String Dim DefaultValue As String Select Case type Case "Label" props = New LabelProperties() props.Caption = row.Item("CTRLSCR_CAPTION") Case "Textbox" props = New TextBoxProperties() If Not IsDBNull(row.Item("CONTROL_DEF_VALUE")) Then props.DefaultValue = row.Item("CONTROL_DEF_VALUE") Else props.DefaultValue = "" End If If Not IsDBNull(row.Item("CONTROL_FORMAT_TYPE")) Then props.Format = DirectCast([Enum].Parse(GetType(EnumFormat), row.Item("CONTROL_FORMAT_TYPE")), Integer) Else props.Format = "String" End If Case "Combobox" props = New ComboBoxProperties() props.MasterDataId = row.Item("CTRLSCR_MASTER_DATA_ID") If Not IsDBNull(row.Item("CONTROL_DEF_VALUE")) Then props.DefaultValue = row.Item("CONTROL_DEF_VALUE") Else props.DefaultValue = "" End If If Not IsDBNull(row.Item("CONTROL_FORMAT_TYPE")) Then props.Format = DirectCast([Enum].Parse(GetType(EnumFormat), row.Item("CONTROL_FORMAT_TYPE")), Integer) Else props.Format = "String" End If If Not IsDBNull(row.Item("CONTROL_STATIC_LIST")) Then props.StaticList = row.Item("CONTROL_STATIC_LIST") Else props.StaticList = "" End If Case "Checkbox" props = New CheckBoxProperties() props.Caption = row.Item("CTRLSCR_CAPTION") If IsDBNull(row.Item("CONTROL_DEF_VALUE")) Or row.Item("CONTROL_DEF_VALUE") = String.Empty Then props.DefaultValue = False Else props.DefaultValue = row.Item("CONTROL_DEF_VALUE") End If Case "Datepicker" props = New DateTimePickerProperties() Case "Datagridview" props = New DataGridViewProperties() Case "Groupbox" props = New GroupBoxProperties() props.Caption = row.Item("CTRLSCR_CAPTION") props.BackColor = IntToColor(row.Item("CTRLSCR_BACK_COLOR")) Case "Picturebox" props = New PictureBoxProperties() Case "RadioButton" props = New RadioButtonProperties() props.Caption = row.Item("CTRLSCR_CAPTION") props.DefaultValue = ClassControlValuesConverter.ToBooleanOrDefault(row.Item("CONTROL_DEF_VALUE")) 'If Not IsDBNull(row.Item("CONTROL_DEF_VALUE")) Then ' props.DefaultValue = row.Item("CONTROL_DEF_VALUE") 'Else ' props.DefaultValue = False 'End If Case "F_AddAppointment" props = New FunctionAddAppointment() Case "F_AddFormData" props = New FunctionAddFormData() Case "CheckedListBox" props = New ComboBoxProperties() If Not IsDBNull(row.Item("CONTROL_STATIC_LIST")) Then props.StaticList = row.Item("CONTROL_STATIC_LIST") Else props.StaticList = "" End If Case "ListBox" props = New ComboBoxProperties() If Not IsDBNull(row.Item("CONTROL_STATIC_LIST")) Then props.StaticList = row.Item("CONTROL_STATIC_LIST") Else props.StaticList = "" End If Case Else MsgBox("Unknown control type " & type, MsgBoxStyle.Exclamation, "Error in LoadControlProperties:") End Select ' Generic Properties props.ID = row.Item("CONTROL_ID") props.Name = row.Item("CONTROL_NAME") props.Size = New Size(row.Item("CTRLSCR_WIDTH"), row.Item("CTRLSCR_HEIGHT")) 'TODO: calc location 'If row.Item("CONTROL_PARENT_ID") <> 0 Then ' Dim parentSQL = "SELECT CTRLSCR_X_LOC, CTRLSCR_Y_LOC FROM VWPMO_VALUES WHERE = CONTROL_ID = " & row.Item("CONTROL_PARENT_ID") 'End If props.Location = New Point(row.Item("CTRLSCR_X_LOC"), row.Item("CTRLSCR_Y_LOC")) Me.Text = "Eigenschaften Control-ID: " & props.ID If type = "F_AddAppointment" Then Dim ControlId = GetControlID_for_Name(ctrl.Name, CURRENT_FORM_ID) Dim dr = ClassFunctionCommands.LoadFunction(ControlId) Dim FromDateId, ToDateId, SubjectString, Subject2String, PlaceString, DescString FromDateId = dr.Item("INTEGER1") ToDateId = dr.Item("INTEGER2") SubjectString = dr.Item("STRING1") Subject2String = dr.Item("STRING2") PlaceString = dr.Item("STRING3") DescString = dr.Item("STRING4") If IsDBNull(FromDateId) OrElse FromDateId = 0 Then props.FromDate = "" Else props.FromDate = GetName_for_ControlID(FromDateId, CURRENT_FORM_ID) End If If IsDBNull(ToDateId) OrElse ToDateId = 0 Then props.ToDate = "" Else props.ToDate = GetName_for_ControlID(ToDateId, CURRENT_FORM_ID) End If If IsDBNull(SubjectString) OrElse String.IsNullOrEmpty(SubjectString) Then props.Subject = "" Else props.Subject = SubjectString End If If IsDBNull(Subject2String) OrElse String.IsNullOrEmpty(Subject2String) Then props.Subject2 = "" Else props.Subject2 = Subject2String End If If IsDBNull(PlaceString) OrElse String.IsNullOrEmpty(PlaceString) Then props.Place = "" Else props.Place = PlaceString End If If IsDBNull(DescString) OrElse String.IsNullOrEmpty(DescString) Then props.Description = "" Else props.Description = DescString End If props.Caption = row.Item("CTRLSCR_CAPTION") ElseIf type = "F_AddFormData" Then ' TODO Dim ControlId = GetControlID_for_Name(ctrl.Name, CURRENT_FORM_ID) Dim dr = ClassFunctionCommands.LoadFunction(ControlId) Dim FormId, ScreenId FormId = dr.Item("INTEGER1") ScreenId = dr.Item("INTEGER2") If IsDBNull(FormId) OrElse FormId = 0 Then props.FormID = 0 Else props.FormID = FormId End If If IsDBNull(ScreenId) OrElse ScreenId = 0 Then props.ScreenID = 0 Else props.ScreenID = ScreenId End If props.Caption = row.Item("CTRLSCR_CAPTION") End If ' Control Properties If Not type.Contains("F_") Then ' PreSave and Convert Properties fontcolor = IntToColor(row.Item("CTRLSCR_FONT_COLOR")) fontfamily = row.Item("CTRLSCR_FONT_FAMILY") fontstyle = CType(row.Item("CTRLSCR_FONT_STYLE"), FontStyle) fontsize = CType(row.Item("CTRLSCR_FONT_SIZE"), Single) isreadonly = row.Item("CONTROL_READ_ONLY") isrequired = row.Item("CONTROL_REQUIRED") columntitle = row.Item("CONTROL_COL_NAME") ' Assign Properties to Class props.FontColor = fontcolor props.Font = New Font(fontfamily, fontsize, fontstyle) props.ColumnTitle = columntitle 'ReadOnly If type = "Textbox" Or type = "Datepicker" Or type = "Combobox" Or type = "Picturebox" Or type = "RadioButton" Or type = "Checkbox" Or type = "CheckedListBox" _ Or type = "ListBox" Then props.IsReadOnly = row.Item("CONTROL_READ_ONLY") End If ' Nicht verfügbar für label If type = "Textbox" Or type = "Combobox" Or type = "Datepicker" Or type = "Checkbox" Or type = "RadioButton" Or type = "CheckedListBox" _ Or type = "ListBox" Then props.TabStop = row.Item("CTRLSCR_TAB_STOP") props.TabIndex = row.Item("CTRLSCR_TAB_INDEX") If Not IsDBNull(row.Item("CONTROL_SHOW_COLUMN")) Then props.ShowColumn = row.Item("CONTROL_SHOW_COLUMN") Else props.ShowColumn = True End If End If If type = "Textbox" Then props.Multiline = row.Item("CONTROL_MULTILINE") End If If type = "Combobox" Or type = "CheckedListBox" Or type = "ListBox" Or type = "Textbox" Then If row.Item("CONTROL_SQLCOMMAND_1").ToString.Length > 1 Then Dim value As New SQLValue(row.Item("CONTROL_SQLCOMMAND_1").ToString) props.SQLCommand = value 'props.SQLCommand = row.Item("CONTROL_SQLCOMMAND_1").ToString End If 'props.ParentFormID = row.Item("PARENT_FORM_ID") props.IsRequired = isrequired props.IsReadOnly = isreadonly End If If type = "Label" Then If row.Item("CONTROL_SQLCOMMAND_1").ToString.Length > 1 Then Dim value As New SQLValue(row.Item("CONTROL_SQLCOMMAND_1").ToString) props.SQLCommand = value 'props.SQLCommand = row.Item("CONTROL_SQLCOMMAND_1").ToString End If End If End If ' Globale Variable setzen CURRENT_CONTROL_ID = row.Item("CONTROL_ID") Me.pgControlProperties.SelectedObject = props End If End If Catch ex As Exception MsgBox("Error in loadcontrolproperties" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub ' Aktualisiert die Position des akutellen Controls und speichert diese in der Klasse Public Sub UpdateControlLocation(ctrl As Control) CurrentProperties = Me.pgControlProperties.SelectedObject If CurrentProperties IsNot Nothing Then CurrentProperties.Location = ctrl.Location Me.pgControlProperties.SelectedObject = CurrentProperties End If End Sub Public Function SaveControlProperties(ctrl As Control, properties As Object) As Boolean If ClassControlCommands.UpdateControl(ctrl, properties) Then LoadControlProperties(ctrl) Return True Else MsgBox("Fehler beim Speichern der Elementeigenschaften.", MsgBoxStyle.Critical) Return False End If End Function Private Sub btnSaveControl_Click(sender As Object, e As EventArgs) Handles btnSaveControl.Click If SaveControlProperties(CtrlBuilder.CurrentControl, pgControlProperties.SelectedObject) Then lblStatus.Text = "Änderungen gespeichert - " & Now lblStatus.Visible = True Else lblStatus.Visible = False ' MsgBox("Änderungen gespeichert!", MsgBoxStyle.Information) End If End Sub Private Sub pgControlProperties_PropertyValueChanged(s As Object, e As PropertyValueChangedEventArgs) Handles pgControlProperties.PropertyValueChanged Dim oldValue As Object = e.OldValue Dim newValue As Object = e.ChangedItem.Value Dim currentProperty As String = e.ChangedItem.Label Dim ctrl As Control = CtrlBuilder.CurrentControl Select Case currentProperty Case "Location" ctrl.Location = newValue Case "X" ctrl.Location = New Point(newValue, ctrl.Location.Y) Case "Y" ctrl.Location = New Point(ctrl.Location.X, newValue) Case "Size" ctrl.Size = newValue Case "Width" ctrl.Size = New Size(newValue, ctrl.Size.Height) Case "Height" ctrl.Size = New Size(ctrl.Size.Width, newValue) Case "Name" ctrl.Name = newValue Case "Caption" ctrl.Text = newValue Case "Font" ctrl.Font = newValue Case "FontColor" ctrl.ForeColor = newValue Case "BackColor" ctrl.BackColor = newValue End Select lblStatus.Text = "Ausstehende Änderungen" lblStatus.Visible = True End Sub Private Sub ToolStripButton1_Click(sender As Object, e As EventArgs) Handles ToolStripButton1.Click If MsgBox("Wollen Sie das Element wirklich löschen?", MsgBoxStyle.YesNo) = MsgBoxResult.Yes Then If IsGroupBox(CtrlBuilder.CurrentControl) Then Dim parentID As Integer = GetControlID_for_Name(CtrlBuilder.CurrentControl.Name, CURRENT_FORM_ID) Dim SQL = "SELECT GUID FROM TBPMO_CONTROL WHERE PARENT_CONTROL_ID = " & parentID Dim dt As DataTable = ClassDatabase.Return_Datatable(SQL) For Each dr As DataRow In dt.Rows Dim id As Integer = dr.Item(0) ClassControlCommands.DeleteControl(id) Next End If If ClassControlCommands.DeleteControl() = True Then MsgBox("Element gelöscht, Elemente werden neu geladen.", MsgBoxStyle.Information) CtrlBuilder.ClearControls() frmLevel_Designer.Instance.LoadControls() End If End If End Sub Private Sub frmTool_ControlProperties_Shown(sender As Object, e As EventArgs) Handles Me.Shown If Me.WindowState = FormWindowState.Maximized Then Me.WindowState = FormWindowState.Normal End If End Sub End Class