Imports DevExpress.LookAndFeel Imports DevExpress.Skins Imports DevExpress.Utils.Svg Imports DevExpress.XtraEditors Imports DevExpress.XtraEditors.Controls Imports DevExpress.XtraGrid.Views.Tile Imports DevExpress.XtraSplashScreen Imports DigitalData.GUIs.ZooFlow.ClassConstants Imports DigitalData.GUIs.ZooFlow.Search Imports DigitalData.GUIs.ZooFlow.Search.SearchToken Imports DigitalData.Modules.Language Imports DigitalData.Modules.Logging Public Class frmFlowSearch2 Private ReadOnly LogConfig As LogConfig = My.LogConfig Private ReadOnly Logger = My.LogConfig.GetLogger() Private SearchRunner As SearchRunner Private TokenTable As DataTable = Nothing Private FormLoading As Boolean = True Private TokenListDefault As New Dictionary(Of String, Object) Private TokenListOperands As New Dictionary(Of String, Object) Private TokenListAttrValues As New Dictionary(Of String, Object) Private Sub frmFlowSearch2_Load(sender As Object, e As EventArgs) Handles MyBase.Load SearchRunner = New SearchRunner(My.LogConfig, My.Application.GetEnvironment, "FlowSearch") With { .BaseSearchSQL = SQL_FLOW_SEARCH_BASE } TokenTable = GetTokenTable() RadioGroupDateConstraints.Properties.Items.AddRange(LoadDateConstraints().ToArray) ComboBoxDateAttributes.Properties.Items.AddRange(LoadDateAttributes()) GridPredefinedSearches.DataSource = LoadPredefinedSearches() Dim oTokens = GetTokensFromTable(Of AttributeValueToken)(TokenTable) AddTokens(TokenEditEx1, oTokens) FormLoading = False 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) Dim oTokens As New List(Of T) 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) oTokens.Add(New T() With { .AttributeId = oAttributeId, .AttributeTitle = oAttributeTitle, .TermId = oTermId, .TermValue = oTermValue }) Next Return oTokens.Distinct().ToList() End Function Private Function LoadDateConstraints() As List(Of RadioGroupItem) Return New List(Of RadioGroupItem) From { New RadioGroupItem(SearchRunner.CREATED_TODAY, "Heute"), New RadioGroupItem(SearchRunner.CREATED_TOMORROW, "Gestern"), New RadioGroupItem(SearchRunner.CREATED_LAST_7_DAYS, "Letzte 7 Tage"), New RadioGroupItem(SearchRunner.CREATED_MONTH_CURR, "Dieser Monat"), New RadioGroupItem(SearchRunner.CREATED_LAST_7_DAYS, "Letzter Monat"), New RadioGroupItem(SearchRunner.CREATED_YEAR_CURRENT, "Dieses Jahr"), New RadioGroupItem(SearchRunner.CREATED_YEAR_LAST, "Letztes Jahr"), New RadioGroupItem("NOTHING", "Keine Einschränkung") } End Function Private Function LoadDateAttributes() As List(Of String) Return 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() End Function Private Function LoadPredefinedSearches() As List(Of PredefinedSearch) Return New List(Of PredefinedSearch) From { New PredefinedDateSearch() With { .Name = "Heute", .Description = "Dokumente, die heute abgelegt wurden", .DateConstraint = SearchRunner.DateConstraint.Today, .Image = SvgImageCollection1.Item("today") }, New PredefinedDateSearch() With { .Name = "Gestern", .Description = "Dokumente, die gestern abgelegt wurden", .DateConstraint = SearchRunner.DateConstraint.Yesterday, .Image = SvgImageCollection1.Item("yesterday") }, New PredefinedDateSearch() With { .Name = "Letzte Woche", .Description = "Dokumente, die in den letzten 7 Tagen abgelegt wurden", .DateConstraint = SearchRunner.DateConstraint.Last7Days, .Image = SvgImageCollection1.Item("week") }, New PredefinedDateSearch() With { .Name = "Dieser Monat", .Description = "Dokumente, die in diesem Monat abgelegt wurden", .DateConstraint = SearchRunner.DateConstraint.CurrentMonth, .Image = SvgImageCollection1.Item("month") }, New PredefinedDateSearch() With { .Name = "Letzter Monat", .Description = "Dokumente, die im letzten Monat abgelegt wurden", .DateConstraint = SearchRunner.DateConstraint.LastMonth, .Image = SvgImageCollection1.Item("month") }, New PredefinedDateSearch() With { .Name = "Dieses Jahr", .Description = "Dokumente, die in diesem Jahr abgelegt wurden", .DateConstraint = SearchRunner.DateConstraint.CurrentYear, .Image = SvgImageCollection1.Item("year") }, New PredefinedDateSearch() With { .Name = "Letztes Jahr", .Description = "Dokumente, die im letzten Jahr abgelegt wurden", .DateConstraint = SearchRunner.DateConstraint.LastYear, .Image = SvgImageCollection1.Item("year") } } End Function Private Function GetTokens() As IEnumerable(Of AttributeValueToken) Dim oTokens = TokenEditEx1.GetTokenList() Return oTokens.Select(Of AttributeValueToken)(Function(token) token.Value).ToList() End Function Private Async Sub TextEdit1_KeyUp(sender As Object, e As KeyEventArgs) Handles TextEdit1.KeyUp If e.KeyCode = Keys.Enter Then Dim oTokens = GetTokens() Await RunSearch(oTokens) End If End Sub Private Async Sub SearchControl2_KeyUp(sender As Object, e As KeyEventArgs) Handles TokenEditEx1.KeyUp If e.KeyCode = Keys.Enter And TokenEditEx1.IsPopupOpen = False Then Dim oTokens = GetTokens() Await RunSearch(oTokens) End If End Sub Private Async Sub TextEdit1_ButtonClick(sender As Object, e As DevExpress.XtraEditors.Controls.ButtonPressedEventArgs) Handles TextEdit1.ButtonClick If e.Button.Tag = "SEARCH" Then Dim oTokens = GetTokens() Await RunSearch(oTokens) End If End Sub Private Async Function RunSearch(pTokens As IEnumerable(Of Token)) As Threading.Tasks.Task Dim oHandle = StartUpdateUI() If pTokens.Count = 0 Then Exit Function End If Try Dim oDateFrom = DateEditFrom.EditValue Dim oDateTo = DateEditTo.EditValue If CheckEdit1.IsOn = False Then oDateTo = Nothing End If SearchRunner.SetDateConstraint() Dim oResult = Await SearchRunner.RunWithSearchTerm(String.Empty, oDateFrom, oDateTo, pTokens, "") If oResult.OK = False Then SetStatusBarColor(Color.OrangeRed) End If lblResults.Caption = $"{oResult.Count} Ergebnisse" Catch ex As Exception MsgBox(ex.Message) Finally StopUpdateUI(oHandle) End Try End Function Private Async Sub TileView1_ItemClick(sender As Object, e As TileViewItemClickEventArgs) Handles TileView1.ItemClick Dim oHandle = StartUpdateUI() Try Dim oSearch = TileView1.GetRow(TileView1.FocusedRowHandle) Dim oSearchTitle As String = "Suche" If TypeOf oSearch Is PredefinedDateSearch Then Dim oDateSearch As PredefinedDateSearch = oSearch oSearchTitle = oDateSearch.DisplayName SearchRunner.SetDateConstraint(oDateSearch.DateConstraint) End If Dim oResult = Await SearchRunner.RunWithSearchTerm("", oSearchTitle) If oResult.Count = 0 Then SetStatusBarColor(Color.OrangeRed) End If lblResults.Caption = $"{oResult.Count} Ergebnisse" Catch ex As Exception MsgBox(ex.Message) Finally StopUpdateUI(oHandle) End Try End Sub Private Function StartUpdateUI() As IOverlaySplashScreenHandle SetStatusBarColor(Color.FromArgb(255, 240, 240, 240)) 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) ' Change color for StatusBarBackground Dim element As SkinElement = SkinManager.GetSkinElement(SkinProductId.Ribbon, UserLookAndFeel.Default, "StatusBarBackground") element.Color.SolidImageCenterColor = pColor element.Color.BackColor = pColor ' Change color for StatusBarFormBackground Dim element2 As SkinElement = SkinManager.GetSkinElement(SkinProductId.Ribbon, UserLookAndFeel.Default, "StatusBarFormBackground") element2.Color.SolidImageCenterColor = pColor element2.Color.BackColor = pColor ' Force update of LookAndFeel LookAndFeelHelper.ForceDefaultLookAndFeelChanged() End Sub Private Sub RadioGroup1_EditValueChanged(sender As Object, e As EventArgs) Handles RadioGroupDateConstraints.EditValueChanged Dim oIndex = RadioGroupDateConstraints.SelectedIndex Dim oItem As RadioGroupItem = RadioGroupDateConstraints.Properties.Items.Item(oIndex) Dim oSearchConstraintString As String = oItem.Value Dim oDateConstraint = SearchRunner.ConstantToDateConstraint(oSearchConstraintString) If oDateConstraint <> SearchRunner.DateConstraint.Undefined Then SearchRunner.SetDateConstraint(oDateConstraint) End If End Sub Friend Class PredefinedSearch Public Property Name As String Public Property Description As String Public Property Image As SvgImage Public Property Count As Integer = 0 Public ReadOnly Property DisplayName As String Get Return Name End Get End Property End Class Friend Class PredefinedSQLSearch Public Property SQLCommand As String End Class Friend Class PredefinedDateSearch Inherits PredefinedSearch Public DateConstraint As SearchRunner.DateConstraint End Class Private Sub CheckEdit1_Properties_EditValueChanged(sender As Object, e As EventArgs) Handles CheckEdit1.Properties.EditValueChanged DateEditTo.Enabled = CheckEdit1.IsOn End Sub Private Sub SetTokens(Editor As TokenEdit, Tokens As IEnumerable(Of Token)) Editor.Properties.Tokens.Clear() AddTokens(Editor, Tokens) End Sub Private Sub AddTokens(Editor As TokenEdit, Tokens As IEnumerable(Of Token)) For Each oToken In Tokens Dim oTokenEditToken = New TokenEditToken With { .Description = oToken.ToString, .Value = oToken } Editor.Properties.Tokens.Add(oTokenEditToken) Next End Sub Private Sub SearchControl2_CustomDrawTokenGlyph(sender As Object, e As TokenEditCustomDrawTokenGlyphEventArgs) Handles TokenEditEx1.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 Else 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 SearchRunner.SetDateAttribute(ComboBoxDateAttributes.EditValue) End Sub Private Sub TokenEditEx1_Properties_TokenAdding(sender As Object, e As TokenEditTokenAddingEventArgs) Handles TokenEditEx1.Properties.TokenAdding ' Prevent adding more than two tokens for now If TokenEditEx1.GetTokenList.Count >= 2 Then e.Cancel = True End If End Sub Private Sub BarToggleSwitchItem2_CheckedChanged(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) End Sub Private Sub BarCheckItem3_CheckedChanged(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles chkDatefilter2.CheckedChanged If chkDatefilter2.Checked Then LayoutControlGroupDate1.Visibility = DevExpress.XtraLayout.Utils.LayoutVisibility.Always LayoutControlGroupDate2.Visibility = DevExpress.XtraLayout.Utils.LayoutVisibility.Always Else LayoutControlGroupDate1.Visibility = DevExpress.XtraLayout.Utils.LayoutVisibility.Never 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) Else ' Create a list of tokens where every term - attribute value is present once. oTokens = GetTokensFromTable(Of AttributeValueToken)(TokenTable) End If SetTokens(TokenEditEx1, 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 End Class