Modules/GUIs.ZooFlow/Search/frmFlowSearch2.vb
2022-05-18 16:19:51 +02:00

309 lines
12 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.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 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 = LoadBaseSQL()
}
RadioGroup1.Properties.Items.AddRange(LoadDateConstraints.ToArray)
GridControl1.DataSource = LoadPredefinedSearches()
Dim oTokens = GetValueTokensForAttribute()
AddTokens(TokenEditEx1, 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
Public Function GetValueTokensForAttribute() As List(Of AttributeValueToken)
Dim oSQL = $"EXEC PRIDB_SEARCH_AUTOSUGGEST '{My.Application.User.Language}', {My.Application.User.UserId}"
Dim oTable = My.Database.GetDatatableIDB(oSQL)
Dim oTokens As New List(Of AttributeValueToken)
For Each oRow As DataRow In oTable.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 AttributeValueToken() 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 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 Function GetTokens() As IEnumerable(Of AttributeValueToken)
Dim oTokens = TokenEditEx1.GetTokenList()
Return oTokens.Select(Of AttributeValueToken)(Function(token) token.Value)
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 AttributeValueToken)) 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 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 IEnumerable(Of AttributeValueToken))
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
End Class