Imports DevExpress.Utils Imports DevExpress.XtraBars.Navigation Imports DevExpress.XtraEditors Imports DevExpress.XtraEditors.Controls Imports DevExpress.XtraEditors.Repository Imports DevExpress.XtraGrid.Views.Base Imports DevExpress.XtraGrid.Views.Tile Imports DevExpress.XtraScheduler Imports System.Text Imports System.IO Imports DevExpress.XtraGrid Imports WINDREAMLib Imports System.Runtime.InteropServices Public Class frmConstructor_Main Private Const SEE_MASK_INVOKEIDLIST = &HC Private Const SEE_MASK_NOCLOSEPROCESS = &H40 Private Const SEE_MASK_FLAG_NO_UI = &H400 Public Const SW_SHOW As Short = 5 _ Public Shared Function ShellExecuteEx(ByRef lpExecInfo As SHELLEXECUTEINFO) As Boolean End Function Public Structure SHELLEXECUTEINFO Public cbSize As Integer Public fMask As Integer Public hwnd As IntPtr Public lpVerb As String Public lpFile As String Public lpParameters As String Public lpDirectory As String Dim nShow As Integer Dim hInstApp As IntPtr Dim lpIDList As IntPtr Public lpClass As String Public hkeyClass As IntPtr Public dwHotKey As Integer Public hIcon As IntPtr Public hProcess As IntPtr End Structure #Region "Laufzeitvariablen & Konstanten" Private CONSTRUCTORID As Integer Private CONSTRUCTOR_DETAIL_ID As Integer Private DT_CONSTRUCT_VIEW As DataTable Private EBENE2_PARENT_ID As Integer Private EBENE3_PARENT_ID As Integer Private ACT_EBENE As Integer Private ACT_EBENE_STRING As String Private SELECTED_RECORD_ID As Integer Private PARENT_RECORDID As Integer Private POS_ENTITY As Integer = 0 Private POS_SQL As String = "" Private POS_RECORD_ID Dim IsTopFirstRow As Boolean = True Private RightMouse_Clicked = False Private VIEW_ID Private VIEW_ID_RUNTIME As Integer = -1 Public RECORD_ENABLED As Boolean = False Private windream_inited = False Private ENTITY_RECORD_COUNT As Integer = 0 Private EBENE1_ENTITY Private EBENE2_ENTITY Private EBENE3_ENTITY Private EBENE1_COLUMNNAME Private EBENE2_COLUMNNAME Private EBENE3_COLUMNNAME Private EBENE1_RECID Private EBENE2_RECID Private EBENE3_RECID Private EBENE1_GRID_RESULT Private EBENE2_GRID_RESULT Private EBENE3_GRID_RESULT Private act_FormViewID Private DT_SELECTION As DataTable Private EDIT_STATE As EditState = EditState.None Private GRID_TYPE As GridType = GridType.Tiles Private GRID_TYPE_ID As Integer = 1 Private FORM_LOADED As Boolean = False Private RECORD_CHANGED As Boolean = False Private SAVE_ROUTINE_ACTIVE As Boolean = False Private SP1 As String Private SP2 As String Private SP3 As String Private SP4 As String Private SP5 As String Private RIGHT_EDIT_R As Boolean = True Private RIGHT_ADD_R As Boolean = True Private RIGHT_DELETE_R As Boolean = False Private RIGHT_ADD_DOC As Boolean = True Private RIGHT_VIEW_DOC As Boolean = True Private RIGHT_DELETE_DOC As Boolean = False Private RIGHT_ONLY_READ As Boolean = False Private windream_Docshow As Boolean = False Private WD_Suche As String Private DocView Private DocViewString As String Private OpenedFileString As String Private _FormClosing As Boolean = False Private ENTITY_LOADED As Boolean = False Private LinkParentID As Integer Private CONTROL_DOCTYPE_MATCH As Integer = 0 Private FOLLOW_UPisActive As Boolean = False Private DT_FU_Record As DataTable Private DT_FU_ENTITY As DataTable Private FOLL_UP_RECORD_DEFINED As Boolean = False Private FOLL_UP_DATE_CTRL_ID As Integer Private FOLL_UP_DONE_CTRL_ID As Integer Private FOLL_UP_ID As Integer Private LOAD_DIRECT As Boolean = False Private IS_SINGLE_RECORD As Boolean = False Private RECORD_ID As Integer Private PARENT_ID As Integer Private SQL_RIGHT_READ_AND_VIEW_ONLY As String = "" Private FORM_TYPE As Integer Private ENTITY_ID As Integer Private FORMVIEW_ID As Integer Private _ENTITYSQL As String Private _ENTITYSTRING As String Private RESULT_DOC_PATH Public Enum EditState None Insert Update Delete End Enum Public Enum GridType Grid Carousel Tiles End Enum #End Region Private Sub frmConstructor_Main_DragDrop(sender As Object, e As DragEventArgs) Handles Me.DragDrop End Sub Private Sub frmForm_Constructor_Main_FormClosing(sender As Object, e As FormClosingEventArgs) Handles Me.FormClosing _FormClosing = True ' Check_Record_Changed() CloseWDDocview() Save_Grid_Layout() Save_Splitter_Layout() ClassWindowLocation.SaveFormLocationSize(Me, CONSTRUCTORID, CURRENT_SCREEN_ID, "CONSTRUCTOR_MAIN") ' Verhindert, das noch geöffnete Records für immer gelockt sind ClassRecordState.UnlockRecord(SELECTED_RECORD_ID) End Sub Private Sub frmForm_Constructor_Main_Load(sender As Object, e As EventArgs) Handles Me.Load Dim sw As New Stopwatch Try sw.Start() tsslblRecord.Text = "" tsslblStatus.Text = "" _FormClosing = False CONSTRUCTORID = CURRENT_CONSTRUCTOR_ID Me.Cursor = Cursors.WaitCursor Init_Grid_Control() Catch ex As Exception MsgBox("Error while Loading Form part 1" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try ' Bestimme Dinge ausblenden wenn kein admin If USER_IS_ADMIN = True Then FormDesignerToolStripMenuItem.Visible = True Else FormDesignerToolStripMenuItem.Visible = False End If Try 'SplitCont_Details.Collapsed = True CONSTRUCTORID = CURRENT_CONSTRUCTOR_ID ClassWindowLocation.LoadFormLocationSize(Me, CONSTRUCTORID, CURRENT_SCREEN_ID, "CONSTRUCTOR_MAIN") VWPMO_WF_USER_ACTIVETableAdapter.Connection.ConnectionString = MyConnectionString Me.TBPMO_FILES_USERTableAdapter.Connection.ConnectionString = MyConnectionString Me.VWPMO_WF_ACTIVETableAdapter.Connection.ConnectionString = MyConnectionString DT_CONSTRUCT_VIEW = ClassDatabase.Return_Datatable("SELECT * FROM TBPMO_FORM_CONSTRUCTOR WHERE GUID = " & CONSTRUCTORID) If DT_CONSTRUCT_VIEW.Rows.Count = 1 Then 'Load Input Grid Me.Text = DT_CONSTRUCT_VIEW.Rows(0).Item("FORM_TITLE") 'Die Standards ein/ausblenden End If Load_Tree_View(CONSTRUCTORID) FORM_LOADED = True Dim elapsed As Double elapsed = sw.Elapsed.TotalSeconds sw.Stop() sw.Reset() If LogErrorsOnly = False Then ClassLogger.Add(" >> Form Load took " & Format(elapsed, "0.000000000") & " seconds", False) Catch ex As System.Exception MsgBox("Error while Loading Form part 2" & vbNewLine & ex.Message, MsgBoxStyle.Critical) 'System.Windows.Forms.MessageBox.Show(ex.Message) End Try Me.Cursor = Cursors.Default End Sub #Region "Layout" Sub Save_POSGrid_Layout() Try Dim EntityRegex As New RegularExpressions.Regex("\s+\(\d+\)") Dim EntityName As String = EntityRegex.Replace(ACT_EBENE_STRING & "_POS", "") Dim Filename As String = String.Format("{0}-{1}-{2}-UserLayout.xml", grvwGridPos.Name, EntityName, CONSTRUCTORID) Dim XMLPath = System.IO.Path.Combine(Application.UserAppDataPath(), Filename) grvwGridPos.SaveLayoutToXml(XMLPath) Catch ex As Exception MsgBox("Error in Save_POSGrid_Layout:" & vbNewLine & ex.Message) End Try End Sub Sub Load_POSGrid_Layout() Try Dim EntityRegex As New RegularExpressions.Regex("\s+\(\d+\)") Dim EntityName As String = EntityRegex.Replace(ACT_EBENE_STRING & "_POS", "") Dim Filename As String = String.Format("{0}-{1}-{2}-UserLayout.xml", grvwGridPos.Name, EntityName, CONSTRUCTORID) Dim XMLPath = System.IO.Path.Combine(Application.UserAppDataPath(), Filename) If File.Exists(XMLPath) Then grvwGridPos.RestoreLayoutFromXml(XMLPath) grvwGridPos.GuessAutoFilterRowValuesFromFilter() 'grvwGrid.ClearGrouping() ' grvwGridPos.ClearSelection() ' grvwGridPos.OptionsView.ShowPreview = False End If Catch ex As Exception MsgBox("Error in Load_POSGrid_Layout:" & vbNewLine & ex.Message) End Try End Sub Sub Save_Grid_Layout() Try If ACT_EBENE_STRING Is Nothing Then Exit Sub End If Dim XMLPath = Get_Grid_Layout_Filename() grvwGrid.SaveLayoutToXml(XMLPath) ' Update_Status_Label(True, "Grid Layout Loaded") Catch ex As Exception MsgBox("Error in Save_Grid_Layout:" & vbNewLine & ex.Message) End Try End Sub Sub Load_Grid_Layout() Try Dim XMLPath = Get_Grid_Layout_Filename() If File.Exists(XMLPath) And GRID_TYPE = GridType.Grid Then grvwGrid.RestoreLayoutFromXml(XMLPath) 'grvwGrid.ClearGrouping() ' grvwGrid.ClearSelection() 'grvwGrid.OptionsView.ShowPreview = False grvwGridPos.GuessAutoFilterRowValuesFromFilter() 'Update_Status_Label(True, "Grid Layout Loaded") End If Catch ex As Exception MsgBox("Error in Load_Grid_Layout: " & vbNewLine & ex.Message) End Try End Sub Sub Load_Splitter_Layout() Try Dim XMLPath As String = Get_Splitter_Layout_Filename() Dim layout As New ClassLayout(XMLPath) Dim settings As System.Collections.Generic.List(Of ClassSetting) settings = layout.Load() If settings.Count = 0 Then settings.Add(New ClassSetting("SplitViewTopSplitterPosition", SplitContainerTop.SplitterPosition)) settings.Add(New ClassSetting("SplitViewMainSplitterPosition", SplitContainerMain.SplitterPosition)) layout.Save(settings) End If For Each setting As ClassSetting In settings Select Case setting._name Case "SplitViewTopSplitterPosition" SplitContainerTop.SplitterPosition = Integer.Parse(setting._value) Case "SplitViewMainSplitterPosition" SplitContainerMain.SplitterPosition = Integer.Parse(setting._value) End Select Next Catch ex As Exception MsgBox("Fehler in Load_Splitter_Layout:" & vbNewLine & ex.Message) End Try End Sub Sub Save_Splitter_Layout() Try Dim XMLPath = Get_Splitter_Layout_Filename() Dim layout As New ClassLayout(XMLPath) Dim settings As New System.Collections.Generic.List(Of ClassSetting) settings.Add(New ClassSetting("SplitViewTopSplitterPosition", SplitContainerTop.SplitterPosition)) settings.Add(New ClassSetting("SplitViewMainSplitterPosition", SplitContainerMain.SplitterPosition)) layout.Save(settings) Catch ex As Exception MsgBox("Error in Save_Splitter_Layout:" & vbNewLine & ex.Message) End Try End Sub Function GetSafeFilename(filename As String) Return String.Join("_", filename.Split(Path.GetInvalidFileNameChars())) End Function Private Function Get_Splitter_Layout_Filename() Dim Filename As String = String.Format("{0}-SplitterLayout.xml", CONSTRUCTORID) Return System.IO.Path.Combine(Application.UserAppDataPath(), Filename) End Function Private Function Get_POSGrid_Layout_Filename() Dim EntityRegex As New RegularExpressions.Regex("\s+\(\d+\)") Dim EntityName As String = EntityRegex.Replace(ACT_EBENE_STRING, "") Dim Filename As String = String.Format("{0}-{1}-{2}-UserLayout.xml", grvwGrid.Name, GetSafeFilename(EntityName), CONSTRUCTORID) Return System.IO.Path.Combine(Application.UserAppDataPath(), Filename) End Function Private Function Get_Grid_Layout_Filename() Dim EntityRegex As New RegularExpressions.Regex("\s+\(\d+\)") Dim EntityName As String = EntityRegex.Replace(ACT_EBENE_STRING, "") Dim Filename As String = String.Format("{0}-{1}-{2}-UserLayout.xml", grvwGrid.Name, GetSafeFilename(EntityName), CONSTRUCTORID) Return System.IO.Path.Combine(Application.UserAppDataPath(), Filename) End Function #End Region #Region "NavPane" Sub Refresh_Navpane() 'Die aktuelle Ebene überprüfen und das NAvpane aktualisieren Select Case ACT_EBENE Case 1 If Not EBENE1_COLUMNNAME Is Nothing Then EBENE1_GRID_RESULT = Get_GridResult(EBENE1_COLUMNNAME) Dim cat As TileNavCategory = LoadLevel1Nav() NavPane.Categories.Clear() NavPane.Categories.Add(cat) End If Case 2 If Not EBENE2_COLUMNNAME Is Nothing Then EBENE2_GRID_RESULT = Get_GridResult(EBENE2_COLUMNNAME) Dim cat As TileNavCategory = LoadLevel1Nav() NavPane.Categories.Clear() NavPane.Categories.Add(cat) Dim item As TileNavItem = LoadLevel2Nav() cat.Items.Add(item) End If Case 3 EBENE3_RECID = SELECTED_RECORD_ID If Not EBENE3_COLUMNNAME Is Nothing Then EBENE3_GRID_RESULT = Get_GridResult(EBENE3_COLUMNNAME) Dim cat As TileNavCategory = LoadLevel1Nav() NavPane.Categories.Clear() NavPane.Categories.Add(cat) Dim item As TileNavItem = LoadLevel2Nav() cat.Items.Add(item) Dim subitem As TileNavSubItem = LoadLevel3Nav() item.SubItems.Add(subitem) End If End Select End Sub Private Function FindNode(tncoll As TreeNodeCollection, strText As [String]) As TreeNode Dim tnFound As TreeNode For Each tnCurr As TreeNode In tncoll If tnCurr.Text.StartsWith(strText) Then Return tnCurr End If tnFound = FindNode(tnCurr.Nodes, strText) If tnFound IsNot Nothing Then Return tnFound End If Next Return Nothing End Function Private Sub NavPane_MouseUp(sender As Object, e As MouseEventArgs) Handles NavPane.MouseUp Dim pane As TileNavPane = TryCast(sender, TileNavPane) Dim hitInfo As TileNavPaneHitInfo = pane.ViewInfo.CalcHitInfo(e.Location) If hitInfo.InButton Then Dim element = hitInfo.ButtonInfo.Element NavPane.HideDropDownWindow() Save_Grid_Layout() If TypeOf element Is NavButton Then Dim btn As NavButton = TryCast(element, NavButton) If btn.IsMain Then ResetNav() ElseIf btn.Name = "NavButtonRefresh" Then Load_Tree_View_Data() End If Else Dim Entity As String = element.Tag Dim Node = FindNode(TreeViewMain.Nodes, Entity) If Node IsNot Nothing Then TreeViewMain.SelectedNode = Node Load_Tree_View_Data() End If End If End If End Sub Private Function LoadLevel1Nav() Dim cat As New TileNavCategory() cat.Caption = EBENE1_GRID_RESULT cat.Name = EBENE1_GRID_RESULT cat.TileText = EBENE1_GRID_RESULT cat.Tag = EBENE1_ENTITY NavPane.SelectedElement = cat Return cat End Function Private Function LoadLevel2Nav() Dim item As New TileNavItem() item.Caption = EBENE2_GRID_RESULT item.Name = EBENE2_GRID_RESULT item.TileText = EBENE2_GRID_RESULT item.Tag = EBENE2_ENTITY NavPane.SelectedElement = item Return item End Function Private Function LoadLevel3Nav() Dim subitem As New TileNavSubItem() subitem.Caption = EBENE3_GRID_RESULT subitem.Name = EBENE3_GRID_RESULT subitem.TileText = EBENE3_GRID_RESULT subitem.Tag = EBENE3_ENTITY NavPane.SelectedElement = subitem Return subitem End Function Private Sub ResetNav() 'Grid zurücksetzen Clear_Grid_View() ACT_EBENE = 0 ACT_EBENE_STRING = "" EBENE1_ENTITY = "" EBENE1_RECID = 0 EBENE2_ENTITY = "" EBENE2_RECID = 0 EBENE3_ENTITY = "" EBENE3_RECID = 0 'Navigation zurücksetzen NavPane.Categories.Clear() 'TreeView zurücksetzen 'Load_Tree_View(CONSTRUCTORID) TreeViewMain.SelectedNode = Nothing SetSelectedNodeStyle(TreeViewMain.Nodes) Load_Tree_View(CONSTRUCTORID) End Sub #End Region #Region "GridControl" Public Sub Init_Grid_Control() GRID_TYPE = GridType.Tiles GRID_TYPE_ID = 1 GridControlMain.MainView = grvwTiles End Sub Public Sub Hide_Grid_Columns() Dim DefaultHiddenColumns As New List(Of String) From {"Record-ID", "Form-ID"} Dim QuickHiddenColumns As New List(Of String) From {"AddedWho", "AddedWhen", "ChangedWho", "ChangedWhen"} If GRID_TYPE = GridType.Carousel Or GRID_TYPE = GridType.Tiles Then DefaultHiddenColumns.AddRange(QuickHiddenColumns) End If For Each colname As String In DefaultHiddenColumns Dim col = grvwTiles.Columns.Item(colname) If col IsNot Nothing Then col.Visible = False End If Next End Sub 'Public Function Get_Grid_Sql(ConstructorId As Integer, FormId As Integer) ' If GRID_TYPE = GridType.Grid Then ' _ENTITYSQL = "SELECT T.* FROM VWTEMP_PMO_FORM" & FormId.ToString & " T" ' Else 'Tiles und Carousel bekommen Quick View ' _ENTITYSQL = String.Format("SELECT SQL_QUICK_VIEW FROM VWPMO_CONSTRUCTOR_FORMS WHERE CONSTRUCT_ID = {0} AND FORM_ID = {1}", ConstructorId, FormId) ' _ENTITYSQL = ClassDatabase.Execute_Scalar(_ENTITYSQL, True) ' If _ENTITYSQL = String.Empty Then ' _ENTITYSQL = "SELECT T.* FROM VWTEMP_PMO_FORM" & FormId.ToString & " T" ' If IS_SINGLE_RECORD = True Or FORM_TYPE = 5 Then ' Else ' GRID_TYPE = GridType.Grid ' GridControlMain.MainView = grvwGrid ' VIEW_ID = 3 ' End If ' GridControlMain.MainView = grvwGrid ' End If ' End If 'End Function Public Function Get_Grid_Sql(ConstructorId As Integer, FormId As Integer, ConstructorDetailID As Integer) Try If GRID_TYPE = GridType.Grid Then If LogErrorsOnly = False Then ClassLogger.Add(" >> GridType = Grid", False) _ENTITYSQL = "SELECT T.* FROM VWTEMP_PMO_FORM" & FormId.ToString & " T" Else 'Tiles und Carousel bekommen Quick View _ENTITYSQL = String.Format("SELECT SQL_QUICK_VIEW FROM VWPMO_CONSTRUCTOR_FORMS WHERE CONSTRUCT_ID = {0} AND FORM_ID = {1} AND SCREEN_ID = {2}", ConstructorId, FormId, CURRENT_SCREEN_ID) _ENTITYSQL = ClassDatabase.Execute_Scalar(_ENTITYSQL, True) If _ENTITYSQL = String.Empty Then _ENTITYSQL = "SELECT T.* FROM VWTEMP_PMO_FORM" & FormId.ToString & " T" If IS_SINGLE_RECORD = True Or FORM_TYPE = 5 Then Else GRID_TYPE = GridType.Grid GridControlMain.MainView = grvwGrid VIEW_ID = 3 End If ' GridControlMain.MainView = grvwGrid Else If LogErrorsOnly = False Then ClassLogger.Add(" >> Quick-View is configured", False) End If End If Try Dim sql = String.Format("SELECT COUNT(*) FROM TBPMO_CONSTRUCTOR_USER_SQL WHERE USER_ID = {0} AND CONSTR_DET_ID = {1} AND SQL_COMMAND IS NOT NULL AND SQL_COMMAND <> ''", USER_GUID, ConstructorDetailID) Dim exists = ClassDatabase.Execute_Scalar(sql) If exists = 1 Then sql = String.Format("SELECT SQL_COMMAND FROM TBPMO_CONSTRUCTOR_USER_SQL WHERE USER_ID = {0} AND CONSTR_DET_ID = {1}", USER_GUID, ConstructorDetailID) Dim result = ClassDatabase.Execute_Scalar(sql) If Not IsNothing(result) Then _ENTITYSQL = _ENTITYSQL & " " & result.ToString _ENTITYSQL = _ENTITYSQL.ToUpper.Replace("@RECORDID", RECORD_ID) _ENTITYSQL = _ENTITYSQL.ToUpper.Replace("@USER_ID", USER_GUID) End If End If Catch ex As Exception ClassLogger.Add("Error in Get Entity SQL for User: " & vbNewLine & ex.Message, True) MsgBox("Error in Get Entity SQL for User: " & vbNewLine & ex.Message) End Try Catch ex As Exception ClassLogger.Add("Error in Get_Grid_Sql: " & vbNewLine & ex.Message, True) MsgBox("Error in Get_Grid_Sql: " & vbNewLine & ex.Message) End Try End Function Public Function Get_Pos_SQL(FormId As Integer) POS_SQL = "SELECT T.* FROM VWTEMP_PMO_FORM" & FormId.ToString & " T, TBPMO_RECORD_CONNECT t1 where T.[Record-ID] = T1.RECORD2_ID AND T1.RECORD1_ID = @PARENT_ID" End Function Public Sub Clear_Grid_View() GridControlMain.DataSource = Nothing If GRID_TYPE = GridType.Grid Then If grvwGrid.Columns.Count > 0 Then grvwGrid.Columns.Clear() End If ElseIf GRID_TYPE = GridType.Tiles Then grvwTiles.Columns.Clear() Else grvwCarousel.Columns.Clear() End If End Sub Public Sub Clear_GridPos_View() BindingNavigatorPOS.BindingSource = Nothing GridControlPos.DataSource = Nothing grvwGridPos.Columns.Clear() POS_RECORD_ID = 0 End Sub Public Function Get_Grid_Row_Count() As Integer If GRID_TYPE = GridType.Grid Then Return grvwGrid.RowCount ElseIf GRID_TYPE = GridType.Tiles Then Return grvwTiles.RowCount Else Return grvwCarousel.RowCount End If End Function Public Function Get_Grid_Row_Handle(value As String) Try Dim rowHandle As Integer = DT_SELECTION.Rows.IndexOf(DT_SELECTION.Rows.Find(value)) If rowHandle > 0 Then If GRID_TYPE = GridType.Grid Then grvwGrid.FocusedRowHandle = rowHandle ElseIf GRID_TYPE = GridType.Tiles Then grvwTiles.FocusedRowHandle = rowHandle Else grvwCarousel.FocusedRowHandle = rowHandle End If End If Catch ex As Exception ClassLogger.Add("Error in Search_RowHandle: " & ex.Message, False) End Try End Function Public Function Get_Grid_Column_Count() As Integer If GRID_TYPE = GridType.Grid Then Return grvwGrid.Columns.Count ElseIf GRID_TYPE = GridType.Tiles Then Return grvwTiles.Columns.Count Else Return grvwCarousel.Columns.Count End If End Function Public Function Get_Focused_Row_Cell_Value(columnName As String) If GRID_TYPE = GridType.Grid Then Return grvwGrid.GetFocusedRowCellValue(grvwGrid.Columns(columnName)) ElseIf GRID_TYPE = GridType.Tiles Then Return grvwTiles.GetFocusedRowCellValue(grvwTiles.Columns(columnName)) Else Return grvwCarousel.GetFocusedRowCellValue(grvwCarousel.Columns(columnName)) End If End Function Public Function Get_Focused_Row_Cell_Value_pos(columnName As String) Return grvwGridPos.GetFocusedRowCellValue(grvwGrid.Columns(columnName)) End Function Private Sub grvwGrid_FocusedColumnChanged(sender As Object, e As FocusedColumnChangedEventArgs) Handles grvwGrid.FocusedColumnChanged Me.Cursor = Cursors.WaitCursor Column_Row_Handler() Me.Cursor = Cursors.Default End Sub Private Sub GridView_FocusedRowChanged(sender As Object, e As DevExpress.XtraGrid.Views.Base.FocusedRowChangedEventArgs) Handles grvwGrid.FocusedRowChanged, grvwTiles.FocusedRowChanged, grvwCarousel.FocusedRowChanged Me.Cursor = Cursors.WaitCursor Column_Row_Handler() Me.Cursor = Cursors.Default 'If dataloaded = True Then ' If LogErrorsOnly = False Then ClassLogger.Add(" >> grvwSelection_FocusedRowChanged - EditState: " & EDIT_STATE, False) ' Dim selRecID = GetSelected_RecordID() ' If Not selRecID Is Nothing And selRecID <> SelectedRecordID Or EDIT_STATE = "insert" Then ' Focused_Row_Column_Changed() ' Else ' 'Console.WriteLine("SelRecordID identisch") ' End If 'End If End Sub Private Sub gridView1_CustomDrawRowIndicator(sender As Object, e As DevExpress.XtraGrid.Views.Grid.RowIndicatorCustomDrawEventArgs) If IsTopFirstRow Then e.Info.ImageIndex = -1 End If End Sub Sub Column_Row_Handler() If _FormClosing = True Then 'Or SaveRoutine_Active = True Exit Sub End If 'Aussteigen, wenng erade die Entität gewechselt wird If ENTITY_LOADED = False Then Exit Sub End If If RightMouse_Clicked Then Exit Sub End If Dim Grid_RecordID = Get_Focused_Row_Cell_Value("Record-ID") If IsNothing(Grid_RecordID) Then Console.WriteLine("No Record ID selectable") Else If Grid_RecordID = 0 Then Console.WriteLine("Grid_RecordID = 0") Else If Grid_RecordID = RECORD_ID And ENTITY_RECORD_COUNT > 1 Then Exit Sub End If If LogErrorsOnly = False Then ClassLogger.Add(" >> RowHandler: RID: " & Grid_RecordID.ToString & " - " & Now, False) 'Hier jetzt erst das Anzeigen für einen selektierten Datensatz If GRID_TYPE = GridType.Grid Then If IsTopFirstRow Then IsTopFirstRow = False 'grvwGrid.FocusRectStyle = DevExpress.XtraGrid.Views.Grid.DrawFocusRectStyle.RowFocus 'grvwGrid.OptionsBehavior.Editable = Not IsTopFirstRow 'grvwGrid.OptionsSelection.EnableAppearanceFocusedCell = Not IsTopFirstRow 'grvwGrid.OptionsSelection.EnableAppearanceFocusedRow = Not IsTopFirstRow 'grvwGrid.OptionsSelection.EnableAppearanceHideSelection = Not IsTopFirstRow End If ElseIf GRID_TYPE = GridType.Carousel Then If IsTopFirstRow Then IsTopFirstRow = False grvwCarousel.OptionsBehavior.Editable = Not IsTopFirstRow End If ElseIf GRID_TYPE = GridType.Tiles Then If IsTopFirstRow Then IsTopFirstRow = False grvwTiles.OptionsBehavior.Editable = Not IsTopFirstRow End If End If Check_Record_Changed() DisableEditMode() VerknüpfungenAnzeigenToolStripMenuItem.Enabled = True Show_Selected_Record_Data(Grid_RecordID, False) RIGHT_ONLY_READ = False tsmi_RecordDelete.Enabled = True DeleteToolStripMenuItem.Enabled = True CopyToolStripMenuItem.Enabled = True RecordKopierenToolStripMenuItem.Enabled = True PropertiesToolStripMenuItem.Enabled = True tslblLocked.Visible = False TabFollowUp.PageEnabled = True Dim tempsql If SQL_RIGHT_READ_AND_VIEW_ONLY <> "" Then Try tempsql = SQL_RIGHT_READ_AND_VIEW_ONLY tempsql = tempsql.Replace("@RECORDID", RECORD_ID) tempsql = tempsql.Replace("@RECORD_ID", RECORD_ID) tempsql = tempsql.Replace("@USER_ID", USER_GUID) tempsql = tempsql.Replace("@USER_GUID", USER_GUID) ''Regulären Ausdruck zum Auslesen der windream-Indexe definieren 'Dim preg As String = "\[%{1}[a-zA-Z0-9\!\$\&\/\(\)\=\?\,\.\-\;\:_öÖüÜäÄ\#\'\+\*\~\{\}\@\€\<\>\ ]+]{1}" '' einen Regulären Ausdruck laden 'Dim regulärerAusdruck As System.Text.RegularExpressions.Regex = New System.Text.RegularExpressions.Regex(preg) '' die Vorkommen im SQL-String auslesen 'Dim elemente As System.Text.RegularExpressions.MatchCollection = regulärerAusdruck.Matches(tempsql) '' alle Vorkommen der windream-Indexe im SQL-String durchlaufen ''##### '' alle Vorkommen der windream-Indexe im SQL-String durchlaufen 'For Each element As System.Text.RegularExpressions.Match In elemente ' Dim elementohneSZ = element.Value.Replace("[%", "") ' elementohneSZ = elementohneSZ.Replace("]", "") ' ' den Platzhalter für den auszulesenden View durch den Viewnamen ersetzen ' tempsql = tempsql.Replace(element.Value, controlvalue.ToString) 'Next Try RIGHT_ONLY_READ = CBool(ClassDatabase.Execute_Scalar(tempsql)) Catch ex As Exception RIGHT_ONLY_READ = False End Try If RIGHT_ONLY_READ = True Then ' Hinzufügen sollte auch bei RIGHT_ONLY_READ verfügbar sein tsButtonAdd.Enabled = True tsButtonEdit.Enabled = False tsButtonSave.Enabled = False tsButtonDelete.Enabled = False tsmi_RecordDelete.Enabled = False PropertiesToolStripMenuItem.Enabled = False CopyToolStripMenuItem.Enabled = False DeleteToolStripMenuItem.Enabled = False tslblLocked.Visible = True RecordKopierenToolStripMenuItem.Enabled = False TabFollowUp.PageEnabled = False End If Catch ex As Exception MsgBox("unexpected Error in Check Read-Limitations:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) ClassLogger.Add("Unexpected Error in Check Read-Limitations: " & ex.Message) ClassLogger.Add("TempSQL so far: " & tempsql) End Try End If If TCDetails.SelectedTabPage Is Nothing Then Exit Sub End If If TabPos.PageVisible = True And TCDetails.SelectedTabPage.Text.StartsWith("Posi") Then Clear_GridPos_View() Dim POS_GRID_RECORD = Get_Focused_Row_Cell_Value_pos("Record-ID") 'If Not IsNothing(POS_GRID_RECORD) Then ' If POS_GRID_RECORD <> POS_RECORD_ID Then ' End If 'Else ' Load_Pos_Data() ' Load_POSGrid_Layout() 'End If Load_Pos_Data() Load_POSGrid_Layout() End If If RECORD_ID > 0 Then If RIGHT_ONLY_READ = False Then tsButtonEdit.Enabled = True End If Get_RecordCounts_Nodes() End If End If End If End Sub #End Region #Region "TreeView" Public Sub SetSelectedNodeStyle(tncoll As TreeNodeCollection) For Each node As TreeNode In tncoll If node.IsSelected Then node.NodeFont = New Font(TreeViewMain.Font.FontFamily, TreeViewMain.Font.Size, FontStyle.Bold) node.Text = node.Text Else node.NodeFont = New Font(TreeViewMain.Font.FontFamily, TreeViewMain.Font.Size, FontStyle.Regular) End If If node.Nodes.Count > 0 Then SetSelectedNodeStyle(node.Nodes) End If Next TreeViewMain.Refresh() End Sub Private Sub TreeViewMain_AfterSelect(sender As Object, e As TreeViewEventArgs) Handles TreeViewMain.AfterSelect DisableEditMode() SetSelectedNodeStyle(TreeViewMain.Nodes) Load_Tree_View_Data() End Sub Private Sub TreeViewMain_BeforeSelect(sender As Object, e As TreeViewCancelEventArgs) Handles TreeViewMain.BeforeSelect If grvwGrid.Columns.Count > 0 Then Save_Grid_Layout() End If End Sub Sub Load_Tree_View(ConstructorId As Integer) Dim sw As New Stopwatch sw.Start() TreeViewMain.Nodes.Clear() Dim SQL As String Dim DT, DT2, DT3 As DataTable ' Daten für Level1 Nodes Laden SQL = String.Format("SELECT *, [dbo].[FNPMO_GETOBJECTCAPTION]('{0}','FORMVIEW_TITLE' + CONVERT(VARCHAR(5), FORM_VIEW_ID), {1}) AS 'CAPTION' " & _ "from VWPMO_CONSTRUCTOR_FORMS WHERE PARENT_ID = 0 AND CONSTRUCT_ID = {2} AND SCREEN_ID = {3} ORDER BY SEQUENCE", USER_LANGUAGE, CURRENT_SCREEN_ID, ConstructorId, CURRENT_SCREEN_ID) DT = ClassDatabase.Return_Datatable(SQL) If DT Is Nothing Then Exit Sub End If If DT.Rows.Count >= 1 Then For Each Row1 As DataRow In DT.Rows Dim LEVEL1_NODE As TreeNode Dim LEVEL2_NODE As TreeNode Dim LEVEL3_NODE As TreeNode Dim LEVEL1_TITLE = Row1.Item("CAPTION").ToString Dim LEVEL1_ID = Row1.Item("FORM_ID").ToString ' Rootnode erstellen und taggen LEVEL1_NODE = New TreeNode(LEVEL1_TITLE) LEVEL1_NODE.Tag = LEVEL1_ID ' TreeView Rootnode einfügen TreeViewMain.Nodes.Add(LEVEL1_NODE) Dim SQL2 As String ' Daten für Level2 Nodes Laden SQL2 = String.Format("SELECT *, [dbo].[FNPMO_GETOBJECTCAPTION]('{0}','FORMVIEW_TITLE' + CONVERT(VARCHAR(5), FORM_VIEW_ID), {1}) AS 'CAPTION' " & _ "FROM VWPMO_CONSTRUCTOR_FORMS WHERE CONSTRUCT_ID = {2} AND PARENT_ID = {3} ORDER BY SEQUENCE", USER_LANGUAGE, CURRENT_SCREEN_ID, ConstructorId, LEVEL1_ID) If LogErrorsOnly = False Then ClassLogger.Add(" >> Level2 Nodes SQL: " & SQL2, False) DT2 = ClassDatabase.Return_Datatable(SQL2) If Not (DT2 Is Nothing) Then For Each row As DataRow In DT2.Rows Dim LEVEL2_TITLE As String = row.Item("CAPTION").ToString Dim LEVEL2_ID As Integer = row.Item("FORM_ID") Dim LEVEL2_PARENT_ID As Integer = row.Item("PARENT_ID") ' Node erstellen.. LEVEL2_NODE = New TreeNode(LEVEL2_TITLE) LEVEL2_NODE.Tag = LEVEL2_ID ' ..und einfügen LEVEL1_NODE.Nodes.Add(LEVEL2_NODE) ' Daten für Level3 Nodes laden SQL = String.Format("SELECT *, [dbo].[FNPMO_GETOBJECTCAPTION]('{0}','FORMVIEW_TITLE' + CONVERT(VARCHAR(5), FORM_VIEW_ID), {1}) AS 'CAPTION' " & _ "FROM VWPMO_CONSTRUCTOR_FORMS WHERE CONSTRUCT_ID = {2} AND PARENT_ID = {3} ORDER BY SEQUENCE", USER_LANGUAGE, CURRENT_SCREEN_ID, ConstructorId, LEVEL2_ID) If LogErrorsOnly = False Then ClassLogger.Add(" >> Level3 Nodes SQL " & SQL, False) DT3 = ClassDatabase.Return_Datatable(SQL) For Each subrow As DataRow In DT3.Rows Dim LEVEL3_TITLE As String = subrow.Item("CAPTION") Dim LEVEL3_ID As Integer = subrow.Item("FORM_ID") ' Node erstellen.. LEVEL3_NODE = New TreeNode(LEVEL3_TITLE) LEVEL3_NODE.Tag = LEVEL3_ID ' ..und einfügen LEVEL2_NODE.Nodes.Add(LEVEL3_NODE) Next Next End If Next TreeViewMain.ExpandAll() TreeViewMain.Nodes(0).EnsureVisible() Dim elapsed As Double elapsed = sw.Elapsed.TotalSeconds sw.Stop() sw.Reset() If LogErrorsOnly = False Then ClassLogger.Add(" >> TreeView Load took " & Format(elapsed, "0.000000000") & " seconds", False) End If TreeViewMain.ExpandAll() End Sub Sub Load_Tree_View_Data() Dim sw As New Stopwatch sw.Start() Dim SelectedNode As TreeNode = TryCast(TreeViewMain.SelectedNode, TreeNode) If SelectedNode IsNot Nothing Then ENTITY_LOADED = False ENTITY_ID = SelectedNode.Tag Dim parentNode As TreeNode = TryCast(SelectedNode.Parent, TreeNode) ACT_EBENE = 2 If parentNode IsNot Nothing Then Dim grandParentNode As TreeNode = TryCast(parentNode.Parent, TreeNode) If grandParentNode IsNot Nothing Then ACT_EBENE = 3 End If Else ACT_EBENE = 1 End If Dim Sql = "SELECT GUID from VWPMO_CONSTRUCTOR_FORMS WHERE CONSTRUCT_ID = " & CONSTRUCTORID & " AND FORM_ID = " & ENTITY_ID & " AND SCREEN_ID = " & CURRENT_SCREEN_ID CONSTRUCTOR_DETAIL_ID = ClassDatabase.Execute_Scalar(Sql, True) Dim elapsed As Double elapsed = sw.Elapsed.TotalSeconds If LogErrorsOnly = False Then ClassLogger.Add(" >> Load_Tree_View_Data1 took " & Format(elapsed, "0.000000000") & " seconds", False) Get_RecordCounts_Nodes() Load_Entity_Data(ACT_EBENE) sw.Stop() sw.Reset() elapsed = elapsed - sw.Elapsed.TotalSeconds If LogErrorsOnly = False Then ClassLogger.Add(" >> Load_Tree_View_Data2 took " & Format(elapsed, "0.000000000") & " seconds", False) End If End Sub Sub Get_RecordCounts_Nodes() Try Dim sw As New Stopwatch sw.Start() Dim selnode As TreeNode = TreeViewMain.SelectedNode Dim a As Integer = 0 For Each childNodeLevel1 As TreeNode In selnode.Nodes Dim PARENT_ID As Integer Dim TYPE_ID As Integer If a = 0 Then Dim sql As String = "SELECT PARENT_ID, FORM_TYPE_ID FROM VWPMO_CONSTRUCTOR_FORMS WHERE CONSTRUCT_ID = " & CONSTRUCTORID & " AND FORM_ID = " & childNodeLevel1.Tag & " AND SCREEN_ID = " & CURRENT_SCREEN_ID Dim DT As DataTable = ClassDatabase.Return_Datatable(sql, "ShowNodeAmounts") PARENT_ID = DT.Rows(0).Item(0) TYPE_ID = DT.Rows(0).Item(1) End If If TYPE_ID <> 5 Then If childNodeLevel1.Text = "Allgemein" Then Console.WriteLine("Allgemein-Reiter") End If Dim result As Integer = ReturnAmountofRecords(childNodeLevel1.Tag, PARENT_ID) If result <> 99999999 Then Dim origtext As String = childNodeLevel1.Text If origtext.Contains(" (") Then Dim existingstring = origtext.Substring(0, origtext.IndexOf("(") - 1) childNodeLevel1.Text = existingstring & " (" & result.ToString & ")" Else childNodeLevel1.Text = childNodeLevel1.Text & " (" & result.ToString & ")" End If End If For Each childNodeLevel2 As TreeNode In childNodeLevel1.Nodes Dim origtext As String = childNodeLevel2.Text If origtext.Contains(" (") Then Dim existingstring = origtext.Substring(0, origtext.IndexOf("(") - 1) childNodeLevel2.Text = existingstring End If For Each childNodeLevel3 As TreeNode In childNodeLevel2.Nodes Dim origtext1 As String = childNodeLevel3.Text If origtext1.Contains(" (") Then Dim existingstring = origtext1.Substring(0, origtext1.IndexOf("(") - 1) childNodeLevel1.Text = existingstring End If Next Next a += 1 End If Next Dim elapsed As Double elapsed = sw.Elapsed.TotalSeconds sw.Stop() sw.Reset() If LogErrorsOnly = False Then ClassLogger.Add(" >> Get_RecordCounts_Nodes took " & Format(elapsed, "0.000000000") & " seconds", False) Catch ex As Exception MsgBox("Error in Get_RecordCounts_Nodes:" & vbNewLine & ex.Message, MsgBoxStyle.Exclamation) End Try End Sub Function ReturnAmountofRecords(EntityID As Integer, PARENT_ID As Integer) ' Statt eine Table zurückzugeben, können wir die anzahl der Zeilen auch in der Datenbank berechnen, ' dadurch wird die Abfrage um einiges schneller Dim SQL As String = "SELECT COUNT(*) FROM ( SELECT T.* FROM VWTEMP_PMO_FORM" & EntityID & " AS T,TBPMO_RECORD_CONNECT T1 WHERE T.[Record-ID] = T1.RECORD2_ID AND T1.RECORD1_ID = @RecordID ) x" 'Abhängig von der Entität dieAnzahl der Datensätze laden Select Case ACT_EBENE Case 1 If EBENE1_RECID = 0 Then Return 99999999 End If '_sql = _sql.Replace("@RecordID", EBENE1_RECID) SQL = SQL.Replace("@RecordID", EBENE1_RECID) Case 2 If EBENE2_RECID = 0 Then Return 99999999 End If If EBENE1_RECID = 0 Then End If '_sql = _sql.Replace("@RecordID", EBENE2_RECID) SQL = SQL.Replace("@RecordID", EBENE2_RECID) Case 3 If EBENE3_RECID = 0 Then Return 99999999 End If '_sql = _sql.Replace("@RecordID", EBENE2_RECID) SQL = SQL.Replace("@RecordID", EBENE2_RECID) End Select 'Dim DT2 As DataTable = ClassDatabase.Return_Datatable(_sql, "ReturnAmountofRecords 1") Dim count As Integer = ClassDatabase.Execute_Scalar(SQL, True) Return count End Function #End Region #Region "Status Bar" Public Sub Update_Status_Label(visible As Boolean, Optional text As String = "", Optional state As EditState = EditState.None) tsslblStatus.Text = text tsslblStatus.Visible = visible Select Case state Case EditState.Insert tsslblStatus.BackColor = Color.Yellow Case EditState.Update tsslblStatus.BackColor = Color.LightBlue Case Else tsslblStatus.BackColor = Color.LightGray End Select End Sub Public Sub Update_Record_Label(RecordId As Integer) Dim SQL As String = "SELECT 'Added by ' + ADDED_WHO + ' when ' + CONVERT(VARCHAR(16),ADDED_WHEN,20) + ', Changed by ' + COALESCE(CHANGED_WHO,'') + ' when ' + COALESCE(CONVERT(VARCHAR(16),CHANGED_WHEN,20),'') FROM TBPMO_RECORD WHERE GUID = " & RecordId Dim result = ClassDatabase.Execute_Scalar(SQL) If IsDBNull(result) Or IsNothing(result) Then tsslblRecord.Visible = False Else If FORM_TYPE = 5 Then tsslblRecord.Text = String.Format("Group-Record ({0}) - {1}", RecordId, result.ToString) Else If IS_SINGLE_RECORD = True Then tsslblRecord.Text = String.Format("Single-Record ({0}) - {1}", RecordId, result.ToString) Else tsslblRecord.Text = String.Format("Record ({0}) - {1}", RecordId, result.ToString) End If End If tsslblRecord.Text = tsslblRecord.Text.Replace(", Changed by when ", "") tsslblRecord.Visible = True End If End Sub #End Region #Region "Controls" Sub Load_Controls(frmview_id As Integer) Dim sw As New Stopwatch sw.Start() Dim elapsed As Double FORMVIEW_ID = frmview_id ENTITY_ID = ClassDatabase.Execute_Scalar("SELECT FORM_ID FROM TBPMO_FORM_VIEW WHERE GUID = " & frmview_id) CtrlBuilder = New ClassControlBuilder(pnlDetails) 'LoadControls(thisFormId) CtrlCommandUI = New ClassControlCommandsUI(CtrlBuilder, ContextMenuDetails, AddressOf NewEditAppointment, AddressOf OpenFormData) CtrlCommandUI.LoadControls(ENTITY_ID) Lock_RecordControls(True) ' pnlDetails.Enabled = False AddHandler CtrlBuilder.OnRecordChanged, AddressOf OnRecordChanged AddHandler CtrlBuilder.OnMouseHover, AddressOf HandleToolTip elapsed = sw.Elapsed.TotalSeconds If LogErrorsOnly = False Then ClassLogger.Add(" >> Load_Controls took " & Format(elapsed, "0.000000000") & " seconds", False) sw.Stop() sw.Reset() End Sub Private Sub HandleToolTip(sender As Object, e As EventArgs) Dim control As Control = DirectCast(sender, Control) Dim id As Integer = DirectCast(control.Tag, ClassControlMetadata).Id Dim hint = ClassControlValueCache.LoadHint(id) If Not IsNothing(hint) Then 'show hint Console.WriteLine("Showing hint: " & hint) ToolTipController.ShowHint(hint.ToString, ToolTipLocation.RightCenter) Else ToolTipController.HideHint() End If End Sub Private Sub OnRecordChanged(sender As Object, e As System.EventArgs) If ENTITY_LOADED Then RECORD_CHANGED = True End If End Sub Sub OpenFormData(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Try Dim Control As Control = sender Dim ControlName As String = Control.Name Dim ControlId As Integer = DirectCast(Control.Tag, ClassControlMetadata).Id ' GetControlID_for_Name(ControlName, FORM_ID) Dim dr As DataRow = ClassFunctionCommands.LoadFunction(ControlId) If IsDBNull(dr.Item("INTEGER1")) OrElse dr.Item("INTEGER1") = 0 Then MsgBox("FormId ist nicht definiert für " & ControlName) Exit Sub End If If IsDBNull(dr.Item("INTEGER2")) OrElse dr.Item("INTEGER2") = 0 Then MsgBox("ScreenId ist nicht definiert für " & ControlName) Exit Sub End If Dim FormId As Integer = dr.Item("INTEGER1") Dim ScreenId As Integer = dr.Item("INTEGER2") Cursor = Cursors.WaitCursor OpenFormInputFor(FormId, ScreenId) Cursor = Cursors.Default Catch ex As Exception MsgBox("Error in OpenFormData:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub #End Region #Region "DetailView - Toolstrip" Private Sub tsButtonAdd_Click(sender As Object, e As EventArgs) Handles tsButtonAdd.Click If CtrlCommandUI.IsInsert Then Exit Sub End If Me.Cursor = Cursors.WaitCursor Try If TCDetails.SelectedTabPage.Text.StartsWith("Pos") = False Then SELECTED_RECORD_ID = 0 CURRENT_RECORD_ID = 0 RECORD_ID = 0 Lock_RecordControls(False) tsButtonShowWorkflowTasks.Enabled = True CURRENT_PARENT_ID = PARENT_ID ClassControlValues.LoadDefaultValues(ENTITY_ID, SELECTED_RECORD_ID, pnlDetails.Controls, CURRENT_PARENT_ID, ENTITY_ID) ' Im gegensatz zu EnableEditMode muss hier nur der save button enabled werden tsButtonSave.Enabled = True ' Muss aktiviert werden, sonst funktionieren die Combobox Abhängigkeits Events nicht CURRENT_RECORD_ENABLED = True EDIT_STATE = EditState.Insert RECORD_CHANGED = True tsslblRecord.Text = "Adding record ......" RIGHT_ONLY_READ = False tslblLocked.Visible = False End If Catch ex As Exception MsgBox("Unexpected Error in Insert: " & ex.Message) Finally Me.Cursor = Cursors.Default CtrlCommandUI.IsInsert = True End Try End Sub Private Sub tsButtonSave_Click(sender As Object, e As EventArgs) Handles tsButtonSave.Click Save_Record() End Sub Function Save_Record() Try Me.Cursor = Cursors.WaitCursor SAVE_ROUTINE_ACTIVE = True Save_Grid_Layout() If CtrlCommandUI.IsInsert Then EDIT_STATE = EditState.Insert Else EDIT_STATE = EditState.Update NEW_RECORD_ID = 0 If Not RECORD_CHANGED Then Update_Status_Label(True, "NO CHANGES in Record.") Me.Cursor = Cursors.Default Return True End If End If 'Update aller Control-Werte Dim ResultMessage ' Wenn MussFelder nicht ausgefüllt werden, wird eine exception geworfen und abgefangen Try ResultMessage = Update_Record_OnChange() Catch ex As Exception MsgBox(ex.Message, MsgBoxStyle.Exclamation, "Error in saving Record") Me.Cursor = Cursors.Default Return False End Try Dim recid As Integer Update_Status_Label(True, ResultMessage, EDIT_STATE) If EDIT_STATE = EditState.Update Then recid = RECORD_ID Else recid = NEW_RECORD_ID End If SELECTED_RECORD_ID = recid RECORD_ID = recid CURRENT_RECORD_ID = RECORD_ID If RECORD_ID = 0 Then MsgBox("Attention: no current record Selected!", MsgBoxStyle.Exclamation) Me.Cursor = Cursors.Default Return False End If If EDIT_STATE = EditState.Insert Then Select Case ACT_EBENE Case 1 EBENE1_RECID = recid For Each row As DataRow In DT_SELECTION.Rows If row.Item("Record-ID") = SELECTED_RECORD_ID Then EBENE1_GRID_RESULT = row.Item(EBENE1_COLUMNNAME) End If Next Case 2 EBENE2_RECID = recid For Each row As DataRow In DT_SELECTION.Rows If row.Item("Record-ID") = SELECTED_RECORD_ID Then EBENE2_GRID_RESULT = row.Item(EBENE2_COLUMNNAME) End If Next If EBENE1_RECID = 0 Then 'Bis jetzt konnte noch keine Parent-ID angelegt werden! MsgBox("Attention: no parent-link was created!", MsgBoxStyle.Exclamation) 'Show_Verknuepfungen() End If End Select ElseIf EDIT_STATE = EditState.Update Then 'Weil es ein Insert war müssen noch die Daten gespeichert/erneuert werden Select Case ACT_EBENE Case 1 EBENE1_RECID = recid For Each row As DataRow In DT_SELECTION.Rows If row.Item("Record-ID") = SELECTED_RECORD_ID Then If EBENE1_COLUMNNAME = "" Then EBENE1_GRID_RESULT = "No Column configured" Else EBENE1_GRID_RESULT = Get_GridResult(EBENE1_COLUMNNAME) ' EBENE1_GRID_RESULT = row.Item(EBENE1_COLUMNNAME) End If End If Next Case 2 EBENE2_RECID = recid For Each row As DataRow In DT_SELECTION.Rows If row.Item("Record-ID") = SELECTED_RECORD_ID Then If EBENE2_COLUMNNAME = "" Then EBENE2_GRID_RESULT = "No Column configured" Else EBENE2_GRID_RESULT = row.Item(EBENE2_COLUMNNAME) End If End If Next End Select End If 'Jetzt den Record nochmal laden ' Show_Selected_Record_Data(SELECTED_RECORD_ID) Update_Status_Label(True, "Record saved - " & Now, EditState.Update) Update_Record_Label(SELECTED_RECORD_ID) Dim FORM_TYPE = ClassDatabase.Execute_Scalar("SELECT FORM_TYPE_ID FROM TBPMO_FORM WHERE GUID = " & ENTITY_ID) Dim IS_SINGLE_RECORD = ClassDatabase.Execute_Scalar("SELECT SINGLE_RECORD FROM TBPMO_FORM WHERE GUID = " & ENTITY_ID) If IS_SINGLE_RECORD = False Then If FORM_TYPE <> 5 Then If EDIT_STATE = EditState.Insert Then 'Die Daten neu laden Load_Entity_Data_Only() Get_Grid_Row_Handle(NEW_RECORD_ID) Else 'Die Daten neu laden Load_Entity_Data_Only() 'Get_Grid_Row_Handle(RECORD_ID) LocateRecordById(RECORD_ID) 'Die Daten auf dem Panel laden 'ClassControlValues.LoadControlValues(RECORD_ID, ENTITY_ID, CtrlBuilder.AllControls) ' Laden der Daten bedeutet nicht dass Daten vom Benutzer geändert wurden! RECORD_CHANGED = False End If End If End If Catch ex As Exception MsgBox("Error in Save Data:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) Return False End Try If CtrlCommandUI.IsInsert Then tsButtonSave.Enabled = False Else ' DisableEditMode() End If CtrlCommandUI.IsInsert = False EDIT_STATE = EditState.None RECORD_CHANGED = False SAVE_ROUTINE_ACTIVE = False Me.Cursor = Cursors.Default Return True End Function Sub Delete_Record() Dim msg = "Sind Sie sicher, dass Sie diesen Record/Datensatz löschen wollen?" If USER_LANGUAGE <> "de-DE" Then msg = "Are You sure You want to delete the selected record?" End If Dim result As MsgBoxResult result = MessageBox.Show(msg, "Confirmation:", MessageBoxButtons.YesNo, MessageBoxIcon.Question) If result = MsgBoxResult.Yes Then Dim del = "EXEC [dbo].[PRPMO_DELETE_RECORD] " & SELECTED_RECORD_ID If ClassDatabase.Execute_non_Query(del, True) = True Then RECORD_CHANGED = False EDIT_STATE = EditState.None CURRENT_RECORD_ENABLED = False ' Update_Record_Label(SELECTED_RECORD_ID) msg = "Der Datensatz '" & SELECTED_RECORD_ID & "' wurde erfolgreich gelöscht - " & Now If USER_LANGUAGE <> "de-DE" Then msg = "The record and all dependencies for '" & SELECTED_RECORD_ID & "' were deleted - " & Now End If Update_Status_Label(True, msg, EditState.Update) msg = "Wollen Sie die zugehörigen windream-Dateien ebenfalls löschen?" If USER_LANGUAGE <> "de-DE" Then msg = "Do You want to delete the related windream-documents?" End If Dim result1 As MsgBoxResult result1 = MessageBox.Show(msg, "Confirmation:", MessageBoxButtons.YesNo, MessageBoxIcon.Question) If result = MsgBoxResult.Yes Then WD_DELETE_DOCS() End If SELECTED_RECORD_ID = 0 RECORD_ID = 0 CURRENT_RECORD_ID = 0 RECORD_CHANGED = False Load_Tree_View_Data() ' Nach dem löschen muss die aktuelle Ansicht neugeladen werden Load_Entity_Data(ACT_EBENE) DisableEditMode() End If End If End Sub Private Sub tsButtonDelete_Click(sender As Object, e As EventArgs) Handles tsButtonDelete.Click Delete_Record() End Sub Private Sub tsButtonEditMode_Click(sender As Object, e As EventArgs) Handles tsButtonEdit.Click ToggleEditMode() End Sub Sub ToggleEditMode() If RECORD_ENABLED = False Then EnableEditMode() Else DisableEditMode() End If End Sub Sub EnableEditMode() Dim EditingUser = ClassRecordState.IsRecordLocked(SELECTED_RECORD_ID) ' Überprüfen, ob der Record gerade bearbeitet wird If Not IsNothing(EditingUser) Then tslblLocked.Visible = True If USER_LANGUAGE = "de-DE" Then MsgBox(String.Format("Dieser Datensatz wird gerade vom Benutzer '{0}' bearbeitet und kann nur lesend abgerufen werden.", EditingUser), MsgBoxStyle.Exclamation) Else MsgBox(String.Format("This Record is currently being edited by User '{0}' and only available in Read-Only mode.", EditingUser), MsgBoxStyle.Exclamation) End If ' Wenn Record bearbeitet wird, EnableEditMode abbrechen! Exit Sub Else 'Wenn Record bearbeitet werden kann, IN_WORK auf 1 setzen, um Bearbeitung durch andere zu verhindern! ClassRecordState.LockRecord(SELECTED_RECORD_ID) End If Lock_RecordControls(False) tsmi_RecordDelete.Enabled = True Me.tsButtonAdd.Enabled = True Me.tsButtonSave.Enabled = True Dim stg As String If USER_LANGUAGE = "de-DE" Then stg = "Bearbeiten beenden" Else stg = "End Working" End If Me.tsButtonEdit.Text = stg CURRENT_RECORD_ID = RECORD_ID ' Abhängige Listen laden CtrlBuilder.WatchRecordChanges = False ClassControlValues.LoadControlValuesListWithPlaceholders(ENTITY_ID, RECORD_ID, PARENT_ID, CtrlBuilder.AllControls, ENTITY_ID) ClassControlValues.Enable_Depending_Controls(ENTITY_ID, RECORD_ID, PARENT_ID, CtrlBuilder.AllControls, ENTITY_ID) CtrlBuilder.WatchRecordChanges = True RECORD_ENABLED = True CURRENT_RECORD_ENABLED = True pnlDetails.Focus() 'If RECORD_ENABLED = False Then ' ClassControlValues.LoadControlValuesList(SELECTED_RECORD_ID, ENTITY_ID, CtrlBuilder.AllControls) 'End If End Sub Sub DisableEditMode() ClassRecordState.UnlockRecord(SELECTED_RECORD_ID) Lock_RecordControls(True) RECORD_ENABLED = False CURRENT_RECORD_ENABLED = False ' Me.pnlDetails.Enabled = False Me.tsButtonDelete.Enabled = False 'Me.tsButtonAdd.Enabled = False Me.tsButtonSave.Enabled = False Dim stg As String If USER_LANGUAGE = "de-DE" Then stg = "Bearbeiten" Else stg = "Work record" End If Me.tsButtonEdit.Text = stg Me.tsButtonEdit.Text = stg 'Funktion nur zum load der Inhalte If RECORD_ENABLED = True Then ClassControlValues.UnloadControlValuesList(SELECTED_RECORD_ID, RECORD_ID, CtrlBuilder.AllControls) End If End Sub #End Region #Region "Appointments" Sub NewEditAppointment(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Try Dim ctrl As Control = sender ClassFunctionCommandsUI.NewEditAppointment(ctrl.Name, ENTITY_ID, RECORD_ID, pnlDetails.Controls) Catch ex As Exception MsgBox("Error in OpenEditAppointment:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub Sub EditAppointment(ByVal sender As Control, FormID As Integer) Try ' Load All appointments first frmCalendar.TBPMO_RESOURCESTableAdapter.Fill(frmCalendar.DD_DMSDataSetCalendar.TBPMO_RESOURCES) frmCalendar.TBPMO_APPOINTMENTSTableAdapter.Fill(frmCalendar.DD_DMSDataSetCalendar.TBPMO_APPOINTMENTS) Dim apt As Appointment = frmCalendar.SchedulerStorage1.Appointments.Items.Find(AddressOf FindAppointment) If apt IsNot Nothing Then frmCalendar.SchedulerControl1.ShowEditAppointmentForm(apt) End If Catch ex As Exception MsgBox("Error in EditAppointment:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub Private Function FindAppointment(ByVal apt As Appointment) As Boolean Return Convert.ToInt32(apt.CustomFields("RecordID")) = SELECTED_RECORD_ID End Function #End Region Sub GetSet_Rights() Try Dim sel = String.Format("SELECT DISTINCT EDIT_REC,ADD_REC,DELETE_REC,ADD_DOC,VIEW_DOC,DELETE_DOC FROM TBPMO_RIGHT_GROUP WHERE ENTITY_ID = {0} AND GROUP_ID IN (SELECT GROUP_ID FROM TBDD_GROUPS_USER WHERE USER_ID = {1})", ENTITY_ID, USER_GUID) If LogErrorsOnly = False Then ClassLogger.Add(" >> Select Rightsmanagement " & sel, False) Dim DT As DataTable = ClassDatabase.Return_Datatable(sel, "GetSet_Rights") If DT.Rows.Count > 0 Then For Each row As DataRow In DT.Rows 'RIGHT_EDIT_R = True 'RIGHT_ADD_R = True 'RIGHT_DELETE_R = False 'RIGHT_ADD_DOC = True 'RIGHT_VIEW_DOC = True 'RIGHT_DELETE_DOC = False If RIGHT_EDIT_R = True And CBool(DT.Rows(0).Item(0)) = False Then RIGHT_EDIT_R = False ElseIf RIGHT_EDIT_R = False And CBool(DT.Rows(0).Item(0)) = True Then RIGHT_EDIT_R = True End If If RIGHT_ADD_R = True And CBool(DT.Rows(0).Item(1)) = False Then RIGHT_ADD_R = False ElseIf RIGHT_EDIT_R = False And CBool(DT.Rows(0).Item(1)) = True Then RIGHT_EDIT_R = True End If If RIGHT_DELETE_R = False And CBool(DT.Rows(0).Item(2)) = True Then RIGHT_DELETE_R = True ElseIf RIGHT_DELETE_R = False And CBool(DT.Rows(0).Item(2)) = False Then RIGHT_DELETE_R = False End If If RIGHT_ADD_DOC = True And CBool(DT.Rows(0).Item(3)) = False Then RIGHT_ADD_DOC = False ElseIf RIGHT_ADD_DOC = False And CBool(DT.Rows(0).Item(3)) = True Then RIGHT_ADD_DOC = True End If If RIGHT_VIEW_DOC = True And CBool(DT.Rows(0).Item(4)) = False Then RIGHT_VIEW_DOC = False ElseIf RIGHT_VIEW_DOC = True And CBool(DT.Rows(0).Item(4)) = False Then RIGHT_VIEW_DOC = True End If If RIGHT_DELETE_DOC = False And CBool(DT.Rows(0).Item(5)) = True Then RIGHT_DELETE_DOC = False ElseIf RIGHT_DELETE_DOC = True And CBool(DT.Rows(0).Item(5)) = False Then RIGHT_DELETE_DOC = True End If Next End If tsButtonSave.Visible = True tsButtonAdd.Visible = True tsButtonEdit.Visible = True tsButtonDelete.Visible = True tsmi_RecordDelete.Enabled = True If RIGHT_ADD_R = False Then tsButtonAdd.Visible = False End If If RIGHT_EDIT_R = False Then tsButtonEdit.Visible = False If RIGHT_ADD_R = False Then tsButtonSave.Visible = False End If End If If RIGHT_DELETE_R = False Then tsButtonDelete.Visible = False tsmi_RecordDelete.Enabled = False End If Catch ex As Exception MsgBox("Error in GetSet_Rights:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub Sub Load_Entity_Data(ClickedLevel As Integer) Try Dim sw As New Stopwatch sw.Start() Dim elapsed As Double Me.Cursor = Cursors.WaitCursor RECORD_CHANGED = False RECORD_ID = 0 VerknüpfungenAnzeigenToolStripMenuItem.Enabled = True 'Setzen von Rechten 'GetSet_Rights() 'VerknüpfungenToolStripMenuItem.Enabled = False FORM_TYPE = ClassDatabase.Execute_Scalar("SELECT FORM_TYPE_ID FROM TBPMO_FORM WHERE GUID = " & ENTITY_ID) IS_SINGLE_RECORD = ClassDatabase.Execute_Scalar("SELECT SINGLE_RECORD FROM TBPMO_FORM WHERE GUID = " & ENTITY_ID) LOAD_DIRECT = ClassDatabase.Execute_Scalar("SELECT LOAD_DIRECT FROM VWPMO_CONSTRUCTOR_FORMS WHERE CONSTRUCT_ID = " & CONSTRUCTORID & " AND FORM_ID = " & ENTITY_ID & " AND SCREEN_ID = " & CURRENT_SCREEN_ID) CURRENT_CONSTRUCTOR_DETAIL_ID = ClassDatabase.Execute_Scalar("SELECT GUID FROM VWPMO_CONSTRUCTOR_FORMS WHERE CONSTRUCT_ID = " & CONSTRUCTORID & " AND FORM_ID = " & ENTITY_ID & " AND SCREEN_ID = " & CURRENT_SCREEN_ID) POS_ENTITY = ClassDatabase.Execute_Scalar("SELECT POS_ENTITY FROM TBPMO_FORM WHERE GUID = " & ENTITY_ID) CONTROL_DOCTYPE_MATCH = ClassDatabase.Execute_Scalar("SELECT CONTROL_DOCTYPE_MATCH FROM VWPMO_CONSTRUCTOR_FORMS WHERE CONSTRUCT_ID = " & CONSTRUCTORID & " AND FORM_ID = " & ENTITY_ID & " AND SCREEN_ID = " & CURRENT_SCREEN_ID) SQL_RIGHT_READ_AND_VIEW_ONLY = ClassDatabase.Execute_Scalar("SELECT SQL_RIGHT_READ_AND_VIEW_ONLY FROM VWPMO_CONSTRUCTOR_FORMS WHERE CONSTRUCT_ID = " & CONSTRUCTORID & " AND FORM_ID = " & ENTITY_ID & " AND SCREEN_ID = " & CURRENT_SCREEN_ID) If VIEW_ID_RUNTIME <> -1 Then GRID_TYPE_ID = VIEW_ID_RUNTIME Else Dim VIEW_ID = ClassDatabase.Execute_Scalar(String.Format("SELECT VIEW_ID FROM TBPMO_USER_CONSTR_VIEW_TYPE WHERE CONSTRUCTOR_DETAIL_ID = {0} AND [ENTITY_ID] = {1} AND USER_ID = {2}", CURRENT_CONSTRUCTOR_DETAIL_ID, ENTITY_ID, USER_GUID), True) If IsNothing(VIEW_ID) Then ClassDatabase.Execute_non_Query("INSERT INTO TBPMO_USER_CONSTR_VIEW_TYPE ([USER_ID],CONSTRUCTOR_DETAIL_ID,[ENTITY_ID]) VALUES (" & USER_GUID & "," & CURRENT_CONSTRUCTOR_DETAIL_ID & "," & ENTITY_ID & ")", True) VIEW_ID = 1 End If GRID_TYPE_ID = VIEW_ID End If ' Den GridType setzen: 1=TileView,2=Carousel,3=GridView Select Case GRID_TYPE_ID Case 1 GRID_TYPE = GridType.Tiles GridControlMain.MainView = grvwTiles Case 2 GRID_TYPE = GridType.Carousel GridControlMain.MainView = grvwCarousel Case 3 GRID_TYPE = GridType.Grid GridControlMain.MainView = grvwGrid End Select SELECTED_RECORD_ID = 0 Dim DT As DataTable Dim sql As String = "SELECT PARENT_ID FROM VWPMO_CONSTRUCTOR_FORMS WHERE CONSTRUCT_ID = " & CONSTRUCTORID & " AND FORM_ID = " & ENTITY_ID & " AND SCREEN_ID = " & CURRENT_SCREEN_ID Dim PARENT_ID = ClassDatabase.Execute_Scalar(sql) If PARENT_ID Is Nothing Then MsgBox("Error in GetParentID for selectedNode - Check Logfile", MsgBoxStyle.Exclamation) Exit Sub End If 'Abhängig von der Entität die Selektierungs-Daten laden Get_Grid_Sql(CONSTRUCTORID, ENTITY_ID, CURRENT_CONSTRUCTOR_DETAIL_ID) elapsed = sw.Elapsed.TotalSeconds If LogErrorsOnly = False Then ClassLogger.Add(" >> Get_Grid_Sql took " & Format(elapsed, "0.000000000") & " seconds", False) 'Anzahl der Datensätze ENTITY_RECORD_COUNT = ClassDatabase.Execute_Scalar("SELECT COUNT(*) FROM TBPMO_RECORD where FORM_ID = " & ENTITY_ID, True) Select Case ClickedLevel Case 1 EBENE1_ENTITY = "" EBENE1_RECID = 0 EBENE2_ENTITY = "" EBENE2_RECID = 0 EBENE3_ENTITY = "" EBENE3_RECID = 0 PARENT_RECORDID = 0 PARENT_ID = 0 EBENE1_ENTITY = TreeViewMain.SelectedNode.Text ACT_EBENE_STRING = EBENE1_ENTITY If LogErrorsOnly = False Then ClassLogger.Add(" >> Level 1 selected in TreeView", False) 'tslblEntity2.Visible = False 'tslblEntity3.Visible = False EBENE1_COLUMNNAME = ClassDatabase.Execute_Scalar("SELECT COLUMN_NAME1 FROM VWPMO_CONSTRUCTOR_FORMS WHERE CONSTRUCT_ID = " & CONSTRUCTORID & " AND FORM_ID = " & ENTITY_ID & " AND SCREEN_ID = " & CURRENT_SCREEN_ID) EBENE2_COLUMNNAME = "" EBENE3_COLUMNNAME = "" EBENE2_GRID_RESULT = Nothing EBENE3_GRID_RESULT = Nothing '_sql = ClassDatabase.Execute_Scalar("SELECT SQL_QUICK_VIEW FROM VWPMO_CONSTRUCTOR_FORMS WHERE CONSTRUCT_ID = " & CONSTRUCTORID & " AND FORM_ID = " & ENTITY_ID) Case 2 'Dim Level1Select = ClassDatabase.Execute_Scalar(Get_Grid_Sql(CONSTRUCTORID, ENTITY_ID)) 'ClassDatabase.Execute_Scalar("SELECT LEVEL1_SELECT FROM VWPMO_CONSTRUCTOR_FORMS WHERE CONSTRUCT_ID = " & CONSTRUCTORID & " AND ENTITY_ID = " & ENTITY_ID) 'If CBool(Level1Select) = False And FORM_TYPE <> 5 And EBENE1_RECID = 0 Then ' MsgBox("Entität '" & TreeViewLevelSelect.SelectedNode.Text & "' kann nicht ohne Auswahl eines Ebene 1 Datensatzes gewählt werden!", MsgBoxStyle.Exclamation) ' TreeViewLevelSelect.SelectedNode = TreeViewLevelSelect.SelectedNode.Parent ' Exit Sub 'End If EBENE2_ENTITY = TreeViewMain.SelectedNode.Text ACT_EBENE_STRING = EBENE2_ENTITY If LogErrorsOnly = False Then ClassLogger.Add(" >> Level 2 selected in TreeView", False) EBENE3_ENTITY = "" 'Wenn bereits ein Record für Ebene 1 gewählt wurde dann einschränken If EBENE1_RECID > 0 Then PARENT_RECORDID = EBENE1_RECID PARENT_ID = EBENE1_RECID If GRID_TYPE = GridType.Grid Then _ENTITYSQL = "SELECT T.* FROM VWTEMP_PMO_FORM" & ENTITY_ID.ToString & " T, TBPMO_RECORD_CONNECT t1 where T.[Record-ID] = T1.RECORD2_ID AND T1.RECORD1_ID = " & PARENT_ID Else _ENTITYSQL = _ENTITYSQL.Replace("@RecordID", EBENE2_RECID) _ENTITYSQL = _ENTITYSQL.ToString.Replace("TBPMO_FORM T1", "TBPMO_FORM T1 ,TBPMO_RECORD_CONNECT T2") _ENTITYSQL = _ENTITYSQL & " AND T.GUID = T2.RECORD2_ID AND T2.RECORD1_ID = @T2.RECORD1_ID" _ENTITYSQL = _ENTITYSQL.ToString.Replace("@T2.RECORD1_ID", PARENT_RECORDID) End If Else Console.WriteLine("Ebene 1 wurde nicht ausgewählt") SELECTED_RECORD_ID = 0 PARENT_ID = 0 PARENT_RECORDID = 0 NavPane.Categories.Clear() tsslblRecord.Text = "" Update_Status_Label(True, "Entity 1 Jumped over - All Records loaded", EditState.Update) End If 'tslblEntity3.Visible = False 'Select Case FORM_TYPE ' Case 5 ' If GET_GROUP_OR_SINGLE_RECORD(PARENT_RECORDID) = True Then ' EBENE2_RECID = RECORD_ID ' End If 'End Select EBENE2_COLUMNNAME = ClassDatabase.Execute_Scalar("SELECT COLUMN_NAME1 FROM VWPMO_CONSTRUCTOR_FORMS WHERE CONSTRUCT_ID = " & CONSTRUCTORID & " AND FORM_ID = " & ENTITY_ID & " AND SCREEN_ID = " & CURRENT_SCREEN_ID) EBENE3_COLUMNNAME = "" EBENE2_GRID_RESULT = Nothing EBENE3_GRID_RESULT = Nothing Case 3 EBENE3_ENTITY = TreeViewMain.SelectedNode.Text ACT_EBENE_STRING = EBENE3_ENTITY If LogErrorsOnly = False Then ClassLogger.Add(" >> Level 3 selected in TreeView", False) EBENE3_COLUMNNAME = ClassDatabase.Execute_Scalar("SELECT COLUMN_NAME1 FROM VWPMO_CONSTRUCTOR_FORMS WHERE CONSTRUCT_ID = " & CONSTRUCTORID & " AND FORM_ID = " & ENTITY_ID & " AND SCREEN_ID = " & CURRENT_SCREEN_ID) 'Wenn bereits ein Record für Ebene 1 gewählt wurde dann eisnchränken If EBENE2_RECID > 0 Then 'Parent-ID setzen PARENT_RECORDID = EBENE2_RECID PARENT_ID = EBENE2_RECID Try If GRID_TYPE = GridType.Grid Then _ENTITYSQL = "SELECT T.* FROM VWTEMP_PMO_FORM" & ENTITY_ID.ToString & " T, TBPMO_RECORD_CONNECT t1 where T.[Record-ID] = T1.RECORD2_ID AND T1.RECORD1_ID = " & PARENT_ID Else _ENTITYSQL = _ENTITYSQL.Replace("@RecordID", EBENE2_RECID) _ENTITYSQL = _ENTITYSQL.ToString.Replace("TBPMO_FORM T1", "TBPMO_FORM T1 ,TBPMO_RECORD_CONNECT T2") _ENTITYSQL = _ENTITYSQL & " AND T.GUID = T2.RECORD2_ID AND T2.RECORD1_ID = @T2.RECORD1_ID" _ENTITYSQL = _ENTITYSQL.ToString.Replace("@T2.RECORD1_ID", PARENT_RECORDID) End If Catch ex As Exception End Try Else Console.WriteLine("Ebene 2 wurde nicht ausgewählt") SELECTED_RECORD_ID = 0 PARENT_ID = 0 PARENT_RECORDID = 0 NavPane.Categories.Clear() Update_Status_Label(True, "Entity 2 Jumped over - All Records loaded", EditState.Update) tsslblRecord.Text = "" End If 'Select Case FORM_TYPE ' Case 5 ' If GET_GROUP_OR_SINGLE_RECORD(PARENT_RECORDID) = True Then ' EBENE3_RECID = RECORD_ID ' End If 'End Select EBENE3_GRID_RESULT = Nothing End Select elapsed = sw.Elapsed.TotalSeconds - elapsed If LogErrorsOnly = False Then ClassLogger.Add(" >> Select Case entities took " & Format(elapsed, "0.000000000") & " seconds", False) _ENTITYSTRING = ACT_EBENE_STRING PARENT_ID = PARENT_RECORDID act_FormViewID = ClassDatabase.Execute_Scalar("SELECT GUID FROM TBPMO_FORM_VIEW where FORM_ID = " & ENTITY_ID) If EDIT_STATE = EditState.None Then 'Die Controls der Entität laden Load_Controls(act_FormViewID) tsButtonAdd.Enabled = True 'set_pnlsize() End If 'Überprüfen ob windream Dos angezeigt werden sollen? Check_windream_Show(act_FormViewID) If windream_Docshow = True Then If TCDetails.SelectedTabPageIndex = 1 Then Me.GridControlDocSearch.DataSource = Nothing If WD_ShowEnitityDocs = True Then Clear_Windream_ResultList() GridControlDocSearch.Visible = True RUN_WD_SEARCH("", "ENTITY") End If End If End If If FORM_TYPE = 5 Or IS_SINGLE_RECORD = True Then If GET_GROUP_OR_SINGLE_RECORD(PARENT_RECORDID, True) = True Then ' Laden der Daten bedeutet nicht dass Daten vom Benutzer geändert wurden! If IS_SINGLE_RECORD Then Show_Selected_Record_Data(RECORD_ID, True) Else Refresh_Navpane() Update_Record_Label(SELECTED_RECORD_ID) End If Get_RecordCounts_Nodes() End If ' Hide_Grid_Columns() If FORM_TYPE = 5 Then TabDetails.PageVisible = False Else TabDetails.PageVisible = True End If Else TabDetails.PageVisible = True GridControlMain.Visible = True Dim DTEntity As DataTable = ClassDatabase.Return_Datatable(_ENTITYSQL, "LoadEntityData - Get DTEntity") If IsNothing(DTEntity) Then MsgBox("Unexpected Error in getting Entity-Data - Check Logfile", MsgBoxStyle.Critical) Else Dim primaryKey(1) As DataColumn primaryKey(0) = DTEntity.Columns("Record-ID") DTEntity.PrimaryKey = primaryKey DT_SELECTION = DTEntity LoadGrid_Selection() If GRID_TYPE = GridType.Grid Then grvwGrid.FocusRectStyle = DevExpress.XtraGrid.Views.Grid.DrawFocusRectStyle.None grvwGrid.OptionsBehavior.Editable = False grvwGrid.OptionsSelection.EnableAppearanceFocusedCell = False grvwGrid.OptionsSelection.EnableAppearanceFocusedRow = False grvwGrid.OptionsSelection.EnableAppearanceHideSelection = False ElseIf GRID_TYPE = GridType.Carousel Then grvwCarousel.OptionsBehavior.Editable = False ElseIf GRID_TYPE = GridType.Tiles Then grvwTiles.FocusedRowHandle = -1 grvwTiles.OptionsBehavior.Editable = False grvwTiles.FocusedRowHandle = -1 grvwTiles.OptionsTiles.HighlightFocusedTileOnGridLoad = False End If If LOAD_DIRECT = True Then Load_Record_Direct() End If If ENTITY_RECORD_COUNT = 1 Then Load_Record_Direct() End If ' Dim sql1 = _ENTITYSQL ' sql1.Replace("T.*", "TOP 1 [Record-ID]") ' Dim id = ClassDatabase.Execute_Scalar(sql1, True) ' If Not id Is Nothing Then ' If LogErrorsOnly = False Then ClassLogger.Add(" >> Load Record directly - RecordID: " & RECORD_ID, False) ' Load_Record_Data() ' End If 'End If 'Überprüfen ob es für diese Entität Wiedervorlagen gibt? Check_FOLLOWUP_IsConfigured(ENTITY_ID) Load_Grid_Layout() Load_Splitter_Layout() End If If POS_ENTITY > 0 Then If USER_LANGUAGE <> "de-DE" Then TabDetails.Text = "Head-Data" Else TabDetails.Text = "Kopfdaten" End If TabPos.PageVisible = True Else If USER_LANGUAGE <> "de-DE" Then TabDetails.Text = "Details" Else TabDetails.Text = "Detailansicht" End If TabPos.PageVisible = False End If Load_Templates() 'For Each column As DevExpress.XtraGrid.Columns.GridColumn In grvwGrid.Columns ' column.MinWidth = 100 'Next ' Wenn rows existieren, erste row laden und recordid auslesen 'Dim firstRow As System.Data.DataRowView = GridControlMain.MainView.GetRow(0) 'If Not IsNothing(firstRow) Then ' Dim firstRecordId As Integer = firstRow.Row.Item("Record-ID") ' ClassControlValues.LoadControlValuesList(firstRecordId, PARENT_ID, ENTITY_ID, CtrlBuilder.MasterPanel.Controls) 'End If ' Hinfällig, da hier die Record-ID nicht gebraucht wird CtrlBuilder.WatchRecordChanges = False ClassControlValues.LoadControlValuesList(ENTITY_ID, CtrlBuilder.MasterPanel.Controls) CtrlBuilder.WatchRecordChanges = True 'Zurücksetzen ENTITY_LOADED = True End If elapsed = sw.Elapsed.TotalSeconds sw.Stop() sw.Reset() If LogErrorsOnly = False Then ClassLogger.Add(" >> Load_Entity_Data took " & Format(elapsed, "0.000000000") & " seconds", False) If ENTITY_RELOAD_AFT_CONTROL_LOAD = True Then Reload_Entity_while_Control_Load() End If Catch ex As Exception MsgBox("Error in Load_Entity_Data:" & vbNewLine & ex.Message, MsgBoxStyle.Exclamation) Finally Me.Cursor = Cursors.Default ENTITY_LOADED = True End Try End Sub Sub Load_Record_Direct() Try Dim Grid_RecordID = Get_Focused_Row_Cell_Value("Record-ID") If Not IsNothing(Grid_RecordID) Then Select Case ACT_EBENE Case 1 PARENT_RECORDID = Grid_RecordID PARENT_ID = PARENT_RECORDID SELECTED_RECORD_ID = Grid_RecordID RECORD_ID = Grid_RecordID ENTITY_RELOAD_AFT_CONTROL_LOAD = False 'Daten zu Record in jedem Fall laden 'ClassControlValues.LoadControlValues(SELECTED_RECORD_ID, ENTITY_ID, CtrlBuilder.AllControls) CtrlBuilder.WatchRecordChanges = False ClassControlValues.LoadControlValues(SELECTED_RECORD_ID, PARENT_ID, ENTITY_ID, CtrlBuilder.AllControls, ENTITY_ID) CtrlBuilder.WatchRecordChanges = True ' Laden der Daten bedeutet nicht dass Daten vom Benutzer geändert wurden! RECORD_CHANGED = False Update_Record_Label(Grid_RecordID) End Select End If Catch ex As Exception MsgBox("Error in Load_Record_Direct:" & vbNewLine & ex.Message, MsgBoxStyle.Exclamation) End Try End Sub Sub Load_Entity_Data_Only() Try ENTITY_LOADED = False Dim DTEntity As DataTable = ClassDatabase.Return_Datatable(_ENTITYSQL, "Load_Entity_Data_Only") Dim primaryKey(1) As DataColumn primaryKey(0) = DTEntity.Columns("Record-ID") DTEntity.PrimaryKey = primaryKey DT_SELECTION = DTEntity LoadGrid_Selection() Load_Grid_Layout() Catch ex As Exception MsgBox("Error in Load_Entity_Data_Only:" & vbNewLine & ex.Message, MsgBoxStyle.Exclamation) End Try ENTITY_LOADED = True End Sub Sub CreateTile() Try Dim ImageIndex As Integer = -1 Dim i As Integer = 0 Dim j As Integer = 0 Dim DT As DataTable = DirectCast(DT_SELECTION, DataTable) If DT Is Nothing Then MsgBox("Daten können nicht geladen werden - Datatable SELECTION is empty", MsgBoxStyle.Critical) Exit Sub End If Dim PrimaryFont As New Font("Segoe UI", 12, FontStyle.Bold) Dim SecondaryFont As New Font("Segoe UI", 10) Dim WhiteBackground As Color = System.Drawing.Color.FromArgb(230, Color.White) ' Datatable laden GridControlMain.DataSource = DT grvwTiles.TileTemplate.Clear() For Each Column As DataColumn In DT.Columns Dim index As Integer = DT.Columns.IndexOf(Column) Dim RECORDID_Column As TileViewItemElement Dim ImageColumn As TileViewItemElement Dim HeadlineColumn As TileViewItemElement Dim TextColumn As TileViewItemElement Dim TextHeaderColumn As TileViewItemElement Select Case index 'Case 0 ' ' RecordId ' RECORDID_Column = New TileViewItemElement() ' With RECORDID_Column ' .Column = grvwTiles.Columns(0) ' .Column.OptionsFilter.AllowFilter = True ' .TextAlignment = TileItemContentAlignment.TopLeft ' End With ' grvwTiles.TileTemplate.Add(RECORDID_Column) Case 1 ' Index 1 ist das Bild If Column.DataType.ToString.Contains("Byte") Then ImageColumn = New TileViewItemElement() With ImageColumn .Image = My.Resources.keinbild .Column = grvwTiles.Columns(1) '.ImageSize = New Size(186, 90) .ImageSize = New Size(186, 118) .ImageScaleMode = TileItemImageScaleMode.ZoomInside .ImageAlignment = TileItemContentAlignment.Manual .ImageLocation = New Point(-10, -10) End With grvwTiles.TileTemplate.Add(ImageColumn) End If Case 2 ' Index 2 ist die Headline HeadlineColumn = New TileViewItemElement() With HeadlineColumn .Column = grvwTiles.Columns(2) .TextAlignment = TileItemContentAlignment.TopRight .Appearance.Normal.Font = PrimaryFont .Appearance.Normal.ForeColor = Color.DodgerBlue .Column.OptionsFilter.AllowFilter = True End With grvwTiles.TileTemplate.Add(HeadlineColumn) Case 3 To 4 ' Indexe 3 und 4 sind normale Textzeilen TextColumn = New TileViewItemElement() TextHeaderColumn = New TileViewItemElement() Dim OffsetIndex = index - 3 With TextHeaderColumn .Text = Column.ColumnName .TextAlignment = TileItemContentAlignment.Manual .TextLocation = New Point(120, 20 + (OffsetIndex * 40)) .Appearance.Normal.Font = SecondaryFont .Appearance.Normal.ForeColor = Color.DarkGray .Appearance.Normal.BackColor = WhiteBackground End With With TextColumn .Column = grvwTiles.Columns(index) .TextAlignment = TileItemContentAlignment.Manual .TextLocation = New Point(120, 20 + 18 + (OffsetIndex * 40)) .Appearance.Normal.Font = SecondaryFont .Appearance.Normal.ForeColor = Color.Black .Appearance.Normal.BackColor = WhiteBackground End With grvwTiles.TileTemplate.Add(TextHeaderColumn) grvwTiles.TileTemplate.Add(TextColumn) End Select Next Catch ex As Exception MsgBox("Error in LoadGrid_Selection:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub Sub Lock_RecordControls(state As Boolean) Lock_Record_Controls_Recursive(state, pnlDetails.Controls) End Sub Sub Lock_Record_Controls_Recursive(state As Boolean, controls As System.Windows.Forms.Control.ControlCollection) For Each Control As System.Windows.Forms.Control In controls Select Case Control.GetType() Case GetType(Windows.Forms.GroupBox) Lock_Record_Controls_Recursive(state, DirectCast(Control, GroupBox).Controls) Case GetType(Windows.Forms.TextBox) Dim txt As TextBox = CType(Control, TextBox) txt.ReadOnly = state Case Else Control.Enabled = Not state 'Case GetType(Windows.Forms.CheckBox) ' Dim chk As CheckBox = CType(Control, CheckBox) ' If state = True Then ' chk.Enabled = False ' Else ' chk.Enabled = True ' End If 'Case GetType(Windows.Forms.RadioButton) ' Dim rb As RadioButton = CType(Control, RadioButton) ' If state = True Then ' rb.Enabled = False ' Else ' rb.Enabled = True ' End If 'Case GetType(CustomComboBox) ' Dim cbobx As CustomComboBox = CType(Control, CustomComboBox) ' If state = True Then ' cbobx.Enabled = False ' Else ' cbobx.Enabled = True ' End If 'Case GetType(DevExpress.XtraEditors.DateEdit) ' Dim dtp As DevExpress.XtraEditors.DateEdit = CType(Control, DevExpress.XtraEditors.DateEdit) ' If state = True Then ' dtp.Enabled = False ' Else ' dtp.Enabled = True ' End If 'Case GetType(DevExpress.XtraEditors.CheckedListBoxControl) ' Dim chlb As DevExpress.XtraEditors.CheckedListBoxControl = CType(Control, DevExpress.XtraEditors.CheckedListBoxControl) ' If state = True Then ' chlb.Enabled = False ' Else ' chlb.Enabled = True ' End If 'Case GetType(DevExpress.XtraEditors.ListBoxControl) ' Dim lb As DevExpress.XtraEditors.ListBoxControl = CType(Control, DevExpress.XtraEditors.ListBoxControl) ' If state = True Then ' lb.Enabled = False ' Else ' lb.Enabled = True ' End If 'Case GetType(Windows.Forms.Button) ' Dim btn As Button = CType(Control, Button) ' If state = True Then ' btn.Enabled = False ' Else ' btn.Enabled = True ' End If End Select Next End Sub Private Sub Check_Record_Changed() If EDIT_STATE <> EditState.None Then Update_Status_Label(False, "") EDIT_STATE = EditState.None End If If RECORD_CHANGED = True Then Dim msg = "Sie haben ungespeicherte Änderungen. Wollen Sie diese speichern?" Dim msg1 = "Ungespeicherte Änderungen" If USER_LANGUAGE <> "de-DE" Then msg = "There are unsaved changes. Would You like to save?" msg1 = "Unsaved changes" End If Dim result As DialogResult = MessageBox.Show(msg, msg1, MessageBoxButtons.YesNo, MessageBoxIcon.Question) If result = Windows.Forms.DialogResult.Yes Then If CtrlCommandUI.IsInsert = True Then EDIT_STATE = EditState.None Lock_RecordControls(True) 'Me.pnlDetails.Enabled = False 'CtrlCommandUI.IsInsert = False End If Try Update_Record_OnChange() Catch ex As Exception MsgBox("Error in Save Record Changes: " & vbNewLine & ex.Message, MsgBoxStyle.Exclamation) End Try End If CtrlCommandUI.IsInsert = False RECORD_CHANGED = False End If End Sub Private Function GET_GROUP_OR_SINGLE_RECORD(PARENT_RECORD_ID As Integer, Entityload As Boolean) 'Dim sqlRecord As String = String.Format("SELECT T.RECORD2_ID FROM TBPMO_RECORD_CONNECT T, TBPMO_RECORD T1 WHERE T.RECORD2_ID = T1.GUID AND T.RECORD1_ID = {0} AND T1.ENTITY_ID = (SELECT PARENT_ID FROM TBPMO_FORM WHERE GUID = {1})", LINKED_RECORD, ENTITY_ID) Dim sql As String = String.Format("SELECT T.RECORD2_ID FROM TBPMO_RECORD_CONNECT T, TBPMO_RECORD T1 WHERE T.RECORD2_ID = T1.GUID AND T.RECORD1_ID = {0} and T1.FORM_ID = {1}", PARENT_RECORD_ID, ENTITY_ID) Dim GRP_SINGLE_REC = ClassDatabase.Execute_Scalar(sql, True) If IsNothing(GRP_SINGLE_REC) Then If ClassControlCommandsUI.CreateRecord(ENTITY_ID) = True Then GRP_SINGLE_REC = ClassControlCommandsUI.GetLastRecord If Not IsNothing(GRP_SINGLE_REC) Then 'Die neue Record-ID setzen RECORD_ID = GRP_SINGLE_REC SELECTED_RECORD_ID = RECORD_ID If ClassControlCommandsUI.ConnectRecord(PARENT_RECORD_ID, RECORD_ID, "PARENT_LINK (Group/Single-Record) for Entity " & ENTITY_ID.ToString) = False Then MsgBox("Unexpected Error in Connecting Record. Check log", MsgBoxStyle.Critical) Return False End If Else Return False End If Else Return False End If Else Try RECORD_ID = CInt(GRP_SINGLE_REC) SELECTED_RECORD_ID = RECORD_ID Catch ex As Exception MsgBox("Error while getting CURRENT_RECORDID FOR PARENT_ID: " & vbNewLine & ex.Message, MsgBoxStyle.Critical) Return False End Try End If Select Case ACT_EBENE '#### Hier muss nun der Parent-Record gesetzt werden #### Case 1 EBENE1_RECID = RECORD_ID Case 2 EBENE2_RECID = RECORD_ID Case 3 EBENE3_RECID = RECORD_ID End Select Return True End Function Private Function GET_LINKED_RECORD(RECORDID As Integer, ENTITY_ID As Integer) Try 'Je nach der Ebene muss evtl die übergeordnete Entität ausgelesen werden Select Case ACT_EBENE Case 2 Dim sql As String = String.Format("SELECT T.RECORD2_ID FROM TBPMO_RECORD_CONNECT T, TBPMO_RECORD T1 WHERE T.RECORD2_ID = T1.GUID AND T.RECORD1_ID = {0} and T1.FORM_ID = {1}", RECORDID, ENTITY_ID) Dim PARENT_RECORD1 = ClassDatabase.Execute_Scalar(sql, True) If IsNothing(PARENT_RECORD1) Then Dim New_Record = ClassControlCommandsUI.GetLastRecord If Not IsNothing(New_Record) Then If LogErrorsOnly = False Then ClassLogger.Add(" >> Parent-Record Ebene 1 wird neu angelegt...", False) 'Die neue Record-ID setzen ClassControlCommandsUI.ConnectRecord(New_Record, RECORDID, "PARENT-LINK FOR ENTITY " & ENTITY_ID & "") Return New_Record Else Return 0 End If Else Return PARENT_RECORD1 End If Case 3 Dim sqlp = "SELECT PARENT_ID FROM TBPMO_FORM WHERE GUID = " & ENTITY_ID Dim Parent_EntityID = ClassDatabase.Execute_Scalar(sqlp, True) Dim sql As String = String.Format("SELECT T.RECORD2_ID FROM TBPMO_RECORD_CONNECT T, TBPMO_RECORD T1 WHERE T.RECORD2_ID = T1.GUID AND T.RECORD1_ID = (SELECT T.RECORD2_ID FROM TBPMO_RECORD_CONNECT T, TBPMO_RECORD T1 WHERE " & _ "T.RECORD2_ID = T1.GUID AND T.RECORD1_ID = {0} and T1.FORM_ID = {1}) and T1.FORM_ID = {2}", RECORDID, Parent_EntityID, ENTITY_ID) Dim PARENT_RECORD2 = ClassDatabase.Execute_Scalar(sql, True) If IsNothing(PARENT_RECORD2) Then Dim New_Record = ClassControlCommandsUI.GetLastRecord If Not IsNothing(New_Record) Then If LogErrorsOnly = False Then ClassLogger.Add(" >> Parent-Record Ebene 1 wird neu angelegt...", False) 'Die neue Record-ID setzen ClassControlCommandsUI.ConnectRecord(New_Record, RECORDID, "PARENT-LINK FOR ENTITY " & ENTITY_ID & "") Return New_Record Else Return 0 End If Else Return PARENT_RECORD2 End If End Select Catch ex As Exception MsgBox("Error in GET_LINKED_RECORD: " & vbNewLine & ex.Message, MsgBoxStyle.Critical) Return 0 End Try End Function Private Function LoadGrid_Selection() Try If GRID_TYPE = GridType.Tiles Then CreateTile() Else ' Alle Checkboxen für aktuelle Ansicht heraussuchen Dim sqlcheck As String = "SELECT CONTROL_COLUMN FROM VWPMO_VALUES WHERE CONTROL_TYPE_ID in (10,11) AND FORM_ID = " & ENTITY_ID Dim dtcheck As DataTable = ClassDatabase.Return_Datatable(sqlcheck) Dim listcheck As New List(Of String) 'Liste von allen Spaltentiteln mit Checkbox erstellen If dtcheck.Rows.Count > 0 Then For Each row As DataRow In dtcheck.Rows listcheck.Add(row.Item(0)) Next End If 'Duplikate entfernen ' listcheck = listcheck.Distinct().ToList() 'Grid leeren Clear_Grid_View() 'Databinding Neu BindingSource_Entity.DataSource = DT_SELECTION GridControlMain.DataSource = BindingSource_Entity ' Den Editor Initialisieren und Optionen setzen Dim CheckBoxEditorForDisplay = New RepositoryItemCheckEdit() CheckBoxEditorForDisplay.ValueChecked = 1 CheckBoxEditorForDisplay.ValueUnchecked = 0 ' Alle Checkbox Spalten durchgehen und CheckBoxEditor zuweisen For Each col As String In listcheck grvwGrid.GridControl.RepositoryItems.Add(CheckBoxEditorForDisplay) If Not IsNothing(grvwGrid.Columns(col)) Then grvwGrid.Columns(col).ColumnEdit = CheckBoxEditorForDisplay End If Next 'grvwGrid.Columns("Record-ID").OptionsColumn.AllowShowHide = False End If HideColumns() Dim selnode As TreeNode = TreeViewMain.SelectedNode Dim origtext As String = selnode.Text If origtext.Contains(" (") Then Dim existingstring = origtext.Substring(0, origtext.IndexOf("(") - 1) selnode.Text = String.Format("{0} ({1})", existingstring, Get_Grid_Row_Count()) Else selnode.Text = String.Format("{0} ({1})", selnode.Text, Get_Grid_Row_Count()) End If Catch ex As Exception MsgBox("Error in LoadGrid_Selection:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) Return False End Try Return True End Function Sub HideColumns() Try Dim SQL As String = "SELECT CONTROL_ID, CONTROL_COL_NAME, CONTROL_SHOW_COLUMN FROM VWPMO_CONTROL_SCREEN WHERE CONTROL_SHOW_COLUMN = 0 AND FORM_ID = " & ENTITY_ID Dim DT As DataTable = ClassDatabase.Return_Datatable(SQL) If GRID_TYPE = GridType.Grid Then Dim cols As DevExpress.XtraGrid.Columns.GridColumnCollection = grvwGrid.Columns If DT.Rows.Count <> 0 Then ' Alle Spalten, die ausgeblendet werden sollten durchgehen und Visible = False For Each row As DataRow In DT.Rows Dim colname As String = row.Item("CONTROL_COL_NAME") Dim col As DevExpress.XtraGrid.Columns.GridColumn = grvwGrid.Columns.Item(colname) If Not IsNothing(col) Then col.Visible = False End If Next End If ' FormID und RecordID immer ausblenden grvwGrid.Columns.Item("Record-ID").Visible = False grvwGrid.Columns.Item("Form-ID").Visible = False End If Catch ex As Exception MsgBox("Error in HideColumns:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub Sub HideColumns_Pos(EntityID As Integer) Try Dim SQL As String = "SELECT CONTROL_ID, CONTROL_COL_NAME, CONTROL_SHOW_COLUMN FROM VWPMO_CONTROL_SCREEN WHERE CONTROL_SHOW_COLUMN = 0 AND FORM_ID = " & EntityID Dim DT As DataTable = ClassDatabase.Return_Datatable(SQL) Dim cols As DevExpress.XtraGrid.Columns.GridColumnCollection = grvwGridPos.Columns If DT.Rows.Count <> 0 Then ' Alle Spalten, die ausgeblendet werden sollten durchgehen und Visible = False For Each row As DataRow In DT.Rows Dim colname As String = row.Item("CONTROL_COL_NAME") Dim col As DevExpress.XtraGrid.Columns.GridColumn = grvwGridPos.Columns.Item(colname) If Not IsNothing(col) Then col.Visible = False End If Next End If ' FormID und RecordID immer ausblenden grvwGridPos.Columns.Item("Record-ID").Visible = False grvwGridPos.Columns.Item("Form-ID").Visible = False Catch ex As Exception MsgBox("Error in HideColumns_Pos:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub Private Sub Show_Selected_Record_Data(Rec_ID As Integer, EntityLoad As Boolean) Try Dim sw As New Stopwatch sw.Start() Update_Status_Label(False, "") If LogErrorsOnly = False Then ClassLogger.Add(" >> GRID_RECORD ID: " & Rec_ID.ToString, False) 'Me.pnlDetails.Visible = True ZeigeRecordLogsToolStripMenuItem.Enabled = False If FORM_TYPE = 5 And EntityLoad = False Or IS_SINGLE_RECORD = True And EntityLoad = False Then '#### Es sind untergeordnete Entitäten geöffnet#### Dim linkedRecord ' Dim pID As Integer Select Case ACT_EBENE '#### Hier muss nun der Parent-Record gewählt werden #### Case 3 linkedRecord = GET_LINKED_RECORD(Rec_ID, ENTITY_ID) If linkedRecord > 0 Then Dim sqlp = "SELECT PARENT_ID FROM TBPMO_FORM WHERE GUID = " & ENTITY_ID Dim Parent_EntityID = ClassDatabase.Execute_Scalar(sqlp, True) Dim sql As String = String.Format("SELECT T.RECORD2_ID FROM TBPMO_RECORD_CONNECT T, TBPMO_RECORD T1 WHERE T.RECORD2_ID = T1.GUID AND T.RECORD1_ID = {0} and T1.FORM_ID = {1}", RECORD_ID, Parent_EntityID) Dim PARENT_RECORD1 = ClassDatabase.Execute_Scalar(sql, True) EBENE2_RECID = PARENT_RECORD1 PARENT_RECORDID = PARENT_RECORD1 PARENT_ID = PARENT_RECORD1 End If Case 2 linkedRecord = GET_LINKED_RECORD(Rec_ID, ENTITY_ID) If linkedRecord > 0 Then EBENE1_RECID = Rec_ID PARENT_RECORDID = EBENE1_RECID PARENT_ID = PARENT_RECORDID End If Case 1 PARENT_RECORDID = Rec_ID EBENE1_RECID = PARENT_RECORDID PARENT_ID = PARENT_RECORDID End Select RECORD_ID = CInt(linkedRecord) SELECTED_RECORD_ID = RECORD_ID '#### Den Group or Single_Record holen/anlegen ' GET_GROUP_OR_SINGLE_RECORD(pID, False) Else '#### Datensatz wird normal geladen #### SELECTED_RECORD_ID = Rec_ID RECORD_ID = SELECTED_RECORD_ID 'Die aktuelle Ebene überprüfen und den Datensatz übergeben, ebenso den PARENT-Record setzen Select Case ACT_EBENE Case 1 PARENT_RECORDID = RECORD_ID EBENE1_RECID = PARENT_RECORDID PARENT_ID = EBENE1_RECID If Not EBENE1_COLUMNNAME Is Nothing Then EBENE1_GRID_RESULT = Get_GridResult(EBENE1_COLUMNNAME) End If Case 2 EBENE2_RECID = SELECTED_RECORD_ID If Not EBENE2_COLUMNNAME Is Nothing Then EBENE2_GRID_RESULT = Get_GridResult(EBENE2_COLUMNNAME) End If If EBENE1_RECID > 0 Then PARENT_RECORDID = EBENE1_RECID PARENT_ID = EBENE1_RECID Else PARENT_ID = EBENE2_RECID End If Case 3 EBENE3_RECID = SELECTED_RECORD_ID If Not EBENE3_COLUMNNAME Is Nothing Then EBENE3_GRID_RESULT = Get_GridResult(EBENE3_COLUMNNAME) End If If EBENE2_RECID > 0 Then PARENT_RECORDID = EBENE2_RECID PARENT_ID = EBENE2_RECID End If End Select End If Select Case TCDetails.SelectedTabPageIndex Case 0 Dim sw1 As New Stopwatch sw1.Start() ENTITY_RELOAD_AFT_CONTROL_LOAD = False CtrlBuilder.WatchRecordChanges = False ClassControlValues.LoadControlValues(SELECTED_RECORD_ID, PARENT_ID, ENTITY_ID, CtrlBuilder.AllControls, ENTITY_ID) CtrlBuilder.WatchRecordChanges = True Dim elapsed1 As Double elapsed1 = sw1.Elapsed.TotalSeconds sw1.Stop() sw1.Reset() If LogErrorsOnly = False Then ClassLogger.Add(" >> LoadControlValues took " & Format(elapsed1, "0.000000000") & " seconds", False) If windream_Docshow = True Then Dim stg As String = "windream-Dateien" If USER_LANGUAGE <> "de-DE" Then stg = "windream-files" End If TabWindream.Text = stg End If Case 1 If RECORD_ID = 0 Then RUN_WD_SEARCH(WD_Suche, "ENTITY") Else RUN_WDSEARCH_GRID() ' RUN_WD_SEARCH(WD_Suche, "RECORD") End If Case 2 tsButtonEdit.Enabled = False Refresh_FollowUps() dtpFollowUp.Enabled = False lblWiedervorlage_Control.Text = "<< Waiting for Selection:" 'ListBoxUser2Profile.Items.Clear() grpbxFU_Profile.Enabled = False End Select ' Laden der Daten bedeutet nicht dass Daten vom Benutzer geändert wurden! RECORD_CHANGED = False Dim Record_Changes As String = "SELECT count(GUID) FROM VWPMO_RECORD_CHANGES WHERE RECORD_ID = " & RECORD_ID Dim RC = ClassDatabase.Execute_Scalar(Record_Changes, True) If Not RC Is Nothing Then If RC > 0 Then ZeigeRecordLogsToolStripMenuItem.Enabled = True End If End If Refresh_Navpane() Update_Record_Label(SELECTED_RECORD_ID) Show_act_WFTask() Me.tsButtonShowWorkflowTasks.Enabled = True Me.tsButtonShowTaskOverview.Enabled = True RECORD_ID = SELECTED_RECORD_ID Dim elapsed As Double elapsed = sw.Elapsed.TotalSeconds sw.Stop() sw.Reset() If LogErrorsOnly = False Then ClassLogger.Add(" >> Show Selected RecordData took " & Format(elapsed, "0.000000000") & " seconds", False) If ENTITY_RELOAD_AFT_CONTROL_LOAD = True Then Reload_Entity_while_Control_Load() End If 'tsstatus_Detail_show(False, "") Catch ex As Exception MsgBox("Error in SelectedRecord_ShowData:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub Sub Reload_Entity_while_Control_Load() Dim result As MsgBoxResult Dim stg As String If USER_LANGUAGE = "de-DE" Then stg = "Es gab ein unerwartetes Problem beim Laden der Control-Values! Wollen Sie versuchen die Daten erneut zu laden?" & vbNewLine & "'Nein' beendet die Sicht für einen manuellen Neustart!" Else stg = "ADDI encountered an unexpected error while loading the control values for the record! Do You want to try to relaod the entity data?" & vbNewLine & "No is terminating the entity-form to restart it manually!" End If result = MessageBox.Show(stg, "Confirmation needed:", MessageBoxButtons.YesNo, MessageBoxIcon.Question) If result = MsgBoxResult.Yes Then Load_Tree_View_Data() Else Me.Close() End If End Sub Sub Create_Grid_Editor(formId As Integer) Try Dim SQL As String = "SELECT CONTROL_COL_NAME,CONTROL_SQLCOMMAND_1,CONTROL_STATIC_LIST FROM VWPMO_CONTROL_SCREEN WHERE CTRLTYPE_ID = 3 AND FORM_ID = " & formId Dim ComboColumns As DataTable = ClassDatabase.Return_Datatable(SQL) ' Alle Checkboxen für aktuelle Ansicht heraussuchen Dim sqlcheck As String = "SELECT CONTROL_COLUMN FROM VWPMO_VALUES WHERE CONTROL_TYPE_ID in (10,11) AND FORM_ID = " & formId Dim dtcheck As DataTable = ClassDatabase.Return_Datatable(sqlcheck) Dim listcheck As New List(Of String) 'Liste von allen Spaltentiteln mit Checkbox erstellen If dtcheck.Rows.Count > 0 Then For Each row As DataRow In dtcheck.Rows listcheck.Add(row.Item(0)) Next End If ' Den Editor Initialisieren und Optionen setzen Dim CheckBoxEditorForDisplay = New RepositoryItemCheckEdit() CheckBoxEditorForDisplay.ValueChecked = 1 CheckBoxEditorForDisplay.ValueUnchecked = 0 ' Alle Checkbox Spalten durchgehen und CheckBoxEditor zuweisen For Each col As String In listcheck grvwGridPos.GridControl.RepositoryItems.Add(CheckBoxEditorForDisplay) If Not IsNothing(grvwGridPos.Columns(col)) Then grvwGridPos.Columns(col).ColumnEdit = CheckBoxEditorForDisplay End If Next For Each col As DataRow In ComboColumns.Rows Dim colName As String = col.Item(0) Dim hasSqlCommand = col.Item(1).ToString() <> "" Dim hasStaticList = col.Item(2).ToString() <> "" If hasStaticList = True Then Dim comboEdit1 As New RepositoryItemComboBox() Dim comboItems1 As ComboBoxItemCollection = comboEdit1.Items Dim staticListItems = col.Item(2).ToString.Split(";") comboItems1.BeginUpdate() Try For Each item In staticListItems comboItems1.Add(item) Next Finally comboItems1.EndUpdate() End Try GridControlPos.RepositoryItems.Add(comboEdit1) If Not IsNothing(grvwGridPos.Columns(colName)) Then grvwGridPos.Columns(colName).ColumnEdit = comboEdit1 End If ElseIf hasSqlCommand = True Then SQL = col.Item(1).ToString() Dim dt As DataTable = ClassDatabase.Return_Datatable(SQL, "Load_Pos_Data") Dim comboEdit2 As New RepositoryItemComboBox() Dim comboItems2 As ComboBoxItemCollection = comboEdit2.Items For Each row As DataRow In dt.Rows Dim value = row.Item(0) comboItems2.BeginUpdate() Try comboItems2.Add(value) Finally comboItems2.EndUpdate() End Try Next GridControlPos.RepositoryItems.Add(comboEdit2) If Not IsNothing(grvwGridPos.Columns(colName)) Then grvwGridPos.Columns(colName).ColumnEdit = comboEdit2 End If End If Next Catch ex As Exception MsgBox("Error in Create_Grid_Editor:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub Sub Load_Pos_Data() Try If POS_ENTITY > 0 Then Get_Pos_SQL(POS_ENTITY) POS_SQL = POS_SQL.Replace("@PARENT_ID", PARENT_RECORDID) Dim DT_POS As DataTable = ClassDatabase.Return_Datatable(POS_SQL, "Load POSData") Clear_GridPos_View() If Not IsNothing(DT_POS) Then GridControlPos.DataSource = DT_POS Dim bs As New BindingSource bs.DataSource = DT_POS BindingNavigatorPOS.BindingSource = bs ' --- Editoren laden für Combobox --- Create_Grid_Editor(POS_ENTITY) HideColumns_Pos(PARENT_RECORDID) End If End If Catch ex As Exception MsgBox("Error in Load_Pos_Data:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub Function Get_GridResult(Columnname As String) Dim result = Get_Focused_Row_Cell_Value(Columnname) If IsDBNull(result) OrElse result = "" Then Return "No Column configured" Else Return result End If End Function Function GetSelected_RecordID() Try If Get_Grid_Column_Count() = 0 Then Lock_RecordControls(True) ' Me.pnlDetails.Enabled = False 'Me.tsbtnshowWorkflowtasks.Enabled = False 'tsstatus_Detail_show(True, "Keine Columns in Grid") Return Nothing End If 'Überhaupt Rows in Grid? If Get_Grid_Row_Count() > 0 Then Dim Grid_RecordID = Get_Focused_Row_Cell_Value("Record-ID") If Grid_RecordID Is Nothing = False Then Return Grid_RecordID Else 'tsstatus_Detail_show(True, "Grid_RecordID konnte nicht gewählt werden!") 'ClassLogger.Add(">> Grid_RecordID konnte nicht gewählt werden - SelectedRecord_ShowData", True) Return Nothing End If Else Return Nothing End If Catch ex As Exception End Try End Function 'Sub Get_Selected_Record() ' Select Case EDIT_STATE ' Case EditState.None ' 'Ganz normalerDatensatzwechsel Wechsel ' Show_Selected_Record_Data("Record-ID") ' 'Refresh_Treeview_SelectedData() ' Update_Status_Label(False) ' 'tslblStatusMain_show(False, "") ' Case EditState.Insert ' 'Refresh_Treeview_SelectedData() ' Case EditState.Update ' ' Refresh_Treeview_SelectedData() ' End Select ' Select Case TCDetails.SelectedTabPageIndex ' Case 0 ' 'Die Values in die Controls laden ' If EDIT_STATE = EditState.None Then ' 'TabPageDetails.Text = "Detaileingabe zu '" & ACT_EBENE_STRING & "' - Record(" & SelectedRecordID & ")" ' 'Die Daten auf dem Panel laden ' ClassControlValues.LoadControlValues(SELECTED_RECORD_ID, FORM_ID, CtrlBuilder.AllControls) ' 'Load_Control_Values(CtrlBuilder.AllControls) ' 'Refresh_Treeview_SelectedData() ' RECORD_CHANGED = False ' End If ' Case 1 ' RUN_WD_SEARCH(WD_Suche, "RECORD") ' Case 2 ' 'If FOLLOW_UPisActive = True Then Refresh_FollowUps() ' End Select ' 'DT_FU_Record = Nothing ' 'VerknüpfungenToolStripMenuItem.Enabled = True ' Update_Record_Label(SELECTED_RECORD_ID) ' If FOLLOW_UPisActive = True Then Refresh_FollowUp_TabHeader() ' Show_act_WFTask() ' Get_RecordCounts_Nodes() ' pnlDetails.Enabled = False ' Refresh_TaskOverview() 'End Sub Private Sub Refresh_FollowUp_TabHeader() Try DT_FU_Record = ClassDatabase.Return_Datatable("select * from VWPMO_FOLLOW_UP_EMAIL_ENTITY_RECORD where Record_ID = " & RECORD_ID, "Refresh FollowUp TabHeader") Dim msg As String = "Wiedervorlage (Nicht Abrufbar)" If USER_LANGUAGE <> "de-DE" Then msg = "Follow Up - (Not accessable)" End If If IsNothing(DT_FU_Record) Then TabFollowUp.Text = msg Exit Sub End If If DT_FU_Record.Rows.Count = 0 Then msg = "Wiedervorlage (Nicht aktiviert)" If USER_LANGUAGE <> "de-DE" Then msg = "Follow Up - (Not activated)" End If TabFollowUp.Text = msg Else msg = "Wiedervorlage (Aktive Profile)" If USER_LANGUAGE <> "de-DE" Then msg = "Follow Up - (active profiles)" End If TabFollowUp.Text = msg End If Catch ex As Exception MsgBox("Error in Refresh_FollowUp_TabHeader:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub Private Function Update_Record_OnChange() As String ' Überprüfen, ob alle "Required Felder ausgefüllt wurden" Dim missingControlValues As List(Of String) = ClassControlValues.CheckRequiredControlValues(CtrlBuilder.MasterPanel.Controls) If missingControlValues.Count > 0 Then Dim nameString As String = String.Join(vbNewLine, missingControlValues) Dim msg = String.Format("Die folgenden Steuerelemente müssen ausgefüllt sein: {0}{1}", vbNewLine, nameString) If USER_LANGUAGE <> "de-DE" Then msg = String.Format("the following controls must be filled with values: {0}{1}", vbNewLine, nameString) End If Dim errorMessage As String = msg Throw New Exception(errorMessage) End If ' Record Speichern Dim ResultMessage = CtrlCommandUI.SaveRecord(SELECTED_RECORD_ID, ENTITY_ID, PARENT_RECORDID) 'Jetzt die für die Entität notwendigen Prroceduren ausführen Customer_Run_Procedures() RECORD_CHANGED = False Return ResultMessage End Function Private Sub Customer_Run_Procedures() Try Dim DT As DataTable = ClassDatabase.Return_Datatable("SELECT * FROM TBPMO_RUN_PROCEDURES WHERE FORM_ID = " & ENTITY_ID) If Not DT Is Nothing Then For Each row As DataRow In DT.Rows Dim prsql As String = row.Item("EXECUTE_COMMAND") prsql = prsql.ToUpper.Replace("@FORM_ID", ENTITY_ID) prsql = prsql.ToUpper.Replace("@ENTITY_ID", ENTITY_ID) prsql = prsql.ToUpper.Replace("@RECORD_ID", RECORD_ID) ClassDatabase.Execute_non_Query(prsql, True) Next End If Catch ex As Exception MsgBox("Error in Customer_Run_Procedures:" & vbNewLine & ex.Message) End Try End Sub #Region "WindreamSuche" Private Function Check_windream_Show(FORM_VIEW_ID As Integer) Try Dim sql = "SELECT * FROM TBPMO_FORM_VIEW WHERE WINDREAM_SEARCH <> '' AND GUID = " & FORM_VIEW_ID Dim DTWD As DataTable = ClassDatabase.Return_Datatable(sql) If DTWD.Rows.Count = 1 Then TabWindream.PageVisible = True If IsDBNull(DTWD.Rows(0).Item(0)) Then windream_Docshow = False WindreamsucheNeuLadenToolStripMenuItem.Visible = False Exit Function End If WindreamsucheNeuLadenToolStripMenuItem.Visible = True windream_Docshow = True If windream_inited = False Then Dim sw As New Stopwatch sw.Start() Dim elapsed As Double If ClassWindream.Init() = True Then windream_inited = True End If elapsed = sw.Elapsed.TotalSeconds sw.Stop() sw.Reset() If LogErrorsOnly = False Then ClassLogger.Add(" >> Windream init took " & Format(elapsed, "0.000000000") & " seconds", False) End If Else windream_Docshow = False TabWindream.PageVisible = False WindreamsucheNeuLadenToolStripMenuItem.Visible = False End If Catch ex As Exception MsgBox("Error in Check windream show:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) windream_Docshow = False End Try End Function Private Sub RUN_WD_SEARCH(BaseSearch As String, Type As String) Dim sw As New Stopwatch sw.Start() Dim elapsed As Double Try Dim windream_temp_search If Not windream_Docshow = True Or Sett_LoadWD_Docs = False Or TCDetails.SelectedTabPageIndex <> 1 Then Exit Sub End If Cursor = Cursors.WaitCursor Dim DTWD As DataTable If Type = "ENTITY" Then Dim _sql = "SELECT WINDREAM_SEARCH,SEARCH_PATTERN1,SEARCH_PATTERN2,SEARCH_PATTERN3,SEARCH_PATTERN4,SEARCH_PATTERN5 FROM TBPMO_FORM_CONSTRUCTOR_DETAIL WHERE WINDREAM_SEARCH <> '' AND FORM_ID = " & ENTITY_ID DTWD = ClassDatabase.Return_Datatable(_sql) If DTWD.Rows.Count = 1 Then If IsDBNull(DTWD.Rows(0).Item(0)) Then Clear_Windream_ResultList() Cursor = Cursors.Default Exit Sub End If Dim msg = "Windream-Dokumente für Entität: " & ACT_EBENE_STRING If USER_LANGUAGE <> "de-DE" Then msg = "windream-files for entity: " & ACT_EBENE_STRING End If tslblWindreamView.Text = msg Else Clear_Windream_ResultList() Cursor = Cursors.Default Exit Sub Exit Sub End If Else Dim sql = "SELECT WINDREAM_SEARCH,SEARCH_PATTERN1,SEARCH_PATTERN2,SEARCH_PATTERN3,SEARCH_PATTERN4,SEARCH_PATTERN5 FROM TBPMO_FORM_VIEW WHERE WINDREAM_SEARCH <> '' AND FORM_ID = " & ENTITY_ID DTWD = ClassDatabase.Return_Datatable(sql) If DTWD.Rows.Count = 1 Then If IsDBNull(DTWD.Rows(0).Item(0)) Then Clear_Windream_ResultList() Cursor = Cursors.Default Exit Sub Exit Sub End If Dim msg = "Windream-Dokumente für Record: " & RECORD_ID If USER_LANGUAGE <> "de-DE" Then msg = "windream-files for record: " & RECORD_ID End If tslblWindreamView.Text = msg Else Clear_Windream_ResultList() Cursor = Cursors.Default Exit Sub Exit Sub End If End If 'Die SearchPatterns durchlaufen und zwischenspeichern If IsDBNull(DTWD.Rows(0).Item(0)) Then Clear_Windream_ResultList() Cursor = Cursors.Default Exit Sub Exit Sub End If BaseSearch = DTWD.Rows(0).Item(0) SP1 = DTWD.Rows(0).Item(1) If IsDBNull(DTWD.Rows(0).Item(2)) Then SP2 = "" Else SP2 = DTWD.Rows(0).Item(2) End If If IsDBNull(DTWD.Rows(0).Item(3)) Then SP3 = "" Else SP3 = DTWD.Rows(0).Item(3) End If If IsDBNull(DTWD.Rows(0).Item(4)) Then SP4 = "" Else SP4 = DTWD.Rows(0).Item(4) End If If IsDBNull(DTWD.Rows(0).Item(5)) Then SP5 = "" Else SP5 = DTWD.Rows(0).Item(5) End If 'Eine tempfile generieren Dim tempFilename1 = My.Computer.FileSystem.GetTempFileName() 'Nur den Filenamen ohne Erweiterung Dim tempName = Path.GetFileNameWithoutExtension(tempFilename1) 'tempfile lsöchen If My.Computer.FileSystem.FileExists(tempFilename1) Then My.Computer.FileSystem.DeleteFile(tempFilename1) End If Try Dim temppath = Path.GetTempPath Dim EncodingFormat As Encoding Dim WDUnicode = ClassDatabase.Execute_Scalar("SELECT WD_UNICODE FROM TBPMO_KONFIGURATION WHERE GUID = 1") If WDUnicode = True Then EncodingFormat = Encoding.GetEncoding(1252) '1252 If LogErrorsOnly = False Then ClassLogger.Add(" >> Unicode is used (Encoding.GetEncoding(1252))", False) Else If LogErrorsOnly = False Then ClassLogger.Add(" >> UTF8 (Encoding.GetEncoding(65001))", False) EncodingFormat = Encoding.GetEncoding(65001) End If Dim fileContents As String If LogErrorsOnly = False Then ClassLogger.Add(" >> ReadAlltext: " & windream_temp_search, False) fileContents = My.Computer.FileSystem.ReadAllText(BaseSearch, EncodingFormat) ', System.Text.Encoding.Unicode If LogErrorsOnly = False Then ClassLogger.Add(" >> fileContents geladen", False) fileContents = fileContents.Replace("Í", "Ö") Dim _sp1 = SP1 Dim _sp2 = SP2 Dim _sp3 = SP3 Dim _sp4 = SP4 Dim _sp5 = SP5 If _sp1.ToString <> String.Empty Then _sp1 = Return_SearchPattern(_sp1.ToString) fileContents = fileContents.Replace("%pattern1%", _sp1) fileContents = fileContents.Replace("471101", _sp1) End If If _sp2.ToString <> String.Empty Then _sp2 = Return_SearchPattern(_sp2.ToString) If _sp2 = 0 Then _sp2 = "" End If fileContents = fileContents.Replace("%pattern2%", _sp2) fileContents = fileContents.Replace("471102", _sp2) End If If _sp3.ToString <> String.Empty Then _sp3 = Return_SearchPattern(_sp3.ToString) If _sp3 = 0 Then _sp3 = "" End If fileContents = fileContents.Replace("%pattern3%", _sp3) fileContents = fileContents.Replace("471103", _sp3) End If If _sp4.ToString <> String.Empty Then _sp4 = Return_SearchPattern(_sp4.ToString) If _sp4 = 0 Then _sp4 = "" End If fileContents = fileContents.Replace("%pattern4%", _sp4) fileContents = fileContents.Replace("471104", _sp4) End If If _sp5.ToString <> String.Empty Then _sp5 = Return_SearchPattern(_sp5.ToString) If _sp5 = 0 Then _sp5 = "" End If fileContents = fileContents.Replace("%pattern5%", _sp5) fileContents = fileContents.Replace("471105", _sp5) End If 'Die windream File zusammensetzen windream_temp_search = temppath & tempName & ".wdf" TEMP_FILES.Add(windream_temp_search) 'Die File schreiben My.Computer.FileSystem.WriteAllText(windream_temp_search, fileContents, False, EncodingFormat) My.Computer.FileSystem.WriteAllText(temppath & "SEARCH_COPY.wdf", fileContents, False, EncodingFormat) ' XML-Datei öffnen und laden Dim Stream As New IO.StreamReader(CStr(windream_temp_search), EncodingFormat) Dim Reader As New System.Xml.XmlTextReader(Stream) ' XML-Datei initialisieren Dim xml As New System.Xml.XmlDocument() ' XML-Datei öffnen und laden xml.Load(Reader) Reader.Close() xml.Save(windream_temp_search) If LogErrorsOnly = False Then ClassLogger.Add(" >> Xml Generiert: " & windream_temp_search, False) Dim windreamSucheErgebnisse As WINDREAMLib.WMObjects Try windreamSucheErgebnisse = ClassWindream.GetSearchDocuments(windream_temp_search) Catch ex As Exception MsgBox("Error in windreamSucheErgebnisse:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try elapsed = sw.Elapsed.TotalSeconds If LogErrorsOnly = False Then ClassLogger.Add(" >> GetSearchDocuments took " & Format(elapsed, "0.000000000") & " seconds", False) If windreamSucheErgebnisse.Count > 0 Then Dim stg As String If USER_LANGUAGE = "de-DE" Then stg = "windream-Dateien" Else stg = "windream-files" End If TabWindream.Text = stg & " (" & windreamSucheErgebnisse.Count & ")" AxObjectListControl.SetIconMode(True) AxObjectListControl.RemoveAllColumnHeader() Me.AxObjectListControl.SetSession(ClassWindream.oSession, "", "") 'Change the status icon 'ICON STATES: Me.AxObjectListControl.SetStatusIcon(0) 'Change the icon Me.AxObjectListControl.SetStatusIcon(2) Try Dim sql_ResultList = "select * from TBPMO_WINDREAM_RESULTLIST_CONFIG where guid = 1" Dim DT As DataTable = ClassDatabase.Return_Datatable(sql_ResultList, "GET RESULTLIST KONFIG") If Not DT Is Nothing And DT.Rows.Count = 1 Then Dim anzparam As Integer = 1 For Each Column As DataColumn In DT.Columns If Column.ColumnName.StartsWith("COLUMN") And Column.ColumnName.EndsWith("WIDTH") = False Then Dim sql = String.Format("select {0} from TBPMO_WINDREAM_RESULTLIST_CONFIG Where GUID = 1", Column.ColumnName) Dim ColumnName = ClassDatabase.Execute_Scalar(sql, True) If Not IsDBNull(ColumnName) Then If Not IsDBNull(ColumnName) Or IsNothing(ColumnName) Or ColumnName <> "" Or ColumnName <> "{}" Then 'Jetzt die Spalten aus Array hinzufügen und Breite konfigurieren sql = String.Format("select COLUMN{0}_WIDTH from TBPMO_WINDREAM_RESULTLIST_CONFIG Where GUID = 1", anzparam) Dim Width = ClassDatabase.Execute_Scalar(sql, True) If IsNothing(Width) Or IsDBNull(Width) Then Width = 200 End If 'You need to use the column name here 'Please note that some attributes or indices will not be displayed 'Try not to add the same header twice, it will throw cause problems if you do that Me.AxObjectListControl.AddColumnHeader(ColumnName, Width) anzparam += 1 End If End If End If Next Else Dim param As New List(Of String) 'The file name param.Add("szLongName") 'The document-Type param.Add("szText37") 'Versionsnummer param.Add("dwVersionNumber") 'Datumsangaben param.Add("dwCreationDate") param.Add("dwCreation_Time") 'Add all search params For Each spar As String In param Dim width As Integer = 200 Select Case spar Case "szLongName" 'Dateiname width = 300 Case "szText37" 'Dokumentart width = 160 Case "dwCreationDate" 'Erstelldatum width = 90 Case "dwCreation_Time" 'Erstell-Zeit width = 120 End Select 'You need to use the column name here 'Please note that some attributes or indices will not be displayed 'Try not to add the same header twice, it will throw cause problems if you do that Me.AxObjectListControl.AddColumnHeader(spar, width) Next End If Catch ex As Exception MsgBox("Unexpected Error in Construct windreamResultList: " & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try If LogErrorsOnly = False Then ClassLogger.Add(" >> AxObjectListControl loaded ", False) 'Execute the search Dim results As WINDREAMLib.WMObjects = windreamSucheErgebnisse If LogErrorsOnly = False Then ClassLogger.Add(" >> results loaded ", False) 'Set the contents without displaying them AxObjectListControl.SetContentsEx(results) 'Change the icon AxObjectListControl.SetStatusIcon(5) 'Display the results... 'The Previous Object Count Dim poc As Integer = 0 'Display new objects, as long as the objectcount changes after displaying the objects Do Until (poc <> AxObjectListControl.GetObjectCount) poc = AxObjectListControl.GetObjectCount 'If you want, you can display more items at a timeRefresh_FollowUp_TabHeader 'But do not display to many at a time or the user interface could freeze 'Maybe try 50 AxObjectListControl.DisplayResults(WDResultListCount) Loop AxObjectListControl.SetStatusIcon(3) Else Dim msg = "Windream-Dokumente für Record: " & RECORD_ID & " - Keine Dateien gefunden" If USER_LANGUAGE <> "de-DE" Then msg = "windream-files for record: " & RECORD_ID & " - no files found" End If tslblWindreamView.Text = "Windream-Dokumente für Record: " & RECORD_ID & " - Keine Dateien gefunden" Clear_Windream_ResultList() End If Catch ex As Exception MsgBox("Error in execute-windreamSearch:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try Cursor = Cursors.Default Catch ex As Exception MsgBox("Error in RUN_WD_SEARCH:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try elapsed = sw.Elapsed.TotalSeconds sw.Stop() sw.Reset() If LogErrorsOnly = False Then ClassLogger.Add(" >> Run WD Search took " & Format(elapsed, "0.000000000") & " seconds", False) Cursor = Cursors.Default End Sub Private Sub WD_DELETE_DOCS() Dim sw As New Stopwatch sw.Start() Dim elapsed As Double Dim Basesearch As String Try Dim windream_temp_search If Not windream_Docshow = True Or Sett_LoadWD_Docs = False Then Exit Sub End If Cursor = Cursors.WaitCursor Dim DTWD As DataTable Dim sql = "SELECT WINDREAM_SEARCH,SEARCH_PATTERN1,SEARCH_PATTERN2,SEARCH_PATTERN3,SEARCH_PATTERN4,SEARCH_PATTERN5 FROM TBPMO_FORM_VIEW WHERE WINDREAM_SEARCH <> '' AND FORM_ID = " & ENTITY_ID DTWD = ClassDatabase.Return_Datatable(sql) If DTWD.Rows.Count = 1 Then If IsDBNull(DTWD.Rows(0).Item(0)) Then Cursor = Cursors.Default Exit Sub End If Else Cursor = Cursors.Default Exit Sub End If 'Die SearchPatterns durchlaufen und zwischenspeichern If IsDBNull(DTWD.Rows(0).Item(0)) Then Cursor = Cursors.Default Exit Sub End If Basesearch = DTWD.Rows(0).Item(0) SP1 = DTWD.Rows(0).Item(1) If IsDBNull(DTWD.Rows(0).Item(2)) Then SP2 = "" Else SP2 = DTWD.Rows(0).Item(2) End If If IsDBNull(DTWD.Rows(0).Item(3)) Then SP3 = "" Else SP3 = DTWD.Rows(0).Item(3) End If If IsDBNull(DTWD.Rows(0).Item(4)) Then SP4 = "" Else SP4 = DTWD.Rows(0).Item(4) End If If IsDBNull(DTWD.Rows(0).Item(5)) Then SP5 = "" Else SP5 = DTWD.Rows(0).Item(5) End If 'Eine tempfile generieren Dim tempFilename1 = My.Computer.FileSystem.GetTempFileName() 'Nur den Filenamen ohne Erweiterung Dim tempName = Path.GetFileNameWithoutExtension(tempFilename1) 'tempfile lsöchen If My.Computer.FileSystem.FileExists(tempFilename1) Then My.Computer.FileSystem.DeleteFile(tempFilename1) End If Dim temppath = Path.GetTempPath Dim EncodingFormat As Encoding Dim WDUnicode = ClassDatabase.Execute_Scalar("SELECT WD_UNICODE FROM TBPMO_KONFIGURATION WHERE GUID = 1") If WDUnicode = True Then EncodingFormat = Encoding.GetEncoding(1252) '1252 If LogErrorsOnly = False Then ClassLogger.Add(" >> Unicode is used (Encoding.GetEncoding(1252))", False) Else If LogErrorsOnly = False Then ClassLogger.Add(" >> UTF8 (Encoding.GetEncoding(65001))", False) EncodingFormat = Encoding.GetEncoding(65001) End If Dim fileContents As String If LogErrorsOnly = False Then ClassLogger.Add(" >> ReadAlltext: " & windream_temp_search, False) fileContents = My.Computer.FileSystem.ReadAllText(Basesearch, EncodingFormat) ', System.Text.Encoding.Unicode If LogErrorsOnly = False Then ClassLogger.Add(" >> fileContents geladen", False) fileContents = fileContents.Replace("Í", "Ö") Dim _sp1 = SP1 Dim _sp2 = SP2 Dim _sp3 = SP3 Dim _sp4 = SP4 Dim _sp5 = SP5 If _sp1.ToString <> String.Empty Then _sp1 = Return_SearchPattern(_sp1.ToString) fileContents = fileContents.Replace("%pattern1%", _sp1) fileContents = fileContents.Replace("471101", _sp1) End If If _sp2.ToString <> String.Empty Then _sp2 = Return_SearchPattern(_sp2.ToString) If _sp2 = 0 Then _sp2 = "" End If fileContents = fileContents.Replace("%pattern2%", _sp2) fileContents = fileContents.Replace("471102", _sp2) End If If _sp3.ToString <> String.Empty Then _sp3 = Return_SearchPattern(_sp3.ToString) If _sp3 = 0 Then _sp3 = "" End If fileContents = fileContents.Replace("%pattern3%", _sp3) fileContents = fileContents.Replace("471103", _sp3) End If If _sp4.ToString <> String.Empty Then _sp4 = Return_SearchPattern(_sp4.ToString) If _sp4 = 0 Then _sp4 = "" End If fileContents = fileContents.Replace("%pattern4%", _sp4) fileContents = fileContents.Replace("471104", _sp4) End If If _sp5.ToString <> String.Empty Then _sp5 = Return_SearchPattern(_sp5.ToString) If _sp5 = 0 Then _sp5 = "" End If fileContents = fileContents.Replace("%pattern5%", _sp5) fileContents = fileContents.Replace("471105", _sp5) End If 'Die windream File zusammensetzen windream_temp_search = temppath & tempName & ".wdf" TEMP_FILES.Add(windream_temp_search) 'Die File schreiben My.Computer.FileSystem.WriteAllText(windream_temp_search, fileContents, False, EncodingFormat) My.Computer.FileSystem.WriteAllText(temppath & "SEARCH_COPY.wdf", fileContents, False, EncodingFormat) ' XML-Datei öffnen und laden Dim Stream As New IO.StreamReader(CStr(windream_temp_search), EncodingFormat) Dim Reader As New System.Xml.XmlTextReader(Stream) ' XML-Datei initialisieren Dim xml As New System.Xml.XmlDocument() ' XML-Datei öffnen und laden xml.Load(Reader) Reader.Close() xml.Save(windream_temp_search) If LogErrorsOnly = False Then ClassLogger.Add(" >> Xml Generiert: " & windream_temp_search, False) Dim windreamSucheErgebnisse As WINDREAMLib.WMObjects Try windreamSucheErgebnisse = ClassWindream.GetSearchDocuments(windream_temp_search) Catch ex As Exception MsgBox("Error in windreamSucheErgebnisse:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try elapsed = sw.Elapsed.TotalSeconds If LogErrorsOnly = False Then ClassLogger.Add(" >> GetSearchDocuments took " & Format(elapsed, "0.000000000") & " seconds", False) If windreamSucheErgebnisse.Count > 0 Then Dim files_deleted As Integer = 0 For Each dok As WMObject In windreamSucheErgebnisse Dim filename = "W:" & dok.aPath Try File.Delete(filename) files_deleted = +1 Catch ex As Exception ClassLogger.Add("Unexpected Error in Delete windream-file '" & filename & "- Error: " & ex.Message) End Try Dim msg = "Es wurden (" & files_deleted.ToString & ") Dateien gelöscht!" If USER_LANGUAGE <> "de-DE" Then msg = "(" & files_deleted.ToString & ") files were deleted!" End If MsgBox(msg, MsgBoxStyle.Information) Next Else Dim msg = "Es wurden keine Dateien für diesen Datensatz gefunden!" If USER_LANGUAGE <> "de-DE" Then msg = "No files found for record!" End If MsgBox(msg, MsgBoxStyle.Information) End If Cursor = Cursors.Default Catch ex As Exception MsgBox("Error in WD-Delete Docs:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) ClassLogger.Add("Unexpected Error in Run WD Delete Docs: " & ex.Message) End Try elapsed = sw.Elapsed.TotalSeconds sw.Stop() sw.Reset() If LogErrorsOnly = False Then ClassLogger.Add(" >> Run WD Delete Docs took " & Format(elapsed, "0.000000000") & " seconds", False) Cursor = Cursors.Default End Sub Private Sub RUN_WDSEARCH_GRID() Dim sw As New Stopwatch sw.Start() Dim elapsed As Double Dim Basesearch As String Try Dim windream_temp_search If Not windream_Docshow = True Or Sett_LoadWD_Docs = False Then Exit Sub End If Cursor = Cursors.WaitCursor GridControlDocSearch.DataSource = Nothing Dim DTWD As DataTable Dim sql = "SELECT WINDREAM_SEARCH,SEARCH_PATTERN1,SEARCH_PATTERN2,SEARCH_PATTERN3,SEARCH_PATTERN4,SEARCH_PATTERN5 FROM TBPMO_FORM_VIEW WHERE WINDREAM_SEARCH <> '' AND FORM_ID = " & ENTITY_ID DTWD = ClassDatabase.Return_Datatable(sql) If DTWD.Rows.Count = 1 Then If IsDBNull(DTWD.Rows(0).Item(0)) Then Cursor = Cursors.Default Exit Sub End If Else Cursor = Cursors.Default Exit Sub End If 'Die SearchPatterns durchlaufen und zwischenspeichern If IsDBNull(DTWD.Rows(0).Item(0)) Then Cursor = Cursors.Default Exit Sub End If Basesearch = DTWD.Rows(0).Item(0) SP1 = DTWD.Rows(0).Item(1) If IsDBNull(DTWD.Rows(0).Item(2)) Then SP2 = "" Else SP2 = DTWD.Rows(0).Item(2) End If If IsDBNull(DTWD.Rows(0).Item(3)) Then SP3 = "" Else SP3 = DTWD.Rows(0).Item(3) End If If IsDBNull(DTWD.Rows(0).Item(4)) Then SP4 = "" Else SP4 = DTWD.Rows(0).Item(4) End If If IsDBNull(DTWD.Rows(0).Item(5)) Then SP5 = "" Else SP5 = DTWD.Rows(0).Item(5) End If 'Eine tempfile generieren Dim tempFilename1 = My.Computer.FileSystem.GetTempFileName() 'Nur den Filenamen ohne Erweiterung Dim tempName = Path.GetFileNameWithoutExtension(tempFilename1) 'tempfile lsöchen If My.Computer.FileSystem.FileExists(tempFilename1) Then My.Computer.FileSystem.DeleteFile(tempFilename1) End If Dim temppath = Path.GetTempPath Dim EncodingFormat As Encoding Dim WDUnicode = ClassDatabase.Execute_Scalar("SELECT WD_UNICODE FROM TBPMO_KONFIGURATION WHERE GUID = 1") If WDUnicode = True Then EncodingFormat = Encoding.GetEncoding(1252) '1252 If LogErrorsOnly = False Then ClassLogger.Add(" >> Unicode is used (Encoding.GetEncoding(1252))", False) Else If LogErrorsOnly = False Then ClassLogger.Add(" >> UTF8 (Encoding.GetEncoding(65001))", False) EncodingFormat = Encoding.GetEncoding(65001) End If Dim fileContents As String If LogErrorsOnly = False Then ClassLogger.Add(" >> ReadAlltext: " & windream_temp_search, False) fileContents = My.Computer.FileSystem.ReadAllText(Basesearch, EncodingFormat) ', System.Text.Encoding.Unicode If LogErrorsOnly = False Then ClassLogger.Add(" >> fileContents geladen", False) fileContents = fileContents.Replace("Í", "Ö") Dim _sp1 = SP1 Dim _sp2 = SP2 Dim _sp3 = SP3 Dim _sp4 = SP4 Dim _sp5 = SP5 If _sp1.ToString <> String.Empty Then _sp1 = Return_SearchPattern(_sp1.ToString) fileContents = fileContents.Replace("%pattern1%", _sp1) fileContents = fileContents.Replace("471101", _sp1) End If If _sp2.ToString <> String.Empty Then _sp2 = Return_SearchPattern(_sp2.ToString) If _sp2 = 0 Then _sp2 = "" End If fileContents = fileContents.Replace("%pattern2%", _sp2) fileContents = fileContents.Replace("471102", _sp2) End If If _sp3.ToString <> String.Empty Then _sp3 = Return_SearchPattern(_sp3.ToString) If _sp3 = 0 Then _sp3 = "" End If fileContents = fileContents.Replace("%pattern3%", _sp3) fileContents = fileContents.Replace("471103", _sp3) End If If _sp4.ToString <> String.Empty Then _sp4 = Return_SearchPattern(_sp4.ToString) If _sp4 = 0 Then _sp4 = "" End If fileContents = fileContents.Replace("%pattern4%", _sp4) fileContents = fileContents.Replace("471104", _sp4) End If If _sp5.ToString <> String.Empty Then _sp5 = Return_SearchPattern(_sp5.ToString) If _sp5 = 0 Then _sp5 = "" End If fileContents = fileContents.Replace("%pattern5%", _sp5) fileContents = fileContents.Replace("471105", _sp5) End If 'Die windream File zusammensetzen windream_temp_search = temppath & tempName & ".wdf" TEMP_FILES.Add(windream_temp_search) 'Die File schreiben My.Computer.FileSystem.WriteAllText(windream_temp_search, fileContents, False, EncodingFormat) My.Computer.FileSystem.WriteAllText(temppath & "SEARCH_COPY.wdf", fileContents, False, EncodingFormat) ' XML-Datei öffnen und laden Dim Stream As New IO.StreamReader(CStr(windream_temp_search), EncodingFormat) Dim Reader As New System.Xml.XmlTextReader(Stream) ' XML-Datei initialisieren Dim xml As New System.Xml.XmlDocument() ' XML-Datei öffnen und laden xml.Load(Reader) Reader.Close() xml.Save(windream_temp_search) If LogErrorsOnly = False Then ClassLogger.Add(" >> Xml Generiert: " & windream_temp_search, False) Dim windreamSucheErgebnisse As WINDREAMLib.WMObjects Try windreamSucheErgebnisse = ClassWindream.GetSearchDocuments(windream_temp_search) Catch ex As Exception MsgBox("Error in windreamSucheErgebnisse:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try elapsed = sw.Elapsed.TotalSeconds If LogErrorsOnly = False Then ClassLogger.Add(" >> GetSearchDocuments took " & Format(elapsed, "0.000000000") & " seconds", False) Dim DTGrid As New DataTable If windreamSucheErgebnisse.Count > 0 Then 'Es gibt Suchergebnisse Dim stg As String If USER_LANGUAGE = "de-DE" Then stg = "windream-Dateien" Else stg = "windream-files" End If TabWindream.Text = stg & " (" & windreamSucheErgebnisse.Count & ")" Dim sql_ResultList = "select * from TBPMO_WINDREAM_RESULTLIST_CONFIG where guid = 2" Dim DT As DataTable = ClassDatabase.Return_Datatable(sql_ResultList, "GET RESULTLIST KONFIG") Dim ColArray As New List(Of String) Try 'Die Icon Colum erstellen und konfigurieren Dim colIcon As New System.Data.DataColumn() colIcon.DataType = GetType(Image) colIcon.ColumnName = "ICON" colIcon.Caption = "" DTGrid.Columns.Add(colIcon) ' Dim colPath As New System.Data.DataColumn() colPath.DataType = GetType(String) colPath.ColumnName = "FULLPATH" colPath.Caption = "Fullpath" DTGrid.Columns.Add(colPath) If Not DT Is Nothing And DT.Rows.Count = 1 Then Dim ColCount As Integer = 1 For Each Column As DataColumn In DT.Columns If Column.ColumnName.StartsWith("COLUMN") And Column.ColumnName.EndsWith("WIDTH") = False Then Dim sql1 = String.Format("select {0} from TBPMO_WINDREAM_RESULTLIST_CONFIG Where GUID = 2", Column.ColumnName) Dim ColumnName = ClassDatabase.Execute_Scalar(sql1, True) If Not IsDBNull(ColumnName) Then If Not IsDBNull(ColumnName) Or IsNothing(ColumnName) Or ColumnName <> "" Or ColumnName <> "{}" Then 'Jetzt die Spalten aus Array hinzufügen und Breite konfigurieren sql1 = String.Format("select COLUMN{0}_WIDTH from TBPMO_WINDREAM_RESULTLIST_CONFIG Where GUID = 2", ColCount) Dim Width = ClassDatabase.Execute_Scalar(sql1, True) If IsNothing(Width) Or IsDBNull(Width) Then Width = 200 End If 'Die Spalte definieren DTGrid.Columns.Add(ColumnName) ColCount += 1 End If End If End If Next 'Jetzt das Array zusammenbauen um die Spaltenwerte zu erhalten ColCount = 1 For Each Column As DataColumn In DT.Columns If Column.ColumnName = String.Format("COLUMN{0}", ColCount) Then Dim sql1 = String.Format("select {0} from TBPMO_WINDREAM_RESULTLIST_CONFIG Where GUID = 2", Column.ColumnName) Dim ColumnName = ClassDatabase.Execute_Scalar(sql1, True) If Not IsDBNull(ColumnName) Then If Not IsDBNull(ColumnName) Or IsNothing(ColumnName) Or ColumnName <> "" Or ColumnName <> "{}" Then 'Jetzt die Spalten aus Array hinzufügen und Breite konfigurieren ColArray.Add(Column.ColumnName) End If End If ColCount += 1 End If Next End If Catch ex As Exception MsgBox("Unexpected Error in Construct Datatable for GridResult: " & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try If DTGrid.Columns.Count > 0 Then If LogErrorsOnly = False Then ClassLogger.Add(" >> Datatable Grid created!", False) 'Alle gefundenen Dateien durchlaufen For Each dok As WMObject In windreamSucheErgebnisse Dim fullpath = "W:" & dok.aPath Dim Folderpath = Path.GetDirectoryName(fullpath) Dim filename = Path.GetFileName(fullpath) Dim extension = Path.GetExtension(fullpath) Try Dim NewRow As DataRow NewRow = DTGrid.NewRow() 'Icon zuweisen Select Case extension Case ".csv" Case ".txt" NewRow.Item(0) = My.Resources.text Case ".pdf" NewRow.Item(0) = My.Resources.pdf Case ".doc" NewRow.Item(0) = My.Resources.doc Case ".docx" NewRow.Item(0) = My.Resources.doc Case ".xls" NewRow.Item(0) = My.Resources.xls Case ".xlsx" NewRow.Item(0) = My.Resources.xls Case ".ppt" NewRow.Item(0) = My.Resources.ppt Case ".pptx" NewRow.Item(0) = My.Resources.ppt Case Else NewRow.Item(0) = My.Resources._blank End Select 'Den Filepath mitgeben NewRow.Item(1) = fullpath Dim i = 2 'Fängt bei 2 an, um die ICON Column zu überspringen For Each Column As String In ColArray Dim Indexname = DT.Rows(0).Item(Column) Dim idxvalue Try If Indexname.ToString.ToUpper = "Dateiname".ToUpper Then idxvalue = filename Else 'windream-Indexwert holen idxvalue = dok.GetVariableValue(Indexname) End If If LogErrorsOnly = False Then ClassLogger.Add(" >> idxvalue from windream: '" & idxvalue.ToString & "'", False) Catch ex As Exception ClassLogger.Add("Unexpected Error in GetVariableValue for Index '" & Indexname & "- Error: " & ex.Message) If Indexname.ToString.StartsWith("Doct") Or Indexname.ToString.StartsWith("Dokum") Then idxvalue = "" Else idxvalue = "Error getting indexvalue" End If End Try NewRow.Item(i) = idxvalue.ToString i += 1 Next DTGrid.Rows.Add(NewRow) Catch ex As Exception ClassLogger.Add("Unexpected Error in CreateRow for doc '" & filename & "- Error: " & ex.Message) End Try Next End If If DTGrid.Rows.Count > 0 Then GridControlDocSearch.DataSource = DTGrid GridViewDoc_Search.Columns.Item(0).MaxWidth = 24 GridViewDoc_Search.Columns.Item(0).MinWidth = 24 grvwGrid.Columns.Item(1).Visible = False End If Else Dim msg = "Windream-Dokumente für Record: " & RECORD_ID & " - Keine Dateien gefunden" If USER_LANGUAGE <> "de-DE" Then msg = "windream-files for record: " & RECORD_ID & " - no files found" End If tslblWindreamView.Text = "Windream-Dokumente für Record: " & RECORD_ID & " - Keine Dateien gefunden" 'Clear_Windream_ResultList() End If Cursor = Cursors.Default Catch ex As Exception MsgBox("Error in RUN_WDSEARCH_GRID:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) ClassLogger.Add("Unexpected Error in RUN_WDSEARCH_GRID: " & ex.Message) End Try elapsed = sw.Elapsed.TotalSeconds sw.Stop() sw.Reset() If LogErrorsOnly = False Then ClassLogger.Add(" >> Run RUN_WDSEARCH_GRID took " & Format(elapsed, "0.000000000") & " seconds", False) Cursor = Cursors.Default End Sub Private Function Return_SearchPattern(ByVal content As String) Select Case content.ToUpper Case "@Record-ID".ToUpper Return RECORD_ID Case "@EntityID".ToUpper Return ENTITY_ID Case "@ParentID".ToUpper Return PARENT_RECORDID Case Else MsgBox("Undefined pattern '" & content & "' in windream-Search Config. Please inform Your system-administrator.", MsgBoxStyle.Exclamation) ClassLogger.Add(" >> Undefined Search-pattern in windream-search config: " & content, True) End Select End Function Private Sub AxObjectListControl_ItemClicked(sender As Object, e As EventArgs) Handles AxObjectListControl.ItemClicked CheckDocView() End Sub Sub Clear_Windream_ResultList() Try Dim sw As New Stopwatch sw.Start() AxObjectListControl.RemoveAllColumnHeader() Me.AxObjectListControl.ClearResultList() Dim stg As String = "windream-Dateien" If USER_LANGUAGE <> "de-DE" Then stg = "windream-files" End If TabWindream.Text = stg Dim elapsed As Double elapsed = sw.Elapsed.TotalSeconds sw.Stop() sw.Reset() If LogErrorsOnly = False Then ClassLogger.Add(" >> Clear Result List took " & Format(elapsed, "0.000000000") & " seconds", False) Catch ex As Exception MsgBox("Unexpected Error in Clear Result List:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub Sub CheckDocView() Dim _index = AxObjectListControl.GetFirstSelectedObject Dim path As String = AxObjectListControl.GetObjectPath(_index) path = path.Replace("?", vWLaufwerk) DocViewString = path If WD_ShowDocs = True Then CloseWDDocview() ShowDocView() End If End Sub Sub ShowDocView() Try CloseWDDocview() DocView = Nothing DocView = CreateObject("WMPViewXNG.Viewer") ' open the viewer DocView.ViewFile(DocViewString) OpenedFileString = DocViewString Catch ex As Exception MsgBox("Error in ShowDocView:" & vbNewLine & ex.Message, MsgBoxStyle.Exclamation) End Try End Sub Sub CloseWDDocview() Try If DocView Is Nothing = False Then DocView.CloseView(OpenedFileString, 0) End If Catch ex As Exception ClassLogger.Add(" ### Error in CloseDocView") ClassLogger.Add("### " & ex.Message & " ###") End Try End Sub #End Region #Region "GridViews" Private Sub ButtonQuickViewCarousel_Click(sender As Object, e As EventArgs) Handles ButtonQuickViewCarousel.Click GRID_TYPE = GridType.Carousel VIEW_ID_RUNTIME = 2 GRID_TYPE_ID = 2 grvwCarousel.OptionsView.ViewMode = DevExpress.XtraGrid.Views.Layout.LayoutViewMode.Carousel GridControlMain.MainView = grvwCarousel Load_Tree_View_Data() End Sub Private Sub ButtonQuickViewTiles_Click(sender As Object, e As EventArgs) Handles ButtonQuickViewTiles.Click GRID_TYPE = GridType.Tiles VIEW_ID_RUNTIME = 1 GRID_TYPE_ID = 1 GridControlMain.MainView = grvwTiles Load_Tree_View_Data() End Sub Private Sub ButtonDetailView_Click(sender As Object, e As EventArgs) Handles ButtonDetailView.Click GRID_TYPE = GridType.Grid VIEW_ID_RUNTIME = 3 GRID_TYPE_ID = 3 GridControlMain.MainView = grvwGrid Load_Tree_View_Data() End Sub Private Sub ButtonSetViewAsDefault_Click(sender As Object, e As EventArgs) Handles ButtonSetViewAsDefault.Click Dim VIEWTYPE_ID As Integer Select Case GRID_TYPE Case GridType.Tiles VIEWTYPE_ID = 1 Case GridType.Carousel VIEWTYPE_ID = 2 Case GridType.Grid VIEWTYPE_ID = 3 End Select Dim upd = String.Format("UPDATE TBPMO_USER_CONSTR_VIEW_TYPE SET VIEW_ID = {0} WHERE CONSTRUCTOR_DETAIL_ID = {1} AND [ENTITY_ID] = {2} AND USER_ID = {3}", VIEWTYPE_ID, CURRENT_CONSTRUCTOR_DETAIL_ID, ENTITY_ID, USER_GUID) If ClassDatabase.Execute_non_Query(upd, True) = True Then ' VIEW_ID Override zurücksetzen!! VIEW_ID_RUNTIME = -1 MsgBox("Stanard-View was saved successfully!", MsgBoxStyle.Information) End If End Sub Private Sub ButtonResetView_Click(sender As Object, e As EventArgs) Handles ButtonResetView.Click ' TODO: Ansicht zurücksetzen Try Dim XMLPath = Get_Grid_Layout_Filename() If File.Exists(XMLPath) Then File.Delete(XMLPath) Load_Entity_Data(ACT_EBENE) End If Catch ex As Exception MsgBox("Error in Reset Layout Grid: " & vbNewLine & ex.Message) End Try End Sub #End Region Private Sub TCDetails_DragDrop(sender As Object, e As DragEventArgs) Handles TCDetails.DragDrop Drag_Drop(e) End Sub Private Sub TCDetails_SelectedPageChanged(sender As Object, e As DevExpress.XtraTab.TabPageChangedEventArgs) Handles TCDetails.SelectedPageChanged Update_Status_Label(False, "") tsButtonEdit.Enabled = True If TCDetails.SelectedTabPage.Text.ToLower.StartsWith("pos") Then tsButtonEdit.Enabled = False Load_Pos_Data() Load_POSGrid_Layout() End If If TCDetails.SelectedTabPage.Text.ToLower.StartsWith("windr") Then tsButtonEdit.Enabled = False If RECORD_ID = 0 Then RUN_WD_SEARCH(WD_Suche, "ENTITY") Else ' RUN_WD_SEARCH(WD_Suche, "RECORD") RUN_WDSEARCH_GRID() End If End If If TCDetails.SelectedTabPage.Text.ToLower.StartsWith("wieder") Or TCDetails.SelectedTabPage.Text.ToLower.StartsWith("follo") Then tsButtonEdit.Enabled = False Refresh_FollowUps() dtpFollowUp.Enabled = False lblWiedervorlage_Control.Text = "<< Waiting for Selection:" 'Check_FOLLOWUP_IsConfigured(ENTITY_ID) End If Select Case TCDetails.SelectedTabPageIndex Case 0 'If RECORD_NEEDS_REFRESH = True Then ' ClassControlValues.LoadControlValues(RECORD_ID, ENTITY_ID, CtrlBuilder.AllControls) ' ' UpdRECORD_NEEDS_REFRESH(False) 'End If 'Refresh_CreatedChangedRecordByID(RECORD_ID) ' RECORD_CHANGED = False Case 1 'windream-Dokumente Case 2 'Refresh_FollowUps() End Select End Sub Private Sub Refresh_FollowUps() Try If DT_FU_ENTITY.Rows.Count > 0 Then grpbxFU_Profile.Enabled = True End If Catch ex As Exception MsgBox("Error in Refresh_FollowUps:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub #Region "Dropping Files" Sub Drag_Enter(e As DragEventArgs) If act_FormViewID <> 0 Then ClassDragDrop.Drag_enter(e) End If End Sub Sub Drag_Drop(e As DragEventArgs) If act_FormViewID <> 0 And RIGHT_ONLY_READ = False Then Dim sql = "select count(*) from VWPMO_DOKUMENTTYPES where FORMVIEW_ID = " & FORMVIEW_ID If ClassDatabase.Execute_Scalar(sql, True) = 0 Then MsgBox("No documenttypes for this entity configured! Indexing is not possible!" & vbNewLine & "Please check the configuration!", MsgBoxStyle.Exclamation) Exit Sub End If If RECORD_CHANGED = True Then If Save_Record() = False Then Exit Sub End If End If CURRENT_CONTROL_DOCTYPE_MATCH = 0 If CONTROL_DOCTYPE_MATCH <> 0 Then Try CURRENT_CONTROL_DOCTYPE_MATCH = "" CURRENT_CONTROL_DOCTYPE_MATCH = ClassControlValues.GetControlValuesREC_CONTROL(RECORD_ID, CONTROL_DOCTYPE_MATCH) Catch ex As Exception CURRENT_CONTROL_DOCTYPE_MATCH = 0 CURRENT_CONTROL_DOCTYPE_MATCH = "" End Try End If If e.Data.GetDataPresent(DataFormats.StringFormat) Then Dim Wert As String = CType(e.Data.GetData(DataFormats.StringFormat), Object) Console.WriteLine("DragDrop-Wert: " & Wert) If Wert.Contains("SCAN") Then Dim split() = Wert.Split(";") If IsNumeric(split(1)) Then CURRENT_FILEID = split(1) CURRENT_PARENT_ID = PARENT_ID CURRENT_RECORD_ID = RECORD_ID CURRENT_FORMVIEW_ID = FORMVIEW_ID frmWD_Index_Dokart.ShowDialog() RUN_WDSEARCH_GRID() 'RUN_WD_SEARCH(WD_Suche, "RECORD") End If ElseIf (e.Data.GetDataPresent("FileGroupDescriptor")) AndAlso (e.Data.GetDataPresent("FileContents")) Then CURRENT_RECORD_ID = RECORD_ID If ClassDragDrop.Drop_File(e) = True Then Check_Dropped_Files() End If ElseIf e.Data.GetDataPresent("FileGroupDescriptor") Then CURRENT_RECORD_ID = RECORD_ID If ClassDragDrop.Drop_File(e) = True Then Check_Dropped_Files() End If End If Else CURRENT_RECORD_ID = RECORD_ID If ClassDragDrop.Drop_File(e) = True Then Check_Dropped_Files() End If End If Else If RIGHT_ONLY_READ = True Then ClassLogger.Add(">> RIGHT_ONLY_READ is set! No DragDrop allowed", False) End If End If End Sub Sub Check_Dropped_Files() Try If RECORD_CHANGED = True Then If Save_Record() = False Then Exit Sub End If End If If RECORD_ID = 0 Then MsgBox("Please choose a record!", MsgBoxStyle.Information) Exit Sub End If For Each Str As Object In ClassDragDrop.files_dropped If Not IsNothing(Str) Then Dim DropType = Str.Substring(0, Str.LastIndexOf("@") + 1) If DropType.ToString.Contains("SCAN") = False Then ClassLogger.Add(">> Check_Dropped_Files:" & Str.ToString, False) Dim CURRENT_WORKFILE = Str.Substring(Str.LastIndexOf("@") + 1) TBPMO_FILES_USERTableAdapter.cmdInsert(CURRENT_WORKFILE, Environment.UserName, DropType) End If End If Next Dim sql = "select count(*) from VWPMO_DOKUMENTTYPES where FORMVIEW_ID = " & FORMVIEW_ID If ClassDatabase.Execute_Scalar(sql, True) >= 1 Then Dim sql1 = String.Format("SELECT GUID, FILENAME2WORK, USER_WORK, HANDLE_TYPE, WORKED, ADDED_WHEN FROM TBPMO_FILES_USER WHERE (UPPER(USER_WORK) = UPPER('{0}')) AND WORKED = 0", Environment.UserName) Dim DT As DataTable = ClassDatabase.Return_Datatable(sql1) If Not IsNothing(DT) Then If DT.Rows.Count > 0 Then For Each Filerow As DataRow In DT.Rows 'Dim datei = Str.ToString.Replace("@DROPFROMFSYSTEM@", "") CURRENT_FILEID = Filerow.Item(0) CURRENT_PARENT_ID = PARENT_ID CURRENT_RECORD_ID = RECORD_ID CURRENT_FORM_ID = ENTITY_ID CURRENT_FORMVIEW_ID = FORMVIEW_ID If ClassDatabase.Execute_Scalar("SELECT COUNT(*) FROM TBPMO_FILES_USER WHERE GUID = " & CURRENT_FILEID & " AND WORKED = 0") = 1 Then frmWD_Index_Dokart.ShowDialog() Else If LogErrorsOnly = False Then ClassLogger.Add(" >> File was deleted or worked meanwhile!") End If Next RUN_WDSEARCH_GRID() ' RUN_WD_SEARCH(WD_Suche, "RECORD") End If End If Else MsgBox("No documenttypes for this entity configured! Indexing is not possible!" & vbNewLine & "Please check the configuration!", MsgBoxStyle.Exclamation) Exit Sub End If Catch ex As Exception MsgBox("Check_Dropped_Files: " & ex.Message, MsgBoxStyle.Critical) End Try End Sub Private Sub GridControlMain_DragEnter(sender As Object, e As DragEventArgs) Handles GridControlMain.DragEnter Drag_Enter(e) End Sub Private Sub pnlDetails_DragEnter(sender As Object, e As DragEventArgs) Handles pnlDetails.DragEnter Drag_Enter(e) End Sub Private Sub GridControlMain_DragDrop(sender As Object, e As DragEventArgs) Handles GridControlMain.DragDrop Drag_Drop(e) End Sub Private Sub pnlDetails_DragDrop(sender As Object, e As DragEventArgs) Handles pnlDetails.DragDrop Drag_Drop(e) End Sub Private Sub TCDetails_DragEnter(sender As Object, e As DragEventArgs) Handles TCDetails.DragEnter Drag_Enter(e) End Sub #End Region #Region "Follow Up" Private Sub ListViewFollowUps_SelectedIndexChanged(sender As Object, e As EventArgs) Handles ListViewFollowUps.SelectedIndexChanged If Me.ListViewFollowUps.SelectedItems.Count > 0 Then dtpFollowUp.Enabled = False FOLL_UP_ID = ListViewFollowUps.SelectedItems(0).Text lblFollowUp_save.Visible = False For Each DR As DataRow In DT_FU_ENTITY.Rows If FOLL_UP_ID = DR.Item("GUID") Then grpbxFU_Profile.Enabled = True FOLL_UP_DATE_CTRL_ID = DR.Item("DEPENDENT_DATE_CTRL_ID") Dim datevalue = ClassControlValues.Get_Control_Value_for_ID(DR.Item("DEPENDENT_DATE_CTRL_ID"), RECORD_ID) If Not IsNothing(datevalue) Then dtpFollowUp.Enabled = True If datevalue = "00:00:00" Then dtpFollowUp.Value = CDate(Now) End If FOLL_UP_RECORD_DEFINED = True Try dtpFollowUp.Value = CDate(datevalue) Catch ex As Exception dtpFollowUp.Value = CDate(Now) End Try Else dtpFollowUp.Value = CDate(Now) FOLL_UP_RECORD_DEFINED = False End If Dim caption = ClassDatabase.Execute_Scalar("SELECT COL_NAME FROM TBPMO_CONTROL WHERE GUID = " & DR.Item("DEPENDENT_DATE_CTRL_ID"), True) If Not IsNothing(caption) Then lblWiedervorlage_Control.Text = CStr(caption) Else lblWiedervorlage_Control.Text = "Wiedervorlage:" End If FOLL_UP_DONE_CTRL_ID = DR.Item("DEPENDENT_DONE_CTRL_ID") Dim checkvalue = ClassControlValues.Get_Control_Value_for_ID(DR.Item("DEPENDENT_DONE_CTRL_ID"), RECORD_ID) If Not IsNothing(checkvalue) Then chkFollowUp.Checked = CBool(checkvalue) Else chkFollowUp.Checked = False End If Dim SQL = String.Format("SELECT GUID FROM TBPMO_CONTROL_SCREEN WHERE CONTROL_ID = {0} AND SCREEN_ID = {1}", DR.Item("DEPENDENT_DONE_CTRL_ID"), CURRENT_SCREEN_ID) Dim ctrl_screen_id = ClassDatabase.Execute_Scalar(SQL, True) If ctrl_screen_id > 0 Then SQL = String.Format("SELECT CAPTION FROM TBPMO_CONTROL_LANGUAGE WHERE CONTROL_SCREEN_ID = {0} AND LANGUAGE_TYPE = '{2}'", ctrl_screen_id, USER_LANGUAGE) Dim captionCheck = ClassDatabase.Execute_Scalar(SQL, True) If Not IsNothing(captionCheck) Then chkFollowUp.Text = CStr(captionCheck) End If End If Load_FUUser(FOLL_UP_ID) End If Next End If End Sub Sub Load_FUUser(ID As Integer) Try Dim sql = "SELECT T.GUID, T1.USERNAME FROM TBPMO_FOLLUPEMAIL_RECORD T, TBDD_USER T1 WHERE T.USER_ID = T1.GUID AND T.FOLLOW_UP_ID = " & ID & " AND T.RECORD_ID = " & RECORD_ID & " ORDER BY T1.USERNAME" Dim DT As DataTable = ClassDatabase.Return_Datatable(sql, "Load_FollowUpUser") ListBoxUser2Profile.DataSource = DT ListBoxUser2Profile.DisplayMember = DT.Columns(1).ColumnName ListBoxUser2Profile.ValueMember = DT.Columns(0).ColumnName Catch ex As Exception MsgBox("Error in Load Follow Up User:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub Private Sub dtpWV_ValueChanged(sender As Object, e As EventArgs) Handles dtpFollowUp.ValueChanged If ENTITY_LOADED = False = False Then Exit Sub End If If ClassControlCommandsUI.UpdateControlValue(FOLL_UP_DATE_CTRL_ID, RECORD_ID, dtpFollowUp.Value) = True Then lblFollowUp_save.Text = "Follow Up saved - " & Now.ToString lblFollowUp_save.Visible = True 'UpdRECORD_NEEDS_REFRESH(True) Else lblFollowUp_save.Visible = False 'UpdRECORD_NEEDS_REFRESH(False) End If End Sub Private Sub chkFollowUp_CheckedChanged(sender As Object, e As EventArgs) Handles chkFollowUp.CheckedChanged If ENTITY_LOADED = False Then Exit Sub End If If ClassControlCommandsUI.UpdateControlValue(FOLL_UP_DONE_CTRL_ID, RECORD_ID, chkFollowUp.Checked.ToString) = True Then lblFollowUp_save.Text = "Follow Up saved - " & Now.ToString lblFollowUp_save.Visible = True ' UpdRECORD_NEEDS_REFRESH(True) Else lblFollowUp_save.Visible = False 'UpdRECORD_NEEDS_REFRESH(False) End If End Sub Private Function Check_FOLLOWUP_IsConfigured(ENTITY_ID As Integer) Try Dim sql = "select * from TBPMO_FOLLOW_UP_EMAIL t where t.ACTIVE = 1 and t.DEPENDENT_DATE_CTRL_ID in (select guid from TBPMO_CONTROL where CONTROL_TYPE_ID = 4 and form_id = " & ENTITY_ID & ")" DT_FU_ENTITY = ClassDatabase.Return_Datatable(sql) If DT_FU_ENTITY.Rows.Count > 0 Then 'Die Userauswahl füllen Dim DTUser As DataTable = ClassDatabase.Return_Datatable("select guid, username from TBDD_USER t where T.EMAIL IS NOT NULL AND MODULE_RECORD_ORG = 1 order by USERNAME") cmbFollowUpUser.DataSource = DTUser cmbFollowUpUser.DisplayMember = DTUser.Columns(1).ColumnName cmbFollowUpUser.ValueMember = DTUser.Columns(0).ColumnName TabFollowUp.PageVisible = True FOLLOW_UPisActive = True 'Die Wiedervorlageprofile in den Listview laden ListViewFollowUps.Items.Clear() Dim anz As Integer = 0 For Each DR As DataRow In DT_FU_ENTITY.Rows Dim name = DR.Item("NAME") ListViewFollowUps.Items.Add(DR.Item("GUID")) ListViewFollowUps.Items(anz).SubItems.Add(name) anz += 1 Next Else FOLLOW_UPisActive = False TabFollowUp.PageVisible = False End If Catch ex As Exception MsgBox("Error in Check Follow Up:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) windream_Docshow = False End Try End Function #End Region #Region "Tasks" Private Sub tsButtonShowWorkflowTasks_Click(sender As Object, e As EventArgs) Handles tsButtonShowWorkflowTasks.Click If RECORD_ID > 0 Then CURRENT_RECORD_ID = RECORD_ID CURRENT_FORM_ID = ENTITY_ID frmTask_Editor.ShowDialog() Show_act_WFTask() Refresh_TaskOverview() End If End Sub Private Sub tsButtonShowTaskOverview_Click(sender As Object, e As EventArgs) Handles tsButtonShowTaskOverview.Click frmTask_Overview.Show() End Sub Sub Refresh_TaskOverview() Dim frmCollection As New FormCollection() frmCollection = Application.OpenForms() If frmTask_Overview.IsHandleCreated Then If Sett_TaskOverviewKeepInFront = True Then frmTask_Overview.Refresh() End If 'Else ' Console.WriteLine("frmTaskOverview NICHT geladen") End If End Sub Sub Show_act_WFTask() Try Me.VWPMO_WF_ACTIVETableAdapter.FillByRecord(Me.DD_DMSDataSet.VWPMO_WF_ACTIVE, USER_LANGUAGE, Environment.UserName, RECORD_ID) tsslblWorkflowstate.BackColor = Color.Black If DD_DMSDataSet.VWPMO_WF_ACTIVE.Rows.Count > 0 Then CURRENT_TASK_ID = Me.DD_DMSDataSet.VWPMO_WF_ACTIVE.Rows(0).Item("WF_TASK_ID") Dim text = "Task: " & Me.DD_DMSDataSet.VWPMO_WF_ACTIVE.Rows(0).Item("WF_TITLE") text += " - " & Me.DD_DMSDataSet.VWPMO_WF_ACTIVE.Rows(0).Item("STATE_TITLE") text += " - " & Me.DD_DMSDataSet.VWPMO_WF_ACTIVE.Rows(0).Item("DUE_DATE") tsslblWorkflowstate.Text = text tsslblWorkflowstate.Visible = True tsButtonShowWorkflowTasks.Visible = True tsButtonShowWorkflowTasks.Enabled = True Dim Colorstring = Me.DD_DMSDataSet.VWPMO_WF_ACTIVE.Rows(0).Item("COLOR") If IsDBNull(Colorstring) Then Exit Sub End If If Colorstring <> "" Then 'grvwSelection.Appearance.FocusedRow.BackColor = ColorTranslator.FromWin32(CInt(Colorstring)) 'grvwSelection.Appearance.FocusedRow.ForeColor = Color.Yellow tsslblWorkflowstate.BackColor = ColorTranslator.FromWin32(CInt(Colorstring)) Select Case tsslblWorkflowstate.BackColor Case Color.Red tsslblWorkflowstate.ForeColor = Color.White End Select End If Else tsslblWorkflowstate.Visible = False tsButtonShowWorkflowTasks.Visible = False ' grvwSelection.Appearance.FocusedRow.BackColor = Color.Fuchsia End If Dim sql1 As String = "SELECT COUNT(*) FROM TBPMO_WORKFLOW_ENTITY_STATE where ENTITY_ID = @ID" sql1 = sql1.Replace("@ID", ENTITY_ID) Dim result As Integer = ClassDatabase.Execute_Scalar(sql1) If result > 0 Then tsButtonShowWorkflowTasks.Visible = True tsButtonShowWorkflowTasks.Enabled = True End If Catch ex As Exception MsgBox("Error in Show act WFTask: " & ex.Message, MsgBoxStyle.Critical) End Try End Sub #End Region Private Sub ResetEbenenAuswahlToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles ResetEbenenAuswahlToolStripMenuItem.Click ACT_EBENE = 0 ACT_EBENE_STRING = "" EBENE1_ENTITY = "" EBENE1_RECID = 0 EBENE2_ENTITY = "" EBENE2_RECID = 0 EBENE3_ENTITY = "" EBENE3_RECID = 0 NavPane.Categories.Clear() Load_Tree_View(CONSTRUCTORID) End Sub Private Sub DateiimportEntitätToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles DateiimportEntitätToolStripMenuItem.Click If PARENT_ID = 0 Then Exit Sub End If CURRENT_ENTITYSTRING = _ENTITYSTRING CURRENT_FORM_ID = ENTITY_ID frmWD_EntityImport.ShowDialog() End Sub Private Sub WindreamsucheNeuLadenToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles WindreamsucheNeuLadenToolStripMenuItem.Click RUN_WDSEARCH_GRID() ' RUN_WD_SEARCH(WD_Suche, "RECORD") End Sub Private Sub WorkflowTasksNeuErstellenToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles WorkflowTasksNeuErstellenToolStripMenuItem.Click Dim result As MsgBoxResult Dim stg As String If USER_LANGUAGE = "de-DE" Then stg = "Wollen Sie die Workflowtasks für diesen record neu erzeugen? Die alten werden gelöscht?" Else stg = "Do You really want to create the workflowtasks new?" End If result = MessageBox.Show(stg, "Confirmation needed:", MessageBoxButtons.YesNo, MessageBoxIcon.Question) If result = MsgBoxResult.Yes Then Try CURRENT_FORM_ID = ENTITY_ID Dim sql = "EXEC PRPMO_CREATE_WF_TASKS " & CURRENT_FORM_ID & " " & RECORD_ID If ClassDatabase.Execute_non_Query(sql) Then Show_act_WFTask() End If Catch ex As Exception MsgBox("Unexpected Error in Create Workflowtasks Record: " & ex.Message, MsgBoxStyle.Critical) End Try End If End Sub Private Sub ZeigeRecordLogsToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles ZeigeRecordLogsToolStripMenuItem.Click CURRENT_RECORD_ID = RECORD_ID frmRecord_Changes.ShowDialog() End Sub Private Sub FormDesignerToolStripMenuItem1_Click(sender As Object, e As EventArgs) Handles FormDesignerToolStripMenuItem.Click Try Dim SelectedNode As TreeNode = TryCast(TreeViewMain.SelectedNode, TreeNode) If SelectedNode IsNot Nothing Then Dim FormId As Integer = SelectedNode.Tag If FormId > 0 Then CURRENT_FORM_ID = FormId OpenFormLevelDesigner() End If End If Catch ex As Exception MsgBox("Unexpected Error in Open Designer: " & ex.Message, MsgBoxStyle.Critical) End Try End Sub Private Sub ButtonExportToExcel_Click(sender As Object, e As EventArgs) Handles ButtonExportToExcel.Click Dim saveFileDialog1 As New SaveFileDialog saveFileDialog1.Filter = "Excel File|*.xlsx" saveFileDialog1.Title = "Export to Excel:" saveFileDialog1.ShowDialog() If saveFileDialog1.FileName <> "" Then Cursor = Cursors.WaitCursor GridControlMain.MainView.ExportToXlsx(saveFileDialog1.FileName) Dim result As MsgBoxResult Dim msg = String.Format("Datei wurde erstellt! Wollen Sie diese nun öffnen?") If USER_LANGUAGE <> "de-DE" Then msg = String.Format("File was created. Do You want to open excel?") End If result = MessageBox.Show(msg, "Exporting result:", MessageBoxButtons.YesNo, MessageBoxIcon.Question) If result = MsgBoxResult.Yes Then Process.Start(saveFileDialog1.FileName) End If End If Cursor = Cursors.Default End Sub Private Sub frmForm_Constructor_Main_Shown(sender As Object, e As EventArgs) Handles Me.Shown Dim sw As Stopwatch = Stopwatch.StartNew() Dim elapsed As Double Me.BringToFront() ' LoadLayouts() Load_Level1() Jump_Record() sw.Stop() elapsed = sw.Elapsed.TotalSeconds If LogErrorsOnly = False Then ClassLogger.Add(String.Format(" >> Form Shown took {0} to load", Format(elapsed, "0.000000000") & " seconds"), False) End Sub Sub Jump_Record() Try Dim sw As Stopwatch = Stopwatch.StartNew() Dim elapsed As Double If LogErrorsOnly = False Then ClassLogger.Add(" >> " & Now.ToString & " Jump_Record", False) If JUMP_RECORD_ID > 0 Then Dim sql = String.Format("SELECT FORM_ID FROM TBPMO_RECORD WHERE GUID = {0}", JUMP_RECORD_ID) Dim FormID = ClassDatabase.Execute_Scalar(sql, True) If FormID > 0 Then Dim n As TreeNode For Each n In TreeViewMain.Nodes CheckNode(n, FormID) Next End If End If elapsed = sw.Elapsed.TotalSeconds sw.Stop() If LogErrorsOnly = False Then ClassLogger.Add(String.Format(" >> Jump_Record took {0} to load", Format(elapsed, "0.000000000") & " seconds"), False) Catch ex As Exception MsgBox("Unexpected error in jump-Record: " & ex.Message, MsgBoxStyle.Critical) End Try End Sub Private Sub CheckNode(ByVal n As TreeNode, FormID As Integer) Dim aNode As TreeNode For Each aNode In n.Nodes If aNode.Tag = FormID Then 'Gefunden also selektieren TreeViewMain.SelectedNode = aNode TreeViewMain.SelectedNode.EnsureVisible() TreeViewMain.Select() 'Für Grid filtern wir die Aktuelle Ansicht nach der Record-ID, 'für Carousel und Tiles markieren wir den Record LocateRecordById(JUMP_RECORD_ID) ' Jump Record-ID wieder zurücksetzen JUMP_RECORD_ID = 0 Exit For Exit Sub End If CheckNode(aNode, FormID) Next End Sub Public Sub LocateRecordById(RecordId As Integer) If GRID_TYPE = GridType.Grid Then Dim rowHandle = grvwGrid.LocateByValue(0, grvwGrid.Columns("Record-ID"), RecordId) grvwGrid.FocusedRowHandle = rowHandle ElseIf GRID_TYPE = GridType.Carousel Then Dim rowHandle = grvwCarousel.LocateByValue(0, grvwCarousel.Columns("Record-ID"), RecordId) grvwCarousel.FocusedRowHandle = rowHandle ElseIf GRID_TYPE = GridType.Tiles Then Dim rowHandle = grvwTiles.LocateByValue(0, grvwTiles.Columns("Record-ID"), RecordId) grvwTiles.FocusedRowHandle = rowHandle End If End Sub Sub Load_Templates() Try Dim sql As String = "SELECT * FROM VWPMO_TEMPLATE_ENTITY WHERE ENTITY_ID = " & ENTITY_ID & " ORDER BY TEMPLATE_NAME" Dim DT As DataTable = ClassDatabase.Return_Datatable(sql, "Load_Templates") If Not IsNothing(DT) Then If DT.Rows.Count > 0 Then OfficeVorlagenToolStripMenuItem.Enabled = True OfficeVorlagenToolStripMenuItem.DropDownItems.Clear() For Each row As DataRow In DT.Rows Dim item As ToolStripMenuItem = OfficeVorlagenToolStripMenuItem Dim newItem As ToolStripMenuItem = New ToolStripMenuItem(row.Item("TEMPLATE_NAME").ToString, Nothing, AddressOf TemplateItem_Click) newItem.Tag = row.Item("TEMPLATE_ID") item.DropDownItems.Add(newItem) ' subitem.DropDownItems.Add(newItem) Next Else OfficeVorlagenToolStripMenuItem.Enabled = False End If End If Catch ex As Exception MsgBox("Error in Load_Templates:" & vbNewLine & ex.Message, MsgBoxStyle.Exclamation) End Try End Sub Private Sub TemplateItem_Click(sender As Object, e As EventArgs) Dim item As ToolStripMenuItem = DirectCast(sender, ToolStripMenuItem) Dim TemplateID As Integer = Integer.Parse(item.Tag) If RECORD_ID > 0 Then Dim SOLLENTITY_ID = ClassDatabase.Execute_Scalar("SELECT ENTITY_ID FROM VWPMO_TEMPLATE_ENTITY WHERE TEMPLATE_ID = " & TemplateID) Dim REC_ENTITY_ID = ClassDatabase.Execute_Scalar("SELECT FORM_ID FROM TBPMO_RECORD WHERE GUID = " & RECORD_ID) If Not IsNothing(SOLLENTITY_ID) Then If CInt(SOLLENTITY_ID) = REC_ENTITY_ID Then Cursor = Cursors.WaitCursor If ClassOfficeTemplate.Open_Word_Template(TemplateID, RECORD_ID) = True Then RUN_WDSEARCH_GRID() ' RUN_WD_SEARCH(WD_Suche, "RECORD") Update_Status_Label(True, "Template file imported to windream", EditState.Insert) End If Cursor = Cursors.Default Else Dim msg = "Bitte wählen Sie nochmal einen Datensatz aus." If USER_LANGUAGE <> "de-DE" Then msg = "Please choose a record again." End If MsgBox(msg, MsgBoxStyle.Exclamation) End If End If Else Dim msg = "Bitte wählen Sie zuerst einen Datensatz aus." If USER_LANGUAGE <> "de-DE" Then msg = "Please choose a record first." End If MsgBox(msg, MsgBoxStyle.Exclamation) End If End Sub Sub Load_Level1() Try Dim sw As Stopwatch = Stopwatch.StartNew() Dim elapsed As Double Dim sql As String = "SELECT * from VWPMO_CONSTRUCTOR_FORMS WHERE PARENT_ID = 0 AND CONSTRUCT_ID = " & CONSTRUCTORID & " AND SCREEN_ID = " & CURRENT_SCREEN_ID & " ORDER BY SEQUENCE" Dim dt As DataTable = ClassDatabase.Return_Datatable(sql) If Not IsNothing(dt) Then If dt.Rows.Count >= 1 Then Dim tn As TreeNode = TreeViewMain.Nodes(0) TreeViewMain.SelectedNode = tn TreeViewMain.Select() End If End If elapsed = sw.Elapsed.TotalSeconds sw.Stop() If LogErrorsOnly = False Then ClassLogger.Add(String.Format(" >> Load_Level1 took {0} to load", Format(elapsed, "0.000000000") & " seconds"), False) Catch ex As Exception MsgBox("Error in Load_Level1:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub ' Call the procedure using the top nodes of the treeview. Private Sub CallRecursive(ByVal aTreeView As TreeView) End Sub Private Sub grvwGridPos_CellValueChanged(sender As Object, e As CellValueChangedEventArgs) Handles grvwGridPos.CellValueChanged Try Dim column = e.Column.FieldName Dim sql = String.Format("select guid from TBPMO_CONTROL where COL_NAME = '{0}' and FORM_ID = {1}", column, POS_ENTITY) Dim controlid = ClassDatabase.Execute_Scalar(sql, True) If Not IsNothing(controlid) Then 'Überprüfen ob schon value vorhanden sql = String.Format("SELECT CONTROL_ID FROM VWPMO_VALUES WHERE CONTROL_ID = {0} AND FORM_ID = {1} AND CONTROL_COLUMN = '{2}' AND RECORD_ID = {3}", controlid, POS_ENTITY, column, POS_RECORD_ID) Dim cId As Integer = ClassDatabase.Execute_Scalar(sql) If IsNothing(POS_RECORD_ID) Or IsDBNull(POS_RECORD_ID) Then If ClassControlCommandsUI.CreateRecord(POS_ENTITY) = True Then Dim recid = ClassControlCommandsUI.GetLastRecord If Not IsNothing(recid) Then 'Die neue Record-ID setzen POS_RECORD_ID = recid ClassControlCommandsUI.ConnectRecord(PARENT_ID, POS_RECORD_ID, "POS_LINK for Entity " & POS_ENTITY.ToString) Else MsgBox("Unexpected Error in Creating POS", MsgBoxStyle.Exclamation) End If End If End If ' Wenn cId = 0, existiert noch kein wert für diese controlId/FormId Kombination If cId = 0 Then ClassControlCommandsUI.InsertControlValue(controlid, POS_RECORD_ID, e.Value) Update_Status_Label(True, "Record was added!", EditState.Insert) Else ClassControlCommandsUI.UpdateControlValue(controlid, POS_RECORD_ID, e.Value) Update_Status_Label(True, "Record was updated!", EditState.Update) End If Else Update_Status_Label(False) End If Catch ex As Exception MsgBox("Error in grvwGridPos_CellValueChanged:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub Private Sub grvwGridPos_FocusedRowChanged(sender As Object, e As FocusedRowChangedEventArgs) Handles grvwGridPos.FocusedRowChanged Try If TCDetails.SelectedTabPage.Text.StartsWith("Pos") Then Dim Grid_RecordID = Get_Focused_Row_Cell_Value_pos("Record-ID") If Not IsNothing(Grid_RecordID) Then POS_RECORD_ID = Grid_RecordID 'SELECTED_RECORD_ID = POS_RECORD_ID 'RECORD_ID = POS_RECORD_ID 'Update_Record_Label(SELECTED_RECORD_ID) End If End If Catch ex As Exception MsgBox("Error in grvwGridPos_FocusedRowChanged:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub Private Sub grvwGridPos_RowUpdated(sender As Object, e As RowObjectEventArgs) Handles grvwGridPos.RowUpdated End Sub Private Sub GridControlPos_Leave(sender As Object, e As EventArgs) Handles GridControlPos.Leave Save_POSGrid_Layout() End Sub Private Sub grvwGridPos_RowStyle(sender As Object, e As DevExpress.XtraGrid.Views.Grid.RowStyleEventArgs) Handles grvwGridPos.RowStyle If e.RowHandle = DevExpress.XtraGrid.GridControl.AutoFilterRowHandle Then e.Appearance.BackColor = Color.Orange 'LemonChiffon End If End Sub Private Sub grvwGrid_RowStyle(sender As Object, e As DevExpress.XtraGrid.Views.Grid.RowStyleEventArgs) Handles grvwGrid.RowStyle If e.RowHandle = DevExpress.XtraGrid.GridControl.AutoFilterRowHandle Then e.Appearance.BackColor = Color.Orange End If End Sub Private Sub grvwGrid_SelectionChanged(sender As Object, e As DevExpress.Data.SelectionChangedEventArgs) Handles grvwGrid.SelectionChanged End Sub Private Sub grvwGrid_MouseDown(sender As Object, e As MouseEventArgs) Handles grvwGrid.MouseDown, grvwTiles.MouseDown, grvwCarousel.MouseDown If e.Button = Windows.Forms.MouseButtons.Right Then RightMouse_Clicked = True Else RightMouse_Clicked = False End If End Sub Private Sub btnAddUser_FollowUp_Click(sender As Object, e As EventArgs) Handles btnAddUser_FollowUp.Click If cmbFollowUpUser.SelectedIndex <> -1 And FOLL_UP_ID > 0 Then Try Dim ins = "INSERT INTO TBPMO_FOLLUPEMAIL_RECORD (FOLLOW_UP_ID,USER_ID,RECORD_ID,ADDED_WHO) VALUES (" & FOLL_UP_ID & ", " & cmbFollowUpUser.SelectedValue & ", " & RECORD_ID & ", '" & Environment.UserName & "')" If ClassDatabase.Execute_non_Query(ins, True) = True Then Load_FUUser(FOLL_UP_ID) Update_Status_Label(True, "User added to Follow Up", EditState.Insert) End If Catch ex As Exception MsgBox("Error in Add User2FollowUp_Record:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End If End Sub Private Sub btnRemoveUser_FollowUp_Click(sender As Object, e As EventArgs) Handles btnRemoveUser_FollowUp.Click If ListBoxUser2Profile.SelectedIndex <> -1 Then Try Dim del = "DELETE FROM TBPMO_FOLLUPEMAIL_RECORD WHERE GUID = " & ListBoxUser2Profile.SelectedValue If ClassDatabase.Execute_non_Query(del, True) = True Then Update_Status_Label(True, "User removed from Follow Up", EditState.Update) Load_FUUser(FOLL_UP_ID) End If Catch ex As Exception MsgBox("Error in Delete Userlink FollowUp:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End If End Sub Private Sub VerknüpfungenAnzeigenToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles VerknüpfungenAnzeigenToolStripMenuItem.Click Show_Verknuepfungen() End Sub Sub Show_Verknuepfungen() If SplitContainerBottom.Collapsed = True Then Dim msg = "Verknüpfungen ausblenden" If USER_LANGUAGE <> "de-DE" Then msg = "Hide record-links" End If VerknüpfungenAnzeigenToolStripMenuItem.Text = msg Load_ParentConnections() TCDetails.SelectedTabPageIndex = 0 SplitContainerBottom.Collapsed = False Else Dim msg = "Verknüpfungen einblenden" If USER_LANGUAGE <> "de-DE" Then msg = "Show record-links" End If VerknüpfungenAnzeigenToolStripMenuItem.Text = msg SplitContainerBottom.Collapsed = True 'Save_GridViewParentEntityLayout() End If End Sub Sub Load_ParentConnections() Try ' SELECT COLUMN_NAME1 FROM VWTEMP_cPMO_FORM Dim sql = String.Format("SELECT TOP 1 PARENT_ID, [dbo].[FNPMO_GETOBJECTCAPTION]('{0}','FORMVIEW_TITLE' + CONVERT(VARCHAR(5), FORM_VIEW_ID), {1}) AS 'FORM_TITLE' " & _ "from VWPMO_CONSTRUCTOR_FORMS WHERE CONSTRUCT_ID = {2} AND SCREEN_ID = {3} AND FORM_ID = {4}", USER_LANGUAGE, CURRENT_SCREEN_ID, CONSTRUCTORID, CURRENT_SCREEN_ID, ENTITY_ID) Dim DT As DataTable = ClassDatabase.Return_Datatable(sql, "Parent-Data") Dim Parent_ID = DT.Rows(0).Item(0) Dim Title = DT.Rows(0).Item(1) Dim Colname = "[" & ClassDatabase.Execute_Scalar("SELECT TOP 1 COLUMN_NAME1 from VWPMO_CONSTRUCTOR_FORMS WHERE CONSTRUCT_ID = " & CONSTRUCTORID & " AND FORM_ID = " & Parent_ID & " AND SCREEN_ID = " & CURRENT_SCREEN_ID, True) & "]" 'Load_GridViewParentEntity_Layout() If Not IsNothing(Parent_ID) And Not IsNothing(Colname) Then If Colname = "[]" Then sql = "select * from VWTEMP_PMO_FORM" & Parent_ID.ToString Else Try sql = "select [Record-ID], " & Colname & " from VWTEMP_PMO_FORM" & Parent_ID.ToString Catch ex As Exception sql = "select * from VWTEMP_PMO_FORM" & Parent_ID.ToString End Try End If Dim DTGrid As DataTable = ClassDatabase.Return_Datatable(sql, "VariableSelect ParentEntity") GridControlParent.DataSource = Nothing GridViewParent.Columns.Clear() 'Databinding Neu GridControlParent.DataSource = DTGrid 'TabPageParentEntity.Text = "Aktuelle Parent-Entity: " & Title GridViewParent.Columns.Item("Record-ID").Visible = False End If Catch ex As Exception MsgBox("Fehler bei Load_ParentConnections:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub Private Sub GridViewParent_FocusedRowChanged(sender As Object, e As FocusedRowChangedEventArgs) Handles GridViewParent.FocusedRowChanged Try If GridViewParent.RowCount > 0 Then Dim Grid_RecordID = GridViewParent.GetFocusedRowCellValue(GridViewParent.Columns("Record-ID")) If Grid_RecordID Is Nothing = False Then LinkParentID = Grid_RecordID 'lblParentID.Text = Grid_RecordID.ToString & " - " & GridViewParentEntity.GetFocusedRowCellValue(GridViewParent.Columns(1)) btnRelinkParentID.BackColor = Color.DarkOrange btnRelinkParentID.FlatAppearance.BorderColor = Color.DarkOrange btnRelinkParentID.Enabled = True Else btnRelinkParentID.Enabled = False btnRelinkParentID.BackColor = Color.WhiteSmoke btnRelinkParentID.FlatAppearance.BorderColor = Color.WhiteSmoke ClassLogger.Add(">> Grid_RecordID koncould not be chosen - GetFocusedParentID", True) ' lblParentID.Text = "keine Auswahl möglich" End If Else btnRelinkParentID.Enabled = False btnRelinkParentID.BackColor = Color.WhiteSmoke btnRelinkParentID.FlatAppearance.BorderColor = Color.WhiteSmoke 'lblParentID.Text = "keine Rows gefunden" End If Catch ex As Exception MsgBox("Fehler bei GetFocusedParentID:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub Private Sub btnRelinkParentID_Click(sender As Object, e As EventArgs) Handles btnRelinkParentID.Click If PARENT_ID > 0 Then Dim result As MsgBoxResult Dim msg = "Möchten Sie den Parent-Datensatz für den aktuellen Datensatz wirklich aktualisieren?" If USER_LANGUAGE <> "de-DE" Then msg = "Would You like to change the parent-record?" End If result = MessageBox.Show(msg, "Change parent-record:", MessageBoxButtons.YesNo, MessageBoxIcon.Question) If result <> MsgBoxResult.Yes Then Exit Sub Else If ClassDatabase.Execute_non_Query("DELETE FROM TBPMO_RECORD_CONNECT WHERE RECORD2_ID = " & RECORD_ID & " AND RECORD1_ID = (SELECT PARENT_ID FROM TBPMO_FORM WHERE GUID = " & ENTITY_ID & ")", True) = False Then Exit Sub End If End If End If If ClassControlCommandsUI.ConnectRecord(LinkParentID, RECORD_ID, "ReLInk ENTITY " & ENTITY_ID.ToString) = True Then 'Save_GridViewParentEntityLayout() Dim msg = "Die Parent-Entität wurde erfolgreich aktualisiert!" If USER_LANGUAGE <> "de-DE" Then msg = "The Parent-Record was changed successful!" End If MsgBox(msg, MsgBoxStyle.Information) Check_Record_Changed() 'Load_Data_for_TreeView() btnRelinkParentID.BackColor = Color.Lime btnRelinkParentID.FlatAppearance.BorderColor = Color.Lime Load_Entity_Data_Only() 'Show_Verknuepfungen() End If End Sub Private Sub RecordKopierenToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles RecordKopierenToolStripMenuItem.Click Dim result As MsgBoxResult Dim msg = "Möchten Sie den Datensatz wirklich kopieren?" If USER_LANGUAGE <> "de-DE" Then msg = "Would You like to copy the record?" End If result = MessageBox.Show(msg, "Copy Record:", MessageBoxButtons.YesNo, MessageBoxIcon.Question) If result = MsgBoxResult.Yes Then Dim SQL = String.Format("EXEC PRDD_COPY_RECORD {0}, '{1}'", RECORD_ID, Environment.UserName) If ClassDatabase.Execute_non_Query(SQL, True) = True Then Load_Entity_Data(ACT_EBENE) End If End If End Sub Private Sub DatenNeuLadenToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles DatenNeuLadenToolStripMenuItem.Click DisableEditMode() Load_Entity_Data(ACT_EBENE) RECORD_CHANGED = False End Sub Private Sub AnwendungscacheFreigebenToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles AnwendungscacheFreigebenToolStripMenuItem.Click Dim result As MsgBoxResult Dim msg = "Möchten Sie den Anwendungscache wirklich leeren?" & vbNewLine & "Die Entität wird dann automatisch neugeladen!" If USER_LANGUAGE <> "de-DE" Then msg = "Would You like to clear the applications-cache?" & vbNewLine & "All data will be loaded new!" End If result = MessageBox.Show(msg, "Clear cache:", MessageBoxButtons.YesNo, MessageBoxIcon.Question) If result = MsgBoxResult.Yes Then Try Cursor = Cursors.WaitCursor CURRENT_FORM_ID = ENTITY_ID ClassControlValueCache.ClearCache() DisableEditMode() Load_Entity_Data(ACT_EBENE) RECORD_CHANGED = False Catch ex As Exception MsgBox("Unexpected Error in Clear Cache:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) Finally Cursor = Cursors.Default End Try End If End Sub Private Sub grvwGrid_ColumnFilterChanged(sender As Object, e As EventArgs) Handles grvwGrid.ColumnFilterChanged Console.WriteLine("Filter changed: " & Now) End Sub Public Sub New() ' Dieser Aufruf ist für den Designer erforderlich. InitializeComponent() ' Fügen Sie Initialisierungen nach dem InitializeComponent()-Aufruf hinzu. End Sub Private Sub AxObjectListControl_CausesValidationChanged(sender As Object, e As EventArgs) Handles AxObjectListControl.CausesValidationChanged Console.WriteLine("CausesValidationChanged") End Sub Private Sub AxObjectListControl_SettingFlagChanged(sender As Object, e As EventArgs) Handles AxObjectListControl.SettingFlagChanged Console.WriteLine("SettingFlagChanged") End Sub Private Sub AxObjectListControl_Validated(sender As Object, e As EventArgs) Handles AxObjectListControl.Validated Console.WriteLine("Validated") End Sub Private Sub tslblLocked_VisibleChanged(sender As Object, e As EventArgs) Handles tslblLocked.VisibleChanged If tslblLocked.Visible = True Then Dim msg = "Nur lesenden Zugriff" If USER_LANGUAGE <> "de-DE" Then msg = "Record is read only" End If tslblLocked.Text = msg End If End Sub Private Sub tsmi_RecordDelete_Click(sender As Object, e As EventArgs) Handles tsmi_RecordDelete.Click Delete_Record() End Sub Private Sub KopierenToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles CopyToolStripMenuItem.Click If RESULT_DOC_PATH <> Nothing Then Try Dim selectedfile(0) As String selectedfile(0) = RESULT_DOC_PATH Dim dataobj As New DataObject dataobj.SetData(DataFormats.FileDrop, True, selectedfile) Clipboard.Clear() Clipboard.SetDataObject(dataobj, True) Catch ex As Exception MsgBox("Unexpected Error in Copy file:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try Cursor = Cursors.Default End If End Sub Private Sub GridViewDoc_Search_FocusedRowChanged(sender As Object, e As FocusedRowChangedEventArgs) Handles GridViewDoc_Search.FocusedRowChanged Try RESULT_DOC_PATH = GridViewDoc_Search.GetFocusedRowCellValue(GridViewDoc_Search.Columns("FULLPATH")) Catch ex As Exception RESULT_DOC_PATH = Nothing End Try End Sub Private Sub LöschenToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles DeleteToolStripMenuItem.Click If RESULT_DOC_PATH <> Nothing Then Dim msg = "Sind Sie sicher, dass Sie diese Dateien löschen wollen?" If USER_LANGUAGE <> "de-DE" Then msg = "Are You sure You want to delete this file?" End If Dim result As MsgBoxResult result = MessageBox.Show(msg, "Confirmation:", MessageBoxButtons.YesNo, MessageBoxIcon.Question) If result = MsgBoxResult.Yes Then Try Dim FileToDelete As String FileToDelete = RESULT_DOC_PATH If System.IO.File.Exists(FileToDelete) = True Then System.IO.File.Delete(FileToDelete) RUN_WDSEARCH_GRID() End If Catch ex As Exception MsgBox("Unexpected Error in Delete file:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End If End If End Sub Private Sub EigenschaftenToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles PropertiesToolStripMenuItem.Click If RESULT_DOC_PATH <> Nothing Then Cursor = Cursors.WaitCursor Dim sei As New SHELLEXECUTEINFO sei.cbSize = Marshal.SizeOf(sei) sei.lpVerb = "properties" sei.lpFile = RESULT_DOC_PATH sei.nShow = SW_SHOW sei.fMask = SEE_MASK_INVOKEIDLIST If Not ShellExecuteEx(sei) Then Dim ex As New System.ComponentModel.Win32Exception(System.Runtime.InteropServices.Marshal.GetLastWin32Error()) MsgBox("Unexpected Error in Open file propertys:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End If End If Cursor = Cursors.Default End Sub Private Sub DateiÖffnenToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles DateiÖffnenToolStripMenuItem.Click File_open() End Sub Sub File_open() If RESULT_DOC_PATH <> Nothing Then Try Dim Proc As New System.Diagnostics.Process Dim psi As New ProcessStartInfo(RESULT_DOC_PATH) Proc.EnableRaisingEvents = True Proc.StartInfo = psi Proc.Start() Catch ex As Exception MsgBox("Unexpected Error in Open file:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) ClassLogger.Add("Fehler bei Datei öffnen: " & ex.Message, True) End Try End If End Sub Private Sub GridControlDocSearch_DoubleClick(sender As Object, e As EventArgs) Handles GridControlDocSearch.DoubleClick Try RESULT_DOC_PATH = GridViewDoc_Search.GetFocusedRowCellValue(GridViewDoc_Search.Columns("FULLPATH")) Catch ex As Exception RESULT_DOC_PATH = Nothing End Try File_open() End Sub End Class