Imports DigitalData.Modules.Logging Imports DevExpress.XtraEditors Imports DigitalData.GUIs.Common Imports DevExpress.XtraSplashScreen Imports DevExpress.XtraBars Imports DigitalData.GUIs.ZooFlow.ClassConstants Imports DevExpress.Utils Public Class frmFlowSearch Private Logger As Logger Private FontLargeBold As New Font("Segoe UI", 10, FontStyle.Bold) Private FontLargeNormal As New Font("Segoe UI", 10) Private SecondaryFontBold As New Font("Segoe UI", 8, FontStyle.Bold) Private SecondaryFont As New Font("Segoe UI", 8) Dim oLastAttribute As String = "" Dim oAttributeCount As Integer = 1 Dim BASE_SEARCHCommand As String Private LastSearchForm As frmDocumentResultList Private ASorDB As ClassDataASorDB Private EventtoggleChange As Boolean = False Private SEARCH_FACT_DATE As String = "MONTH(OBJ.ADDED_WHEN) <> 13" Private SEARCH_FACT_DATE_ATTRIBUTE = "ADDED_WHEN" Private Language_Term_Object As String Private LIMITATION_DATE As Boolean = False Private TOGGLE_Change As Boolean = False Private CATEGORIES_SELECTED As String = "" Public Sub New(pBaseSearchSql As String) ' Dieser Aufruf ist für den Designer erforderlich. InitializeComponent() BASE_SEARCHCommand = pBaseSearchSql ' Fügen Sie Initialisierungen nach dem InitializeComponent()-Aufruf hinzu. Logger = My.LogConfig.GetLogger() ASorDB = New ClassDataASorDB(My.LogConfig) If My.Application.User.Language = "de-DE" Then Language_Term_Object = "Objekte" Else Language_Term_Object = "objects" End If End Sub Private Sub frmFlowSearch_Load(sender As Object, e As EventArgs) Handles Me.Load Try RibbonControl1.Minimized = True TileControlMatch.Groups.Clear() Dim oSQL = "select DISTINCT TERM_VALUE AS CATEGORY ,ATTRIBUTE_ID from VWIDB_CATEGORIES_PER_OBJECT_AND_LANGUAGE WHERE LANGUAGE_ID = @LANGUAGE_ID ORDER BY TERM_VALUE" Dim oDTCategory As DataTable = ASorDB.GetDatatable("IDB", $"SELECT 'NONE' as CATEGORY", "VWIDB_CATEGORIES_PER_OBJECT_AND_LANGUAGE", "", "CATEGORY") If Not IsNothing(oDTCategory) Then CheckedListBoxCategories.DataSource = oDTCategory CheckedListBoxCategories.DisplayMember = "CATEGORY" End If If My.Application.User.Language = "de-DE" Then cmbAttributeDate.Items.Add(IDB_ADDED_WHEN_String_German) Else cmbAttributeDate.Items.Add(IDB_ADDED_WHEN_String_Englisch) End If Dim oDT As DataTable = ASorDB.GetDatatable("IDB", $"SELECT * FROM VWIDB_BE_ATTRIBUTE WHERE TYPE_ID = 5 AND LANG_ID = {My.Application.User.LanguageID}", "VWIDB_BE_ATTRIBUTE", $"TYPE_ID = 5 AND LANG_ID = {My.Application.User.LanguageID}") For Each oRow As DataRow In oDT.Rows cmbAttributeDate.Items.Add(oRow.Item("ATTR_TITLE")) Next 'Dim editor As BarEditItem = BarEditItemDate ' editor = TryCast(BarEditItemDate, ComboBoxEdit) If My.Application.User.Language = "de-DE" Then cmbAttributeDate.SelectedIndex = 0 ' BarEditItemDate.EditValue = "Erstellt Wann" Else cmbAttributeDate.SelectedIndex = 1 ' BarEditItemDate.EditValue = "Added when" End If Catch ex As Exception MsgBox(ex.Message, MsgBoxStyle.Critical) Logger.Error(ex) End Try End Sub Private Sub txtSearch_TextChanged(sender As Object, e As EventArgs) Handles txtSearchTerm.TextChanged Try If txtSearchTerm.Text = String.Empty Then Reset_Form() Exit Sub End If lblFoundResult.Visible = False Start_FlowSearch() Catch ex As Exception lblFoundResult.Text = "Unexpected error in FlowSearch - Check Your log" lblFoundResult.Visible = True Logger.Error(ex) End Try End Sub Sub Reset_Form() TileControlMatch.Groups.Clear() lblFoundResult.Visible = False End Sub Sub SearchContent() Try If txtSearchTerm.Text = String.Empty Then Exit Sub End If GET_SELECTED_CATEGORIES() Dim oSearchValue = Trim(txtSearchTerm.Text) oLastAttribute = "" Dim oSQL = BASE_SEARCHCommand.Replace("@SEARCH_STRING", oSearchValue) If SEARCH_FACT_DATE_ATTRIBUTE = "ADDED_WHEN" Then oSQL = oSQL.Replace("MONTH(OBJ.ADDED_WHEN) <> 13", SEARCH_FACT_DATE) Else oSQL = oSQL.Replace("MONTH(OBJ.ADDED_WHEN) <> 13", SEARCH_FACT_DATE) oSQL = oSQL.Replace("--INNER JOIN VWIDB_GROUP_DATA_DATE", "INNER JOIN VWIDB_GROUP_DATA_DATE") End If If CATEGORIES_SELECTED <> String.Empty Then oSQL = oSQL.Replace("--AND ATTR.TITLE IN ('')", $"AND ATTR.TITLE IN ({CATEGORIES_SELECTED})") End If Dim oResultCountAttributes As Integer = 0 TileControlMatch.Groups.Clear() Dim oResultsfromSearchDT As DataTable = My.DatabaseIDB.GetDatatable(oSQL) If Not IsNothing(oResultsfromSearchDT) Then Dim oView As DataView = New DataView(oResultsfromSearchDT) Dim oDTDistinctValues As DataTable = oView.ToTable(True, "ATTRIBUTE", "ATTR_ID") Dim oGroups = oResultsfromSearchDT.AsEnumerable().GroupBy(Function(row) row.Field(Of String)("ATTRIBUTE")) Dim oNewTable As New DataTable oNewTable.Columns.Add("ATTRIBUTE") oNewTable.Columns.Add("COUNT", Type.GetType("System.Int32")) For Each oGroup In oGroups oNewTable.Rows.Add(oGroup.Key, oGroup.Sum(Function(row) row.Field(Of Int32)("COUNT_OBJ"))) Next If Not IsNothing(oNewTable) Then Dim oAttrCount As Integer = 0 For Each orow As DataRow In oNewTable.Rows oAttrCount += 1 oResultCountAttributes += orow.Item(1) Next lblFoundResult.Text = GetResultString(oResultCountAttributes, oAttrCount, oSearchValue) TileControlMatch.Text = GetResultString(oResultCountAttributes, oAttrCount, oSearchValue) lblFoundResult.Visible = True End If oNewTable.DefaultView.Sort = "COUNT ASC" oNewTable = oNewTable.DefaultView.ToTable '#### CREATE THE GROUPS FOR EACH ATTRIBUTE #### For Each oGroupRow As DataRow In oNewTable.Rows Dim oGroup As New TileGroup oGroup.Text = $"{oGroupRow.Item(0).ToString} ({oGroupRow.Item(1).ToString} {Language_Term_Object})" oGroup.Tag = oGroupRow.Item(0) oGroup.Visible = True For Each oitemRow As DataRow In oResultsfromSearchDT.Rows If oitemRow.Item("ATTRIBUTE") = oGroupRow.Item(0) Then Dim oItem = CreateTile(oitemRow.Item("TERM_VALUE"), oitemRow.Item("COUNT_OBJ"), oGroupRow.Item(0).ToString, oitemRow.Item("ATTR_ID"), oitemRow.Item("TERM_GUID")) If Not IsNothing(oItem) Then oGroup.Items.Add(oItem) End If End If Next TileControlMatch.Groups.Add(oGroup) Next 'Wenn weniger als 45 Belege gefunden wurden wird direkt die Suche ausgeführt If oResultCountAttributes > 0 And oResultCountAttributes <= 45 Then StartSearch_Full(oSearchValue, "") Else If oResultsfromSearchDT.Rows.Count = 0 Then Reset_Form() lblFoundResult.Text = "No Results" lblFoundResult.Visible = True End If End If Else lblFoundResult.Text = "Result from DB Is Nothing..Check SQL" lblFoundResult.Visible = True End If Catch ex As Exception Logger.Error(ex) lblFoundResult.Text = $"Unexpected Error in SearchContent {ex.Message}" lblFoundResult.Visible = True End Try End Sub Private Function StartSearch_Full(pSearchValue As String, pOptAttribute As String) As Boolean Dim oHandle As IOverlaySplashScreenHandle = Nothing Dim oItemsFound As Boolean = False Dim oSearchData = My.Application.Search Try oHandle = SplashScreenManager.ShowOverlayForm(Me) Dim oEXECSQL = $"EXEC PRFLOW_SEARCH_GET_RESULT '{pSearchValue}','{SEARCH_FACT_DATE}', {My.Application.User.UserId},'{oSearchData.SelectInStringAttributeIds}','{oSearchData.SelectInIntegerAttributeIds}',{My.Application.User.LanguageID},'{pOptAttribute}'" Dim oDTOBJECT_RESULT As DataTable = My.DatabaseIDB.GetDatatable(oEXECSQL) If Not IsNothing(oDTOBJECT_RESULT) Then If oDTOBJECT_RESULT.Rows.Count = 0 Then lblFoundResult.Text = "No Results" lblFoundResult.Visible = True Return False End If oItemsFound = True OpenResultForm(oDTOBJECT_RESULT) End If Catch ex As Exception MsgBox(ex.Message, MsgBoxStyle.Critical, Text) Finally SplashScreenManager.CloseOverlayForm(oHandle) End Try Return oItemsFound End Function Private Sub OpenResultForm(pDTRESULT As DataTable) Try Dim oEnvironment As New Modules.ZooFlow.Environment() With { .User = My.Application.User, .Modules = My.Application.Modules, .Database = My.Database, .DatabaseIDB = My.DatabaseIDB, .Settings = My.Application.Settings, .Service = My.Application.Service } Dim oShortGuid = Guid.NewGuid() Dim oWindowGuid = $"FLOWSEARCH-{My.User.Name}" Dim oParams = New DocumentResultParams() With { .WindowGuid = oWindowGuid, .Results = New List(Of DocumentResult) From { New DocumentResult() With { .Title = "FlowSearchResult", .Datatable = pDTRESULT } } } Dim oForm As New frmDocumentResultList(My.LogConfig, oEnvironment, oParams) oForm.Show() LastSearchForm = oForm ' Position Result Window below this window LastSearchForm.Location = GetResultFormLocation() LastSearchForm.Size = GetResultFormSize() Catch ex As Exception Logger.Error(ex) End Try End Sub Private Function GetResultFormLocation() As Point Return Location End Function Private Function GetResultFormSize() As Size Return Size End Function Private Function GetResultString(CountObjects As Integer, CountAttribute As Integer, SearchContent As String) As String Dim oResultString = $"wurden {CountObjects} Objekte" ' IIf(CountAttribute = 1, $"wurden {CountObjects} Objekte", $"wurden {CountObjects} Objekte in {CountAttribute} Attributen") Dim oProfileString = IIf(CountAttribute = 1, "einem Attribut", $"{CountAttribute} Attributen") Dim oBase = "Es {0} in {1} für Ihre Suche nach '{2}' gefunden:" Return String.Format(oBase, oResultString, oProfileString, SearchContent) End Function Private Function CreateTile(pTermValue As String, pCount_Obj As String, pAttribute As String, pAttributeID As String, pTermGuid As Long) As TileItem Try Dim oItem As New TileItem() With {.Tag = $"{pTermGuid}|{pAttributeID}"} If oLastAttribute <> pAttribute Then oAttributeCount = 1 oLastAttribute = pAttribute oItem.ItemSize = TileItemSize.Wide oItem.AppearanceItem.Normal.BackColor = Color.FromArgb(165, 36, 49) ' GELB 255, 214, 47) Else oItem.ItemSize = TileItemSize.Medium oItem.AppearanceItem.Normal.BackColor = Color.White End If oAttributeCount += 1 oItem.Elements.Clear() Dim oNameElement = New TileItemElement With { .Text = pTermValue, .TextAlignment = TileItemContentAlignment.TopLeft } Select Case oItem.ItemSize Case TileItemSize.Wide oNameElement.Appearance.Normal.Font = FontLargeBold oNameElement.Appearance.Normal.ForeColor = Color.White Case Else oNameElement.Appearance.Normal.Font = SecondaryFontBold oNameElement.Appearance.Normal.ForeColor = Color.FromArgb(165, 36, 49) End Select 'oNameElement.Appearance.Normal.ForeColor = Color.Black oItem.Elements.Add(oNameElement) 'Dim oCommentElement = New TileItemElement With { ' .Text = "Anzahl Objekte: " & pCount_Obj, ' .TextAlignment = TileItemContentAlignment.MiddleLeft '} 'Select Case oItem.ItemSize ' Case TileItemSize.Wide ' oCommentElement.Appearance.Normal.Font = FontLargeNormal ' Case Else ' oCommentElement.Appearance.Normal.Font = SecondaryFont 'End Select 'oCommentElement.Appearance.Normal.ForeColor = Color.Black 'oItem.Elements.Add(oCommentElement) Dim oCountElement = New TileItemElement With { .Text = "Anzahl Objekte: " & pCount_Obj, .TextAlignment = TileItemContentAlignment.BottomRight } Select Case oItem.ItemSize Case TileItemSize.Wide oCountElement.Appearance.Normal.Font = FontLargeNormal oCountElement.Appearance.Normal.ForeColor = Color.White Case Else oCountElement.Appearance.Normal.Font = SecondaryFont oCountElement.Appearance.Normal.ForeColor = Color.FromArgb(165, 36, 49) End Select oItem.Elements.Add(oCountElement) Return oItem Catch ex As Exception Logger.Error(ex) Return Nothing End Try End Function Private Sub txtSearch_GotFocus(sender As Object, e As EventArgs) Handles txtSearchTerm.GotFocus Label1.Visible = True Dim oTEXTBOX As TextBox = CType(sender, TextBox) oTEXTBOX.BackColor = Color.FromArgb(255, 214, 47) End Sub Private Sub txtSearchTerm_Leave(sender As Object, e As EventArgs) Handles txtSearchTerm.Leave Dim oTEXTBOX As TextBox = CType(sender, TextBox) oTEXTBOX.BackColor = Color.White End Sub Sub GET_SELECTED_CATEGORIES() CATEGORIES_SELECTED = "" Dim i As Integer = 0 For Each item As Object In CheckedListBoxCategories.CheckedItems Dim row As DataRowView = TryCast(item, DataRowView) Dim oItem = $"'{row("CATEGORY")}'" If i = 0 Then CATEGORIES_SELECTED = oItem End If If Not CATEGORIES_SELECTED.StartsWith(oItem) Then CATEGORIES_SELECTED &= String.Format(",{0}", oItem) End If i += 1 Next item End Sub Private Sub TileControlMatch_ItemClick(sender As Object, e As TileItemEventArgs) Handles TileControlMatch.ItemClick Try Dim oItem As TileItem = e.Item Dim oItemTag = oItem.Tag Dim oHandle As IOverlaySplashScreenHandle = Nothing Dim oItemsFound As Boolean = False Dim oSearchData = My.Application.Search Dim oSplit = oItem.Tag.ToString.Split("|") Try oHandle = SplashScreenManager.ShowOverlayForm(Me) Dim oDT As DataTable = ASorDB.GetDatatable("IDB", $"SELECT * FROM VWIDB_BE_ATTRIBUTE WHERE ATTR_ID = {oSplit(1)} AND LANG_ID = {My.Application.User.LanguageID}", "VWIDB_BE_ATTRIBUTE", $"ATTR_ID = {oSplit(1)} AND LANG_ID = {My.Application.User.LanguageID}") Dim oType = oDT.Rows(0).Item("TYPE_NAME") Dim oEXECSQL = $"EXEC PRFLOW_SEARCH_GET_RESULT_PER_TILE {oSplit(0)},{My.Application.User.UserId},'{oType}',{oSplit(1)},'{My.Application.User.Language}'" Dim oDTOBJECT_RESULT As DataTable = My.DatabaseIDB.GetDatatable(oEXECSQL) If Not IsNothing(oDTOBJECT_RESULT) Then oItemsFound = True OpenResultForm(oDTOBJECT_RESULT) End If Catch ex As Exception MsgBox(ex.Message, MsgBoxStyle.Critical, Text) Finally SplashScreenManager.CloseOverlayForm(oHandle) End Try Catch ex As Exception MsgBox($"Error while loading Searches: " & vbNewLine & ex.Message, MsgBoxStyle.Critical, Text) Logger.Error(ex) End Try End Sub Private Function GET_DATE_LIMITATION(pInput As String) As String Try Dim oReturn As String If SEARCH_FACT_DATE_ATTRIBUTE = "ADDED_WHEN" Then Return pInput.Replace("@ATTRIBUTE", "OBJ.ADDED_WHEN") Else Dim oSTR = $"GRPDATE.[{SEARCH_FACT_DATE_ATTRIBUTE}]" Return pInput.Replace("@ATTRIBUTE", oSTR) End If Catch ex As Exception Return pInput Logger.Error(ex) End Try End Function Sub Start_FlowSearch(Optional AllOver As Boolean = False) If txtSearchTerm.Text <> String.Empty Or AllOver = True Then SearchContent() End If End Sub Private Sub btnFindAll_Click(sender As Object, e As EventArgs) End Sub Private Sub CheckButton1_CheckedChanged(sender As Object, e As EventArgs) Handles CheckButton1.CheckedChanged If LIMITATION_DATE = True Then Dim result As MsgBoxResult If My.Application.User.Language = "de-DE" Then result = MessageBox.Show("Wollen Sie wirklich eine Suche über alle Objekte starten?", "Bestätigung erforderlich:", MessageBoxButtons.YesNo, MessageBoxIcon.Question) Else result = MessageBox.Show("Do You really want to start a search without limitation?", "Confirmation needed:", MessageBoxButtons.YesNo, MessageBoxIcon.Question) End If If result = MsgBoxResult.No Then Exit Sub End If End If StartSearch_Full("", "") CheckButton1.Checked = True End Sub Private Sub TileControlMatch_Click(sender As Object, ByVal e As MouseEventArgs) Handles TileControlMatch.Click Dim tc As TileControl = TryCast(sender, TileControl) Dim hi = tc.CalcHitInfo(e.Location) If hi.HitTest = DevExpress.XtraEditors.TileControlHitTest.GroupCaption Then Console.WriteLine(hi.GroupInfo.Group.Tag) StartSearch_Full(RTrim(LTrim(txtSearchTerm.Text)), hi.GroupInfo.Group.Tag) End If End Sub Private Sub cmbAttributeDate_SelectedIndexChanged(sender As Object, e As EventArgs) Handles cmbAttributeDate.SelectedIndexChanged If cmbAttributeDate.SelectedIndex <> -1 Then Try Dim oEditValue As String = cmbAttributeDate.SelectedItem.ToString If oEditValue = IDB_ADDED_WHEN_String_German Or oEditValue = IDB_ADDED_WHEN_String_Englisch Then SEARCH_FACT_DATE_ATTRIBUTE = "ADDED_WHEN" Else SEARCH_FACT_DATE_ATTRIBUTE = oEditValue SEARCH_FACT_DATE = $"MONTH(GRPDATE.[{SEARCH_FACT_DATE_ATTRIBUTE}]) <> 13" End If SearchContent() Catch ex As Exception Logger.Error(ex) End Try End If End Sub Private Sub DockManager1_StartDocking(sender As Object, e As Docking.DockPanelCancelEventArgs) Handles DockManager1.StartDocking e.Cancel = True End Sub Private Sub ToggleSwitchDate_Toggled(sender As Object, e As EventArgs) Handles ToggleSwitchToday.Toggled, ToggleSwitchYesterday.Toggled, ToggleSwitchCurrentYear.Toggled, ToggleSwitchLastYear.Toggled, ToggleSwitchLastMonth.Toggled, ToggleSwitchCurrentMonth.Toggled If TOGGLE_Change = True Then Exit Sub End If Dim oToggle As ToggleSwitch = TryCast(sender, ToggleSwitch) If oToggle.IsOn Then TOGGLE_Change = True LIMITATION_DATE = True Dim oWHENDATE As String Select Case oToggle.Name Case "ToggleSwitchCurrentYear" ToggleSwitchLastYear.IsOn = False ToggleSwitchCurrentMonth.IsOn = False ToggleSwitchLastMonth.IsOn = False ToggleSwitchToday.IsOn = False ToggleSwitchYesterday.IsOn = False oWHENDATE = GET_DATE_LIMITATION("YEAR(@ATTRIBUTE) = YEAR(GETDATE())") Case "ToggleSwitchLastYear" ToggleSwitchCurrentYear.IsOn = False ToggleSwitchCurrentMonth.IsOn = False ToggleSwitchLastMonth.IsOn = False ToggleSwitchToday.IsOn = False ToggleSwitchYesterday.IsOn = False oWHENDATE = GET_DATE_LIMITATION("YEAR(@ATTRIBUTE) = (YEAR(GETDATE()) -1)") Case "ToggleSwitchCurrentMonth" ToggleSwitchCurrentYear.IsOn = False ToggleSwitchLastYear.IsOn = False ToggleSwitchToday.IsOn = False ToggleSwitchYesterday.IsOn = False ToggleSwitchLastMonth.IsOn = False oWHENDATE = GET_DATE_LIMITATION("MONTH(@ATTRIBUTE) = MONTH(GETDATE())") Case "ToggleSwitchLastMonth" ToggleSwitchCurrentYear.IsOn = False ToggleSwitchLastYear.IsOn = False ToggleSwitchCurrentMonth.IsOn = False ToggleSwitchToday.IsOn = False ToggleSwitchYesterday.IsOn = False Dim currentDate As DateTime = DateTime.Now If currentDate.Month = 1 Then oWHENDATE = GET_DATE_LIMITATION("MONTH(@ATTRIBUTE) = 12 " & vbNewLine & "AND YEAR(@ATTRIBUTE) = (YEAR(GETDATE()) -1)") Else oWHENDATE = GET_DATE_LIMITATION("MONTH(@ATTRIBUTE) = (MONTH(GETDATE()) -1)") End If Case "ToggleSwitchToday" ToggleSwitchCurrentYear.IsOn = False ToggleSwitchLastYear.IsOn = False ToggleSwitchCurrentMonth.IsOn = False ToggleSwitchYesterday.IsOn = False oWHENDATE = GET_DATE_LIMITATION("convert(DATE,@ATTRIBUTE) = convert(DATE,GETDATE())") Case "ToggleSwitchYesterday" ToggleSwitchCurrentYear.IsOn = False ToggleSwitchLastYear.IsOn = False ToggleSwitchCurrentMonth.IsOn = False ToggleSwitchToday.IsOn = False oWHENDATE = GET_DATE_LIMITATION("convert(DATE,@ATTRIBUTE) = convert(DATE,GETDATE()-1)") End Select SEARCH_FACT_DATE = oWHENDATE TOGGLE_Change = False Else If ToggleSwitchToday.IsOn = False And ToggleSwitchYesterday.IsOn = False And ToggleSwitchCurrentYear.IsOn = False And ToggleSwitchLastYear.IsOn = False And ToggleSwitchLastMonth.IsOn = False And ToggleSwitchCurrentMonth.IsOn = False Then LIMITATION_DATE = False End If End If Start_FlowSearch() End Sub End Class