2677 lines
117 KiB
VB.net

Imports System.Windows.Forms
Imports System.Text.RegularExpressions
Imports DevExpress.XtraGrid
Imports DevExpress.XtraGrid.Views.Grid
Public Class ClassControlBuilder
Private _master_panel As Panel
Private _current_control As Control
Private _begin_location As Point
Private _end_location As Point
Private _mouse_down_handler As MouseEventHandler
Private _mouse_up_handler As MouseEventHandler
Private _mouse_move_handler As MouseEventHandler
Private _mouse_click_handler As EventHandler
Private _group_box_drag_drop_handler As DragEventHandler
Private _tool_tip_handler As EventHandler
Private _onRecordChangedName As String = "OnRecordChanged"
Private _onMouseHoverName As String = "OnMouseHover"
Private _events As System.ComponentModel.EventHandlerList = Nothing
Public IsInsert As Boolean
Public IsEdit As Boolean
Public IsCancelCheck As Boolean = False
' +++ Constructor +++
Public Sub New(MasterPanel As Panel,
MouseDownHandler As MouseEventHandler,
MouseUpHandler As MouseEventHandler,
MouseMoveHandler As MouseEventHandler,
MouseClickHandler As EventHandler,
GroupBoxDragDropHandler As DragEventHandler)
Me._master_panel = MasterPanel
Me._mouse_down_handler = MouseDownHandler
Me._mouse_up_handler = MouseUpHandler
Me._mouse_move_handler = MouseMoveHandler
Me._mouse_click_handler = MouseClickHandler
Me._group_box_drag_drop_handler = GroupBoxDragDropHandler
End Sub
Public Sub New(MasterPanel As Panel)
Me._master_panel = MasterPanel
End Sub
Protected ReadOnly Property Events() As System.ComponentModel.EventHandlerList
Get
If _events Is Nothing Then
_events = New System.ComponentModel.EventHandlerList
End If
Return _events
End Get
End Property
' +++ RecordChanged Event +++
Public WatchRecordChanges As Boolean = True
Public Custom Event OnRecordChanged As EventHandler
AddHandler(value As EventHandler)
Me.Events.AddHandler(_onRecordChangedName, value)
End AddHandler
RemoveHandler(value As EventHandler)
Me.Events.RemoveHandler(_onRecordChangedName, value)
End RemoveHandler
RaiseEvent(sender As Object, e As EventArgs)
CType(Me.Events(_onRecordChangedName), EventHandler).Invoke(sender, e)
End RaiseEvent
End Event
Public Custom Event OnMouseHover As EventHandler
AddHandler(value As EventHandler)
Me.Events.AddHandler(_onMouseHoverName, value)
End AddHandler
RemoveHandler(value As EventHandler)
Me.Events.RemoveHandler(_onMouseHoverName, value)
End RemoveHandler
RaiseEvent(sender As Object, e As EventArgs)
CType(Me.Events(_onMouseHoverName), EventHandler).Invoke(sender, e)
End RaiseEvent
End Event
' ==================================================================================
' Handler für alle Controls
' ==================================================================================
Public ControlsChanged As New List(Of Integer)
Public Sub RecordChanged(sender As Object, ByVal e As EventArgs)
Dim onRecordChangedHandler As EventHandler = CType(Me.Events(_onRecordChangedName), EventHandler)
Dim ctrl As Control = DirectCast(sender, Control)
Dim controlId As Integer = DirectCast(ctrl.Tag, ClassControlMetadata).Id
If Not ControlsChanged.Contains(controlId) Then
ControlsChanged.Add(controlId)
End If
If (onRecordChangedHandler IsNot Nothing And WatchRecordChanges) Then
onRecordChangedHandler.Invoke(sender, e)
End If
End Sub
' CheckedListBox hat andere Handler Signatur
Public Sub RecordChanged(sender As Object, ByVal e As DevExpress.XtraEditors.Controls.ItemCheckEventArgs)
Dim onRecordChangedHandler As EventHandler = CType(Me.Events(_onRecordChangedName), EventHandler)
Dim ctrl As Control = DirectCast(sender, Control)
Dim controlId As Integer = DirectCast(ctrl.Tag, ClassControlMetadata).Id
If Not ControlsChanged.Contains(controlId) Then
ControlsChanged.Add(controlId)
End If
If (onRecordChangedHandler IsNot Nothing And WatchRecordChanges) Then
onRecordChangedHandler.Invoke(sender, e)
End If
End Sub
' GridControl hat andere Handler Signatur
Public Sub RecordChanged(sender As Object, ByVal e As DevExpress.XtraGrid.Views.Base.CellValueChangedEventArgs)
Dim onRecordChangedHandler As EventHandler = CType(Me.Events(_onRecordChangedName), EventHandler)
Dim ctrl As DevExpress.XtraGrid.Views.Grid.GridView = sender
' Dim ctrl As Control = sender 'DirectCast(sender, Control)
Dim controlId As Integer = DirectCast(ctrl.GridControl.Tag, ClassControlMetadata).Id
If Not ControlsChanged.Contains(controlId) Then
ControlsChanged.Add(controlId)
End If
If (onRecordChangedHandler IsNot Nothing And WatchRecordChanges) Then
onRecordChangedHandler.Invoke(sender, e)
End If
End Sub
Public Sub RecordChanged(sender As Object, e As DevExpress.Data.SelectionChangedEventArgs)
Dim onRecordChangedHandler As EventHandler = CType(Me.Events(_onRecordChangedName), EventHandler)
Dim ctrl As DevExpress.XtraGrid.Views.Grid.GridView = sender
Dim controlId As Integer = DirectCast(ctrl.GridControl.Tag, ClassControlMetadata).Id
If Not ControlsChanged.Contains(controlId) Then
ControlsChanged.Add(controlId)
End If
If (onRecordChangedHandler IsNot Nothing And WatchRecordChanges) Then
onRecordChangedHandler.Invoke(sender, e)
End If
End Sub
Public Sub MouseHover(sender As Object, e As EventArgs)
Dim onMouseHoverHandler As EventHandler = CType(Me.Events(_onMouseHoverName), EventHandler)
If onMouseHoverHandler IsNot Nothing Then
onMouseHoverHandler.Invoke(sender, e)
End If
End Sub
Private Sub OnEnabledChanged(sender As Object, e As EventArgs)
Dim control As Control = DirectCast(sender, Control)
' FIXME: Hier wird die konfigurierte Farbe überschrrieben, brauchen wird das? o.O
' Checkbox, radiobutton, label ist sonderfall
'If control.GetType() = GetType(CheckBox) Or _
' control.GetType() = GetType(RadioButton) Or _
' control.GetType() = GetType(Label) Then
' ' Hier wird nur die vordergrund-farbe geändert
' control.ForeColor = Color.Black
' Exit Sub
'End If
'If control.Enabled Then
' control.BackColor = Color.White
' control.ForeColor = Color.Black
'ElseIf control.Enabled = False Then
' control.BackColor = System.Drawing.SystemColors.Info
' control.ForeColor = Color.Black 'System.Drawing.SystemColors.InfoText
'End If
End Sub
' Wie OnEnabledChanged, nur für TextBVi
Private Sub OnReadOnlyChanged(sender As Object, e As EventArgs)
Dim control As TextBox = DirectCast(sender, TextBox)
If control.ReadOnly = False Then
control.BackColor = Color.White
control.ForeColor = Color.Black
ElseIf control.ReadOnly = True Then
control.BackColor = SystemColors.Info
control.ForeColor = Color.Black 'System.Drawing.SystemColors.InfoText
End If
End Sub
Public Sub OnTextBoxFocus(sender As Object, ByVal e As EventArgs)
Dim box As TextBox = sender
box.BackColor = Color.LemonChiffon
box.SelectAll()
If CURRENT_RECORD_ENABLED = False Then Exit Sub
CURRENT_TEXTBOX_SELECTED_TEXT = DirectCast(sender, TextBox).Text
End Sub
Public Sub OnTextBoxLostFocus(sender As Object, ByVal e As EventArgs)
Dim box As TextBox = sender
box.BackColor = Color.White
If CURRENT_RECORD_ENABLED = False Then Exit Sub
CURRENT_RECORD_ENABLED = False
Try
Dim control As Control = DirectCast(sender, Control)
Dim textbox As TextBox = DirectCast(control, TextBox)
Dim controlId As Integer = DirectCast(control.Tag, ClassControlMetadata).Id
CONTROL_ID = controlId
If IsEdit Then
Dim expression As String
expression = "ENTITY_ID = " & CURRENT_ENTITY_ID
Dim foundControls() As DataRow
' Use the Select method to find all rows matching the filter.
foundControls = CURRENT_DT_TBPMO_ENTITY_RIGHT_CONTROLS.Select(expression)
Dim i As Integer
' Check if control is one of rightcontrols
For i = 0 To foundControls.GetUpperBound(0)
If foundControls(i)("CONTROL_ID") = CONTROL_ID Then
RIGHT_CONTROL_CHANGED = True
Dim msg = MSG_RIGHTMODULE_DE
If USER_LANGUAGE <> "de-DE" Then
msg = MSG_RIGHTMODULE_EN_US
End If
Dim result As MsgBoxResult
result = MessageBox.Show(msg, "Confirmation needed:", MessageBoxButtons.YesNo, MessageBoxIcon.Question)
If result = MsgBoxResult.No Then
Me.ControlsChanged.Remove(controlId)
' Y U NO WORK??
Dim text = CURRENT_TEXTBOX_SELECTED_TEXT
textbox.Text = text
CURRENT_RECORD_ENABLED = True
Exit Sub
End If
End If
Next
End If
Catch ex As Exception
If ex.Message.Contains("Objektverweis") Or ex.Message.Contains("reference not set") Then
Else
MsgBox("Error in OnTextBoxLostFocus - " & CONTROL_ID.ToString & ": " & ex.Message, MsgBoxStyle.Critical)
End If
Finally
CURRENT_RECORD_ENABLED = True
End Try
End Sub
Public Sub OnComboBoxFocus(sender As Object, ByVal e As EventArgs)
Try
Dim combo As CustomComboBox = sender
combo.BackColor = Color.LemonChiffon
Catch ex As Exception
LOGGER.Warn("Unexpected error in OnComboBoxFocus: " & ex.Message)
End Try
End Sub
Public Sub OnComboBoxLostFocus(sender As Object, ByVal e As EventArgs)
Try
Dim combo As CustomComboBox = sender
combo.BackColor = Color.White
Catch ex As Exception
LOGGER.Warn("Unexpected error in OnComboBoxLostFocus: " & ex.Message)
End Try
End Sub
Dim CONTROL_ID
Public Sub Enable_Controls(control As Control, TableResult As DataTable, value As Object)
Try
If TableResult.Rows.Count = 0 Then
Exit Sub
End If
If CURRENT_RECORD_ID = 0 Then
Exit Sub
End If
For Each row As DataRow In TableResult.Rows
Dim sqlcommand As String = row.Item("SQL_COMMAND_2")
Dim msg = String.Format("Working on enabling control {0} - SQL: {1}", CONTROL_ID.ToString, sqlcommand)
LOGGER.Debug(msg, False)
If IsNothing(sqlcommand) Then
Continue For
End If
' Versuchen, die RecordId zu ersetzen, falls eine existiert
sqlcommand = sqlcommand.ToUpper.Replace("@RECORD_ID", CURRENT_RECORD_ID)
msg = String.Format("sqlcommand-replaced1: {0}", sqlcommand)
LOGGER.Debug(msg, False)
' ControlId Platzhalter suchen und ersetzen
Dim regex As New System.Text.RegularExpressions.Regex("(@(\d+)@)")
Dim match As System.Text.RegularExpressions.Match = regex.Match(sqlcommand)
If match.Success Then
' DependingControlId bezeichnet das Control, das die Abhängigkeit enthält
Dim dependingControlId As Integer = row.Item("GUID")
'Dim panel As Panel = DirectCast(control.Parent, Panel)
Dim panel As Panel = Me.MasterPanel
' Über die Id das Control finden
Dim dependingControl As Control = panel.Controls.OfType(Of Control)().Where(Function(c As Control)
Return DirectCast(c.Tag, ClassControlMetadata).Id = dependingControlId
End Function).SingleOrDefault()
' Wir ersetzen den platzhalter im sql command mit dem übergebenen wert
sqlcommand = sqlcommand.Replace(match.Groups(1).Value, value)
LOGGER.Debug("" & String.Format("Executing SQL_COMMAND: {0} for controlID {1}", sqlcommand, dependingControlId), False)
' Jetzt wird das SQL Command ausgeführt, es MUSS einen Boolschen Wert zurückgeben, True, False, 0, 1
Dim dt_result As DataTable = Nothing
dt_result = ClassDatabase.Return_Datatable(sqlcommand)
If dt_result.Rows.Count = 1 Then
Dim enabled As Boolean = True
Try
enabled = CBool(dt_result.Rows(0).Item(0))
Catch ex As Exception
msg = String.Format("Could not convert value of tablecontent to boolean!! SQL {0} # tablecontent: {1}" & vbNewLine, sqlcommand, dependingControlId)
LOGGER.Warn(msg)
End Try
If enabled = False Then
msg = String.Format("Control {0} will be disabled." & vbNewLine, dependingControlId.ToString)
LOGGER.Debug(msg, False)
Else
msg = String.Format("Control {0} will be enabled." & vbNewLine, dependingControlId.ToString)
LOGGER.Debug(msg, False)
End If
dependingControl.Enabled = enabled
Else
LOGGER.Warn("Attention: RowCount for enabling control (" & dependingControlId.ToString & ") was '" & dt_result.Rows.Count.ToString & "' and not 1 as expected - Check SQL: '" & sqlcommand & "'", False)
End If
End If
Next
Catch ex As Exception
MsgBox("Error in Enable Controls - " & CONTROL_ID.ToString & ": " & ex.Message, MsgBoxStyle.Critical)
End Try
End Sub
Public Sub Depending_Controls(control As Control, TableResult As DataTable, value As String)
Try
If TableResult.Rows.Count = 0 Then
Exit Sub
End If
If CURRENT_RECORD_ID = 0 Or CONTROL_ID = 0 Then
Exit Sub
End If
If IsNothing(value) Then 'Kein Value also abhängige Controls auf "Leer" setzen
Try
For Each row As DataRow In TableResult.Rows
' DependingControlId bezeichnet das Control, das die Abhängigkeit enthält
Dim dependingControlId As Integer = row.Item("GUID")
Dim panel As Panel = DirectCast(control.Parent, Panel)
' Über die Id das Control finden
Dim dependingControl As Control = panel.Controls.OfType(Of Control)().Where(Function(c As Control)
Return DirectCast(c.Tag, ClassControlMetadata).Id = dependingControlId
End Function).SingleOrDefault()
Dim type = dependingControl.GetType().Name
Select Case type
Case "CustomComboBox"
DirectCast(dependingControl, CustomComboBox).DataSource = Nothing
Case "CheckedListBoxControl"
DirectCast(dependingControl, DevExpress.XtraEditors.CheckedListBoxControl).DataSource = Nothing
Case "Label"
DirectCast(dependingControl, Label).Text = ""
Case "TextBox"
DirectCast(dependingControl, TextBox).Text = ""
Case "GridControl"
DirectCast(dependingControl, DevExpress.XtraGrid.GridControl).DataSource = Nothing
End Select
Next
Exit Sub
Catch ex As Exception
MsgBox("Unexpected error in DependingControls (For Each row As DataRow In TableResult.Rows)- " & CONTROL_ID.ToString & ": " & ex.Message, MsgBoxStyle.Critical)
Exit Sub
End Try
End If
LOGGER.Debug("DependingControls - For Each row As DataRow In TableResult.Rows", False, False)
For Each row As DataRow In TableResult.Rows
Dim sqlcommand As String = row.Item("SQL_COMMAND_1")
If IsNothing(sqlcommand) Then
Continue For
End If
sqlcommand = sqlcommand.ToUpper.Replace("@RECORD_ID", CURRENT_RECORD_ID)
Dim regex As New System.Text.RegularExpressions.Regex("(@(\d+)@)")
Dim match As System.Text.RegularExpressions.Match = regex.Match(sqlcommand)
If match.Success Then
Dim sqlguid = String.Format("SELECT GUID FROM TBPMO_CONTROL_VALUE WHERE CONTROL_ID = {0} AND RECORD_ID = {1}", CONTROL_ID, CURRENT_RECORD_ID)
Dim ctrlvalID = ClassDatabase.Execute_Scalar(sqlguid, True)
' Diese Abfrage verhindert, dass Werte, die aus z.B. CheckedListBoxen kommen,
' nicht überschrieben werden. Diese Werte werden bereits mit UpdateMultipleValues gespeichert
If (Not value.Contains(";")) Then
If Not IsNothing(ctrlvalID) Then
If ClassControlCommandsUI.UpdateControlValue(CONTROL_ID, CURRENT_RECORD_ID, value.ToString, CURRENT_ENTITY_ID) = False Then
LOGGER.Warn(String.Format("ClassControlCommandsUI.UpdateControlValue (1) was not successfull - ControlID: {0},RecordID: {1},value: {2}'", CONTROL_ID, CURRENT_RECORD_ID, value), False)
Else
ControlsChanged.Remove(CONTROL_ID)
End If
Else
LOGGER.Debug("ctrlvalID is Nothing - Attention.....", False, False)
If CURRENT_RECORD_ID <> 0 Then
If ClassControlCommandsUI.CreateControlProcedure(CONTROL_ID, CURRENT_RECORD_ID, value, CURRENT_ENTITY_ID) = 0 Then
LOGGER.Warn(String.Format("ClassControlCommandsUI.CreateControlProcedure (1) was not successfull - ControlID: {0},RecordID: {1},value: {2}'", CONTROL_ID, CURRENT_RECORD_ID, value), False)
Else
ControlsChanged.Remove(CONTROL_ID)
End If
End If
End If
End If
' DependingControlId bezeichnet das Control, das die Abhängigkeit enthält
Dim dependingControlId As Integer = row.Item("GUID")
If dependingControlId > 0 Then
LOGGER.Debug("dependingControlId: " + dependingControlId.ToString, False, False)
End If
Dim panel As Panel = Me.MasterPanel
'Dim panel As Panel = DirectCast(control.Parent, Panel)
' Über die Id das Control finden
Dim dependingControl As Control = panel.Controls.OfType(Of Control)().Where(Function(c As Control)
Return DirectCast(c.Tag, ClassControlMetadata).Id = dependingControlId
End Function).SingleOrDefault()
If IsNothing(dependingControl) Then
LOGGER.Warn("dependingControl is Nothing - Attention.....")
Continue For
End If
sqlcommand = sqlcommand.Replace(match.Groups(1).Value, value)
LOGGER.Debug("" & String.Format("Executing SQL_COMMAND: '{0}' for controlID '{1}'", sqlcommand, dependingControlId), False)
Dim dt As DataTable = ClassDatabase.Return_Datatable(sqlcommand, True)
Dim type = dependingControl.GetType().Name
Select Case type
Case "DateEdit"
If dt.Rows.Count = 1 Then
Try
Dim val = dt.Rows(0).Item(0)
Dim dateValue
Try
dateValue = CStr(CDate(val)) 'Format(val, "dd-MM-yyyy"))
Catch ex As Exception
If val <> "" Then
LOGGER.Warn("Unexpected Error in converting Value '" & value & "' to date - Control-ID: " & dependingControlId.ToString & "- Error: " & ex.Message)
End If
Continue For
End Try
ControlLoader.DateTimePicker.LoadValue(dependingControl, dateValue)
Dim sql1 = String.Format("SELECT GUID FROM TBPMO_CONTROL_VALUE WHERE CONTROL_ID = {0} AND RECORD_ID = {1}", dependingControlId, CURRENT_RECORD_ID)
Dim id = ClassDatabase.Execute_Scalar(sql1, True)
If Not IsNothing(id) Then
'Dim upd = String.Format("UPDATE TBPMO_CONTROL_VALUE SET VALUE = '{0}', CHANGED_WHO = '{1}' WHERE GUID = {2}", dateValue, USER_USERNAME, id)
If ClassControlCommandsUI.UpdateControlValue(dependingControlId, CURRENT_RECORD_ID, dateValue, CURRENT_ENTITY_ID) = True Then
ControlsChanged.Remove(dependingControlId)
LOGGER.Debug("Value was not nothing - Updated the ControlValue'", False) '" & upd)
Else
LOGGER.Warn("Check Update depending control (DateEdit) value as it was nothing and Update was not successful - Update-Command '", False) ' & upd & "'")
End If
Else
If ClassControlCommandsUI.CreateControlProcedure(dependingControlId, CURRENT_RECORD_ID, dateValue, CURRENT_ENTITY_ID) = 1 Then
ControlsChanged.Remove(dependingControlId)
LOGGER.Debug("Value was nothing - Inserted the ControlValue (DateEdit)!", False)
Else
LOGGER.Warn(String.Format("ClassControlCommandsUI.InsertControlValue (DateEdit) was not successfull - ControlID: {0},RecordID: {1},value: {2}'", CONTROL_ID, CURRENT_RECORD_ID, dateValue), False)
End If
End If
Catch ex As Exception
LOGGER.Warn("Unexpected Error in OnComboBoxValueChanged - TextBox: " & ex.Message)
End Try
Else
LOGGER.Warn("Attention: RowCount for depending control was '" & dt.Rows.Count.ToString & "' and not 1 as expected - Check SQL: '" & sqlcommand & "'")
End If
Case "CustomComboBox"
ControlLoader.Combobox.SetDataSource(DirectCast(dependingControl, CustomComboBox), dt)
Case "CheckedListBoxControl"
LOGGER.Debug("DependingControls - CheckedListBoxControl", False, False)
Dim checkedlistbox = DirectCast(dependingControl, DevExpress.XtraEditors.CheckedListBoxControl)
If IsNothing(checkedlistbox) Then
LOGGER.Debug("checkedlistbox is Nothing - Attention.....", False, False)
End If
ControlLoader.CheckedListBox.SetDataSource(checkedlistbox, dt)
' Hier werden nun evtl schon gesetzte Werte für CheckedListBox angehakt
' Wert per LINQ aus DT_ControlValues suchen der zur aktuellen controlId passt
Dim values As List(Of Object) = (From row1 In CURRENT_CONTROL_VALUES.AsEnumerable()
Where row1.Item("CONTROL_ID") = dependingControlId
Select row1.Item("VALUE")).ToList()
ControlLoader.CheckedListBox.LoadValue(checkedlistbox, values)
If IsEdit Or IsInsert Then
CURRENT_RECORD_ENABLED = True
End If
Case "Label"
If dt.Rows.Count = 1 Then
Try
ControlLoader.Label.LoadValue(DirectCast(dependingControl, Label), 9999, 9999, dt.Rows(0).Item(0).ToString, True)
Catch ex As Exception
LOGGER.Warn("Unexpectet Error in OnComboBoxValueChanged - Label: " & ex.Message)
End Try
End If
Case "TextBox"
If dt.Rows.Count = 1 Then
Try
Dim value1 As String = dt.Rows(0).Item(0)
ControlLoader.TextBox.LoadValue(DirectCast(dependingControl, TextBox), 9999, 9999, value1, 999, True)
Dim sqltextbox = String.Format("SELECT GUID FROM TBPMO_CONTROL_VALUE WHERE CONTROL_ID = {0} AND RECORD_ID = {1}", dependingControlId, CURRENT_RECORD_ID)
Dim id = ClassDatabase.Execute_Scalar(sqltextbox, True)
If Not IsNothing(id) Then
If ClassControlCommandsUI.UpdateControlValue(dependingControlId, CURRENT_RECORD_ID, value1, CURRENT_ENTITY_ID) = True Then
LOGGER.Debug("Value was not nothing - Updated the ControlValue'", False) '" & upd)
ControlsChanged.Remove(dependingControlId)
Else
LOGGER.Warn(String.Format("ClassControlCommandsUI.UpdateControlValue (TextBox) was not successfull - ControlID: {0},RecordID: {1},value: {2}'", CONTROL_ID, CURRENT_RECORD_ID, value1), False)
End If
'Dim upd = String.Format("UPDATE TBPMO_CONTROL_VALUE SET VALUE = '{0}', CHANGED_WHO = '{1}' WHERE GUID = {2}", value1, USER_USERNAME, id)
'If ClassDatabase.Execute_non_Query(upd) = True Then
' LOGGER.Debug("Value was not nothing - Updated the ControlValue '" & upd)
'Else
' Logger.Warn("Check Update depending control value as it was nothing and Update was not successful - Update-Command '" & upd & "'")
'End If
Else
If ClassControlCommandsUI.CreateControlProcedure(dependingControlId, CURRENT_RECORD_ID, value1, CURRENT_ENTITY_ID) = 1 Then
ControlsChanged.Remove(dependingControlId)
LOGGER.Debug("Value was nothing - Inserted the ControlValue (TextBox)!", False)
Else
LOGGER.Warn(String.Format("ClassControlCommandsUI.InsertControlValue (TextBox) was not successfull - ControlID: {0},RecordID: {1},value: {2}'", CONTROL_ID, CURRENT_RECORD_ID, value1), False)
End If
End If
Catch ex As Exception
LOGGER.Warn("Unexpected Error in OnComboBoxValueChanged - TextBox: " & ex.Message)
End Try
Else
LOGGER.Warn("Attention: RowCount for depending control was '" & dt.Rows.Count.ToString & "' and not 1 as expected - Check SQL: '" & sqlcommand & "'")
End If
Case "GridControl"
Dim gridControl = DirectCast(dependingControl, DevExpress.XtraGrid.GridControl)
ControlLoader.DataGridViewCheckable.SetDataSource(gridControl, dt)
Dim values As List(Of Object) = (From row1 In CURRENT_CONTROL_VALUES.AsEnumerable()
Where row1.Item("CONTROL_ID") = dependingControlId
Select row1.Item("VALUE")).ToList()
ControlLoader.DataGridViewCheckable.LoadValue(gridControl, values)
End Select
End If
Next
Catch ex As Exception
MsgBox("Unexpected error in DependingControls - " & CONTROL_ID.ToString & ": " & ex.Message, MsgBoxStyle.Critical)
End Try
End Sub
Public Sub OnDateTimeValueChanged(sender As Object, ByVal e As EventArgs)
If CURRENT_RECORD_ENABLED = False Then Exit Sub
Try
Dim control As Control = DirectCast(sender, Control)
Dim controlId As Integer = DirectCast(control.Tag, ClassControlMetadata).Id
CONTROL_ID = controlId
'SQL für abhängige Auswahllisten
Dim SQL As String = String.Format("SELECT GUID, SQL_COMMAND_1,CONTROL_TYPE_ID,FORMAT_TYPE FROM TBPMO_CONTROL WHERE SQL_COMMAND_1 LIKE '%@{0}@%'", controlId)
Dim value
'SQL für enable control
Dim SQLenable As String = String.Format("SELECT GUID, SQL_COMMAND_2,CONTROL_TYPE_ID,FORMAT_TYPE FROM TBPMO_CONTROL WHERE SQL_COMMAND_2 LIKE '%@{0}@%'", controlId)
value = DirectCast(control, DevExpress.XtraEditors.DateEdit).DateTime
If String.IsNullOrEmpty(value) Then
Exit Sub
End If
If CURRENT_RECORD_ID = 0 And IsInsert = True Then
Exit Sub
End If
Dim datatable As DataTable = ClassDatabase.Return_Datatable(SQL)
Dim datatable1 As DataTable = ClassDatabase.Return_Datatable(SQLenable)
Depending_Controls(control, datatable, value)
Enable_Controls(control, datatable1, value)
Console.WriteLine("value changed")
Catch ex As Exception
If ex.Message.Contains("Objektverweis") Or ex.Message.Contains("reference not set") Then
Else
MsgBox("Error in OnComboBoxValueChanged - " & CONTROL_ID.ToString & ": " & ex.Message, MsgBoxStyle.Critical)
End If
End Try
End Sub
Public Sub OnComboBoxFocused(sender As Object, ByVal e As EventArgs)
If CURRENT_RECORD_ENABLED = False Then Exit Sub
Try
Dim control As Control = DirectCast(sender, Control)
Dim controlId As Integer = DirectCast(control.Tag, ClassControlMetadata).Id
CURRENT_COMBOBOX_SELECTED_INDEX = DirectCast(control, CustomComboBox).SelectedIndex
CURRENT_COMBOBOX_SELECTED_TEXT = DirectCast(control, CustomComboBox).Text
Catch ex As Exception
MsgBox("Error in OnComboBoxFocused - " & CONTROL_ID.ToString & ": " & ex.Message, MsgBoxStyle.Critical)
End Try
End Sub
Public Sub OnComboBoxValueChanged(sender As Object, ByVal e As EventArgs)
If CURRENT_RECORD_ENABLED = False Then Exit Sub
' Verhindert, dass OnComboBoxFocues unkontrolliert feuert!
CURRENT_RECORD_ENABLED = False
Try
Dim control As Control = DirectCast(sender, Control)
Dim combo As CustomComboBox = DirectCast(control, CustomComboBox)
Dim controlId As Integer = DirectCast(control.Tag, ClassControlMetadata).Id
CONTROL_ID = controlId
If IsEdit Then
Dim expression As String
expression = "ENTITY_ID = " & CURRENT_ENTITY_ID
Dim foundControls() As DataRow
' Use the Select method to find all rows matching the filter.
foundControls = CURRENT_DT_TBPMO_ENTITY_RIGHT_CONTROLS.Select(expression)
Dim i As Integer
' Check if control is one of rightcontrols
For i = 0 To foundControls.GetUpperBound(0)
If foundControls(i)("CONTROL_ID") = CONTROL_ID Then
RIGHT_CONTROL_CHANGED = True
Dim msg = MSG_RIGHTMODULE_DE
If USER_LANGUAGE <> "de-DE" Then
msg = MSG_RIGHTMODULE_EN_US
End If
Dim result As MsgBoxResult
result = MessageBox.Show(msg, "Confirmation needed:", MessageBoxButtons.YesNo, MessageBoxIcon.Question)
If result = MsgBoxResult.No Then
Me.ControlsChanged.Remove(controlId)
' Y U NO WORK??
Dim text = CURRENT_COMBOBOX_SELECTED_TEXT
combo.SelectedIndex = -1
combo.SelectedText = text
combo.Text = text
CURRENT_RECORD_ENABLED = True
Exit Sub
End If
End If
Next
End If
Dim onRecordChangedHandler As EventHandler = CType(Me.Events(_onRecordChangedName), EventHandler)
If Not ControlsChanged.Contains(controlId) Then
ControlsChanged.Add(controlId)
End If
If (onRecordChangedHandler IsNot Nothing And WatchRecordChanges) Then
onRecordChangedHandler.Invoke(sender, e)
End If
'SQL für abhängige Auswahllisten
Dim SQL As String = String.Format("SELECT GUID, SQL_COMMAND_1, CONTROL_TYPE_ID,FORMAT_TYPE FROM TBPMO_CONTROL WHERE SQL_COMMAND_1 LIKE '%@{0}@%'", controlId)
Dim value
'SQL für enable control
Dim SQLenable As String = String.Format("SELECT GUID, SQL_COMMAND_2, CONTROL_TYPE_ID,FORMAT_TYPE FROM TBPMO_CONTROL WHERE SQL_COMMAND_2 LIKE '%@{0}@%'", controlId)
' Diese Befehle führen dazu, dass auch der ValueMember als Wert ausgelesen wird
' Das kann zu unerwarteten Ergebnissen führen, da der Benutzer nur den DisplayMember sieht.
'Select Case control.GetType()
' Case GetType(CustomComboBox)
' If IsNothing(DirectCast(control, CustomComboBox).ValueMember) Then
' value = DirectCast(control, CustomComboBox).Text
' Else
' value = DirectCast(control, CustomComboBox).SelectedValue
' End If
' Case Else
' Exit Sub
'End Select
' Die bessere Lösung ist für jetzt, einfach den angezeigten Wert auszulesen:
value = DirectCast(control, CustomComboBox).Text
If String.IsNullOrEmpty(value) Then
CURRENT_RECORD_ENABLED = True
Exit Sub
End If
If CURRENT_RECORD_ID = 0 And IsInsert = True Then
CURRENT_RECORD_ENABLED = True
Exit Sub
End If
Dim datatable As DataTable = ClassDatabase.Return_Datatable(SQL)
Dim datatable1 As DataTable = ClassDatabase.Return_Datatable(SQLenable)
Depending_Controls(control, datatable, value)
Enable_Controls(control, datatable1, value)
CURRENT_RECORD_ENABLED = True
Catch ex As Exception
If ex.Message.Contains("Objektverweis") Or ex.Message.Contains("reference not set") Then
Else
MsgBox("Error in OnComboBoxValueChanged - " & CONTROL_ID.ToString & ": " & ex.Message, MsgBoxStyle.Critical)
End If
End Try
End Sub
Public Sub OnCheckedItemChanged(sender As Object, ByVal e As EventArgs)
If CURRENT_RECORD_ENABLED = False Then Exit Sub
Try
Dim control As Control = DirectCast(sender, Control)
Dim controlId As Integer = DirectCast(control.Tag, ClassControlMetadata).Id
CONTROL_ID = controlId
control.Update()
If IsEdit Then
Dim expression As String
expression = "ENTITY_ID = " & CURRENT_ENTITY_ID
Dim foundControls() As DataRow
' Use the Select method to find all rows matching the filter.
foundControls = CURRENT_DT_TBPMO_ENTITY_RIGHT_CONTROLS.Select(expression)
Dim i As Integer
' Check if control is one of rightcontrols
For i = 0 To foundControls.GetUpperBound(0)
If foundControls(i)("CONTROL_ID") = CONTROL_ID Then
RIGHT_CONTROL_CHANGED = True
Dim msg = MSG_RIGHTMODULE_DE
If USER_LANGUAGE <> "de-DE" Then
msg = MSG_RIGHTMODULE_EN_US
End If
Dim result As MsgBoxResult
result = MessageBox.Show(msg, "Confirmation needed:", MessageBoxButtons.YesNo, MessageBoxIcon.Question)
If result = MsgBoxResult.No Then
RIGHT_CONTROL_CHANGED = False
Me.ControlsChanged.Remove(controlId)
Dim loadedValues As List(Of Object) = (From row In CURRENT_CONTROL_VALUES.AsEnumerable()
Where row.Item("CONTROL_ID") = controlId
Select row.Item("VALUE")).ToList()
ClassControlValues.LoadControlValue(CURRENT_RECORD_ID, CURRENT_PARENT_RECORD_ID, CONTROL_ID, control, loadedValues, CURRENT_ENTITY_ID)
RECORD_CHANGED = False
Exit Sub
End If
End If
Next
End If
'SQL für abhängige Auswahllisten
Dim SQL As String = String.Format("SELECT GUID, SQL_COMMAND_1,CONTROL_TYPE_ID,FORMAT_TYPE FROM TBPMO_CONTROL WHERE SQL_COMMAND_1 LIKE '%@{0}@%'", controlId)
'SQL für enable control
Dim SQLenable As String = String.Format("SELECT GUID, SQL_COMMAND_2,CONTROL_TYPE_ID,FORMAT_TYPE FROM TBPMO_CONTROL WHERE SQL_COMMAND_2 LIKE '%@{0}@%'", controlId)
'If CtrlCommandUI.IsInsert = True Then
' CtrlCommandUI.SaveRecord(0, CURRENT_ENTITY_ID, CURRENT_PARENT_ID)
'End If
Dim CONTROL_VALUE As String = ClassControlCommandsUI.GetControlValue(control)
If CURRENT_CONTROL_VALUE_COUNT > 3 Then
End If
If CURRENT_RECORD_ID = 0 Then
Exit Sub
End If
' Da wir beim Klick auf Hinzfügen einen Record anlegen,
' muss UpdateMultipleValues auch aufgerufen werden, wenn wir IsInsert = True ist
'If CtrlCommandUI.IsInsert = False Then
ClassControlCommandsUI.UpdateMultipleValues(controlId, CURRENT_RECORD_ID, CONTROL_VALUE)
'End If
Dim SQL1 As String = String.Format("SELECT * FROM VWPMO_VALUES WHERE RECORD_ID = {0}", CURRENT_RECORD_ID)
Dim DT_ControlValues As DataTable = ClassDatabase.Return_Datatable(SQL1, True)
CURRENT_CONTROL_VALUES = DT_ControlValues
Dim datatable As DataTable = ClassDatabase.Return_Datatable(SQL, True)
Dim datatable1 As DataTable = ClassDatabase.Return_Datatable(SQLenable, True)
Depending_Controls(control, datatable, CONTROL_VALUE)
If IsNothing(CONTROL_VALUE) Then
Exit Sub
End If
Enable_Controls(control, datatable1, CONTROL_VALUE)
Dim values = New List(Of Object)(CONTROL_VALUE.Split(";").ToArray())
'Jetzt noch die checked Items setzen
' ClassControlValues.LoadControlValue(CURRENT_RECORD_ID, CURRENT_PARENT_ID, controlId, control, values, 99)
Catch ex As Exception
If ex.Message.Contains("Objektverweis") Or ex.Message.Contains("reference not set") Then
Else
MsgBox("Error in OnCheckedItemChanged - " & CONTROL_ID.ToString & ": " & ex.Message, MsgBoxStyle.Critical)
End If
End Try
End Sub
Public Sub OnCheckedChanged(sender As Object, ByVal e As DevExpress.Data.SelectionChangedEventArgs)
If CURRENT_RECORD_ENABLED = False Then Exit Sub
If IsCancelCheck = True Then Exit Sub
' Wenn die aktion nicht Add oder Remove ist, wurde auch keine Checkbox angeklickt
' Dann auch nicht updaten
If e.Action = System.ComponentModel.CollectionChangeAction.Refresh Then Exit Sub
Try
Dim GridView As DevExpress.XtraGrid.Views.Grid.GridView = sender
Dim control As Control = DirectCast(GridView.GridControl, Control)
Dim controlId As Integer = DirectCast(GridView.GridControl.Tag, ClassControlMetadata).Id
CONTROL_ID = controlId
control.Update()
'SQL für abhängige Auswahllisten
Dim SQL As String = String.Format("SELECT GUID, SQL_COMMAND_1,CONTROL_TYPE_ID,FORMAT_TYPE FROM TBPMO_CONTROL WHERE SQL_COMMAND_1 LIKE '%@{0}@%'", controlId)
'SQL für enable control
Dim SQLenable As String = String.Format("SELECT GUID, SQL_COMMAND_2,CONTROL_TYPE_ID,FORMAT_TYPE FROM TBPMO_CONTROL WHERE SQL_COMMAND_2 LIKE '%@{0}@%'", controlId)
'If CtrlCommandUI.IsInsert = True Then
' CtrlCommandUI.SaveRecord(0, CURRENT_ENTITY_ID, CURRENT_PARENT_ID)
'End If
Dim CONTROL_VALUE As String = ClassControlCommandsUI.GetControlValue(control)
If CURRENT_RECORD_ID = 0 Then
Exit Sub
End If
If CURRENT_CONTROL_VALUE_COUNT > 3 Then
Dim msgtitle = "Mehr als 3 Werte gewählt:"
If USER_LANGUAGE <> "de-DE" Then
msgtitle = "More than 3 values selected:"
End If
Dim msg = String.Format("Sind Sie sicher dass Sie '{0}' Werte hinterlegen wollen?", CURRENT_CONTROL_VALUE_COUNT)
If USER_LANGUAGE <> "de-DE" Then
msg = String.Format("Do You really want to add '{0}' values?", CURRENT_CONTROL_VALUE_COUNT)
End If
Dim result As MsgBoxResult
result = MessageBox.Show(msg, msgtitle, MessageBoxButtons.YesNo, MessageBoxIcon.Question)
If result = MsgBoxResult.No Then
Dim type = control.GetType().Name
Select Case type
Case "GridControl"
Dim chk_grid As DevExpress.XtraGrid.GridControl
chk_grid = DirectCast(control, DevExpress.XtraGrid.GridControl)
Dim gridview1 As DevExpress.XtraGrid.Views.Grid.GridView = chk_grid.MainView
gridview1.ClearSelection()
IsCancelCheck = True
'For Each index As Integer In GridView.GetSelectedRows()
' gridview1.UnselectRow(index)
' 'Dim fieldName As String = GridView.Columns(0).FieldName
' 'Dim value As String = GridView.GetRowCellValue(index, fieldName)
' 'GridView.
'Next
End Select
IsCancelCheck = False
Exit Sub
End If
End If
' Da wir beim Klick auf Hinzfügen einen Record anlegen,
' muss UpdateMultipleValues auch aufgerufen werden, wenn wir IsInsert = True ist
'If CtrlCommandUI.IsInsert = False Then
ClassControlCommandsUI.UpdateMultipleValues(controlId, CURRENT_RECORD_ID, CONTROL_VALUE)
'End If
Dim SQL1 As String = String.Format("SELECT * FROM VWPMO_VALUES WHERE RECORD_ID = {0}", CURRENT_RECORD_ID)
Dim DT_ControlValues As DataTable = ClassDatabase.Return_Datatable(SQL1, True)
CURRENT_CONTROL_VALUES = DT_ControlValues
Dim datatable As DataTable = ClassDatabase.Return_Datatable(SQL)
Dim datatable1 As DataTable = ClassDatabase.Return_Datatable(SQLenable)
Depending_Controls(control, datatable, CONTROL_VALUE)
If IsNothing(CONTROL_VALUE) Then
Exit Sub
End If
Enable_Controls(control, datatable1, CONTROL_VALUE)
Dim values = New List(Of Object)(CONTROL_VALUE.Split(";").ToArray())
'Jetzt noch die checked Items setzen
' ClassControlValues.LoadControlValue(CURRENT_RECORD_ID, CURRENT_PARENT_ID, controlId, control, values, 99)
Catch ex As Exception
If ex.Message.Contains("Objektverweis") Or ex.Message.Contains("reference not set") Then
Else
MsgBox("Error in OnCheckedChanged - " & CONTROL_ID.ToString & ": " & ex.Message, MsgBoxStyle.Critical)
End If
End Try
End Sub
Public Sub OnFilterChanged(sender As Object, e As EventArgs)
Dim gridView As GridView = sender
Dim filter = gridView.ActiveFilter
Dim controlId As Integer = DirectCast(gridView.GridControl.Tag, ClassControlMetadata).Id
Dim recordId As Integer = CURRENT_RECORD_ID
' Wenn der Filter geleert wurde, Infos über die angehakten Zeilen aus der Datenbank holen
If filter.IsEmpty Then
Try
Dim sql As String = $"SELECT VALUE FROM TBPMO_CONTROL_VALUE WHERE CONTROL_ID = {controlId} AND RECORD_ID = {recordId}"
Dim dt As DataTable = ClassDatabase.Return_Datatable(sql)
Dim values As New List(Of Object)
For Each row As DataRow In dt.Rows
values.Add(row.Item(0))
Next
' Verhindern, dass OnSelectionChanged ausgelöst wird
IsCancelCheck = True
' Jetzt die Werte neu setzen, d.h. die angehakten Zeilen setzen
ControlLoader.DataGridViewCheckable.LoadValue(gridView.GridControl, values)
IsCancelCheck = False
Catch ex As Exception
LOGGER.Warn("Error in OnFilterChanged: " & ex.Message)
End Try
End If
End Sub
Public Sub CheckBoxChanged(sender As Object, ByVal e As EventArgs)
If CURRENT_RECORD_ENABLED = False Then Exit Sub
Try
Dim control As Control = DirectCast(sender, Control)
Dim controlId As Integer = DirectCast(control.Tag, ClassControlMetadata).Id
CONTROL_ID = controlId
Dim checkstate
'SQL für enable control
Dim SQLenable As String = String.Format("SELECT GUID, SQL_COMMAND_2 FROM TBPMO_CONTROL WHERE SQL_COMMAND_2 LIKE '%@{0}@%'", controlId)
Try
' Den CheckState setzen
checkstate = DirectCast(control, CheckBox).Checked
Catch ex As Exception
Exit Sub
End Try
If CURRENT_RECORD_ID = 0 Then
Exit Sub
End If
'If CURRENT_RECORD_ID = 0 And CtrlCommandUI.IsInsert = True Then
' Exit Sub
'End If
Dim datatable1 As DataTable = ClassDatabase.Return_Datatable(SQLenable)
Enable_Controls(control, datatable1, checkstate)
'Dim sqlcommand As String = datatable.Rows(0).Item("SQL_COMMAND_1")
'If IsNothing(sqlcommand) Then
' Exit Sub
'End If
'If String.IsNullOrEmpty(value) Then
' Exit Sub
'End If
'Dim regex As New System.Text.RegularExpressions.Regex("(@(\d+)@)")
'Dim match As System.Text.RegularExpressions.Match = regex.Match(sqlcommand)
'If match.Success Then
' ' DependingControlId bezeichnet das Control, das die Abhängigkeit enthält
' Dim dependingControlId As Integer = datatable.Rows(0).Item("GUID")
' Dim panel As Panel = DirectCast(control.Parent, Panel)
' ' Über die Id das Control finden
' Dim dependingControl As CustomComboBox = panel.Controls.OfType(Of CustomComboBox)().Where(Function(c As CustomComboBox)
' Return DirectCast(c.Tag, ClassControlMetadata).Id = dependingControlId
' End Function).SingleOrDefault()
' sqlcommand = sqlcommand.Replace(match.Groups(1).Value, value)
' Console.WriteLine("Executing SQL_COMMAND: {0}", sqlcommand)
' Dim dt As DataTable = ClassDatabase.Return_Datatable(sqlcommand)
' ControlLoader.Combobox.SetDataSource(dependingControl, dt)
'End If
Console.WriteLine("value changed")
Catch ex As Exception
If ex.Message.Contains("Objektverweis") Or ex.Message.Contains("reference not set") Then
Else
MsgBox("Error in OnComboBoxValueChanged - " & CONTROL_ID.ToString & ": " & ex.Message, MsgBoxStyle.Critical)
End If
End Try
End Sub
' ==================================================================================
' Mouse Up/Down/Move-Handler für LevelDesigner festlegen
' RecordChanged-Handler für Constructor festlegen
' ==================================================================================
Private Sub SetEventHandlers(control As Control)
If Not IsNothing(_mouse_down_handler) Then
AddHandler control.MouseDown, Me._mouse_down_handler
AddHandler control.MouseUp, Me._mouse_up_handler
AddHandler control.MouseMove, Me._mouse_move_handler
AddHandler control.Click, Me._mouse_click_handler
End If
Dim type As String = control.GetType().Name
Dim eventArgs As New System.EventArgs
' Hover Handler gilt für alle Controls
AddHandler control.MouseHover, AddressOf MouseHover
Select Case type
Case "Label"
Dim label As Label = CType(control, Label)
'AddHandler label.EnabledChanged, AddressOf OnEnabledChanged
Case "TextBox"
Dim textbox As TextBox = CType(control, TextBox)
AddHandler textbox.TextChanged, AddressOf RecordChanged
AddHandler textbox.GotFocus, AddressOf OnTextBoxFocus
AddHandler textbox.LostFocus, AddressOf OnTextBoxLostFocus
AddHandler textbox.ReadOnlyChanged, AddressOf OnReadOnlyChanged
Case "CustomComboBox"
Dim combo As CustomComboBox = CType(control, CustomComboBox)
'AddHandler combo.GotFocus, AddressOf OnComboBoxFocused
AddHandler combo.Enter, AddressOf OnComboBoxFocused
AddHandler combo.SelectedValueChanged, AddressOf OnComboBoxValueChanged
AddHandler combo.TextChanged, AddressOf RecordChanged
'AddHandler combo.TextChanged, AddressOf RecordChanged
'AddHandler combo.GotFocus, AddressOf OnComboBoxFocus
'AddHandler combo.LostFocus, AddressOf OnComboBoxLostFocus
'AddHandler combo.EnabledChanged, AddressOf OnEnabledChanged
Case "RadioButton"
Dim radiobutton As RadioButton = CType(control, RadioButton)
AddHandler radiobutton.CheckedChanged, AddressOf RecordChanged
'AddHandler radiobutton.EnabledChanged, AddressOf OnEnabledChanged
Case "CheckBox"
Dim checkbox As CheckBox = CType(control, CheckBox)
AddHandler checkbox.CheckedChanged, AddressOf RecordChanged
'AddHandler checkbox.EnabledChanged, AddressOf OnEnabledChanged
AddHandler checkbox.CheckedChanged, AddressOf CheckBoxChanged
Case "PictureBox"
Dim picturebox As PictureBox = CType(control, PictureBox)
AddHandler picturebox.BackgroundImageChanged, AddressOf RecordChanged
'AddHandler picturebox.EnabledChanged, AddressOf OnEnabledChanged
Case "DateEdit"
Dim datetimepick As DevExpress.XtraEditors.DateEdit = CType(control, DevExpress.XtraEditors.DateEdit)
AddHandler datetimepick.DateTimeChanged, AddressOf RecordChanged
AddHandler datetimepick.DateTimeChanged, AddressOf OnDateTimeValueChanged
'AddHandler datetimepick.EnabledChanged, AddressOf OnEnabledChanged
Case "ListBoxControl"
Dim listbox As DevExpress.XtraEditors.ListBoxControl = CType(control, DevExpress.XtraEditors.ListBoxControl)
AddHandler listbox.SelectedValueChanged, AddressOf RecordChanged
'AddHandler listbox.EnabledChanged, AddressOf OnEnabledChanged
Case "CheckedListBoxControl"
Dim chklistbox As DevExpress.XtraEditors.CheckedListBoxControl = CType(control, DevExpress.XtraEditors.CheckedListBoxControl)
AddHandler chklistbox.ItemCheck, AddressOf RecordChanged
AddHandler chklistbox.ItemCheck, AddressOf OnCheckedItemChanged
' AddHandler chklistbox.EnabledChanged, AddressOf OnEnabledChanged
Case "DataGridView"
Dim gridview As DataGridView = CType(control, DataGridView)
AddHandler gridview.RowsAdded, AddressOf RecordChanged
AddHandler gridview.CellValueChanged, AddressOf RecordChanged
AddHandler gridview.RowsRemoved, AddressOf RecordChanged
'AddHandler gridview.EnabledChanged, AddressOf OnEnabledChanged
Case "GridControl"
Dim gridcontrol As DevExpress.XtraGrid.GridControl = CType(control, DevExpress.XtraGrid.GridControl)
Dim gridview As DevExpress.XtraGrid.Views.Grid.GridView = gridcontrol.MainView
AddHandler gridview.SelectionChanged, AddressOf RecordChanged
AddHandler gridview.SelectionChanged, AddressOf OnCheckedChanged
AddHandler gridview.ColumnFilterChanged, AddressOf OnFilterChanged
End Select
End Sub
Private Sub SetDragDropHandler(groupbox As GroupBox)
If Not IsNothing(_group_box_drag_drop_handler) Then
AddHandler groupbox.DragDrop, Me._group_box_drag_drop_handler
AddHandler groupbox.DragEnter, AddressOf Me.GroupBoxDragEnter
End If
End Sub
Private Sub GroupBoxDragEnter(sender As Object, e As DragEventArgs)
' 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 Sub selectAll_Click(sender As Object, e As EventArgs)
Dim item As ToolStripMenuItem = DirectCast(sender, ToolStripMenuItem)
Dim menu As ContextMenuStrip = item.Owner
Dim chklb As DevExpress.XtraEditors.CheckedListBoxControl = menu.SourceControl
chklb.CheckAll()
End Sub
Private Sub deselectAll_Click(sender As Object, e As EventArgs)
Dim item As ToolStripMenuItem = DirectCast(sender, ToolStripMenuItem)
Dim menu As ContextMenuStrip = item.Owner
Dim chklb As DevExpress.XtraEditors.CheckedListBoxControl = menu.SourceControl
chklb.UnCheckAll()
End Sub
Private Sub itemAdd_Click(sender As Object, e As EventArgs)
Dim item As ToolStripMenuItem = DirectCast(sender, ToolStripMenuItem)
Dim menu As ContextMenuStrip = item.Owner
Dim pb As PictureBox = menu.SourceControl
Dim dialog As New OpenFileDialog()
dialog.Filter = "Bilddateien|*.png;*.jpg;*.jpeg"
If dialog.ShowDialog() = DialogResult.OK Then
pb.BackgroundImageLayout = ImageLayout.Zoom
pb.BackgroundImage = CType(System.Drawing.Image.FromFile(dialog.FileName, True), Bitmap)
End If
End Sub
Private Sub itemDel_Click(sender As Object, e As EventArgs)
Dim item As ToolStripMenuItem = DirectCast(sender, ToolStripMenuItem)
Dim menu As ContextMenuStrip = item.Owner
Dim pb As PictureBox = menu.SourceControl
Dim answer = MessageBox.Show("Wollen sie dieses Bild wirklich löschen?", "Bild löschen", MessageBoxButtons.YesNo)
If answer = DialogResult.Yes Then
pb.BackgroundImage = Nothing
End If
End Sub
Private Sub itemSave_Click(sender As Object, e As EventArgs)
Dim item As ToolStripMenuItem = DirectCast(sender, ToolStripMenuItem)
Dim menu As ContextMenuStrip = item.Owner
Dim pb As PictureBox = menu.SourceControl
If IsNothing(pb.BackgroundImage) Then
MsgBox("Kein Bild ausgewählt!", MsgBoxStyle.Exclamation)
Exit Sub
End If
Dim dialog As New SaveFileDialog()
dialog.Filter = "PNG-Bilddateien|*.png|JPEG-Bilddateien|*.jpg"
Try
If dialog.ShowDialog() = DialogResult.OK Then
Dim filename As String = dialog.FileName
Dim ext As String = System.IO.Path.GetExtension(filename)
Select Case ext
Case ".png"
pb.BackgroundImage.Save(filename, System.Drawing.Imaging.ImageFormat.Png)
Case ".jpg"
pb.BackgroundImage.Save(filename, System.Drawing.Imaging.ImageFormat.Jpeg)
End Select
End If
Catch ex As Exception
MsgBox("Fehler beim Speichern des Bildes:" & vbNewLine & ex.Message, MsgBoxStyle.Critical)
End Try
End Sub
' +++ Panel Interaction +++
Private Sub AddToPanel(control As Control)
_master_panel.Controls.Add(control)
End Sub
' +++ GroupBox Interaction +++
Private Sub AddToGroupBox(Parent As GroupBox, Child As Control)
Parent.Controls.Add(Child)
End Sub
Private Sub RemoveFromPanel(control As Control)
Dim controls As Control.ControlCollection = Me._master_panel.Controls
controls.Remove(control)
End Sub
' +++ Public Properties +++
Public Property CurrentControl As Control
Get
Return Me._current_control
End Get
Set(control As Control)
Me._current_control = control
End Set
End Property
Public Property BeginLocation As Point
Get
Return _begin_location
End Get
Set(value As Point)
_begin_location = value
End Set
End Property
Public Property EndLocation As Point
Get
Return _end_location
End Get
Set(value As Point)
_end_location = value
End Set
End Property
Public ReadOnly Property AllControls As Control.ControlCollection
Get
Return _master_panel.Controls
End Get
End Property
Public ReadOnly Property MasterPanel As Panel
Get
Return _master_panel
End Get
End Property
' =========================
' Textbox Format Handlers
' =========================
Private Sub AddTextHandler(control As TextBox, format As String)
If format = "Currency" Then
AddHandler control.Leave, AddressOf Textbox_Currency_Handler
ElseIf format = "Decimal" Then
AddHandler control.Leave, AddressOf TextBox_Decimal_Handler
End If
End Sub
Private Sub AddComboHandler(control As CustomComboBox, format As String)
If format = "Currency" Then
AddHandler control.Leave, AddressOf Combo_Currency_Handler
ElseIf format = "Decimal" Then
AddHandler control.Leave, AddressOf Combo_Decimal_Handler
End If
AddHandler control.KeyUp, AddressOf AutoCompleteCombo_KeyUp
End Sub
Public Function IsValidCurrency(currencyValue As String) As Boolean
Dim pattern As String = "\p{Sc}+\s*\d+"
Dim currencyRegex As New Regex(pattern)
Return currencyRegex.IsMatch(currencyValue)
End Function
Private Sub Textbox_Currency_Handler(sender As Object, e As EventArgs)
Dim control As TextBox = DirectCast(sender, TextBox)
If control.Text <> "" Then
Dim GermanCulture = Globalization.CultureInfo.GetCultureInfo("de-DE")
Dim controlvalue = control.Text
Dim value As Double
' Tausenderzeichen entfernen
controlvalue = controlvalue.Replace(".", "")
If Not Double.TryParse(controlvalue, Globalization.NumberStyles.Currency, GermanCulture, value) Then
'Invalid.
MessageBox.Show("Please enter a valid curreny amount.", "Invalid Format", MessageBoxButtons.OK, MessageBoxIcon.Warning)
control.Focus()
'control.SelectAll()
Else
'Alles gut, convertierung erfolgreich, wieder als currency anzeigen
control.Text = ClassHelper.Format_Currency(value.ToString(), USER_LANGUAGE)
End If
End If
'ALT
'If control.Text <> "" Then
' Dim controlvalue = control.Text
' If controlvalue.Contains(".") Then
' controlvalue = controlvalue.Replace(".", ",")
' End If
' Dim value As Double
' If Double.TryParse(controlvalue, Globalization.NumberStyles.Currency, Nothing, value) Then
' 'Valid.
' control.Text = value.ToString("c"c)
' Else
' 'Invalid.
' MessageBox.Show("Please enter a valid curreny amount.")
' control.Focus()
' control.SelectAll()
' End If
'End If
End Sub
Private Sub TextBox_Decimal_Handler(sender As Object, e As EventArgs)
Dim control As TextBox = DirectCast(sender, TextBox)
Dim value As Decimal
If Decimal.TryParse(control.Text.Trim(), value) Then
control.Text = value.ToString("###,###")
End If
End Sub
Private Sub Combo_Currency_Handler(sender As Object, e As EventArgs)
Dim control As CustomComboBox = DirectCast(sender, CustomComboBox)
Dim value As Decimal
If Decimal.TryParse(control.Text.Trim(), value) Then
control.Text = value.ToString("c")
control.SelectionStart = control.SelectionStart + 1
'value = FormatNumber(value, -1, TriState.UseDefault, TriState.UseDefault, TriState.True)
'control.Text = value.ToString("n")
End If
End Sub
Private Sub Combo_Decimal_Handler(sender As Object, e As EventArgs)
Dim control As CustomComboBox = DirectCast(sender, CustomComboBox)
Dim value As Decimal
If Decimal.TryParse(control.Text.Trim(), value) Then
control.Text = value.ToString("###,###")
End If
End Sub
' +++ Public Helper Methods +++
Public Function GetCursorPosition() As Point
Return Me._master_panel.PointToClient(Cursor.Position)
End Function
Public Function GetControlByName(name As String)
For Each c In _master_panel.Controls
If c.name = name Then
Return c
End If
Next
Return Nothing
End Function
Public Sub SetActiveColor(ActiveControl As Control)
Dim ActiveColor As Color = Color.DarkOrange
Dim CurrentType As String = ActiveControl.GetType().Name
Select Case CurrentType
Case "TextBox"
ActiveControl.BackColor = ActiveColor
Case "CustomComboBox"
'Case "System.Windows.Forms.ComboBox"
ActiveControl.BackColor = ActiveColor
Case "Label"
ActiveControl.BackColor = ActiveColor
Case "CheckBox"
ActiveControl.BackColor = ActiveColor
Case "Button"
ActiveControl.BackColor = ActiveColor
Case "DataGridView"
Dim current As DataGridView = DirectCast(ActiveControl, DataGridView)
current.BackgroundColor = ActiveColor
Case "DateEdit"
ActiveControl.BackColor = ActiveColor
Case "GroupBox"
ActiveControl.BackColor = ActiveColor
Case "PictureBox"
ActiveControl.BackColor = ActiveColor
Case "CheckedListBoxControl"
ActiveControl.BackColor = ActiveColor
Case "ListBoxControl"
ActiveControl.BackColor = ActiveColor
End Select
End Sub
Public Sub ResetActiveColor(ActiveControl As Control)
For Each inctrl As Control In Me._master_panel.Controls
If inctrl.Name <> ActiveControl.Name Then
Dim Type As String = inctrl.GetType().Name
Select Case Type
Case "TextBox"
inctrl.BackColor = Color.White
Case "CustomComboBox"
'Case "System.Windows.Forms.ComboBox"
inctrl.BackColor = Color.White
Case "Label"
inctrl.BackColor = Color.Transparent
Case "CheckBox"
inctrl.BackColor = Color.Transparent
Case "DataGridView"
Dim ctrl As DataGridView = DirectCast(inctrl, DataGridView)
ctrl.BackgroundColor = SystemColors.ControlDark
Case "DateEdit"
inctrl.BackColor = Color.White
Case "Button"
inctrl.BackColor = SystemColors.Control
Case "GroupBox"
inctrl.BackColor = SystemColors.Control
Case "CheckedListBoxControl"
inctrl.BackColor = Color.White
Case "ListBoxControl"
inctrl.BackColor = Color.White
Case "PictureBox"
inctrl.BackColor = SystemColors.ControlDark
For Each gbctrl As Control In inctrl.Controls
If gbctrl.Name <> ActiveControl.Name Then
Dim gbType As String = gbctrl.GetType.ToString
Select Case gbType
Case "TextBox"
gbctrl.BackColor = Color.White
Case "CustomComboBox"
'Case "System.Windows.Forms.ComboBox"
gbctrl.BackColor = Color.White
Case "Label"
gbctrl.BackColor = Color.Transparent
Case "CheckBox"
gbctrl.BackColor = Color.Transparent
Case "DataGridView"
Dim ctrl As DataGridView = DirectCast(gbctrl, DataGridView)
ctrl.BackgroundColor = SystemColors.ControlDark
Case "DateEdit"
gbctrl.BackColor = Color.White
Case "Button"
gbctrl.BackColor = SystemColors.Control
Case "PictureBox"
inctrl.BackColor = SystemColors.ControlDark
Case "CheckedListBoxControl"
inctrl.BackColor = Color.White
Case "ListBoxControl"
inctrl.BackColor = Color.White
End Select
End If
Next
End Select
End If
Next
End Sub
Public Sub SetAllActiveColor()
SetActiveColor(_current_control)
' Remove Active Color from all other Controls
ResetActiveColor(_current_control)
End Sub
' +++ Public Methods +++
Public Sub ClearControls()
Me._master_panel.Controls.Clear()
End Sub
Public Sub RemoveControl(name As String)
For Each ctrl As Control In Me._master_panel.Controls
If (name = ctrl.Name) Then
Me._master_panel.Controls.Remove(ctrl)
Exit Sub
End If
Next
End Sub
Public Sub AddLabel(id As Integer,
name As String,
text As String,
x As Integer,
y As Integer,
fontfamily As String,
fontcolor As Integer,
fontsize As Integer,
fontstyle As Integer,
sqlcommand As String,
_new As Boolean,
Optional parent As GroupBox = Nothing,
Optional _designMode As Boolean = False)
Try
Dim control As Label = New Label
Dim defaultSize As Size = New Size(200, 27)
Dim metadata As New ClassControlMetadata()
metadata.Id = id
metadata.Name = name
control.Tag = metadata
control.Name = name
control.Text = text
control.Font = New Font(fontfamily, fontsize, CType(fontstyle, FontStyle))
control.ForeColor = IntToColor(fontcolor)
control.AutoSize = True
If _new And IsNothing(parent) Then
control.Location = Me.GetCursorPosition()
control.Size = defaultSize
ElseIf _new And Not IsNothing(parent) Then
Dim cursor = Me.GetCursorPosition()
control.Location = New Point(cursor.X - parent.Location.X,
cursor.Y - parent.Location.Y)
Else
control.Location = New Point(x, y)
control.Size = defaultSize
End If
If _designMode = True Then
control.Cursor = Cursors.Hand
End If
'SQL-Command vorhanden also Ausführen des SQL
If sqlcommand.Length > 1 Then
Dim result
If sqlcommand.Contains("@RECORD_ID") Or sqlcommand.Contains("@RECORDID") Or sqlcommand.Contains("@ENTITY_ID") Or sqlcommand.Contains("@PARENTRECORD_ID") Or sqlcommand.Contains("@PARENTRECORDID") Then
result = Nothing
Else
result = ClassDatabase.Execute_Scalar(sqlcommand, True)
End If
If Not IsNothing(result) Then
If Not IsDBNull(result) Then
If Not IsNothing(result) Then
control.Text = result.ToString
End If
End If
Else
If text <> "" Then
control.Text = text
Else
control.Text = "NO CAPTION/TEXT"
End If
End If
End If
SetEventHandlers(control)
CurrentControl = control
If Not IsNothing(parent) Then
control.Parent = parent
Me.AddToGroupBox(parent, control)
Else
control.Parent = _master_panel
Me.AddToPanel(control)
End If
Catch ex As Exception
MsgBox("Error in AddLabel: " + vbNewLine + ex.Message)
End Try
End Sub
Public Sub AddLine(id As Integer,
name As String,
x As Integer,
y As Integer,
color As Integer,
width As Integer,
height As Integer,
_new As Integer,
Optional parent As GroupBox = Nothing,
Optional _designMode As Boolean = False)
Dim line As New LineLabel
line.Tag = New ClassControlMetadata() With {
.Id = id,
.Name = name
}
line.Name = name
line.AutoSize = False
line.BackColor = IntToColor(color)
If _new Then
line.Location = GetCursorPosition()
line.Size = New Size(200, 5)
Else
line.Location = New Point(x, y)
line.Size = New Size(width, height)
End If
CurrentControl = line
line.Parent = _master_panel
SetEventHandlers(line)
AddToPanel(line)
End Sub
Public Sub AddTextBox(id As Integer,
name As String,
x As Integer,
y As Integer,
fontfamily As String,
fontcolor As Integer,
fontsize As Integer,
fontstyle As Integer,
tabindex As Integer,
tabstop As Integer,
vwidth As Integer,
vheight As Integer,
multiline As Boolean,
read_only As Boolean,
required As Boolean,
format As String,
autoSuggest As Boolean,
_new As Boolean,
Optional parent As GroupBox = Nothing,
Optional _designMode As Boolean = False)
Try
Dim control As New TextBox
Dim defaultSize As Size = New Size(200, 27)
Dim metadata As New ClassControlMetadata()
metadata.Id = id
metadata.Name = name
metadata.Required = required
metadata.Format = format
control.Tag = metadata
control.Name = name
control.Font = New Font(fontfamily, fontsize, CType(fontstyle, FontStyle))
control.ForeColor = IntToColor(fontcolor)
control.TabIndex = tabindex
control.TabStop = tabstop
control.BorderStyle = BorderStyle.FixedSingle
control.ReadOnly = read_only
AddTextHandler(DirectCast(control, Control), format)
'Console.WriteLine("setting tabindex of control " & name & " to " & tabindex)
If autoSuggest = True Then
control.AutoCompleteMode = AutoCompleteMode.Suggest
control.AutoCompleteSource = AutoCompleteSource.CustomSource
Dim suggestSource As New AutoCompleteStringCollection()
Dim dt As DataTable = ClassDatabase.Return_Datatable($"SELECT DISTINCT VALUE FROM VWPMO_VALUES WHERE CONTROL_ID = {id}")
For Each row As DataRow In dt.Rows
suggestSource.Add(row.Item("VALUE"))
Next
control.AutoCompleteCustomSource = suggestSource
End If
If multiline = True Then
control.Multiline = True
control.AcceptsReturn = True
control.AcceptsTab = True
control.ScrollBars = ScrollBars.Vertical
End If
If _new And IsNothing(parent) Then
control.Location = Me.GetCursorPosition()
control.Size = defaultSize
ElseIf _new And Not IsNothing(parent) Then
Dim cursor = Me.GetCursorPosition()
control.Location = New Point(cursor.X - parent.Location.X,
cursor.Y - parent.Location.Y)
Else
control.Location = New Point(x, y)
control.Size = New Size(vwidth, vheight)
End If
If _designMode = True Then
control.Cursor = Cursors.Hand
End If
If Not read_only Or _designMode Then
Me.SetEventHandlers(control)
End If
Me.CurrentControl = DirectCast(control, TextBox)
If Not IsNothing(parent) Then
control.Parent = parent
Me.AddToGroupBox(parent, control)
Else
control.Parent = _master_panel
Me.AddToPanel(control)
End If
Catch ex As Exception
MsgBox("Error in AddTextBox: " + vbNewLine + ex.Message)
End Try
End Sub
Public Sub AddCheckBox(id As Integer,
name As String,
text As String,
Checked As Boolean,
x As Integer,
y As Integer,
fontfamily As String,
fontcolor As Integer,
fontsize As Integer,
fontstyle As Integer,
tabindex As Integer,
tabstop As Boolean,
vwidth As Integer,
vheight As Integer,
_new As Boolean,
read_only As Boolean,
required As Boolean,
Optional parent As GroupBox = Nothing,
Optional _designMode As Boolean = False)
Try
Dim control As New CheckBox
Dim defaultSize As Size = New Size(150, 27)
Dim metadata As New ClassControlMetadata()
metadata.Id = id
metadata.Name = name
metadata.Required = required
control.Tag = metadata
control.Checked = Checked
control.Name = name
control.Font = New Font(fontfamily, fontsize, CType(fontstyle, FontStyle))
control.ForeColor = IntToColor(fontcolor)
control.Text = text
control.TabIndex = tabindex
control.TabStop = tabstop
control.AutoCheck = True
If _designMode = True Then
control.AutoCheck = False
control.Cursor = Cursors.Hand
Else
control.AutoCheck = True
End If
If Not _designMode And read_only Then
control.Enabled = Not read_only
End If
If _new And IsNothing(parent) Then
control.Location = Me.GetCursorPosition()
control.Size = defaultSize
ElseIf _new And Not IsNothing(parent) Then
Dim cursor = Me.GetCursorPosition()
control.Location = New Point(cursor.X - parent.Location.X,
cursor.Y - parent.Location.Y)
Else
control.Location = New Point(x, y)
control.Size = New Size(vwidth, vheight)
End If
Me.SetEventHandlers(control)
Me.CurrentControl = DirectCast(control, CheckBox)
If Not IsNothing(parent) Then
control.Parent = parent
Me.AddToGroupBox(parent, control)
Else
control.Parent = _master_panel
Me.AddToPanel(control)
End If
Catch ex As Exception
MsgBox("Error in AddCheckBox: " + vbNewLine + ex.Message)
End Try
End Sub
Public Sub AddRadioButton(id As Integer,
name As String,
text As String,
Checked As Boolean,
x As Integer,
y As Integer,
fontfamily As String,
fontcolor As Integer,
fontsize As Integer,
fontstyle As Integer,
tabindex As Integer,
tabstop As Boolean,
vwidth As Integer,
vheight As Integer,
_new As Boolean,
read_only As Boolean,
required As Boolean,
Optional parent As GroupBox = Nothing,
Optional _designMode As Boolean = False)
Try
Dim control As New RadioButton
Dim defaultSize As Size = New Size(150, 27)
Dim metadata As New ClassControlMetadata()
metadata.Id = id
metadata.Name = name
metadata.Required = required
control.Tag = metadata
control.Name = name
control.Font = New Font(fontfamily, fontsize, CType(fontstyle, FontStyle))
control.ForeColor = IntToColor(fontcolor)
control.Text = text
control.TabIndex = tabindex
control.TabStop = tabstop
control.AutoCheck = True
control.Checked = Checked
If _new And IsNothing(parent) Then
control.Location = Me.GetCursorPosition()
control.Size = defaultSize
ElseIf _new And Not IsNothing(parent) Then
Dim cursor = Me.GetCursorPosition()
control.Location = New Point(cursor.X - parent.Location.X,
cursor.Y - parent.Location.Y)
Else
control.Location = New Point(x, y)
control.Size = New Size(vwidth, vheight)
End If
If Not _designMode And read_only Then
control.Enabled = Not read_only
End If
If _designMode = True Then
control.Cursor = Cursors.Hand
End If
Me.SetEventHandlers(control)
Me.CurrentControl = DirectCast(control, RadioButton)
If Not IsNothing(parent) Then
control.Parent = parent
Me.AddToGroupBox(parent, control)
Else
control.Parent = _master_panel
Me.AddToPanel(control)
End If
Catch ex As Exception
MsgBox("Error in AddRadioButton: " + vbNewLine + ex.Message)
End Try
End Sub
Public Sub AddComboBox(id As Integer,
name As String,
x As Integer,
y As Integer,
fontfamily As String,
fontcolor As Integer,
fontsize As Integer,
fontstyle As Integer,
tabindex As Integer,
tabstop As Boolean,
vwidth As Integer,
vheight As Integer,
vformat As String,
_new As Boolean,
read_only As Boolean,
select_only As Boolean,
required As Boolean,
static_list As String,
sqlcommand As String,
Optional parent As GroupBox = Nothing,
Optional _designMode As Boolean = False)
Try
Dim _control As New ComboBox
Dim control As New CustomComboBox
Dim defaultSize As Size = New Size(120, 24)
Dim metadata As New ClassControlMetadata()
metadata.Id = id
metadata.Name = name
metadata.Required = required
control.Tag = metadata
control.Name = name
control.Font = New Font(fontfamily, fontsize, CType(fontstyle, FontStyle))
control.ForeColor = IntToColor(fontcolor)
control.TabIndex = tabindex
control.TabStop = tabstop
control.Parent = _master_panel
control.DropDownStyle = ComboBoxStyle.DropDown
control.FormattingEnabled = True
control.AutoCompleteMode = AutoCompleteMode.Append
control.AutoCompleteSource = AutoCompleteSource.ListItems
If (Not _designMode And read_only) Then
control.Enabled = Not read_only
End If
If (Not _designMode And select_only) Then
control.DropDownStyle = ComboBoxStyle.DropDownList
End If
AddComboHandler(control, vformat)
If _new And IsNothing(parent) Then
control.Location = Me.GetCursorPosition()
control.Size = defaultSize
ElseIf _new And Not IsNothing(parent) Then
Dim cursor = Me.GetCursorPosition()
control.Location = New Point(cursor.X - parent.Location.X,
cursor.Y - parent.Location.Y)
Else
control.Location = New Point(x, y)
control.Size = New Size(vwidth, vheight)
End If
' Wenn statische liste vorhanden, werte splitten und einfügen
If static_list.Length > 0 Then
Dim items() As String = static_list.Split(";")
For Each item As String In items
control.Items.Add(item)
Next
End If
Me.SetEventHandlers(control)
Me.CurrentControl = DirectCast(control, CustomComboBox)
If Not IsNothing(parent) Then
control.Parent = parent
Me.AddToGroupBox(parent, control)
Else
control.Parent = _master_panel
Me.AddToPanel(control)
End If
Catch ex As Exception
MsgBox("Error in AddComboBox: " + vbNewLine + ex.Message)
End Try
End Sub
Public Sub AutoCompleteCombo_KeyUp(ByVal cbo As CustomComboBox, ByVal e As KeyEventArgs)
Try
''Allow select keys without Autocompleting
Select Case e.KeyCode
Case Keys.Back, Keys.Left, Keys.Right, Keys.Up, Keys.Delete, Keys.Down
Return
End Select
Dim iFoundIndex As Integer
iFoundIndex = cbo.FindStringExact(cbo.Text)
'cbo.SelectedIndex = iFoundIndex
'Dim sTypedText As String
'Dim iFoundIndex As Integer
'Dim oFoundItem As Object
'Dim sFoundText As String
'Dim sAppendText As String
''Get the Typed Text and Find it in the list
'sTypedText = cbo.Text
'iFoundIndex = cbo.FindString(sTypedText)
''If we found the Typed Text in the list then Autocomplete
'If iFoundIndex >= 0 Then
' 'Get the Item from the list (Return Type depends if Datasource was bound
' ' or List Created)
' oFoundItem = cbo.Items(iFoundIndex)
' 'Use the ListControl.GetItemText to resolve the Name in case the Combo
' ' was Data bound
' sFoundText = cbo.GetItemText(oFoundItem)
' 'Append then found text to the typed text to preserve case
' sAppendText = sFoundText.Substring(sTypedText.Length)
' cbo.Text = sTypedText & sAppendText
' 'Select the Appended Text
' cbo.SelectionStart = sTypedText.Length
' cbo.SelectionLength = sAppendText.Length
'End If
Catch ex As Exception
LOGGER.Warn("Unexpected error in AutoCompleteComboKEyUp: " & ex.Message)
End Try
End Sub
Public Sub AutoCompleteCombo_Leave(ByVal cbo As CustomComboBox)
Try
Dim iFoundIndex As Integer
iFoundIndex = cbo.FindStringExact(cbo.Text)
cbo.SelectedIndex = iFoundIndex
Catch ex As Exception
End Try
End Sub
Public Sub AddDateTimePicker(id As Integer,
name As String,
x As Integer,
y As Integer,
fontfamily As String,
fontsize As Integer,
fontstyle As Integer,
tabindex As Integer,
tabstop As Boolean,
vwidth As Integer,
vheight As Integer,
read_only As Boolean,
required As Boolean,
_new As Boolean,
Optional parent As GroupBox = Nothing,
Optional _designMode As Boolean = False)
Try
Dim control As New DevExpress.XtraEditors.DateEdit
'Dim control As New DateTimePicker
Dim defaultSize As Size = New Size(90, 20)
Dim metadata As New ClassControlMetadata()
metadata.Id = id
metadata.Name = name
metadata.Required = required
control.Tag = metadata
control.Name = name
'control.Format = DateTimePickerFormat.Short
'control.Font = New Font(fontfamily, fontsize, CType(fontstyle, FontStyle))
'control.CalendarFont = New Font(fontfamily, fontsize, CType(fontstyle, FontStyle))
control.Font = New Font(fontfamily, fontsize, CType(fontstyle, FontStyle))
control.TabIndex = tabindex
control.TabStop = tabstop
control.Parent = _master_panel
control.Properties.NullDate = DateTime.MinValue
control.Properties.NullText = String.Empty
control.Properties.ReadOnly = read_only
If _new And IsNothing(parent) Then
control.Location = Me.GetCursorPosition()
control.Size = defaultSize
ElseIf _new And Not IsNothing(parent) Then
Dim cursor = Me.GetCursorPosition()
control.Location = New Point(cursor.X - parent.Location.X,
cursor.Y - parent.Location.Y)
Else
control.Location = New Point(x, y)
control.Size = New Size(vwidth, vheight)
End If
If Not read_only Or _designMode Then
Me.SetEventHandlers(control)
End If
'Me.CurrentControl = DirectCast(control, DateTimePicker)
Me.CurrentControl = DirectCast(control, DevExpress.XtraEditors.DateEdit)
If Not IsNothing(parent) Then
control.Parent = parent
Me.AddToGroupBox(parent, control)
Else
control.Parent = _master_panel
Me.AddToPanel(control)
End If
Catch ex As Exception
MsgBox("Error in AddDateTimePicker: " + vbNewLine + ex.Message)
End Try
End Sub
Public Sub AddDataGridView(id As Integer,
name As String,
x As Integer,
y As Integer,
vwidth As Integer,
vheight As Integer,
_new As Boolean,
read_only As Boolean,
required As Boolean,
columnTitle As String,
Optional parent As GroupBox = Nothing,
Optional _designMode As Boolean = False)
Dim control As New DataGridView
Dim column As New DataGridViewTextBoxColumn
Dim defaultSize = New Size(130, 150)
Dim metadata As New ClassControlMetadata()
metadata.Id = id
metadata.Name = name
metadata.Required = required
control.Tag = metadata
control.Name = name
control.BackgroundColor = SystemColors.ControlDark
control.AllowUserToAddRows = True
control.AllowUserToDeleteRows = True
control.AllowUserToResizeColumns = False
control.AllowUserToResizeRows = False
control.Parent = _master_panel
control.ReadOnly = read_only
column.HeaderText = columnTitle
column.Name = "column1"
control.Columns.Add(column)
If _new And IsNothing(parent) Then
control.Location = Me.GetCursorPosition()
control.Size = defaultSize
ElseIf _new And Not IsNothing(parent) Then
Dim cursor = Me.GetCursorPosition()
control.Location = New Point(cursor.X - parent.Location.X,
cursor.Y - parent.Location.Y)
Else
control.Location = New Point(x, y)
control.Size = New Size(vwidth, vheight)
End If
If _designMode = True Then
control.Cursor = Cursors.Hand
End If
Me.SetEventHandlers(control)
Me.CurrentControl = DirectCast(control, DataGridView)
If Not IsNothing(parent) Then
control.Parent = parent
Me.AddToGroupBox(parent, control)
Else
control.Parent = _master_panel
Me.AddToPanel(control)
End If
End Sub
Public Sub AddDataGridViewCheckable(id As Integer,
name As String,
x As Integer,
y As Integer,
vwidth As Integer,
vheight As Integer,
_new As Boolean,
tabindex As Integer,
tabstop As Boolean,
read_only As Boolean,
required As Boolean,
columnTitle As String,
Optional parent As GroupBox = Nothing,
Optional _designMode As Boolean = False)
Dim control As New DevExpress.XtraGrid.GridControl
Dim gridview As New DevExpress.XtraGrid.Views.Grid.GridView
control.MainView = gridview
Dim defaultSize = New Size(200, 150)
gridview.OptionsView.ShowGroupPanel = False
gridview.OptionsView.EnableAppearanceEvenRow = True
gridview.Appearance.EvenRow.BackColor = Color.Aqua
gridview.OptionsSelection.MultiSelect = True
gridview.OptionsSelection.MultiSelectMode = DevExpress.XtraGrid.Views.Grid.GridMultiSelectMode.CheckBoxRowSelect
gridview.OptionsSelection.CheckBoxSelectorColumnWidth = 30
If Not _designMode Then
' Filter funktioniert nicht mit den MouseEvents des LevelDesigners
gridview.OptionsView.ShowAutoFilterRow = True
End If
If _designMode Then
Dim DataColumn = gridview.Columns.Add()
DataColumn.Caption = "Data"
DataColumn.FieldName = "DATA"
'DataColumn.UnboundType = DevExpress.Data.UnboundColumnType.Object
DataColumn.Visible = True
gridview.OptionsBehavior.ReadOnly = True
gridview.OptionsBehavior.Editable = False
' Beispieldaten hinzufügen
Dim dt As New DataTable
dt.Columns.Add(DataColumn.FieldName)
Dim row1 As DataRow = dt.NewRow()
row1.Item(DataColumn.FieldName) = "Datensatz 1"
dt.Rows.Add(row1)
Dim row2 As DataRow = dt.NewRow()
row2.Item(DataColumn.FieldName) = "Datensatz 2"
dt.Rows.Add(row2)
control.DataSource = dt
End If
Dim metadata As New ClassControlMetadata()
metadata.Id = id
metadata.Name = name
metadata.Required = required
control.Tag = metadata
control.Name = name
control.Parent = _master_panel
If _new And IsNothing(parent) Then
control.Location = Me.GetCursorPosition()
control.Size = defaultSize
ElseIf _new And Not IsNothing(parent) Then
Dim cursor = Me.GetCursorPosition()
control.Location = New Point(cursor.X - parent.Location.X,
cursor.Y - parent.Location.Y)
Else
control.Location = New Point(x, y)
control.Size = New Size(vwidth, vheight)
End If
If _designMode = True Then
control.Cursor = Cursors.Hand
End If
Me.SetEventHandlers(control)
Me.CurrentControl = DirectCast(control, DevExpress.XtraGrid.GridControl)
If Not IsNothing(parent) Then
control.Parent = parent
Me.AddToGroupBox(parent, control)
Else
control.Parent = _master_panel
Me.AddToPanel(control)
End If
End Sub
Public Sub AddPictureBox(id As Integer,
name As String,
x As Integer,
y As Integer,
vwidth As Integer,
vheight As Integer,
_new As Boolean,
read_only As Boolean,
required As Boolean,
Optional parent As GroupBox = Nothing,
Optional _designMode As Boolean = False)
Dim control As New PictureBox
Dim defaultSize = New Size(200, 100)
Dim ctx As New ContextMenuStrip()
Dim itemAdd As New ToolStripMenuItem()
Dim itemDel As New ToolStripMenuItem()
Dim itemSave As New ToolStripMenuItem()
itemAdd.Text = "Bild auswählen.."
itemDel.Text = "Bild löschen"
itemSave.Text = "Bild speichern unter.."
AddHandler itemAdd.Click, AddressOf itemAdd_Click
AddHandler itemDel.Click, AddressOf itemDel_Click
AddHandler itemSave.Click, AddressOf itemSave_Click
'Nur bei ReadOnly alle Auswahlmöglichkeiten
If read_only = False Then
ctx.Items.Add(itemAdd)
ctx.Items.Add(itemDel)
End If
ctx.Items.Add(itemSave)
Dim metadata As New ClassControlMetadata()
metadata.Id = id
metadata.Name = name
metadata.Required = required
control.Tag = metadata
control.Name = name
control.Parent = _master_panel
control.BorderStyle = BorderStyle.FixedSingle
control.ContextMenuStrip = ctx
control.BackgroundImage = My.Resources.ImageListControl_683
control.BackgroundImageLayout = ImageLayout.Zoom
If _new And IsNothing(parent) Then
control.Location = Me.GetCursorPosition()
control.Size = defaultSize
ElseIf _new And Not IsNothing(parent) Then
Dim cursor = Me.GetCursorPosition()
control.Location = New Point(cursor.X - parent.Location.X,
cursor.Y - parent.Location.Y)
Else
control.Location = New Point(x, y)
control.Size = New Size(vwidth, vheight)
End If
If _designMode = True Then
control.Cursor = Cursors.Hand
End If
Me.SetEventHandlers(control)
Me.CurrentControl = DirectCast(control, PictureBox)
If Not IsNothing(parent) Then
control.Parent = parent
Me.AddToGroupBox(parent, control)
Else
control.Parent = _master_panel
Me.AddToPanel(control)
End If
End Sub
Public Sub AddGroupBox(id As Integer,
name As String,
Caption As String,
x As Integer,
y As Integer,
vwidth As Integer,
vheight As Integer,
backcolor As Integer,
fontcolor As Integer,
fontfamily As String,
fontsize As Integer,
fontstyle As Integer,
_new As Boolean,
Optional parent As GroupBox = Nothing,
Optional _designMode As Boolean = False)
Dim control As New GroupBox
Dim defaultSize = New Size(200, 100)
Dim metadata As New ClassControlMetadata()
metadata.Id = id
metadata.Name = name
control.Tag = metadata
control.Name = name
control.Parent = _master_panel
control.Text = Caption
'control.Font = New Font(fontfamily, fontsize, CType(fontstyle, FontStyle))
control.ForeColor = IntToColor(fontcolor)
control.BackColor = IntToColor(backcolor)
If _new And IsNothing(parent) Then
control.Location = Me.GetCursorPosition()
control.Size = defaultSize
ElseIf _new And Not IsNothing(parent) Then
Dim cursor = Me.GetCursorPosition()
control.Location = New Point(cursor.X - parent.Location.X,
cursor.Y - parent.Location.Y)
Else
control.Location = New Point(x, y)
control.Size = New Size(vwidth, vheight)
End If
If _designMode = True Then
control.Cursor = Cursors.Hand
End If
control.AllowDrop = True
Me.SetEventHandlers(control)
Me.SetDragDropHandler(control)
Me.CurrentControl = DirectCast(control, GroupBox)
If Not IsNothing(parent) Then
control.Parent = parent
Me.AddToGroupBox(parent, control)
Else
control.Parent = _master_panel
Me.AddToPanel(control)
End If
End Sub
Public Sub FunctionAddAppointment(id As Integer,
name As String,
text As String,
x As Integer,
y As Integer,
vwidth As Integer,
vheight As Integer,
_new As Boolean,
Optional parent As GroupBox = Nothing,
Optional _designMode As Boolean = False)
Try
Dim control As Button = New Button
Dim defaultSize As Size = New Size(200, 27)
Dim metadata As New ClassControlMetadata()
metadata.Id = id
metadata.Name = name
control.Tag = metadata
control.Name = name
control.Text = text
control.TabStop = False
control.Image = My.Resources.calendar_add
control.ImageAlign = ContentAlignment.MiddleRight
control.TextAlign = ContentAlignment.MiddleLeft
If _new And IsNothing(parent) Then
control.Location = Me.GetCursorPosition()
control.Size = defaultSize
ElseIf _new And Not IsNothing(parent) Then
Dim cursor = Me.GetCursorPosition()
control.Location = New Point(cursor.X - parent.Location.X,
cursor.Y - parent.Location.Y)
Else
control.Location = New Point(x, y)
control.Size = New Size(vwidth, vheight)
End If
If _designMode = True Then
control.Cursor = Cursors.Hand
End If
Me.SetEventHandlers(control)
Me.CurrentControl = DirectCast(control, Button)
If Not IsNothing(parent) Then
control.Parent = parent
Me.AddToGroupBox(parent, control)
Else
control.Parent = _master_panel
Me.AddToPanel(control)
End If
Catch ex As Exception
MsgBox("Error in FunctionAddAppointment: " + vbNewLine + ex.Message)
End Try
End Sub
Public Sub FunctionAddFormData(id As Integer,
name As String,
text As String,
x As Integer,
y As Integer,
vwidth As Integer,
vheight As Integer,
_new As Boolean,
Optional parent As GroupBox = Nothing,
Optional _designMode As Boolean = False)
Try
Dim control As Button = New Button
Dim defaultSize As Size = New Size(30, 21)
Dim metadata As New ClassControlMetadata()
metadata.Id = id
metadata.Name = name
control.Tag = metadata
control.Name = name
control.Text = ""
control.TabStop = False
control.Image = My.Resources.add1
If _new And IsNothing(parent) Then
control.Location = Me.GetCursorPosition()
control.Size = defaultSize
ElseIf _new And Not IsNothing(parent) Then
Dim cursor = Me.GetCursorPosition()
control.Location = New Point(cursor.X - parent.Location.X,
cursor.Y - parent.Location.Y)
Else
control.Location = New Point(x, y)
control.Size = New Size(vwidth, vheight)
End If
If _designMode = True Then
control.Cursor = Cursors.Hand
End If
Me.SetEventHandlers(control)
Me.CurrentControl = DirectCast(control, Button)
If Not IsNothing(parent) Then
control.Parent = parent
Me.AddToGroupBox(parent, control)
Else
control.Parent = _master_panel
Me.AddToPanel(control)
End If
Catch ex As Exception
MsgBox("Fehler: " + vbNewLine + ex.Message)
End Try
End Sub
Public Sub AddCheckedListBox(id As Integer,
name As String,
x As Integer,
y As Integer,
fontfamily As String,
fontcolor As Integer,
fontsize As Integer,
fontstyle As Integer,
tabindex As Integer,
tabstop As Boolean,
vwidth As Integer,
vheight As Integer,
_new As Boolean,
read_only As Boolean,
required As Boolean,
static_list As String,
sqlcommand As String,
Optional parent As GroupBox = Nothing,
Optional _designMode As Boolean = False)
Try
Dim control As New DevExpress.XtraEditors.CheckedListBoxControl
Dim defaultSize As Size = New Size(180, 140)
'control.CheckOnClick = True
' control.CheckStyle = DevExpress.XtraEditors.Controls.CheckStyles.Style3
Dim metadata As New ClassControlMetadata()
metadata.Id = id
metadata.Name = name
metadata.Required = required
control.Tag = metadata
control.Name = name
control.Font = New Font(fontfamily, fontsize, CType(fontstyle, FontStyle))
control.ForeColor = IntToColor(fontcolor)
control.TabIndex = tabindex
control.TabStop = tabstop
control.Parent = _master_panel
'Bei clicken checken
control.CheckOnClick = True
If Not _designMode And read_only Then
control.Enabled = Not read_only
End If
Dim ctx As New ContextMenuStrip()
Dim selectAll As New ToolStripMenuItem()
Dim deselectAll As New ToolStripMenuItem()
selectAll.Text = "Select all"
deselectAll.Text = "Deselect all"
AddHandler selectAll.Click, AddressOf selectAll_Click
AddHandler deselectAll.Click, AddressOf deselectAll_Click
ctx.Items.Add(selectAll)
ctx.Items.Add(deselectAll)
control.ContextMenuStrip = ctx
If _new And IsNothing(parent) Then
control.Location = Me.GetCursorPosition()
control.Size = defaultSize
ElseIf _new And Not IsNothing(parent) Then
Dim cursor = Me.GetCursorPosition()
control.Location = New Point(cursor.X - parent.Location.X,
cursor.Y - parent.Location.Y)
Else
control.Location = New Point(x, y)
control.Size = New Size(vwidth, vheight)
End If
'SQL-Command vorhanden?
If sqlcommand.Length > 1 Then
'Ja also überprüfen ob parametrisiert??
If Not sqlcommand.ToString.Contains("@") Then
'SQL-Command vorhanden also Ausführen des SQL
Dim DT_ListBox As DataTable = ClassDatabase.Return_Datatable(sqlcommand)
If DT_ListBox Is Nothing = False Then
If DT_ListBox.Rows.Count > 0 Then
control.DataSource = DT_ListBox
If DT_ListBox.Columns.Count = 1 Then
control.DisplayMember = DT_ListBox.Columns(0).ColumnName
control.ValueMember = DT_ListBox.Columns(0).ColumnName
Else
Try
control.ValueMember = DT_ListBox.Columns(0).ColumnName
control.DisplayMember = DT_ListBox.Columns(1).ColumnName
Catch ex As Exception
Dim colstring = ""
For Each Col As DataColumn In DT_ListBox.Columns
colstring = colstring & ";" & Col.ColumnName
Next
LOGGER.Warn("Error in Binding CheckedListBox: " & ex.Message & " - Columns: " & colstring)
control.DisplayMember = DT_ListBox.Columns(0).ColumnName
End Try
End If
End If
End If
End If
End If
' Wenn statische liste vorhanden, werte splitten und einfügen
If static_list.Length > 0 Then
Dim items() As String = static_list.Split(";")
For Each item As String In items
control.Items.Add(item)
Next
End If
Me.SetEventHandlers(control)
Me.CurrentControl = DirectCast(control, DevExpress.XtraEditors.CheckedListBoxControl)
If Not IsNothing(parent) Then
control.Parent = parent
Me.AddToGroupBox(parent, control)
Else
control.Parent = _master_panel
Me.AddToPanel(control)
End If
Catch ex As Exception
LOGGER.Warn("Unexpected Error in AddCheckedListBox: " & ex.Message)
MsgBox("Error in AddCheckedListBox: " + vbNewLine + ex.Message)
End Try
End Sub
Public Sub AddListBox(id As Integer,
name As String,
x As Integer,
y As Integer,
fontfamily As String,
fontcolor As Integer,
fontsize As Integer,
fontstyle As Integer,
tabindex As Integer,
tabstop As Boolean,
vwidth As Integer,
vheight As Integer,
_new As Boolean,
read_only As Boolean,
required As Boolean,
static_list As String,
sqlcommand As String,
Optional parent As GroupBox = Nothing,
Optional _designMode As Boolean = False)
Try
Dim control As New DevExpress.XtraEditors.ListBoxControl
Dim defaultSize As Size = New Size(180, 140)
'control.CheckOnClick = True
' control.CheckStyle = DevExpress.XtraEditors.Controls.CheckStyles.Style3
Dim metadata As New ClassControlMetadata()
metadata.Id = id
metadata.Name = name
metadata.Required = required
control.Tag = metadata
control.Name = name
control.Font = New Font(fontfamily, fontsize, CType(fontstyle, FontStyle))
control.ForeColor = IntToColor(fontcolor)
control.TabIndex = tabindex
control.TabStop = tabstop
control.Parent = _master_panel
If Not _designMode And read_only Then
control.Enabled = Not read_only
End If
If _new And IsNothing(parent) Then
control.Location = Me.GetCursorPosition()
control.Size = defaultSize
ElseIf _new And Not IsNothing(parent) Then
Dim cursor = Me.GetCursorPosition()
control.Location = New Point(cursor.X - parent.Location.X,
cursor.Y - parent.Location.Y)
Else
control.Location = New Point(x, y)
control.Size = New Size(vwidth, vheight)
End If
'SQL-Command vorhanden also Ausführen des SQL
If sqlcommand.Length > 1 Then
If Not sqlcommand.ToString.Contains("@") Then
'SQL-Command vorhanden also Ausführen des SQL
Dim DT_ListBox As DataTable = ClassDatabase.Return_Datatable(sqlcommand)
If DT_ListBox Is Nothing = False Then
If DT_ListBox.Rows.Count > 0 Then
control.DataSource = DT_ListBox
control.DisplayMember = DT_ListBox.Columns(1).ColumnName
control.ValueMember = DT_ListBox.Columns(0).ColumnName
End If
End If
End If
End If
' Wenn statische liste vorhanden, werte splitten und einfügen
If static_list.Length > 0 Then
Dim items() As String = static_list.Split(";")
For Each item As String In items
control.Items.Add(item)
Next
End If
Me.SetEventHandlers(control)
Me.CurrentControl = DirectCast(control, DevExpress.XtraEditors.ListBoxControl)
If Not IsNothing(parent) Then
control.Parent = parent
Me.AddToGroupBox(parent, control)
Else
control.Parent = _master_panel
Me.AddToPanel(control)
End If
Catch ex As Exception
MsgBox("Error in AddListBox: " + vbNewLine + ex.Message)
End Try
End Sub
Public Class LineLabel
Inherits Label
End Class
End Class