Imports DevExpress.LookAndFeel Imports DevExpress.Skins Imports DevExpress.Utils.Svg Imports DevExpress.XtraEditors Imports DevExpress.XtraEditors.Controls Imports DevExpress.XtraGrid Imports DevExpress.XtraGrid.Views.Tile Imports DevExpress.XtraSplashScreen Imports DigitalData.GUIs.ZooFlow.ClassConstants Imports DigitalData.GUIs.ZooFlow.SavedSearch Imports DigitalData.GUIs.ZooFlow.Search Imports DigitalData.GUIs.ZooFlow.Search.SearchToken Imports DigitalData.Modules.Language Imports DigitalData.Modules.Logging Public Class frmSearchFlow Private ReadOnly LogConfig As LogConfig = My.LogConfig Private ReadOnly Logger = My.LogConfig.GetLogger() Private SearchLoader As SearchLoader Private SearchRunner As SearchRunner Private TokenTable As DataTable = Nothing Private FormLoading As Boolean = True Private ReadOnly TokenListDefault As New Dictionary(Of String, Object) Private ReadOnly TokenListOperands As New Dictionary(Of String, Object) Private ReadOnly TokenListAttrValues As New Dictionary(Of String, Object) Private Sub frmFlowSearch2_Load(sender As Object, e As EventArgs) Handles MyBase.Load SearchLoader = New SearchLoader(My.LogConfig, My.SystemConfigManager, SvgImageCollection1) SearchRunner = New SearchRunner(My.LogConfig, My.Application.GetEnvironment, "FlowSearch") With { .BaseSearchSQL = SQL_FLOW_SEARCH_BASE } AddHandler SearchRunner.NeedsNewSavedSearch, AddressOf SearchRunner_NewSavedSearch TokenTable = GetTokenTable() ComboBoxDateAttributes.Properties.Items.AddRange(LoadDateAttributes()) ComboBoxDateAttributes.SelectedIndex = 0 GridSearches.DataSource = SearchLoader.LoadSearches() Dim oTokens = GetTokensFromTable(Of AttributeValueToken)(TokenTable) AddTokens(txtSearchInput, oTokens) ViewSearches.FocusedRowHandle = GridControl.InvalidRowHandle FormLoading = False End Sub Private Sub SearchRunner_NewSavedSearch(sender As Object, e As EventArgs) Dim oForm As New frmEditSearch With {.IsNew = True} If oForm.ShowDialog() = DialogResult.OK Then SearchLoader.CreateCustomSearch(oForm.Title, oForm.Description, New List(Of Token), oForm.ImageString) GridSearches.DataSource = SearchLoader.LoadSearches() End If End Sub Public Function GetTokenTable() As DataTable Dim oSQL = $"EXEC PRIDB_SEARCH_AUTOSUGGEST '{My.Application.User.Language}', {My.Application.User.UserId}" Dim oTable = My.Database.GetDatatableIDB(oSQL) Return oTable End Function Public Function GetTokensFromTable(Of T As {New, Token})(pTable As DataTable) As List(Of T) Try Dim oTokens As New List(Of T) Dim oTermValueBlackList As New List(Of String) From {"", " "} For Each oRow As DataRow In pTable.Rows Dim oTermValue = oRow.Item("TERM") Dim oTermId = oRow.ItemEx("TERM_ID", 0) Dim oAttributeTitle = oRow.Item("ATTR_TITLE") Dim oAttributeId = oRow.ItemEx("ATTR_ID", 0) If oTermValueBlackList.Contains(oTermValue) Then Continue For End If oTokens.Add(New T() With { .AttributeId = oAttributeId, .AttributeTitle = oAttributeTitle, .TermId = oTermId, .TermValue = oTermValue }) Next Return oTokens. OrderBy(Function(token) token.TermValue). Distinct(). ToList() Catch ex As Exception Logger.error(ex) Return New List(Of T) End Try End Function Private Function LoadDateAttributes() As List(Of String) Try Dim oAttributes = My.Tables.DTIDB_ATTRIBUTE. AsEnumerable(). Where(Function(row) CBool(row.Item("SYS_ATTRIBUTE")) = False). Where(Function(row) row.Item("TYP_ID") = 5 Or row.Item("TYP_ID") = 6). Select(Function(row) row.Item("ATTR_TITLE")). Cast(Of String). ToList() If My.Application.User.Language = "de-DE" Then oAttributes.Add(IDB_ADDED_WHEN_String_German) Else oAttributes.Add(IDB_ADDED_WHEN_String_Englisch) End If Return oAttributes Catch ex As Exception Logger.error(ex) Return New List(Of String) End Try End Function Private Function GetTokens() As IEnumerable(Of Token) Dim oTokens = txtSearchInput.GetTokenList() Return oTokens.Select(Of Token)(Function(token) token.Value).ToList() End Function Private Async Sub SearchControl2_KeyUp(sender As Object, e As KeyEventArgs) Handles txtSearchInput.KeyUp If e.KeyCode = Keys.Enter And txtSearchInput.IsPopupOpen = False Then Await RunSearch2(GetTokens()) End If End Sub Private Async Sub TileView1_ItemClick(sender As Object, e As TileViewItemClickEventArgs) Handles ViewSearches.ItemClick Dim oSearch = ViewSearches.GetRow(ViewSearches.FocusedRowHandle) If TypeOf oSearch Is CustomSearch Then Dim oCustomSearch As CustomSearch = oSearch Await RunSearch2(oCustomSearch.Tokens) Else Await RunSearch2(GetTokens()) End If End Sub Private Async Sub BarButtonItem1_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles BarButtonItem1.ItemClick Await RunSearch2(GetTokens()) End Sub Private Async Function RunSearch2(pTokens As IEnumerable(Of Token)) As Threading.Tasks.Task Dim oHandle = StartUpdateUI() Dim oSearchTitle As String = "Suche" Try ' If the user clicked on a Search Tile, it will set the date constraint for this search Dim oSearch = ViewSearches.GetRow(ViewSearches.FocusedRowHandle) If oSearch IsNot Nothing AndAlso TypeOf oSearch Is SavedSearch.PredefinedDateSearch Then Dim oDateSearch As SavedSearch.PredefinedDateSearch = oSearch oSearchTitle = oDateSearch.DisplayName SearchRunner.SetDateConstraint(oDateSearch.DateConstraint) Else SearchRunner.SetDateConstraint() End If ' If the user selected a custom date range, process it including the 'with end date' toggle Dim oDateFrom, oDateTo As Date If chkDatefilter2.Checked Then oDateFrom = DateEditFrom.EditValue oDateTo = DateEditTo.EditValue If CheckEdit1.IsOn = False Then oDateTo = Nothing End If Else oDateFrom = Nothing oDateTo = Nothing End If ' Run the actual search Dim oResult As SearchRunner.SearchResult If chkSearchEverywhere.Checked Then Dim oToken = pTokens.First() oResult = Await SearchRunner.RunWithSearchTerm(oToken.TermValue, oDateFrom, oDateTo, oSearchTitle) Else oResult = Await SearchRunner.RunWithTokens(pTokens, oDateFrom, oDateTo, oSearchTitle) End If ' If there was an error, show the message ' otherwise just show the count of results and color it ' if none were found If oResult.OK = False Then SetStatusBarColor(Color.OrangeRed, Color.White) lblResults.Caption = oResult.ErrorMessage ElseIf oResult.Count = 0 Then SetStatusBarColor(Color.OrangeRed, Color.White) lblResults.Caption = $"Keine Ergebnisse" Else lblResults.Caption = $"{oResult.Count} Ergebnisse" End If ' Reset the clicked tile ViewSearches.FocusedRowHandle = GridControl.InvalidRowHandle Catch ex As Exception MsgBox(ex.Message) Finally StopUpdateUI(oHandle) End Try End Function Private Function StartUpdateUI() As IOverlaySplashScreenHandle SetStatusBarColor(Color.FromArgb(255, 240, 240, 240), Color.Black) Dim oHandle = SplashScreenManager.ShowOverlayForm(LayoutControl1) Return oHandle End Function Private Sub StopUpdateUI(pHandle As IOverlaySplashScreenHandle) SplashScreenManager.CloseOverlayForm(pHandle) End Sub Private Sub SetStatusBarColor(pColor As Color, pForeColor As Color) ' Change color for StatusBarBackground Dim element As SkinElement = SkinManager.GetSkinElement(SkinProductId.Ribbon, UserLookAndFeel.Default, "StatusBarBackground") element.Color.SolidImageCenterColor = pColor element.Color.BackColor = pColor element.Color.ForeColor = pForeColor ' Change color for StatusBarFormBackground Dim element2 As SkinElement = SkinManager.GetSkinElement(SkinProductId.Ribbon, UserLookAndFeel.Default, "StatusBarFormBackground") element2.Color.SolidImageCenterColor = pColor element2.Color.BackColor = pColor element2.Color.ForeColor = pForeColor ' Force update of LookAndFeel LookAndFeelHelper.ForceDefaultLookAndFeelChanged() End Sub Private Sub CheckEdit1_Properties_EditValueChanged(sender As Object, e As EventArgs) Handles CheckEdit1.Properties.EditValueChanged DateEditTo.Enabled = CheckEdit1.IsOn End Sub Private Sub SetTokens(pEditor As TokenEdit, Tokens As IEnumerable(Of Token)) pEditor.Properties.Tokens.Clear() AddTokens(pEditor, Tokens) End Sub Private Sub ClearTokens(pEditor As TokenEdit) pEditor.EditValue = Nothing End Sub Private Sub AddTokens(pEditor As TokenEdit, Tokens As IEnumerable(Of Token)) For Each oToken In Tokens Dim oTokenEditToken = New TokenEditToken With { .Description = oToken.ToString, .Value = oToken } pEditor.Properties.Tokens.Add(oTokenEditToken) Next End Sub Private Sub SearchControl2_CustomDrawTokenGlyph(sender As Object, e As TokenEditCustomDrawTokenGlyphEventArgs) Handles txtSearchInput.CustomDrawTokenGlyph ' Set Background according to token type Select Case e.Value.GetType() Case GetType(AttributeValueToken) e.Graphics.FillRectangle(New SolidBrush(Color.FromArgb(255, 255, 214, 49)), e.Bounds) Case GetType(ValueOnlyToken) e.Graphics.FillRectangle(New SolidBrush(Color.FromArgb(255, 255, 214, 49)), e.Bounds) End Select ' Draw the glyph on top ' This fixes: https://supportcenter.devexpress.com/ticket/details/t215578/tokenedit-glyph-is-not-visible-when-customdrawtokentext-is-used e.DefaultDraw() End Sub Private Sub ComboBoxDateAttributes_EditValueChanged(sender As Object, e As EventArgs) Handles ComboBoxDateAttributes.EditValueChanged Dim oEditValue As String = ComboBoxDateAttributes.EditValue If oEditValue = IDB_ADDED_WHEN_String_German Or oEditValue = IDB_ADDED_WHEN_String_Englisch Then SearchRunner.SetDateAttribute() Else SearchRunner.SetDateAttribute(oEditValue) End If End Sub Private Sub TokenEditEx1_Properties_TokenAdding(sender As Object, e As TokenEditTokenAddingEventArgs) Handles txtSearchInput.Properties.TokenAdding ' Prevent adding more than two tokens for now If txtSearchInput.GetTokenList.Count >= 2 Then e.Cancel = True End If End Sub Private Sub BarCheckItem3_CheckedChanged(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles chkDatefilter2.CheckedChanged If chkDatefilter2.Checked Then LayoutControlGroupDate2.Visibility = DevExpress.XtraLayout.Utils.LayoutVisibility.Always Else LayoutControlGroupDate2.Visibility = DevExpress.XtraLayout.Utils.LayoutVisibility.Never End If End Sub Private Sub chkSearchEverywhere_CheckedChanged(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles chkSearchEverywhere.CheckedChanged Dim oTokens As IEnumerable(Of Token) If chkSearchEverywhere.Checked = True Then ' Create a list of tokens that only contains every term once, ' without caring about attribute names. oTokens = GetTokensFromTable(Of ValueOnlyToken)(TokenTable) RibbonPageGroup5.Enabled = False Else ' Create a list of tokens where every term - attribute value is present once. oTokens = GetTokensFromTable(Of AttributeValueToken)(TokenTable) RibbonPageGroup5.Enabled = True End If ClearTokens(txtSearchInput) SetTokens(txtSearchInput, oTokens) End Sub Private Sub chkOperatorAnd_CheckedChanged(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles chkOperatorAnd.CheckedChanged If chkOperatorAnd.Checked And FormLoading = False Then SearchRunner.SetTokenOperator(SearchRunner.TokenOperator.And) End If End Sub Private Sub chkOperatorOr_CheckedChanged(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles chkOperatorOr.CheckedChanged If chkOperatorOr.Checked And FormLoading = False Then SearchRunner.SetTokenOperator(SearchRunner.TokenOperator.Or) End If End Sub Private Sub TokenEditEx1_Properties_TokenAdded(sender As Object, e As TokenEditTokenAddedEventArgs) Handles txtSearchInput.Properties.TokenAdded End Sub Private Sub BarButtonItem2_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles BarButtonItem2.ItemClick FormLoading = True DateEditFrom.EditValue = Nothing DateEditTo.EditValue = Nothing CheckEdit1.IsOn = False ComboBoxDateAttributes.SelectedIndex = 0 txtSearchInput.EditValue = Nothing FormLoading = False End Sub Private Sub chkGridVertical_CheckedChanged(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles chkGridVertical.CheckedChanged ViewSearches.OptionsTiles.Orientation = Orientation.Vertical End Sub Private Sub chkGridHorizontal_CheckedChanged(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles chkGridHorizontal.CheckedChanged ViewSearches.OptionsTiles.Orientation = Orientation.Horizontal End Sub Private Sub BarEditItem1_EditValueChanged(sender As Object, e As EventArgs) Handles BarEditItem1.EditValueChanged ViewSearches.OptionsTiles.ColumnCount = BarEditItem1.EditValue End Sub Private Sub BarEditItem2_EditValueChanged(sender As Object, e As EventArgs) Handles BarEditItem2.EditValueChanged ViewSearches.OptionsTiles.RowCount = BarEditItem2.EditValue End Sub End Class