Imports DevExpress.XtraScheduler Public Class ClassFunctionCommandsUI Shared Sub OpenFormData(ControlName As String, FormID As Integer) Try Dim ControlId As Integer = GetControlID_for_Name(ControlName, FormID) Dim dr As DataRow = ClassFunctionCommands.LoadFunction(ControlId) If IsDBNull(dr.Item("INTEGER1")) OrElse dr.Item("INTEGER1") = 0 Then MsgBox("FormId ist nicht definiert für " & ControlName) Exit Sub End If If IsDBNull(dr.Item("INTEGER2")) OrElse dr.Item("INTEGER2") = 0 Then MsgBox("ScreenId ist nicht definiert für " & ControlName) Exit Sub End If Dim newFormId As Integer = dr.Item("INTEGER1") Dim newScreenId As Integer = dr.Item("INTEGER2") OpenFormInputFor(newFormId, newScreenId) Catch ex As Exception MsgBox("Error in OpenFormData:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub Shared Sub NewEditTaskAppointment(RecordID As Integer, ControlID As Integer, Subject As String, Description As String, DueDateTime As DateTime) Try Dim apt As Appointment = frmCalendar.SchedulerStorage1.CreateAppointment(AppointmentType.Normal) Dim reminder As Reminder = apt.CreateNewReminder() Dim SQL As String = "SELECT VALUE FROM VWPMO_VALUES where [RECORD_ID] = " & RecordID & " and [CONTROL_ID] = " & ControlID reminder.AlertTime = DueDateTime apt.Reminders.Add(reminder) Dim Value = ClassDatabase.Execute_Scalar(SQL) If Value Is Nothing Then apt.Subject = Subject & " - " & Value.ToString() Else apt.Subject = Subject End If apt.Description = Description apt.AllDay = True apt.Start = DueDateTime apt.End = DueDateTime apt.CustomFields("RecordID") = RecordID apt.CustomFields("ControlID") = ControlID frmCalendar.SchedulerControl1.ShowEditAppointmentForm(apt) Catch ex As Exception MsgBox("Error in NewEditTaskAppointment:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub Private Shared Sub NewTaskAppointment(RecordID As Integer, ControlID As Integer, Subject As String, Description As String, DueDateTime As DateTime) Dim apt As Appointment = frmCalendar.SchedulerStorage1.CreateAppointment(AppointmentType.Normal) Dim reminder As Reminder = apt.CreateNewReminder() Dim SQL As String = "SELECT VALUE FROM VWPMO_VALUES where [RECORD_ID] = " & RecordID & " and [CONTROL_ID] = " & ControlID reminder.AlertTime = DueDateTime apt.Reminders.Add(reminder) Dim Value = ClassDatabase.Execute_Scalar(SQL) apt.Subject = Subject & " - " & Value.ToString() apt.Description = Description apt.AllDay = True apt.Start = DueDateTime apt.End = DueDateTime apt.CustomFields("RecordID") = RecordID apt.CustomFields("ControlID") = ControlID frmCalendar.SchedulerControl1.ShowEditAppointmentForm(apt) End Sub Shared Sub NewEditAppointment(ControlName As String, FormID As Integer, RecordID As Integer, PanelControls As Control.ControlCollection) Try Dim controlID = GetControlID_for_Name(ControlName, FormID) Dim SQL = "SELECT GUID FROM TBPMO_APPOINTMENTS WHERE CustomField1 = " & RecordID & " AND CustomField2 = " & controlID Dim result = ClassDatabase.Execute_Scalar(SQL) If result Is Nothing Then NewAppointment(ControlName, FormID, RecordID, PanelControls) Else EditAppointment(ControlName, FormID, RecordID) End If Catch ex As Exception MsgBox("Error in OpenEditAppointment:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub Private Shared Function FindControlValue(ControlName As String, PanelControls As Control.ControlCollection) As String If ControlName = Nothing Then Return Nothing Else Dim from_ctrls() As Control = PanelControls.Find(ControlName, True) Dim from_ctrl As Control If from_ctrls.Length = 1 Then from_ctrl = from_ctrls(0) Return from_ctrl.Text Else : Return Nothing End If End If End Function Private Shared Sub NewAppointment(ControlName As String, FormID As Integer, RecordID As Integer, PanelControls As Control.ControlCollection) Try Dim ControlId As Integer = GetControlID_for_Name(ControlName, FormID) Dim dr As DataRow = ClassFunctionCommands.LoadFunction(ControlId) Dim apt As Appointment = frmCalendar.SchedulerStorage1.CreateAppointment(AppointmentType.Normal) Dim FromDateName, ToDateName As String Dim FromDateValue, ToDateValue As Date Dim SubjectValue, Subject2Value, PlaceValue, DescValue As String Dim FromDateID As Object = dr.Item("INTEGER1") Dim ToDateID As Object = dr.Item("INTEGER2") Dim SubjectString As Object = dr.Item("STRING1") Dim Subject2String As Object = dr.Item("STRING2") Dim PlaceString As Object = dr.Item("STRING3") Dim DescString As Object = dr.Item("STRING4") If Not IsDBNull(FromDateID) Then If FromDateID <> 0 Then FromDateName = GetName_for_ControlID(FromDateID, FormID) FromDateValue = Date.Parse(FindControlValue(FromDateName, PanelControls)) apt.Start = FromDateValue Else apt.Start = Date.Now End If Else apt.Start = Date.Now End If If Not IsDBNull(ToDateID) Then If ToDateID <> 0 Then ToDateName = GetName_for_ControlID(ToDateID, FormID) ToDateValue = Date.Parse(FindControlValue(ToDateName, PanelControls)) apt.End = ToDateValue Else apt.End = Date.Now End If Else apt.End = Date.Now End If If Not IsDBNull(SubjectString) OrElse Not String.IsNullOrWhiteSpace(SubjectString) Then SubjectValue = ReplacePlaceholders(SubjectString, RecordID, ControlName, PanelControls) apt.Subject = SubjectValue End If If Not IsDBNull(Subject2String) OrElse Not String.IsNullOrWhiteSpace(Subject2String) Then Subject2Value = ReplacePlaceholders(Subject2String, RecordID, ControlName, PanelControls) If Not String.IsNullOrEmpty(Subject2Value) Then apt.Subject = apt.Subject & " - " & Subject2Value End If End If If Not IsDBNull(PlaceString) OrElse Not String.IsNullOrWhiteSpace(PlaceString) Then PlaceValue = ReplacePlaceholders(PlaceString, RecordID, ControlName, PanelControls) apt.Location = PlaceValue End If If Not IsDBNull(DescString) OrElse Not String.IsNullOrWhiteSpace(DescString) Then DescValue = ReplacePlaceholders(DescString, RecordID, ControlName, PanelControls) apt.Description = DescValue End If apt.AllDay = True apt.CustomFields("RecordID") = RecordID apt.CustomFields("ControlID") = ControlId frmCalendar.SchedulerControl1.ShowEditAppointmentForm(apt) Catch ex As Exception MsgBox("Fehler beim Laden der Termininformationen:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub Public Shared Function ReplacePlaceholders(str As String, RecordID As Integer, ControlName As String, PanelControls As Control.ControlCollection) Dim preg As String = "\[%{1}[a-zA-Z0-9\!\$\&\/\(\)\=\?\,\.\-\;\:_öÖüÜäÄ\#\'\+\*\~\{\}\@\€\<\>\ ]+]{1}" Dim regexp As System.Text.RegularExpressions.Regex = New System.Text.RegularExpressions.Regex(preg) Dim matches As System.Text.RegularExpressions.MatchCollection = regexp.Matches(str) If matches.Count = 0 Then Return str End If For Each match As System.Text.RegularExpressions.Match In matches Dim ControlNameToReplace As String = match.Value.Substring(2, match.Value.Length - 3) Dim ControlValue As String = FindControlValue(ControlNameToReplace, PanelControls) str = str.Replace(match.Value, ControlValue) Next Return str End Function Private Shared Sub EditAppointment(ControlName As String, FormID As Integer, RecordID As Integer) Try Dim controlID = GetControlID_for_Name(ControlName, FormID) ' Load All appointments first frmCalendar.TBPMO_RESOURCESTableAdapter.Fill(frmCalendar.DD_DMSDataSetCalendar.TBPMO_RESOURCES) frmCalendar.TBPMO_APPOINTMENTSTableAdapter.Fill(frmCalendar.DD_DMSDataSetCalendar.TBPMO_APPOINTMENTS) Dim apt As Appointment = frmCalendar.SchedulerStorage1.Appointments.Items.Find(Function(a As Appointment) Return Convert.ToInt32(a.CustomFields("RecordID")).Equals(RecordID) And Convert.ToInt32(a.CustomFields("ControlID")).Equals(controlID) End Function) If apt IsNot Nothing Then frmCalendar.SchedulerControl1.ShowEditAppointmentForm(apt) End If Catch ex As Exception MsgBox("Error in EditAppointment:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub End Class