AppStd/Modules
8
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

ZooFlow: Improvements and Performance for frmSearchStart

Browse Source
This commit is contained in:
Jonathan Jenne
2020-11-20 16:09:29 +01:00
parent baa914d153
commit d0e4ecb4ed
9 changed files with 394 additions and 621 deletions
Download Patch File Download Diff File Expand all files Collapse all files

625
GUIs.ZooFlow/ClassControlCreator.vb
View File

@@ -1,9 +1,9 @@
Imports DevExpress.XtraEditors
Imports DevExpress.XtraGrid
Imports DevExpress.XtraGrid.Views.Base
Imports DevExpress.XtraGrid.Views.Grid
Imports DevExpress.XtraTab
Imports DigitalData.Modules.Logging
Imports DigitalData.Modules.Language
Public Class ClassControlCreator
@@ -54,41 +54,30 @@ Public Class ClassControlCreator
Public Class ControlMetadata
Public Guid As Integer
Public AttrID As Integer
Public DependingAttrID As Integer
Public AttributeID As Integer
Public DependingAttributeID As Integer
Public Multiselect As Boolean
Public AttrTitle As String
Public AttrType As String
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(row As DataRow, pXPosition As Integer, pYPosition As Integer) As ControlDBProps
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 style As FontStyle = NotNull(row.Item("FONT_STYLE"), DEFAULT_FONT_STYLE)
' Dim size As Single = NotNull(row.Item("FONT_SIZE"), DEFAULT_FONT_SIZE)
' Dim familyString As String = NotNull(row.Item("FONT_FAMILY"), DEFAULT_FONT_FAMILY)
'Dim family As FontFamily = New FontFamily(familyString)
Dim oGuid As Integer = row.Item("GUID")
Dim oName As String = row.Item("ATTRIBUTE_TITLE")
Dim oGuid As Integer = pRow.Item("GUID")
Dim oName As String = pRow.Item("ATTRIBUTE_TITLE")
Dim oLocation As New Point(oxPos, oYPos)
'Dim oFont As New Font(family, size, style, GraphicsUnit.Point)
'Dim oColor As Color = IntToColor(NotNull(row.Item("FONT_COLOR"), DEFAULT_COLOR))
'Dim oReadOnly As Boolean = row.Item("READ_ONLY")
Return New ControlDBProps() With {
.Guid = oGuid,
.Name = oName,
.Location = oLocation}
'.Font = oFont,
'.Color = oColor
.Location = oLocation
}
End Function
Public Function CreateBaseControl(ctrl As Control, pAttributeRow As DataRow, pXPosition As Integer, pYPosition As Integer) As Control
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
@@ -97,39 +86,38 @@ Public Class ClassControlCreator
oSourceSQL = oSourceSQL.Replace("@RESULT_TITLE", pAttributeRow.Item("ATTRIBUTE_TITLE").ToString)
Dim oDTSource As DataTable
'If pAttributeRow.Item("DEPENDING_ATTRIBUTE1") = 0 Then
oDTSource = My.DatabaseIDB.GetDatatable(oSourceSQL)
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
oMinValue = oDTSource.Rows(0).Item(0)
oMaxValue = oDTSource.Rows(oDTSource.Rows.Count - 1).Item(0)
End If
'ctrl.Tag = New ControlMetadata() With {
Dim omyclass = New ControlMetadata() With {
Dim oMetadata = New ControlMetadata() With {
.Guid = CType(pAttributeRow.Item("GUID"), Integer),
.AttrID = CType(pAttributeRow.Item("ATTRIBUTE_ID"), Integer),
.AttributeID = CType(pAttributeRow.Item("ATTRIBUTE_ID"), Integer),
.DTSource = CType(oDTSource, DataTable),
.AttrTitle = CType(pAttributeRow.Item("ATTRIBUTE_TITLE"), String),
.AttributeTitle = CType(pAttributeRow.Item("ATTRIBUTE_TITLE"), String),
.Multiselect = CType(pAttributeRow.Item("MULTISELECT"), Boolean),
.SourceSQL = oSourceSQL,
.MinValue = oMinValue,
.MaxValue = oMaxValue
}
' If CInt(pAttributeRow.Item("DEPENDING_ATTRIBUTE1")) <> 0 Then
' omyclass.DTSource = Nothing
'' Else
' omyclass.DTSource = CType(oDTSource, DataTable)
' End If
ctrl.Tag = omyclass
ctrl.Name = props.Name
ctrl.Location = props.Location
ctrl.Font = props.Font
ctrl.ForeColor = props.Color
pControl.Tag = oMetadata
pControl.Name = props.Name
pControl.Location = props.Location
pControl.Font = props.Font
pControl.ForeColor = props.Color
Return ctrl
Return pControl
Catch ex As Exception
Logger.Error(ex)
End Try
@@ -147,7 +135,7 @@ Public Class ClassControlCreator
oCheckBox.AutoSize = True
Try
oCheckBox.Text = pAttributeRow.Item("ATTRIBUTE_TITLE")
oCheckBox.Text = pAttributeRow.Item("ATTRIBUTE_TITLE").ToString
Catch ex As Exception
oCheckBox.Text = "NO CAPTION AVAILABLE"
End Try
@@ -163,13 +151,13 @@ Public Class ClassControlCreator
oDateControl.Properties.ShowWeekNumbers = True
oDateControl.Properties.ShowClear = True
Try
Dim oMinDate As Date = DirectCast(oDateControl.Tag, ClassControlCreator.ControlMetadata).MinValue
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, ClassControlCreator.ControlMetadata).MaxValue
Dim oMaxDate As Date = DirectCast(oDateControl.Tag, ControlMetadata).MaxValue
oDateControl.Properties.MaxValue = oMaxDate
Catch ex As Exception
@@ -178,187 +166,103 @@ Public Class ClassControlCreator
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 DevExpress.XtraGrid.Views.Grid.GridView
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.OptionsView.ShowGroupPanel = False
oMyNewGridControl.ContextMenu = Nothing
oView.Appearance.EvenRow.BackColor = Color.PaleTurquoise
oView.OptionsBehavior.Editable = False
oView.OptionsBehavior.ReadOnly = True
oView.OptionsBehavior.AllowAddRows = False
oView.OptionsBehavior.AllowDeleteRows = False
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
oMyNewGridControl.Size = New Size(CInt(pAttributeRow.Item("WIDTH")), CInt(pAttributeRow.Item("HEIGHT")))
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), CInt(pAttributeRow.Item("HEIGHT")))
oMyNewGridControl.Size = New Size(CInt(pAttributeRow.Item("WIDTH") + 50), DEFAULT_HEIGHT_GRIDVIEW)
End If
'oView.Columns("TERM_ID").Visible = False
' 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
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 oColumn = New DataColumn() With {
' .DataType = GetType(String),
' .ColumnName = pAttributeRow.Item("ATTRIBUTE_TITLE").ToString,
' .Caption = pAttributeRow.Item("ATTRIBUTE_TITLE").ToString,
' .ReadOnly = False
' }
'oDatatable.Columns.Add(oColumn)
'For Each oRow As DataRow In DT_MY_COLUMNS.Rows
' ' Create Columns in Datatable
' Dim oColumn = New DataColumn() With {
' .DataType = GetType(String),
' .ColumnName = pAttributeRow.Item("ATTRIBUTE_TITLE").ToString,
' .Caption = pAttributeRow.Item("ATTRIBUTE_TITLE").ToString,
' .ReadOnly = False
' }
' oDatatable.Columns.Add(oColumn)
' ' Fetch and cache Combobox results
' Dim oConnectionId As Integer = NotNull(oRow.Item("CONNECTION_ID"), 0)
' Dim oSqlCommand As String = NotNull(oRow.Item("SQL_COMMAND"), "")
' If Not clsPatterns.HasComplexPatterns(oSqlCommand) Then
' If oConnectionId > 0 And oSqlCommand <> "" Then
' Try
' Dim oComboboxDataTable As DataTable = ClassDatabase.Return_Datatable_ConId(oSqlCommand, oConnectionId)
' GridTables.Add(oRow.Item("SPALTENNAME"), oComboboxDataTable)
' Catch ex As Exception
' Logger.Warn("Could not load data for column {0} in control {1}", oRow.Item("SPALTENNAME"), oControl.Name)
' Logger.Error(ex)
' End Try
' End If
' End If
'Next
Dim oDTSource As DataTable = DirectCast(oMyNewGridControl.Tag, ClassControlCreator.ControlMetadata).DTSource
Dim oDTSource As DataTable = DirectCast(oMyNewGridControl.Tag, ControlMetadata).DTSource
oMyNewGridControl.DataSource = oDTSource
oView.PopulateColumns()
oMyNewGridControl.RefreshDataSource()
oMyNewGridControl.ForceInitialize()
'Try
' oView.Columns(0).Caption = "Existierende Werte"
'Catch ex As Exception
'End Try
'AddHandler oView.CustomRowCellEdit, Sub(sender As Object, e As CustomRowCellEditEventArgs)
' For Each oRow As DataRow In DT_MY_COLUMNS.Rows
' If oRow.Item("SPALTENNAME") = e.Column.FieldName Then
' If GridTables.ContainsKey(e.Column.FieldName) Then
' Dim oComboboxDataTable As DataTable = GridTables.Item(e.Column.FieldName)
' Dim oEditor As New RepositoryItemComboBox()
' Dim oItems As New List(Of String)
' AddHandler oEditor.Validating, Sub(_sender As ComboBoxEdit, _e As CancelEventArgs)
' If oItems.Contains(_sender.EditValue) Then
' _e.Cancel = False
' Else
' _e.Cancel = True
' End If
' End Sub
' For Each oRow2 As DataRow In oComboboxDataTable.Rows
' Dim oValue = oRow2.Item(0)
' Try
' oValue &= $" | {oRow2.Item(1)}"
' Catch ex As Exception
' End Try
' oEditor.Items.Add(oValue)
' oItems.Add(oValue)
' Next
' e.RepositoryItem = oEditor
' End If
' End If
' Next
' End Sub
'AddHandler oView.CellValueChanged, Sub(sender As Object, e As CellValueChangedEventArgs)
' Dim oValue = e.Value.ToString()
' Dim oView2 As GridView = TryCast(sender, GridView)
' If oValue.Contains(" | ") Then
' oValue = oValue.Split(" | ").ToList().Item(0)
' oView2.SetRowCellValue(e.RowHandle, e.Column, oValue)
' End If
' End Sub
oWatch1.Stop()
Return oMyNewGridControl
End Function
Public Function AddCheckBox(indexname As String, y As Integer, vorbelegung As String, caption As String)
Public Function AddCheckBox(pIndexname As String, y As Integer, pVorbelegung As String, pCaption As String) As CheckBox
Try
Dim value As Boolean = False
Dim chk As New CheckBox
chk.Name = "chk" & indexname
chk.Size = New Size(100, 27)
chk.Location = New Point(11, y)
chk.Tag = New ControlMeta() With {
.IndexName = indexname,
.IndexType = "BOOLEAN"
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 caption <> "" Then
chk.Text = caption
chk.Size = New Size(CInt(caption.Length * 15), 27)
If pCaption <> "" Then
oCheckbox.Text = pCaption
oCheckbox.Size = New Size(CInt(pCaption.Length * 15), 27)
End If
If Boolean.TryParse(vorbelegung, value) = False Then
If vorbelegung = "1" Or vorbelegung = "0" Then
chk.Checked = CBool(vorbelegung)
If Boolean.TryParse(pVorbelegung, oValue) = False Then
If pVorbelegung = "1" Or pVorbelegung = "0" Then
oCheckbox.Checked = CBool(pVorbelegung)
Else
chk.Checked = False
oCheckbox.Checked = False
End If
Else
chk.Checked = value
oCheckbox.Checked = oValue
End If
AddHandler chk.CheckedChanged, AddressOf Checkbox_CheckedChanged
AddHandler oCheckbox.CheckedChanged, AddressOf Checkbox_CheckedChanged
Return chk
Return oCheckbox
Catch ex As Exception
Logger.Info("Unhandled Exception in AddCheckBox: " & ex.Message)
Logger.Error(ex.Message)
@@ -370,107 +274,32 @@ Public Class ClassControlCreator
'PrepareDependingControl(sender)
End Sub
'Public Function AddVorschlag_ComboBox(indexname As String, y As Integer, conid As Integer, sql_Vorschlag As String, Multiselect As Boolean, DataType As String, Optional Vorgabe As String = "", Optional AddNewValues As Boolean = False, Optional PreventDuplicateValues As Boolean = False, Optional SQLSuggestion As Boolean = False) As Control
' Try
' Dim oSql As String = sql_Vorschlag
' Dim oConnectionString As String
' Dim oControl As New DigitalData.Controls.LookupGrid.LookupControl2 With {
' .Multiselect = Multiselect,
' .AllowAddNewValues = AddNewValues,
' .PreventDuplicates = PreventDuplicateValues,
' .Location = New Point(11, y),
' .Size = New Size(300, 27),
' .Name = "cmbMulti" & indexname,
' .Tag = New ControlMeta() With {
' .IndexName = indexname,
' .IndexType = DataType
' }
' }
' oControl.Properties.AppearanceFocused.BackColor = Color.Lime
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)
' If Not String.IsNullOrEmpty(Vorgabe) Then
' Dim oDefaultValues As New List(Of String)
' If Vorgabe.Contains(",") Then
' oDefaultValues = Vorgabe.
' Split(",").ToList().
' Select(Function(item) item.Trim()).
' ToList()
' Else
' oDefaultValues = Vorgabe.
' Split(ClassConstants.VECTORSEPARATOR).ToList().
' Select(Function(item) item.Trim()).
' ToList()
' End If
' oControl.SelectedValues = oDefaultValues
' End If
' AddHandler oControl.SelectedValuesChanged, AddressOf Lookup_SelectedValuesChanged
' oConnectionString = ClassFormFunctions.GetConnectionString(conid)
' If oConnectionString IsNot Nothing And oSql.Length > 0 And SQLSuggestion = True Then
' Logger.Debug("Connection String (redacted): [{0}]", oConnectionString.Substring(0, 30))
' If ClassPatterns.HasComplexPatterns(oSql) Then
' Logger.Debug(" >>sql enthält Platzhalter und wird erst während der Laufzeit gefüllt!", False)
' Else
' Dim oDatatable = ClassDatabase.Return_Datatable_Combined(oSql, oConnectionString, False)
' oControl.DataSource = oDatatable
' End If
' Else
' Logger.Warn("Connection String for control [{0}] is empty!", oControl.Name)
' End If
' Return oControl
' Catch ex As Exception
' Logger.Info(" - Unvorhergesehener Unexpected error in AddVorschlag_ComboBox - Indexname: " & indexname & " - Fehler: " & vbNewLine & ex.Message)
' Logger.Error(ex.Message)
' MsgBox(ex.Message, MsgBoxStyle.Critical, "Unvorhergesehener Unexpected error in AddVorschlag_ComboBox:")
' Return Nothing
' End Try
'End Function
'Private Sub Lookup_SelectedValuesChanged(sender As LookupControl2, SelectedValues As List(Of String))
' PrepareDependingControl(sender)
'End Sub
Function AddCombobox(indexname As String, y As Integer)
Dim cmb As New ComboBox
cmb.Name = "cmb" & indexname
cmb.AutoSize = True
cmb.Size = New Size(300, 27)
cmb.Location = New Point(11, y)
cmb.Tag = New ControlMeta() With {
oCombobox.Tag = New ControlMeta() With {
.IndexName = indexname
}
AddHandler cmb.SelectedIndexChanged, AddressOf OncmbSIndexChanged
AddHandler cmb.GotFocus, AddressOf OncmbGotFocus
AddHandler cmb.LostFocus, AddressOf OncmbLostFocus
'AddHandler cmb.KeyDown, AddressOf OncmbKeyDown
Return cmb
AddHandler oCombobox.SelectedIndexChanged, AddressOf OncmbSIndexChanged
AddHandler oCombobox.GotFocus, AddressOf OncmbGotFocus
AddHandler oCombobox.LostFocus, AddressOf OncmbLostFocus
Return oCombobox
End Function
'Public Sub OncmbKeyDown(sender As System.Object, e As System.EventArgs)
' Dim cmb As ComboBox = sender
' ' Verhindert, dass Auswahlliste und Autocompleteliste übereinander liegen
' If cmb.DroppedDown = True Then
' cmb.DroppedDown = False
' End If
'End Sub
Public Sub OncmbGotFocus(sender As System.Object, e As System.EventArgs)
Dim cmb As ComboBox = sender
cmb.BackColor = Color.Lime
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 System.Object, e As System.EventArgs)
Dim cmb As ComboBox = sender
cmb.BackColor = Color.White
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)
@@ -478,139 +307,20 @@ Public Class ClassControlCreator
Exit Sub
End If
Dim cmb As ComboBox = sender
If cmb.SelectedIndex <> -1 Then
If cmb.Text.Length > 15 Then
Dim g As Graphics = cmb.CreateGraphics
cmb.Width = g.MeasureString(cmb.Text, cmb.Font).Width + 30
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
' Get_NextComboBoxResults(cmb)
SendKeys.Send("{TAB}")
End If
End Sub
'Private Sub Get_NextComboBoxResults(cmb As ComboBox)
' Try
' Dim indexname = cmb.Name.Replace("cmb", "")
' Dim sql = "SELECT GUID,NAME,SQL_RESULT FROM TBDD_INDEX_MAN where SUGGESTION = 1 AND SQL_RESULT like '%@" & indexname & "%' and DOK_ID = " & CURRENT_DOKART_ID & " ORDER BY SEQUENCE"
' Dim DT As DataTable = ClassDatabase.Return_Datatable(sql, True)
' If Not IsNothing(DT) Then
' If DT.Rows.Count > 0 Then
' Dim cmbname = "cmb" & DT.Rows(0).Item("NAME")
' Renew_ComboboxResults(DT.Rows(0).Item("GUID"), indexname, cmb.Text)
' End If
' End If
' Catch ex As Exception
' MsgBox("Error in Get_NextComboBoxResults:" & vbNewLine & ex.Message, MsgBoxStyle.Critical)
' End Try
'End Sub
'Private Sub Renew_ComboboxResults(INDEX_GUID As Integer, SearchString As String, Resultvalue As String)
' Try
' Dim connectionString As String
' Dim sqlCnn As SqlConnection
' Dim sqlCmd As SqlCommand
' Dim adapter As New SqlDataAdapter
' Dim oracleConn As OracleConnection
' Dim oracleCmd As OracleCommand
' Dim oracleadapter As New OracleDataAdapter
' Dim NewDataset As New DataSet
' Dim i As Integer
' Dim DT_INDEX As DataTable = ClassDatabase.Return_Datatable("select * FROM TBDD_INDEX_MAN WHERE GUID = " & INDEX_GUID, True)
' If IsNothing(DT_INDEX) Then
' Exit Sub
' End If
' Dim conid = DT_INDEX.Rows(0).Item("CONNECTION_ID")
' Dim sql_result = DT_INDEX.Rows(0).Item("SQL_RESULT")
' Dim NAME = DT_INDEX.Rows(0).Item("NAME")
' If Not IsNothing(conid) And Not IsNothing(sql_result) And Not IsNothing(NAME) Then
' For Each ctrl As Control In Me.Panel.Controls
' If ctrl.Name = "cmb" & NAME.ToString Then
' Dim cmb As ComboBox = ctrl
' Dim sql As String = sql_result.ToString.ToUpper.Replace("@" & SearchString.ToUpper, Resultvalue)
' connectionString = ClassFormFunctions.GetConnectionString(conid)
' If connectionString Is Nothing = False Then
' 'SQL Befehl füllt die Auswahlliste
' If connectionString.Contains("Initial Catalog=") Then
' sqlCnn = New SqlConnection(connectionString)
' sqlCnn.Open()
' sqlCmd = New SqlCommand(sql, sqlCnn)
' adapter.SelectCommand = sqlCmd
' adapter.Fill(NewDataset)
' ElseIf connectionString.StartsWith("Data Source=") And connectionString.Contains("SERVICE_NAME") Then
' oracleConn = New OracleConnection(connectionString)
' ' Try
' oracleConn.Open()
' oracleCmd = New OracleCommand(sql, oracleConn)
' oracleadapter.SelectCommand = oracleCmd
' oracleadapter.Fill(NewDataset)
' End If
' If NewDataset.Tables(0).Rows.Count > 0 Then
' cmb.Items.Clear()
' 'Die Standargrösse definieren
' Dim newWidth As Integer = 300
' For i = 0 To NewDataset.Tables(0).Rows.Count - 1
' 'MsgBox(NewDataset.Tables(0).Rows(i).Item(0))
' cmb.Items.Add(NewDataset.Tables(0).Rows(i).Item(0))
' Try
' Dim text As String = NewDataset.Tables(0).Rows(i).Item(0)
' If text.Length > 15 Then
' Dim g As Graphics = cmb.CreateGraphics
' If g.MeasureString(text, cmb.Font).Width + 30 > newWidth Then
' newWidth = g.MeasureString(text, cmb.Font).Width + 30
' End If
' g.Dispose()
' End If
' Catch ex As Exception
' MsgBox(ex.Message, MsgBoxStyle.Critical, "Unexpected error in Anpassung Breite ComboBox:")
' End Try
' Next
' cmb.Size = New Size(newWidth, 27)
' cmb.AutoCompleteSource = AutoCompleteSource.ListItems
' cmb.AutoCompleteMode = AutoCompleteMode.Suggest
' End If
' If connectionString.Contains("Initial Catalog=") Then
' Try
' adapter.Dispose()
' sqlCmd.Dispose()
' sqlCnn.Close()
' Catch ex As Exception
' End Try
' Else
' Try
' oracleadapter.Dispose()
' oracleCmd.Dispose()
' oracleConn.Close()
' Catch ex As Exception
' End Try
' End If
' End If
' End If
' Next
' End If
' Catch ex As Exception
' Logger.Info(" - Unvorhergesehener Unexpected error in Renew_ComboboxResults - Fehler: " & vbNewLine & ex.Message)
' Logger.Error(ex.Message)
' MsgBox(ex.Message, MsgBoxStyle.Critical, "Unvorhergesehener Unexpected error in Renew_ComboboxResults:")
' End Try
'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 DevExpress.XtraEditors.TextEdit With {
Dim oEdit As New TextEdit With {
.Name = "txt" & pAttrName,
.Size = New Size(260, 27),
.Location = New Point(11, y),
@@ -622,7 +332,7 @@ Public Class ClassControlCreator
Select Case pAttrDataType
Case "INTEGER"
oEdit.Properties.Mask.MaskType = DevExpress.XtraEditors.Mask.MaskType.Numeric
oEdit.Properties.Mask.MaskType = Mask.MaskType.Numeric
oEdit.Properties.Mask.EditMask = "d"
Console.WriteLine()
End Select
@@ -640,26 +350,26 @@ Public Class ClassControlCreator
Return oEdit
End Function
Public Sub OnTextBoxFocus(sender As System.Object, e As System.EventArgs)
Dim oTextbox As DevExpress.XtraEditors.TextEdit = sender
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 System.Object, e As System.EventArgs)
Dim oTextbox As DevExpress.XtraEditors.TextEdit = sender
Public Sub OnTextBoxTextChanged(sender As Object, e As EventArgs)
Dim oTextbox As TextEdit = CType(sender, TextEdit)
Using oGraphics As Graphics = oTextbox.CreateGraphics()
oTextbox.Width = oGraphics.MeasureString(oTextbox.Text, oTextbox.Font).Width + 15
oTextbox.Width = CInt(oGraphics.MeasureString(oTextbox.Text, oTextbox.Font).Width + 15)
End Using
End Sub
Public Sub OnTextBoxLostFocus(sender As System.Object, e As System.EventArgs)
Dim oTextbox As DevExpress.XtraEditors.TextEdit = sender
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 System.Object, e As System.Windows.Forms.KeyEventArgs)
Dim oTextbox As DevExpress.XtraEditors.TextEdit = sender
Public Sub OnTextBoxKeyUp(sender As Object, e As KeyEventArgs)
Dim oTextbox As TextEdit = CType(sender, TextEdit)
If oTextbox.Text = String.Empty Then
Exit Sub
@@ -675,8 +385,8 @@ Public Class ClassControlCreator
End Sub
Public Function AddDateTimePicker(indexname As String, y As Integer, DataType As String) As DevExpress.XtraEditors.DateEdit
Dim oPicker As New DevExpress.XtraEditors.DateEdit With {
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),
@@ -689,105 +399,4 @@ Public Class ClassControlCreator
Return oPicker
End Function
Sub OndtpChanged()
'offen was hier zu tun ist
End Sub
'Private Sub PrepareDependingControl(Control As Control)
' If TypeOf Control Is Label Then
' Exit Sub
' End If
' Try
' Dim oMeta = DirectCast(Control.Tag, ClassControls.ControlMeta)
' Dim oIndexName As String = oMeta.IndexName
' Dim oSQL = $"SELECT * FROM TBDD_INDEX_MAN WHERE SQL_RESULT LIKE '%{oIndexName}%'"
' Dim oDatatable As DataTable = ClassDatabase.Return_Datatable(oSQL)
' If Not IsNothing(oDatatable) Then
' Logger.Debug("Found [{0}] depending controls for [{1}]", oDatatable.Rows.Count, Control.Name)
' For Each oRow As DataRow In oDatatable.Rows
' Dim oControlName As String = NotNull(oRow.Item("NAME"), "")
' Dim oConnectionId As Integer = NotNull(oRow.Item("CONNECTION_ID"), -1)
' Dim oControlSql As String = NotNull(oRow.Item("SQL_RESULT"), "")
' If oConnectionId = -1 Or oControlSql = String.Empty Then
' Logger.Warn("Missing SQL Query or ConnectionId for Control [{0}]! Continuing.", oControlName)
' Continue For
' End If
' oControlSql = ClassPatterns.ReplaceUserValues(oControlSql, USER_PRENAME, USER_SURNAME, USER_SHORTNAME, USER_LANGUAGE, USER_EMAIL, USER_ID, CURRENT_DOKART_ID)
' oControlSql = ClassPatterns.ReplaceInternalValues(oControlSql)
' oControlSql = ClassPatterns.ReplaceControlValues(oControlSql, Panel)
' Logger.Debug("SQL After Preparing: [{0}]", oControlSql)
' Logger.Debug("Setting new value for [{0}]", oControlName)
' SetDependingControlResult(oControlName, oControlSql, oConnectionId)
' Next
' End If
' Catch ex As Exception
' Logger.Error(ex)
' End Try
'End Sub
'Private Sub SetDependingControlResult(IndexName As String, SqlCommand As String, SqlConnectionId As Integer)
' Try
' If SqlCommand Is Nothing OrElse SqlCommand = String.Empty Then
' Logger.Warn("New Value for Index [{0}] could not be set. Supplied SQL is empty.")
' Exit Sub
' End If
' Dim oConnectionString = ClassFormFunctions.GetConnectionString(SqlConnectionId)
' Dim oDatatable As DataTable = ClassDatabase.Return_Datatable_CS(SqlCommand, oConnectionString)
' Dim oFoundControl As Control = Nothing
' For Each oControl As Control In Panel.Controls
' If TypeOf oControl Is Label Then
' Continue For
' End If
' Dim oMeta = DirectCast(oControl.Tag, ClassControls.ControlMeta)
' Dim oIndex As String = oMeta.IndexName
' If oIndex = IndexName Then
' oFoundControl = oControl
' Exit For
' End If
' Next
' If oFoundControl Is Nothing Then
' Logger.Warn("Depending Control for Index [{0}] not found!", IndexName)
' End If
' If oDatatable Is Nothing Then
' Logger.Warn("Error in SQL Command: {0}", SqlCommand)
' End If
' Select Case oFoundControl.GetType.Name
' Case GetType(DevExpress.XtraEditors.TextEdit).Name
' If oDatatable.Rows.Count > 0 Then
' Dim oFirstRow As DataRow = oDatatable.Rows.Item(0)
' If oFirstRow.ItemArray.Length > 0 Then
' Dim oValue = oFirstRow.Item(0).ToString()
' Logger.Debug("Setting Value for TextEdit [{0}]: [{1}]", oFoundControl.Name, oValue)
' DirectCast(oFoundControl, DevExpress.XtraEditors.TextEdit).Text = oValue
' End If
' End If
' Case GetType(LookupControl2).Name
' Logger.Debug("Setting Value for LookupControl [{0}]: [{1}]", oFoundControl.Name, "DATATABLE")
' DirectCast(oFoundControl, LookupControl2).DataSource = oDatatable
' Case GetType(ComboBox).Name
' Logger.Debug("Setting Value for Combobox [{0}]: [{1}]", oFoundControl.Name, "DATATABLE")
' DirectCast(oFoundControl, ComboBox).DataSource = oDatatable
' Case Else
' Logger.Debug("Could not set depending control result for [{0}]", oFoundControl.GetType.Name)
' End Select
' Catch ex As Exception
' Logger.Error(ex)
' End Try
'End Sub
End Class