794 lines
34 KiB
VB.net
794 lines
34 KiB
VB.net
Imports DD_LIB_Standards
|
|
|
|
Public Class frmFormDesigner
|
|
Public ProfileId As Integer
|
|
Public ProfileName As String
|
|
Public ProfileObjectType As String
|
|
|
|
' Control Variables
|
|
Private CurrentControl As Control = Nothing
|
|
|
|
' Movement Variables
|
|
Private Mouse_IsPressed As Boolean
|
|
Private Mouse_IsMoving As Boolean
|
|
Private Mouse_BeginLocation As Point
|
|
Private Mouse_EndLocation As Point
|
|
|
|
' Windream List Data
|
|
Private Windream_ChoiceLists As List(Of String)
|
|
Private Windream_AllIndicies As List(Of String)
|
|
Private Windream_VectorIndicies As List(Of String)
|
|
Private Windream_SimpleIndicies As List(Of String)
|
|
|
|
|
|
Private Sub frmFormDesigner_Load(sender As Object, e As EventArgs) Handles Me.Load
|
|
Try
|
|
' Profil Name in Fenstertitel setzen
|
|
Text = $"{Text} - Profil: {ProfileName}"
|
|
|
|
Try
|
|
' Windream initialisieren
|
|
clsWindream.Create_Session()
|
|
|
|
'Windream Abfragen, sollten einmal beim Start des Formulars geladen werden
|
|
|
|
Dim unsortedIndicies = clsWD_GET.GetIndicesByObjecttype(CURRENT_OBJECTTYPE).ToList()
|
|
Dim sortedIndicies = unsortedIndicies.OrderBy(Function(index As String) index).ToList()
|
|
|
|
Windream_AllIndicies = sortedIndicies
|
|
Windream_ChoiceLists = clsWD_GET.GetChoiceLists()
|
|
Windream_VectorIndicies = Windream_AllIndicies.FindAll(AddressOf IsVectorIndex)
|
|
Windream_SimpleIndicies = Windream_AllIndicies.Except(Windream_VectorIndicies).ToList()
|
|
Catch ex As Exception
|
|
MsgBox("Fehler bei Initialisieren von windream: " & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Achtung:")
|
|
End Try
|
|
|
|
Try
|
|
TBPM_PROFILE_CONTROLSTableAdapter.Connection.ConnectionString = MyConnectionString
|
|
TBDD_CONNECTIONTableAdapter.Connection.ConnectionString = MyConnectionString
|
|
TBWH_CHECK_PROFILE_CONTROLSTableAdapter.Connection.ConnectionString = MyConnectionString
|
|
TBPM_CONTROL_TABLETableAdapter.Connection.ConnectionString = MyConnectionString
|
|
TBDD_CONNECTIONTableAdapter.Fill(DD_DMSLiteDataSet.TBDD_CONNECTION)
|
|
Catch ex As Exception
|
|
MsgBox("Fehler bei Laden der Connection-Strings und Grunddaten: " & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Achtung:")
|
|
End Try
|
|
|
|
LoadControls()
|
|
Catch ex As Exception
|
|
MsgBox(ex.Message, MsgBoxStyle.Critical, "error loading form:")
|
|
End Try
|
|
End Sub
|
|
|
|
Private Sub frmFormDesigner_FormClosing(sender As Object, e As FormClosingEventArgs) Handles Me.FormClosing
|
|
If ProfileId > 0 Then
|
|
Dim sql As String = $"SELECT NAME, INDEX_NAME FROM TBPM_PROFILE_CONTROLS WHERE PROFIL_ID = {ProfileId} AND CTRL_TYPE <> 'LBL' AND CTRL_TYPE <> 'LINE'"
|
|
Dim dt As DataTable = ClassDatabase.Return_Datatable(sql)
|
|
|
|
Dim missingIndexControls As New List(Of String)
|
|
|
|
For Each row As DataRow In dt.Rows
|
|
If NotNull(row.Item("INDEX_NAME"), String.Empty) = String.Empty Then
|
|
missingIndexControls.Add(row.Item("NAME"))
|
|
End If
|
|
Next
|
|
|
|
If missingIndexControls.Count > 0 Then
|
|
e.Cancel = True
|
|
Dim missingControls As String = String.Join(vbCrLf, missingIndexControls.ToArray())
|
|
MsgBox($"Für die folgenden Controls wurden noch keine Indexdefinitionen hinterlegt: {vbCrLf}{vbCrLf}{missingControls}")
|
|
End If
|
|
End If
|
|
|
|
If Application.OpenForms().OfType(Of frmControl_Detail).Any Then
|
|
frmControl_Detail.Close()
|
|
End If
|
|
|
|
End Sub
|
|
|
|
''' <summary>
|
|
''' Filtert aus der Liste von Indexen die Vektor Indexe heraus
|
|
''' </summary>
|
|
Private Function IsVectorIndex(index As String) As Boolean
|
|
Dim type As Integer = clsWD_GET.GetTypeOfIndexAsIntByName(index)
|
|
|
|
'Vektor Zahl Oder Vektor String
|
|
Return (type = 4107 Or type = 4097)
|
|
End Function
|
|
|
|
Sub LoadControls()
|
|
Try
|
|
TBPM_PROFILE_CONTROLSTableAdapter.FillByProfil(DD_DMSLiteDataSet.TBPM_PROFILE_CONTROLS, ProfileId)
|
|
TBPM_CONTROL_TABLETableAdapter.FillAll(DD_DMSLiteDataSet.TBPM_CONTROL_TABLE)
|
|
|
|
' löscht alle Controls
|
|
pnldesigner.Controls.Clear()
|
|
|
|
Dim dt As DataTable = DD_DMSLiteDataSet.TBPM_PROFILE_CONTROLS
|
|
For Each row As DataRow In dt.Rows
|
|
' Ein Base Control erstellen
|
|
Dim guid As Integer = row.Item("GUID")
|
|
Dim name As String = row.Item("NAME")
|
|
Dim x As Integer = row.Item("X_LOC")
|
|
Dim y As Integer = row.Item("Y_LOC")
|
|
Dim style As FontStyle = NotNull(row.Item("FONT_STYLE"), FontStyle.Regular)
|
|
Dim size As Single = NotNull(row.Item("FONT_SIZE"), 10)
|
|
Dim familyString As String = NotNull(row.Item("FONT_FAMILY"), "Arial")
|
|
Dim family As FontFamily = New FontFamily(familyString)
|
|
Dim font As New Font(family, size, style, GraphicsUnit.Point)
|
|
Dim color As Color = IntToColor(NotNull(row.Item("FONT_COLOR"), 0))
|
|
|
|
' Jetzt die Control spezifischen Eigenschaften zuweisen
|
|
Select Case row.Item("CTRL_TYPE")
|
|
Case "TXT"
|
|
Dim txt = ClassControlCreator.CreateExistingTextbox(row, True)
|
|
pnldesigner.Controls.Add(txt)
|
|
SetMovementHandlers(txt)
|
|
|
|
Case "LBL"
|
|
Dim lbl = ClassControlCreator.CreateExistingLabel(row, True)
|
|
pnldesigner.Controls.Add(lbl)
|
|
SetMovementHandlers(lbl)
|
|
|
|
|
|
Case "CMB"
|
|
Dim cmb = ClassControlCreator.CreateExistingCombobox(row, True)
|
|
pnldesigner.Controls.Add(cmb)
|
|
SetMovementHandlers(cmb)
|
|
|
|
Case "DTP"
|
|
Dim dtp = ClassControlCreator.CreateExistingDatepicker(row, True)
|
|
pnldesigner.Controls.Add(dtp)
|
|
SetMovementHandlers(dtp)
|
|
|
|
Case "CHK"
|
|
Dim chk = ClassControlCreator.CreateExisingCheckbox(row, True)
|
|
pnldesigner.Controls.Add(chk)
|
|
SetMovementHandlers(chk)
|
|
|
|
Case "DGV"
|
|
Dim dgv = ClassControlCreator.CreateExistingDataGridView(row, True)
|
|
pnldesigner.Controls.Add(dgv)
|
|
SetMovementHandlers(dgv)
|
|
|
|
Case "TABLE"
|
|
Dim findControlColumnsQuery = (From r As DD_DMSLiteDataSet.TBPM_CONTROL_TABLERow In DD_DMSLiteDataSet.TBPM_CONTROL_TABLE
|
|
Where r.CONTROL_ID = guid
|
|
Select r)
|
|
Dim columns As List(Of DD_DMSLiteDataSet.TBPM_CONTROL_TABLERow) = findControlColumnsQuery.ToList()
|
|
Dim table = ClassControlCreator.CreateExistingTable(row, columns, True)
|
|
|
|
AddHandler table.ColumnHeaderMouseClick, AddressOf table_ColumnHeaderMouseClick
|
|
|
|
pnldesigner.Controls.Add(table)
|
|
SetMovementHandlers(table)
|
|
|
|
Case "LINE"
|
|
Dim line = ClassControlCreator.CreateExistingLine(row, True)
|
|
pnldesigner.Controls.Add(line)
|
|
SetMovementHandlers(line)
|
|
End Select
|
|
Next
|
|
Catch ex As Exception
|
|
MsgBox("Fehler bei LoadControls " & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Achtung:")
|
|
End Try
|
|
|
|
End Sub
|
|
Private Sub DragDropButtons_MouseDown(sender As Object, e As MouseEventArgs) Handles btnlabel.MouseDown, btntextbox.MouseDown, btncmb.MouseDown, btndtp.MouseDown, btnVektor.MouseDown, btnTabelle.MouseDown, btnCheckbox.MouseDown, btnLine.MouseDown
|
|
Mouse_IsPressed = True
|
|
|
|
CurrentControl = Nothing
|
|
Try
|
|
TBPM_PROFILE_CONTROLSBindingSource.Clear()
|
|
Catch ex As Exception
|
|
End Try
|
|
End Sub
|
|
|
|
Private Sub DragDropButtons_MouseMove(sender As Object, e As MouseEventArgs) Handles btnlabel.MouseMove, btntextbox.MouseMove, btncmb.MouseMove, btndtp.MouseMove, btnVektor.MouseMove, btnTabelle.MouseMove, btnCheckbox.MouseMove, btnLine.MouseMove
|
|
If Mouse_IsPressed Then
|
|
Dim btn As Button = sender
|
|
Dim dragDropData As String
|
|
|
|
Select Case btn.Name
|
|
Case "btnlabel"
|
|
dragDropData = ClassControlCreator.PREFIX_LABEL
|
|
Case "btntextbox"
|
|
dragDropData = ClassControlCreator.PREFIX_TEXTBOX
|
|
Case "btncmb"
|
|
dragDropData = ClassControlCreator.PREFIX_COMBOBOX
|
|
Case "btndtp"
|
|
dragDropData = ClassControlCreator.PREFIX_DATETIMEPICKER
|
|
Case "btnVektor"
|
|
dragDropData = ClassControlCreator.PREFIX_DATAGRIDVIEW
|
|
Case "btnTabelle"
|
|
dragDropData = ClassControlCreator.PREFIX_TABLE
|
|
Case "btnCheckbox"
|
|
dragDropData = ClassControlCreator.PREFIX_CHECKBOX
|
|
Case "btnLine"
|
|
dragDropData = ClassControlCreator.PREFIX_LINE
|
|
End Select
|
|
|
|
btn.DoDragDrop(dragDropData, DragDropEffects.Copy)
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub DragDropButtons_MouseUp(sender As Object, e As MouseEventArgs) Handles btnlabel.MouseUp, btntextbox.MouseUp, btncmb.MouseUp, btndtp.MouseUp, btnVektor.MouseUp, btnTabelle.MouseUp, btnCheckbox.MouseUp, btnLine.MouseUp
|
|
Mouse_IsPressed = False
|
|
End Sub
|
|
|
|
Private Sub pnlDesigner_DragDrop(sender As Object, e As DragEventArgs) Handles pnldesigner.DragDrop
|
|
Dim cursorPosition As Point = pnldesigner.PointToClient(Cursor.Position)
|
|
|
|
Mouse_IsPressed = False
|
|
|
|
Try
|
|
Select Case e.Data.GetData(DataFormats.Text)
|
|
Case ClassControlCreator.PREFIX_LABEL
|
|
Dim label = ClassControlCreator.CreateNewLabel(cursorPosition)
|
|
SetMovementHandlers(label)
|
|
|
|
TBPM_PROFILE_CONTROLSTableAdapter.cmdInsertAnlage(ProfileId, label.Name, "LBL", label.Text, label.Location.X, label.Location.Y, Environment.UserName, label.Size.Height, label.Size.Width)
|
|
|
|
CurrentControl = label
|
|
CurrentControl.Tag = GetLastID()
|
|
|
|
pnldesigner.Controls.Add(label)
|
|
|
|
Case ClassControlCreator.PREFIX_TEXTBOX
|
|
Dim txt = ClassControlCreator.CreateNewTextBox(cursorPosition)
|
|
SetMovementHandlers(txt)
|
|
|
|
TBPM_PROFILE_CONTROLSTableAdapter.cmdInsertAnlage(ProfileId, txt.Name, "TXT", txt.Name, txt.Location.X, txt.Location.Y, Environment.UserName, txt.Size.Height, txt.Size.Width)
|
|
|
|
CurrentControl = txt
|
|
CurrentControl.Tag = GetLastID()
|
|
|
|
pnldesigner.Controls.Add(txt)
|
|
|
|
Case ClassControlCreator.PREFIX_COMBOBOX
|
|
Dim cmb = ClassControlCreator.CreateNewCombobox(cursorPosition)
|
|
SetMovementHandlers(cmb)
|
|
|
|
TBPM_PROFILE_CONTROLSTableAdapter.cmdInsertAnlage(ProfileId, cmb.Name, "CMB", cmb.Name, cmb.Location.X, cmb.Location.Y, Environment.UserName, cmb.Size.Height, cmb.Size.Width)
|
|
|
|
CurrentControl = cmb
|
|
CurrentControl.Tag = GetLastID()
|
|
|
|
pnldesigner.Controls.Add(cmb)
|
|
|
|
Case ClassControlCreator.PREFIX_DATETIMEPICKER
|
|
Dim dtp = ClassControlCreator.CreateNewDatetimepicker(cursorPosition)
|
|
SetMovementHandlers(dtp)
|
|
|
|
TBPM_PROFILE_CONTROLSTableAdapter.cmdInsertAnlage(ProfileId, dtp.Name, "DTP", dtp.Name, dtp.Location.X, dtp.Location.Y, Environment.UserName, dtp.Size.Height, dtp.Size.Width)
|
|
|
|
CurrentControl = dtp
|
|
CurrentControl.Tag = GetLastID()
|
|
|
|
pnldesigner.Controls.Add(dtp)
|
|
|
|
Case ClassControlCreator.PREFIX_CHECKBOX
|
|
Dim chk = ClassControlCreator.CreateNewCheckbox(cursorPosition)
|
|
SetMovementHandlers(chk)
|
|
|
|
TBPM_PROFILE_CONTROLSTableAdapter.cmdInsertAnlage(ProfileId, chk.Name, "CHK", chk.Text, chk.Location.X, chk.Location.Y, Environment.UserName, chk.Size.Height, chk.Size.Width)
|
|
|
|
CurrentControl = chk
|
|
CurrentControl.Tag = GetLastID()
|
|
|
|
pnldesigner.Controls.Add(chk)
|
|
|
|
Case ClassControlCreator.PREFIX_DATAGRIDVIEW
|
|
Dim dgv = ClassControlCreator.CreateNewDatagridview(cursorPosition)
|
|
SetMovementHandlers(dgv)
|
|
|
|
TBPM_PROFILE_CONTROLSTableAdapter.cmdInsertAnlage(ProfileId, dgv.Name, "DGV", dgv.Name, dgv.Location.X, dgv.Location.Y, Environment.UserName, dgv.Size.Height, dgv.Size.Width)
|
|
|
|
CurrentControl = dgv
|
|
CurrentControl.Tag = GetLastID()
|
|
|
|
pnldesigner.Controls.Add(dgv)
|
|
|
|
Case ClassControlCreator.PREFIX_TABLE
|
|
Dim tb = ClassControlCreator.CreateNewTable(cursorPosition)
|
|
|
|
SetMovementHandlers(tb)
|
|
AddHandler tb.ColumnHeaderMouseClick, AddressOf table_ColumnHeaderMouseClick
|
|
|
|
TBPM_PROFILE_CONTROLSTableAdapter.cmdInsertAnlage(ProfileId, tb.Name, "TABLE", tb.Name, tb.Location.X, tb.Location.Y, Environment.UserName, tb.Size.Height, tb.Size.Width)
|
|
|
|
CurrentControl = tb
|
|
CurrentControl.Tag = GetLastID()
|
|
|
|
TBPM_CONTROL_TABLETableAdapter.Insert(CurrentControl.Tag, "column1", "Column1", 95, Environment.UserName)
|
|
TBPM_CONTROL_TABLETableAdapter.Insert(CurrentControl.Tag, "column2", "Column2", 95, Environment.UserName)
|
|
|
|
pnldesigner.Controls.Add(tb)
|
|
|
|
Case ClassControlCreator.PREFIX_LINE
|
|
Dim line = ClassControlCreator.CreateNewLine(cursorPosition)
|
|
|
|
SetMovementHandlers(line)
|
|
|
|
TBPM_PROFILE_CONTROLSTableAdapter.cmdInsertAnlage(ProfileId, line.Name, "LINE", line.Name, line.Location.X, line.Location.Y, Environment.UserName, line.Size.Height, line.Size.Width)
|
|
|
|
CurrentControl = line
|
|
CurrentControl.Tag = GetLastID()
|
|
|
|
|
|
pnldesigner.Controls.Add(line)
|
|
End Select
|
|
Catch ex As Exception
|
|
ClassLogger.Add($"Error while Adding new control {e.Data.GetData(DataFormats.Text)}:")
|
|
ClassLogger.Add(ex)
|
|
End Try
|
|
End Sub
|
|
|
|
Private Sub pnlDesigner_DragEnter(sender As System.Object, e As DragEventArgs) Handles pnldesigner.DragEnter
|
|
' Check the format of the data being dropped.
|
|
If (e.Data.GetDataPresent(DataFormats.Text)) Then
|
|
' Display the copy cursor.
|
|
e.Effect = DragDropEffects.Copy
|
|
Else
|
|
' Display the no-drop cursor.
|
|
e.Effect = DragDropEffects.None
|
|
End If
|
|
End Sub
|
|
|
|
Private Function GetLastID()
|
|
Dim sql = String.Format("SELECT MAX(GUID) FROM TBPM_PROFILE_CONTROLS WHERE PROFIL_ID = {0}", ProfileId)
|
|
Return ClassDatabase.Execute_Scalar(sql, MyConnectionString, True)
|
|
End Function
|
|
|
|
Sub SetActiveControlColor()
|
|
CurrentControl.BackColor = Color.DarkOrange
|
|
|
|
' Reset Color of all other controls
|
|
For Each inctrl As Control In Me.pnldesigner.Controls
|
|
If inctrl.Name <> CurrentControl.Name Then
|
|
Dim Type As String = inctrl.GetType.ToString
|
|
Select Case Type
|
|
Case "System.Windows.Forms.TextBox"
|
|
inctrl.BackColor = Color.White
|
|
Case "System.Windows.Forms.ComboBox"
|
|
inctrl.BackColor = Color.White
|
|
Case "System.Windows.Forms.Label"
|
|
inctrl.BackColor = Color.Transparent
|
|
Case "System.Windows.Forms.CheckBox"
|
|
inctrl.BackColor = Color.Transparent
|
|
Case "DD_PM_WINDREAM.ClassControlCreator+LineLabel"
|
|
inctrl.BackColor = inctrl.ForeColor
|
|
End Select
|
|
End If
|
|
Next
|
|
End Sub
|
|
|
|
Public Sub table_ColumnHeaderMouseClick(sender As System.Object, e As DataGridViewCellMouseEventArgs)
|
|
CurrentControl = sender
|
|
Dim dgv As DataGridView = sender
|
|
|
|
CurrentControl = dgv
|
|
|
|
Dim dgvColumn As DataGridViewColumn = dgv.Columns(e.ColumnIndex)
|
|
Dim columnId = TBPM_CONTROL_TABLETableAdapter.getColumnID(CURRENT_CONTROL_ID, dgvColumn.Name)
|
|
Dim frmTableColumn = New frmControl_Detail()
|
|
|
|
frmTableColumn.FillData(columnId)
|
|
frmTableColumn.Text = "Konfiguration von Spalte: " & dgvColumn.Name
|
|
frmTableColumn.Show()
|
|
End Sub
|
|
|
|
Sub DeleteControl(controlName As String)
|
|
Try
|
|
Dim result As MsgBoxResult = MsgBox("Wollen Sie das Control: " & controlName & " wirklich löschen?", MsgBoxStyle.YesNo, "Bestätigung:")
|
|
' wenn Speichern ja
|
|
If result = MsgBoxResult.Yes Then
|
|
Dim controlId As Integer = TBPM_PROFILE_CONTROLSTableAdapter.cmdGetGUID(ProfileId, controlName)
|
|
If controlId > 0 Then
|
|
Me.TBPM_CONTROL_TABLETableAdapter.Delete(controlId)
|
|
TBPM_PROFILE_CONTROLSTableAdapter.Delete(controlId)
|
|
LoadControls()
|
|
End If
|
|
End If
|
|
Catch ex As Exception
|
|
MsgBox(ex.Message, MsgBoxStyle.Critical, "DeleteControl:")
|
|
End Try
|
|
End Sub
|
|
' +++ Public Helper Methods +++
|
|
Public Function GetCursorPosition() As Point
|
|
Return pnldesigner.PointToClient(Cursor.Position)
|
|
End Function
|
|
|
|
Private Sub btndelete_Click(sender As System.Object, e As EventArgs) Handles btndelete.Click
|
|
If CurrentControl Is Nothing = False Then
|
|
DeleteControl(CurrentControl.Name)
|
|
TabControlEigenschaften.Enabled = False
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub btnwidth_plus_Click(sender As System.Object, e As EventArgs) Handles btnwidth_plus.Click
|
|
If CurrentControl Is Nothing = False Then
|
|
CurrentControl.Size = New Size(CurrentControl.Width + 5, CurrentControl.Height)
|
|
UpdateSingleValue("WIDTH", CurrentControl.Size.Width)
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub btnwidth_minus_Click(sender As System.Object, e As EventArgs) Handles btnwidth_minus.Click
|
|
If CurrentControl Is Nothing = False Then
|
|
Dim newWidth = CurrentControl.Width - 5
|
|
|
|
' Verhindert, dass das Control unsichtbar wird
|
|
If newWidth < 1 Then
|
|
Exit Sub
|
|
End If
|
|
|
|
CurrentControl.Size = New Size(newWidth, CurrentControl.Height)
|
|
UpdateSingleValue("WIDTH", CurrentControl.Size.Width)
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub btnheight_plus_Click(sender As System.Object, e As EventArgs) Handles btnheight_plus.Click
|
|
If CurrentControl Is Nothing = False Then
|
|
Dim newHeight As Integer = CurrentControl.Height + 5
|
|
|
|
If newHeight > 21 And TypeOf CurrentControl Is TextBox Then
|
|
DirectCast(CurrentControl, TextBox).Multiline = True
|
|
End If
|
|
|
|
CurrentControl.Size = New Size(CurrentControl.Width, newHeight)
|
|
UpdateSingleValue("WIDTH", newHeight)
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub btnheight_minus_Click(sender As System.Object, e As EventArgs) Handles btnheight_minus.Click
|
|
If CurrentControl Is Nothing = False Then
|
|
Dim newHeight As Integer = CurrentControl.Height - 5
|
|
|
|
If newHeight < 22 And TypeOf CurrentControl Is TextBox Then
|
|
DirectCast(CurrentControl, TextBox).Multiline = True
|
|
End If
|
|
|
|
' Verhindert, dass das Control unsichtbar wird
|
|
If newHeight < 1 Then
|
|
Exit Sub
|
|
End If
|
|
|
|
CurrentControl.Size = New Size(CurrentControl.Width, newHeight)
|
|
UpdateSingleValue("WIDTH", newHeight)
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub btnrefresh_Click(sender As Object, e As EventArgs) Handles btnrefresh.Click
|
|
LoadControls()
|
|
End Sub
|
|
|
|
''' <summary>
|
|
''' Setzt die Eventhandler für ein Control, die für die Bewegung via Drag & Drop und das Laden der Eigentschaften verantwortlich sind
|
|
''' </summary>
|
|
''' <param name="control">Das Control, für das die Eventhandler gesetzt werden sollen</param>
|
|
Private Sub SetMovementHandlers(control As Control)
|
|
AddHandler control.MouseDown, AddressOf OnControl_MouseDown
|
|
AddHandler control.MouseUp, AddressOf OnControl_MouseUp
|
|
AddHandler control.MouseMove, AddressOf OnControl_MouseMove
|
|
End Sub
|
|
|
|
Private Sub OnControl_MouseDown(sender As Control, e As MouseEventArgs)
|
|
If e.Button = MouseButtons.Left Then
|
|
CurrentControl = sender
|
|
Mouse_BeginLocation = e.Location
|
|
sender.BringToFront()
|
|
|
|
Mouse_IsPressed = True
|
|
|
|
Console.WriteLine("CURRENT_CONTROL:" & CurrentControl.Name)
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub OnControl_MouseUp(sender As Control, e As MouseEventArgs)
|
|
Mouse_IsPressed = False
|
|
|
|
' Control Eigenschaften laden
|
|
LoadControlProperties(sender)
|
|
|
|
If Mouse_IsMoving = False Then
|
|
MyBase.Cursor = Cursors.Default
|
|
Exit Sub
|
|
End If
|
|
|
|
Mouse_IsMoving = False
|
|
|
|
Dim CurrentPosition = CurrentControl.Location
|
|
Dim OldPosition As Point = DirectCast(pgControls.SelectedObject, BaseProperties).Location
|
|
|
|
If Not Point.op_Inequality(CurrentPosition, OldPosition) Then
|
|
MyBase.Cursor = Cursors.Default
|
|
Exit Sub
|
|
End If
|
|
|
|
' Das Control sollte nicht außerhalb des Panels geschoben werden (Koordinaten kleiner 0)
|
|
If CurrentPosition.X < 0 Then
|
|
CurrentControl.Location = New Point(0, CurrentControl.Location.Y)
|
|
End If
|
|
|
|
If CurrentPosition.Y < 0 Then
|
|
CurrentControl.Location = New Point(CurrentControl.Location.X, 0)
|
|
End If
|
|
|
|
' Ebenso nicht über die Größe des Panels (X-Achse)
|
|
If CurrentPosition.X > pnldesigner.Width Then
|
|
CurrentControl.Location = New Point(pnldesigner.Width - CurrentControl.Width, CurrentControl.Location.Y)
|
|
End If
|
|
|
|
' Ebenso nicht über die Größe des Panels (Y-Achse)
|
|
If CurrentPosition.Y > pnldesigner.Height Then
|
|
CurrentControl.Location = New Point(CurrentControl.Location.X, pnldesigner.Height - CurrentControl.Height)
|
|
End If
|
|
|
|
DirectCast(pgControls.SelectedObject, BaseProperties).Location = CurrentControl.Location
|
|
|
|
UpdateSingleValue("X_LOC", CurrentControl.Location.X)
|
|
UpdateSingleValue("Y_LOC", CurrentControl.Location.Y)
|
|
|
|
MyBase.Cursor = Cursors.Default
|
|
End Sub
|
|
|
|
Private Sub OnControl_MouseMove(sender As Control, e As MouseEventArgs)
|
|
Try
|
|
If CurrentControl Is Nothing Then
|
|
Exit Sub
|
|
End If
|
|
|
|
Mouse_IsMoving = True
|
|
|
|
If Mouse_IsPressed Then
|
|
Cursor = Cursors.Hand
|
|
Refresh()
|
|
|
|
Dim CurrentPosition As Point = GetCursorPosition()
|
|
|
|
If Point.op_Inequality(CurrentPosition, Mouse_BeginLocation) Then
|
|
CurrentControl.Location = New Point(CurrentPosition.X - Mouse_BeginLocation.X, CurrentPosition.Y - Mouse_BeginLocation.Y)
|
|
End If
|
|
End If
|
|
Catch ex As Exception
|
|
Mouse_IsMoving = False
|
|
End Try
|
|
End Sub
|
|
|
|
''' <summary>
|
|
''' Weist die grundlegenden Eigenschaften zu einem Properties Objekt zu
|
|
''' Die Properties werden an das Property Grid weitergegeben
|
|
''' </summary>
|
|
''' <param name="obj">Das grundlegende Properties Objekt</param>
|
|
''' <param name="row">Die DataRow, die die Eigenschaften des Controls enthält</param>
|
|
''' <returns>Das gefüllt Properties Objekt</returns>
|
|
Private Function CreatePropsObject(obj As BaseProperties, row As DataRow, Optional indicies As List(Of String) = Nothing)
|
|
obj.ID = row.Item("GUID")
|
|
obj.Location = New Point(row.Item("X_LOC"), row.Item("Y_LOC"))
|
|
obj.Name = row.Item("NAME")
|
|
obj.Size = New Size(row.Item("WIDTH"), row.Item("HEIGHT"))
|
|
obj.ChangedAt = NotNull(row.Item("CHANGED_WHEN"), Nothing)
|
|
obj.ChangedWho = NotNull(row.Item("CHANGED_WHO"), "")
|
|
|
|
|
|
Dim style As FontStyle = NotNull(row.Item("FONT_STYLE"), FontStyle.Regular)
|
|
Dim size As Single = NotNull(row.Item("FONT_SIZE"), 10)
|
|
Dim familyString As String = NotNull(row.Item("FONT_FAMILY"), "Arial")
|
|
Dim family As FontFamily = New FontFamily(familyString)
|
|
|
|
obj.Font = New Font(family, size, style)
|
|
|
|
Dim color As Integer = NotNull(row.Item("FONT_COLOR"), 0)
|
|
|
|
obj.TextColor = IntToColor(color)
|
|
Return obj
|
|
End Function
|
|
|
|
''' <summary>
|
|
''' Funktioniert wie CreatePropsObject mit dem Unterschied, dass zusätzlich noch eine Liste von Indicies übergeben wird
|
|
''' Diese können dann im PropertyGrid angezeigt und ausgewählt werden.
|
|
''' Außerdem werden noch einige Eigenschaften gesetzt, die alle Controls (außer reine Anzeige-Controls) haben
|
|
''' </summary>
|
|
''' <param name="obj">Das grundlegende Properties Objekt</param>
|
|
''' <param name="row">Die DataRow, die die Eigenschaften des Controls enthält</param>
|
|
''' <param name="indicies">Eine Liste von Indicies</param>
|
|
''' <returns>Das gefüllt Properties Objekt</returns>
|
|
Private Function CreatePropsObjectWithIndicies(obj As InputProperties, row As DataRow, indicies As List(Of String))
|
|
obj = CreatePropsObject(obj, row)
|
|
obj.Indicies = indicies
|
|
obj.ReadOnly = StrToBool(row.Item("READ_ONLY"))
|
|
obj.Required = StrToBool(row.Item("VALIDATION"))
|
|
obj.Index = NotNull(row.Item("INDEX_NAME"), "")
|
|
obj.SQLCommand = New InputProperties.SQLValue(row.Item("SQL_UEBERPRUEFUNG"))
|
|
Return obj
|
|
End Function
|
|
|
|
Private Sub LoadControlProperties(sender As Control)
|
|
Dim props
|
|
Dim dt As DataTable = DD_DMSLiteDataSet.TBPM_PROFILE_CONTROLS
|
|
Dim row As DataRow
|
|
|
|
TabControlEigenschaften.Enabled = True
|
|
|
|
' Beim Laden der Eigenschaften eines Controls muss die ganze Datatable neu geladen werden
|
|
' Nicht wirklich, aber gibt gerade keine bessere Möglichkeit, ohne alle SQL Abfragen selbst auszuführen
|
|
Try
|
|
TBPM_PROFILE_CONTROLSTableAdapter.FillByProfil(DD_DMSLiteDataSet.TBPM_PROFILE_CONTROLS, ProfileId)
|
|
Catch ex As Exception
|
|
ClassLogger.Add("Error while executing TBPM_PROFILE_CONTROLSTableAdapter.FillByProfil in LoadControlProperties:")
|
|
ClassLogger.Add(ex)
|
|
End Try
|
|
|
|
row = dt.AsEnumerable().Where(Function(r As DataRow)
|
|
Return r.Item("GUID") = sender.Tag
|
|
End Function).SingleOrDefault()
|
|
|
|
' Control-Id wurde nicht in DataRow gefunden
|
|
If IsNothing(row) Then
|
|
ClassLogger.Add($"Error while filtering Controls by Guid '{sender.Tag}' in LoadControlProperties:")
|
|
MsgBox($"Control mit der Id {sender.Tag} wurde nicht gefunden!", MsgBoxStyle.Critical, "Fehler beim Laden der Control Eigenschaften")
|
|
|
|
Exit Sub
|
|
End If
|
|
|
|
' Globale Variablen setzen
|
|
CurrentControl = sender
|
|
CURRENT_CONTROL_ID = sender.Tag
|
|
|
|
SetActiveControlColor()
|
|
|
|
' Mithilfe von CreatePropsObject(WithIndicies) wird ein Basis Objekt mit grundlegenden
|
|
' Eigenschaften angelegt. Danach können für jeden Control Typ spezifische Eigenschaften festgelegt werden.
|
|
If TypeOf sender Is ClassControlCreator.LineLabel Then
|
|
Dim line As ClassControlCreator.LineLabel = sender
|
|
Dim lineProps As LineLabelProperties = CreatePropsObject(New LineLabelProperties, row)
|
|
|
|
props = lineProps
|
|
ElseIf TypeOf sender Is Label Then
|
|
Dim label As Label = sender
|
|
Dim labelProps As LabelProperties = CreatePropsObject(New LabelProperties, row)
|
|
labelProps.Text = label.Text
|
|
|
|
props = labelProps
|
|
ElseIf TypeOf sender Is CheckBox Then
|
|
Dim check As CheckBox = sender
|
|
Dim checkProps As CheckboxProperties = CreatePropsObjectWithIndicies(New CheckboxProperties, row, Windream_AllIndicies)
|
|
checkProps.Text = check.Text
|
|
|
|
props = checkProps
|
|
ElseIf TypeOf sender Is TextBox Then
|
|
Dim txt As TextBox = sender
|
|
Dim txtProps As TextboxProperties = CreatePropsObjectWithIndicies(New TextboxProperties, row, Windream_AllIndicies)
|
|
|
|
props = txtProps
|
|
|
|
ElseIf TypeOf sender Is ComboBox Then
|
|
Dim cmb As ComboBox = sender
|
|
Dim cmbProps As ComboboxProperties = CreatePropsObjectWithIndicies(New ComboboxProperties, row, Windream_AllIndicies)
|
|
cmbProps.ChoiceLists = Windream_ChoiceLists
|
|
cmbProps.ChoiceList = NotNull(row.Item("CHOICE_LIST"), "")
|
|
|
|
props = cmbProps
|
|
|
|
ElseIf TypeOf sender Is DateTimePicker Then
|
|
Dim dtp As DateTimePicker = sender
|
|
Dim dtpProps As DatepickerProperties = CreatePropsObjectWithIndicies(New DatepickerProperties, row, Windream_AllIndicies)
|
|
|
|
props = dtpProps
|
|
ElseIf TypeOf sender Is DataGridView Then
|
|
Dim grid As DataGridView = sender
|
|
Dim gridProps As GridViewProperties = CreatePropsObjectWithIndicies(New GridViewProperties, row, Windream_VectorIndicies)
|
|
|
|
props = gridProps
|
|
Else
|
|
MsgBox("This is not a supported control type!")
|
|
Exit Sub
|
|
End If
|
|
|
|
' Zum Schluss wird das Eigenschaften-Objekt ins PropertyGrid geladen
|
|
pgControls.SelectedObject = props
|
|
End Sub
|
|
|
|
Private Sub pgControls_PropertyValueChanged(s As Object, e As PropertyValueChangedEventArgs) Handles pgControls.PropertyValueChanged
|
|
Dim oldValue As Object = e.OldValue
|
|
Dim newValue As Object = e.ChangedItem.Value
|
|
Dim prop As String = e.ChangedItem.Label
|
|
|
|
Select Case prop
|
|
Case "Location"
|
|
UpdateSingleValue("X_LOC", DirectCast(newValue, Point).X)
|
|
UpdateSingleValue("Y_LOC", DirectCast(newValue, Point).Y)
|
|
|
|
CurrentControl.Location = newValue
|
|
|
|
Case "X"
|
|
UpdateSingleValue("X_LOC", CInt(newValue))
|
|
|
|
CurrentControl.Location = New Point(newValue, CurrentControl.Location.Y)
|
|
|
|
Case "Y"
|
|
UpdateSingleValue("Y_LOC", CInt(newValue))
|
|
|
|
CurrentControl.Location = New Point(CurrentControl.Location.X, newValue)
|
|
|
|
Case "Size"
|
|
UpdateSingleValue("WIDTH", DirectCast(newValue, Size).Width)
|
|
UpdateSingleValue("HEIGHT", DirectCast(newValue, Size).Height)
|
|
|
|
CurrentControl.Size = newValue
|
|
|
|
Case "Width"
|
|
UpdateSingleValue("WIDTH", CInt(newValue))
|
|
|
|
CurrentControl.Size = New Size(newValue, CurrentControl.Size.Height)
|
|
|
|
Case "Height"
|
|
UpdateSingleValue("HEIGHT", CInt(newValue))
|
|
|
|
CurrentControl.Size = New Size(CurrentControl.Size.Width, newValue)
|
|
|
|
Case "Name"
|
|
UpdateSingleValue("NAME", newValue)
|
|
|
|
CurrentControl.Name = newValue
|
|
|
|
Case "Index"
|
|
UpdateSingleValue("INDEX_NAME", newValue)
|
|
|
|
Case "Text"
|
|
UpdateSingleValue("CTRL_TEXT", newValue)
|
|
|
|
CurrentControl.Text = newValue
|
|
|
|
Case "Required"
|
|
UpdateSingleValue("VALIDATION", IIf(newValue = True, 1, 0))
|
|
|
|
Case "ReadOnly"
|
|
UpdateSingleValue("READ_ONLY", IIf(newValue = True, 1, 0))
|
|
|
|
Case "Font"
|
|
Dim font As Font = newValue
|
|
Dim fontSize As Integer = Math.Truncate(font.SizeInPoints)
|
|
UpdateSingleValue("FONT_SIZE", fontSize)
|
|
UpdateSingleValue("FONT_FAMILY", font.FontFamily.Name)
|
|
UpdateSingleValue("FONT_STYLE", font.Style.ToString)
|
|
|
|
CurrentControl.Font = font
|
|
Case "TextColor"
|
|
Dim color As Color = newValue
|
|
UpdateSingleValue("FONT_COLOR", ColorToInt(color))
|
|
|
|
CurrentControl.ForeColor = color
|
|
Case "SQLCommand"
|
|
UpdateSingleValue("SQL_UEBERPRUEFUNG", newValue)
|
|
UpdateSingleValue("CHOICE_LIST", "")
|
|
|
|
Case "ChoiceList"
|
|
UpdateSingleValue("CHOICE_LIST", newValue)
|
|
UpdateSingleValue("SQL_UEBERPRUEFUNG", "")
|
|
End Select
|
|
End Sub
|
|
|
|
Private Sub UpdateSingleValue(columnName As String, value As Object)
|
|
Dim guid As Integer = CURRENT_CONTROL_ID
|
|
Dim escapedValue = value
|
|
|
|
' Strings und SQL-Commands müssen vor dem Speichern escaped und mit Anführungszeichen versehen werden
|
|
If TypeOf value Is String Then
|
|
escapedValue = $"'{value}'"
|
|
ElseIf TypeOf value Is InputProperties.SQLValue Then
|
|
Dim v As InputProperties.SQLValue = value
|
|
escapedValue = $"'{v.Value.Replace("'", "''")}'"
|
|
End If
|
|
|
|
Try
|
|
ClassDatabase.Execute_non_Query($"UPDATE TBPM_PROFILE_CONTROLS SET {columnName} = {escapedValue}, CHANGED_WHO = '{Environment.UserName}' WHERE GUID = {guid}")
|
|
|
|
tslblAenderungen.Visible = True
|
|
tslblAenderungen.Text = "Änderungen gespeichert - " & Now
|
|
Catch ex As Exception
|
|
Dim msg = $"UpdateSingleValue - Fehler beim Speichern von Control (Id: {guid}, column: {columnName}): {vbCrLf}{ex.Message}"
|
|
MsgBox(msg)
|
|
ClassLogger.Add(msg)
|
|
End Try
|
|
End Sub
|
|
End Class |