Monorepo/GUIs.ZooFlow/ClassControlCreator.vb
2022-04-28 15:02:31 +02:00

415 lines
15 KiB
VB.net

Imports DevExpress.XtraEditors
Imports DevExpress.XtraGrid
Imports DevExpress.XtraGrid.Views.Grid
Imports DevExpress.XtraTab
Imports DigitalData.Modules.Logging
Imports DigitalData.Modules.Language
Public Class ClassControlCreator
Private Const DEFAULT_TEXT = "Bezeichnung definieren"
Private Const DEFAULT_FONT_SIZE As Integer = 10
Private Const DEFAULT_FONT_FAMILY As String = "Arial"
Private Const DEFAULT_FONT_STYLE As FontStyle = FontStyle.Regular
Private Const DEFAULT_COLOR As Integer = 0
Private Const DEFAULT_WIDTH As Integer = 170
Private Const DEFAULT_HEIGHT As Integer = 20
Private Const DEFAULT_WIDTH_GRIDVIEW As Integer = 150
Private Const DEFAULT_HEIGHT_GRIDVIEW As Integer = 150
Public Const PREFIX_TEXTBOX = "TXT"
Public Const PREFIX_LABEL = "LBL"
Public Const PREFIX_CHECKBOX = "CHK"
Public Const PREFIX_COMBOBOX = "CMB"
Public Const PREFIX_DATETIMEPICKER = "DTP"
Public Const PREFIX_DATAGRIDVIEW = "DGV"
Public Const PREFIX_LOOKUP = "LU"
Public Const PREFIX_GRIDCONTROL = "GRID"
Public Const PREFIX_LINE = "LINE"
Public Const PREFIX_BUTTON = "BTN"
Public Shared GridTables As New Dictionary(Of String, DataTable)
Private Logger As Logger
Private Property Form As frmSearchStart
Private Property TabPage As XtraTabPage
Public Class ControlMeta
Public Property IndexName As String
Public Property IndexType As String
Public Property MultipleValues As Boolean = False
End Class
''' <summary>
''' Standard Eigenschaften für alle Controls
''' </summary>
Private Class ControlDBProps
Public Guid As Integer
Public Name As String
Public Location As Point
Public [Font] As Font
Public [Color] As Color
End Class
Public Class ControlMetadata
Public Guid As Integer
Public AttributeID As Integer
Public DependingAttributeID As Integer
Public Multiselect As Boolean
Public AttributeTitle As String
Public AttributeType As String
Public SourceSQL As String
Public DTSource As DataTable
Public MinValue As String
Public MaxValue As String
End Class
Private Shared Function TransformDataRow(pRow As DataRow, pXPosition As Integer, pYPosition As Integer) As ControlDBProps
Dim oxPos As Integer = pXPosition
Dim oYPos As Integer = pYPosition
Dim oGuid As Integer = pRow.Item("GUID")
Dim oName As String = pRow.Item("ATTRIBUTE_TITLE")
Dim oLocation As New Point(oxPos, oYPos)
Return New ControlDBProps() With {
.Guid = oGuid,
.Name = oName,
.Location = oLocation
}
End Function
Public Function CreateBaseControl(pControl As Control, pAttributeRow As DataRow, pXPosition As Integer, pYPosition As Integer) As Control
Try
Dim props As ControlDBProps = TransformDataRow(pAttributeRow, pXPosition, pYPosition)
Dim oSourceSQL As String = pAttributeRow.Item("SOURCE_SQL").ToString
oSourceSQL = oSourceSQL.Replace("@USER_LANGUAGE", My.Application.User.Language)
oSourceSQL = oSourceSQL.Replace("@pUSER_ID", My.Application.User.UserId)
oSourceSQL = oSourceSQL.Replace("@RESULT_TITLE", pAttributeRow.Item("ATTRIBUTE_TITLE").ToString)
'oSourceSQL = oSourceSQL & " ORDER BY T.TERM_VALUE"
Dim oDTSource As DataTable
'If pAttributeRow.Item("DEPENDING_ATTRIBUTE1") = 0 Then
If Utils.NotNull(oSourceSQL, String.Empty) <> String.Empty Then
oDTSource = My.DatabaseIDB.GetDatatable(oSourceSQL)
End If
'End If
Dim oMinValue As String = ""
Dim oMaxValue As String = ""
If Not IsNothing(oDTSource) Then
oDTSource.DefaultView.Sort = pAttributeRow.Item("ATTRIBUTE_TITLE").ToString '"ColumnName ASC"
oDTSource = oDTSource.DefaultView.ToTable
oMinValue = oDTSource.Rows(0).Item(0)
oMaxValue = oDTSource.Rows(oDTSource.Rows.Count - 1).Item(0)
End If
Dim oMetadata = New ControlMetadata() With {
.Guid = CType(pAttributeRow.Item("GUID"), Integer),
.AttributeID = CType(pAttributeRow.Item("ATTRIBUTE_ID"), Integer),
.DTSource = CType(oDTSource, DataTable),
.AttributeTitle = CType(pAttributeRow.Item("ATTRIBUTE_TITLE"), String),
.Multiselect = CType(pAttributeRow.Item("MULTISELECT"), Boolean),
.SourceSQL = oSourceSQL,
.MinValue = oMinValue,
.MaxValue = oMaxValue
}
pControl.Tag = oMetadata
pControl.Name = props.Name
pControl.Location = props.Location
pControl.Font = props.Font
pControl.ForeColor = props.Color
Return pControl
Catch ex As Exception
Logger.Error(ex)
End Try
End Function
Public Sub New(pTabPage As XtraTabPage, pForm As frmSearchStart)
Me.Form = pForm
Me.TabPage = pTabPage
Logger = My.LogConfig.GetLogger()
End Sub
Public Function CreateExistingCheckbox(pAttributeRow As DataRow, pXPosition As Integer, pYPosition As Integer) As CheckBox
Dim oCheckBox As CheckBox = CType(CreateBaseControl(New CheckBox(), pAttributeRow, pXPosition, pYPosition), CheckBox)
oCheckBox.AutoSize = True
Try
oCheckBox.Text = pAttributeRow.Item("ATTRIBUTE_TITLE").ToString
Catch ex As Exception
oCheckBox.Text = "NO CAPTION AVAILABLE"
End Try
oCheckBox.CheckState = CheckState.Indeterminate
Return oCheckBox
End Function
Public Function CreateExistingDatepicker(pAttributeRow As DataRow, pXPosition As Integer, pYPosition As Integer) As DateEdit
Dim oDateControl As DateEdit = CType(CreateBaseControl(New DateEdit(), pAttributeRow, pXPosition, pYPosition), DateEdit)
oDateControl.Size = New Size(100, 20)
oDateControl.Properties.HighlightTodayCell = True
oDateControl.Properties.ShowWeekNumbers = True
oDateControl.Properties.ShowClear = True
Try
Dim oMinDate As Date = DirectCast(oDateControl.Tag, ControlMetadata).MinValue
oDateControl.Properties.MinValue = oMinDate
Catch ex As Exception
End Try
Try
Dim oMaxDate As Date = DirectCast(oDateControl.Tag, ControlMetadata).MaxValue
oDateControl.Properties.MaxValue = oMaxDate
Catch ex As Exception
End Try
Return oDateControl
End Function
Public Function CreateExistingGridControl(pAttributeRow As DataRow, pXPosition As Integer, pYPosition As Integer) As GridControl
Dim oWatch1 As New Watch("Creating Base Control")
Dim oMyNewGridControl As GridControl = CreateBaseControl(New GridControl(), pAttributeRow, pXPosition, pYPosition)
Dim oDatatable As New DataTable
Dim oView As GridView
oWatch1.Stop()
oWatch1 = New Watch("Configuring Grid")
oMyNewGridControl.ForceInitialize()
oMyNewGridControl.ContextMenu = Nothing
oMyNewGridControl.Size = New Size(CInt(pAttributeRow.Item("WIDTH")), DEFAULT_HEIGHT_GRIDVIEW)
'oMyNewGridControl.Size = New Size(CInt(pAttributeRow.Item("WIDTH")), CInt(pAttributeRow.Item("HEIGHT")))
oView = CType(oMyNewGridControl.MainView, GridView)
oView.Appearance.EvenRow.BackColor = Color.WhiteSmoke ' Color.FromArgb(255, 214, 49)
oView.OptionsBehavior.Editable = False
oView.OptionsBehavior.ReadOnly = True
oView.OptionsBehavior.AllowAddRows = DevExpress.Utils.DefaultBoolean.False
oView.OptionsBehavior.AllowDeleteRows = DevExpress.Utils.DefaultBoolean.False
oView.OptionsView.NewItemRowPosition = NewItemRowPosition.None
oView.OptionsView.ShowAutoFilterRow = True
oView.OptionsView.EnableAppearanceEvenRow = True
oView.OptionsView.ShowGroupPanel = False
If CType(pAttributeRow.Item("MULTISELECT"), Boolean) Then
oView.OptionsSelection.MultiSelect = True
oView.OptionsSelection.MultiSelectMode = GridMultiSelectMode.CheckBoxRowSelect
oView.OptionsSelection.CheckBoxSelectorColumnWidth = 20
oMyNewGridControl.Size = New Size(CInt(pAttributeRow.Item("WIDTH") + 50), DEFAULT_HEIGHT_GRIDVIEW)
End If
oWatch1.Stop()
oWatch1 = New Watch("Loading Datasource")
' Add and configure navigator to delete rows
'oMyNewGridControl.UseEmbeddedNavigator = True
'With oMyNewGridControl.EmbeddedNavigator.Buttons
' .CancelEdit.Visible = False
' .Edit.Visible = False
' .EndEdit.Visible = False
' .First.Visible = False
' .Last.Visible = False
' .Next.Visible = False
' .NextPage.Visible = False
' .PrevPage.Visible = False
' .Prev.Visible = False
'End With
GridTables.Clear()
Dim oDTSource As DataTable = DirectCast(oMyNewGridControl.Tag, ControlMetadata).DTSource
oMyNewGridControl.DataSource = oDTSource
oView.PopulateColumns()
oView.FocusInvalidRow()
'oMyNewGridControl.RefreshDataSource()
'oMyNewGridControl.ForceInitialize()
oWatch1.Stop()
Return oMyNewGridControl
End Function
Public Sub DeselectGridControl(BaseControl As Control)
Try
DirectCast(DirectCast(BaseControl, GridControl).MainView, GridView).FocusInvalidRow()
Catch ex As Exception
Logger.Error(ex)
End Try
End Sub
Public Function AddCheckBox(pIndexname As String, y As Integer, pVorbelegung As String, pCaption As String) As CheckBox
Try
Dim oValue As Boolean = False
Dim oCheckbox As New CheckBox With {
.Name = "chk" & pIndexname,
.Size = New Size(100, 27),
.Location = New Point(11, y),
.Tag = New ControlMeta() With {
.IndexName = pIndexname,
.IndexType = "BOOLEAN"
}
}
If pCaption <> "" Then
oCheckbox.Text = pCaption
oCheckbox.Size = New Size(CInt(pCaption.Length * 15), 27)
End If
If Boolean.TryParse(pVorbelegung, oValue) = False Then
If pVorbelegung = "1" Or pVorbelegung = "0" Then
oCheckbox.Checked = CBool(pVorbelegung)
Else
oCheckbox.Checked = False
End If
Else
oCheckbox.Checked = oValue
End If
AddHandler oCheckbox.CheckedChanged, AddressOf Checkbox_CheckedChanged
Return oCheckbox
Catch ex As Exception
Logger.Info("Unhandled Exception in AddCheckBox: " & ex.Message)
Logger.Error(ex.Message)
Return Nothing
End Try
End Function
Public Sub Checkbox_CheckedChanged(sender As CheckBox, e As EventArgs)
'PrepareDependingControl(sender)
End Sub
Function AddCombobox(indexname As String, y As Integer) As ComboBoxEdit
Dim oCombobox As New ComboBoxEdit
oCombobox.Name = "cmb" & indexname
oCombobox.AutoSize = True
oCombobox.Size = New Size(300, 27)
oCombobox.Location = New Point(11, y)
oCombobox.Tag = New ControlMeta() With {
.IndexName = indexname
}
AddHandler oCombobox.SelectedIndexChanged, AddressOf OncmbSIndexChanged
AddHandler oCombobox.GotFocus, AddressOf OncmbGotFocus
AddHandler oCombobox.LostFocus, AddressOf OncmbLostFocus
Return oCombobox
End Function
Public Sub OncmbGotFocus(sender As Object, e As System.EventArgs)
Dim oCombobox As ComboBoxEdit = CType(sender, ComboBoxEdit)
oCombobox.BackColor = Color.Lime
End Sub
Public Sub OncmbLostFocus(sender As Object, e As System.EventArgs)
Dim oCombobox As ComboBoxEdit = CType(sender, ComboBoxEdit)
oCombobox.BackColor = Color.White
End Sub
Public Sub OncmbSIndexChanged(sender As System.Object, e As System.EventArgs)
If Form.DataLoaded = False Then
Exit Sub
End If
Dim oCombobox As ComboBoxEdit = CType(sender, ComboBoxEdit)
If oCombobox.SelectedIndex <> -1 Then
If oCombobox.Text.Length > 15 Then
Dim g As Graphics = oCombobox.CreateGraphics
oCombobox.Width = CInt(g.MeasureString(oCombobox.Text, oCombobox.Font).Width + 30)
g.Dispose()
End If
SendKeys.Send("{TAB}")
End If
End Sub
Public Function AddTextBox(pAttrName As String, y As Integer, text As String, pAttrDataType As String) As DevExpress.XtraEditors.TextEdit
Dim oEdit As New TextEdit With {
.Name = "txt" & pAttrName,
.Size = New Size(260, 27),
.Location = New Point(11, y),
.Tag = New ControlMeta() With {
.IndexName = pAttrName,
.IndexType = pAttrDataType
}
}
Select Case pAttrDataType
Case "INTEGER"
oEdit.Properties.Mask.MaskType = Mask.MaskType.Numeric
oEdit.Properties.Mask.EditMask = "d"
Console.WriteLine()
End Select
If text IsNot Nothing Then
oEdit.Text = text
oEdit.SelectAll()
End If
AddHandler oEdit.GotFocus, AddressOf OnTextBoxFocus
AddHandler oEdit.LostFocus, AddressOf OnTextBoxLostFocus
AddHandler oEdit.KeyUp, AddressOf OnTextBoxKeyUp
AddHandler oEdit.TextChanged, AddressOf OnTextBoxTextChanged
Return oEdit
End Function
Public Sub OnTextBoxFocus(sender As Object, e As EventArgs)
Dim oTextbox As TextEdit = CType(sender, TextEdit)
oTextbox.BackColor = Color.Lime
oTextbox.SelectAll()
End Sub
Public Sub OnTextBoxTextChanged(sender As Object, e As EventArgs)
Dim oTextbox As TextEdit = CType(sender, TextEdit)
Using oGraphics As Graphics = oTextbox.CreateGraphics()
oTextbox.Width = CInt(oGraphics.MeasureString(oTextbox.Text, oTextbox.Font).Width + 15)
End Using
End Sub
Public Sub OnTextBoxLostFocus(sender As Object, e As EventArgs)
Dim oTextbox As TextEdit = CType(sender, TextEdit)
oTextbox.BackColor = Color.White
End Sub
Public Sub OnTextBoxKeyUp(sender As Object, e As KeyEventArgs)
Dim oTextbox As TextEdit = CType(sender, TextEdit)
If oTextbox.Text = String.Empty Then
Exit Sub
End If
If e.KeyCode = Keys.Return Or e.KeyCode = Keys.Enter Or e.KeyCode = Keys.Tab Then
'PrepareDependingControl(oTextbox)
End If
If (e.KeyCode = Keys.Return) Then
SendKeys.Send("{TAB}")
End If
End Sub
Public Function AddDateTimePicker(indexname As String, y As Integer, DataType As String) As DateEdit
Dim oPicker As New DateEdit With {
.Name = "dtp" & indexname,
.Size = New Size(260, 27),
.Location = New Point(11, y),
.Tag = New ControlMeta() With {
.IndexName = indexname,
.IndexType = DataType
}
}
oPicker.Properties.AppearanceFocused.BackColor = Color.Lime
Return oPicker
End Function
End Class