1455 lines
66 KiB
VB.net
1455 lines
66 KiB
VB.net
Imports System.ComponentModel
|
|
Imports DD_LIB_Standards
|
|
Imports DevExpress.XtraGrid
|
|
Imports DevExpress.XtraGrid.Columns
|
|
Imports DevExpress.XtraGrid.Views.Grid
|
|
Imports DevExpress.XtraGrid.Views.Grid.ViewInfo
|
|
Imports DigitalData.Controls.LookupGrid
|
|
Imports DigitalData.Modules.Language.Utils
|
|
Imports System.Drawing
|
|
|
|
Public Class frmFormDesigner
|
|
Public ProfileId As Integer
|
|
Public ProfileName As String
|
|
Public ProfileObjectType As String
|
|
Public Designer_Locked As Boolean = True
|
|
Public ControlSelected 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 Source_AllIndicies As List(Of String)
|
|
Private Source_VectorIndicies As List(Of String)
|
|
Private Source_SimpleIndicies As List(Of String)
|
|
Private Source_LookupIndicies As List(Of String)
|
|
|
|
Private CurrentColumnId As Integer = 0
|
|
|
|
|
|
Private Sub frmFormDesigner_Load(sender As Object, e As EventArgs) Handles Me.Load
|
|
Try
|
|
ClassControlCreator.Logger = LOGCONFIG.GetLoggerFor("ControlCreator")
|
|
BarButtonItem3.Caption = "Designer locked"
|
|
BarButtonItem3.ItemAppearance.Normal.BackColor = Color.Red
|
|
Designer_Locked = True
|
|
Mouse_IsPressed = False
|
|
RibPGCtrlheight.Enabled = False
|
|
RibPGCtrlWidth.Enabled = False
|
|
rpggrp_controls.Enabled = False
|
|
' Setzt den typ des SQL-Befehls für frmSQL_DESIGNER
|
|
CURRENT_DESIGN_TYPE = "INPUT_INDEX"
|
|
CHANGES_FORM_DESIGN = False
|
|
|
|
' Profil Name in Fenstertitel setzen
|
|
Text = $"Validation Designer - Profil: {ProfileName}"
|
|
|
|
' Try
|
|
' Windream initialisieren
|
|
If IDB_ACTIVE = False Then
|
|
clsWindream.Create_Session()
|
|
bbtnitButton.Visibility = DevExpress.XtraBars.BarItemVisibility.Never
|
|
Else
|
|
bbtnitButton.Visibility = DevExpress.XtraBars.BarItemVisibility.Always
|
|
End If
|
|
|
|
|
|
'Windream Abfragen, sollten einmal beim Start des Formulars geladen werden
|
|
Dim unsortedIndicies
|
|
Dim sortedIndicies As List(Of String)
|
|
If IDB_ACTIVE = False Then
|
|
unsortedIndicies = clsWD_GET.GetIndicesByObjecttype(CURRENT_OBJECTTYPE).ToList()
|
|
|
|
sortedIndicies = unsortedIndicies '.OrderBy(Function(index As String) index).ToList()
|
|
sortedIndicies = sortedIndicies.OrderBy(Function(index As String) index).ToList
|
|
Else
|
|
sortedIndicies = IDBData.GetIndicesByBE(CURRENT_OBJECTTYPE).ToList()
|
|
End If
|
|
|
|
|
|
Source_AllIndicies = sortedIndicies
|
|
Source_VectorIndicies = Source_AllIndicies.FindAll(AddressOf IsVectorIndex)
|
|
Source_SimpleIndicies = Source_AllIndicies.Except(Source_VectorIndicies).ToList()
|
|
Source_LookupIndicies = Source_AllIndicies.
|
|
Where(AddressOf IsNotVectorBooleanIndex).
|
|
Where(AddressOf IsNotVectorDateIndex).
|
|
Where(AddressOf IsNotVectorDatetimeIndex).
|
|
Where(AddressOf IsNotBooleanIndex).
|
|
Where(AddressOf IsNotDateIndex).
|
|
ToList()
|
|
|
|
If IDB_ACTIVE = False Then
|
|
Windream_ChoiceLists = New List(Of String)
|
|
Windream_ChoiceLists.Add(String.Empty)
|
|
Windream_ChoiceLists.AddRange(clsWD_GET.GetChoiceLists())
|
|
End If
|
|
|
|
'Catch ex As Exception
|
|
' LOGGER.Error(ex)
|
|
' MsgBox("Fehler bei Initialisieren von windream: " & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Achtung:")
|
|
'End Try
|
|
|
|
Try
|
|
TBPM_PROFILE_CONTROLSTableAdapter.Connection.ConnectionString = CONNECTION_STRING_ECM
|
|
TBDD_CONNECTIONTableAdapter.Connection.ConnectionString = CONNECTION_STRING_ECM
|
|
TBWH_CHECK_PROFILE_CONTROLSTableAdapter.Connection.ConnectionString = CONNECTION_STRING_ECM
|
|
TBPM_CONTROL_TABLETableAdapter.Connection.ConnectionString = CONNECTION_STRING_ECM
|
|
TBDD_CONNECTIONTableAdapter.Fill(DD_DMSLiteDataSet.TBDD_CONNECTION)
|
|
Catch ex As Exception
|
|
LOGGER.Error(ex)
|
|
MsgBox("Fehler bei Laden der Connection-Strings und Grunddaten: " & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Achtung:")
|
|
End Try
|
|
|
|
LoadControls()
|
|
Catch ex As Exception
|
|
LOGGER.Error(ex)
|
|
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 NOT IN ('BUTTON','LBL','LINE')"
|
|
Dim dt As DataTable = Database_ECM.GetDatatable(sql) ', "frmFormDesigner_FormClosing")
|
|
|
|
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 frmColumn_Detail).Any Then
|
|
frmColumn_Detail.Close()
|
|
End If
|
|
|
|
' Setzt den typ des SQL-Befehls für frmSQL_DESIGNER
|
|
CURRENT_DESIGN_TYPE = "FINAL_INDEX"
|
|
|
|
' Beim Schließen das PropertyGrid leeren
|
|
pgControls.SelectedObject = Nothing
|
|
End Sub
|
|
|
|
''' <summary>
|
|
''' Filtert aus der Liste von Indexen die Vektor Indexe heraus
|
|
''' </summary>
|
|
Private Function IsVectorIndex(IndexName As String) As Boolean
|
|
Dim oType As Integer
|
|
If IDB_ACTIVE = False Then
|
|
oType = clsWD_GET.GetTypeOfIndexAsIntByName(IndexName)
|
|
Else
|
|
oType = IDBData.GetTypeOfIndex(IndexName)
|
|
End If
|
|
|
|
Return FINALINDICES.IsVectorIndex(oType)
|
|
End Function
|
|
|
|
Private Function IsNotBooleanIndex(IndexName As String) As Boolean
|
|
Dim oType As Integer '= clsWD_GET.GetTypeOfIndexAsIntByName(IndexName)
|
|
If IDB_ACTIVE = False Then
|
|
oType = clsWD_GET.GetTypeOfIndexAsIntByName(IndexName)
|
|
Else
|
|
oType = IDBData.GetTypeOfIndex(IndexName)
|
|
End If
|
|
Return oType <> FINALINDICES.INDEX_TYPE_BOOLEAN
|
|
End Function
|
|
|
|
Private Function IsNotDateIndex(IndexName As String) As Boolean
|
|
Dim oType As Integer '= clsWD_GET.GetTypeOfIndexAsIntByName(IndexName)
|
|
If IDB_ACTIVE = False Then
|
|
oType = clsWD_GET.GetTypeOfIndexAsIntByName(IndexName)
|
|
Else
|
|
oType = IDBData.GetTypeOfIndex(IndexName)
|
|
End If
|
|
Return oType <> FINALINDICES.INDEX_TYPE_DATE
|
|
End Function
|
|
|
|
Private Function IsNotVectorBooleanIndex(IndexName As String) As Boolean
|
|
Dim oType As Integer '= clsWD_GET.GetTypeOfIndexAsIntByName(IndexName)
|
|
If IDB_ACTIVE = False Then
|
|
oType = clsWD_GET.GetTypeOfIndexAsIntByName(IndexName)
|
|
Else
|
|
oType = IDBData.GetTypeOfIndex(IndexName)
|
|
End If
|
|
Return oType <> FINALINDICES.INDEX_TYPE_VECTOR_BOOLEAN
|
|
End Function
|
|
|
|
Private Function IsNotVectorDateIndex(IndexName As String) As Boolean
|
|
Dim oType As Integer '= clsWD_GET.GetTypeOfIndexAsIntByName(IndexName)
|
|
If IDB_ACTIVE = False Then
|
|
oType = clsWD_GET.GetTypeOfIndexAsIntByName(IndexName)
|
|
Else
|
|
oType = IDBData.GetTypeOfIndex(IndexName)
|
|
End If
|
|
Return oType <> FINALINDICES.INDEX_TYPE_VECTOR_DATE
|
|
End Function
|
|
|
|
Private Function IsNotVectorDatetimeIndex(IndexName As String) As Boolean
|
|
Dim oType As Integer '= clsWD_GET.GetTypeOfIndexAsIntByName(IndexName)
|
|
If IDB_ACTIVE = False Then
|
|
oType = clsWD_GET.GetTypeOfIndexAsIntByName(IndexName)
|
|
Else
|
|
oType = IDBData.GetTypeOfIndex(IndexName)
|
|
End If
|
|
Return oType <> FINALINDICES.INDEX_TYPE_VECTOR_DATETIME
|
|
End Function
|
|
Sub LoadControls()
|
|
Try
|
|
TBPM_PROFILE_CONTROLSTableAdapter.FillByProfil(DD_DMSLiteDataSet.TBPM_PROFILE_CONTROLS, USER_LANGUAGE, 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 oDTColumnsPerDevExGrid As DataTable = Database_ECM.GetDatatable($"SELECT * FROM TBPM_CONTROL_TABLE WHERE CONTROL_ID = {guid} ORDER BY [SEQUENCE]") ', "FDesignLaodControls")
|
|
|
|
|
|
Dim table = ClassControlCreator.CreateExistingGridControl(row, oDTColumnsPerDevExGrid, True)
|
|
|
|
AddHandler table.MouseClick, AddressOf gridControl_MouseClick
|
|
' AddHandler table.ColumnHeaderMouseClick, AddressOf table_ColumnHeaderMouseClick
|
|
|
|
pnldesigner.Controls.Add(table)
|
|
SetMovementHandlers(table)
|
|
|
|
Case "LOOKUP"
|
|
Dim lookup = ClassControlCreator.CreateExistingLookupControl(row, True)
|
|
pnldesigner.Controls.Add(lookup)
|
|
SetMovementHandlers(lookup)
|
|
|
|
Case "LINE"
|
|
Dim line = ClassControlCreator.CreateExistingLine(row, True)
|
|
pnldesigner.Controls.Add(line)
|
|
SetMovementHandlers(line)
|
|
Case "BUTTON"
|
|
Dim oButton = ClassControlCreator.CreateExistingButton(row, True)
|
|
pnldesigner.Controls.Add(oButton)
|
|
SetMovementHandlers(oButton)
|
|
End Select
|
|
Next
|
|
Catch ex As Exception
|
|
LOGGER.Error(ex)
|
|
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, btndtp.MouseDown, btnVektor.MouseDown, btnTabelle.MouseDown, btnCheckbox.MouseDown, btnLine.MouseDown, btnButton.MouseDown
|
|
' If Designer_Locked Then
|
|
' Exit Sub
|
|
' End If
|
|
' Mouse_IsPressed = True
|
|
|
|
' CurrentControl = Nothing
|
|
' Try
|
|
' TBPM_PROFILE_CONTROLSBindingSource.Clear()
|
|
' Catch ex As Exception
|
|
' LOGGER.Error(ex)
|
|
' End Try
|
|
'End Sub
|
|
|
|
'Private Sub DragDropButtons_MouseMove(sender As Object, e As MouseEventArgs) Handles btnlabel.MouseMove, btntextbox.MouseMove, btndtp.MouseMove, btnVektor.MouseMove, btnTabelle.MouseMove, btnCheckbox.MouseMove, btnLine.MouseMove, btnButton.MouseMove
|
|
' If Designer_Locked Then
|
|
' Exit Sub
|
|
' End If
|
|
' 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
|
|
' Case "btnButton"
|
|
' dragDropData = ClassControlCreator.PREFIX_BUTTON
|
|
' 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, btndtp.MouseUp, btnVektor.MouseUp, btnTabelle.MouseUp, btnCheckbox.MouseUp, btnLine.MouseUp, btnButton.MouseUp
|
|
' Mouse_IsPressed = False
|
|
'End Sub
|
|
|
|
'Private Sub pnlDesigner_DragDrop(sender As Object, e As DragEventArgs) Handles pnldesigner.DragDrop
|
|
' If Designer_Locked Then
|
|
' Exit Sub
|
|
' End If
|
|
' 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, USER_USERNAME, label.Size.Height, label.Size.Width)
|
|
' CHANGES_IN_ADMINISTRATION = True
|
|
' CurrentControl = label
|
|
' CurrentControl.Tag = New ClassControlCreator.ControlMetadata() With {
|
|
' .Guid = GetLastID(),
|
|
' .ReadOnly = False
|
|
' }
|
|
|
|
|
|
' 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, USER_USERNAME, txt.Size.Height, txt.Size.Width)
|
|
' CHANGES_IN_ADMINISTRATION = True
|
|
' CurrentControl = txt
|
|
' CurrentControl.Tag = New ClassControlCreator.ControlMetadata() With {
|
|
' .Guid = GetLastID(),
|
|
' .ReadOnly = False
|
|
' }
|
|
|
|
' 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, USER_USERNAME, cmb.Size.Height, cmb.Size.Width)
|
|
' CHANGES_IN_ADMINISTRATION = True
|
|
' CurrentControl = cmb
|
|
' CurrentControl.Tag = New ClassControlCreator.ControlMetadata() With {
|
|
' .Guid = GetLastID(),
|
|
' .ReadOnly = False
|
|
' }
|
|
|
|
' 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, USER_USERNAME, dtp.Size.Height, dtp.Size.Width)
|
|
' CHANGES_IN_ADMINISTRATION = True
|
|
' CurrentControl = dtp
|
|
' CurrentControl.Tag = New ClassControlCreator.ControlMetadata() With {
|
|
' .Guid = GetLastID(),
|
|
' .ReadOnly = False
|
|
' }
|
|
|
|
' 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, USER_USERNAME, chk.Size.Height, chk.Size.Width)
|
|
' CHANGES_IN_ADMINISTRATION = True
|
|
' CurrentControl = chk
|
|
' CurrentControl.Tag = New ClassControlCreator.ControlMetadata() With {
|
|
' .Guid = GetLastID(),
|
|
' .ReadOnly = False
|
|
' }
|
|
|
|
' pnldesigner.Controls.Add(chk)
|
|
|
|
' Case ClassControlCreator.PREFIX_DATAGRIDVIEW
|
|
' Dim lc As LookupControl3 = ClassControlCreator.CreateNewLookupControl(cursorPosition)
|
|
|
|
' SetMovementHandlers(lc)
|
|
|
|
' TBPM_PROFILE_CONTROLSTableAdapter.cmdInsertAnlage(ProfileId, lc.Name, "LOOKUP", lc.Name, lc.Location.X, lc.Location.Y, USER_USERNAME, lc.Size.Height, lc.Size.Width)
|
|
' CHANGES_IN_ADMINISTRATION = True
|
|
' CurrentControl = lc
|
|
' CurrentControl.Tag = New ClassControlCreator.ControlMetadata() With {
|
|
' .Guid = GetLastID(),
|
|
' .ReadOnly = False
|
|
' }
|
|
|
|
' pnldesigner.Controls.Add(lc)
|
|
|
|
' Case ClassControlCreator.PREFIX_TABLE
|
|
' Dim tb = ClassControlCreator.CreateNewTable(cursorPosition)
|
|
|
|
' SetMovementHandlers(tb)
|
|
' AddHandler tb.MouseClick, AddressOf gridControl_MouseClick
|
|
|
|
' TBPM_PROFILE_CONTROLSTableAdapter.cmdInsertAnlage(ProfileId, tb.Name, "TABLE", tb.Name, tb.Location.X, tb.Location.Y, USER_USERNAME, tb.Size.Height, tb.Size.Width)
|
|
' CHANGES_IN_ADMINISTRATION = True
|
|
' Dim oControlId = GetLastID()
|
|
|
|
' CurrentControl = tb
|
|
' CurrentControl.Tag = New ClassControlCreator.ControlMetadata() With {
|
|
' .Guid = oControlId,
|
|
' .ReadOnly = False
|
|
' }
|
|
|
|
' TBPM_CONTROL_TABLETableAdapter.Insert(oControlId, "column1", "Column1", 95, USER_USERNAME)
|
|
' TBPM_CONTROL_TABLETableAdapter.Insert(oControlId, "column2", "Column2", 95, USER_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, USER_USERNAME, line.Size.Height, line.Size.Width)
|
|
' CHANGES_IN_ADMINISTRATION = True
|
|
' CurrentControl = line
|
|
' CurrentControl.Tag = New ClassControlCreator.ControlMetadata() With {
|
|
' .Guid = GetLastID(),
|
|
' .ReadOnly = False
|
|
' }
|
|
|
|
|
|
' pnldesigner.Controls.Add(line)
|
|
' Case ClassControlCreator.PREFIX_BUTTON
|
|
' Dim oButton = ClassControlCreator.CreateNewButton(cursorPosition)
|
|
|
|
' SetMovementHandlers(oButton)
|
|
|
|
' TBPM_PROFILE_CONTROLSTableAdapter.cmdInsertAnlage(ProfileId, oButton.Name, "BUTTON", oButton.Name, oButton.Location.X, oButton.Location.Y, USER_USERNAME, oButton.Size.Height, oButton.Size.Width)
|
|
' CHANGES_IN_ADMINISTRATION = True
|
|
' CurrentControl = oButton
|
|
' CurrentControl.Tag = New ClassControlCreator.ControlMetadata() With {
|
|
' .Guid = GetLastID(),
|
|
' .ReadOnly = False
|
|
' }
|
|
|
|
|
|
' pnldesigner.Controls.Add(oButton)
|
|
' End Select
|
|
' Catch ex As Exception
|
|
' LOGGER.Error(ex)
|
|
' LOGGER.Info($"Error while Adding new control {e.Data.GetData(DataFormats.Text)}:")
|
|
' LOGGER.Info(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 Database_ECM.GetScalarValue(sql)
|
|
End Function
|
|
|
|
Sub SetActiveControlColor()
|
|
If DirectCast(CurrentControl.Tag, ClassControlCreator.ControlMetadata).ReadOnly = False Then
|
|
CurrentControl.BackColor = Color.DarkOrange
|
|
End If
|
|
|
|
' Reset Color of all other controls
|
|
For Each oControl As Control In Me.pnldesigner.Controls
|
|
If oControl.Name <> CurrentControl.Name Then
|
|
Dim oMetadata = DirectCast(oControl.Tag, ClassControlCreator.ControlMetadata)
|
|
|
|
If oMetadata.ReadOnly = False Then
|
|
Dim Type As String = oControl.GetType.ToString
|
|
Select Case Type
|
|
Case "System.Windows.Forms.TextBox"
|
|
oControl.BackColor = Color.White
|
|
Case "System.Windows.Forms.ComboBox"
|
|
oControl.BackColor = Color.White
|
|
Case "System.Windows.Forms.Label"
|
|
oControl.BackColor = Color.Transparent
|
|
Case "System.Windows.Forms.CheckBox"
|
|
oControl.BackColor = Color.Transparent
|
|
Case "DD_ProcessManager.ClassControlCreator+LineLabel"
|
|
oControl.BackColor = oControl.ForeColor
|
|
Case "DigitalData.Controls.LookupGrid.LookupControl3"
|
|
oControl.BackColor = Color.White
|
|
Case "System.Windows.Forms.Button"
|
|
oControl.BackColor = SystemColors.Control
|
|
End Select
|
|
End If
|
|
End If
|
|
Next
|
|
End Sub
|
|
|
|
Public Sub gridControl_MouseClick(sender As GridControl, e As MouseEventArgs)
|
|
Try
|
|
If Designer_Locked = True Then
|
|
Exit Sub
|
|
End If
|
|
Dim oView As GridView = sender.DefaultView
|
|
Dim oHitinfo As GridHitInfo = oView.CalcHitInfo(sender.PointToClient(Cursor.Position))
|
|
|
|
CurrentControl = sender
|
|
CURRENT_CONTROL_ID = DirectCast(sender.Tag, ClassControlCreator.ControlMetadata).Guid
|
|
|
|
If oHitinfo.IsValid And oHitinfo.InColumn Then
|
|
Dim oColumn As GridColumn = oHitinfo.Column
|
|
|
|
If oColumn Is Nothing Then
|
|
Exit Sub
|
|
End If
|
|
|
|
Dim oColumnCaption As String = oColumn.Caption
|
|
Dim oColumnName As String = oColumn.FieldName
|
|
Dim oColumnId = TBPM_CONTROL_TABLETableAdapter.getColumnID(CURRENT_CONTROL_ID, oColumnName)
|
|
|
|
CurrentColumnId = oColumnId
|
|
|
|
Dim frmTableColumn = New frmColumn_Detail()
|
|
frmTableColumn.FillData(CurrentColumnId)
|
|
frmTableColumn.Text = "Konfiguration von Spalte: " & oColumnCaption
|
|
Dim oResult = frmTableColumn.ShowDialog()
|
|
|
|
LoadControls()
|
|
|
|
ElseIf oHitinfo.IsValid And e.Button = MouseButtons.Right Then
|
|
GridControlContextMenu.Show(Cursor.Position.X, Cursor.Position.Y)
|
|
End If
|
|
Catch ex As Exception
|
|
LOGGER.Error(ex)
|
|
MsgBox("Error while loading Column Configuration: " & vbCrLf & ex.Message, MsgBoxStyle.Critical)
|
|
End Try
|
|
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
|
|
TBPM_CONTROL_TABLETableAdapter.DeleteColumnsByControlId(controlId)
|
|
TBPM_PROFILE_CONTROLSTableAdapter.Delete(controlId)
|
|
LoadControls()
|
|
End If
|
|
End If
|
|
Catch ex As Exception
|
|
LOGGER.Error(ex)
|
|
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
|
|
|
|
|
|
|
|
|
|
''' <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
|
|
If Designer_Locked Then
|
|
Exit Sub
|
|
End If
|
|
CurrentControl = sender
|
|
Mouse_BeginLocation = e.Location
|
|
sender.BringToFront()
|
|
RibbonPageGroup3.Enabled = True
|
|
Mouse_IsPressed = True
|
|
RibPGCtrlheight.Enabled = True
|
|
RibPGCtrlWidth.Enabled = True
|
|
Console.WriteLine("CURRENT_CONTROL:" & CurrentControl.Name)
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub OnControl_MouseUp(sender As Control, e As MouseEventArgs)
|
|
Try
|
|
If Designer_Locked Then
|
|
Exit Sub
|
|
End If
|
|
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 CurrentPosition.X = OldPosition.X + 2 And CurrentPosition.Y = OldPosition.Y + 2 Then
|
|
CurrentControl.Location = New Point(CurrentPosition.X - 2, CurrentPosition.Y - 2)
|
|
MyBase.Cursor = Cursors.Default
|
|
Exit Sub
|
|
End If
|
|
|
|
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
|
|
Catch ex As Exception
|
|
MsgBox(ex.Message, MsgBoxStyle.Critical)
|
|
LOGGER.Error(ex)
|
|
Mouse_IsMoving = False
|
|
Mouse_IsPressed = False
|
|
End Try
|
|
|
|
End Sub
|
|
|
|
Private Sub OnControl_MouseMove(sender As Control, e As MouseEventArgs)
|
|
Try
|
|
If Designer_Locked Then
|
|
Exit Sub
|
|
End If
|
|
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
|
|
LOGGER.Error(ex)
|
|
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.Active = StrToBool(row.Item("CONTROL_ACTIVE"))
|
|
obj.Index = NotNull(row.Item("INDEX_NAME"), "")
|
|
obj.DefaultValue = NotNull(row.Item("DEFAULT_VALUE"), Nothing)
|
|
obj.SQLCommand = New SQLValue(row.Item("SQL_UEBERPRUEFUNG"))
|
|
Return obj
|
|
End Function
|
|
|
|
Private Sub LoadControlProperties(sender As Control)
|
|
Try
|
|
Dim props
|
|
Dim oDatatable As DataTable = DD_DMSLiteDataSet.TBPM_PROFILE_CONTROLS
|
|
Dim oRow As DataRow
|
|
|
|
pgControls.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, USER_LANGUAGE, ProfileId)
|
|
Catch ex As Exception
|
|
LOGGER.Error(ex)
|
|
LOGGER.Info("Error while executing TBPM_PROFILE_CONTROLSTableAdapter.FillByProfil in LoadControlProperties:")
|
|
LOGGER.Info(ex)
|
|
End Try
|
|
|
|
Dim oControlId = DirectCast(sender.Tag, ClassControlCreator.ControlMetadata).Guid
|
|
|
|
oRow = oDatatable.AsEnumerable().Where(Function(r As DataRow)
|
|
Return r.Item("GUID") = oControlId
|
|
End Function).SingleOrDefault()
|
|
|
|
' Control-Id wurde nicht in DataRow gefunden
|
|
If IsNothing(oRow) Then
|
|
LOGGER.Info($"Error while filtering Controls by Guid '{oControlId}' in LoadControlProperties:")
|
|
MsgBox($"Control mit der Id {oControlId} wurde nicht gefunden!", MsgBoxStyle.Critical, "Fehler beim Laden der Control Eigenschaften")
|
|
|
|
Exit Sub
|
|
End If
|
|
|
|
' Globale Variablen setzen
|
|
CurrentControl = sender
|
|
CURRENT_CONTROL_ID = oControlId
|
|
|
|
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, oRow)
|
|
|
|
props = lineProps
|
|
ElseIf TypeOf sender Is Label Then
|
|
Dim label As Label = sender
|
|
Dim labelProps As LabelProperties = CreatePropsObject(New LabelProperties, oRow)
|
|
labelProps.Text = label.Text
|
|
|
|
props = labelProps
|
|
ElseIf TypeOf sender Is CheckBox Then
|
|
Dim check As CheckBox = sender
|
|
Dim checkProps As CheckboxProperties = CreatePropsObjectWithIndicies(New CheckboxProperties, oRow, Source_AllIndicies)
|
|
checkProps.Text = check.Text
|
|
checkProps.Enable_SQL = New SQLValue(NotNull(oRow.Item("SQL_ENABLE"), ""))
|
|
checkProps.Enable_SQL_OnLoad = New SQLValue(NotNull(oRow.Item("SQL_ENABLE_ON_LOAD"), ""))
|
|
checkProps.SetControlData = New SQLValue(NotNull(oRow.Item("SET_CONTROL_DATA"), ""))
|
|
props = checkProps
|
|
ElseIf TypeOf sender Is TextBox Then
|
|
Dim txt As TextBox = sender
|
|
Dim txtProps As TextboxProperties = CreatePropsObjectWithIndicies(New TextboxProperties, oRow, Source_AllIndicies)
|
|
txtProps.Regex = NotNull(oRow.Item("REGEX_MATCH"), String.Empty)
|
|
txtProps.RegexMessage = NotNull(oRow.Item("REGEX_MESSAGE_DE"), String.Empty)
|
|
txtProps.Enable_SQL = New SQLValue(NotNull(oRow.Item("SQL_ENABLE"), ""))
|
|
txtProps.Enable_SQL_OnLoad = New SQLValue(NotNull(oRow.Item("SQL_ENABLE_ON_LOAD"), ""))
|
|
txtProps.SetControlData = New SQLValue(NotNull(oRow.Item("SET_CONTROL_DATA"), ""))
|
|
|
|
props = txtProps
|
|
|
|
ElseIf TypeOf sender Is ComboBox Then
|
|
Dim cmb As ComboBox = sender
|
|
Dim cmbProps As ComboboxProperties = CreatePropsObjectWithIndicies(New ComboboxProperties, oRow, Source_AllIndicies)
|
|
cmbProps.ChoiceLists = Windream_ChoiceLists
|
|
cmbProps.ChoiceList = NotNull(oRow.Item("CHOICE_LIST"), String.Empty)
|
|
cmbProps.Enable_SQL = New SQLValue(NotNull(oRow.Item("SQL_ENABLE"), ""))
|
|
cmbProps.Enable_SQL_OnLoad = New SQLValue(NotNull(oRow.Item("SQL_ENABLE_ON_LOAD"), ""))
|
|
cmbProps.SetControlData = New SQLValue(NotNull(oRow.Item("SET_CONTROL_DATA"), ""))
|
|
props = cmbProps
|
|
cmbProps.DisplayAsLookUpControl = False
|
|
|
|
ElseIf TypeOf sender Is DateTimePicker Then
|
|
Dim dtp As DateTimePicker = sender
|
|
Dim dtpProps As DatepickerProperties = CreatePropsObjectWithIndicies(New DatepickerProperties, oRow, Source_AllIndicies)
|
|
dtpProps.Enable_SQL = New SQLValue(NotNull(oRow.Item("SQL_ENABLE"), ""))
|
|
dtpProps.Enable_SQL_OnLoad = New SQLValue(NotNull(oRow.Item("SQL_ENABLE_ON_LOAD"), ""))
|
|
props = dtpProps
|
|
|
|
ElseIf TypeOf sender Is DataGridView Then
|
|
Dim grid As DataGridView = sender
|
|
Dim gridProps As GridViewProperties = CreatePropsObjectWithIndicies(New GridViewProperties, oRow, Source_VectorIndicies)
|
|
|
|
props = gridProps
|
|
|
|
ElseIf TypeOf sender Is LookupControl3 Then
|
|
Dim grid As LookupControl3 = sender
|
|
Dim lookupProps As LookupControlProperties = CreatePropsObjectWithIndicies(New LookupControlProperties, oRow, Source_AllIndicies)
|
|
lookupProps.MultiSelect = StrToBool(oRow.Item("MULTISELECT"))
|
|
lookupProps.PreventDuplicates = StrToBool(oRow.Item("VKT_PREVENT_MULTIPLE_VALUES"))
|
|
lookupProps.AllowAddNewValues = StrToBool(oRow.Item("VKT_ADD_ITEM"))
|
|
lookupProps.DisplayAsComboBox = False
|
|
lookupProps.Enable_SQL = New SQLValue(NotNull(oRow.Item("SQL_ENABLE"), ""))
|
|
lookupProps.Enable_SQL_OnLoad = New SQLValue(NotNull(oRow.Item("SQL_ENABLE_ON_LOAD"), ""))
|
|
lookupProps.SetControlData = New SQLValue(NotNull(oRow.Item("SET_CONTROL_DATA"), ""))
|
|
props = lookupProps
|
|
|
|
ElseIf TypeOf sender Is GridControl Then
|
|
Dim oGridControl As GridControl = sender
|
|
Dim oGridProps As GridControlProperties = CreatePropsObjectWithIndicies(New GridControlProperties, oRow, Source_VectorIndicies)
|
|
oGridProps.AllowAddNewValues = StrToBool(oRow.Item("VKT_ADD_ITEM"))
|
|
oGridProps.Enable_SQL = New SQLValue(NotNull(oRow.Item("SQL_ENABLE"), ""))
|
|
oGridProps.Enable_SQL_OnLoad = New SQLValue(NotNull(oRow.Item("SQL_ENABLE_ON_LOAD"), ""))
|
|
props = oGridProps
|
|
ElseIf TypeOf sender Is Button Then
|
|
Dim oButton As Button = sender
|
|
Dim oButtonProps As ButtonProperties = CreatePropsObject(New ButtonProperties, oRow, Source_VectorIndicies)
|
|
oButtonProps.Text = oButton.Text
|
|
oButtonProps.SQLCommand = New SQLValue(oRow.Item("SQL_UEBERPRUEFUNG"))
|
|
oButtonProps.Override_SQL = New SQLValue(NotNull(oRow.Item("SQL2"), ""))
|
|
oButtonProps.Enable_SQL = New SQLValue(NotNull(oRow.Item("SQL_ENABLE"), ""))
|
|
oButtonProps.Enable_SQL_OnLoad = New SQLValue(NotNull(oRow.Item("SQL_ENABLE_ON_LOAD"), ""))
|
|
If Not IsDBNull(oRow.Item("IMAGE_CONTROL")) Then
|
|
Dim obimg() As Byte = oRow.Item("IMAGE_CONTROL")
|
|
Dim oBitmap As Bitmap = ByteArrayToBitmap(obimg)
|
|
oButtonProps.CtrlImage = New ImageValue("IMAGE")
|
|
oButton.Image = oBitmap
|
|
End If
|
|
|
|
props = oButtonProps
|
|
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
|
|
Catch ex As Exception
|
|
MsgBox(ex.Message, MsgBoxStyle.Critical)
|
|
End Try
|
|
|
|
End Sub
|
|
|
|
Private Sub pgControls_PropertyValueChanged(s As Object, e As PropertyValueChangedEventArgs) Handles pgControls.PropertyValueChanged
|
|
Dim oldValue As Object = e.OldValue
|
|
Dim newValue = e.ChangedItem.Value
|
|
Dim prop As String = e.ChangedItem.Label
|
|
|
|
Select Case prop
|
|
Case "DisplayAsLookUpControl"
|
|
If UpdateSingleValue("CTRL_TYPE", "LOOKUP") = True Then
|
|
MsgBox("Type has been changed. Controls will be reloaded!", MsgBoxStyle.Information, "")
|
|
LoadControls()
|
|
End If
|
|
Case "DisplayAsComboBox"
|
|
If UpdateSingleValue("CTRL_TYPE", "CMB") = True Then
|
|
MsgBox("Type has been changed. Controls will be reloaded!", MsgBoxStyle.Information, "")
|
|
LoadControls()
|
|
End If
|
|
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", CInt(font.Style))
|
|
|
|
CurrentControl.Font = font
|
|
Case "TextColor"
|
|
Dim color As Color = newValue
|
|
UpdateSingleValue("FONT_COLOR", ColorTranslator.ToWin32(color))
|
|
|
|
CurrentControl.ForeColor = color
|
|
Case "SQLCommand"
|
|
UpdateSingleValue("SQL_UEBERPRUEFUNG", newValue)
|
|
UpdateSingleValue("CONNECTION_ID", CURRENT_CONN_ID)
|
|
UpdateSingleValue("CHOICE_LIST", "")
|
|
|
|
Case "Enable_SQL"
|
|
UpdateSingleValue("SQL_ENABLE", newValue)
|
|
UpdateSingleValue("CONNECTION_ID", CURRENT_CONN_ID)
|
|
UpdateSingleValue("CHOICE_LIST", "")
|
|
Case "Enable_SQL_OnLoad"
|
|
UpdateSingleValue("SQL_ENABLE_ON_LOAD", newValue)
|
|
UpdateSingleValue("SQL_ENABLE_ON_LOAD_CONID", CURRENT_CONN_ID)
|
|
UpdateSingleValue("CHOICE_LIST", "")
|
|
Case "Override_SQL"
|
|
UpdateSingleValue("SQL2", newValue)
|
|
UpdateSingleValue("CONNECTION_ID", CURRENT_CONN_ID)
|
|
UpdateSingleValue("CHOICE_LIST", "")
|
|
Case "SetControlData"
|
|
UpdateSingleValue("SET_CONTROL_DATA", newValue)
|
|
UpdateSingleValue("CONNECTION_ID", CURRENT_CONN_ID)
|
|
UpdateSingleValue("CHOICE_LIST", "")
|
|
Case "ChoiceList"
|
|
UpdateSingleValue("CHOICE_LIST", newValue)
|
|
UpdateSingleValue("SQL_UEBERPRUEFUNG", "")
|
|
UpdateSingleValue("CONNECTION_ID", "NULL")
|
|
|
|
Case "MultiSelect"
|
|
UpdateSingleValue("MULTISELECT", IIf(newValue = True, 1, 0))
|
|
|
|
Case "AllowAddNewValues"
|
|
UpdateSingleValue("VKT_ADD_ITEM", IIf(newValue = True, 1, 0))
|
|
|
|
Case "PreventDuplicates"
|
|
UpdateSingleValue("VKT_PREVENT_MULTIPLE_VALUES", IIf(newValue = True, 1, 0))
|
|
|
|
Case "DefaultValue"
|
|
UpdateSingleValue("DEFAULT_VALUE", newValue)
|
|
|
|
Case "Regex"
|
|
UpdateSingleValue("REGEX_MATCH", newValue)
|
|
|
|
Case "RegexMessage"
|
|
UpdateSingleValue("REGEX_MESSAGE_DE", newValue)
|
|
Case "Active"
|
|
UpdateSingleValue("CONTROL_ACTIVE", IIf(newValue = True, 1, 0))
|
|
Case "CtrlImage"
|
|
Dim myPath As ImageValue = newValue
|
|
UpdateImage(myPath.Value)
|
|
End Select
|
|
End Sub
|
|
Private Function UpdateImage(ImageLocation As String)
|
|
Try
|
|
Dim image As Bitmap = CType(System.Drawing.Image.FromFile(ImageLocation, True), Bitmap)
|
|
Dim bimage() As Byte = BitmapToByteArray(image)
|
|
'UPDATE TBPMO_FORM_CONSTRUCTOR SET MENU_IMG = @MENU_IMG, WHERE GUID = @GUID"
|
|
Dim SQL As String = "UPDATE TBPM_PROFILE_CONTROLS SET IMAGE_CONTROL = @MENU_IMG WHERE GUID = @GUID"
|
|
Dim conn As SqlClient.SqlConnection = New SqlClient.SqlConnection(CONNECTION_STRING_ECM)
|
|
Dim cmd As SqlClient.SqlCommand = New SqlClient.SqlCommand(SQL, conn)
|
|
|
|
cmd.Parameters.Add("@MENU_IMG", SqlDbType.VarBinary).Value = bimage
|
|
cmd.Parameters.Add("@GUID", SqlDbType.Int).Value = CURRENT_CONTROL_ID
|
|
|
|
conn.Open()
|
|
cmd.ExecuteNonQuery()
|
|
conn.Close()
|
|
|
|
tslblAenderungen.Visible = True
|
|
tslblAenderungen.Text = "Änderungen gespeichert - " & Now
|
|
CHANGES_FORM_DESIGN = True
|
|
Return True
|
|
|
|
Catch ex As Exception
|
|
LOGGER.Error(ex)
|
|
Dim oMsg = $"UpdateImage - Error while saving Control (Id: {CURRENT_CONTROL_ID}): {vbCrLf}{ex.Message}"
|
|
MsgBox(oMsg)
|
|
LOGGER.Info(oMsg)
|
|
Return False
|
|
End Try
|
|
End Function
|
|
Private Function 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 SQLValue Then
|
|
Dim v As SQLValue = value
|
|
escapedValue = $"'{v.Value.Replace("'", "''")}'"
|
|
End If
|
|
|
|
Try
|
|
If Database_ECM.ExecuteNonQuery($"UPDATE TBPM_PROFILE_CONTROLS SET {columnName} = {escapedValue}, CHANGED_WHO = '{USER_USERNAME}' WHERE GUID = {guid}") = True Then
|
|
tslblAenderungen.Visible = True
|
|
tslblAenderungen.Text = "Änderungen gespeichert - " & Now
|
|
If columnName.ToUpper = "CTRL_TEXT" Then
|
|
Dim oSQL = $"EXEC PRPM_CHANGE_CONTROL_CAPTION {guid},{escapedValue},'{USER_USERNAME}','{USER_LANGUAGE}'"
|
|
Database_ECM.ExecuteNonQuery(oSQL)
|
|
End If
|
|
CHANGES_FORM_DESIGN = True
|
|
Return True
|
|
End If
|
|
|
|
|
|
|
|
Catch ex As Exception
|
|
LOGGER.Error(ex)
|
|
Dim oMsg = $"UpdateSingleValue - Fehler beim Speichern von Control (Id: {guid}, column: {columnName}): {vbCrLf}{ex.Message}"
|
|
MsgBox(oMsg)
|
|
LOGGER.Info(oMsg)
|
|
Return False
|
|
End Try
|
|
End Function
|
|
|
|
Private Sub MenuItemAddColumn_Click(sender As Object, e As EventArgs) Handles MenuItemAddColumn.Click
|
|
Try
|
|
Dim oGuid = clsTools.ShortGuid()
|
|
Dim oColumnName As String = "colNew" & oGuid
|
|
Dim oColumnCaption As String = "New Column " & oGuid
|
|
If Database_ECM.ExecuteNonQuery($"INSERT INTO TBPM_CONTROL_TABLE (CONTROL_ID, SPALTENNAME, SPALTEN_HEADER, SPALTENBREITE) VALUES({CURRENT_CONTROL_ID}, '{oColumnName}', '{oColumnCaption}', 95)") = True Then
|
|
tslblAenderungen.Visible = True
|
|
tslblAenderungen.Text = "Änderungen gespeichert - " & Now
|
|
|
|
LoadControls()
|
|
End If
|
|
Catch ex As Exception
|
|
Dim oMsg = $"MenuItemAddColumn_Click - Fehler beim Hinzufügen von einer neuen Spalte: {vbCrLf}{ex.Message}"
|
|
MsgBox(oMsg)
|
|
LOGGER.Error(ex)
|
|
End Try
|
|
End Sub
|
|
|
|
Private Sub bbtnItemFinishSQL_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles bbtnItemFinishSQL.ItemClick
|
|
Try
|
|
CURRENT_DESIGN_TYPE = "SQL_BTNFINISH"
|
|
Dim oSQL = $"SELECT SQL_BTN_FINISH FROM TBPM_PROFILE WHERE GUID = {ProfileId}"
|
|
Dim oldSQL = Database_ECM.GetScalarValue(oSQL)
|
|
Dim oForm As New frmSQL_DESIGNER() With {.SQLCommand = oldSQL}
|
|
Dim oResult = oForm.ShowDialog()
|
|
|
|
If oResult = DialogResult.OK Then
|
|
If oldSQL <> oForm.SQLCommand Then
|
|
Dim oUpdate As String = $"Update TBPM_PROFILE SET CHANGED_WHO = '{USER_USERNAME}', SQL_BTN_FINISH = '{oForm.SQLCommand.Replace("'", "''")}' WHERE GUID = {CURRENT_ProfilGUID}"
|
|
If Database_ECM.ExecuteNonQuery(oUpdate) = True Then
|
|
tslblAenderungen.Text = $"Profile SQLFinish saved - {Now.ToLongTimeString}"
|
|
tslblAenderungen.Visible = True
|
|
CHANGES_FORM_DESIGN = True
|
|
Else
|
|
tslblAenderungen.Visible = False
|
|
End If
|
|
|
|
End If
|
|
End If
|
|
Catch ex As Exception
|
|
MsgBox("Error in Saving Profile SQLFinish: " & vbNewLine & vbNewLine & ex.Message)
|
|
LOGGER.Error(ex)
|
|
End Try
|
|
End Sub
|
|
|
|
Private Sub BarButtonItem1_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles BarButtonItem1.ItemClick
|
|
If CurrentControl Is Nothing = False Then
|
|
DeleteControl(CurrentControl.Name)
|
|
pgControls.Enabled = False
|
|
CurrentControl = Nothing
|
|
RibPGCtrlheight.Enabled = False
|
|
RibPGCtrlWidth.Enabled = False
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub BarButtonItem2_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles BarButtonItem2.ItemClick
|
|
LoadControls()
|
|
End Sub
|
|
|
|
Private Sub BarButtonItem3_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles BarButtonItem3.ItemClick
|
|
If BarButtonItem3.Caption = "Designer locked" Then
|
|
BarButtonItem3.Caption = "Designer active"
|
|
BarButtonItem3.ItemAppearance.Normal.BackColor = Color.LightSteelBlue
|
|
rpggrp_controls.Enabled = True
|
|
Designer_Locked = False
|
|
Else
|
|
BarButtonItem3.Caption = "Designer locked"
|
|
BarButtonItem3.ItemAppearance.Normal.BackColor = Color.Red
|
|
Designer_Locked = True
|
|
rpggrp_controls.Enabled = False
|
|
If Me.Cursor = Cursors.Cross Then
|
|
Mouse_IsPressed = False
|
|
Me.Cursor = Cursors.Default
|
|
End If
|
|
End If
|
|
End Sub
|
|
Private Sub ControlBarItem_Clicked(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles bbtnitLabel.ItemClick, bbtnitLine.ItemClick, bbtnitButton.ItemClick,
|
|
bbtnitCheckBox.ItemClick, bbtnitDatePicker.ItemClick, bbtnitLU.ItemClick, bbtnitTable.ItemClick, bbtnitTextBox.ItemClick
|
|
If Designer_Locked Then
|
|
Exit Sub
|
|
End If
|
|
Me.Cursor = Cursors.Cross
|
|
Mouse_IsPressed = True
|
|
CurrentControl = Nothing
|
|
|
|
Select Case e.Item.Name
|
|
Case "bbtnitLabel"
|
|
ControlSelected = ClassControlCreator.PREFIX_LABEL
|
|
Case "bbtnitTextBox"
|
|
ControlSelected = ClassControlCreator.PREFIX_TEXTBOX
|
|
Case "btncmb"
|
|
ControlSelected = ClassControlCreator.PREFIX_COMBOBOX
|
|
Case "bbtnitDatePicker"
|
|
ControlSelected = ClassControlCreator.PREFIX_DATETIMEPICKER
|
|
Case "btnVektor"
|
|
ControlSelected = ClassControlCreator.PREFIX_DATAGRIDVIEW
|
|
Case "bbtnitTable"
|
|
ControlSelected = ClassControlCreator.PREFIX_TABLE
|
|
Case "bbtnitCheckBox"
|
|
ControlSelected = ClassControlCreator.PREFIX_CHECKBOX
|
|
Case "bbtnitLine"
|
|
ControlSelected = ClassControlCreator.PREFIX_LINE
|
|
Case "bbtnitButton"
|
|
ControlSelected = ClassControlCreator.PREFIX_BUTTON
|
|
Case "bbtnitLU"
|
|
ControlSelected = ClassControlCreator.PREFIX_LOOKUP
|
|
End Select
|
|
|
|
|
|
End Sub
|
|
|
|
Private Sub frmFormDesigner_KeyUp(sender As Object, e As KeyEventArgs) Handles MyBase.KeyUp
|
|
If e.KeyCode = Keys.Escape Then
|
|
If Me.Cursor = Cursors.Cross Then
|
|
Mouse_IsPressed = False
|
|
Me.Cursor = Cursors.Default
|
|
End If
|
|
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub pnldesigner_MouseDown(sender As Object, e As MouseEventArgs) Handles pnldesigner.MouseDown
|
|
If Designer_Locked Then
|
|
Exit Sub
|
|
End If
|
|
If Me.Cursor = Cursors.Cross And Mouse_IsPressed = True Then
|
|
Dim cursorPosition As Point = pnldesigner.PointToClient(Cursor.Position)
|
|
Mouse_IsPressed = False
|
|
|
|
Try
|
|
Select Case ControlSelected
|
|
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, USER_USERNAME, label.Size.Height, label.Size.Width)
|
|
CHANGES_FORM_DESIGN = True
|
|
CurrentControl = label
|
|
CurrentControl.Tag = New ClassControlCreator.ControlMetadata() With {
|
|
.Guid = GetLastID(),
|
|
.ReadOnly = False
|
|
}
|
|
|
|
|
|
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, USER_USERNAME, txt.Size.Height, txt.Size.Width)
|
|
CHANGES_FORM_DESIGN = True
|
|
CurrentControl = txt
|
|
CurrentControl.Tag = New ClassControlCreator.ControlMetadata() With {
|
|
.Guid = GetLastID(),
|
|
.ReadOnly = False
|
|
}
|
|
|
|
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, USER_USERNAME, cmb.Size.Height, cmb.Size.Width)
|
|
CHANGES_FORM_DESIGN = True
|
|
CurrentControl = cmb
|
|
CurrentControl.Tag = New ClassControlCreator.ControlMetadata() With {
|
|
.Guid = GetLastID(),
|
|
.ReadOnly = False
|
|
}
|
|
|
|
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, USER_USERNAME, dtp.Size.Height, dtp.Size.Width)
|
|
CHANGES_FORM_DESIGN = True
|
|
CurrentControl = dtp
|
|
CurrentControl.Tag = New ClassControlCreator.ControlMetadata() With {
|
|
.Guid = GetLastID(),
|
|
.ReadOnly = False
|
|
}
|
|
|
|
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, USER_USERNAME, chk.Size.Height, chk.Size.Width)
|
|
CHANGES_FORM_DESIGN = True
|
|
CurrentControl = chk
|
|
CurrentControl.Tag = New ClassControlCreator.ControlMetadata() With {
|
|
.Guid = GetLastID(),
|
|
.ReadOnly = False
|
|
}
|
|
|
|
pnldesigner.Controls.Add(chk)
|
|
|
|
Case ClassControlCreator.PREFIX_LOOKUP
|
|
Dim lc As LookupControl3 = ClassControlCreator.CreateNewLookupControl(cursorPosition)
|
|
|
|
SetMovementHandlers(lc)
|
|
|
|
TBPM_PROFILE_CONTROLSTableAdapter.cmdInsertAnlage(ProfileId, lc.Name, "LOOKUP", lc.Name, lc.Location.X, lc.Location.Y, USER_USERNAME, lc.Size.Height, lc.Size.Width)
|
|
CHANGES_FORM_DESIGN = True
|
|
CurrentControl = lc
|
|
CurrentControl.Tag = New ClassControlCreator.ControlMetadata() With {
|
|
.Guid = GetLastID(),
|
|
.ReadOnly = False
|
|
}
|
|
|
|
pnldesigner.Controls.Add(lc)
|
|
|
|
Case ClassControlCreator.PREFIX_TABLE
|
|
Dim tb = ClassControlCreator.CreateNewTable(cursorPosition)
|
|
|
|
SetMovementHandlers(tb)
|
|
AddHandler tb.MouseClick, AddressOf gridControl_MouseClick
|
|
|
|
TBPM_PROFILE_CONTROLSTableAdapter.cmdInsertAnlage(ProfileId, tb.Name, "TABLE", tb.Name, tb.Location.X, tb.Location.Y, USER_USERNAME, tb.Size.Height, tb.Size.Width)
|
|
CHANGES_FORM_DESIGN = True
|
|
Dim oControlId = GetLastID()
|
|
|
|
CurrentControl = tb
|
|
CurrentControl.Tag = New ClassControlCreator.ControlMetadata() With {
|
|
.Guid = oControlId,
|
|
.ReadOnly = False
|
|
}
|
|
|
|
TBPM_CONTROL_TABLETableAdapter.Insert(oControlId, "column1", "Column1", 95, USER_USERNAME, "TEXT")
|
|
TBPM_CONTROL_TABLETableAdapter.Insert(oControlId, "column2", "Column2", 95, USER_USERNAME, "TEXT")
|
|
|
|
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, USER_USERNAME, line.Size.Height, line.Size.Width)
|
|
CHANGES_FORM_DESIGN = True
|
|
CurrentControl = line
|
|
CurrentControl.Tag = New ClassControlCreator.ControlMetadata() With {
|
|
.Guid = GetLastID(),
|
|
.ReadOnly = False
|
|
}
|
|
|
|
|
|
pnldesigner.Controls.Add(line)
|
|
Case ClassControlCreator.PREFIX_BUTTON
|
|
Dim oButton = ClassControlCreator.CreateNewButton(cursorPosition)
|
|
|
|
SetMovementHandlers(oButton)
|
|
|
|
TBPM_PROFILE_CONTROLSTableAdapter.cmdInsertAnlage(ProfileId, oButton.Name, "BUTTON", oButton.Name, oButton.Location.X, oButton.Location.Y, USER_USERNAME, oButton.Size.Height, oButton.Size.Width)
|
|
CHANGES_FORM_DESIGN = True
|
|
CurrentControl = oButton
|
|
CurrentControl.Tag = New ClassControlCreator.ControlMetadata() With {
|
|
.Guid = GetLastID(),
|
|
.ReadOnly = False
|
|
}
|
|
|
|
|
|
pnldesigner.Controls.Add(oButton)
|
|
End Select
|
|
If Not IsNothing(CurrentControl) Then
|
|
RibPGCtrlheight.Enabled = True
|
|
RibPGCtrlWidth.Enabled = True
|
|
End If
|
|
Catch ex As Exception
|
|
LOGGER.Error(ex)
|
|
LOGGER.Info($"Error while Adding new control {ControlSelected}:")
|
|
LOGGER.Info(ex)
|
|
End Try
|
|
Me.Cursor = Cursors.Default
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub bbtniwidth_plus_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles bbtniwidth_plus.ItemClick
|
|
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 bbtniwidth_min_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles bbtniwidth_min.ItemClick
|
|
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 bbtniheight_min_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles bbtniheight_min.ItemClick
|
|
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("HEIGHT", newHeight)
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub bbtniheight_plus_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles bbtniheight_plus.ItemClick
|
|
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("HEIGHT", newHeight)
|
|
End If
|
|
End Sub
|
|
End Class |