Monorepo/GUIs.ZooFlow/frmSearchStart.vb

963 lines
42 KiB
VB.net

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