Monorepo/GUIs.ZooFlow/Search/frmSearchFlow.vb
2022-06-02 16:41:53 +02:00

343 lines
14 KiB
VB.net

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.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 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
SearchLoader = New SearchLoader(My.LogConfig, My.UIConfigManager, SvgImageCollection1)
SearchRunner = New SearchRunner(My.LogConfig, My.Application.GetEnvironment, "FlowSearch") With {
.BaseSearchSQL = SQL_FLOW_SEARCH_BASE
}
TokenTable = GetTokenTable()
ComboBoxDateAttributes.Properties.Items.AddRange(LoadDateAttributes())
ComboBoxDateAttributes.SelectedIndex = 0
Dim oSearchBindingList As New BindingSource() With {
.DataSource = SearchLoader.LoadSearches()
}
GridSearches.DataSource = oSearchBindingList
Dim oTokens = GetTokensFromTable(Of AttributeValueToken)(TokenTable)
AddTokens(txtSearchInput, oTokens)
ViewSearches.FocusedRowHandle = GridControl.InvalidRowHandle
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)
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()
End Function
Private Function LoadDateAttributes() As List(Of String)
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
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
Await RunSearch2(GetTokens())
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 SearchLoader.PredefinedDateSearch Then
Dim oDateSearch As SearchLoader.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 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
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 TileView1_CustomItemTemplate(sender As Object, e As TileViewCustomItemTemplateEventArgs) Handles ViewSearches.CustomItemTemplate
Dim oSearch = ViewSearches.GetRow(e.RowHandle)
'If TypeOf oSearch Is PredefinedDateSearch Then
' e.Template = e.Templates.Item("DefaultSmall")
'Else
' e.Template = e.Templates.Item("Default")
'End If
e.Template = e.Templates.Item("Default")
End Sub
Private Sub btnSaveSearch_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles btnSaveSearch.ItemClick
SearchLoader.CreateCustomSearch("TestSearch", "Some Stuff", GetTokens(), "invoice")
GridSearches.DataSource = SearchLoader.LoadSearches()
End Sub
End Class