Option Explicit On Imports DigitalData.Modules.Logging Imports DevExpress.XtraTab Imports DevExpress.XtraGrid Imports DevExpress.XtraGrid.Views.Grid Imports DevExpress.XtraEditors Imports DevExpress.XtraSplashScreen Imports DigitalData.GUIs.Common Public Class frmSearchStart Private Logger As Logger Private DTSearchProfiles As DataTable Private TabSelectedIndex As Integer Private TabSelected As XtraTabPage Private CURR_CTRL_OBJ As Object Private PSEARCH_ID As Integer = 0 Private SEARCH_SQL As String Private SEARCH_TITLE As String Public DataLoaded As Boolean = False Private Const DEFAULT_X As Integer = 10 Private Const DEFAULT_Y As Integer = 10 'Private DTSearchTerms As DataTable Private oDTAttributes As DataTable Private SEARCH_COUNT As Integer = 0 Private _Environment As Environment Private ChangedDateControls As List(Of String) Public Sub New(ByVal pDTSearchProfiles As DataTable, Optional ByVal pRunSearch As Boolean = False) ' Dieser Aufruf ist für den Designer erforderlich. InitializeComponent() ' Fügen Sie Initialisierungen nach dem InitializeComponent()-Aufruf hinzu. DTSearchProfiles = pDTSearchProfiles Logger = My.LogConfig.GetLogger() Dim oSearchTerms As New DataTable ' Create four typed columns in the DataTable. oSearchTerms.Columns.Add("BracketLeft", GetType(String)) oSearchTerms.Columns.Add("AttrID", GetType(Integer)) oSearchTerms.Columns.Add("AttrTitle", GetType(String)) oSearchTerms.Columns.Add("Criteria", GetType(String)) oSearchTerms.Columns.Add("SearchTerm", GetType(String)) oSearchTerms.Columns.Add("BracketRight", GetType(String)) oSearchTerms.Columns.Add("Operator", GetType(String)) 'DTSearchTerms = oSearchTerms End Sub Private Sub frmSearchStart_Load(sender As Object, e As EventArgs) Handles Me.Load Try Me.pnlProfileChoose.Visible = False For Each oTab As XtraTabPage In XtraTabControl1.TabPages oTab.PageVisible = False Next RepositoryItemComboBox2.Items.AddRange(New List(Of FilterTimeframe) From { New FilterTimeframe() With {.Name = "Kein", .DisableFilter = True}, New FilterTimeframe() With {.Name = "Eigener", .CustomFilter = True}, New FilterTimeframe() With { .Name = "letzte 7 Tage", .From = Date.Now.Subtract(TimeSpan.FromDays(7)), .[To] = Date.Now }, New FilterTimeframe() With { .Name = "letzte 14 Tage", .From = Date.Now.Subtract(TimeSpan.FromDays(14)), .[To] = Date.Now }, New FilterTimeframe() With { .Name = "letzte 30 Tage", .From = Date.Now.Subtract(TimeSpan.FromDays(30)), .[To] = Date.Now } }) If DTSearchProfiles.Rows.Count > 1 Then cmbProfile.DataSource = DTSearchProfiles cmbProfile.ValueMember = DTSearchProfiles.Columns("SEARCH_PROFILE_ID").ColumnName cmbProfile.DisplayMember = DTSearchProfiles.Columns("TITLE").ColumnName cmbProfile.AutoCompleteMode = AutoCompleteMode.Suggest cmbProfile.AutoCompleteSource = AutoCompleteSource.ListItems cmbProfile.SelectedIndex = -1 TabSelectedIndex = -1 Me.pnlProfileChoose.Visible = True For Each orow As DataRow In DTSearchProfiles.Rows RepositoryItemComboBox1.Items.Add(orow.Item("TITLE")) Next Me.pnlProfileChoose.Visible = True Else Me.pnlProfileChoose.Visible = False RibbonPageGroupProfiles.Visible = False TabSelectedIndex = 0 TabSelected = XtraTabControl1.TabPages(0) TabSelected.PageVisible = True PSEARCH_ID = DTSearchProfiles.Rows(0).Item("SEARCH_PROFILE_ID") SEARCH_SQL = DTSearchProfiles.Rows(0).Item("RESULT_SQL") SEARCH_TITLE = DTSearchProfiles.Rows(0).Item("TITLE") TabSelected.Text = DTSearchProfiles.Rows(0).Item("TITLE") Load_Search_Attributes() BarButtonItemNewSearch.Visibility = DevExpress.XtraBars.BarItemVisibility.Never End If SEARCH_COUNT = DTSearchProfiles.Rows.Count SplitContainerControlSearch.Collapsed = True RibbonControl1.ColorScheme = DevExpress.XtraBars.Ribbon.RibbonControlColorScheme.Red If My.UIConfig.SearchForm.Location.X > 0 And My.UIConfig.SearchForm.Location.Y > 0 Then Me.Location = My.UIConfig.SearchForm.Location End If Catch ex As Exception Logger.Error(ex.Message) MsgBox(ex.Message, MsgBoxStyle.Critical, "Unexpected error while loading ProfileSearches:") End Try End Sub 'Public Sub AddSearchAttribute(pAttributeId As String, pAttributeTitle As String, pSearchTerm As String, Optional pCriteria As String = "=") ' GridControlSerchTerms.DataSource = Nothing ' Dim oMultiselect As Boolean = False ' For Each oRow As DataRow In oDTAttributes.Rows ' If oRow.Item("ATTRIBUTE_ID") = pAttributeId Then ' oMultiselect = CBool(oRow.Item("MULTISELECT")) ' Exit For ' End If ' Next ' If oMultiselect = False Then ' For Each oSearchTerm As DataRow In DTSearchTerms.Rows ' If oSearchTerm.Item("AttrID") = pAttributeId Then 'And oSearchTerm.Item("Criteria") = pCriteria And oSearchTerm.Item("SearchTerm") = pSearchTerm ' oSearchTerm.Delete() ' End If ' Next ' End If ' DTSearchTerms.Rows.Add("", pAttributeId, pAttributeTitle, pCriteria, pSearchTerm, "", "and") ' RenewBinding_DTSearchTerms() ' If SplitContainerControlSearch.Collapsed = True Then ' SplitContainerControlSearch.Collapsed = False ' End If 'End Sub 'Sub RenewBinding_DTSearchTerms() ' DTSearchTerms.AcceptChanges() ' GridControlSerchTerms.DataSource = Nothing ' GridControlSerchTerms.DataSource = DTSearchTerms ' GridViewSearchTerms.Columns("BracketLeft").Caption = "(" ' GridViewSearchTerms.Columns("BracketRight").Caption = ")" ' If My.Application.User.Language <> "de-DE" Then ' GridViewSearchTerms.Columns("AttrTitle").Caption = "Attribute" ' GridViewSearchTerms.Columns("Criteria").Caption = "Criteria" ' Else ' GridViewSearchTerms.Columns("AttrTitle").Caption = "Attribut" ' GridViewSearchTerms.Columns("Criteria").Caption = "Bedingung" ' End If 'End Sub 'Public Sub SearchAttribute(pAttrID As String, pAttrTitle As String, pSearchTerm As String, Optional pCriteria As String = "=") ' '"BracketLeft" ' '"AttrID", GetType(Integer)) ' '"AttrTitle" ' '"Criteria" ' '"SearchTerm" ' '"BracketRight" ' '"Operator" ' DTSearchTerms.Rows.Add("", pAttrID, pAttrTitle, pCriteria, pSearchTerm, "", "And") ' DTSearchTerms.AcceptChanges() 'End Sub Sub Load_Search_Attributes() Try DataLoaded = False Dim oSQL = $"SELECT * FROM VWIDB_SEARCH_PROFILE_ATTRIBUTES WHERE SEARCH_PROFIL_ID = {PSEARCH_ID} ORDER BY [SEQUENCE]" Dim oDT As DataTable = My.DatabaseIDB.GetDatatable(oSQL) oDTAttributes = Nothing oDTAttributes = oDT.Clone() oDT.Select("", "SEQUENCE").CopyToDataTable(oDTAttributes, LoadOption.PreserveChanges) 'oDTAttributes.Columns.Add("MULTISELECT", GetType(Boolean)) 'oDTAttributes.AcceptChanges() 'For Each oAttributeRow As DataRow In oDTAttributes.Rows ' oAttributeRow.Item("MULTISELECT") = False 'Next Dim oControlCount As Integer = 1 Dim oControlRow As Integer = 0 Dim oControls As New ClassControlCreator(TabSelected, Me) Dim YMax As Integer = 0 Dim YActControlHeight As Integer = 0 Dim XActControlWidth As Integer = 0 Dim iList As New List(Of Integer)() iList.Add(2) iList.Add(3) iList.Add(5) iList.Add(6) iList.Add(8) iList.Add(9) For Each oAttributeRow As DataRow In oDT.Rows Dim oXPosition As Integer Dim oYPositionControl As Integer Dim oYPositionLabel As Integer Dim oMyLastGridView As DevExpress.XtraGrid.Views.Grid.GridView Dim oSingleResult As Boolean = False Dim oAttriTitle As String = oAttributeRow.Item("ATTRIBUTE_TITLE").ToString Dim oAttriID As Integer = CInt(oAttributeRow.Item("ATTRIBUTE_ID")) ' Dim oDepAttriID1 As String = oAttributeRow.Item("DEPENDING_ATTRIBUTE1").ToString Dim oAttriTYPE As String = oAttributeRow.Item("ATTRIBUTE_TYPE").ToString If oControlCount = 1 Or oControlCount = 5 Or oControlCount = 9 Then oControlRow += 1 End If If oControlRow = 1 Then If oControlCount = 1 Then oXPosition = 10 oYPositionLabel = 10 oYPositionControl = oYPositionLabel + 20 End If ElseIf oControlRow = 2 Then If oControlCount = 5 Then oXPosition = 10 oYPositionLabel = YActControlHeight + 10 oYPositionControl = oYPositionLabel + 20 End If ElseIf oControlRow = 3 Then If oControlCount = 9 Then oXPosition = 10 End If End If Dim oControlHeight As Integer = CInt(oAttributeRow.Item("HEIGHT")) Dim oControlWidth As Integer = CInt(oAttributeRow.Item("WIDTH")) If CBool(oAttributeRow.Item("MULTISELECT")) = True Then oControlWidth += 50 End If 'Erst mal das Label hinzufügen 'If oAttriTYPE <> "BIT" Then addLabel(oAttriTitle, oXPosition, oYPositionLabel) 'End If 'Nun das Control mit dem entsprechenden Abstand und der Größe Dim oXDistance As Integer, oYDistance As Integer Dim oCalcHeight As Integer Dim oCalcWidth As Integer If oAttriTYPE = "VARCHAR" Or oAttriTYPE = "BIG INTEGER" Then oCalcHeight = oControlHeight + oYPositionControl oCalcWidth = oControlWidth ElseIf (oAttriTYPE = "DATE" Or oAttriTYPE = "BIT") Then oCalcHeight = 20 + oYPositionControl oCalcWidth = 100 End If If oCalcHeight > YActControlHeight Then YActControlHeight = oCalcHeight End If Dim oMyControl As Control If oAttriTYPE = "VARCHAR" Or oAttriTYPE = "BIG INTEGER" Then oMyControl = oControls.CreateExistingGridControl(oAttributeRow, oXPosition, oYPositionControl) Dim myDGV As GridControl = CType(oMyControl, GridControl) Dim omyDTSource As DataTable = CType(myDGV.DataSource, DataTable) If Not IsNothing(omyDTSource) Then If omyDTSource.Rows.Count = 1 Then oSingleResult = True ' AddSearchAttribute(oAttriID, oAttriTitle, omyDTSource.Rows(0).Item(oAttriTitle).ToString) End If End If Dim oView As DevExpress.XtraGrid.Views.Grid.GridView oView = CType(myDGV.MainView, GridView) oMyLastGridView = oView If CBool(oAttributeRow.Item("MULTISELECT")) = True Then 'AddHandler oView.SelectionChanged, AddressOf RenewSearchAttributes Else ' AddHandler oView.FocusedRowChanged, AddressOf FocusedRowChanged End If oView.FocusInvalidRow() ElseIf oAttriTYPE = "DATE" Then oMyControl = oControls.CreateExistingDatepicker(oAttributeRow, oXPosition, oYPositionControl) Dim myDTP As DateEdit = CType(oMyControl, DateEdit) AddHandler myDTP.DisableCalendarDate, AddressOf DisableCalendarDate AddHandler myDTP.DateTimeChanged, AddressOf CalendarChanged 'CalendarChanged ElseIf oAttriTYPE = "BIT" Then oMyControl = oControls.CreateExistingCheckbox(oAttributeRow, oXPosition, oYPositionControl) Dim myCheckBox As CheckBox = CType(oMyControl, CheckBox) AddHandler myCheckBox.CheckedChanged, AddressOf CheckBox_CheckedChanged End If oControlCount += 1 TabSelected.Controls.Add(oMyControl) If oAttriTYPE = "VARCHAR" Or oAttriTYPE = "BIG INTEGER" Then oMyLastGridView.FocusInvalidRow() End If oXPosition += oControlWidth + 20 Next DataLoaded = True Catch ex As Exception Logger.Warn("Unexpected error in Load_Search_Attributes - Error: " & ex.Message) MsgBox(ex.Message, MsgBoxStyle.Critical, "Unexpected error in Load_Search_Attributes:") DataLoaded = True End Try End Sub Sub addLabel(pAttrName As String, pXPos As Integer, ylbl As Integer) Dim lbl As New Label With { .Name = "lbl" & pAttrName, .AutoSize = True, .Text = pAttrName, .Location = New Point(pXPos, ylbl) } TabSelected.Controls.Add(lbl) End Sub Private Sub XtraTabControl1_SelectedPageChanged(sender As Object, e As DevExpress.XtraTab.TabPageChangedEventArgs) Handles XtraTabControl1.SelectedPageChanged TabSelected = XtraTabControl1.SelectedTabPage End Sub Private Sub ClearSearchCriteria() Dim oSQL = $"DELETE FROM TBIDB_USER_SEARCH_CRITERIA WHERE SEARCH_PROFIL_ID = {PSEARCH_ID} AND USERID = {My.Application.User.UserId}" My.DatabaseIDB.ExecuteNonQuery(oSQL) End Sub Private Sub ClearSelectedControls() ChangedDateControls = Nothing End Sub Private Sub RenewSearchAttributes() ClearSearchCriteria() For Each oControl As Control In TabSelected.Controls Dim octrlType = oControl.GetType.ToString Dim oAttrID As Integer Dim oAttrTitle As String Select Case oControl.GetType.ToString Case "DevExpress.XtraGrid.GridControl" Dim oMyGridControl As GridControl = CType(oControl, GridControl) Dim oMyGridView As DevExpress.XtraGrid.Views.Grid.GridView = CType(oMyGridControl.MainView, GridView) Dim oSelectedRows As Integer() = oMyGridView.GetSelectedRows() If oSelectedRows.Count = 0 Then Continue For End If oAttrID = DirectCast(oControl.Tag, ClassControlCreator.ControlMetadata).AttrID oAttrTitle = DirectCast(oControl.Tag, ClassControlCreator.ControlMetadata).AttrTitle For Each oRowHandle As Integer In oSelectedRows Dim oResult = oMyGridView.GetRowCellValue(oRowHandle, oMyGridView.Columns(0).FieldName) Dim oInsert = $"EXEC PRIDB_NEW_USER_SEARCH_CRITERIA {PSEARCH_ID.ToString},{My.Application.User.UserId.ToString},{oAttrID.ToString},'{oResult}','{My.Application.User.UserName}'" My.DatabaseIDB.ExecuteNonQuery(oInsert) Next Case "DevExpress.XtraEditors.DateEdit" ' MsgBox("Date") Dim myDTP As DateEdit = CType(oControl, DateEdit) If ChangedDateControls Is Nothing Then Continue For End If If ChangedDateControls.Count = 0 Then Continue For End If For Each oName As String In ChangedDateControls If myDTP.Name = oName Then If Not IsNothing(myDTP.EditValue) Then oAttrID = DirectCast(oControl.Tag, ClassControlCreator.ControlMetadata).AttrID oAttrTitle = DirectCast(oControl.Tag, ClassControlCreator.ControlMetadata).AttrTitle Dim oldValue As Date Dim validDate As Boolean = False Dim oDateValue As DateTime = myDTP.EditValue Try validDate = Date.TryParse(myDTP.OldEditValue, oldValue) Catch ex As Exception oldValue = Date.MinValue End Try If Not validDate Then oldValue = Date.MinValue End If If oldValue = myDTP.EditValue Then Exit Sub End If Dim dateString = oDateValue.ToString("yyyy-MM-dd") 'hh:mm:ss.fff Dim omydate = myDTP.EditValue.ToString Dim oInsert = $"EXEC PRIDB_NEW_USER_SEARCH_CRITERIA {PSEARCH_ID.ToString},{My.Application.User.UserId.ToString},{oAttrID.ToString},'{omydate}','{My.Application.User.UserName}'" My.DatabaseIDB.ExecuteNonQuery(oInsert) End If End If Next Case "System.Windows.Forms.CheckBox" Dim myCheckBox As CheckBox = CType(oControl, CheckBox) If myCheckBox.CheckState <> CheckState.Indeterminate Then oAttrID = DirectCast(oControl.Tag, ClassControlCreator.ControlMetadata).AttrID oAttrTitle = DirectCast(oControl.Tag, ClassControlCreator.ControlMetadata).AttrTitle Dim oInsert = $"EXEC PRIDB_NEW_USER_SEARCH_CRITERIA {PSEARCH_ID.ToString},{My.Application.User.UserId.ToString},{oAttrID.ToString},'{myCheckBox.Checked.ToString}','{My.Application.User.UserName}'" My.DatabaseIDB.ExecuteNonQuery(oInsert) End If Case Else 'MsgBox(oControl.GetType.ToString) End Select Next End Sub Private Sub FocusedRowChanged(sender As Object, e As Views.Base.FocusedRowChangedEventArgs) If DataLoaded = False Then Exit Sub Dim oCurrentView As GridView = DirectCast(sender, GridView) Dim oCurrentControl As GridControl = oCurrentView.GridControl Dim rowView As DataRowView = CType(oCurrentView.GetFocusedRow(), DataRowView) If IsNothing(rowView) = False Then Dim oResult As String = CType(rowView.Item(0), String) Dim oAttrID = DirectCast(oCurrentControl.Tag, ClassControlCreator.ControlMetadata).AttrID Dim oAttrTitle = DirectCast(oCurrentControl.Tag, ClassControlCreator.ControlMetadata).AttrTitle ' RenewSearchAttributes() ' AddSearchAttribute(oAttrID, oAttrTitle, oResult) End If End Sub Private Sub CheckBox_CheckedChanged(sender As Object, e As EventArgs) If DataLoaded = False Then Exit Sub Dim oCurrentCB As CheckBox = DirectCast(sender, CheckBox) Dim oChecked = oCurrentCB.Checked Dim oAttrID = DirectCast(oCurrentCB.Tag, ClassControlCreator.ControlMetadata).AttrID Dim oAttrTitle = DirectCast(oCurrentCB.Tag, ClassControlCreator.ControlMetadata).AttrTitle 'RenewSearchAttributes() ' AddSearchAttribute(oAttrID, oAttrTitle, oChecked.ToString) End Sub Private Sub frmSearchStart_Shown(sender As Object, e As EventArgs) Handles Me.Shown DataLoaded = True End Sub Private Sub DisableCalendarDate(sender As Object, e As DevExpress.XtraEditors.Calendar.DisableCalendarDateEventArgs) Dim oDateEdit As DateEdit = DirectCast(sender, DateEdit) Dim oDTSource As DataTable = DirectCast(oDateEdit.Tag, ClassControlCreator.ControlMetadata).DTSource If Not IsNothing(oDTSource) Then If IsValidDate(oDTSource, e.Date) = False Then e.IsDisabled = True End If End If 'If (e.Date.DayOfWeek = DayOfWeek.Wednesday) Then ' e.IsDisabled = True 'End If End Sub Private Sub CalendarChanged(sender As Object, e As EventArgs) If DataLoaded = False Then Exit Sub Dim myDTP As DateEdit = CType(sender, DateEdit) If Not IsNothing(myDTP.EditValue) Then Dim omydate = myDTP.EditValue.ToString Dim oList As New List(Of String) oList.Add(myDTP.Name) If Not IsNothing(ChangedDateControls) Then Dim oFound As Boolean = False For Each oName As String In ChangedDateControls If myDTP.Name = oName Then oFound = True Exit For End If Next If oFound = False Then ChangedDateControls.Add(myDTP.Name) End If Else ChangedDateControls = oList End If 'RenewSearchAttributes() 'Dim oInsert = $"EXEC PRIDB_NEW_USER_SEARCH_CRITERIA {PSEARCH_ID.ToString},{My.Application.User.UserId.ToString},{oAttrID.ToString},'{omydate}','{My.Application.User.UserName}'" 'My.DatabaseIDB.ExecuteNonQuery(oInsert) End If End Sub Private Sub OnDateSelectedValueChanged(sender As Object, e As EventArgs) Try Dim myDTP As DateEdit = CType(sender, DateEdit) Dim value As DateTime = myDTP.EditValue Dim oldValue As Date Dim validDate As Boolean = False Try validDate = Date.TryParse(myDTP.OldEditValue, oldValue) Catch ex As Exception oldValue = Date.MinValue End Try If Not validDate Then oldValue = Date.MinValue End If If oldValue = myDTP.EditValue Then Exit Sub End If Dim dateString = value.ToString("yyyy-MM-dd") 'hh:mm:ss.fff Catch ex As Exception Logger.Error(ex) End Try End Sub Public Function IsValidDate(pCheckDT As DataTable, pDate2Check As Date) As Boolean Dim oIsValid As Boolean = False For Each oDateRow As DataRow In pCheckDT.Rows If CDate(oDateRow.Item(0)) = pDate2Check Then oIsValid = True End If Next Return oIsValid End Function 'Private Sub Clear_token() ' Try ' TokenEdit1.Properties.BeginUpdate() ' Dim oCount As Int16 = 1 ' For Each oRow As DataRow In DTSearchTerms.Rows ' TokenEdit1.RemoveItem($"criteria{oCount}") ' oCount += 1 ' Next ' TokenEdit1.Properties.EndUpdate() ' Catch ex As Exception ' End Try 'End Sub Private Sub BarButtonItem1_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles BarButtonItem1.ItemClick Try 'Clear_token() ClearSearchCriteria() 'DTSearchTerms.Clear() ClearSelectedControls() Catch ex As Exception MsgBox("Unexpected Error in Clearing Search Items: " & ex.Message, MsgBoxStyle.Critical) End Try TabSelected.Controls.Clear() Load_Search_Attributes() End Sub Private Sub BarButtonItem3_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles BarButtonItem3.ItemClick 'TokenEdit1.Properties.BeginUpdate() ''TokenEdit1.Properties.Tokens.AddToken("Column1 = 'Value1'", "criteria1") 'TokenEdit1.Properties.Tokens.AddToken("Column1 = 'Value1'", "criteria1") 'TokenEdit1.Properties.Tokens.AddToken("Column2 > 20", "criteria2") 'TokenEdit1.Properties.Tokens.AddToken("Column3 <> 'Harry'", "criteria3") 'TokenEdit1.EditValue = "criteria1, criteria2, criteria3" '' ... add more tokens 'TokenEdit1.Properties.EndUpdate() End Sub 'Private Sub AddToken(CriteriaString As String) ' Try ' Clear_token() ' TokenEdit1.Properties.BeginUpdate() ' ''oRow.Item("AttrTitle") & " " & oRow.Item("Criteria") & " '" & oRow.Item("SearchTerm") & "'" ' Dim oCount As Int16 = 1 ' For Each oRow As DataRow In DTSearchTerms.Rows ' Try ' Dim oCriteriaString = oRow.Item("AttrTitle") & " " & oRow.Item("Criteria") & " '" & oRow.Item("SearchTerm") & "'" ' TokenEdit1.Properties.Tokens.AddToken(CriteriaString, "criteria" + oCount.ToString) ' Catch ex As Exception ' End Try ' oCount += 1 ' Next ' ' Dim oTokenCount = DTSearchTerms.Rows.Count ' 'TokenEdit1.Properties.BeginUpdate() ' 'TokenEdit1.Properties.Tokens.AddToken(CriteriaString, "criteria" + oCount.ToString) ' Dim otokenEditString = "" ' oCount = 1 ' For Each oRow As DataRow In DTSearchTerms.Rows ' If oCount = 1 Then ' otokenEditString = "criteria1" ' Else ' otokenEditString &= $", criteria{oCount}" ' End If ' oCount += 1 ' Next ' TokenEdit1.EditValue = otokenEditString ' ' ... add more tokens ' TokenEdit1.Properties.EndUpdate() ' Catch ex As Exception ' MsgBox("Unexpected Error in AddToken: " & ex.Message, MsgBoxStyle.Critical) ' Logger.Warn("Unexpected Error in AddToken: " & ex.Message) ' End Try 'End Sub Private Sub cmbProfile_SelectedIndexChanged(sender As Object, e As EventArgs) Handles cmbProfile.SelectedIndexChanged If DataLoaded = False Then Exit Sub If cmbProfile.SelectedIndex <> -1 Then If TabSelectedIndex = -1 Then TabSelectedIndex = 0 Else TabSelectedIndex += 1 End If TabSelected = XtraTabControl1.TabPages(TabSelectedIndex) TabSelected.PageVisible = True PSEARCH_ID = cmbProfile.SelectedValue Dim oDT As New DataTable Dim oFilter As String = $"SEARCH_PROFILE_ID = {PSEARCH_ID}" Dim oFilteredRows() As DataRow = DTSearchProfiles.Select(oFilter) oDT = DTSearchProfiles.Clone For Each oRow As DataRow In oFilteredRows SEARCH_SQL = oRow.Item("RESULT_SQL").ToString SEARCH_TITLE = cmbProfile.Text Next TabSelected.Text = SEARCH_TITLE Load_Search_Attributes() BarButtonItemNewSearch.Visibility = DevExpress.XtraBars.BarItemVisibility.Always XtraTabControl1.SelectedTabPageIndex = TabSelectedIndex End If End Sub Private Sub BarEditItem2_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles BarEditItem2.ItemClick End Sub Private Sub BarButtonItemNewSearch_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles BarButtonItemNewSearch.ItemClick Display_InfoItem("New Search not integrated", Color.Yellow) End Sub Private Sub BarButtonItem2_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles BarButtonItem2.ItemClick Display_InfoItem("Search Save not integrated", Color.Yellow) End Sub Sub Display_InfoItem(pText As String, pColor As Color) BarStaticItemInfo.Caption = pText BarStaticItemInfo.ItemAppearance.Normal.BackColor = pColor End Sub Private Sub MehrfachauswahlAktivierenToolStripMenuItem_Click(sender As Object, e As EventArgs) If DataLoaded = False Then Exit Sub Dim oCurrentControl As GridControl = DirectCast(CURR_CTRL_OBJ, GridControl) Dim oAttrID = DirectCast(oCurrentControl.Tag, ClassControlCreator.ControlMetadata).AttrID Dim oAttrTitle = DirectCast(oCurrentControl.Tag, ClassControlCreator.ControlMetadata).AttrTitle For Each oROW As DataRow In oDTAttributes.Rows If oROW.Item("ATTRIBUTE_ID") = oAttrID Then oROW.Item("MULTISELECT") = True Exit For End If Next End Sub Private Sub MehrfachauswahlInaktivierenToolStripMenuItem_Click(sender As Object, e As EventArgs) If DataLoaded = False Then Exit Sub Dim oCurrentControl As GridControl = DirectCast(CURR_CTRL_OBJ, GridControl) Dim oAttrID = DirectCast(oCurrentControl.Tag, ClassControlCreator.ControlMetadata).AttrID Dim oAttrTitle = DirectCast(oCurrentControl.Tag, ClassControlCreator.ControlMetadata).AttrTitle For Each oROW As DataRow In oDTAttributes.Rows If oROW.Item("ATTRIBUTE_ID") = oAttrID Then oROW.Item("MULTISELECT") = False Exit For End If Next End Sub Private Sub GridViewSearchTerms_RowDeleted(sender As Object, e As DevExpress.Data.RowDeletedEventArgs) If DataLoaded = False Then Exit Sub Dim oCurrentView As GridView = DirectCast(sender, GridView) Dim oCurrentControl As GridControl = oCurrentView.GridControl Dim rowView As DataRowView = CType(oCurrentView.GetFocusedRow(), DataRowView) If IsNothing(rowView) = False Then Dim oResult As String = CType(rowView.Item(0), String) Dim oAttrID = DirectCast(oCurrentControl.Tag, ClassControlCreator.ControlMetadata).AttrID Dim oAttrTitle = DirectCast(oCurrentControl.Tag, ClassControlCreator.ControlMetadata).AttrTitle End If End Sub 'Private Sub GridViewSearchTerms_KeyUp(sender As Object, e As KeyEventArgs) ' If e.KeyValue = Keys.Delete Then ' Dim oSelectedRows As Integer() = GridViewSearchTerms.GetSelectedRows() ' Dim oAttrID = GridViewSearchTerms.GetRowCellValue(oSelectedRows.Last(), GridViewSearchTerms.Columns("AttrID")) ' Dim oSearchTerm = GridViewSearchTerms.GetRowCellValue(oSelectedRows.Last(), GridViewSearchTerms.Columns("SearchTerm")) ' For Each dr As DataRow In DTSearchTerms.Rows ' If dr.Item("AttrID") = oAttrID And dr.Item("SearchTerm") = oSearchTerm Then ' dr.Delete() ' Exit For ' End If ' Next ' RenewBinding_DTSearchTerms() ' End If 'End Sub 'Private Sub ContextMenuStripSearchTerms_Opening(sender As Object, e As System.ComponentModel.CancelEventArgs) Handles ContextMenuStripSearchTerms.Opening ' Dim rowView As DataRowView = GridViewSearchTerms.GetFocusedRow() ' '"BracketLeft" ' '"AttrID", GetType(Integer)) ' '"AttrTitle" ' '"Criteria" ' '"SearchTerm" ' '"BracketRight" ' '"Operator" ' If IsNothing(rowView) = False Then ' Dim oOperator As String = rowView.Item("Operator") ' If oOperator = "and" Then ' If My.Application.User.Language = "de-De" Then ' tsmOperator.Text = "Operator = oder" ' Else ' tsmOperator.Text = "Operator = or" ' End If ' Else ' If My.Application.User.Language = "de-De" Then ' tsmOperator.Text = "Operator = und" ' Else ' tsmOperator.Text = "Operator = and" ' End If ' End If ' End If 'End Sub 'Private Sub tsmOperator_Click(sender As Object, e As EventArgs) Handles tsmOperator.Click ' Dim rowView As DataRowView = GridViewSearchTerms.GetFocusedRow() ' If IsNothing(rowView) = False Then ' Dim oAttrID As String = rowView.Item("AttrID") ' Dim oSearchTerm As String = rowView.Item("SearchTerm") ' Dim oREPLACEOperator As String ' If tsmOperator.Text.EndsWith("und") Or tsmOperator.Text.EndsWith("and") Then ' oREPLACEOperator = "and" ' Else ' oREPLACEOperator = "or" ' End If ' For Each oRow As DataRow In DTSearchTerms.Rows ' If oRow.Item("AttrID") = oAttrID And oRow.Item("SearchTerm") = oSearchTerm Then ' oRow.Item("Operator") = oREPLACEOperator ' DTSearchTerms.AcceptChanges() ' Exit For ' End If ' Next ' End If 'End Sub 'Private Sub BracketLeftToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles BracketLeftToolStripMenuItem.Click ' Dim rowView As DataRowView = GridViewSearchTerms.GetFocusedRow() ' If IsNothing(rowView) = False Then ' Dim oAttrID As String = rowView.Item("AttrID") ' Dim oSearchTerm As String = rowView.Item("SearchTerm") ' For Each oRow As DataRow In DTSearchTerms.Rows ' If oRow.Item("AttrID") = oAttrID And oRow.Item("SearchTerm") = oSearchTerm Then ' oRow.Item("BracketLeft") = "(" ' DTSearchTerms.AcceptChanges() ' Exit For ' End If ' Next ' End If 'End Sub 'Private Sub KlammerRechtsToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles KlammerRechtsToolStripMenuItem.Click ' Dim rowView As DataRowView = CType(GridViewSearchTerms.GetFocusedRow(), DataRowView) ' If IsNothing(rowView) = False Then ' Dim oAttrID As String = rowView.Item("AttrID") ' Dim oSearchTerm As String = rowView.Item("SearchTerm") ' For Each oRow As DataRow In DTSearchTerms.Rows ' If oRow.Item("AttrID") = oAttrID And oRow.Item("SearchTerm") = oSearchTerm Then ' oRow.Item("BracketRight") = ")" ' DTSearchTerms.AcceptChanges() ' Exit For ' End If ' Next ' End If 'End Sub 'Private Sub KlammerEntfernenToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles KlammerEntfernenToolStripMenuItem.Click ' Dim rowView As DataRowView = GridViewSearchTerms.GetFocusedRow() ' If IsNothing(rowView) = False Then ' Dim oAttrID As String = rowView.Item("AttrID") ' Dim oSearchTerm As String = rowView.Item("SearchTerm") ' For Each oRow As DataRow In DTSearchTerms.Rows ' If oRow.Item("AttrID") = oAttrID And oRow.Item("SearchTerm") = oSearchTerm Then ' oRow.Item("BracketRight") = "" ' oRow.Item("BracketLeft") = "" ' DTSearchTerms.AcceptChanges() ' Exit For ' End If ' Next ' End If 'End Sub Private Sub frmSearchStart_FormClosed(sender As Object, e As FormClosedEventArgs) Handles MyBase.FormClosed My.UIConfig.SearchForm.Location = Me.Location My.UIConfigManager.Save() End Sub Private Function GetSearchTermForType(pAttrID As Int16, pAttrTitle As String, pCriteria As String, pTERM As String) As String Dim oRETURN As String = "" Dim oFilter As String = $"GUID = {pAttrID}" Dim oFilteredRows() As DataRow = My.DTAttributes.Select(oFilter) If oFilteredRows.Length = 1 Then For Each oRow As DataRow In oFilteredRows Dim oType As Integer = CInt(oRow.Item("TYP_ID")) If oType = 1 Or oType = 8 Then oRETURN = $"{pAttrTitle} {pCriteria} '{pTERM.Replace("'", "''")}'" ElseIf oType = 2 Or oType = 9 Then oRETURN = $"{pAttrTitle} {pCriteria} {pTERM}" ElseIf oType = 3 Then 'Float oRETURN = $"{pAttrTitle} {pCriteria} Convert(float,'{pTERM.Replace(",", ".")}')" ElseIf oType = 4 Then 'Decimal oRETURN = $"{pAttrTitle} {pCriteria} Convert(decimal(19,2),'{pTERM.Replace(",", ".")}')" ElseIf oType = 5 Then 'DATE oRETURN = $"{pAttrTitle} {pCriteria} Convert(date,'{pTERM}')" ElseIf oType = 7 Then Dim oBit As Int16 If CBool(pTERM) = True Then oBit = 1 Else oBit = 0 End If oRETURN = $"{pAttrTitle} {pCriteria} '{oBit.ToString}'" End If Next End If Return oRETURN End Function Private Sub BarButtonItem4_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles BarButtonItem4.ItemClick RenewSearchAttributes() Start_Search() End Sub Private Sub Start_Search() Dim oHandle As IOverlaySplashScreenHandle = Nothing Try oHandle = SplashScreenManager.ShowOverlayForm(Me) Dim oSEARCH_SQL = SEARCH_SQL Dim oOperator As String Dim oCount As Integer = 1 'For Each oRow As DataRow In DTSearchTerms.Rows ' '"BracketLeft" ' '"AttrID", GetType(Integer)) ' '"AttrTitle" ' '"Criteria" ' '"SearchTerm" ' '"BracketRight" ' '"Operator" ' oOperator = oRow.Item("Operator").ToString ' Dim oSearchTerm = GetSearchTermForType(oRow.Item("AttrID"), oRow.Item("AttrTitle").ToString, oRow.Item("Criteria").ToString, oRow.Item("SearchTerm").ToString) ' Dim oBracketLeft As String = oRow.Item("BracketLeft").ToString ' Dim oBracketRight As String = oRow.Item("BracketLeft").ToString ' Dim oSpaceChar = IIf(oCount = 0, " ", "") ' oSEARCH_SQL &= $"{oSpaceChar}{oBracketLeft}{oSearchTerm}{oBracketRight}" ' If DTSearchTerms.Rows.Count > oCount Then ' oSEARCH_SQL &= $" {oOperator} {Chr(13)}" ' End If ' oCount += 1 'Next oSEARCH_SQL = oSEARCH_SQL.Replace("@UserID", My.Application.User.UserId) oSEARCH_SQL = oSEARCH_SQL.Replace("@User_ID", My.Application.User.UserId) oSEARCH_SQL = oSEARCH_SQL.Replace("@UserName", My.Application.User.UserName) oSEARCH_SQL = oSEARCH_SQL.Replace("@SearchID", PSEARCH_ID) 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 } Dim oDTSearchResult As DataTable = My.DatabaseIDB.GetDatatable(oSEARCH_SQL) If oDTSearchResult.Rows.Count > 0 Then Dim oShortGuid = Guid.NewGuid() Dim oWindowGuid = $"{PSEARCH_ID.ToString}-{My.User.Name}" Dim oParams = New DocumentResultParams() With { .IsIDBResult = True, .WindowGuid = oWindowGuid, .Results = New List(Of DocumentResult) From { New DocumentResult() With { .Title = TabSelected.Text, .Datatable = oDTSearchResult } } } Dim oForm As New frmDocumentResultList(My.LogConfig, oEnvironment, oParams) oForm.Show() ' Position Result Window below this window oForm.Location = GetResultFormLocation() oForm.Size = GetResultFormSize() Else Display_InfoItem("No results for this searchcombination!", Color.OrangeRed) End If Catch ex As Exception MsgBox(ex.Message, MsgBoxStyle.Critical, Text) Finally SplashScreenManager.CloseOverlayForm(oHandle) End Try End Sub Private Function GetResultFormLocation() As Point Dim oX = Location.X Dim oY = Location.Y + Size.Height Return New Point(oX, oY) End Function Private Function GetResultFormSize() As Size Dim oWidth = Size.Width ' TODO: Smarter height calculation, maybe depending on screen height and parent form location Dim oHeight = 400 Return New Size(oWidth, oHeight) End Function Private Sub frmSearchStart_KeyUp(sender As Object, e As KeyEventArgs) Handles Me.KeyUp If e.KeyCode = Keys.F2 Then Start_Search() End If End Sub Private Class FilterTimeframe Public Property Name As String Public Property From As Date Public Property [To] As Date Public Property DisableFilter As Boolean = False Public Property CustomFilter As Boolean = False Public Overrides Function ToString() As String Return Name.ToString End Function End Class Private Sub cmbFilterTimeframe_EditValueChanged(sender As Object, e As EventArgs) Handles cmbFilterTimeframe.EditValueChanged Dim oTimeframe As FilterTimeframe = DirectCast(cmbFilterTimeframe.EditValue, FilterTimeframe) If oTimeframe.DisableFilter Then txtFilterFrom.Enabled = False txtFilterFrom.Reset() txtFilterTo.Enabled = False txtFilterTo.Reset() Else txtFilterFrom.Enabled = True txtFilterFrom.EditValue = oTimeframe.From txtFilterTo.Enabled = True txtFilterTo.EditValue = oTimeframe.[To] End If End Sub End Class