Option Explicit On Imports DigitalData.Modules.Logging Imports DigitalData.Modules.Language Imports DevExpress.XtraTab Imports DevExpress.XtraGrid Imports DevExpress.XtraGrid.Views.Grid Imports DevExpress.XtraEditors Imports DevExpress.XtraSplashScreen Imports DigitalData.GUIs.Common Imports DigitalData.GUIs.ZooFlow.ClassConstants Imports DigitalData.GUIs.ZooFlow.SearchFilter Imports System.Threading.Tasks Public Class frmSearchStart Private Logger As Logger ' Constants Private Const DEFAULT_X As Integer = 10 Private Const DEFAULT_Y As Integer = 10 ' Runtime Variables Private SelectedTabIndex As Integer Private SelectedTab As XtraTabPage Private HeightBeforeMinimizing As Integer = 600 Private SEARCH_ID As Integer = 0 Private SEARCH_SQL As String Private SEARCH_TITLE As String Private SEARCH_COUNT As Integer = 0 Public DataLoaded As Boolean = False Private DatatableAttributes As DataTable Private DatatableAttributeLinks As DataTable Private DatatableSearchProfiles As DataTable Private DatatableStartSearchResult As DataTable Private DatatableSearchResultSoFar As DataTable Private LastSearchForm As frmDocumentResultList Private ChangedDateControls As List(Of String) Private clsControls As ClassControlCreator Private StopWatch As Watch Public Sub New(ByVal pDTSearchProfiles As DataTable, Optional ByVal pRunSearch As Boolean = False) ' Dieser Aufruf ist für den Designer erforderlich. InitializeComponent() ' Fügen Sie Initialisierungen nach dem InitializeComponent()-Aufruf hinzu. StopWatch = New Watch(Name) DatatableSearchProfiles = pDTSearchProfiles Logger = My.LogConfig.GetLogger() Dim oSearchTerms As New DataTable ' Create four typed columns in the DataTable. oSearchTerms.Columns.Add("BracketLeft", GetType(String)) oSearchTerms.Columns.Add("AttrID", GetType(Integer)) oSearchTerms.Columns.Add("AttrTitle", GetType(String)) oSearchTerms.Columns.Add("Criteria", GetType(String)) oSearchTerms.Columns.Add("SearchTerm", GetType(String)) oSearchTerms.Columns.Add("BracketRight", GetType(String)) oSearchTerms.Columns.Add("Operator", GetType(String)) End Sub Private Async Sub frmSearchStart_Load(sender As Object, e As EventArgs) Handles Me.Load Dim oHandle As IOverlaySplashScreenHandle = Nothing Try oHandle = SplashScreenManager.ShowOverlayForm(Me) Dim oWatch As New Watch("Setting up Form") pnlProfileChoose.Visible = False For Each oTab As XtraTabPage In XtraTabControl1.TabPages oTab.PageVisible = False Next RepositoryItemComboBox2.Items.AddRange(DefaultFilters) BarCheckboxOpenSearchInSameWindow.Checked = My.UIConfig.SearchForm.OpenSearchInSameWindow If DatatableSearchProfiles.Rows.Count > 1 Then cmbProfile.DataSource = DatatableSearchProfiles cmbProfile.ValueMember = DatatableSearchProfiles.Columns("SEARCH_PROFILE_ID").ColumnName cmbProfile.DisplayMember = DatatableSearchProfiles.Columns("TITLE").ColumnName cmbProfile.AutoCompleteMode = AutoCompleteMode.Suggest cmbProfile.AutoCompleteSource = AutoCompleteSource.ListItems cmbProfile.SelectedIndex = -1 SelectedTabIndex = -1 pnlProfileChoose.Visible = True For Each oRow As DataRow In DatatableSearchProfiles.Rows RepositoryItemComboBox1.Items.Add(oRow.Item("TITLE")) Next oWatch.Stop() Else pnlProfileChoose.Visible = False RibbonPageGroupProfiles.Visible = False SelectedTabIndex = 0 SelectedTab = XtraTabControl1.TabPages.First SelectedTab.PageVisible = True SelectedTab.Text = DatatableSearchProfiles.Rows(0).Item("TITLE") SEARCH_ID = DatatableSearchProfiles.Rows(0).Item("SEARCH_PROFILE_ID") SEARCH_SQL = DatatableSearchProfiles.Rows(0).Item("RESULT_SQL") SEARCH_TITLE = DatatableSearchProfiles.Rows(0).Item("TITLE") oWatch.Stop() oWatch = New Watch("Loading Attributes") Await Load_Search_Attributes() oWatch.Stop() BarButtonNewSearch.Visibility = DevExpress.XtraBars.BarItemVisibility.Never End If SEARCH_COUNT = DatatableSearchProfiles.Rows.Count SplitContainerControlSearch.Collapsed = True If My.UIConfig.SearchForm.Size.Height > 0 And My.UIConfig.SearchForm.Size.Width > 0 Then Size = My.UIConfig.SearchForm.Size End If If My.UIConfig.SearchForm.Location.X > 0 And My.UIConfig.SearchForm.Location.Y > 0 Then Location = My.UIConfig.SearchForm.Location End If Catch ex As Exception Logger.Error(ex.Message) MsgBox(ex.Message, MsgBoxStyle.Critical, "Unexpected error while loading ProfileSearches:") Finally SplashScreenManager.CloseOverlayForm(oHandle) StopWatch.Stop() End Try End Sub Async Function Load_Search_Attributes() As Task Try DataLoaded = False Dim oWatch1 As New Watch("Getting data from Database") Dim oSQL = $"SELECT * FROM VWIDB_SEARCH_PROFILE_ATTRIBUTES WHERE SEARCH_PROFIL_ID = {SEARCH_ID} ORDER BY [SEQUENCE]" Dim oDT As DataTable = Await My.DatabaseIDB.GetDatatableAsync(oSQL) oSQL = $"SELECT * FROM VWIDB_SEARCH_ATTRIBUTES_LINKS WHERE SEARCH_PROFIL_ID = {SEARCH_ID} ORDER BY DEP_ATTR_ID" Dim oDT1 As DataTable = Await My.DatabaseIDB.GetDatatableAsync(oSQL) oWatch1.Stop() Dim oWatch2 As New Watch("Procesing Dataset") DatatableAttributes = Nothing DatatableAttributes = oDT.Clone() oDT.Select("", "SEQUENCE").CopyToDataTable(DatatableAttributes, LoadOption.PreserveChanges) DatatableAttributeLinks = Nothing DatatableAttributeLinks = oDT1.Clone() oDT1.Select("", "DEP_ATTR_ID").CopyToDataTable(DatatableAttributeLinks, LoadOption.PreserveChanges) oWatch2.Stop() Dim oControlCount As Integer = 1 Dim oControlRow As Integer = 0 clsControls = New ClassControlCreator(SelectedTab, Me) Dim YActControlHeight As Integer = 0 Dim XActControlWidth As Integer = 0 For Each oAttributeRow As DataRow In DatatableAttributes.Rows Dim oXPosition As Integer Dim oYPositionControl As Integer Dim oYPositionLabel As Integer Dim oMyLastGridView As GridView Dim oSingleResult As Boolean = False Dim oAttributeTitle As String = oAttributeRow.Item("ATTRIBUTE_TITLE").ToString Dim oAttriID As Integer = CInt(oAttributeRow.Item("ATTRIBUTE_ID")) Dim oAttributeType As String = oAttributeRow.Item("ATTRIBUTE_TYPE").ToString Dim oWatch3 As New Watch($"Loading Attribute: {oAttributeTitle}") Dim oWatch4 As New Watch($"Calculating Position") If oControlCount = 1 Or oControlCount = 5 Or oControlCount = 9 Then oControlRow += 1 End If If oControlRow = 1 Then If oControlCount = 1 Then oXPosition = 10 oYPositionLabel = 10 oYPositionControl = oYPositionLabel + 20 End If ElseIf oControlRow = 2 Then If oControlCount = 5 Then oXPosition = 10 oYPositionLabel = YActControlHeight + 10 oYPositionControl = oYPositionLabel + 20 End If ElseIf oControlRow = 3 Then If oControlCount = 9 Then oXPosition = 10 End If End If oWatch4.Stop() oWatch4 = New Watch("Creating Label") 'Dim oControlHeight As Integer = CInt(oAttributeRow.Item("HEIGHT")) Dim oControlHeight As Integer = 150 Dim oControlWidth As Integer = CInt(oAttributeRow.Item("WIDTH")) 'Dim oControlWidth As Integer = 150 If CBool(oAttributeRow.Item("MULTISELECT")) = True Then oControlWidth += 50 End If addLabel(oAttributeTitle, oXPosition, oYPositionLabel) 'Nun das Control mit dem entsprechenden Abstand und der Größe Dim oCalcHeight As Integer Dim oCalcWidth As Integer If oAttributeType = ATTR_TYPE_STRING Or oAttributeType = ATTR_TYPE_INTEGER Then oCalcHeight = oControlHeight + oYPositionControl oCalcWidth = oControlWidth ElseIf (oAttributeType = ATTR_TYPE_DATE Or oAttributeType = ATTR_TYPE_BOOLEAN) Then oCalcHeight = 20 + oYPositionControl oCalcWidth = 100 End If If oCalcHeight > YActControlHeight Then YActControlHeight = oCalcHeight End If oWatch4.Stop() oWatch4 = New Watch("Creating Control") Dim oMyControl As Control = Nothing If oAttributeType = ATTR_TYPE_STRING Or oAttributeType = ATTR_TYPE_INTEGER Then oMyControl = clsControls.CreateExistingGridControl(oAttributeRow, oXPosition, oYPositionControl) Dim oGrid As GridControl = CType(oMyControl, GridControl) Dim oDataSource As DataTable = CType(oGrid.DataSource, DataTable) If Not IsNothing(oDataSource) AndAlso oDataSource.Rows.Count = 1 Then oSingleResult = True End If Dim oView As GridView = CType(oGrid.MainView, GridView) oMyLastGridView = oView oView.FocusInvalidRow() 'Prüfen ob für dieses Grid eine Abhängigkeit definiert ist? For Each oROW As DataRow In DatatableAttributeLinks.Rows If CInt(oROW.Item("LINKED_ATTR_ID")) = oAttriID Then If CBool(oAttributeRow.Item("MULTISELECT")) = True Then AddHandler oView.SelectionChanged, AddressOf SelectionChanged Else AddHandler oView.FocusedRowChanged, AddressOf FocusedRowChanged End If End If Next ElseIf oAttributeType = ATTR_TYPE_DATE Then oMyControl = clsControls.CreateExistingDatepicker(oAttributeRow, oXPosition, oYPositionControl) Dim myDTP As DateEdit = CType(oMyControl, DateEdit) AddHandler myDTP.DisableCalendarDate, AddressOf DisableCalendarDate AddHandler myDTP.DateTimeChanged, AddressOf CalendarChanged 'CalendarChanged ElseIf oAttributeType = ATTR_TYPE_BOOLEAN Then oMyControl = clsControls.CreateExistingCheckbox(oAttributeRow, oXPosition, oYPositionControl) Dim myCheckBox As CheckBox = CType(oMyControl, CheckBox) AddHandler myCheckBox.CheckedChanged, AddressOf CheckBox_CheckedChanged End If oWatch4.Stop() oWatch4 = New Watch("Adding Control to Panel") oControlCount += 1 If oMyControl IsNot Nothing Then SelectedTab.Controls.Add(oMyControl) If oAttributeType = ATTR_TYPE_STRING Or oAttributeType = ATTR_TYPE_INTEGER Then clsControls.DeselectGridControl(oMyControl) End If End If oXPosition += oControlWidth + 20 oWatch4.Stop() oWatch3.Stop() Next oSQL = $"SELECT [dbo].[FNIDB_SEARCH_GET_FILTER_SQL] ({SEARCH_ID},{My.Application.User.UserId},'{My.Application.User.Language}')" Dim oREsult = My.DatabaseIDB.GetScalarValue(oSQL) If Not IsNothing(oREsult) Then DatatableStartSearchResult = My.DatabaseIDB.GetDatatable(oREsult) End If Catch ex As Exception Logger.Warn("Unexpected error in Load_Search_Attributes - Error: " & ex.Message) MsgBox(ex.Message, MsgBoxStyle.Critical, "Unexpected error in Load_Search_Attributes:") Finally DataLoaded = True End Try End Function Private Function FilterbyAttribute(Attribute2Filter As String, pFilter As String, TermColumn As String) As DataTable Try Dim oDV As DataView = New DataView(DatatableStartSearchResult, pFilter, "", DataViewRowState.OriginalRows) Dim oDT As DataTable = oDV.ToTable(True, TermColumn) Return oDT Catch ex As Exception Logger.Error(ex.Message) Return Nothing End Try End Function Private Function RenewResultSoFar(pFilter As String) As DataTable Try Dim oDT2Filter As DataTable ' If DatatableSearchResultSoFar Is Nothing Then oDT2Filter = DatatableStartSearchResult.Copy() ' Else 'oDT2Filter = DatatableSearchResultSoFar ' End If Dim oDV As DataView = New DataView(oDT2Filter, pFilter, "", DataViewRowState.OriginalRows) Dim oDT As DataTable = oDV.ToTable(True) DatatableSearchResultSoFar = oDT Display_InfoItem("FindResusult so far: " & DatatableSearchResultSoFar.Rows.Count.ToString, Color.Yellow) Return DatatableSearchResultSoFar Catch ex As Exception Logger.Error(ex.Message) Return Nothing End Try End Function Sub addLabel(pAttrName As String, pXPos As Integer, ylbl As Integer) Dim lbl As New Label With { .Name = "lbl" & pAttrName, .AutoSize = True, .Text = pAttrName, .Location = New Point(pXPos, ylbl) } SelectedTab.Controls.Add(lbl) End Sub Private Sub XtraTabControl1_SelectedPageChanged(sender As Object, e As DevExpress.XtraTab.TabPageChangedEventArgs) Handles XtraTabControl1.SelectedPageChanged SelectedTab = XtraTabControl1.SelectedTabPage End Sub Private Sub ClearSearchCriteria() Dim oSQL = $"DELETE FROM TBIDB_USER_SEARCH_CRITERIA WHERE SEARCH_PROFIL_ID = {SEARCH_ID} AND USERID = {My.Application.User.UserId}" My.DatabaseIDB.ExecuteNonQuery(oSQL) End Sub Private Sub ClearSelectedControls() ChangedDateControls = Nothing End Sub Private Sub ClearAllRestrictedData() Dim osql = $"DELETE FROM TBIDB_SEARCH_RESTRICTIONS_INPUT WHERE SEARCH_ID = {SEARCH_ID} and USR_ID = {My.Application.User.UserId}" My.DatabaseIDB.ExecuteNonQuery(osql) osql = $"DELETE FROM TBIDB_SEARCH_RESTRICTIONS_OBJECTS WHERE SEARCH_ID = {SEARCH_ID} AND USR_ID = {My.Application.User.UserId}" My.DatabaseIDB.ExecuteNonQuery(osql) End Sub Private Sub ClearRestrictedDataAttr(pAttrID As Integer) Dim osql = $"DELETE FROM TBIDB_SEARCH_RESTRICTIONS_INPUT WHERE SEARCH_ID = {SEARCH_ID} and USR_ID = {My.Application.User.UserId} AND RESTR_ATTR_ID = {pAttrID}" My.DatabaseIDB.ExecuteNonQuery(osql) End Sub Private Sub RenewSearchAttributes() ClearSearchCriteria() ClearAllRestrictedData() For Each oControl As Control In SelectedTab.Controls Dim octrlType = oControl.GetType.ToString Dim oAttrID As Integer Dim oAttrTitle As String Select Case oControl.GetType.FullName Case GetType(GridControl).FullName Dim oMyGridControl As GridControl = CType(oControl, GridControl) Dim oMyGridView As GridView = CType(oMyGridControl.MainView, GridView) Dim oSelectedRows As Integer() = oMyGridView.GetSelectedRows() If oSelectedRows.Count = 0 Then Continue For End If oAttrID = DirectCast(oControl.Tag, ClassControlCreator.ControlMetadata).AttributeID oAttrTitle = DirectCast(oControl.Tag, ClassControlCreator.ControlMetadata).AttributeTitle For Each oRowHandle As Integer In oSelectedRows Dim oResult = oMyGridView.GetRowCellValue(oRowHandle, oMyGridView.Columns(0).FieldName) Dim oInsert = $"EXEC PRIDB_NEW_USER_SEARCH_CRITERIA {SEARCH_ID.ToString},{My.Application.User.UserId.ToString},{oAttrID.ToString},'{oResult}','{My.Application.User.UserName}'" My.DatabaseIDB.ExecuteNonQuery(oInsert) Next Case GetType(DateEdit).FullName ' MsgBox("Date") Dim oDateEdit As DateEdit = CType(oControl, DateEdit) If ChangedDateControls Is Nothing Then Continue For End If If ChangedDateControls.Count = 0 Then Continue For End If For Each oName As String In ChangedDateControls If oDateEdit.Name = oName Then If Not IsNothing(oDateEdit.EditValue) Then oAttrID = DirectCast(oControl.Tag, ClassControlCreator.ControlMetadata).AttributeID oAttrTitle = DirectCast(oControl.Tag, ClassControlCreator.ControlMetadata).AttributeTitle Dim oldValue As Date Dim validDate As Boolean = False Dim oDateValue As Date = DirectCast(oDateEdit.EditValue, Date) Try validDate = Date.TryParse(oDateEdit.OldEditValue, oldValue) Catch ex As Exception oldValue = Date.MinValue End Try If Not validDate Then oldValue = Date.MinValue End If If oldValue = oDateEdit.EditValue Then Exit Sub End If Dim dateString = oDateValue.ToString("yyyy-MM-dd") 'hh:mm:ss.fff Dim omydate = oDateEdit.EditValue.ToString Dim oInsert = $"EXEC PRIDB_NEW_USER_SEARCH_CRITERIA {SEARCH_ID.ToString},{My.Application.User.UserId.ToString},{oAttrID.ToString},'{omydate}','{My.Application.User.UserName}'" My.DatabaseIDB.ExecuteNonQuery(oInsert) End If End If Next Case GetType(CheckBox).FullName Dim myCheckBox As CheckBox = CType(oControl, CheckBox) If myCheckBox.CheckState <> CheckState.Indeterminate Then oAttrID = DirectCast(oControl.Tag, ClassControlCreator.ControlMetadata).AttributeID oAttrTitle = DirectCast(oControl.Tag, ClassControlCreator.ControlMetadata).AttributeTitle Dim oInsert = $"EXEC PRIDB_NEW_USER_SEARCH_CRITERIA {SEARCH_ID.ToString},{My.Application.User.UserId.ToString},{oAttrID.ToString},'{myCheckBox.Checked.ToString}','{My.Application.User.UserName}'" My.DatabaseIDB.ExecuteNonQuery(oInsert) End If Case Else 'MsgBox(oControl.GetType.ToString) End Select Next End Sub Private Sub Relation2ControlActivated(pToAttributeID As Integer, pAttribute2Filter As String, pFilter As String, pTermColumn As String) Try For Each oControl As Control In SelectedTab.Controls Dim octrlType = oControl.GetType.ToString Dim oAttrID As Integer Dim oAttrTitle As String If octrlType = "System.Windows.Forms.Label" Then Continue For End If oAttrID = DirectCast(oControl.Tag, ClassControlCreator.ControlMetadata).AttributeID oAttrTitle = DirectCast(oControl.Tag, ClassControlCreator.ControlMetadata).AttributeTitle Select Case oControl.GetType.FullName Case GetType(GridControl).FullName Dim oMyGridControl As GridControl = CType(oControl, GridControl) Dim oMyGridView As GridView = CType(oMyGridControl.MainView, GridView) If pToAttributeID = oAttrID Then Dim oDTSource As DataTable = FilterbyAttribute(pAttribute2Filter, pFilter, pTermColumn) If Not IsNothing(oDTSource) Then oDTSource.DefaultView.Sort = oAttrTitle '"ColumnName ASC" oDTSource = oDTSource.DefaultView.ToTable oMyGridControl.DataSource = oDTSource oMyGridView.PopulateColumns() oMyGridView.FocusInvalidRow() End If 'MsgBox("Attribute" & oAttrTitle & " is linked" & vbNewLine & oinString) Continue For End If Case GetType(DateEdit).FullName ' MsgBox("Date") Dim oDateEdit As DateEdit = CType(oControl, DateEdit) If pToAttributeID = oAttrID Then Continue For End If Case GetType(CheckBox).FullName Dim myCheckBox As CheckBox = CType(oControl, CheckBox) Case Else 'MsgBox(oControl.GetType.ToString) End Select Next Catch ex As Exception Logger.Error(ex) End Try End Sub Private Function ReplacePatterns(pInput As String, pAttrTitle As String) As String Try Dim oReturn = pInput oReturn = oReturn.Replace("@USER_LANGUAGE", My.Application.User.Language) oReturn = oReturn.Replace("@pUSER_ID", My.Application.User.UserId) oReturn = oReturn.Replace("@RESULT_TITLE", pAttrTitle) Return oReturn Catch ex As Exception Return pInput Logger.Error(ex) End Try End Function Private Sub RenewDatasourceControl(pToAttributeID As Integer, pSourceSQL As String) Try For Each oControl As Control In SelectedTab.Controls Dim octrlType = oControl.GetType.ToString Dim oAttrID As Integer Dim oAttrTitle As String If octrlType = "System.Windows.Forms.Label" Then Continue For End If oAttrID = DirectCast(oControl.Tag, ClassControlCreator.ControlMetadata).AttributeID oAttrTitle = DirectCast(oControl.Tag, ClassControlCreator.ControlMetadata).AttributeTitle If pToAttributeID = oAttrID Then Dim oSourceSQL As String = ReplacePatterns(pSourceSQL, oAttrTitle) Dim oDTSource As DataTable = My.DatabaseIDB.GetDatatable(oSourceSQL) If Not IsNothing(oDTSource) Then oDTSource.DefaultView.Sort = oAttrTitle '"ColumnName ASC" oDTSource = oDTSource.DefaultView.ToTable Select Case oControl.GetType.FullName Case GetType(GridControl).FullName Dim oMyGridControl As GridControl = CType(oControl, GridControl) Dim oMyGridView As GridView = CType(oMyGridControl.MainView, GridView) oMyGridControl.DataSource = oDTSource oMyGridView.PopulateColumns() oMyGridView.FocusInvalidRow() Case GetType(DateEdit).FullName ' MsgBox("Date") Dim oDateEdit As DateEdit = CType(oControl, DateEdit) Case GetType(CheckBox).FullName Dim myCheckBox As CheckBox = CType(oControl, CheckBox) Case Else 'MsgBox(oControl.GetType.ToString) End Select End If End If Next Catch ex As Exception Logger.Error(ex) End Try End Sub Private Sub Link2ControlActivated(pFromAttributeID As Integer, pToAttributeID As Integer, pListSelected As List(Of String), pSourceSQL As String) Try For Each oControl As Control In SelectedTab.Controls Dim octrlType = oControl.GetType.ToString Dim oAttrID As Integer Dim oAttrTitle As String If octrlType = "System.Windows.Forms.Label" Then Continue For End If oAttrID = DirectCast(oControl.Tag, ClassControlCreator.ControlMetadata).AttributeID oAttrTitle = DirectCast(oControl.Tag, ClassControlCreator.ControlMetadata).AttributeTitle Select Case oControl.GetType.FullName Case GetType(GridControl).FullName Dim oMyGridControl As GridControl = CType(oControl, GridControl) Dim oMyGridView As GridView = CType(oMyGridControl.MainView, GridView) If pToAttributeID = oAttrID Then ClearRestrictedDataAttr(pToAttributeID) Dim i As Integer = 0 Dim oinString As String = " in (" For Each oOBJ_ID As String In pListSelected Dim oinsert As String = $"INSERT INTO [dbo].[TBIDB_SEARCH_RESTRICTIONS_INPUT] ([SEARCH_ID],[RESTR_ATTR_ID],[SOURCE_ATTR_ID] ,[TERM],[USR_ID]) VALUES ({SEARCH_ID},{pToAttributeID},{pFromAttributeID},'{oOBJ_ID}',{My.Application.User.UserId})" My.DatabaseIDB.ExecuteNonQuery(oinsert) If i = 0 Then oinString += "'" + oOBJ_ID.ToString + "'" Else oinString = oinString + ",'" + oOBJ_ID.ToString + "'" End If i += 1 Next oinString += ")" Dim oSourceSQL As String = pSourceSQL oSourceSQL = oSourceSQL.Replace("@USER_LANGUAGE", My.Application.User.Language) oSourceSQL = oSourceSQL.Replace("@pUSER_ID", My.Application.User.UserId) oSourceSQL = oSourceSQL.Replace("@RESULT_TITLE", oAttrTitle) oSourceSQL &= $" Inner Join TBIDB_SEARCH_RESTRICTIONS_OBJECTS T1 ON T.IDB_OBJECT_ID = T1.IDB_OBJ_ID " & $"WHERE RESTR_ATTR_ID = {pToAttributeID} And SEARCH_ID = {SEARCH_ID} And USR_ID = {My.Application.User.UserId} " 'oSourceSQL &= " ORDER BY T.TERM_VALUE" Dim oDTSource As DataTable If Utils.NotNull(oSourceSQL, String.Empty) <> String.Empty Then oDTSource = My.DatabaseIDB.GetDatatable(oSourceSQL) If Not IsNothing(oDTSource) Then oDTSource.DefaultView.Sort = oAttrTitle '"ColumnName ASC" oDTSource = oDTSource.DefaultView.ToTable oMyGridControl.DataSource = oDTSource oMyGridView.PopulateColumns() oMyGridView.FocusInvalidRow() End If End If 'MsgBox("Attribute" & oAttrTitle & " is linked" & vbNewLine & oinString) Continue For End If Case GetType(DateEdit).FullName ' MsgBox("Date") Dim oDateEdit As DateEdit = CType(oControl, DateEdit) If pToAttributeID = oAttrID Then Continue For End If Case GetType(CheckBox).FullName Dim myCheckBox As CheckBox = CType(oControl, CheckBox) Case Else 'MsgBox(oControl.GetType.ToString) End Select Next Catch ex As Exception Logger.Error(ex) End Try End Sub Private Sub SelectionChanged(sender As Object, e As DevExpress.Data.SelectionChangedEventArgs) Try If DataLoaded = False Then Exit Sub Dim oMyGridView As GridView = DirectCast(sender, GridView) Dim oMyGridControl As GridControl = oMyGridView.GridControl Dim oAttrID As Integer Dim oAttrTitle As String oAttrID = DirectCast(oMyGridControl.Tag, ClassControlCreator.ControlMetadata).AttributeID oAttrTitle = DirectCast(oMyGridControl.Tag, ClassControlCreator.ControlMetadata).AttributeTitle Dim oSelectedRows As Integer() = oMyGridView.GetSelectedRows() If oSelectedRows.Count = 0 Then ClearRestrictedDataAttr(oAttrID) For Each orow As DataRow In DatatableAttributeLinks.Rows If CInt(orow.Item("LINKED_ATTR_ID")) = oAttrID Then ' Nun die Controls durchlaufen RenewDatasourceControl(CInt(orow.Item("DEP_ATTR_ID")), orow.Item("DEP_SOURCE_SQL").ToString) End If Next Exit Sub End If Dim oList As New List(Of String) For Each oRowHandle As Integer In oSelectedRows Dim oSelectedItem As String = oMyGridView.GetRowCellValue(oRowHandle, oMyGridView.Columns(0).FieldName) oList.Add("'" + oSelectedItem + "'") Next Dim oFilter As String = oAttrTitle + " in (" + String.Join(",", oList) + ")" RenewResultSoFar(oFilter) For Each orow As DataRow In DatatableAttributeLinks.Rows If CInt(orow.Item("LINKED_ATTR_ID")) = oAttrID Then ' Nun die Controls durchlaufen Relation2ControlActivated(CInt(orow.Item("DEP_ATTR_ID")), oAttrTitle, oFilter, orow.Item("DEP_ATTRIBUTE_TITLE").ToString) 'Link2ControlActivated(oAttrID, CInt(orow.Item("DEP_ATTR_ID")), oList, orow.Item("DEP_SOURCE_SQL")) End If Next Catch ex As Exception Logger.Error(ex) End Try End Sub Private Sub FocusedRowChanged(sender As Object, e As Views.Base.FocusedRowChangedEventArgs) Try If DataLoaded = False Then Exit Sub Dim oMyGridView As GridView = DirectCast(sender, GridView) Dim oMyGridControl As GridControl = oMyGridView.GridControl Dim oSelectedRows As Integer() = oMyGridView.GetSelectedRows() If oSelectedRows.Count = 0 Then Exit Sub End If Dim oList As New List(Of String) For Each oRowHandle As Integer In oSelectedRows Dim oSelectedItem As String = oMyGridView.GetRowCellValue(oRowHandle, oMyGridView.Columns(0).FieldName) oList.Add(oSelectedItem) Next Dim oAttrID As Integer Dim oAttrTitle As String oAttrID = DirectCast(oMyGridControl.Tag, ClassControlCreator.ControlMetadata).AttributeID oAttrTitle = DirectCast(oMyGridControl.Tag, ClassControlCreator.ControlMetadata).AttributeTitle Dim oFilter As String = oAttrTitle + " = (" + String.Join(",", oList) + ")" RenewResultSoFar(oFilter) For Each orow As DataRow In DatatableAttributeLinks.Rows If CInt(orow.Item("LINKED_ATTR_ID")) = oAttrID Then ' Nun die Controls durchlaufen Relation2ControlActivated(CInt(orow.Item("DEP_ATTR_ID")), oAttrTitle, oFilter, orow.Item("DEP_ATTRIBUTE_TITLE").ToString) ' Link2ControlActivated(oAttrID, CInt(orow.Item("DEP_ATTR_ID")), oList, orow.Item("DEP_SOURCE_SQL")) End If Next Catch ex As Exception Logger.Error(ex) End Try End Sub Private Sub CheckBox_CheckedChanged(sender As Object, e As EventArgs) Try If DataLoaded = False Then Exit Sub Dim oCurrentCB As CheckBox = DirectCast(sender, CheckBox) Dim oChecked = oCurrentCB.Checked Dim oAttrID = DirectCast(oCurrentCB.Tag, ClassControlCreator.ControlMetadata).AttributeID Dim oAttrTitle = DirectCast(oCurrentCB.Tag, ClassControlCreator.ControlMetadata).AttributeTitle 'RenewSearchAttributes() ' AddSearchAttribute(oAttrID, oAttrTitle, oChecked.ToString) Catch ex As Exception Logger.Error(ex) End Try End Sub Private Sub frmSearchStart_Shown(sender As Object, e As EventArgs) Handles Me.Shown DataLoaded = True End Sub Private Sub DisableCalendarDate(sender As Object, e As DevExpress.XtraEditors.Calendar.DisableCalendarDateEventArgs) Dim oDateEdit As DateEdit = DirectCast(sender, DateEdit) Dim oDTSource As DataTable = DirectCast(oDateEdit.Tag, ClassControlCreator.ControlMetadata).DTSource If Not IsNothing(oDTSource) Then If IsValidDate(oDTSource, e.Date) = False Then e.IsDisabled = True End If End If End Sub Private Sub CalendarChanged(sender As Object, e As EventArgs) If DataLoaded = False Then Exit Sub Dim oDateEdit As DateEdit = CType(sender, DateEdit) If Not IsNothing(oDateEdit.EditValue) Then Dim oEditValue = oDateEdit.EditValue.ToString Dim oList As New List(Of String) From {oDateEdit.Name} If Not IsNothing(ChangedDateControls) Then Dim oFound As Boolean = False For Each oName As String In ChangedDateControls If oDateEdit.Name = oName Then oFound = True Exit For End If Next If oFound = False Then ChangedDateControls.Add(oDateEdit.Name) End If Else ChangedDateControls = oList End If End If End Sub Public Function IsValidDate(pCheckDT As DataTable, pDate2Check As Date) As Boolean Dim oIsValid As Boolean = False For Each oDateRow As DataRow In pCheckDT.Rows If CDate(oDateRow.Item(0)) = pDate2Check Then oIsValid = True End If Next Return oIsValid End Function Private Async Sub BarButtonClearSearch_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles BarButtonClearSearch.ItemClick Try ClearSearchCriteria() ClearSelectedControls() ClearAllRestrictedData() Catch ex As Exception MsgBox("Unexpected Error in Clearing Search Items: " & ex.Message, MsgBoxStyle.Critical) End Try SelectedTab.Controls.Clear() Await Load_Search_Attributes() End Sub Private Async Sub cmbProfile_SelectedIndexChanged(sender As Object, e As EventArgs) Handles cmbProfile.SelectedIndexChanged If DataLoaded = False Then Exit Sub If cmbProfile.SelectedIndex <> -1 Then If SelectedTabIndex = -1 Then SelectedTabIndex = 0 Else SelectedTabIndex += 1 End If SelectedTab = XtraTabControl1.TabPages(SelectedTabIndex) SelectedTab.PageVisible = True SEARCH_ID = cmbProfile.SelectedValue Dim oDT As New DataTable Dim oFilter As String = $"SEARCH_PROFILE_ID = {SEARCH_ID}" Dim oFilteredRows() As DataRow = DatatableSearchProfiles.Select(oFilter) oDT = DatatableSearchProfiles.Clone For Each oRow As DataRow In oFilteredRows SEARCH_SQL = oRow.Item("RESULT_SQL").ToString SEARCH_TITLE = cmbProfile.Text Next SelectedTab.Text = SEARCH_TITLE Await Load_Search_Attributes() BarButtonNewSearch.Visibility = DevExpress.XtraBars.BarItemVisibility.Always XtraTabControl1.SelectedTabPageIndex = SelectedTabIndex End If End Sub Private Sub BarButtonNewSearch_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles BarButtonNewSearch.ItemClick Display_InfoItem("New Search not integrated", Color.Yellow) End Sub Private Sub BarButtonItem2_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles BarButtonSaveSearch.ItemClick Display_InfoItem("Search Save not integrated", Color.Yellow) End Sub Sub Display_InfoItem(pText As String, pBackColor As Color) Display_InfoItem(pText, pBackColor, Color.Black) End Sub Sub Display_InfoItem(pText As String, pBackColor As Color, pForeColor As Color) BarStaticItemInfo.Caption = pText BarStaticItemInfo.ItemAppearance.Normal.BackColor = pBackColor BarStaticItemInfo.ItemAppearance.Normal.ForeColor = pForeColor End Sub Sub Clear_InfoItem() BarStaticItemInfo.Caption = String.Empty BarStaticItemInfo.ItemAppearance.Normal.BackColor = Color.Transparent End Sub Private Sub GridViewSearchTerms_RowDeleted(sender As Object, e As DevExpress.Data.RowDeletedEventArgs) If DataLoaded = False Then Exit Sub Dim oCurrentView As GridView = DirectCast(sender, GridView) Dim oCurrentControl As GridControl = oCurrentView.GridControl Dim oRowView As DataRowView = CType(oCurrentView.GetFocusedRow(), DataRowView) If IsNothing(oRowView) = False Then Dim oResult As String = CType(oRowView.Item(0), String) Dim oAttrID = DirectCast(oCurrentControl.Tag, ClassControlCreator.ControlMetadata).AttributeID Dim oAttrTitle = DirectCast(oCurrentControl.Tag, ClassControlCreator.ControlMetadata).AttributeTitle End If End Sub Private Sub frmSearchStart_FormClosed(sender As Object, e As FormClosedEventArgs) Handles MyBase.FormClosed My.UIConfig.SearchForm.Location = Me.Location My.UIConfigManager.Save() End Sub Private Function GetSearchTermForType(pAttrID As Int16, pAttrTitle As String, pCriteria As String, pTerm As String) As String Dim oSearchTerm As String = "" Dim oFilter As String = $"GUID = {pAttrID}" Dim oFilteredRows() As DataRow = My.Tables.DTIDB_ATTRIBUTE.Select(oFilter) If oFilteredRows.Length = 1 Then For Each oRow As DataRow In oFilteredRows Dim oType As Integer = DirectCast(oRow.Item("TYP_ID"), Integer) If oType = 1 Or oType = 8 Then oSearchTerm = $"{pAttrTitle} {pCriteria} '{pTerm.Replace("'", "''")}'" ElseIf oType = 2 Or oType = 9 Then oSearchTerm = $"{pAttrTitle} {pCriteria} {pTerm}" ElseIf oType = 3 Then 'Float oSearchTerm = $"{pAttrTitle} {pCriteria} Convert(float,'{pTerm.Replace(",", ".")}')" ElseIf oType = 4 Then 'Decimal oSearchTerm = $"{pAttrTitle} {pCriteria} Convert(decimal(19,2),'{pTerm.Replace(",", ".")}')" ElseIf oType = 5 Then 'DATE oSearchTerm = $"{pAttrTitle} {pCriteria} Convert(date,'{pTerm}')" ElseIf oType = 7 Then Dim oBit As Int16 If CBool(pTerm) = True Then oBit = 1 Else oBit = 0 End If oSearchTerm = $"{pAttrTitle} {pCriteria} '{oBit.ToString}'" End If Next End If Return oSearchTerm End Function Private Sub BarButtonStartSearch_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles BarButtonStartSearch.ItemClick Prepare_Search() End Sub Private Sub Prepare_Search() RenewSearchAttributes() ' Minimize the search form, but only if results were found If Start_Search() Then Hide() ' Position Result Window below this window LastSearchForm.Location = GetResultFormLocation() LastSearchForm.Size = GetResultFormSize() AddHandler LastSearchForm.FormClosed, AddressOf LastSearchForm_FormClosed End If End Sub Private Sub LastSearchForm_FormClosed(sender As Object, e As EventArgs) If LastSearchForm.ShouldReturnToPreviousForm = True Then Show() LastSearchForm = Nothing Else Close() LastSearchForm = Nothing End If End Sub Private Function Start_Search() As Boolean Dim oHandle As IOverlaySplashScreenHandle = Nothing Dim oItemsFound As Boolean = False Try oHandle = SplashScreenManager.ShowOverlayForm(Me) Clear_InfoItem() Dim oSearchSQL = SEARCH_SQL oSearchSQL = oSearchSQL.Replace("@UserID", My.Application.User.UserId.ToString) oSearchSQL = oSearchSQL.Replace("@User_ID", My.Application.User.UserId.ToString) oSearchSQL = oSearchSQL.Replace("@UserName", My.Application.User.UserName) oSearchSQL = oSearchSQL.Replace("@SearchID", SEARCH_ID.ToString) Dim oEnvironment As New Modules.ZooFlow.Environment() With { .User = My.Application.User, .Modules = My.Application.Modules, .Database = My.Database, .DatabaseIDB = My.DatabaseIDB, .Settings = My.Application.Settings, .Service = My.Application.Service } Dim oDTSearchResult As DataTable = My.DatabaseIDB.GetDatatable(oSearchSQL) If oDTSearchResult.Rows.Count > 0 Then Dim oShortGuid = Guid.NewGuid() Dim oWindowGuid = $"{SEARCH_ID.ToString}-{My.User.Name}" Dim oParams = New DocumentResultParams() With { .WindowGuid = oWindowGuid, .Results = New List(Of DocumentResult) From { New DocumentResult() With { .Title = SelectedTab.Text, .Datatable = oDTSearchResult } } } If My.UIConfig.SearchForm.OpenSearchInSameWindow And LastSearchForm IsNot Nothing Then LastSearchForm.RefreshResults(oParams.Results) Else Dim oForm As New frmDocumentResultList(My.LogConfig, oEnvironment, oParams) oForm.Show() LastSearchForm = oForm End If oItemsFound = True Else Display_InfoItem("No results for this searchcombination!", Color.OrangeRed, Color.White) End If Catch ex As Exception MsgBox(ex.Message, MsgBoxStyle.Critical, Text) Finally SplashScreenManager.CloseOverlayForm(oHandle) End Try Return oItemsFound End Function Private Function GetResultFormLocation() As Point Return Location End Function Private Function GetResultFormSize() As Size Return Size End Function Private Sub frmSearchStart_KeyUp(sender As Object, e As KeyEventArgs) Handles Me.KeyUp If e.KeyCode = Keys.F2 Then Prepare_Search() End If End Sub 'Private Sub MinimizeSearchForm() ' HeightBeforeMinimizing = Height ' Height = 200 ' BarButtonItem2.Visibility = DevExpress.XtraBars.BarItemVisibility.Always 'End Sub 'Private Sub RestoreSearchForm() ' Height = HeightBeforeMinimizing ' If LastSearchForm IsNot Nothing Then ' LastSearchForm.Location = GetResultFormLocation() ' End If ' BarButtonItem2.Visibility = DevExpress.XtraBars.BarItemVisibility.Never 'End Sub Private Sub cmbFilterTimeframe_EditValueChanged(sender As Object, e As EventArgs) Handles cmbFilterTimeframe.EditValueChanged Dim oTimeframe As FilterTimeframe = DirectCast(cmbFilterTimeframe.EditValue, FilterTimeframe) If oTimeframe.DisableFilter Then txtFilterFrom.Enabled = False txtFilterFrom.Reset() txtFilterTo.Enabled = False txtFilterTo.Reset() Else txtFilterFrom.Enabled = True txtFilterFrom.EditValue = oTimeframe.From txtFilterTo.Enabled = True txtFilterTo.EditValue = oTimeframe.[To] End If End Sub Private Sub BarCheckboxOpenSearchInSameWindow_CheckedChanged(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles BarCheckboxOpenSearchInSameWindow.CheckedChanged My.UIConfig.SearchForm.OpenSearchInSameWindow = BarCheckboxOpenSearchInSameWindow.Checked My.UIConfigManager.Save() End Sub Private Sub frmSearchStart_ResizeEnd(sender As Object, e As EventArgs) Handles Me.ResizeEnd My.UIConfig.SearchForm.Location = Location My.UIConfig.SearchForm.Size = Size My.UIConfigManager.Save() End Sub Private Sub BarButtonItem1_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles BarButtonItem1.ItemClick 'RestoreSearchForm() End Sub Private Sub BarButtonItem2_ItemClick_1(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles BarButtonItem2.ItemClick 'RestoreSearchForm() End Sub Private Sub RibbonControl1_MinimizedRibbonHiding(sender As Object, e As DevExpress.XtraBars.Ribbon.MinimizedRibbonEventArgs) Handles RibbonControl1.MinimizedRibbonHiding End Sub End Class