Modules/GUIs.ZooFlow/Search/frmFlowSearch2.vb

359 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.Views.Tile
Imports DevExpress.XtraSplashScreen
Imports DigitalData.GUIs.ZooFlow.ClassConstants
Imports DigitalData.GUIs.ZooFlow.Search
Imports DigitalData.GUIs.ZooFlow.Search.SearchToken
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 Search As Search.Search
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
Search = New Search.Search(LogConfig, My.Application.User, My.Database)
SearchRunner = New SearchRunner(My.LogConfig, My.Application.GetEnvironment, "FlowSearch") With {
.BaseSearchSQL = LoadBaseSQL()
}
TextEdit1.MaskBox.AutoCompleteSource = AutoCompleteSource.CustomSource
TextEdit1.MaskBox.AutoCompleteMode = AutoCompleteMode.SuggestAppend
TextEdit1.MaskBox.AutoCompleteCustomSource = LoadAutoSuggest()
RadioGroup1.Properties.Items.AddRange(LoadDateConstraints.ToArray)
GridControl1.DataSource = LoadPredefinedSearches()
Dim oTokens = Search.GetValueTokensForAttribute()
AddTokens(TokenEdit1, oTokens)
End Sub
Private Function LoadBaseSQL() As String
Dim oSQL = ""
For Each oRow As DataRow In My.Tables.DTIDB_COMMON_SQL.Rows
If oRow.Item("TITLE") = SQLCMD_FLOW_SEARCH_BASE Then
oSQL = oRow.Item("SQL_COMMAND")
oSQL = oSQL.Replace("@USER_ID", My.Application.User.UserId)
oSQL = oSQL.Replace("@LANG_CODE", My.Application.User.Language)
End If
Next
Return oSQL
End Function
Private Function LoadAutoSuggest() As AutoCompleteStringCollection
Dim oCollection As New AutoCompleteStringCollection
Dim oSql = $"EXEC PRIDB_SEARCH_AUTOSUGGEST '{My.Application.User.Language}',{My.Application.User.UserId}"
Dim oTable As DataTable = My.Database.GetDatatableIDB(oSql)
If oTable Is Nothing Then
Return New AutoCompleteStringCollection()
End If
For Each oRow As DataRow In oTable.Rows
oCollection.Add(oRow.Item("TERM"))
Next
Return oCollection
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 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("day")
},
New PredefinedDateSearch() With {
.Name = "Gestern",
.Description = "Dokumente, die gestern abgelegt wurden",
.DateConstraint = SearchRunner.DateConstraint.Yesterday,
.Image = SvgImageCollection1.Item("day")
},
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")
}
}
End Function
Private Async Sub TextEdit1_KeyUp(sender As Object, e As KeyEventArgs) Handles TextEdit1.KeyUp
If e.KeyCode = Keys.Enter Then
Await RunSearch(TextEdit1.EditValue)
End If
End Sub
Private Async Sub SearchControl2_KeyUp(sender As Object, e As KeyEventArgs) Handles TokenEdit1.KeyUp
If e.KeyCode = Keys.Enter And TokenEdit1.IsPopupOpen = False Then
Dim oTokens = TokenEdit1.GetTokenList()
Dim oFirstToken = oTokens.FirstOrDefault()
If oFirstToken Is Nothing Then
Exit Sub
End If
Dim oTokenValue As TokenValue = oFirstToken.Value
Await RunSearch(oTokenValue.Value)
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
Await RunSearch(TextEdit1.EditValue)
End If
End Sub
Private Async Function RunSearch(pSearchTerm As String) As Threading.Tasks.Task
Dim oHandle = StartUpdateUI()
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(pSearchTerm, oDateFrom, oDateTo)
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 RadioGroup1.EditValueChanged
Dim oIndex = RadioGroup1.SelectedIndex
Dim oItem As RadioGroupItem = RadioGroup1.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 chkDateFilter_CheckedChanged(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles chkDateFilter.CheckedChanged
If chkDateFilter.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 SetTokens(Editor As TokenEdit, Tokens As Dictionary(Of String, Object))
Editor.Properties.Tokens.Clear()
AddTokens(Editor, Tokens)
End Sub
Private Sub AddTokens(Editor As TokenEdit, Tokens As Dictionary(Of String, Object))
For Each oToken In Tokens
Dim oTokenEditToken = New TokenEditToken With {
.Description = oToken.Key,
.Value = oToken.Value
}
Editor.Properties.Tokens.Add(oTokenEditToken)
Next
End Sub
'Private Sub SearchControl2_Properties_TokenAdded(sender As Object, e As DevExpress.XtraEditors.TokenEditTokenAddedEventArgs) Handles TokenEdit1.Properties.TokenAdded
' Dim oEditor As TokenEdit = sender
' SetNewTokens(oEditor)
'End Sub
'Private Sub SearchControl2_Properties_TokenRemoved(sender As Object, e As TokenEditTokenRemovedEventArgs) Handles TokenEdit1.Properties.TokenRemoved
' Dim oEditor As TokenEdit = sender
' SetNewTokens(oEditor)
'End Sub
Private Sub SetNewTokens(pEditor As TokenEdit)
Dim oLastToken = pEditor.GetTokenList().LastOrDefault()
pEditor.Properties.BeginUpdate()
If pEditor.GetTokenList().Count > 0 Then
SetTokens(pEditor, TokenListDefault)
Search.InputMode = InputMode.Default
Else
SetTokens(pEditor, New Dictionary(Of String, Object))
Search.InputMode = InputMode.Default
End If
'If oLastToken IsNot Nothing Then
' Select Case oLastToken.Value.GetType
' Case GetType(AttributeKeyToken)
' ' After the attribute key comes an operator
' SetTokens(pEditor, Search.GetOperatorTokens(GetType(String)))
' Search.InputMode = InputMode.Operator
' Case GetType(AttributeOperatorToken)
' ' After the attribute operator comes a value
' SetTokens(pEditor, TokenListAttrValues)
' Search.InputMode = InputMode.Value
' Case GetType(AttributeValueToken)
' ' After the attribute value comes another value
' SetTokens(pEditor, TokenListAttrValues)
' Search.InputMode = InputMode.Value
' Case Else
' SetTokens(pEditor, TokenListDefault)
' Search.InputMode = InputMode.Default
' End Select
'Else
' SetTokens(pEditor, TokenListDefault)
' Search.InputMode = InputMode.Default
'End If
pEditor.Properties.EndUpdate()
End Sub
Private Sub SearchControl2_CustomDrawTokenGlyph(sender As Object, e As TokenEditCustomDrawTokenGlyphEventArgs) Handles TokenEdit1.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
End Class