This commit is contained in:
2022-07-07 13:20:13 +02:00
parent 331611c9e8
commit 28254c99f7
125 changed files with 1796 additions and 1144 deletions

File diff suppressed because it is too large Load Diff

View File

@@ -0,0 +1,590 @@
Public Class ClassControlCommands
' +++ Helper Functions +++
'Public Shared Function BoolToInt(bool As Boolean) As Integer
' ' Wandelt einen Boolean Wert in einen Int um
' Return IIf(bool, 1, 0)
'End Function
Public Shared Function ControlToTypeId(control As Control) As Integer
Dim CurrentType As String = control.GetType.ToString.ToUpper
Select Case True
Case CurrentType.Contains("LineLabel".ToUpper)
Return 15
Case CurrentType.Contains("Label".ToUpper)
Return 1
Case CurrentType.Contains("TextBox".ToUpper)
Return 2
Case CurrentType.Contains("ComboBox".ToUpper)
Return 3
Case CurrentType.Contains("DateTimePicker".ToUpper)
Return 4
Case CurrentType.Contains("DevExpress.XtraEditors.DateEdit".ToUpper)
Return 4
Case CurrentType.Contains("GroupBox".ToUpper)
Return 5
Case CurrentType.Contains("PictureBox".ToUpper)
Return 6
Case CurrentType.Contains("DataGridView".ToUpper)
Return 7
Case CurrentType.Contains("CheckBox".ToUpper)
Return 10
Case CurrentType.Contains("RadioButton".ToUpper)
Return 11
Case CurrentType.Contains("Button".ToUpper)
If control.Name.Contains("f_addappointment") Then
Return 8
ElseIf control.Name.Contains("f_addformdata") Then
Return 9
End If
Case CurrentType.Contains("DEVEXPRESS.XTRAGRID.GRIDCONTROL".ToUpper)
Return 14
Case CurrentType.Contains("CheckedListBoxControl".ToUpper)
Return 12
Case CurrentType.Contains("ListBoxControl".ToUpper)
Return 13
' Id 14 ist DataGridView Checkable - nicht verwendet
Case Else
Return -1
End Select
End Function
' +++ Public Functions +++
Public Shared Function GetParentRecordId(RecordId As Integer) As Integer
Try
Dim parentId = ClassDatabase.Execute_Scalar("SELECT RECORD1_ID FROM TBPMO_RECORD_CONNECT WHERE RECORD2_ID = " & RecordId, True)
If IsNothing(parentId) Then
Return 0
Else
Return parentId
End If
Catch ex As Exception
MsgBox("Error in GetFormId:" & vbNewLine & ex.Message, MsgBoxStyle.Critical)
End Try
End Function
Public Shared Function GetFormId(RecordId As Integer) As Integer
Try
Dim FormId = ClassDatabase.Execute_Scalar("SELECT FORM_ID FROM VWPMO_VALUES WHERE RECORD_ID = " & RecordId, True)
Return FormId
Catch ex As Exception
MsgBox("Error in GetFormId:" & vbNewLine & ex.Message, MsgBoxStyle.Critical)
End Try
End Function
Public Shared Function GetControlGuid(name As String)
Try
Dim sql = "SELECT GUID FROM TBPMO_CONTROL WHERE UPPER(NAME) = UPPER('" & name & "')"
Return ClassDatabase.Execute_Scalar(sql, True)
Catch ex As Exception
Return -1
End Try
End Function
Public Shared Function InsertControl(control As Control)
Try
Dim SQL As String
Dim NAME As String
Dim CONTROL_TYPE_ID As Integer
Dim PARENT_CONTROL_ID As Integer = 0
Dim DEFVALUE As String = ""
If (control.Parent.GetType().Name = "GroupBox") Then
Dim ParentID As Integer = GetControlID_for_Name(control.Parent.Name, CURRENT_ENTITY_ID)
PARENT_CONTROL_ID = ParentID
End If
NAME = control.Name
CONTROL_TYPE_ID = ControlToTypeId(control)
' SQL Befehl für CONTROL TABELLE
' SQL_COMMAND_1 auf leeren String setzen
SQL = $"INSERT INTO TBPMO_CONTROL (FORM_ID, CONTROL_TYPE_ID, DEFAULT_VALUE, NAME, COL_NAME, PARENT_CONTROL_ID, SQL_COMMAND_1) VALUES ({CURRENT_ENTITY_ID}, {CONTROL_TYPE_ID}, '', '{NAME}', '{NAME}', {PARENT_CONTROL_ID}, '')"
'LOGGER.Debug(SQL)
If ClassDatabase.Execute_non_Query(SQL) = True Then
SQL = "SELECT MAX(GUID) FROM TBPMO_CONTROL"
Dim GUID = ClassDatabase.Execute_Scalar(SQL)
Return InsertControlScreen(GUID, control, CURRENT_ENTITY_ID)
Else
Throw New Exception()
End If
Catch ex As Exception
LOGGER.Warn("Unexpected Error in InsertControl: " & ex.Message)
MsgBox("Unexpected Error in InsertControl:" + vbNewLine + ex.Message, MsgBoxStyle.Critical)
Return False
End Try
End Function
Public Shared Function InsertControlScreen(guid As Integer, ByRef control As Control, CURRENT_ENTITY_ID As Integer)
Try
Dim CurrentType As String = control.GetType.ToString
Dim SQL As String
Dim X_LOC, Y_LOC, WIDTH, HEIGHT As Integer
Dim CONTROL_TEXT As String
X_LOC = control.Location.X
Y_LOC = control.Location.Y
WIDTH = control.Width
HEIGHT = control.Height
CONTROL_TEXT = control.Text
'Dim TAB_INDEX
'SQL = "SELECT MAX(TAB_INDEX) FROM TBPMO_CONTROL_SCREEN WHERE CONTROL_ID IN (SELECT GUID FROM TBPMO_CONTROL WHERE CURRENT_ENTITY_ID = " & CURRENT_ENTITY_ID & ")"
'TAB_INDEX = ClassDatabase.Execute_Scalar(SQL)
'If Not TAB_INDEX Is Nothing Then
' If IsDBNull(TAB_INDEX) Then
' TAB_INDEX = 1
' Else
' TAB_INDEX = CInt(TAB_INDEX) + 1
' End If
'Else
' TAB_INDEX = 1
'End If
SQL = "INSERT TBPMO_CONTROL_SCREEN (CONTROL_ID, SCREEN_ID, CONTROL_TEXT, X_LOC, Y_LOC, HEIGHT, WIDTH) VALUES (" & guid & ", 1, '" & CONTROL_TEXT & "', " & X_LOC & ", " & Y_LOC & ", " & HEIGHT & ", " & WIDTH & ")"
If ClassDatabase.Execute_non_Query(SQL) Then
' Die Guid in die Metadaten des Controls zurückschreiben
Dim metadata = DirectCast(control.Tag, ClassControlMetadata)
metadata.Id = guid
control.Tag = metadata
SQL = "SELECT MAX(GUID) FROM TBPMO_CONTROL_SCREEN WHERE CONTROL_ID = " & guid & " AND SCREEN_ID = " & CURRENT_SCREEN_ID
Dim ctrl_screen_Id = ClassDatabase.Execute_Scalar(SQL)
SQL = String.Format("INSERT INTO TBPMO_CONTROL_LANGUAGE (LANGUAGE_TYPE,CONTROL_SCREEN_ID,CAPTION,ADDED_WHO) VALUES ('{0}',{1},'{2}','{3}')", USER_LANGUAGE, ctrl_screen_Id, CONTROL_TEXT, USER_USERNAME)
ClassDatabase.Execute_non_Query(SQL)
Return True
Else
Throw New Exception()
End If
Catch ex As Exception
LOGGER.Warn("Unexpected Error in InsertControlScreen: " & ex.Message)
MsgBox("Unexpected Error in InsertControlScreen (Adding ViewProperties:" + vbNewLine + ex.Message, MsgBoxStyle.Critical)
Return False
End Try
End Function
Public Shared Function UpdateControlPosition(ByVal x As Integer, ByVal y As Integer, control As Control)
Try
Dim CONTROL_ID = GetControlID_for_Name(control.Name, CURRENT_ENTITY_ID)
'If (ParentIsGroupBox(control)) Then
' Console.WriteLine("Before:" & x & ":" & y)
' x = x - control.Parent.Location.X
' y = y - control.Parent.Location.Y
' Console.WriteLine("After:" & x & ":" & y)
'End If
Dim SQL = "UPDATE TBPMO_CONTROL_SCREEN SET X_LOC = " & x & ", Y_LOC = " & y & ", CHANGED_WHO = '" & USER_USERNAME & "' WHERE CONTROL_ID = " & CONTROL_ID
If ClassDatabase.Execute_non_Query(SQL) = True Then
Return True
Else
Throw New Exception()
End If
Catch ex As Exception
LOGGER.Warn("Unexpected Error in UpdateControlPosition: " & ex.Message)
MsgBox("Unexpected Error in UpdateControlPosition:" & vbNewLine & ex.Message, MsgBoxStyle.Critical)
Return False
End Try
End Function
Public Shared Function UpdateControl(control As Control, properties As Object)
Try
' Nach Typ den Update Befehl anpassen
Dim type As String = control.GetType.Name
Dim SQL As String
Dim NAME As String
Dim REQUIRED As Integer
Dim READ_ONLY As Integer
Dim SELECT_ONLY As Integer
Dim CHANGED_WHO As String = USER_USERNAME
Dim COL_NAME As String
Dim SQLCommand As String
Dim SQL_ENABLED_WHEN As String
Dim MULTILINE As Integer
Dim MASTER_DATA_ID As Integer
Dim DEFAULTVALUE As String
Dim FORMAT_TYPE As String
Dim SHOW_COLUMN As Integer
Dim STATIC_LIST As String
Dim VISIBLE As Integer
Dim TREE_VIEW As Integer
Dim AUTO_SUGGEST As Integer
' So sollte diese Funktion später mal aussehen :(
'Select Case type
' Case "TextBox"
' NAME = properties.Name
' MULTILINE = ClassConverter.BoolToInt(properties.Multiline)
' COL_NAME = ClassConverter.ToStringOrDefault(properties.ColumnTitle)
' DEFAULTVALUE = ClassConverter.ToStringOrDefault(properties.DefaultValue)
' SHOW_COLUMN = ClassConverter.BoolToInt(properties.ShowColumn)
' FORMAT_TYPE = properties.Format.ToString()
' REQUIRED = ClassConverter.BoolToInt(properties.IsRequired)
' READ_ONLY = ClassConverter.BoolToInt(properties.IsReadOnly)
' SQLCommand = ClassConverter.SQLValueToString(properties.SQLCommand)
'End Select
NAME = properties.Name
VISIBLE = BoolToInt(properties.Visible)
If propExists(properties, "Multiline") Then
MULTILINE = BoolToInt(properties.Multiline)
Else
MULTILINE = 0
End If
If propExists(properties, "AutoSuggest") Then
AUTO_SUGGEST = BoolToInt(properties.AutoSuggest)
Else
AUTO_SUGGEST = 0
End If
If propExists(properties, "ColumnTitle") Then
COL_NAME = properties.ColumnTitle
Else
COL_NAME = String.Empty
End If
If Not (type = "RadioButton" Or type = "CheckBox" Or type = "GroupBox") Then
TREE_VIEW = BoolToInt(properties.TreeView)
End If
If type = "RadioButton" Then
DEFAULTVALUE = properties.DefaultValue
ElseIf type = "CheckBox" Then
DEFAULTVALUE = properties.DefaultValue
ElseIf type = "CustomComboBox" Then
DEFAULTVALUE = properties.DefaultValue
ElseIf type = "DateEdit" Then
DEFAULTVALUE = ClassConverter.ToDateTimePickerOptionsOrDefault(properties.DefaultValue)
ElseIf type = "TextBox" Then
DEFAULTVALUE = properties.DefaultValue
End If
If propExists(properties, "ShowColumn") Then
SHOW_COLUMN = BoolToInt(properties.ShowColumn)
End If
If type = "TextBox" AndAlso propExists(properties, "Format") Then
FORMAT_TYPE = properties.Format.ToString
ElseIf type = "ComboBox" AndAlso propExists(properties, "Format") Then
FORMAT_TYPE = properties.Format.ToString
Else
FORMAT_TYPE = EnumFormatOptions.String.ToString
End If
If propExists(properties, "IsRequired") Then
REQUIRED = BoolToInt(properties.IsRequired)
Else
REQUIRED = BoolToInt(False)
End If
If propExists(properties, "IsReadOnly") Then
READ_ONLY = BoolToInt(properties.IsReadOnly)
Else
READ_ONLY = BoolToInt(False)
End If
If propExists(properties, "IsSelectOnly") Then
SELECT_ONLY = BoolToInt(properties.IsSelectOnly)
Else
SELECT_ONLY = BoolToInt(False)
End If
If propExists(properties, "SQLCommand") Then
Dim value As SQLValue = DirectCast(properties.SQLCommand, SQLValue)
SQLCommand = value.Value
'Maskieren von Hochkommata damit der Insert angenommen wird
If SQLCommand.Contains("'") Then
SQLCommand = SQLCommand.Replace("'", "''")
End If
Else
SQLCommand = String.Empty
End If
If propExists(properties, "EnabledWhen") Then
Dim value As SQLValue = DirectCast(properties.EnabledWhen, SQLValue)
SQL_ENABLED_WHEN = value.Value
If SQL_ENABLED_WHEN.Contains("'") Then
SQL_ENABLED_WHEN = SQL_ENABLED_WHEN.Replace("'", "''")
End If
Else
SQL_ENABLED_WHEN = String.Empty
End If
If propExists(properties, "StaticList") Then
Dim value As StaticListValue = DirectCast(properties.StaticList, StaticListValue)
STATIC_LIST = value.Value
Else
STATIC_LIST = String.Empty
End If
If propExists(properties, "MasterDataId") Then
MASTER_DATA_ID = properties.MasterDataId
Else
MASTER_DATA_ID = 0
End If
' If CURRENT_CONTROL_ID isn't equal to ID in Properties Window, make it equal
If CURRENT_CONTROL_ID <> properties.ID Then
CURRENT_CONTROL_ID = properties.ID
End If
SQL = $"UPDATE TBPMO_CONTROL
SET REQUIRED = {REQUIRED},
READ_ONLY = {READ_ONLY},
SHOW_COLUMN = {SHOW_COLUMN},
FORMAT_TYPE = '{FORMAT_TYPE}',
DEFAULT_VALUE = '{DEFAULTVALUE}',
NAME = '{NAME}',
SQL_COMMAND_1 = '{SQLCommand}',
SQL_COMMAND_2 = '{SQL_ENABLED_WHEN}',
CHANGED_WHO = '{CHANGED_WHO}',
COL_NAME = '{COL_NAME}',
MULTILINE = {MULTILINE},
MASTER_DATA_ID = {MASTER_DATA_ID},
STATIC_LIST = '{STATIC_LIST}',
VISIBLE = {VISIBLE},
TREE_VIEW = {TREE_VIEW},
SELECT_ONLY = {SELECT_ONLY},
AUTO_SUGGEST = {AUTO_SUGGEST}
WHERE GUID = {CURRENT_CONTROL_ID}"
If ClassDatabase.Execute_non_Query(SQL) = True Then
Return UpdateControlScreen(control, properties)
Else
Throw New Exception()
End If
Catch ex As Exception
LOGGER.Warn("Unexpected Error in UpdateControl: " & ex.Message)
MsgBox("Unexpected Error in UpdateControl:" + vbNewLine + ex.Message, MsgBoxStyle.Critical)
Return False
End Try
End Function
Public Shared Function UpdateControlScreen(control As Control, properties As Object)
Try
Dim SQL As String
Dim CurrentType As String = control.GetType.ToString
Dim X_LOC, Y_LOC As Integer
Dim HEIGHT, WIDTH As Integer
Dim CHANGED_WHO As String = USER_USERNAME
Dim CONTROL_TEXT As String
Dim TAB_INDEX As Integer
Dim TAB_STOP As Integer
Dim FONT_FAMILY As String
Dim FONT_COLOR As Integer
Dim FONT_SIZE As Integer
Dim FONT_STYLE As Integer
Dim BACK_COLOR As Integer
Dim HINT As String = properties.Hint
X_LOC = properties.Location.X
Y_LOC = properties.Location.Y
HEIGHT = properties.Size.Height
WIDTH = properties.Size.Width
If propExists(properties, "Font") AndAlso Not IsNothing(properties.Font) Then
Dim f As Font = properties.Font
FONT_FAMILY = f.FontFamily.Name
FONT_SIZE = CType(f.Size, Integer)
FONT_STYLE = CType(f.Style, Integer)
Else
FONT_FAMILY = "Segoe UI"
FONT_SIZE = 8
FONT_STYLE = 0
End If
If propExists(properties, "FontColor") Then
Dim c As Color = properties.FontColor
FONT_COLOR = ColorToInt(c)
Else
Dim c As Color = Color.Black
FONT_COLOR = ColorToInt(c)
End If
If propExists(properties, "TabIndex") Then
TAB_INDEX = properties.TabIndex
Else
TAB_INDEX = 0
End If
If propExists(properties, "TabStop") Then
TAB_STOP = BoolToInt(properties.TabStop)
Else
TAB_STOP = BoolToInt(False)
End If
If propExists(properties, "Caption") Then
CONTROL_TEXT = properties.Caption
Else
CONTROL_TEXT = String.Empty
End If
If propExists(properties, "BackColor") Then
BACK_COLOR = ColorToInt(properties.BackColor)
Else
BACK_COLOR = ColorToInt(SystemColors.Control)
End If
SQL = "UPDATE TBPMO_CONTROL_SCREEN SET TAB_INDEX = " & TAB_INDEX & ", TAB_STOP = " & TAB_STOP & ", X_LOC = " & X_LOC & ", Y_LOC = " & Y_LOC & ", HEIGHT = " & HEIGHT & ", WIDTH = " & WIDTH & ", CONTROL_TEXT = '" & CONTROL_TEXT & "', CHANGED_WHO = '" & CHANGED_WHO & "', FONT_COLOR = " & FONT_COLOR & ", FONT_SIZE = " & FONT_SIZE & ", FONT_STYLE = " & FONT_STYLE & ", FONT_FAMILY = '" & FONT_FAMILY & "' , BACK_COLOR = " & BACK_COLOR & " WHERE CONTROL_ID = " & CURRENT_CONTROL_ID & " AND SCREEN_ID = " & CURRENT_SCREEN_ID
If ClassDatabase.Execute_non_Query(SQL) = True Then
Dim upd = String.Format("UPDATE TBPMO_CONTROL_LANGUAGE SET CAPTION = '{0}', HINT = '{1}' WHERE LANGUAGE_TYPE = '{2}' AND " & _
"CONTROL_SCREEN_ID = (SELECT GUID FROM TBPMO_CONTROL_SCREEN WHERE CONTROL_ID = " & _
CURRENT_CONTROL_ID & " AND SCREEN_ID = " & CURRENT_SCREEN_ID & ")", CONTROL_TEXT, HINT, USER_LANGUAGE)
ClassDatabase.Execute_non_Query(upd)
If CurrentType.Contains("Button") Then
'If control.Tag = "ADDAPPOINTMENT" Then
If control.Name.Contains("f_addappointment") Then
Dim ControlId = properties.ID
Dim FromDateId, ToDateId As Integer
Dim SubjectString, Subject2String, PlaceString, DescString As String
If propExists(properties, "FromDate") And Not String.IsNullOrWhiteSpace(properties.FromDate) Then
FromDateId = GetControlID_for_Name(properties.FromDate, CURRENT_ENTITY_ID)
If FromDateId = -1 Then
Throw New Exception("Das Element für 'fromDate' mit dem Namen " & properties.FromDate & " existiert nicht!")
End If
End If
If propExists(properties, "ToDate") And Not String.IsNullOrWhiteSpace(properties.ToDate) Then
ToDateId = GetControlID_for_Name(properties.ToDate, CURRENT_ENTITY_ID)
If ToDateId = -1 Then
Throw New Exception("Das Element für 'ToDate' mit dem Namen " & properties.ToDate & " existiert nicht!")
End If
End If
If propExists(properties, "Subject") Then
SubjectString = properties.Subject
Else
SubjectString = String.Empty
End If
If propExists(properties, "Subject2") Then
Subject2String = properties.Subject2
Else
Subject2String = String.Empty
End If
If propExists(properties, "Place") Then
PlaceString = properties.Place
Else
PlaceString = String.Empty
End If
If propExists(properties, "Description") Then
DescString = properties.Description
Else
DescString = String.Empty
End If
ClassFunctionCommands.UpdateAddAppointmentFunction(ControlId, FromDateId, ToDateId, SubjectString, Subject2String, PlaceString, DescString)
ElseIf control.Name.Contains("f_addformdata") Then
'ElseIf control.Tag = "ADDFORMDATA" Then
Dim ControlId = properties.ID
Dim FormID, ScreenID As Integer
If propExists(properties, "FormID") And Not String.IsNullOrWhiteSpace(properties.FormID) Then
FormID = properties.FormID
End If
If propExists(properties, "ScreenID") And Not String.IsNullOrWhiteSpace(properties.ScreenID) Then
ScreenID = properties.ScreenID
End If
ClassFunctionCommands.UpdateAddFormDataFunction(ControlId, FormID, ScreenID)
End If
End If
Return True
Else
Throw New Exception()
End If
Catch ex As Exception
LOGGER.Warn("Unexpected Error in UpdateControlScreen: " & ex.Message)
MsgBox("Unexpected Error in UpdateControlScreen:" + vbNewLine + ex.Message, MsgBoxStyle.Critical)
Return False
End Try
End Function
Public Shared Function DeleteControl(ID As Integer)
Try
Dim del = "EXEC [dbo].[PRPMO_DELETE_CONTROL] " & ID.ToString
If ClassDatabase.Execute_non_Query(del) = True Then
Return True
Else
Return False
End If
Catch ex As Exception
LOGGER.Warn("Unexpected Error in Delete Control: " & ex.Message)
MsgBox("Unexpected Error in Delete Control:" + vbNewLine + ex.Message, MsgBoxStyle.Critical)
Return False
End Try
End Function
Public Shared Function DeleteControlScreen(id As Integer)
Try
Dim SQL = "DELETE FROM TBPMO_CONTROL_LANGUAGE WHERE CONTROL_SCREEN_ID IN (SELECT GUID FROM TBPMO_CONTROL_SCREEN WHERE CONTROL_ID = " & id & ")"
If ClassDatabase.Execute_non_Query(SQL) = True Then
SQL = "DELETE FROM TBPMO_CONTROL_SCREEN WHERE CONTROL_ID = " & id
If ClassDatabase.Execute_non_Query(SQL) = True Then
Return True
Else
Throw New Exception()
End If
Else
Throw New Exception()
End If
Catch ex As Exception
LOGGER.Warn("Unexpected Error in DeleteControlScreen: " & ex.Message)
MsgBox("Unexpected Error in DeleteControlScreen:" + vbNewLine + ex.Message, MsgBoxStyle.Critical)
Return False
End Try
End Function
Public Shared Function DeleteControlValues(id As Integer)
Try
Dim SQL = "DELETE FROM TBPMO_CONTROL_VALUE WHERE CONTROL_ID = " & id
If ClassDatabase.Execute_non_Query(SQL) = True Then
Return True
Else
Throw New Exception()
End If
Catch ex As Exception
LOGGER.Warn("Unexpected Error in DeleteControlValues: " & ex.Message)
MsgBox("Unexpected Error in DeleteControlValues:" + vbNewLine + ex.Message, MsgBoxStyle.Critical)
Return False
End Try
End Function
Public Shared Function CTRL_EXISTSinPARENT(ctrlName As String, parent As Control) As Boolean
Dim bResult As Boolean = False
For Each elem As Control In parent.Controls
If elem.Name = ctrlName Then
bResult = True
Exit For
End If
Next
Return bResult
End Function
End Class

View File

@@ -0,0 +1,973 @@
Imports DD_Record_Organizer.ClassDatabase
Imports DD_Record_Organizer.ClassControlBuilder
Imports DD_LIB_Standards
Imports System.Data.SqlClient
Public Class ClassControlCommandsUI
Private _CtrlBuilder As ClassControlBuilder
Private _AddAppointmentHandler As System.EventHandler
Private _AddFormDataHandler As System.EventHandler
Private _ContextMenuStrip As ContextMenuStrip
Private _isinsert As Boolean = False
Private _isedit As Boolean = False
Public Property IsInsert As Boolean
Get
Return _isinsert
End Get
Set(value As Boolean)
_isinsert = value
_CtrlBuilder.IsInsert = value
End Set
End Property
Public Property IsEdit As Boolean
Get
Return _isedit
End Get
Set(value As Boolean)
_isedit = value
_CtrlBuilder.IsEdit = value
End Set
End Property
''' <summary>
''' Erstellt eine neue Instanz der ClassControlCommandsUI Klasse
''' </summary>
''' <param name="ControlBuilder">Eine ControlBuilder Instanz</param>
''' <param name="AddAppointmentDelegate">Ein Delegate, der auf eine AddAppointment-Methode verweist, mit AddressOf verwenden</param>
''' <param name="AddFormDataDelegate">Ein Delegate, der auf eine AddFormData-Methode verweist, mit AddressOf verwenden</param>
''' <remarks></remarks>
Sub New(ControlBuilder As ClassControlBuilder, ContextMenuStrip As ContextMenuStrip, AddAppointmentDelegate As System.EventHandler) ', AddFormDataDelegate As System.EventHandler)
_CtrlBuilder = ControlBuilder
_ContextMenuStrip = ContextMenuStrip
_AddAppointmentHandler = AddAppointmentDelegate
' _AddFormDataHandler = AddFormDataDelegate
End Sub
Sub LoadControls(FormId As Integer)
_CtrlBuilder.ClearControls()
_CtrlBuilder.MasterPanel.SuspendLayout()
Dim sw As New SW("LoadControls")
'Dim SQL As String = String.Format("SELECT T.*, dbo.FNPMO_GET_CONTROL_CAPTION ('{2}', {3},T.CONTROL_ID) AS 'CAPTION' FROM VWPMO_CONTROL_SCREEN T WHERE T.SCREEN_ID = {0} AND T.FORM_ID = {1} AND T.CONTROL_VISIBLE = 1", CURRENT_SCREEN_ID, FormId, USER_LANGUAGE, CURRENT_SCREEN_ID)
Dim expression As String = String.Format("SCREEN_ID = {0} AND FORM_ID = {1} AND CONTROL_VISIBLE = 1", CURRENT_SCREEN_ID, FormId)
Dim DT As DataTable = ClassHelper.FILTER_DATATABLE(DT_VWPMO_CONTROL_SCREEN, expression, "") ' ClassDatabase.Return_Datatable(Sql, True)
For Each dr As DataRow In DT.Rows
Dim parent As GroupBox = Nothing
If (dr.Item("CONTROL_PARENT_ID") <> 0) Then
Dim parentname As String = Get_Name_for_ControlID(dr.Item("CONTROL_PARENT_ID"), FormId)
parent = _CtrlBuilder.GetControlByName(parentname)
End If
Dim control As String
Select Case dr.Item("CTRLTYPE_ID")
Case 1 ' Label
_CtrlBuilder.AddLabel(dr.Item("CONTROL_ID"),
dr.Item("CONTROL_NAME"),
dr.Item("CAPTION"),
dr.Item("CTRLSCR_X_LOC"),
dr.Item("CTRLSCR_Y_LOC"),
dr.Item("CTRLSCR_FONT_FAMILY"),
dr.Item("CTRLSCR_FONT_COLOR"),
dr.Item("CTRLSCR_FONT_SIZE"),
dr.Item("CTRLSCR_FONT_STYLE"),
dr.Item("CONTROL_SQLCOMMAND_1"),
False,
parent)
control = "Label - " & dr.Item("CONTROL_ID")
Case 2 ' TextBox
_CtrlBuilder.AddTextBox(dr.Item("CONTROL_ID"),
dr.Item("CONTROL_NAME"),
dr.Item("CTRLSCR_X_LOC"),
dr.Item("CTRLSCR_Y_LOC"),
dr.Item("CTRLSCR_FONT_FAMILY"),
dr.Item("CTRLSCR_FONT_COLOR"),
dr.Item("CTRLSCR_FONT_SIZE"),
dr.Item("CTRLSCR_FONT_STYLE"),
dr.Item("CTRLSCR_TAB_INDEX"),
dr.Item("CTRLSCR_TAB_STOP"),
dr.Item("CTRLSCR_WIDTH"),
dr.Item("CTRLSCR_HEIGHT"),
dr.Item("CONTROL_MULTILINE"),
dr.Item("CONTROL_READ_ONLY"),
dr.Item("CONTROL_REQUIRED"),
dr.Item("CONTROL_FORMAT_TYPE"),
dr.Item("CONTROL_AUTO_SUGGEST"),
False,
parent)
control = "Text - " & dr.Item("CONTROL_ID")
Case 3 ' ComboBox
_CtrlBuilder.AddComboBox(dr.Item("CONTROL_ID"),
dr.Item("CONTROL_NAME"),
dr.Item("CTRLSCR_X_LOC"),
dr.Item("CTRLSCR_Y_LOC"),
dr.Item("CTRLSCR_FONT_FAMILY"),
dr.Item("CTRLSCR_FONT_COLOR"),
dr.Item("CTRLSCR_FONT_SIZE"),
dr.Item("CTRLSCR_FONT_STYLE"),
dr.Item("CTRLSCR_TAB_INDEX"),
dr.Item("CTRLSCR_TAB_STOP"),
dr.Item("CTRLSCR_WIDTH"),
dr.Item("CTRLSCR_HEIGHT"),
dr.Item("CONTROL_FORMAT_TYPE"),
False,
dr.Item("CONTROL_READ_ONLY"),
dr.Item("CONTROL_SELECT_ONLY"),
dr.Item("CONTROL_REQUIRED"),
dr.Item("CONTROL_STATIC_LIST"),
dr.Item("CONTROL_SQLCOMMAND_1"),
parent)
Case 4 ' DateTimePicker
_CtrlBuilder.AddDateTimePicker(dr.Item("CONTROL_ID"),
dr.Item("CONTROL_NAME"),
dr.Item("CTRLSCR_X_LOC"),
dr.Item("CTRLSCR_Y_LOC"),
dr.Item("CTRLSCR_FONT_FAMILY"),
dr.Item("CTRLSCR_FONT_SIZE"),
dr.Item("CTRLSCR_FONT_STYLE"),
dr.Item("CTRLSCR_TAB_INDEX"),
dr.Item("CTRLSCR_TAB_STOP"),
dr.Item("CTRLSCR_WIDTH"),
dr.Item("CTRLSCR_HEIGHT"),
dr.Item("CONTROL_READ_ONLY"),
dr.Item("CONTROL_REQUIRED"),
False,
parent)
control = "DatePicker - " & dr.Item("CONTROL_ID")
Case 5 ' GroupBox
_CtrlBuilder.AddGroupBox(dr.Item("CONTROL_ID"),
dr.Item("CONTROL_NAME"),
dr.Item("CTRLSCR_CAPTION"),
dr.Item("CTRLSCR_X_LOC"),
dr.Item("CTRLSCR_Y_LOC"),
dr.Item("CTRLSCR_WIDTH"),
dr.Item("CTRLSCR_HEIGHT"),
dr.Item("CTRLSCR_BACK_COLOR"),
dr.Item("CTRLSCR_FONT_COLOR"),
dr.Item("CTRLSCR_FONT_FAMILY"),
dr.Item("CTRLSCR_FONT_SIZE"),
dr.Item("CTRLSCR_FONT_STYLE"),
False,
parent)
control = "GroupBox - " & dr.Item("CONTROL_ID")
Case 6 ' PictureBox
_CtrlBuilder.AddPictureBox(dr.Item("CONTROL_ID"),
dr.Item("CONTROL_NAME"),
dr.Item("CTRLSCR_X_LOC"),
dr.Item("CTRLSCR_Y_LOC"),
dr.Item("CTRLSCR_WIDTH"),
dr.Item("CTRLSCR_HEIGHT"),
False,
dr.Item("CONTROL_READ_ONLY"),
dr.Item("CONTROL_REQUIRED"),
parent)
Case 7 ' DataGridView
_CtrlBuilder.AddDataGridView(dr.Item("CONTROL_ID"),
dr.Item("CONTROL_NAME"),
dr.Item("CTRLSCR_X_LOC"),
dr.Item("CTRLSCR_Y_LOC"),
dr.Item("CTRLSCR_WIDTH"),
dr.Item("CTRLSCR_HEIGHT"),
False,
dr.Item("CONTROL_READ_ONLY"),
dr.Item("CONTROL_REQUIRED"),
dr.Item("CONTROL_COL_NAME"),
parent)
control = "Datagridview - " & dr.Item("CONTROL_ID")
Case 10 ' Checkbox
Dim Checked As Boolean = False
'If IsDBNull(dr.Item("CONTROL_DEF_VALUE")) Then
' Checked = False
'Else
' Checked = StrToBool(dr.Item("CONTROL_DEF_VALUE"))
'End If
_CtrlBuilder.AddCheckBox(dr.Item("CONTROL_ID"),
dr.Item("CONTROL_NAME"),
dr.Item("CTRLSCR_CAPTION"),
Checked,
dr.Item("CTRLSCR_X_LOC"),
dr.Item("CTRLSCR_Y_LOC"),
dr.Item("CTRLSCR_FONT_FAMILY"),
dr.Item("CTRLSCR_FONT_COLOR"),
dr.Item("CTRLSCR_FONT_SIZE"),
dr.Item("CTRLSCR_FONT_STYLE"),
dr.Item("CTRLSCR_TAB_INDEX"),
dr.Item("CTRLSCR_TAB_STOP"),
dr.Item("CTRLSCR_WIDTH"),
dr.Item("CTRLSCR_HEIGHT"),
False,
dr.Item("CONTROL_READ_ONLY"),
dr.Item("CONTROL_REQUIRED"),
parent)
control = "CheckBox - " & dr.Item("CONTROL_ID")
Case 8 ' Function AddAppointment
_CtrlBuilder.FunctionAddAppointment(dr.Item("CONTROL_ID"),
dr.Item("CONTROL_NAME"),
dr.Item("CTRLSCR_CAPTION"),
dr.Item("CTRLSCR_X_LOC"),
dr.Item("CTRLSCR_Y_LOC"),
dr.Item("CTRLSCR_WIDTH"),
dr.Item("CTRLSCR_HEIGHT"),
False,
parent)
AddHandler _CtrlBuilder.CurrentControl.Click, _AddAppointmentHandler
control = "Appointment - " & dr.Item("CONTROL_ID")
Case 9 ' Function AddFormData
_CtrlBuilder.FunctionAddFormData(dr.Item("CONTROL_ID"),
dr.Item("CONTROL_NAME"),
dr.Item("CTRLSCR_CAPTION"),
dr.Item("CTRLSCR_X_LOC"),
dr.Item("CTRLSCR_Y_LOC"),
dr.Item("CTRLSCR_WIDTH"),
dr.Item("CTRLSCR_HEIGHT"),
False,
parent)
AddHandler _CtrlBuilder.CurrentControl.Click, _AddFormDataHandler
control = "AddFormData - " & dr.Item("CONTROL_ID")
Case 11 ' RadioButton
Dim Checked As Boolean = False
'If IsDBNull(dr.Item("CONTROL_DEF_VALUE")) Then
' Checked = False
'Else
' Checked = StrToBool(dr.Item("CONTROL_DEF_VALUE"))
'End If
_CtrlBuilder.AddRadioButton(dr.Item("CONTROL_ID"),
dr.Item("CONTROL_NAME"),
dr.Item("CTRLSCR_CAPTION"),
Checked,
dr.Item("CTRLSCR_X_LOC"),
dr.Item("CTRLSCR_Y_LOC"),
dr.Item("CTRLSCR_FONT_FAMILY"),
dr.Item("CTRLSCR_FONT_COLOR"),
dr.Item("CTRLSCR_FONT_SIZE"),
dr.Item("CTRLSCR_FONT_STYLE"),
dr.Item("CTRLSCR_TAB_INDEX"),
dr.Item("CTRLSCR_TAB_STOP"),
dr.Item("CTRLSCR_WIDTH"),
dr.Item("CTRLSCR_HEIGHT"),
False,
dr.Item("CONTROL_READ_ONLY"),
dr.Item("CONTROL_REQUIRED"),
parent)
control = "Radiobutton - " & dr.Item("CONTROL_ID")
Case 12 'CheckedListBox
_CtrlBuilder.AddCheckedListBox(dr.Item("CONTROL_ID"),
dr.Item("CONTROL_NAME"),
dr.Item("CTRLSCR_X_LOC"),
dr.Item("CTRLSCR_Y_LOC"),
dr.Item("CTRLSCR_FONT_FAMILY"),
dr.Item("CTRLSCR_FONT_COLOR"),
dr.Item("CTRLSCR_FONT_SIZE"),
dr.Item("CTRLSCR_FONT_STYLE"),
dr.Item("CTRLSCR_TAB_INDEX"),
dr.Item("CTRLSCR_TAB_STOP"),
dr.Item("CTRLSCR_WIDTH"),
dr.Item("CTRLSCR_HEIGHT"),
False,
dr.Item("CONTROL_READ_ONLY"),
dr.Item("CONTROL_REQUIRED"),
dr.Item("CONTROL_STATIC_LIST"),
dr.Item("CONTROL_SQLCOMMAND_1"),
parent)
control = "CheckedlistBox - " & dr.Item("CONTROL_ID")
Case 13 'CheckedListBox
_CtrlBuilder.AddListBox(dr.Item("CONTROL_ID"),
dr.Item("CONTROL_NAME"),
dr.Item("CTRLSCR_X_LOC"),
dr.Item("CTRLSCR_Y_LOC"),
dr.Item("CTRLSCR_FONT_FAMILY"),
dr.Item("CTRLSCR_FONT_COLOR"),
dr.Item("CTRLSCR_FONT_SIZE"),
dr.Item("CTRLSCR_FONT_STYLE"),
dr.Item("CTRLSCR_TAB_INDEX"),
dr.Item("CTRLSCR_TAB_STOP"),
dr.Item("CTRLSCR_WIDTH"),
dr.Item("CTRLSCR_HEIGHT"),
False,
dr.Item("CONTROL_READ_ONLY"),
dr.Item("CONTROL_REQUIRED"),
dr.Item("CONTROL_STATIC_LIST"),
dr.Item("CONTROL_SQLCOMMAND_1"),
parent)
control = "Listbox - " & dr.Item("CONTROL_ID")
Case 14 'DataGridViewCheckable
_CtrlBuilder.AddDataGridViewCheckable(dr.Item("CONTROL_ID"),
dr.Item("CONTROL_NAME"),
dr.Item("CTRLSCR_X_LOC"),
dr.Item("CTRLSCR_Y_LOC"),
dr.Item("CTRLSCR_WIDTH"),
dr.Item("CTRLSCR_HEIGHT"),
False,
dr.Item("CTRLSCR_TAB_INDEX"),
dr.Item("CTRLSCR_TAB_STOP"),
dr.Item("CONTROL_READ_ONLY"),
dr.Item("CONTROL_REQUIRED"),
dr.Item("CONTROL_COL_NAME"),
parent)
control = "DataGridViewCheckable - " & dr.Item("CONTROL_ID")
Case 15 ' Line
_CtrlBuilder.AddLine(dr.Item("CONTROL_ID"),
dr.Item("CONTROL_NAME"),
dr.Item("CTRLSCR_X_LOC"),
dr.Item("CTRLSCR_Y_LOC"),
dr.Item("CTRLSCR_FONT_COLOR"),
dr.Item("CTRLSCR_WIDTH"),
dr.Item("CTRLSCR_HEIGHT"),
False,
parent)
control = "Line - " & dr.Item("CONTROL_ID")
End Select
' ContextMenuStrip zuweisen
' MasterDataID im ContextMenuStrip Speichern
If dr.Item("CTRLSCR_MASTER_DATA_ID") <> 0 Then
_CtrlBuilder.CurrentControl.ContextMenuStrip = _ContextMenuStrip
' Tag wird für ControlId verwendet, master data id bei rechtsklick herausfinden
'_CtrlBuilder.CurrentControl.Tag = dr.Item("CTRLSCR_MASTER_DATA_ID")
End If
Next
sw.Done()
_CtrlBuilder.MasterPanel.ResumeLayout()
End Sub
Function DeleteRecord(RecordID As Integer)
Return ClassHelper.DeleteRecord(RecordID)
End Function
Function SaveRecord(RecordID As Integer, FormID As Integer, Optional foreignRecordID As Integer = 0) As String
Try
Dim ADDED_WHO As String = USER_USERNAME
LOGGER.Debug("(SaveRecord) Update RecordID: " & RecordID, False)
If UpdateAllControls(FormID, RecordID, _CtrlBuilder.AllControls) = True Then
Return "Datensatz aktualisiert - " & Now
Else
Return "ERROR"
End If
'End If
Catch ex As Exception
MsgBox("Unexpected Error in SaveRecord: " & ex.Message, MsgBoxStyle.Critical)
End Try
End Function
Private Sub InsertAllControls(FormID As Integer, RecordID As Integer, controls As Control.ControlCollection)
For Each ctrl As Control In controls
Dim CONTROL_ID As Integer = DirectCast(ctrl.Tag, ClassControlMetadata).Id 'GetControlID_for_Name(ctrl.Name, FormID)
Dim CONTROL_VALUE As String = Nothing
If TypeOf ctrl Is PictureBox Then
'Dim id As Integer = GetControlID_for_Name(ctrl.Name, FormID)
UpsertImage(CONTROL_ID, RecordID, ctrl.BackgroundImage)
Continue For
End If
' Control existiert
If CONTROL_ID <> -1 Then
CONTROL_VALUE = GetControlValue(ctrl)
End If
'If TypeName(ctrl).ToString = "DateEdit" Then
' CONTROL_VALUE = CDate(CONTROL_VALUE)
'End If
'If CONTROL_ID = 489 Then
' Console.WriteLine(TypeName(ctrl))
'End If
' Kein Bekanntes Control oder Groupbox
If IsNothing(CONTROL_VALUE) Then
If TypeOf ctrl Is GroupBox Then
InsertAllControls(FormID, RecordID, DirectCast(ctrl, GroupBox).Controls)
End If
Else
CreateControlProcedure(CONTROL_ID, RecordID, CONTROL_VALUE, CURRENT_ENTITY_ID)
End If
Next
End Sub
Private Sub UpsertImage(ControlID As Integer, RecordID As Integer, image As Bitmap)
Dim existsSQL As String = "SELECT GUID FROM TBPMO_CONTROL_IMAGE WHERE CONTROL_ID = " & ControlID & " AND RECORD_ID = " & RecordID
Dim exists = ClassDatabase.Execute_Scalar(existsSQL)
If IsNothing(exists) Then
InsertImage(ControlID, RecordID, image)
Else
UpdateImage(ControlID, RecordID, image)
End If
End Sub
Private Sub InsertImage(ControlID As Integer, RecordID As Integer, image As Bitmap)
Try
Dim bimage() As Byte
Dim SQL As String = "INSERT INTO TBPMO_CONTROL_IMAGE (CONTROL_ID, RECORD_ID, IMG, ADDED_WHO) VALUES (@CONTROL_ID, @RECORD_ID, @IMG, @ADDED_WHO)"
Dim conn As New SqlClient.SqlConnection(MyConnectionString)
Dim cmd As New SqlClient.SqlCommand(SQL, conn)
If IsNothing(image) Then
DeleteImage(ControlID, RecordID)
Exit Sub
End If
bimage = BitmapToByteArray(image)
cmd.Parameters.Add("@CONTROL_ID", SqlDbType.Int).Value = ControlID
cmd.Parameters.Add("@RECORD_ID", SqlDbType.Int).Value = RecordID
cmd.Parameters.Add("@RECORDID", SqlDbType.Int).Value = RecordID
cmd.Parameters.Add("@IMG", SqlDbType.VarBinary).Value = bimage
cmd.Parameters.Add("@ADDED_WHO", SqlDbType.VarChar).Value = USER_USERNAME
conn.Open()
cmd.ExecuteNonQuery()
conn.Close()
LinkImage(ControlID, RecordID)
Catch ex As Exception
MsgBox("Error in InsertImage: ", ex.Message, vbCritical)
End Try
End Sub
Private Sub LinkImage(ControlID As Integer, RecordID As Integer)
Try
Dim SQL = String.Format("SELECT GUID FROM TBPMO_CONTROL_IMAGE WHERE CONTROL_ID = {0} AND RECORD_ID = {1}", ControlID, RecordID)
Dim ImageID As Integer = ClassDatabase.Execute_Scalar(SQL)
SQL = String.Format("SELECT GUID FROM TBPMO_CONTROL_VALUE WHERE CONTROL_ID = {0} AND RECORD_ID = {1}", ControlID, RecordID)
Dim valueExists = ClassDatabase.Execute_Scalar(SQL)
Dim VALUE = "%%" & ImageID.ToString & "%%"
If valueExists Then
SQL = String.Format("UPDATE TBPMO_CONTROL_VALUE SET VALUE = '{0}', CHANGED_WHO = '{1}' WHERE CONTROL_ID = {2} AND RECORD_ID = {3}", VALUE, USER_USERNAME, ControlID, RecordID)
Else
SQL = String.Format("INSERT INTO TBPMO_CONTROL_VALUE (RECORD_ID, CONTROL_ID, VALUE, ADDED_WHO) VALUES ({0}, {1}, '{2}', '{3}')", RecordID, ControlID, VALUE, USER_USERNAME)
End If
ClassDatabase.Execute_non_Query(SQL)
Catch ex As Exception
MsgBox("Error in LinkImage: " & vbNewLine & ex.Message)
End Try
End Sub
Private Sub UpdateImage(ControlID As Integer, RecordID As Integer, image As Bitmap)
Try
Dim bimage() As Byte
Dim SQL As String = "UPDATE TBPMO_CONTROL_IMAGE SET IMG = @IMG, CHANGED_WHO = @CHANGED_WHO WHERE CONTROL_ID = @CONTROL_ID AND RECORD_ID = @RECORD_ID"
Dim conn As New SqlClient.SqlConnection(MyConnectionString)
Dim cmd As New SqlClient.SqlCommand(SQL, conn)
If IsNothing(image) Then
DeleteImage(ControlID, RecordID)
Exit Sub
End If
bimage = BitmapToByteArray(image)
cmd.Parameters.Add("@CONTROL_ID", SqlDbType.Int).Value = ControlID
cmd.Parameters.Add("@RECORD_ID", SqlDbType.Int).Value = RecordID
cmd.Parameters.Add("@RECORDID", SqlDbType.Int).Value = RecordID
cmd.Parameters.Add("@IMG", SqlDbType.VarBinary).Value = bimage
cmd.Parameters.Add("@CHANGED_WHO", SqlDbType.VarChar).Value = USER_USERNAME
conn.Open()
cmd.ExecuteNonQuery()
conn.Close()
LinkImage(ControlID, RecordID)
Catch ex As Exception
MsgBox("Error in UpdateImage: ", ex.Message, vbCritical)
End Try
End Sub
Private Sub DeleteImage(ControlID As Integer, RecordID As Integer)
Try
' Delete Image
Dim SQL = String.Format("DELETE FROM TBPMO_CONTROL_IMAGE WHERE CONTROL_ID = {0} AND RECORD_ID = {1}", ControlID, RecordID)
Dim result = ClassDatabase.Execute_non_Query(SQL)
' Delete Value
SQL = String.Format("DELETE FROM TBPMO_CONTROL_VALUE WHERE CONTROL_ID = {0} AND RECORD_ID = {1}", ControlID, RecordID)
result = ClassDatabase.Execute_non_Query(SQL)
Catch ex As Exception
MsgBox("Fehler beim löschen des Bildes:" & vbNewLine & ex.Message, MsgBoxStyle.Critical)
End Try
End Sub
Private Function UpdateAllControls(FormID As Integer, RecordID As Integer, controls As Control.ControlCollection)
Try
Dim _error As Boolean = False
Dim sw As New SW("UpdateAllControls")
Dim del = String.Format("DELETE FROM TBPMO_CONTROL_VALUE_CHANGE_HISTORY WHERE UPPER(ADDED_WHO) = '{0}'", USER_USERNAME.ToUpper)
ClassDatabase.Execute_non_Query(del)
CURRENT_CHANGE_STEP += 1
Dim sel = String.Format("SELECT RECORD_ID, CONTROL_ID FROM VWPMO_VALUES WHERE RECORD_ID = {0}", RecordID)
Dim VALUE_EXISTS_DT As DataTable = ClassDatabase.Return_Datatable(sel, True)
For Each ctrl As Control In controls
Console.WriteLine("Updating Control " + ctrl.Name)
Dim CONTROL_ID As Integer = DirectCast(ctrl.Tag, ClassControlMetadata).Id 'GetControlID_for_RecordID(ctrl.Name, RecordID)
LOGGER.Debug("CONTROL_ID: " & CONTROL_ID, False)
Dim CONTROL_VALUE As String = GetControlValue(ctrl)
Dim controltype = ctrl.GetType.ToString
If TypeOf ctrl Is PictureBox Then
Dim id As Integer = DirectCast(ctrl.Tag, ClassControlMetadata).Id 'GetControlID_for_Name(ctrl.Name, FormID)
UpsertImage(id, RecordID, ctrl.BackgroundImage)
Continue For
End If
If TypeOf ctrl Is DevExpress.XtraEditors.DateEdit Then
Console.WriteLine("Updating DateEdit " + ctrl.Name)
End If
If TypeOf ctrl Is GroupBox Then
Dim ctrls As Control.ControlCollection = DirectCast(ctrl, GroupBox).Controls
UpdateAllControls(FormID, RecordID, ctrls)
Continue For
End If
If TypeOf ctrl Is System.Windows.Forms.DataGridView Then
Dim id As Integer = DirectCast(ctrl.Tag, ClassControlMetadata).Id
UpdateMultipleValues(id, RecordID, CONTROL_VALUE)
Continue For
End If
' UpdateMultipleValues wird für diese Controls bereits beim CheckedChanged-Event ausgeführt
If TypeOf ctrl Is DevExpress.XtraGrid.GridControl Or TypeOf ctrl Is DevExpress.XtraEditors.CheckedListBoxControl Then
Continue For
End If
'Dim ValueExists = ClassDatabase.Execute_Scalar(String.Format("SELECT RECORD_ID FROM VWPMO_VALUES WHERE RECORD_ID = {0} AND CONTROL_ID = {1}", RecordID, CONTROL_ID))
Dim ValueExists = VALUE_EXISTS_DT.Select(String.Format("CONTROL_ID = {0}", CONTROL_ID))
Dim ValueChanged As Boolean = _CtrlBuilder.ControlsChanged.Contains(CONTROL_ID)
If Not ValueChanged Then
Continue For
End If
If ValueExists.Length = 0 Then ' Neues Control
'If CONTROL_ID = 995 Or CONTROL_ID = 996 Or CONTROL_ID = 997 Or CONTROL_ID = 810 Then
' Console.WriteLine("sdasd")
'End If
LOGGER.Debug("InsertControlValue: " & CONTROL_ID & "|" & RecordID & "|" & CONTROL_VALUE, False)
If Not IsNothing(CONTROL_VALUE) Then
If TypeOf ctrl Is CustomComboBox And CONTROL_VALUE = "" Then
'Exit Sub - Zuviel des guten
Continue For
End If
If CONTROL_VALUE <> "" Then
If CreateControlProcedure(CONTROL_ID, RecordID, CONTROL_VALUE, CURRENT_ENTITY_ID) = 0 Then
_error = True
End If
End If
End If
Else ' Update Control
Dim isEmptyValue As Boolean = IsNothing(CONTROL_VALUE) Or CONTROL_VALUE = String.Empty
Dim isDateEdit = TypeOf ctrl Is DevExpress.XtraEditors.DateEdit
Dim isTextBox = TypeOf ctrl Is TextBox
Dim isComboBox = TypeOf ctrl Is CustomComboBox
' Bei bestimmten Controls soll der Wert in CONTROL_VALUES gelöscht werden
' wenn der Wert im Control leer ist
If (isDateEdit Or isTextBox Or isComboBox) And isEmptyValue Then
Dim sql As String = $"DELETE FROM TBPMO_CONTROL_VALUE WHERE RECORD_ID = {RecordID} AND CONTROL_ID = {CONTROL_ID}"
If ClassDatabase.Execute_non_Query(sql) = True Then
If LICENSE_PROXY = True Or clsDatabase.DB_PROXY_INITIALIZED = True Then
ClassDatabase.Execute_non_Query(sql, True)
End If
End If
Else
If Not IsNothing(CONTROL_VALUE) Then
Dim sw2 As New SW("UpdateControlValue")
UpdateControlValue(CONTROL_ID, RecordID, CONTROL_VALUE, CURRENT_ENTITY_ID)
sw2.Done()
End If
End If
End If
Next
sw.Done()
If _error = True Then
Return False
Else
Return True
End If
Catch ex As Exception
MsgBox("Unexpected Error in UpdateAllControls: " & vbNewLine & ex.Message, MsgBoxStyle.Critical)
Return False
End Try
End Function
Public Shared Sub UpdateMultipleValues(ControlId As Integer, RecordId As Integer, value As String)
Try
Dim val = String.Format("SELECT VALUE FROM TBPMO_CONTROL_VALUE WHERE CONTROL_ID = {0} AND RECORD_ID = {1}", ControlId, RecordId)
Dim dt As DataTable = ClassDatabase.Return_Datatable(val, True)
If IsNothing(dt) Then
Exit Sub
End If
' Konvertiere datatable zu liste
Dim oldValues = dt.AsEnumerable().Select(Of String)(Function(r)
Return r.Item("VALUE")
End Function).ToList()
If (IsNothing(value) Or value = String.Empty) And dt.Rows.Count = 0 Then
Exit Sub
End If
Dim values As New List(Of String)
If Not IsNothing(value) Then
values = New List(Of String)(value.Split(";"))
Else
values.Add("")
End If
'Dim values As New List(Of String)(value.Split(";"))
Dim AddValues = values.Except(oldValues).ToList()
Dim RemoveValues = oldValues.Except(values).ToList()
For Each _addValue As String In AddValues
If Not _addValue = "" Then
Dim converted_value = Check_and_Format_Value(ControlId, RecordId, _addValue)
If Not IsNothing(converted_value) Then
ClassControlCommandsUI.CreateControlProcedure(ControlId, RecordId, converted_value, CURRENT_ENTITY_ID)
End If
End If
Next
For Each v As String In RemoveValues
ClassDatabase.Execute_non_Query(String.Format("DELETE FROM TBPMO_CONTROL_VALUE WHERE CONTROL_ID = {0} AND RECORD_ID = {1} AND VALUE = '{2}'", ControlId, RecordId, v))
' ClassProxy.PRPROXY_CONTROL_DEL(RecordId, CURRENT_ENTITY_ID, ControlId)
Next
ClassProxy.PRPROXY_CONTROL_VALUE_UPD_INS(CURRENT_ENTITY_ID, ControlId, RecordId, "")
Catch ex As Exception
MsgBox("Error in UpdateMultipleValues:" & vbNewLine & ex.Message)
End Try
End Sub
Public Shared Function GetControlValue(ctrl As Control) As String
Dim type = ctrl.GetType().Name
Dim CONTROL_ID As Integer = DirectCast(ctrl.Tag, ClassControlMetadata).Id ' GetControlID_for_RecordID(ctrl.Name, CURRENT_RECORD_ID)
LOGGER.Debug("GetControlValue CONTROL_ID: " & CONTROL_ID, False)
Dim CONTROL_VALUE As String = Nothing
LOGGER.Debug("type = " & type.ToString, False)
Select Case type
Case "TextBox"
Return DirectCast(ctrl, TextBox).Text
Case "CustomComboBox"
LOGGER.Debug("Return Value: " & DirectCast(ctrl, CustomComboBox).Text, False)
Return DirectCast(ctrl, CustomComboBox).Text
Case "CheckBox"
Return DirectCast(ctrl, CheckBox).Checked.ToString()
Case "RadioButton"
Return DirectCast(ctrl, RadioButton).Checked.ToString()
Case "DateEdit"
Dim Value = DirectCast(ctrl, DevExpress.XtraEditors.DateEdit).EditValue
If IsDBNull(Value) Or IsNothing(Value) Then
Return ""
Else
Dim datevalue = DirectCast(ctrl, DevExpress.XtraEditors.DateEdit).DateTime.ToString("yyyy-MM-dd")
If datevalue = "0001-01-01" Then
Return ""
Else
Return datevalue
End If
End If
Case "PictureBox"
'Return "PictureBox" 'Es ist egal was für ein String hier zurückgegeben wird, hauptsache nicht Nothing
Case "CheckedListBoxControl"
Dim chklbx As DevExpress.XtraEditors.CheckedListBoxControl
chklbx = DirectCast(ctrl, DevExpress.XtraEditors.CheckedListBoxControl)
Dim SQL_COMAMND = ClassDatabase.Execute_Scalar("SELECT UPPER(SQL_COMMAND_1) FROM TBPMO_CONTROL WHERE GUID = " & CONTROL_ID, True)
'TODO: Wenn keine Datasource vorhanden, angecheckte einträge als string speichern
If IsNothing(chklbx.DataSource) Then
Dim result As New List(Of String)
Dim result_string As String
For Each item As DevExpress.XtraEditors.Controls.CheckedListBoxItem In chklbx.CheckedItems
result.Add(item.Value.ToString.Trim)
Next
result_string = String.Join(";", result)
' Hier wird ein String zurückgegeben, der als VALUE gespeichert werden soll
' Überspringt den Rest der funktion
Return result_string
End If
If SQL_COMAMND.ToString.StartsWith("SELECT [RECORD_ID]") Or SQL_COMAMND.ToString.StartsWith("SELECT [RECORD-ID]") Then
'Alle Recorddatensätze durchlaufen und überprüfen ob nicht angehakt
'Wenn nicht angehakt dann Record löschen
Dim index As Integer = 0
For i As Integer = 0 To chklbx.ItemCount - 1
Dim item = chklbx.GetItem(i)
Dim row As DataRowView = CType(item, DataRowView)
If chklbx.GetItemCheckState(i) = 0 Then
If CInt(row(0)) > 0 Then
'Überprüfen ob es den Record gibt
Dim SQL = "SELECT COUNT(*) FROM TBPMO_RECORD_CONNECT WHERE RECORD1_ID = " & CURRENT_RECORD_ID & " AND RECORD2_ID = " & CInt(row(0))
If ClassDatabase.Execute_Scalar(SQL, True) = 1 Then
SQL = "DELETE FROM TBPMO_RECORD_CONNECT WHERE RECORD1_ID = " & CURRENT_RECORD_ID & " AND RECORD2_ID = " & CInt(row(0))
If ClassDatabase.Execute_non_Query(SQL) = True Then
LOGGER.Debug("TBPMO_RECORD_CONNECT-Entry after 'deselect CheckedListBox' deleted", False)
End If
End If
End If
End If
Next
End If
'Für jeden gecheckten Eintrag den Record der Stammentität mit dem selektierten linken
Dim checked_result As New List(Of String)
Dim checked_result_string As String
If SQL_COMAMND.ToString.StartsWith("SELECT [RECORD_ID]") Or SQL_COMAMND.ToString.StartsWith("SELECT [RECORD-ID]") Then
For Each item As Object In DirectCast(ctrl, DevExpress.XtraEditors.CheckedListBoxControl).CheckedItems
Dim row As DataRowView = CType(item, DataRowView)
Try
If CInt(row(0)) > 0 Then
Dim rid = CInt(row(0))
Dim checked_value = row(1)
checked_result.Add(checked_value)
checked_result_string = String.Join(";", checked_result)
Dim SQL = "SELECT COUNT(*) FROM TBPMO_RECORD_CONNECT WHERE RECORD1_ID = " & CURRENT_RECORD_ID & " AND RECORD2_ID = " & CInt(row(0))
If ClassDatabase.Execute_Scalar(SQL, True) = 0 Then
If CURRENT_RECORD_ID = 0 Then
MsgBox("Attention: no current record Selected!", MsgBoxStyle.Exclamation)
Else
If ClassRecordCommands.ConnectRecord(CURRENT_RECORD_ID, CInt(row(0)), "CheckedListBox;" & ctrl.Name) = True Then
LOGGER.Debug("Checked ListBox record '" & rid.ToString & "' was linked successfully.", False)
End If
End If
End If
End If
Catch ex As Exception
LOGGER.Warn("Error in CheckedListBoxGetControlValue: " & ex.Message)
End Try
Next
Else
For Each item As Object In DirectCast(ctrl, DevExpress.XtraEditors.CheckedListBoxControl).CheckedItems
Dim row As DataRowView = CType(item, DataRowView)
If row.DataView.Table.Columns.Count = 1 Then
Dim checked_value = row(0)
checked_result.Add(checked_value)
ElseIf row.DataView.Table.Columns.Count = 2 Then
Dim checked_value = row(1)
checked_result.Add(checked_value)
End If
checked_result_string = String.Join(";", checked_result)
Next
End If
' Hier wird ein String zurückgegeben, der als VALUE gespeichert werden soll
' Überspringt den Rest der funktion
If Not IsNothing(checked_result_string) Then
'Dim sql = String.Format("select count(*) from TBPMO_CONTROL_VALUE where CONTROL_ID = {0} and RECORD_ID = {1}", CONTROL_ID, CURRENT_RECORD_ID)
'If ClassDatabase.Execute_Scalar(sql) = 0 Then
' InsertControlValue(CONTROL_ID, CURRENT_RECORD_ID, "")
'End If
Return checked_result_string
Else
'In jedem Fall Nothing zurückgeben
Return Nothing
End If
Case "GridControl"
Dim chk_grid As DevExpress.XtraGrid.GridControl
chk_grid = DirectCast(ctrl, DevExpress.XtraGrid.GridControl)
Dim gridview As DevExpress.XtraGrid.Views.Grid.GridView = chk_grid.MainView
Dim SQL_COMAMND = ClassDatabase.Execute_Scalar("SELECT UPPER(SQL_COMMAND_1) FROM TBPMO_CONTROL WHERE GUID = " & CONTROL_ID, True)
Dim result As New List(Of String)
Dim result_string As String
For Each index As Integer In gridview.GetSelectedRows()
Dim fieldName As String = gridview.Columns(0).FieldName
Dim value As String = gridview.GetRowCellValue(index, fieldName)
result.Add(value)
Next
CURRENT_CONTROL_VALUE_COUNT = result.Count
result_string = String.Join(";", result)
If Not IsNothing(result_string) Then
Return result_string
Else
Return Nothing
End If
Case "ListBoxControl"
Dim listbox As DevExpress.XtraEditors.ListBoxControl = DirectCast(ctrl, DevExpress.XtraEditors.ListBoxControl)
Return listbox.SelectedValue
Case "DataGridView"
Dim list As New List(Of String)
Dim dgv As DataGridView = DirectCast(ctrl, DataGridView)
For Each row As DataGridViewRow In dgv.Rows
Dim cell As DataGridViewCell = row.Cells(0)
If Not IsNothing(cell.Value) Then
list.Add(cell.Value)
End If
Next
Return String.Join(";", list)
Case Else
Return Nothing
End Select
End Function
Public Class MyBaseClass
End Class
Public Class MyDerivedClass : Inherits MyBaseClass
End Class
Public Shared Function Check_and_Format_Value(ControlID As Integer, RecordID As Integer, Value As String)
Try
Dim expression As String
expression = "GUID = " & ControlID
Dim CONTROL_ROW() As DataRow
' Use the Select method to find all rows matching the filter.
CONTROL_ROW = CURRENT_TBPMO_CONTROL.Select(expression)
Dim i As Integer
Dim FORMAT_TYPE As String, CONTROL_TYPE As Integer
For i = 0 To CONTROL_ROW.GetUpperBound(0)
FORMAT_TYPE = CONTROL_ROW(i)("FORMAT_TYPE")
CONTROL_TYPE = CONTROL_ROW(i)("CONTROL_TYPE_ID")
Next
If CONTROL_TYPE = 0 And FORMAT_TYPE Is Nothing Then
If IsDate(Value) Then
CONTROL_TYPE = 4
End If
End If
Select Case FORMAT_TYPE
Case "Currency"
If Not Value = String.Empty Then
Value = Decimal.Parse(Value, Globalization.NumberStyles.Currency).ToString
End If
Case "Decimal"
If Not Value = String.Empty Then
Value = Decimal.Parse(Value, Globalization.NumberStyles.Integer)
End If
End Select
Select Case CONTROL_TYPE
Case 4
Dim oDate = ClassHelper.Convert_to_Database_Date(Value)
Value = oDate.ToString()
End Select
Value = Value.Replace("'", "´")
Return Value
Catch ex As Exception
MsgBox("Unexpected Error in Check_and_Format_Value: " & vbNewLine & ex.Message, MsgBoxStyle.Critical)
LOGGER.Warn("Unexpected Error in Check_and_Format_Value: " & ex.Message)
Return Nothing
End Try
End Function
Public Shared Function CreateControlProcedure(ControlID As Integer, RecordID As Integer, Value As String, ENTITY_ID As Integer)
Try
Dim _result As Integer
Dim converted_value = Check_and_Format_Value(ControlID, RecordID, Value)
If Not IsNothing(converted_value) Then
Dim connection As New SqlConnection
connection.ConnectionString = MyConnectionString
Using cmd As New SqlCommand("PRPMO_CREATE_CONTROL_VALUE", connection)
cmd.CommandType = CommandType.StoredProcedure
cmd.Parameters.AddWithValue("@pRECORD_ID", RecordID)
cmd.Parameters.AddWithValue("@pCONTROL_ID", ControlID)
cmd.Parameters.AddWithValue("@pVALUE", converted_value)
cmd.Parameters.AddWithValue("@pADDED_WHO", USER_USERNAME)
cmd.Parameters.Add("@pRESULT", SqlDbType.Int)
cmd.Parameters("@pRESULT").Direction = ParameterDirection.Output
connection.Open()
cmd.ExecuteNonQuery()
connection.Close()
_result = cmd.Parameters("@pRESULT").Value
If _result = 1 And clsDatabase.DB_PROXY_INITIALIZED = True Then
ClassProxy.PRPROXY_CONTROL_VALUE_UPD_INS(ENTITY_ID, ControlID, RecordID, converted_value)
End If
Return _result
End Using
Else
_result = 0
End If
Catch ex As Exception
Dim name = clsDatabase.Execute_Scalar("SELECT NAME FROM TBPMO_CONTROL WHERE GUID = " & ControlID, True)
MsgBox(ex.Message, MsgBoxStyle.Critical, "Error in CreateControlProcedure für Control: " & name)
LOGGER.Warn("Error in CreateControlProcedure: " & ex.Message, True)
Return 0
End Try
End Function
Public Shared Function InsertControlValueOld(ControlID As Integer, RecordID As Integer, Value As String, ENTITY_ID As Integer)
Try
Dim AddedWho = USER_USERNAME
Dim converted_value = Check_and_Format_Value(ControlID, RecordID, Value)
If Not IsNothing(converted_value) Then
converted_value = converted_value.Replace("'", "´")
Dim ins As String = String.Format("INSERT INTO TBPMO_CONTROL_VALUE (CONTROL_ID, RECORD_ID, VALUE, ADDED_WHO) VALUES ({0}, {1}, '{2}', '{3}')", ControlID, RecordID, converted_value, AddedWho)
If LICENSE_PROXY = True Or clsDatabase.DB_PROXY_INITIALIZED = True Then
If ClassDatabase.Execute_non_Query(ins) = True Then
Return ClassProxy.PRPROXY_CONTROL_VALUE_UPD_INS(ENTITY_ID, ControlID, RecordID, converted_value)
Else
Return False
End If
Else
Return ClassDatabase.Execute_non_Query(ins)
End If
Else
Return False
End If
Catch ex As Exception
MsgBox("Unexpected Error in inserting Control-Value: " & vbNewLine & ex.Message, MsgBoxStyle.Critical)
LOGGER.Warn("Unexpected Error in inserting Control-Value: " & ex.Message)
Return False
End Try
End Function
Public Shared Function UpdateControlValue(ControlID As Integer, RecordID As Integer, Value As String, ENTITY_ID As Integer)
Try
Dim CHANGED_WHO = USER_USERNAME
Dim converted_value = Check_and_Format_Value(ControlID, RecordID, Value)
Dim def = "SELECT FORMAT_TYPE,CONTROL_TYPE_ID FROM TBPMO_CONTROL WHERE GUID = " & ControlID
Dim upd = String.Format("UPDATE TBPMO_CONTROL_VALUE SET VALUE = '{0}', CHANGED_WHO = '{1}', CHANGE_STEP = {2} WHERE CONTROL_ID = {3} AND RECORD_ID = {4}",
converted_value, CHANGED_WHO, CURRENT_CHANGE_STEP, ControlID, RecordID)
If ControlID = 279 Or ControlID = 745 Then
LOGGER.Warn(upd)
End If
If LICENSE_PROXY = True Or clsDatabase.DB_PROXY_INITIALIZED = True Then
If ClassDatabase.Execute_non_Query(upd) = True Then
Return ClassProxy.PRPROXY_CONTROL_VALUE_UPD_INS(ENTITY_ID, ControlID, RecordID, converted_value)
Else
Return False
End If
Else
Return ClassDatabase.Execute_non_Query(upd)
End If
Catch ex As Exception
LOGGER.Warn("Unerwarteter Fehler in UpdateControlValue: " & ex.Message)
Return False
End Try
End Function
End Class

View File

@@ -0,0 +1,583 @@
Namespace ControlLoader
Public Class _BaseControl
'Public Shared Function ReplaceSqlCommandPlaceholders(sqlCommand As String, recordId As Integer, parentRecordId As Integer, entity_ID As Integer)
' sqlCommand = sqlCommand.Replace("@RECORD_ID", recordId)
' sqlCommand = sqlCommand.Replace("@RECORDID", recordId)
' Dim sql As String = "SELECT FORM_ID FROM TBPMO_RECORD WHERE FORM_ID = "
' ss()
' sqlCommand = sqlCommand.Replace("@ENTITY_ID", recordId)
' sqlCommand = sqlCommand.Replace("@PARENTRECORD_ID", parentRecordId)
' sqlCommand = sqlCommand.Replace("@PARENTRECORDID", parentRecordId)
' Return sqlCommand
'End Function
Public Shared Function LoadAutoValue(control As System.Windows.Forms.Control, RecordId As Integer, ParentRecordId As Integer, entity_ID As Integer)
Try
Dim AutoValue As String = String.Empty
Dim ControlId As Integer = DirectCast(control.Tag, ClassControlMetadata).Id
Dim CONNID = ClassDatabase.Execute_Scalar(String.Format("SELECT CONNECTION_ID_1 FROM TBPMO_CONTROL WHERE GUID = {0}", ControlId))
Dim SQL As String = ClassDatabase.Execute_Scalar(String.Format("SELECT SQL_COMMAND_1 FROM TBPMO_CONTROL WHERE GUID = {0}", ControlId))
SQL = ClassControlValues.ReplaceSqlCommandPlaceholders(SQL, RecordId, ParentRecordId, entity_ID)
If SQL = "" Or IsDBNull(SQL) Then
Return Nothing
End If
If Not IsNothing(CONNID) Then
AutoValue = ClassDatabase.Execute_ScalarWithConnection(CONNID, SQL)
Else
AutoValue = ClassDatabase.Execute_Scalar(SQL, True)
End If
' AutoValue = ClassDatabase.Execute_Scalar(SQL)
If String.IsNullOrEmpty(AutoValue) Or IsDBNull(AutoValue) Then
Return Nothing
End If
Return AutoValue
Catch ex As Exception
LOGGER.Warn("Unexpected Error in LoadAutoValue: " & ex.Message)
Return Nothing
End Try
End Function
End Class
Public Class _ListControl : Inherits _BaseControl
Public Shared Function GetDynamicValue(controlId As Integer, formId As Integer, connID As Object, sqlCommand As String) As DynamicValue
Dim returnValue As DynamicValue
returnValue.StaticList = CheckForStaticList(controlId)
returnValue.DataTable = GetSqlList(controlId, formId, connID, sqlCommand)
Return returnValue
End Function
Private Shared Function CheckForStaticList(controlId As Integer) As List(Of String)
Try
' Der alte SQL Befehl hat nicht wirklich nach der StaticList geschaut o_O
' Dim SQL As String = String.Format("SELECT VALUE FROM VWPMO_VALUES WHERE CONTROL_ID = {0} AND RECORD_ID = {1}", controlId, recordId)
Dim SQL As String = String.Format("SELECT STATIC_LIST FROM TBPMO_CONTROL WHERE GUID = {0}", controlId)
Dim staticList As String = ClassDatabase.Execute_Scalar(SQL, True)
If IsNothing(staticList) Or String.IsNullOrWhiteSpace(staticList) Then
Return Nothing
Else
Return New List(Of String)(staticList.Split(";").ToArray())
End If
Catch ex As Exception
MsgBox("Error in CheckForStaticList: " & vbNewLine & ex.Message)
Return Nothing
End Try
End Function
Public Shared Function GetSqlList(controlId As Integer, formId As Integer, connection_Id As Object, sqlCommand As String) As DataTable
Try
If sqlCommand Is Nothing Or sqlCommand = String.Empty Then
Return Nothing
End If
Dim cached As DataTable = ClassControlValueCache.LoadFromCache(sqlCommand)
Dim final As DataTable
If cached Is Nothing Then
If Not IsDBNull(connection_Id) Then
final = ClassDatabase.MSSQL_ReturnDTWithConnection(connection_Id, sqlCommand)
Else
final = ClassDatabase.Return_Datatable(sqlCommand)
End If
ClassControlValueCache.SaveToCache(sqlCommand, final)
Console.WriteLine("CACHE MISS")
Else
final = cached
Console.WriteLine("CACHE HIT")
End If
Return final
Catch ex As Exception
MsgBox("Error in GetSqlList: " & vbNewLine & ex.Message)
Return Nothing
End Try
End Function
Overloads Shared Sub SetDataSource(control As DevExpress.XtraGrid.GridControl, dt As DataTable)
Try
Dim columnCount As Integer = dt.Columns.Count
Dim rowCount As Integer = dt.Rows.Count
' Zuerst die Datasource leeren und neu setzen
control.DataSource = Nothing
control.DataSource = dt
' Wir müssen PopulateColumns und RefreshData nach dem Setzen der Datasource aufrufen
' ansonsten wird das Grid leer bleiben und die neuen Daten nicht anzeigen
control.MainView.PopulateColumns()
control.MainView.RefreshData()
'Jetzt noch den Columnname ändern
Dim gridview = DirectCast(control.MainView, DevExpress.XtraGrid.Views.Grid.GridView)
Dim caption As String = ClassDatabase.Execute_Scalar(String.Format("SELECT COL_NAME FROM TBPMO_CONTROL WHERE GUID = {0}", DirectCast(control.Tag, ClassControlMetadata).Id), True)
gridview.Columns(0).Caption = caption
Catch ex As Exception
MsgBox("Error in SetDataSource - GridControl: " & ex.Message, MsgBoxStyle.Critical)
End Try
End Sub
Overloads Shared Sub SetDataSource(control As CustomComboBox, dt As DataTable)
Dim sw As New SW("SetDataSource CustomComboBox")
Dim columnCount As Integer = dt.Columns.Count
control.BeginUpdate()
PerfomanceHelper.SuspendDraw(control)
' Damit beim Setzen von DisplayMember und ValueMember kein Fehler auftritt,
' muss die Datasource zunächst geleert werden und der selected index auf -1 gesetzt werden.
control.DataSource = Nothing
control.SelectedIndex = -1
' Es ist wichtig, dass DisplayMember und ValueMember VOR der DataSource festgelegt werden,
' Dadurch ist das Laden der Datasource um einiges SCHNELLER
If columnCount = 1 Then
control.DisplayMember = dt.Columns(0).ColumnName
control.ValueMember = dt.Columns(0).ColumnName
ElseIf columnCount = 2 Then
control.DisplayMember = dt.Columns(1).ColumnName
control.ValueMember = dt.Columns(0).ColumnName
End If
' Als letztes setzen wir die DataSource
control.DataSource = dt
PerfomanceHelper.ResumeDraw(control)
control.EndUpdate()
sw.Done()
End Sub
Overloads Shared Sub SetDataSource(control As DevExpress.XtraEditors.CheckedListBoxControl, dt As DataTable)
Dim columnCount As Integer = dt.Columns.Count
' Damit beim Setzen von DisplayMember und ValueMember kein Fehler auftritt,
' muss die Datasource zunächst geleert werden und der selected index auf -1 gesetzt werden.
control.DataSource = Nothing
control.SelectedIndex = -1
' Es ist wichtig, dass DisplayMember und ValueMember VOR der DataSource festgelegt werden,
' Dadurch ist das Laden der Datasource um einiges SCHNELLER
If columnCount = 1 Then
control.DisplayMember = dt.Columns(0).ColumnName
control.ValueMember = dt.Columns(0).ColumnName
ElseIf columnCount = 2 Then
control.DisplayMember = dt.Columns(1).ColumnName
control.ValueMember = dt.Columns(0).ColumnName
End If
' Als letztes setzen wir die DataSource
control.DataSource = dt
End Sub
Overloads Shared Sub SetDataSource(control As DevExpress.XtraEditors.ListBoxControl, dt As DataTable)
Dim columnCount As Integer = dt.Columns.Count
' Damit beim Setzen von DisplayMember und ValueMember kein Fehler auftritt,
' muss die Datasource zunächst geleert werden und der selected index auf -1 gesetzt werden.
control.DataSource = Nothing
control.SelectedIndex = -1
' Es ist wichtig, dass DisplayMember und ValueMember VOR der DataSource festgelegt werden,
' Dadurch ist das Laden der Datasource um einiges SCHNELLER
If columnCount = 1 Then
control.DisplayMember = dt.Columns(0).ColumnName
control.ValueMember = dt.Columns(0).ColumnName
ElseIf columnCount = 2 Then
control.DisplayMember = dt.Columns(1).ColumnName
control.ValueMember = dt.Columns(0).ColumnName
End If
' Als letztes setzen wir die DataSource
control.DataSource = dt
End Sub
Overloads Shared Sub SetDataSource(control As System.Windows.Forms.DataGridView, dt As DataTable)
control.DataSource = dt
End Sub
End Class
Public Structure DynamicValue
Public StaticList As List(Of String)
Public DataTable As DataTable
End Structure
Public Class Label : Inherits _BaseControl
Public Shared Sub LoadValue(control As System.Windows.Forms.Label, recordId As Integer, parentRecordId As Integer, value As String, entity_ID As Integer, Optional VARIABLE_VALUE As Boolean = False)
Dim Sql
Dim ControlId As Integer
Try
ControlId = DirectCast(control.Tag, ClassControlMetadata).Id
Dim autoValue
Dim drarray() As DataRow = CURRENT_SQL_AUTO_VALUES_DT.Select("GUID = " & ControlId)
If drarray.Length > 0 Then
Dim ID
Try
ID = drarray(0)("CONNECTION_ID_1").ToString
Catch ex As Exception
ID = drarray(0)("CONNECTION_ID").ToString
End Try
If Not IsNothing(ID) Then
Sql = drarray(0)("SQL_COMMAND_1").ToString
Sql = ClassControlValues.ReplaceSqlCommandPlaceholders(Sql, recordId, parentRecordId, entity_ID)
autoValue = ClassDatabase.Execute_ScalarWithConnection(ID, Sql)
Else
autoValue = ClassDatabase.Execute_Scalar(Sql, True)
End If
If IsNothing(autoValue) Then
If VARIABLE_VALUE = True Then
control.Text = value
Else
Sql = String.Format("SELECT GUID FROM TBPMO_CONTROL_SCREEN WHERE CONTROL_ID = {0} AND SCREEN_ID = {1}", ControlId, 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 = '{1}'", ctrl_screen_id, USER_LANGUAGE)
Dim labelText As String = ClassDatabase.Execute_Scalar(Sql)
control.Text = labelText
End If
End If
Else
If IsDBNull(autoValue) Then
control.Text = "ATTENTION: result of select was dbnull"
Else
control.Text = autoValue
End If
End If
End If
Catch ex As Exception
MsgBox("Unexpected Error in LoadValueMain:" & vbNewLine & ex.Message, MsgBoxStyle.Critical)
LOGGER.Warn("Unexpected Error in LoadValueMain: " & ex.Message)
LOGGER.Warn(String.Format("ControlID: {0}" & vbNewLine & "recordid: {1}" & vbNewLine & "parentRecordId: {2}" & vbNewLine & "value: {3}" & vbNewLine & "entity_ID: {4}" & vbNewLine & "VARIABLE_VALUE: {5}", ControlId, recordId, parentRecordId, value, entity_ID, VARIABLE_VALUE), False)
End Try
End Sub
End Class
Public Class Checkbox : Inherits _BaseControl
Public Shared Sub LoadValue(control As System.Windows.Forms.CheckBox, value As String)
Try
Dim result As Boolean = False
Boolean.TryParse(value, result)
control.Checked = result
Catch ex As Exception
MsgBox("Unexpected Error in LoadValue1:" & vbNewLine & ex.Message)
LOGGER.Warn("Unexpected Error in LoadValue1: " & ex.Message)
End Try
End Sub
End Class
Public Class RadioButton : Inherits _BaseControl
Public Shared Sub LoadValue(control As System.Windows.Forms.RadioButton, value As String)
Try
Dim result As Boolean = False
Boolean.TryParse(value, result)
control.Checked = result
Catch ex As Exception
MsgBox("Unexpected Error in LoadValue2:" & vbNewLine & ex.Message)
LOGGER.Warn("Unexpected Error in LoadValue2: " & ex.Message)
End Try
End Sub
End Class
Public Class TextBox : Inherits _BaseControl
Public Shared Sub LoadValue(control As System.Windows.Forms.TextBox, recordId As Integer, parentRecordId As Integer, value As String, entity_ID As Integer, Optional VARIABLE_VALUE As Boolean = False)
Try
Dim ControlMeta As ClassControlMetadata = DirectCast(control.Tag, ClassControlMetadata)
Dim ControlId As Integer = ControlMeta.Id
Dim ControlFormat As String = ControlMeta.Format
If CURRENT_RECORD_ENABLED = False Then
If ControlFormat = "Currency" Then
control.Text = ClassHelper.Format_Currency(value, USER_LANGUAGE)
Else
control.Text = value
End If
Else
If VARIABLE_VALUE = True Then
If ControlFormat = "Currency" Then
control.Text = ClassHelper.Format_Currency(value, USER_LANGUAGE)
Else
control.Text = value
End If
Else
Dim drarray() As DataRow = CURRENT_SQL_AUTO_VALUES_DT.Select("GUID = " & ControlId)
If drarray.Length > 0 Then
Dim autoValue
Dim ID
Try
ID = drarray(0)("CONNECTION_ID_1").ToString
Catch ex As Exception
ID = drarray(0)("CONNECTION_ID").ToString
End Try
Dim Sql = drarray(0)("SQL_COMMAND").ToString
If Not IsNothing(ID) Then
autoValue = ClassDatabase.Execute_ScalarWithConnection(ID, Sql)
Else
autoValue = ClassDatabase.Execute_Scalar(Sql, True)
End If
' AutoValue = ClassDatabase.Execute_Scalar(SQL)
If String.IsNullOrEmpty(autoValue) Or IsDBNull(autoValue) Then
control.Text = value
Else
control.Text = autoValue
End If
End If
'If USER_WAN = True Then 'WENN in einer WAN-Umgebung betrieben
'Else 'in LAN-Umgebung
' Dim autoValue = LoadAutoValue(control, recordId, parentRecordId, entity_ID)
' If IsNothing(autoValue) Then
' control.Text = value
' Else
' control.Text = autoValue
' End If
'End If
End If
End If
Catch ex As Exception
MsgBox("Unexpected Error in LoadValue3:" & vbNewLine & ex.Message)
LOGGER.Warn("Unexpected Error in LoadValue3: " & ex.Message)
End Try
End Sub
End Class
Public Class DateTimePicker : Inherits _BaseControl
Public Shared Sub LoadValue(control As DevExpress.XtraEditors.DateEdit, value As String)
If String.IsNullOrWhiteSpace(value) Or value = "00:00:00" Then
control.DateTime = DateTime.MinValue
Else
If Not DateTime.TryParse(value, control.DateTime) Then
control.DateTime = DateTime.MinValue
End If
End If
End Sub
End Class
Public Class Combobox : Inherits _ListControl
Public Shared Sub LoadValue(control As CustomComboBox, recordId As Integer, parentRecordId As Integer, value As String)
control.Text = value
End Sub
Public Shared Sub LoadList(control As CustomComboBox, formId As Integer, connID As Object, SQLCommand As String)
Try
Dim sw As New SW("LoadList CustomComboBox")
Dim sw1 As New SW("GetDynamicValue CustomComboBox")
Dim dynamic As DynamicValue = GetDynamicValue(DirectCast(control.Tag, ClassControlMetadata).Id, formId, connID, SQLCommand)
sw1.Done()
If dynamic.StaticList IsNot Nothing Then
control.DataSource = dynamic.StaticList
End If
If dynamic.DataTable IsNot Nothing AndAlso dynamic.DataTable.Rows.Count > 0 Then
SetDataSource(control, dynamic.DataTable)
CalculateDropdownWidth(control, dynamic.DataTable)
End If
sw.Done()
Catch ex As Exception
MsgBox("Error in Combobox.LoadList:" & vbNewLine & ex.Message)
End Try
End Sub
Private Shared Sub CalculateDropdownWidth(control As CustomComboBox, dt As DataTable)
Try
Const WIDEST_WIDTH As Integer = 300
Dim FinalWidth As Integer = WIDEST_WIDTH
Dim index As Integer = 1
If dt.Columns.Count = 1 Then
index = 0
End If
For Each row As DataRow In dt.Rows
'Die Breite der Dropdown-List anpassen
Using g As Graphics = control.CreateGraphics()
Dim valueWidth As Integer = g.MeasureString(row.Item(index).ToString(), control.Font).Width
If valueWidth + 30 > FinalWidth Then
FinalWidth = valueWidth + 30
End If
g.Dispose()
End Using
Next
If FinalWidth > WIDEST_WIDTH Then
control.DropDownWidth = Math.Max(FinalWidth, control.Width)
End If
Catch ex As Exception
MsgBox("Error in CalculateDropdownWidth:" & vbNewLine & ex.Message)
End Try
End Sub
End Class
Public Class CheckedListBox : Inherits _ListControl
Public Shared Sub LoadValue(control As DevExpress.XtraEditors.CheckedListBoxControl, values As List(Of Object))
If IsNothing(values) Then
Exit Sub
End If
CURRENT_RECORD_ENABLED = False
control.UnCheckAll()
For Each v As String In values
'For i As Integer = 0 To control.ItemCount - 1
' Console.WriteLine(control.GetItemText(i))
'Next i
Dim posBefore As Integer = 0
While (control.FindStringExact(v, posBefore) > -1)
Dim pos = control.FindStringExact(v, posBefore)
' Wenn v gefunden wurde, anhaken
If pos >= 0 Then
control.SetItemCheckState(pos, CheckState.Checked)
posBefore = pos + 1
End If
' Verhindere Endlosschleife
If pos = 100 Then
Exit While
End If
End While
Next
End Sub
Public Shared Sub LoadList(control As DevExpress.XtraEditors.CheckedListBoxControl, formId As Integer, conn_Id As Object, SQLCommand As String)
Try
Dim sw As New SW("LoadList CheckedListBoxControl")
Dim dynamic As DynamicValue = GetDynamicValue(DirectCast(control.Tag, ClassControlMetadata).Id, formId, conn_Id, SQLCommand)
If dynamic.StaticList IsNot Nothing Then
control.Items.Clear()
For Each item In dynamic.StaticList
control.Items.Add(item)
Next
'control.DataSource = dynamic.StaticList
End If
If dynamic.DataTable IsNot Nothing AndAlso dynamic.DataTable.Rows.Count > 0 Then
'control.Items.Clear()
SetDataSource(control, dynamic.DataTable)
End If
sw.Done()
Catch ex As Exception
MsgBox("Error in CheckedListBox.LoadList:" & vbNewLine & ex.Message)
End Try
End Sub
End Class
Public Class ListBox : Inherits _ListControl
Public Shared Sub LoadValue(control As DevExpress.XtraEditors.ListBoxControl, value As String)
If IsNothing(value) Then
Exit Sub
End If
control.SelectedIndex = control.FindStringExact(value)
End Sub
Public Shared Sub LoadList(control As DevExpress.XtraEditors.ListBoxControl, formId As Integer, ConnId As Object, SQLCommand As String)
Dim sw As New SW("LoadList ListBoxControl")
Dim dynamic As DynamicValue = GetDynamicValue(DirectCast(control.Tag, ClassControlMetadata).Id, formId, ConnId, SQLCommand)
If dynamic.StaticList IsNot Nothing Then
control.DataSource = dynamic.StaticList
End If
If dynamic.DataTable IsNot Nothing AndAlso dynamic.DataTable.Rows.Count > 0 Then
SetDataSource(control, dynamic.DataTable)
End If
sw.Done()
End Sub
End Class
Public Class DataGridView : Inherits _ListControl
Public Shared Sub LoadValue(control As System.Windows.Forms.DataGridView, values As List(Of Object))
control.Rows.Clear()
For Each item In values
control.Rows.Add(item.ToString)
Next
End Sub
End Class
Public Class DataGridViewCheckable : Inherits _ListControl
Public Shared Sub LoadList(control As DevExpress.XtraGrid.GridControl, formId As Integer, ConnId As Object, SQLCommand As String)
Dim sw As New SW("LoadList GridControl")
Dim dynamic As DynamicValue = GetDynamicValue(DirectCast(control.Tag, ClassControlMetadata).Id, formId, ConnId, SQLCommand)
If dynamic.StaticList IsNot Nothing Then
control.DataSource = dynamic.StaticList
End If
If dynamic.DataTable IsNot Nothing AndAlso dynamic.DataTable.Rows.Count > 0 Then
SetDataSource(control, dynamic.DataTable)
End If
End Sub
Public Shared Sub LoadValue(control As DevExpress.XtraGrid.GridControl, values As List(Of Object))
Dim gridview As DevExpress.XtraGrid.Views.Grid.GridView = control.MainView
Dim focused As Boolean = False
For i As Integer = 0 To gridview.RowCount - 1
Dim fieldName As String = gridview.Columns(0).FieldName
Dim rowhandle As Integer = gridview.GetRowHandle(i)
Dim rowvalue As String = gridview.GetRowCellValue(rowhandle, fieldName)
If values.Contains(rowvalue) Then
If focused = False Then
gridview.FocusedRowHandle = rowhandle
focused = True
End If
gridview.SelectRow(rowhandle)
End If
Next
End Sub
End Class
End Namespace

View File

@@ -0,0 +1,6 @@
Public Structure ClassControlMetadata
Public Property Id As Integer
Public Property Name As String
Public Property Required As Boolean
Public Property Format As String
End Structure

View File

@@ -0,0 +1,793 @@
Imports System.ComponentModel
Imports System.Resources
Module ClassControlProperties
' ++++++ LOCALIZE PROPERTIES ++++++
Private Function Lookup(key As String)
Try
Return My.Resources.ControlProperties.ResourceManager.GetString(key)
Catch ex As Exception
Return key
End Try
End Function
Public Class LocalizedDescriptionAttribute
Inherits DescriptionAttribute
Public Sub New(key As String)
MyBase.New(Lookup(key))
End Sub
End Class
Public Class LocalizedCategoryAttribute
Inherits CategoryAttribute
Public Sub New(key As String)
MyBase.New(Lookup(key))
End Sub
End Class
' +++++ END LOCALIZE PROPERTIES +++++
' +++++ ABSTRACT CLASSES +++++
Public MustInherit Class BaseProperties
Private _id As Integer
Private _type As String
Private _size As Size
Private _location As Point
Private _name As String
Private _hint As String
Private _visible As Boolean
Private _tree_view As Boolean
<LocalizedCategoryAttribute("category_other")>
<LocalizedDescriptionAttribute("desc_tree_view")>
Public Property TreeView() As Boolean
Get
Return _tree_view
End Get
Set(value As Boolean)
_tree_view = value
End Set
End Property
<LocalizedCategoryAttribute("category_info")>
<LocalizedDescriptionAttribute("desc_id")>
<ReadOnlyAttribute(True)>
Public Property ID() As Integer
Get
Return _id
End Get
Set(value As Integer)
_id = value
End Set
End Property
<LocalizedCategoryAttribute("category_info")>
<LocalizedDescriptionAttribute("desc_type")>
<ReadOnlyAttribute(True)>
Public Property ControlType() As String
Get
Return _type
End Get
Set(value As String)
_type = value
End Set
End Property
<LocalizedCategoryAttribute("category_view")>
<LocalizedDescriptionAttribute("desc_hint")>
Public Property Hint() As String
Get
Return _hint
End Get
Set(value As String)
_hint = value
End Set
End Property
<LocalizedCategoryAttribute("category_view")>
<LocalizedDescriptionAttribute("desc_visible")>
Public Property Visible() As Boolean
Get
Return _visible
End Get
Set(value As Boolean)
_visible = value
End Set
End Property
<LocalizedCategoryAttribute("category_view")>
<LocalizedDescriptionAttribute("desc_size")>
Public Property Size() As Size
Get
Return _size
End Get
Set(value As Size)
_size = value
End Set
End Property
<LocalizedCategoryAttribute("category_view")>
<LocalizedDescriptionAttribute("desc_location")>
Public Property Location() As Point
Get
Return _location
End Get
Set(value As Point)
_location = value
End Set
End Property
<LocalizedCategoryAttribute("category_view")>
<LocalizedDescriptionAttribute("desc_name")>
Public Property Name() As String
Get
Return _name
End Get
Set(value As String)
_name = value
End Set
End Property
End Class
Public MustInherit Class CommonProperties
Inherits BaseProperties
Private _id As Integer
' ViewConfigurations
Private _size As Size
Private _location As Point
Private _name As String = ""
Private _column_title = ""
' Database Configurations
Private _sql_command As String = ""
Private _sql_command_2 As String = "" 'EnabledWhen
' Font Configurations
Private _font As Font
Private _font_color As Color
<LocalizedCategoryAttribute("category_view")>
<LocalizedDescriptionAttribute("desc_col_title")>
Public Property ColumnTitle() As String
Get
Return _column_title
End Get
Set(value As String)
_column_title = value
End Set
End Property
<LocalizedCategoryAttribute("category_database")>
<LocalizedDescriptionAttribute("desc_sqlcommand")>
Public Property SQLCommand() As SQLValue
Get
Return New SQLValue(_sql_command)
End Get
Set(value As SQLValue)
_sql_command = value.Value
End Set
End Property
<LocalizedCategoryAttribute("category_database")>
<LocalizedDescriptionAttribute("desc_enabledwhen")>
Public Property EnabledWhen() As SQLValue
Get
Return New SQLValue(_sql_command_2)
End Get
Set(value As SQLValue)
_sql_command_2 = value.Value
End Set
End Property
<LocalizedCategoryAttribute("category_font")>
<LocalizedDescriptionAttribute("desc_fontstyle")>
Public Property Font() As Font
Get
Return _font
End Get
Set(value As Font)
_font = value
End Set
End Property
<LocalizedCategoryAttribute("category_font")>
<LocalizedDescriptionAttribute("desc_fontcolor")>
Public Property FontColor() As Color
Get
Return _font_color
End Get
Set(value As Color)
_font_color = value
End Set
End Property
End Class
Public MustInherit Class InputControlProperties
Inherits CommonProperties
Private _default_Value As String
Private _tab_index As Integer
Private _tab_stop As Boolean
Private _show_column As Boolean
' Other Configurations
Private _required As Boolean = False
Private _read_only As Boolean = False
<LocalizedCategoryAttribute("category_other")>
<LocalizedDescriptionAttribute("desc_required")>
Public Property IsRequired() As Boolean
Get
Return _required
End Get
Set(value As Boolean)
_required = value
End Set
End Property
<LocalizedCategoryAttribute("category_other")>
<LocalizedDescriptionAttribute("desc_readonly")>
Public Property IsReadOnly() As Boolean
Get
Return _read_only
End Get
Set(value As Boolean)
_read_only = value
End Set
End Property
<LocalizedCategoryAttribute("category_other")>
<LocalizedDescriptionAttribute("desc_tabindex")>
Public Property TabIndex() As Integer
Get
Return _tab_index
End Get
Set(value As Integer)
_tab_index = value
End Set
End Property
<LocalizedCategoryAttribute("category_other")>
<LocalizedDescriptionAttribute("desc_tabstop")>
Public Property TabStop() As Boolean
Get
Return _tab_stop
End Get
Set(value As Boolean)
_tab_stop = value
End Set
End Property
<LocalizedCategoryAttribute("category_other")>
<LocalizedDescriptionAttribute("desc_defaultvalue")>
<DefaultValue("")>
Public Property DefaultValue() As String
Get
Return _default_Value
End Get
Set(value As String)
_default_Value = value
End Set
End Property
<LocalizedCategoryAttribute("category_view")>
<LocalizedDescriptionAttribute("desc_showcolumn")>
Public Property ShowColumn() As Boolean
Get
Return _show_column
End Get
Set(value As Boolean)
_show_column = value
End Set
End Property
End Class
' +++++ CONTROL CLASSES +++++
Public Class LabelProperties
Inherits CommonProperties
Private _caption As String = ""
<Browsable(False)>
<LocalizedCategoryAttribute("category_view")>
<LocalizedDescriptionAttribute("desc_col_title")>
Public Overloads Property ColumnTitle() As String
Get
Return ""
End Get
Set(value As String)
'_column_title = value
End Set
End Property
<Browsable(False)>
<LocalizedCategoryAttribute("category_other")>
<LocalizedDescriptionAttribute("desc_tree_view")>
Public Overloads Property TreeView() As Boolean
Get
Return False
End Get
Set(value As Boolean)
'_tree_view = value
End Set
End Property
<LocalizedCategoryAttribute("category_view")>
<LocalizedDescriptionAttribute("desc_caption")>
Public Property Caption() As String
Get
Return _caption
End Get
Set(value As String)
_caption = value
End Set
End Property
End Class
Public Class LineProperties
Inherits CommonProperties
<Browsable(False)>
<LocalizedCategoryAttribute("category_view")>
<LocalizedDescriptionAttribute("desc_col_title")>
Public Overloads Property ColumnTitle() As String
Get
Return ""
End Get
Set(value As String)
'_column_title = value
End Set
End Property
<Browsable(False)>
<LocalizedCategoryAttribute("category_other")>
<LocalizedDescriptionAttribute("desc_tree_view")>
Public Overloads Property TreeView() As Boolean
Get
Return False
End Get
Set(value As Boolean)
'_tree_view = value
End Set
End Property
End Class
Public Class TextBoxProperties
Inherits InputControlProperties
Private _multiline As Boolean
Private _autosuggest As Boolean
Private _format As String
<LocalizedCategoryAttribute("category_view")>
<LocalizedDescriptionAttribute("desc_format")>
Public Property Format() As EnumFormatOptions
Get
Return _format
End Get
Set(value As EnumFormatOptions)
_format = value
End Set
End Property
<LocalizedCategoryAttribute("category_view")>
<LocalizedDescriptionAttribute("desc_multiline")>
Public Property Multiline() As Boolean
Get
Return _multiline
End Get
Set(value As Boolean)
_multiline = value
End Set
End Property
<LocalizedCategoryAttribute("category_view")>
<LocalizedDescription("desc_autosuggest")>
Public Property AutoSuggest() As Boolean
Get
Return _autosuggest
End Get
Set(value As Boolean)
_autosuggest = value
End Set
End Property
End Class
Public Class ComboBoxProperties
Inherits InputControlProperties
Private _master_data_id As Integer
Private _static_list As String
Private _format As EnumFormatOptions
Private _select_only As Boolean
<LocalizedCategoryAttribute("category_other")>
<LocalizedDescriptionAttribute("desc_select_only")>
Public Property IsSelectOnly() As Boolean
Get
Return _select_only
End Get
Set(value As Boolean)
_select_only = value
End Set
End Property
<LocalizedCategoryAttribute("category_view")>
<LocalizedDescriptionAttribute("desc_format")>
Public Property Format() As EnumFormatOptions
Get
Return _format
End Get
Set(value As EnumFormatOptions)
_format = value
End Set
End Property
<LocalizedCategoryAttribute("category_other")>
<LocalizedDescriptionAttribute("desc_masterdataid")>
Public Property MasterDataId() As Integer
Get
Return _master_data_id
End Get
Set(value As Integer)
_master_data_id = value
End Set
End Property
<LocalizedCategoryAttribute("category_data")>
<LocalizedDescriptionAttribute("desc_staticlist")>
Public Property StaticList() As StaticListValue
Get
Return New StaticListValue(_static_list)
End Get
Set(value As StaticListValue)
_static_list = value.Value
End Set
End Property
End Class
Public Class DateTimePickerProperties
Inherits InputControlProperties
Private _default_value As EnumDateTimePickerDefaultValueOptions = EnumDateTimePickerDefaultValueOptions.Empty
<LocalizedCategoryAttribute("category_other")>
<LocalizedDescriptionAttribute("desc_defaultvalue")>
Public Overloads Property DefaultValue() As EnumDateTimePickerDefaultValueOptions
Get
Return _default_value
End Get
Set(value As EnumDateTimePickerDefaultValueOptions)
_default_value = value
End Set
End Property
End Class
Public Class CheckBoxProperties
Inherits InputControlProperties
Private _caption As String = ""
Private _default_value As Boolean = False
<Browsable(False)>
Public Overloads Property TreeView() As Boolean
Get
Return False
End Get
Set(value As Boolean)
'noop
End Set
End Property
<LocalizedCategoryAttribute("category_view")>
<LocalizedDescriptionAttribute("desc_caption")>
Public Property Caption() As String
Get
Return _caption
End Get
Set(value As String)
_caption = value
End Set
End Property
<LocalizedCategoryAttribute("category_other")>
<LocalizedDescriptionAttribute("desc_defaultvalue")>
<DefaultValue(False)>
Public Overloads Property DefaultValue As Boolean
Get
Return _default_value
End Get
Set(value As Boolean)
_default_value = value
End Set
End Property
End Class
Public Class RadioButtonProperties
Inherits InputControlProperties
Private _caption As String = ""
Private _default_value As Boolean = False
<Browsable(False)>
Public Overloads Property TreeView() As Boolean
Get
Return False
End Get
Set(value As Boolean)
'noop
End Set
End Property
<LocalizedCategoryAttribute("category_view")>
<LocalizedDescriptionAttribute("desc_caption")>
Public Property Caption() As String
Get
Return _caption
End Get
Set(value As String)
_caption = value
End Set
End Property
<LocalizedCategoryAttribute("category_other")>
<LocalizedDescriptionAttribute("desc_defaultvalue")>
<DefaultValue(False)>
Public Overloads Property DefaultValue As Boolean
Get
Return _default_value
End Get
Set(value As Boolean)
_default_value = value
End Set
End Property
End Class
Public Class DataGridViewProperties
Inherits CommonProperties
Private _show_column As Boolean
Private _required As Boolean
Private _read_only As Boolean
Private _tree_view As Boolean
<LocalizedCategoryAttribute("category_view")>
<LocalizedDescriptionAttribute("desc_showcolumn")>
Public Property ShowColumn() As Boolean
Get
Return _show_column
End Get
Set(value As Boolean)
_show_column = value
End Set
End Property
<LocalizedCategoryAttribute("category_other")>
<LocalizedDescriptionAttribute("desc_required")>
Public Property IsRequired() As Boolean
Get
Return _required
End Get
Set(value As Boolean)
_required = value
End Set
End Property
<LocalizedCategoryAttribute("category_other")>
<LocalizedDescriptionAttribute("desc_readonly")>
Public Property IsReadOnly() As Boolean
Get
Return _read_only
End Get
Set(value As Boolean)
_read_only = value
End Set
End Property
End Class
Public Class PictureBoxProperties
Inherits CommonProperties
Private _required As Boolean
Private _read_only As Boolean
<LocalizedCategoryAttribute("category_other")>
<LocalizedDescriptionAttribute("desc_required")>
Public Property IsRequired() As Boolean
Get
Return _required
End Get
Set(value As Boolean)
_required = value
End Set
End Property
<LocalizedCategoryAttribute("category_other")>
<LocalizedDescriptionAttribute("desc_readonly")>
Public Property IsReadOnly() As Boolean
Get
Return _read_only
End Get
Set(value As Boolean)
_read_only = value
End Set
End Property
End Class
Public Class GroupBoxProperties
Inherits CommonProperties
Private _caption As String = ""
Private _back_color As Color
<Browsable(False)>
Public Overloads Property TreeView() As Boolean
Get
Return False
End Get
Set(value As Boolean)
'noop
End Set
End Property
<LocalizedCategoryAttribute("category_view")>
<LocalizedDescriptionAttribute("desc_caption")>
Public Property Caption() As String
Get
Return _caption
End Get
Set(value As String)
_caption = value
End Set
End Property
<LocalizedCategoryAttribute("category_view")>
<LocalizedDescriptionAttribute("desc_backcolor")>
Public Property BackColor() As Color
Get
Return _back_color
End Get
Set(value As Color)
_back_color = value
End Set
End Property
End Class
' +++++ FUNCTION CLASSES +++++
Public Class FunctionAddAppointmentProperties
Inherits BaseProperties
Private _caption As String
Private _subject As String
Private _subject2 As String
Private _from_date As String
Private _from_time As String
Private _to_date As String
Private _to_time As String
Private _place As String
Private _description As String
<LocalizedCategoryAttribute("category_view")>
<LocalizedDescriptionAttribute("desc_caption")>
Public Property Caption() As String
Get
Return _caption
End Get
Set(value As String)
_caption = value
End Set
End Property
<LocalizedCategoryAttribute("category_appointment")>
<LocalizedDescriptionAttribute("desc_subject")>
Public Property Subject() As String
Get
Return _subject
End Get
Set(value As String)
_subject = value
End Set
End Property
<LocalizedCategoryAttribute("category_appointment")>
<LocalizedDescriptionAttribute("desc_subject2")>
Public Property Subject2() As String
Get
Return _subject2
End Get
Set(value As String)
_subject2 = value
End Set
End Property
<LocalizedCategoryAttribute("category_appointment")>
<LocalizedDescriptionAttribute("desc_place")>
Public Property Place() As String
Get
Return _place
End Get
Set(value As String)
_place = value
End Set
End Property
<LocalizedCategoryAttribute("category_appointment")>
<LocalizedDescriptionAttribute("desc_description")>
Public Property Description() As String
Get
Return _description
End Get
Set(value As String)
_description = value
End Set
End Property
<LocalizedCategoryAttribute("category_date")>
<LocalizedDescriptionAttribute("desc_fromdate")>
Public Property FromDate() As String
Get
Return _from_date
End Get
Set(value As String)
_from_date = value
End Set
End Property
<LocalizedCategoryAttribute("category_date")>
<LocalizedDescriptionAttribute("desc_todate")>
Public Property ToDate() As String
Get
Return _to_date
End Get
Set(value As String)
_to_date = value
End Set
End Property
End Class
Public Class FunctionAddFormDataProperties
Inherits BaseProperties
Private _caption As String
Private _form_id As Integer
Private _screen_id As Integer
<LocalizedCategoryAttribute("category_view")>
<LocalizedDescriptionAttribute("desc_caption")>
Public Property Caption() As String
Get
Return _caption
End Get
Set(value As String)
_caption = value
End Set
End Property
<LocalizedCategoryAttribute("category_form")>
<LocalizedDescriptionAttribute("desc_formid")>
Public Property FormID() As Integer
Get
Return _form_id
End Get
Set(value As Integer)
_form_id = value
End Set
End Property
<LocalizedCategoryAttribute("category_form")>
<LocalizedDescriptionAttribute("desc_screenid")>
Public Property ScreenID() As Integer
Get
Return _screen_id
End Get
Set(value As Integer)
_screen_id = value
End Set
End Property
End Class
End Module

View File

@@ -0,0 +1,55 @@
Public Class ClassControlValueCache
Private Shared Property Cache As New Dictionary(Of String, DataTable)
' ClassControlValueCache
' Ordnet SQL Queries den daraus resultierenden DataTables zu.
'
' Somit kann eine Query in der Laufzeit des Programms von mehreren Forms genutzt werden,
' muss aber nur einmal vom Server abgefragt werden.
Public Shared Function LoadFromCache(sqlCommand As String) As DataTable
' Mit ToUpper wird das Command case-insensitive,
' es ist also egal, ob die query GROSS oder klein geschrieben wird
Dim UpperCaseCommand = sqlCommand.ToUpper()
If Cache.ContainsKey(UpperCaseCommand) Then
Return Cache.Item(UpperCaseCommand)
Else
Return Nothing
End If
End Function
Public Shared Sub SaveToCache(sqlCommand As String, dt As DataTable)
Dim UpperCaseCommand = sqlCommand.ToUpper()
' Dynamische Queries dürfen nicht gecached werden
If (UpperCaseCommand.Contains("@")) Then
Exit Sub
End If
Cache.Item(UpperCaseCommand) = dt
End Sub
Public Shared Sub ClearCache()
Cache.Clear()
End Sub
' =========================================================================================
Private Shared Property HintCache As New Dictionary(Of Integer, String)
Public Shared Function LoadHint(controlId As Integer) As String
If HintCache.ContainsKey(controlId) Then
Dim hint As String = HintCache.Item(controlId)
If hint.Length = 0 Then
Return Nothing
End If
Return HintCache.Item(controlId)
Else
Return Nothing
End If
End Function
Public Shared Sub SaveHint(controlId As Integer, hint As String)
HintCache.Item(controlId) = hint
End Sub
End Class

View File

@@ -0,0 +1,893 @@
Imports DevExpress.XtraEditors.Controls
Imports System.Text.RegularExpressions
Public Class ClassControlValues
Public Shared Function ControlHasValue(control As Control) As Boolean
Try
Select Case control.GetType()
Case GetType(TextBox)
Dim textbox As TextBox = DirectCast(control, TextBox)
If textbox.Text.Trim() = String.Empty Then
Return False
Else
Return True
End If
Case GetType(CustomComboBox)
Dim combobox As CustomComboBox = DirectCast(control, CustomComboBox)
If combobox.Text.Trim() = String.Empty Then
Return False
Else
Return True
End If
Case GetType(CheckBox)
Dim checkbox As CheckBox = DirectCast(control, CheckBox)
Return checkbox.Checked
Case GetType(RadioButton)
Dim radiobutton As RadioButton = DirectCast(control, RadioButton)
Return radiobutton.Checked
Case GetType(DevExpress.XtraEditors.DateEdit)
Dim datepicker As DevExpress.XtraEditors.DateEdit = DirectCast(control, DevExpress.XtraEditors.DateEdit)
If IsDBNull(datepicker.EditValue) Or datepicker.EditValue = DateTime.MinValue Then
Return False
Else
Return True
End If
Case GetType(DevExpress.XtraEditors.ListBoxControl)
Dim listbox As DevExpress.XtraEditors.ListBoxControl = DirectCast(control, DevExpress.XtraEditors.ListBoxControl)
If listbox.SelectedIndex = -1 Then
Return False
Else
Return True
End If
Case GetType(DevExpress.XtraEditors.CheckedListBoxControl)
Dim checkedlistbox = DirectCast(control, DevExpress.XtraEditors.CheckedListBoxControl)
If checkedlistbox.CheckedItemsCount = 0 Then
Return False
Else
Return True
End If
Case GetType(PictureBox)
Dim picturebox = DirectCast(control, PictureBox)
If IsNothing(picturebox.BackgroundImage) Then
Return False
Else
Return True
End If
Case Else
Return True
End Select
Catch ex As Exception
Return False
End Try
End Function
' Überprüft, welche Controls "Required" sind
Public Shared Function CheckRequiredControlValues(controls As Control.ControlCollection, Optional isGroupbox As Boolean = False) As List(Of String)
Dim missingValues As New List(Of String)
'If isGroupbox = True Then
' Dim radiobuttons As New List(Of RadioButton)
' Dim otherControls As New List(Of Control)
' ' Nach allen Radiobuttons suchen
' For Each c As Control In controls
' If TypeOf c Is RadioButton Then
' radiobuttons.Add(DirectCast(c, RadioButton))
' Else
' otherControls.Add(c)
' End If
' Next
' ' Wenn mindestens 1 MussFeld-Radiobutton in der Groupbox
' Dim atLeastOneRadioButtonHasRequired = False
' For Each rb As RadioButton In radiobuttons
' If DirectCast(rb.Tag, ClassControlMetadata).Required = True Then
' atLeastOneRadioButtonHasRequired = True
' Exit For
' End If
' Next
' If atLeastOneRadioButtonHasRequired Then
' ' Alle RadioButtons die angeklickt wurden (ist meistens einer :o)
' Dim radioButtonsWithValue = (From rb As RadioButton In radiobuttons
' Where ControlHasValue(rb)
' Select rb.Name).ToArray()
' ' Wenn kein RadioButton angeklickt wurde, nehmen wir alle in einen String,
' ' da GENAU EINER angeklickt werden MUSS
' If radioButtonsWithValue Is Nothing Then
' Dim missingValue As String = String.Join(", ", radiobuttons)
' missingValues.Add(missingValue)
' End If
' End If
'End If
For Each Control As Control In controls
Dim metadata = DirectCast(Control.Tag, ClassControlMetadata)
If TypeOf Control Is Label Then
Continue For
End If
'Radio Buttons müssen nicht überprüft werden, da eine RadioButton Group
'immer ein Control mit Checked = true hat
If TypeOf Control Is RadioButton Then
Continue For
End If
Console.WriteLine(Control.Name)
' Groupbox muss rekursiv überprüft werden
If TypeOf Control Is GroupBox Then
Dim groupbox As GroupBox = DirectCast(Control, GroupBox)
Dim gbfields As List(Of String) = CheckRequiredControlValues(groupbox.Controls, True)
missingValues.AddRange(gbfields)
Continue For
End If
If IsNothing(metadata.Required) OrElse metadata.Required = False Then
Continue For
End If
If Not ControlHasValue(Control) And Control.Enabled = True Then
missingValues.Add(Control.Name)
End If
Next
Return missingValues.Distinct().ToList()
End Function
Public Shared Sub LoadControlValues(RecordId As Integer, ParentRecordId As Integer, FormId As Integer, controls As Control.ControlCollection, Entity_ID As Integer, Optional isGroupbox As Boolean = False)
Try
Dim sw As New SW("LoadControlValues1")
'Dim SQL As String = String.Format("SELECT * FROM VWPMO_VALUES WHERE VALUE <> '' AND RECORD_ID = {0}", RecordId)
Dim SQL As String = String.Format("SELECT * FROM VWPMO_VALUES WHERE RECORD_ID = {0}", RecordId)
Dim DT_ControlValues As DataTable = ClassDatabase.Return_Datatable(SQL, True)
CURRENT_CONTROL_VALUES = DT_ControlValues
sw.Done()
If controls.Count = 0 Then
LOGGER.Warn("the control-Collection in LoadControlValuesNeu is empty!")
If (Not isGroupbox) Then
ENTITY_RELOAD_AFT_CONTROL_LOAD = True
End If
Exit Sub
End If
' Zuerst alle Controls leeren
ClearControlValues(controls)
sw = New SW("LoadControlValues2")
' Load all Hints for controls
Dim SQLHint = "SELECT * FROM VWPMO_CONTROL_HINT WHERE FORM_ID = " & FormId
Dim DT_Hints As DataTable = ClassDatabase.Return_Datatable(SQLHint, True)
' ' Hint in DT_Hints suchen der zur aktuellen controlId passt
For Each row As DataRow In DT_Hints.Rows
ClassControlValueCache.SaveHint(row.Item(1), row.Item(2))
Next
' LoadControlHints(controls)
sw.Done()
sw = New SW("LoadControlValues3")
For Each control As Control In controls
PerfomanceHelper.SuspendDraw(control)
Dim ControlId As Integer = DirectCast(control.Tag, ClassControlMetadata).Id
' Wert per LINQ aus DT_ControlValues suchen der zur aktuellen controlId passt
Dim values As List(Of Object) = (From row In DT_ControlValues.AsEnumerable()
Where row.Item("CONTROL_ID") = ControlId
Select row.Item("VALUE")).ToList()
If TypeOf control Is GroupBox Then
Dim groupbox As GroupBox = DirectCast(control, GroupBox)
LoadControlValues(RecordId, ParentRecordId, FormId, groupbox.Controls, Entity_ID, True)
Else
If ControlId = 439 Then
Console.WriteLine("Control 439")
End If
LoadControlValue(RecordId, ParentRecordId, ControlId, control, values, Entity_ID)
End If
PerfomanceHelper.ResumeDraw(control)
Next
sw.Done()
Catch ex As Exception
LOGGER.Warn("Unexpected Error in LoadControlValuesNeu: " & ex.Message)
MsgBox("Error in LoadControlValuesNeu:" & vbNewLine & ex.Message, MsgBoxStyle.Critical)
End Try
End Sub
Public Shared Function GetControlValuesREC_CONTROL(RecordId As Integer, CONTROL_ID As Integer)
Try
'Dim SQL As String = String.Format("SELECT * FROM VWPMO_VALUES WHERE VALUE <> '' AND RECORD_ID = {0}", RecordId)
Dim SQL As String = String.Format("SELECT VALUE FROM VWPMO_VALUES WHERE RECORD_ID = {0} AND CONTROL_ID = {1}", RecordId, CONTROL_ID)
Dim RESULT = ClassDatabase.Execute_Scalar(SQL, True)
If IsNothing(RESULT) Then
Return Nothing
ElseIf RESULT = "" Then
Return Nothing
Else
Return RESULT
End If
Catch ex As Exception
LOGGER.Warn("Unexpected Error in GetControlValuesREC_CONTROL: " & ex.Message)
MsgBox("Error in GetControlValuesREC_CONTROL:" & vbNewLine & ex.Message, MsgBoxStyle.Critical)
Return Nothing
End Try
End Function
Private Shared Sub LoadControlHints(controls As Control.ControlCollection)
For Each c As Control In controls
Dim id As Integer = DirectCast(c.Tag, ClassControlMetadata).Id
Dim sql As String = String.Format("SELECT HINT FROM TBPMO_CONTROL_LANGUAGE WHERE CONTROL_SCREEN_ID = (SELECT GUID FROM TBPMO_CONTROL_SCREEN WHERE CONTROL_ID = {0} AND SCREEN_ID = 1) AND LANGUAGE_TYPE = '{1}' AND HINT IS NOT NULL", id, USER_LANGUAGE)
Dim hint = ClassDatabase.Execute_Scalar(sql)
If IsNothing(hint) Then
Continue For
End If
ClassControlValueCache.SaveHint(id, hint.ToString)
Next
End Sub
Public Shared Sub LoadControlValue(recordId As Integer, parentRecordId As Integer, controlId As Integer, control As Control, values As List(Of Object), entity_ID As Integer)
' Try
' Für die meisten Controls wird nur das erste Element der Liste benötigt
Dim value As String = Nothing
If values.Count > 0 Then
value = values.Item(0)
End If
Select Case control.GetType()
Case GetType(TextBox)
If CURRENT_CONTROL_ID = 272 Then
Console.WriteLine("272")
End If
Dim textbox As TextBox = DirectCast(control, TextBox)
ControlLoader.TextBox.LoadValue(textbox, recordId, parentRecordId, value, entity_ID)
Case GetType(Label)
Dim label As Label = DirectCast(control, Label)
ControlLoader.Label.LoadValue(label, recordId, parentRecordId, value, entity_ID)
Case GetType(CustomComboBox)
Dim combobox As CustomComboBox = DirectCast(control, CustomComboBox)
ControlLoader.Combobox.LoadValue(combobox, recordId, parentRecordId, value)
Case GetType(CheckBox)
Dim checkbox As CheckBox = DirectCast(control, CheckBox)
ControlLoader.Checkbox.LoadValue(checkbox, value)
Case GetType(RadioButton)
LOGGER.Debug("Sub LoadControlValueNeu - GetType(RadioButton) ", False)
Dim radiobutton As RadioButton = DirectCast(control, RadioButton)
ControlLoader.RadioButton.LoadValue(radiobutton, value)
Case GetType(DevExpress.XtraEditors.DateEdit)
Dim datepicker As DevExpress.XtraEditors.DateEdit = DirectCast(control, DevExpress.XtraEditors.DateEdit)
ControlLoader.DateTimePicker.LoadValue(datepicker, value)
Case GetType(DevExpress.XtraEditors.ListBoxControl)
Dim listbox As DevExpress.XtraEditors.ListBoxControl = DirectCast(control, DevExpress.XtraEditors.ListBoxControl)
ControlLoader.ListBox.LoadValue(listbox, value)
Case GetType(DevExpress.XtraEditors.CheckedListBoxControl)
Dim checkedlistbox As DevExpress.XtraEditors.CheckedListBoxControl = DirectCast(control, DevExpress.XtraEditors.CheckedListBoxControl)
ControlLoader.CheckedListBox.LoadValue(checkedlistbox, values)
Case GetType(PictureBox)
Dim picturebox = DirectCast(control, PictureBox)
LoadImage(recordId, controlId, picturebox)
Case GetType(DataGridView)
Dim gridview = DirectCast(control, DataGridView)
ControlLoader.DataGridView.LoadValue(gridview, values)
Case GetType(DevExpress.XtraGrid.GridControl)
Dim gridcontrol As DevExpress.XtraGrid.GridControl = DirectCast(control, DevExpress.XtraGrid.GridControl)
ControlLoader.DataGridViewCheckable.LoadValue(gridcontrol, values)
Case Else
If GetType(Control).ToString() <> "System.Windows.Forms.Control" Then
LOGGER.Warn("Sub LoadControlValue - Control-Type nicht berücksichtigt: " & GetType(Control).ToString(), False)
End If
End Select
'Catch ex As Exception
' Logger.Warn("Unexpected Error in LoadControlValue: " & ex.Message)
' MsgBox("Error in LoadControlValue:" & vbNewLine & ex.Message)
'End Try
End Sub
Public Shared Sub LoadControlValuesList(FormID As Integer, controls As Control.ControlCollection)
Try
Dim sw As New SW("LoadControlValuesList - Database")
If controls.Count = 0 Then
'MsgBox("LoadControlValuesList: Control.ControlCollection is unexpected empty!", MsgBoxStyle.Exclamation)
LOGGER.Warn("LoadControlValuesList: Control.ControlCollection is unexpected empty!")
Exit Sub
End If
' Zuerst alle SQL Commands für FormID finden
' CONTROL_SQLCOMMAND_1 wird als SQL gealiast
'Dim SQL As String = String.Format("SELECT CONTROL_ID, CONTROL_CONNID_1,CONTROL_SQLCOMMAND_1 AS SQL FROM VWPMO_CONTROL_SCREEN WHERE FORM_ID = {0} AND CONTROL_SQLCOMMAND_1 NOT LIKE '%@%'", FormID)
Dim Sql = String.Format("FORM_ID = {0} AND CONTROL_SQLCOMMAND_1 NOT LIKE '%@%'", FormID)
Dim dt As DataTable = ClassHelper.FILTER_DATATABLE(DT_VWPMO_CONTROL_SCREEN, Sql, "") 'ClassDatabase.Return_Datatable(SQL, True)
sw.Done()
If dt.Rows.Count = 0 Then
Exit Sub
End If
sw = New SW("LoadControlValuesList")
For Each Ctrl As Control In controls
Dim controlTagId = DirectCast(Ctrl.Tag, ClassControlMetadata).Id
PerfomanceHelper.SuspendDraw(Ctrl)
'If controlTagId = 474 Then
' MsgBox("Thats it")
'End If
'Datatable nach row mit CONTROL_ID wie Ctrl suchen
Dim row As DataRow = dt.Select(String.Format("CONTROL_ID={0}", controlTagId)).FirstOrDefault()
If IsNothing(row) Then
' Beim aussteigen muss wieder ResumeDraw aufgerufen werden
PerfomanceHelper.ResumeDraw(Ctrl)
Continue For
End If
Dim sqlcommand As String = row.Item("CONTROL_SQLCOMMAND_1")
Dim ConnID = row.Item("CONTROL_CONNID_1")
Select Case Ctrl.GetType()
Case GetType(CustomComboBox)
Dim combobox = DirectCast(Ctrl, CustomComboBox)
ControlLoader.Combobox.LoadList(combobox, FormID, ConnID, sqlcommand)
Case GetType(DevExpress.XtraEditors.ListBoxControl)
Dim listbox = DirectCast(Ctrl, DevExpress.XtraEditors.ListBoxControl)
ControlLoader.ListBox.LoadList(listbox, FormID, ConnID, sqlcommand)
Case GetType(DevExpress.XtraEditors.CheckedListBoxControl)
Dim chlistbox = DirectCast(Ctrl, DevExpress.XtraEditors.CheckedListBoxControl)
ControlLoader.CheckedListBox.LoadList(chlistbox, FormID, ConnID, sqlcommand)
Case GetType(DevExpress.XtraGrid.GridControl)
Dim grid = DirectCast(Ctrl, DevExpress.XtraGrid.GridControl)
ControlLoader.DataGridViewCheckable.LoadList(grid, FormID, ConnID, sqlcommand)
End Select
PerfomanceHelper.ResumeDraw(Ctrl)
Next
sw.Done()
Catch ex As Exception
LOGGER.Warn("Unexpected Error in LoadControlValuesList: " & ex.Message)
MsgBox("Unexpected Error in LoadControlValuesList:" & vbNewLine & ex.Message, MsgBoxStyle.Critical)
End Try
End Sub
Public Shared Sub LoadControlValuesListWithPlaceholders(FormId As Integer, RecordId As Integer, ParentRecordId As Integer, controls As Control.ControlCollection, entity_ID As Integer)
Try
If controls.Count = 0 Then
'MsgBox("LoadControlValuesListWithPlaceholders: Control.ControlCollection is unexpected empty!", MsgBoxStyle.Exclamation)
LOGGER.Warn("LoadControlValuesListWithPlaceholders: Control.ControlCollection is unexpected empty!")
Exit Sub
End If
' Dim SQL As String = String.Format("SELECT CONTROL_ID, CONTROL_CONNID_1, CONTROL_SQLCOMMAND_1 AS SQL FROM VWPMO_CONTROL_SCREEN WHERE FORM_ID = {0} AND CONTROL_SQLCOMMAND_1 <> '' AND CONTROL_SQLCOMMAND_1 LIKE '%@%'", FormId)
Dim sw As New SW("LoadControlValuesListWithPlaceholders")
Dim commands As New List(Of String)
Dim expression As String = String.Format("FORM_ID = {0} AND CONTROL_SQLCOMMAND_1 <> '' AND CONTROL_SQLCOMMAND_1 LIKE '%@%'", FormId)
Dim dt As DataTable = ClassHelper.FILTER_DATATABLE(DT_VWPMO_CONTROL_SCREEN, expression, "") 'ClassDatabase.Return_Datatable(SQL, True)
If dt.Rows.Count = 0 Then
Exit Sub
End If
For Each Ctrl As Control In controls
Dim controlTagId = DirectCast(Ctrl.Tag, ClassControlMetadata).Id
Dim row As DataRow = dt.Select(String.Format("CONTROL_ID={0}", controlTagId)).FirstOrDefault()
If IsNothing(row) Then
Continue For
End If
Dim connID = row.Item("CONTROL_CONNID_1")
Dim sqlcommand As String = row.Item("CONTROL_SQLCOMMAND_1")
If ParentRecordId = 0 And CURRENT_ACT_LEVEL > 1 Then
'eigentlich sollte eine Parent_RecordID da sein
Try
Dim _SQL = String.Format("SELECT RECORD1_ID FROM TBPMO_RECORD_CONNECT WHERE RECORD2_ID = {0}", RecordId)
Dim ParentRec = ClassDatabase.Execute_Scalar(_SQL)
If Not IsNothing(ParentRec) Then
If ParentRec > 0 Then
ParentRecordId = ParentRec
End If
End If
Catch ex As Exception
LOGGER.Warn("Unexpected Error in Getting Parent-Record cause PRecord was 0: " & ex.Message)
End Try
End If
sqlcommand = ReplaceSqlCommandPlaceholders(sqlcommand, RecordId, ParentRecordId, entity_ID)
PerfomanceHelper.SuspendDraw(Ctrl)
Select Case Ctrl.GetType()
Case GetType(CustomComboBox)
Dim combobox = DirectCast(Ctrl, CustomComboBox)
ControlLoader.Combobox.LoadList(combobox, FormId, connID, sqlcommand)
Case GetType(DevExpress.XtraEditors.ListBoxControl)
Dim listbox = DirectCast(Ctrl, DevExpress.XtraEditors.ListBoxControl)
ControlLoader.ListBox.LoadList(listbox, FormId, connID, sqlcommand)
Case GetType(DevExpress.XtraEditors.CheckedListBoxControl)
Dim chlistbox = DirectCast(Ctrl, DevExpress.XtraEditors.CheckedListBoxControl)
ControlLoader.CheckedListBox.LoadList(chlistbox, FormId, connID, sqlcommand)
Case GetType(DevExpress.XtraGrid.GridControl)
Dim gridControl = DirectCast(Ctrl, DevExpress.XtraGrid.GridControl)
ControlLoader.DataGridViewCheckable.LoadList(gridControl, FormId, connID, sqlcommand)
End Select
PerfomanceHelper.ResumeDraw(Ctrl)
Next
sw.Done()
Catch ex As Exception
LOGGER.Warn("Unexpected Error in LoadControlValuesListWithPlaceholders: " & ex.Message)
MsgBox("Unexpected Error in LoadControlValuesListWithPlaceholders:" & vbNewLine & ex.Message, MsgBoxStyle.Critical)
End Try
End Sub
''' <summary>
''' Sucht alle Controls in der aktuellen Entität, die eine Abhängigkeit besitzen,
''' und (de)aktiviert sie basierend auf dem Wert er Abhängigkeit
''' </summary>
''' <remarks></remarks>
Public Shared Sub Enable_Depending_Controls(FormId As Integer, RecordId As Integer, ParentRecordId As Integer, controls As Control.ControlCollection, entity_ID As Integer)
Try
If controls.Count = 0 Then
'MsgBox("LoadControlValuesListWithPlaceholders: Control.ControlCollection is unexpected empty!", MsgBoxStyle.Exclamation)
LOGGER.Warn("Enable_Depending_Controls: Control.ControlCollection is unexpected empty!")
Exit Sub
End If
' Alle Controls finden, die Abhängigkeiten haben
Dim SQL As String = String.Format("select GUID,NAME,SQL_COMMAND_2 from TBPMO_CONTROL where FORM_ID = {0} AND SQL_COMMAND_2 IS NOT NULL " _
& "AND LEN(SQL_COMMAND_2) > 10 AND SQL_COMMAND_2 LIKE '%@%@%'", FormId)
Dim sw As New SW("Enable_Depending_Controls")
Dim commands As New List(Of String)
Dim dt As DataTable = ClassDatabase.Return_Datatable(SQL)
If dt.Rows.Count = 0 Then
Exit Sub
End If
' Durchlaufe alle Controls, die eine Abhängigheit haben
For Each row As DataRow In dt.Rows
Dim msg = String.Format("Working on Depending Control-ID: {0}", row.Item("GUID").ToString)
LOGGER.Debug(msg, False)
Dim DependingControlId As Integer = row.Item("GUID")
Dim DependingControlSQL As String = row.Item("SQL_COMMAND_2")
msg = String.Format("SQL: {0}", DependingControlSQL)
LOGGER.Debug(msg, False)
Dim DependingControl As Control = controls.OfType(Of Control)().Where(Function(c As Control)
Return DirectCast(c.Tag, ClassControlMetadata).Id = DependingControlId
End Function).SingleOrDefault()
Dim regex As New Regex("(@(\d+)@)")
Dim match As Match = regex.Match(DependingControlSQL)
If match.Success Then
' Wir suchen aus dem SQL Befehl die ControlId heraus,
' von dem das aktuelle Control abhängt
Dim otherControlId As Integer
Integer.TryParse(match.Groups(2).Value, otherControlId)
' Jetzt suchen wir das Control, das zu dieser ControlId passt
Dim otherControl As Control = controls.OfType(Of Control)().Where(Function(c As Control)
Dim controlId As Integer = DirectCast(c.Tag, ClassControlMetadata).Id
Console.WriteLine(controlId)
Return controlId = otherControlId
End Function).SingleOrDefault()
Dim otherControlType As String = otherControl.GetType().Name
' Jetzt holen wir uns den Wert von dem 'OtherControl'
' und geben seinen Value zusammen mit dem dependingControl weiter
Dim value As Object = Nothing
' Jetzt lesen wir den Wert aus, der im SQL Command ersetzt werden soll
Select Case otherControlType
Case "CheckBox"
msg = String.Format("CheckBox-CtrlID: {0}", otherControlId)
LOGGER.Debug(msg, False)
value = DirectCast(otherControl, CheckBox).Checked
Case "TextBox"
msg = String.Format("TextBox-CtrlID: {0}", otherControlId)
LOGGER.Debug(msg, False)
value = DirectCast(otherControl, TextBox).Text
Case "CustomComboBox"
msg = String.Format("CustomComboBox-CtrlID: {0}", otherControlId)
LOGGER.Debug(msg, False)
value = DirectCast(otherControl, CustomComboBox).Text
Case "DateEdit"
msg = String.Format("DateEdit-CtrlID: {0}", otherControlId)
LOGGER.Debug(msg, False)
value = DirectCast(otherControl, DevExpress.XtraEditors.DateEdit).EditValue
End Select
' Jetzt ersetzen wir den Platzhalter im SQL Command
DependingControlSQL = regex.Replace(DependingControlSQL, value)
msg = String.Format("DependingControlSQL: {0}", DependingControlSQL)
LOGGER.Debug(msg, False)
Dim enableDT As DataTable = ClassDatabase.Return_Datatable(DependingControlSQL)
If IsNothing(enableDT) Then
msg = String.Format("enableDT is nothing!! CHECK SQL {0}." & vbNewLine, DependingControlSQL)
LOGGER.Warn(msg)
Continue For
End If
If enableDT.Rows.Count = 1 Then
Dim enabled As Boolean = True
Try
enabled = CBool(enableDT.Rows(0).Item(0))
Catch ex As Exception
msg = String.Format("Could not convert value of tablecontent to boolean!! SQL {0} # tablecontent: {1}" & vbNewLine, DependingControlSQL, enableDT.Rows(0).Item(0).ToString)
LOGGER.Warn(msg)
End Try
DependingControl.Enabled = enabled
If enabled = False Then
msg = String.Format("Control {0} will be disabled." & vbNewLine, DependingControlId.ToString)
LOGGER.Debug(msg, False)
Else
msg = String.Format("Control {0} will be enabled." & vbNewLine, DependingControlId.ToString)
LOGGER.Debug(msg, False)
End If
Else
LOGGER.Warn("Attention in Enable_Depending_Controls: RowCount for enabling control was '" & enableDT.Rows.Count.ToString & "' and not 1 as expected - Check SQL: '" & DependingControlSQL & "'")
End If
End If
Next
sw.done
Catch ex As Exception
LOGGER.Warn("Unexpected Error in Enable_Depending_Controls: " & ex.Message, True)
MsgBox("Unexpected Error in Enable_Depending_Controls:" & vbNewLine & ex.Message, MsgBoxStyle.Critical)
End Try
End Sub
Public Shared Function ReplaceSqlCommandPlaceholders(sqlCommand As String, recordId As Integer, parentRecordId As Integer, entity_Id As Integer)
Try
sqlCommand = sqlCommand.Replace("@RECORD_ID", recordId)
sqlCommand = sqlCommand.Replace("@RECORDID", recordId)
sqlCommand = sqlCommand.Replace("@ENTITY_ID", entity_Id)
sqlCommand = sqlCommand.Replace("@PARENTRECORD_ID", parentRecordId)
sqlCommand = sqlCommand.Replace("@PARENTRECORDID", parentRecordId)
Return sqlCommand
Catch ex As Exception
LOGGER.Warn("Unexpected Error in ReplaceSqlCommandPlaceholders: " & ex.Message)
MsgBox("Unexpected Error in ReplaceSqlCommandPlaceholders:" & vbNewLine & ex.Message, MsgBoxStyle.Critical)
Return sqlCommand
End Try
End Function
Public Shared Sub UnloadControlValuesList(RecordID As Integer, FormID As Integer, controls As Control.ControlCollection)
For Each C As Control In controls
If TypeOf C Is CustomComboBox Then
Dim Combobox = DirectCast(C, CustomComboBox)
Dim currentValue As String = Combobox.Text
Combobox.DataSource = Nothing
Combobox.Text = currentValue
End If
Next
End Sub
Public Shared Sub LoadImage(RecordID As Integer, ControlID As Integer, control As Control)
Dim picbox As PictureBox = DirectCast(control, PictureBox)
Dim SQL As String = String.Format("SELECT IMG FROM TBPMO_CONTROL_IMAGE WHERE RECORD_ID = {0} AND CONTROL_ID = {1}", RecordID, ControlID)
Dim bimage As Byte() = ClassDatabase.Execute_Scalar(SQL)
If Not IsNothing(bimage) Then
picbox.BackgroundImage = ByteArrayToBitmap(bimage)
picbox.BackgroundImageLayout = ImageLayout.Zoom
Else
picbox.BackgroundImage = Nothing
End If
End Sub
#Region "ClearControlValue"
Public Shared Sub ClearControlValues(controls As Control.ControlCollection)
For Each control In controls
If control.GetType().Name = "GroupBox" Then
Dim groupbox As GroupBox = control
ClearControlValues(groupbox.Controls)
Else
ClearControlValue(control)
End If
Next
End Sub
Public Shared Sub ClearControlValue(control As Control)
Select Case control.GetType()
Case GetType(TextBox)
DirectCast(control, TextBox).Text = String.Empty
Case GetType(CustomComboBox)
Dim combo As CustomComboBox = DirectCast(control, CustomComboBox)
combo.SelectedIndex = -1
combo.Text = String.Empty
Case GetType(CheckBox)
DirectCast(control, CheckBox).Checked = False
Case GetType(RadioButton)
DirectCast(control, RadioButton).Checked = False
Case GetType(DevExpress.XtraEditors.DateEdit)
DirectCast(control, DevExpress.XtraEditors.DateEdit).DateTime = DateTime.MinValue
Case GetType(PictureBox)
DirectCast(control, PictureBox).BackgroundImage = Nothing
Case GetType(DevExpress.XtraEditors.CheckedListBoxControl)
Dim chklbx As DevExpress.XtraEditors.CheckedListBoxControl = DirectCast(control, DevExpress.XtraEditors.CheckedListBoxControl)
chklbx.UnCheckAll()
Case GetType(DevExpress.XtraEditors.ListBoxControl)
Dim lb As DevExpress.XtraEditors.ListBoxControl = DirectCast(control, DevExpress.XtraEditors.ListBoxControl)
lb.SelectedIndex = -1
Case GetType(DataGridView)
Dim dgv As DataGridView = DirectCast(control, DataGridView)
Dim ds = dgv.DataSource
If (IsNothing(ds)) Then
dgv.Rows.Clear()
dgv.Refresh()
Else
dgv.DataSource = Nothing
dgv.Refresh()
End If
Case GetType(DevExpress.XtraGrid.GridControl)
Dim gc = DirectCast(control, DevExpress.XtraGrid.GridControl)
Dim gridview As DevExpress.XtraGrid.Views.Grid.GridView = gc.MainView
' Setzt den Filter zurück
gridview.ActiveFilterString = String.Empty
If gridview.RowCount = 0 Then
Exit Select
End If
For i As Integer = 0 To gridview.RowCount - 1
Dim fieldName As String = gridview.Columns(0).FieldName
Dim rowhandle As Integer = gridview.GetRowHandle(i)
Dim rowvalue As String = gridview.GetRowCellValue(rowhandle, fieldName)
gridview.UnselectRow(rowhandle)
Next
Try
gridview.Columns(0).OptionsColumn.AllowEdit = False
Catch ex As Exception
End Try
End Select
End Sub
#End Region
#Region "LoadDefaultValue"
Public Shared Sub LoadDefaultValues(FormID As Integer, RecordID As Integer, controls As Control.ControlCollection, parentRecordID As Integer, EntityID As Integer)
Try
Dim sw As New SW("LoadDefaultValues")
' Alle Controls leeren
ClearControlValues(controls)
' Alle Controls laden, die einen Default Value haben
Dim SQL As String = String.Format("SELECT CONTROL_ID, CONTROL_DEF_VALUE, CONTROL_NAME FROM VWPMO_CONTROL_SCREEN WHERE FORM_ID = {0} AND CONTROL_DEF_VALUE <> '' " & _
"UNION SELECT CONTROL_ID, CONTROL_SQLCOMMAND_1 AS CONTROL_DEF_VALUE, CONTROL_NAME FROM VWPMO_CONTROL_SCREEN where FORM_ID = {0} and CONTROL_SQLCOMMAND_1 <> '' AND CONTROL_SQLCOMMAND_1 NOT LIKE '%@%@%' AND CONTROL_SQLCOMMAND_1 LIKE '%@RECORD_ID%'", FormID)
Dim DEFAULT_VALUE_DT As DataTable = ClassDatabase.Return_Datatable(SQL, True)
For Each row As DataRow In DEFAULT_VALUE_DT.Rows
Dim defaultValue = row.Item("CONTROL_DEF_VALUE")
Dim controlId As Integer = row.Item("CONTROL_ID")
Dim controlName As String = row.Item("CONTROL_NAME")
Try
Dim control As Control = controls.Find(controlName, False)(0)
LoadDefaultValue(controlId, RecordID, Control, parentRecordID, EntityID, defaultValue)
Catch ex As Exception
LOGGER.Warn("Unexpected Error in getting default value for control '" & controlName & " - " & ex.Message, True)
End Try
Next
sw.Done()
'Den Focus auf das erste Steuerelement setzen
For Each c As Control In controls
If Not TypeOf c Is Label Then
c.Focus()
Exit For
End If
Next
Catch ex As Exception
MsgBox("Error in LoadDefaultValues: " & vbNewLine & ex.Message, MsgBoxStyle.Critical)
End Try
End Sub
'Public Shared Sub LoadDefaultValues_(FormID As Integer, RecordID As Integer, controls As Control.ControlCollection, ParentRecordId As Integer, entity_ID As Integer)
' '' Zuerst alle Controls leeren
' ClearControlValues(controls)
' Dim i = 0
' For Each control As Control In controls
' Dim CONTROL_ID = DirectCast(control.Tag, ClassControlMetadata).Id ' GetControlID_for_Name(control.Name, FormID)
' If Not (TypeOf control Is Label) Then
' i += 1
' End If
' If TypeOf control Is GroupBox Then
' LoadDefaultValues(FormID, RecordID, DirectCast(control, GroupBox).Controls, ParentRecordId, entity_ID)
' End If
' 'LoadDefaultValue(CONTROL_ID, RecordID, control, ParentRecordId, entity_ID)
' 'Den Focus auf das erste Steuerelement setzen
' If i = 1 Then
' control.Focus()
' End If
' Next
'End Sub
Public Shared Sub LoadDefaultValue(ControlID As Integer, RecordID As Integer, control As Control, ParentRecordId As Integer, entity_ID As Integer, defaultValue As Object)
Try
'Dim SQL = String.Format("SELECT CONTROL_DEF_VALUE FROM VWPMO_CONTROL_SCREEN WHERE CONTROL_ID = {0} and CONTROL_DEF_VALUE <> ''", ControlID)
'Dim defaultValue = ClassDatabase.Execute_Scalar(SQL)
'Dim SQL = "SELECT * FROM VWPMO_CONTROL_SCREEN WHERE CONTROL_ID = " & ControlID
'Dim DT As DataTable = ClassDatabase.Return_Datatable(SQL)
'Dim result = DT.Rows(0).Item("CONTROL_DEF_VALUE")
Select Case control.GetType()
Case GetType(TextBox)
If ControlID = 272 Then
Console.WriteLine("obacht")
End If
Dim textbox As TextBox = DirectCast(control, TextBox)
If IsDBNull(defaultValue) Then
textbox.Text = ""
Else
Dim vorgabe = defaultValue
'Wenn der Default Wert über einen Select kommt
If vorgabe.ToString.ToLower.StartsWith("select") Then
vorgabe = defaultValue.Replace("@FORM_ID", CURRENT_ENTITY_ID)
vorgabe = vorgabe.Replace("@RECORD_ID", CURRENT_RECORD_ID)
vorgabe = vorgabe.Replace("@RECORDID", CURRENT_RECORD_ID)
vorgabe = vorgabe.Replace("@PARENTRECORD_ID", CURRENT_PARENT_RECORD_ID)
defaultValue = ClassDatabase.Execute_Scalar(vorgabe.ToString, True)
If IsNothing(vorgabe) Then
textbox.Text = ""
End If
End If
textbox.Text = defaultValue
End If
Case GetType(CheckBox)
Dim checkbox As CheckBox = DirectCast(control, CheckBox)
checkbox.Checked = StrToBool(defaultValue)
Case GetType(RadioButton)
Dim radio As RadioButton = DirectCast(control, RadioButton)
radio.Checked = StrToBool(defaultValue)
Case GetType(CustomComboBox)
Dim combobox As CustomComboBox = DirectCast(control, CustomComboBox)
If IsDBNull(defaultValue) Then
combobox.SelectedIndex = -1
Else
combobox.SelectedIndex = combobox.FindStringExact(defaultValue)
End If
Case GetType(DevExpress.XtraEditors.DateEdit)
Dim datepicker As DevExpress.XtraEditors.DateEdit = DirectCast(control, DevExpress.XtraEditors.DateEdit)
If IsDBNull(defaultValue) Then
defaultValue = String.Empty
End If
Dim result As EnumDateTimePickerDefaultValueOptions = EnumDateTimePickerDefaultValueOptions.Empty
Dim success = [Enum].TryParse(Of EnumDateTimePickerDefaultValueOptions)(defaultValue, result)
If success Then
If result = EnumDateTimePickerDefaultValueOptions.Empty Then
' DBNull.Value leert das DateEdit control.
defaultValue = DBNull.Value
ElseIf result = EnumDateTimePickerDefaultValueOptions.CurrentDate Then
defaultValue = Now
End If
Else
'Wenn der DefaultWert nicht gelesen werden konnte, DateEdit leeren
defaultValue = DBNull.Value
End If
' Mit EditValue kann man auch den angezeigten Wert leeren
'datepicker.DateTime = autoValue
datepicker.EditValue = defaultValue
Case GetType(Label)
Dim lbl As Label = DirectCast(control, Label)
Dim CONNID = ClassDatabase.Execute_Scalar(String.Format("SELECT CONNECTION_ID_1 FROM TBPMO_CONTROL WHERE GUID = {0}", ControlID))
'Dim SQL_AUTOVALUE As String = ClassDatabase.Execute_Scalar(String.Format("SELECT SQL_COMMAND_1 FROM TBPMO_CONTROL WHERE GUID = {0}", ControlID))
defaultValue = ClassControlValues.ReplaceSqlCommandPlaceholders(defaultValue, RecordID, ParentRecordId, entity_ID)
If defaultValue = "" Or IsDBNull(defaultValue) Then
Exit Sub
End If
If Not IsNothing(CONNID) Then
defaultValue = ClassDatabase.Execute_ScalarWithConnection(CONNID, defaultValue)
Else
defaultValue = ClassDatabase.Execute_Scalar(defaultValue, True)
End If
' AutoValue = ClassDatabase.Execute_Scalar(SQL)
If Not IsNothing(defaultValue) And Not IsDBNull(defaultValue) Then
lbl.Text = defaultValue
End If
End Select
Catch ex As Exception
MsgBox("Unexpected Error in LoadDefaultValue:" & vbNewLine & ex.Message, MsgBoxStyle.Critical)
End Try
End Sub
#End Region
Public Shared Function Get_Control_Value_for_ID(Control_ID As Integer, Record_ID As Integer)
Try
Dim sql = "SELECT VALUE FROM TBPMO_CONTROL_VALUE WHERE CONTROL_ID = " & Control_ID & " AND RECORD_ID = " & Record_ID
CURRENT_LAST_SQL = sql
Return ClassDatabase.Execute_Scalar(sql)
Catch ex As Exception
LOGGER.Warn("Unexpected Error in GetControlValueForControlID: " & ex.Message)
MsgBox("Error in GetControlValueForControlID:" & vbNewLine & ex.Message, MsgBoxStyle.Critical)
Return Nothing
End Try
End Function
End Class

View File

@@ -0,0 +1,29 @@
Public Class ClassControls_Manual
Public Shared Function AddCheckBox(ID As Integer, indexname As String, y As Integer, vorbelegung As String, caption As String)
Try
Dim chk As New CheckBox
chk.Name = "chk" & indexname
chk.Size = New Size(100, 27)
chk.Location = New Point(11, y)
chk.Tag = ID
If caption <> "" Then
chk.Text = caption
chk.Size = New Size(CInt(caption.Length * 15), 27)
End If
If vorbelegung <> "" Then
If vorbelegung = "1" Or vorbelegung = "0" Then
chk.Checked = CBool(vorbelegung)
Else
chk.Checked = False
End If
Else
chk.Checked = False
End If
Return chk
Catch ex As Exception
LOGGER.Warn("Unhandled Exception in AddCheckBox: " & ex.Message)
Return Nothing
End Try
End Function
End Class