Monorepo/GUIs.ZooFlow/frmSearchStart.vb

347 lines
15 KiB
VB.net

Imports DigitalData.Modules.Logging
Imports DevExpress.XtraTab
Imports DevExpress.XtraGrid
Imports DevExpress.XtraGrid.Views.Grid
Imports DevExpress.XtraEditors
Public Class frmSearchStart
Private Logger As Logger
Private DTSearchProfiles As DataTable
Private TabSelected As XtraTabPage
Private PSEARCH_ID As Integer = 0
Private PSEARCH_BASE_RESULT_SQL As String
Public FormShown As Boolean = False
Private Const DEFAULT_X As Integer = 10
Private Const DEFAULT_Y As Integer = 10
Private DTSearchTerms As DataTable
Private SEARCH_COUNT As Integer = 0
Public Sub New(pDTSearchProfiles As DataTable)
' 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("AttrID", GetType(Integer))
oSearchTerms.Columns.Add("AttrTitle", GetType(String))
oSearchTerms.Columns.Add("Criteria", GetType(String))
oSearchTerms.Columns.Add("SearchTerm", GetType(String))
DTSearchTerms = oSearchTerms
End Sub
Public Sub AddSearchAttribute(pAttrID As String, pAttrTitle As String, pSearchTerm As String, Optional pCriteria As String = "=")
For Each oSearchTerm As DataRow In DTSearchTerms.Rows
If oSearchTerm.Item("AttrID") = pAttrID Then 'And oSearchTerm.Item("Criteria") = pCriteria And oSearchTerm.Item("SearchTerm") = pSearchTerm
oSearchTerm.Delete()
End If
Next
DTSearchTerms.Rows.Add(pAttrID, pAttrTitle, pCriteria, pSearchTerm)
DTSearchTerms.AcceptChanges()
AddToken(pAttrTitle & " " & pCriteria & " '" & pSearchTerm & "'")
End Sub
Public Sub SearchAttribute(pAttrID As String, pAttrTitle As String, pSearchTerm As String, Optional pCriteria As String = "=")
DTSearchTerms.Rows.Add(pAttrID, pAttrTitle, pCriteria, pSearchTerm)
DTSearchTerms.AcceptChanges()
End Sub
Private Sub frmSearchStart_Load(sender As Object, e As EventArgs) Handles Me.Load
Try
Me.Panel1.Visible = False
For Each oTab As XtraTabPage In XtraTabControl1.TabPages
oTab.PageVisible = False
Next
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
Me.Panel1.Visible = True
Else
TabSelected = XtraTabControl1.TabPages(0)
TabSelected.PageVisible = True
PSEARCH_ID = DTSearchProfiles.Rows(0).Item("SEARCH_PROFILE_ID")
PSEARCH_BASE_RESULT_SQL = DTSearchProfiles.Rows(0).Item("RESULT_SQL")
TabSelected.Text = DTSearchProfiles.Rows(0).Item("TITLE")
Load_Search_Attributes()
BarButtonItemNewSearch.Visibility = DevExpress.XtraBars.BarItemVisibility.Never
End If
SEARCH_COUNT = DTSearchProfiles.Rows.Count
Catch ex As Exception
Logger.Error(ex.Message)
MsgBox(ex.Message, MsgBoxStyle.Critical, "Unexpected error while loading ProfileSearches:")
End Try
End Sub
Sub Load_Search_Attributes()
Dim oSQL = $"SELECT * FROM VWIDB_SEARCH_PROFILE_ATTRIBUTES WHERE SEARCH_PROFIL_ID = {PSEARCH_ID} ORDER BY [SEQUENCE]"
Dim oDT As DataTable = My.Database_IDB.GetDatatable(oSQL)
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 oSingleResult As Boolean = False
Dim oAttriTitle As String = oAttributeRow.Item("ATTRIBUTE_TITLE").ToString
Dim oAttriID As String = oAttributeRow.Item("ATTRIBUTE_ID").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"))
'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)
Dim oView As DevExpress.XtraGrid.Views.Grid.GridView
oView = CType(myDGV.MainView, GridView)
AddHandler oView.FocusedRowChanged, AddressOf FocusedRowChanged
If omyDTSource.Rows.Count = 1 Then
oSingleResult = True
AddSearchAttribute(oAttriID, oAttriTitle, omyDTSource.Rows(0).Item(oAttriTitle).ToString)
End If
ElseIf oAttriTYPE = "DATE" Then
oMyControl = oControls.CreateExistingDatepicker(oAttributeRow, oXPosition, oYPositionControl)
Dim myDTP As DateEdit = CType(oMyControl, DateEdit)
AddHandler myDTP.DisableCalendarDate, AddressOf DisableCalendarDate
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)
oXPosition += oControlWidth + 20
Next
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 WindowsUIButtonPanel1_ButtonClick(sender As Object, e As DevExpress.XtraBars.Docking2010.ButtonEventArgs) Handles WindowsUIButtonPanel1.ButtonClick
Select Case e.Button.Properties.Tag.ToString
Case "Run"
RunSearch()
End Select
End Sub
Private Sub RunSearch()
Try
For Each oSearchTerm As DataRow In DTSearchTerms.Rows
Next
Catch ex As Exception
MsgBox("Unexpected Error in Clearing Search Items: " & ex.Message, MsgBoxStyle.Critical)
Logger.Error(ex)
End Try
End Sub
Private Sub XtraTabControl1_SelectedPageChanged(sender As Object, e As DevExpress.XtraTab.TabPageChangedEventArgs) Handles XtraTabControl1.SelectedPageChanged
TabSelected = XtraTabControl1.SelectedTabPage
End Sub
Private Sub FocusedRowChanged(sender As Object, e As Views.Base.FocusedRowChangedEventArgs)
If FormShown = 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
AddSearchAttribute(oAttrID, oAttrTitle, oResult)
' Return oResult
'Else : Return Nothing
End If
End Sub
Private Sub CheckBox_CheckedChanged(sender As Object, e As EventArgs)
If FormShown = 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
AddSearchAttribute(oAttrID, oAttrTitle, oChecked.ToString)
End Sub
Private Sub frmSearchStart_Shown(sender As Object, e As EventArgs) Handles Me.Shown
FormShown = 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
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()
DTSearchTerms.Clear()
Catch ex As Exception
MsgBox("Unexpected Error in Clearing Search Items: " & ex.Message, MsgBoxStyle.Critical)
End Try
TabSelected.Controls.Clear()
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
End Class