1508 lines
62 KiB
VB.net
1508 lines
62 KiB
VB.net
Public Class frmFormDesigner
|
|
Public _windreamPM As ClassPMWindream
|
|
Private COLUMN_GUID
|
|
Private MouseIsDown As Boolean = False
|
|
Private idxlbl As Integer = 0
|
|
Private idxtxt As Integer = 0
|
|
Private idxcmb As Integer = 0
|
|
Private idxdtp As Integer = 0
|
|
Private idxdgv As Integer = 0
|
|
Private idxchk As Integer = 0
|
|
Private _loading As Boolean = False
|
|
Dim frmTableColumn As New frmControl_Detail
|
|
Private CURRENT_CONTROL As Control
|
|
|
|
' Movement Variables
|
|
Private MouseMoving As Boolean
|
|
Private BeginLocation As Point
|
|
Private EndLocation As Point
|
|
|
|
Private Sub frmFormDesigner_FormClosing(sender As Object, e As FormClosingEventArgs) Handles Me.FormClosing
|
|
If CURRENT_ProfilGUID > 0 Then
|
|
Dim sql As String = $"SELECT NAME, INDEX_NAME FROM TBPM_PROFILE_CONTROLS WHERE PROFIL_ID = {CURRENT_ProfilGUID} AND CTRL_TYPE <> 'LBL'"
|
|
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
|
|
|
|
|
|
|
|
Private Sub frmFormDesigner_Load(sender As Object, e As System.EventArgs) Handles Me.Load
|
|
Try
|
|
lblDesign.Text = "FormDesigner für Profil: " & CURRENT_ProfilName
|
|
'löscht alle Controls
|
|
pnldesigner.Controls.Clear()
|
|
CURRENT_CONTROL = Nothing
|
|
Try
|
|
DD_LIB_Standards.clsWindream.Create_Session()
|
|
' Windream instanziieren
|
|
_windreamPM = New ClassPMWindream()
|
|
'Windream initialisieren (Connection, Session, ... aufbauen)
|
|
_windreamPM.Init()
|
|
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
|
|
TBPM_CONNECTIONTableAdapter.Connection.ConnectionString = MyConnectionString
|
|
TBWH_CHECK_PROFILE_CONTROLSTableAdapter.Connection.ConnectionString = MyConnectionString
|
|
TBPM_CONTROL_TABLETableAdapter.Connection.ConnectionString = MyConnectionString
|
|
TBPM_CONNECTIONTableAdapter.Fill(DD_DMSLiteDataSet.TBPM_CONNECTION)
|
|
Catch ex As Exception
|
|
MsgBox("Fehler bei Laden der Connection-Strings und Grunddaten: " & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Achtung:")
|
|
End Try
|
|
|
|
Load_indexe()
|
|
Controls_laden()
|
|
Catch ex As System.Exception
|
|
MsgBox(ex.Message, MsgBoxStyle.Critical, "error loading form:")
|
|
End Try
|
|
End Sub
|
|
Sub Load_indexe()
|
|
cmbIndex.Items.Clear()
|
|
Dim indexe = _windreamPM.GetIndicesByObjecttype(CURRENT_OBJECTTYPE)
|
|
If indexe IsNot Nothing Then
|
|
cmbIndex.Items.Add("")
|
|
For Each index As String In indexe
|
|
cmbIndex.Items.Add(index)
|
|
Next
|
|
cmbIndex.Items.Add("DD PM-ONLY FOR DISPLAY")
|
|
cmbIndex.SelectedIndex = -1
|
|
End If
|
|
End Sub
|
|
Sub Load_Indexe_Vektor()
|
|
Try
|
|
Me.cmbIndex.Items.Clear()
|
|
Dim indexe = _windreamPM.GetIndicesByObjecttype(CURRENT_OBJECTTYPE)
|
|
If indexe IsNot Nothing Then
|
|
Me.cmbIndex.Items.Add("")
|
|
For Each index As String In indexe
|
|
Dim _vektorString As Boolean = False
|
|
'If index.StartsWith("Vektor") Or index.StartsWith("vkt") Then
|
|
' MsgBox(_windreamPM.GetTypeOfIndex(index).ToString)
|
|
'End If
|
|
Select Case _windreamPM.GetTypeOfIndex(index)
|
|
Case 4107 'Vektor Zahl
|
|
_vektorString = True
|
|
Case 4097
|
|
_vektorString = True
|
|
Case Else
|
|
_vektorString = False
|
|
End Select
|
|
If _vektorString = True Then
|
|
Me.cmbIndex.Items.Add(index)
|
|
End If
|
|
|
|
Next
|
|
End If
|
|
Catch ex As Exception
|
|
MsgBox("Fehler bei Indexe Volltext eintragen: " & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Achtung:")
|
|
End Try
|
|
End Sub
|
|
Sub Load_Control(Optional ID As Integer = 0)
|
|
_loading = True
|
|
Try
|
|
TabControlEigenschaften.SelectedIndex = 0
|
|
Me.cmbIndex.Visible = False
|
|
Me.INDEX_NAMETextBox.Visible = False
|
|
If ID = 0 Then
|
|
If IsNothing(CURRENT_CONTROL.Tag) Then
|
|
Dim ID_CTRL = GetControlGUID(CURRENT_CONTROL.Name)
|
|
If ID_CTRL > 0 Then
|
|
CURRENT_CONTROL.Tag = ID_CTRL
|
|
End If
|
|
End If
|
|
CURRENT_CONTROL_ID = CURRENT_CONTROL.Tag
|
|
Else
|
|
CURRENT_CONTROL_ID = ID
|
|
End If
|
|
|
|
If CURRENT_CONTROL_ID <> 0 Then
|
|
gbxControl.Enabled = True
|
|
TBPM_PROFILE_CONTROLSTableAdapter.Fill(DD_DMSLiteDataSet.TBPM_PROFILE_CONTROLS, CURRENT_CONTROL_ID)
|
|
Dim dt As DataTable = DD_DMSLiteDataSet.TBPM_PROFILE_CONTROLS
|
|
Dim dr As DataRow = dt.Rows(0)
|
|
If dr Is Nothing = False Then
|
|
' MsgBox(dr.Item("INDEX_NAME").ToString)
|
|
If dr.Item("INDEX_NAME").ToString.StartsWith("[%VKT") Then
|
|
Me.rbVektor.Checked = True
|
|
Me.rbIndex.Checked = False
|
|
Me.INDEX_NAMETextBox.Visible = True
|
|
Me.cmbIndex.Visible = False
|
|
Me.INDEX_NAMETextBox.Text = dr.Item("INDEX_NAME").ToString.Replace("[%VKT", "")
|
|
Else
|
|
Me.rbIndex.Checked = True
|
|
Me.rbVektor.Checked = False
|
|
Me.INDEX_NAMETextBox.Visible = False
|
|
Me.cmbIndex.Visible = True
|
|
IDX_CMB(CURRENT_CONTROL.Name)
|
|
End If
|
|
Try
|
|
If CheckBoxAuswahlliste.Visible = False Then
|
|
_loading = False
|
|
Exit Sub
|
|
End If
|
|
If dr.Item("CHOICE_LIST") <> "" Then
|
|
CheckBoxAuswahlliste.Checked = True
|
|
CHOICE_LISTTextBox.Text = dr.Item("CHOICE_LIST")
|
|
End If
|
|
Catch ex As Exception
|
|
CheckBoxAuswahlliste.Checked = False
|
|
End Try
|
|
|
|
End If
|
|
Else
|
|
gbxControl.Enabled = False
|
|
tslblAenderungen.Visible = True
|
|
tslblAenderungen.Text = "Konte das aktuelle Control nicht wählen!!"
|
|
End If
|
|
btnsave.Visible = True
|
|
Catch ex As Exception
|
|
If Not ex.Message.Contains("Data Reader") Then
|
|
MsgBox("Fehler bei Laden des Controls: " & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Achtung:")
|
|
End If
|
|
|
|
End Try
|
|
_loading = False
|
|
End Sub
|
|
|
|
Function CreateBaseControl(ctrl As Control, guid As Integer, name As String, x As Integer, y As Integer, font As Font, color As Color)
|
|
ctrl.Tag = guid
|
|
ctrl.Name = name
|
|
ctrl.Location = New Point(x, y)
|
|
ctrl.Font = font
|
|
ctrl.ForeColor = color
|
|
|
|
Return ctrl
|
|
End Function
|
|
|
|
Sub Controls_laden()
|
|
Try
|
|
TBPM_PROFILE_CONTROLSTableAdapter.FillByProfil(DD_DMSLiteDataSet.TBPM_PROFILE_CONTROLS, CURRENT_ProfilGUID)
|
|
' 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 ctrl = CreateBaseControl(New TextBox, guid, name, x, y, font, color)
|
|
AddExistingTextbox(ctrl, row.Item("WIDTH"), row.Item("HEIGHT"))
|
|
Case "LBL"
|
|
Dim ctrl = CreateBaseControl(New Label, guid, name, x, y, font, color)
|
|
AddExistingLabel(ctrl, row.Item("CTRL_TEXT"))
|
|
Case "CMB"
|
|
Dim ctrl = CreateBaseControl(New ComboBox, guid, name, x, y, font, color)
|
|
AddExistingCombobox(ctrl, row.Item("WIDTH"), row.Item("HEIGHT"))
|
|
Case "DTP"
|
|
Dim ctrl = CreateBaseControl(New ComboBox, guid, name, x, y, font, color)
|
|
AddExistingDatetimepicker(ctrl, row.Item("WIDTH"), row.Item("HEIGHT"))
|
|
Case "DGV"
|
|
Dim ctrl = CreateBaseControl(New DataGridView, guid, name, x, y, font, color)
|
|
AddExistingDatagridview(ctrl, row.Item("WIDTH"), row.Item("HEIGHT"))
|
|
Case "CHK"
|
|
Dim ctrl = CreateBaseControl(New CheckBox, guid, name, x, y, font, color)
|
|
AddExistingCheckbox(ctrl, row.Item("CTRL_TEXT"), row.Item("WIDTH"), row.Item("HEIGHT"))
|
|
Case "TABLE"
|
|
Dim ctrl = CreateBaseControl(New DataGridView, guid, name, x, y, font, color)
|
|
AddExistingTable(ctrl, row.Item("WIDTH"), row.Item("HEIGHT"))
|
|
End Select
|
|
Next
|
|
Catch ex As Exception
|
|
MsgBox("Fehler bei Controls_laden: " & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Achtung:")
|
|
End Try
|
|
|
|
End Sub
|
|
Private Sub DragDropButtons_MouseDown(sender As System.Object, e As System.Windows.Forms.MouseEventArgs) Handles btnlabel.MouseDown, btntextbox.MouseDown, btncmb.MouseDown, btndtp.MouseDown, btnVektor.MouseDown,
|
|
btnTabelle.MouseDown, btnCheckbox.MouseDown
|
|
MouseIsDown = True
|
|
CURRENT_CONTROL = Nothing
|
|
Try
|
|
TBPM_PROFILE_CONTROLSBindingSource.Clear()
|
|
Catch ex As Exception
|
|
|
|
End Try
|
|
|
|
End Sub
|
|
|
|
|
|
Private Sub btnlabel_MouseMove(sender As Object, e As System.Windows.Forms.MouseEventArgs) Handles btnlabel.MouseMove
|
|
If MouseIsDown Then
|
|
' Initiate dragging.
|
|
btnlabel.DoDragDrop("lbl", DragDropEffects.Copy)
|
|
End If
|
|
MouseIsDown = False
|
|
End Sub
|
|
|
|
Private Sub btntextbox_MouseMove(sender As Object, e As System.Windows.Forms.MouseEventArgs) Handles btntextbox.MouseMove
|
|
If MouseIsDown Then
|
|
' Initiate dragging.
|
|
btntextbox.DoDragDrop("txt", DragDropEffects.Copy)
|
|
End If
|
|
MouseIsDown = False
|
|
End Sub
|
|
|
|
Private Sub Panel2_DragDrop(sender As Object, e As System.Windows.Forms.DragEventArgs) Handles pnldesigner.DragDrop
|
|
Dim r As New Random()
|
|
Dim random As Integer = r.Next(8, 100)
|
|
Select Case e.Data.GetData(DataFormats.Text)
|
|
Case "lbl"
|
|
'idxlbl += 1
|
|
AddNewLabel("lbl" & random.ToString)
|
|
Case "txt"
|
|
'idxtxt += 1
|
|
add_newtextbox("txt" & random)
|
|
Case "cmb"
|
|
'idxcmb += 1
|
|
add_newCombobox("cmb" & random)
|
|
Case "dtp"
|
|
'idxdtp += 1
|
|
add_newDTP("dtp" & random)
|
|
Case "dgv"
|
|
'idxdgv += 1
|
|
add_newDGV("dgv" & random)
|
|
Case "chk"
|
|
' idxchk += 1
|
|
add_newCheckbox("chk" & random)
|
|
Case "tb"
|
|
add_newTABLE("tb" & random)
|
|
End Select
|
|
End Sub
|
|
|
|
Private Sub Panel2_DragEnter(sender As System.Object, e As System.Windows.Forms.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 GetControlGUID(control_name As String)
|
|
Try
|
|
CURRENT_CONTROL_ID = TBPM_PROFILE_CONTROLSTableAdapter.cmdGetGUID(CURRENT_ProfilGUID, control_name)
|
|
Return CURRENT_CONTROL_ID
|
|
Catch ex As Exception
|
|
MsgBox("Fehler bei GetControlGUID: " & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Achtung:")
|
|
Return 0
|
|
End Try
|
|
End Function
|
|
Function AddNewLabel(lblname As String)
|
|
Try
|
|
Dim lbl As New Label
|
|
lbl.Name = lblname
|
|
lbl.Text = "Bez. definieren"
|
|
lbl.AutoSize = True
|
|
'lbl.Size = New Size(CInt(lbl.Text.Length * 10), 16)
|
|
'lbl.Size = New Size(300, 27)
|
|
Dim clientPosition As Point = Me.pnldesigner.PointToClient(System.Windows.Forms.Cursor.Position)
|
|
lbl.Location = New Point(clientPosition)
|
|
pnldesigner.Controls.Add(lbl)
|
|
CURRENT_CONTROL = lbl
|
|
|
|
'AddHandler lbl.Click, AddressOf OnlblClick
|
|
'AddHandler lbl.MouseDown, AddressOf MovableLabel_MouseDown
|
|
'AddHandler lbl.MouseUp, AddressOf MovableCtrl_MouseUp
|
|
'AddHandler lbl.MouseMove, AddressOf Control_MouseMove 'MovableLabel_MouseMove
|
|
SetMovementHandlers(lbl)
|
|
|
|
TBPM_PROFILE_CONTROLSTableAdapter.cmdInsertAnlage(CURRENT_ProfilGUID, lbl.Name, "LBL", lblname, lbl.Location.X, lbl.Location.Y, Environment.UserName, 16, 200)
|
|
CURRENT_CONTROL.Tag = GetLastID()
|
|
'Load_Control()
|
|
btnsave.Visible = True
|
|
Catch ex As Exception
|
|
MsgBox("Fehler bei Anlegen Label: " & vbNewLine & ex.Message, MsgBoxStyle.Critical)
|
|
End Try
|
|
End Function
|
|
Function AddExistingLabel(lbl As Label, text As String)
|
|
lbl.Text = text
|
|
lbl.AutoSize = True
|
|
|
|
pnldesigner.Controls.Add(lbl)
|
|
SetMovementHandlers(lbl)
|
|
End Function
|
|
|
|
Private Function GetLastID()
|
|
Dim sql = String.Format("SELECT MAX(GUID) FROM TBPM_PROFILE_CONTROLS WHERE PROFIL_ID = {0}", CURRENT_ProfilGUID)
|
|
Return ClassDatabase.Execute_Scalar(sql, MyConnectionString, True)
|
|
End Function
|
|
Function add_newtextbox(txtname As String)
|
|
Try
|
|
Dim txt As New TextBox
|
|
txt.Name = txtname
|
|
txt.Size = New Size(200, 27)
|
|
txt.Cursor = Cursors.Hand
|
|
txt.ReadOnly = True
|
|
Dim clientPosition As Point = Me.pnldesigner.PointToClient(System.Windows.Forms.Cursor.Position)
|
|
txt.Location = New Point(clientPosition)
|
|
txt.BackColor = Color.White
|
|
pnldesigner.Controls.Add(txt)
|
|
CURRENT_CONTROL = txt
|
|
|
|
SetMovementHandlers(txt)
|
|
|
|
TBPM_PROFILE_CONTROLSTableAdapter.cmdInsertAnlage(CURRENT_ProfilGUID, txt.Name, "TXT", txtname, txt.Location.X, txt.Location.Y, Environment.UserName, 27, 200)
|
|
CURRENT_CONTROL.Tag = GetLastID()
|
|
'GetControlGUID(txt.Name)
|
|
'Load_Control()
|
|
btnsave.Visible = True
|
|
Catch ex As Exception
|
|
MsgBox("Fehler bei Anlegen TextBox: " & vbNewLine & ex.Message, MsgBoxStyle.Critical)
|
|
End Try
|
|
End Function
|
|
Function AddExistingTextbox(txt As TextBox, vwidth As Integer, vheight As Integer)
|
|
If vheight > 27 Then
|
|
txt.Multiline = True
|
|
Else
|
|
txt.Multiline = False
|
|
End If
|
|
txt.Size = New Size(vwidth, vheight)
|
|
|
|
txt.Cursor = Cursors.Hand
|
|
txt.ReadOnly = True
|
|
txt.BackColor = Color.White
|
|
|
|
pnldesigner.Controls.Add(txt)
|
|
SetMovementHandlers(txt)
|
|
|
|
btnsave.Visible = True
|
|
End Function
|
|
Function add_newCheckbox(chkname As String)
|
|
Try
|
|
|
|
Dim chk As New CheckBox
|
|
chk.Name = chkname
|
|
'chk.Size = New Size(200, 27)
|
|
chk.AutoSize = True
|
|
chk.Text = "Beschriftung def."
|
|
chk.Cursor = Cursors.Hand
|
|
Dim clientPosition As Point = Me.pnldesigner.PointToClient(System.Windows.Forms.Cursor.Position)
|
|
chk.Location = New Point(clientPosition)
|
|
pnldesigner.Controls.Add(chk)
|
|
CURRENT_CONTROL = chk
|
|
|
|
SetMovementHandlers(chk)
|
|
|
|
TBPM_PROFILE_CONTROLSTableAdapter.cmdInsertAnlage(CURRENT_ProfilGUID, chk.Name, "CHK", chkname, chk.Location.X, chk.Location.Y, Environment.UserName, 27, 200)
|
|
CURRENT_CONTROL.Tag = GetLastID()
|
|
Load_Control()
|
|
btnsave.Visible = True
|
|
Catch ex As Exception
|
|
MsgBox("Fehler bei Anlegen Checkbox: " & vbNewLine & ex.Message, MsgBoxStyle.Critical)
|
|
End Try
|
|
End Function
|
|
Function AddExistingCheckbox(chk As CheckBox, text As String, vwidth As Integer, vheight As Integer)
|
|
chk.AutoSize = True
|
|
chk.Text = text
|
|
chk.Cursor = Cursors.Hand
|
|
|
|
pnldesigner.Controls.Add(chk)
|
|
SetMovementHandlers(chk)
|
|
|
|
btnsave.Visible = True
|
|
End Function
|
|
Function add_newCombobox(cmbname As String)
|
|
Try
|
|
Dim cmb As New ComboBox
|
|
cmb.Name = cmbname
|
|
cmb.Size = New Size(180, 24)
|
|
cmb.Cursor = Cursors.Hand
|
|
Dim clientPosition As Point = Me.pnldesigner.PointToClient(System.Windows.Forms.Cursor.Position)
|
|
cmb.Location = New Point(clientPosition)
|
|
pnldesigner.Controls.Add(cmb)
|
|
CURRENT_CONTROL = cmb
|
|
|
|
SetMovementHandlers(cmb)
|
|
|
|
TBPM_PROFILE_CONTROLSTableAdapter.cmdInsertAnlage(CURRENT_ProfilGUID, cmb.Name, "CMB", cmbname, cmb.Location.X, cmb.Location.Y, Environment.UserName, 24, 180)
|
|
CURRENT_CONTROL.Tag = GetLastID()
|
|
Load_Control()
|
|
btnsave.Visible = True
|
|
Catch ex As Exception
|
|
MsgBox("Fehler bei Anlegen Combobox: " & vbNewLine & ex.Message, MsgBoxStyle.Critical)
|
|
End Try
|
|
End Function
|
|
Function AddExistingCombobox(cmb As ComboBox, vwidth As Integer, vheight As Integer)
|
|
cmb.Size = New Size(vwidth, vheight)
|
|
cmb.Cursor = Cursors.Hand
|
|
|
|
pnldesigner.Controls.Add(cmb)
|
|
SetMovementHandlers(cmb)
|
|
|
|
btnsave.Visible = True
|
|
End Function
|
|
Function AddExistingDatetimepicker(dtp As DateTimePicker, vwidth As Integer, vheight As Integer)
|
|
dtp.Size = New Size(vwidth, vheight)
|
|
dtp.Cursor = Cursors.Hand
|
|
dtp.Format = DateTimePickerFormat.Short
|
|
pnldesigner.Controls.Add(dtp)
|
|
|
|
SetMovementHandlers(dtp)
|
|
btnsave.Visible = True
|
|
End Function
|
|
Function add_newDTP(dtpname As String)
|
|
Try
|
|
Dim dtp As New DateTimePicker
|
|
dtp.Name = dtpname
|
|
dtp.Size = New Size(180, 24)
|
|
dtp.Cursor = Cursors.Hand
|
|
dtp.Format = DateTimePickerFormat.Short
|
|
Dim clientPosition As Point = Me.pnldesigner.PointToClient(System.Windows.Forms.Cursor.Position)
|
|
dtp.Location = New Point(clientPosition)
|
|
pnldesigner.Controls.Add(dtp)
|
|
CURRENT_CONTROL = dtp
|
|
'AddHandler dtp.Click, AddressOf OndtpClick
|
|
'AddHandler dtp.MouseDown, AddressOf Movabledtp_MouseDown
|
|
'AddHandler dtp.MouseUp, AddressOf MovableCtrl_MouseUp
|
|
'AddHandler dtp.MouseMove, AddressOf Control_MouseMove 'Movabledtp_MouseMove
|
|
SetMovementHandlers(dtp)
|
|
|
|
TBPM_PROFILE_CONTROLSTableAdapter.cmdInsertAnlage(CURRENT_ProfilGUID, dtp.Name, "DTP", dtpname, dtp.Location.X, dtp.Location.Y, Environment.UserName, 24, 180)
|
|
CURRENT_CONTROL.Tag = GetLastID()
|
|
Load_Control()
|
|
|
|
Catch ex As Exception
|
|
MsgBox("Fehler bei Anlegen DatetimePicker: " & vbNewLine & ex.Message, MsgBoxStyle.Critical)
|
|
End Try
|
|
End Function
|
|
Function AddExistingDatagridview(dgv As DataGridView, vwidth As Integer, vheight As Integer)
|
|
dgv.Size = New Size(vwidth, vheight)
|
|
dgv.Cursor = Cursors.Hand
|
|
dgv.AllowUserToAddRows = False
|
|
dgv.AllowUserToDeleteRows = False
|
|
dgv.AllowUserToResizeColumns = False
|
|
dgv.AllowUserToResizeRows = False
|
|
|
|
|
|
Dim col As New DataGridViewTextBoxColumn
|
|
col.HeaderText = ""
|
|
col.Name = "column1"
|
|
dgv.Columns.Add(col)
|
|
|
|
pnldesigner.Controls.Add(dgv)
|
|
|
|
'AddHandler dgv.Click, AddressOf OndgvClick
|
|
'AddHandler dgv.MouseDown, AddressOf MovableDGV_MouseDown
|
|
'AddHandler dgv.MouseUp, AddressOf MovableCtrl_MouseUp
|
|
'AddHandler dgv.MouseMove, AddressOf dgv_MouseMove
|
|
SetMovementHandlers(dgv)
|
|
|
|
btnsave.Visible = True
|
|
End Function
|
|
Function add_newDGV(dgvName As String)
|
|
Try
|
|
Dim dgv As New DataGridView
|
|
dgv.Name = dgvName
|
|
dgv.Size = New Size(130, 150)
|
|
dgv.Cursor = Cursors.Hand
|
|
Dim clientPosition As Point = Me.pnldesigner.PointToClient(System.Windows.Forms.Cursor.Position)
|
|
dgv.Location = New Point(clientPosition)
|
|
dgv.AllowUserToAddRows = False
|
|
dgv.AllowUserToDeleteRows = False
|
|
dgv.AllowUserToResizeColumns = False
|
|
dgv.AllowUserToResizeRows = False
|
|
|
|
Dim col As New DataGridViewTextBoxColumn
|
|
col.HeaderText = ""
|
|
col.Name = "column1"
|
|
dgv.Columns.Add(col)
|
|
pnldesigner.Controls.Add(dgv)
|
|
CURRENT_CONTROL = dgv
|
|
|
|
'AddHandler dgv.Click, AddressOf OndgvClick
|
|
'AddHandler dgv.MouseDown, AddressOf MovableDGV_MouseDown
|
|
'AddHandler dgv.MouseUp, AddressOf MovableCtrl_MouseUp
|
|
'AddHandler dgv.MouseMove, AddressOf dgv_MouseMove
|
|
SetMovementHandlers(dgv)
|
|
|
|
TBPM_PROFILE_CONTROLSTableAdapter.cmdInsertAnlage(CURRENT_ProfilGUID, dgv.Name, "DGV", dgvName, dgv.Location.X, dgv.Location.Y, Environment.UserName, 130, 150)
|
|
CURRENT_CONTROL.Tag = GetLastID()
|
|
Load_Control()
|
|
Catch ex As Exception
|
|
MsgBox("Fehler bei Anlegen DGV: " & vbNewLine & ex.Message, MsgBoxStyle.Critical)
|
|
End Try
|
|
End Function
|
|
Function add_newTABLE(tableName As String)
|
|
Try
|
|
Dim table As New DataGridView
|
|
table.Name = tableName
|
|
table.Size = New Size(200, 150)
|
|
table.Cursor = Cursors.Hand
|
|
Dim clientPosition As Point = Me.pnldesigner.PointToClient(System.Windows.Forms.Cursor.Position)
|
|
table.Location = New Point(clientPosition)
|
|
table.AllowUserToAddRows = False
|
|
table.AllowUserToDeleteRows = False
|
|
table.AllowUserToResizeColumns = True
|
|
table.AllowUserToResizeRows = False
|
|
|
|
Dim col1 As New DataGridViewTextBoxColumn With {
|
|
.HeaderText = "Column1",
|
|
.Name = "column1"
|
|
}
|
|
|
|
Dim col2 As New DataGridViewTextBoxColumn With {
|
|
.HeaderText = "Column2",
|
|
.Name = "column2"
|
|
}
|
|
|
|
table.Columns.Add(col1)
|
|
table.Columns.Add(col2)
|
|
pnldesigner.Controls.Add(table)
|
|
CURRENT_CONTROL = table
|
|
|
|
'AddHandler table.Click, AddressOf OndgvClick
|
|
'AddHandler table.MouseDown, AddressOf MovableDGV_MouseDown
|
|
'AddHandler table.MouseUp, AddressOf MovableCtrl_MouseUp
|
|
'AddHandler table.MouseMove, AddressOf dgv_MouseMove
|
|
SetMovementHandlers(table)
|
|
|
|
AddHandler table.ColumnHeaderMouseClick, AddressOf table_ColumnHeaderMouseClick
|
|
TBPM_PROFILE_CONTROLSTableAdapter.cmdInsertAnlage(CURRENT_ProfilGUID, table.Name, "TABLE", tableName, table.Location.X, table.Location.Y, Environment.UserName, 130, 150)
|
|
CURRENT_CONTROL.Tag = GetLastID()
|
|
TBPM_CONTROL_TABLETableAdapter.Insert(CURRENT_CONTROL.Tag, "column1", "Column1", 95, Environment.UserName)
|
|
TBPM_CONTROL_TABLETableAdapter.Insert(CURRENT_CONTROL.Tag, "column2", "Column2", 95, Environment.UserName)
|
|
Load_Control()
|
|
Catch ex As Exception
|
|
MsgBox("Fehler bei Anlegen Tabelle: " & vbNewLine & ex.Message, MsgBoxStyle.Critical)
|
|
End Try
|
|
End Function
|
|
Function AddExistingTable(table As DataGridView, vwidth As Integer, vheight As Integer)
|
|
table.Size = New Size(vwidth, vheight)
|
|
table.Cursor = Cursors.Hand
|
|
table.AllowUserToAddRows = False
|
|
table.AllowUserToDeleteRows = False
|
|
table.AllowUserToResizeColumns = True
|
|
table.AllowUserToResizeRows = False
|
|
CURRENT_CONTROL = table
|
|
'Columns laden
|
|
TBPM_CONTROL_TABLETableAdapter.Fill(Me.DD_DMSLiteDataSet.TBPM_CONTROL_TABLE, table.Tag)
|
|
Dim DT As DataTable = Me.DD_DMSLiteDataSet.TBPM_CONTROL_TABLE
|
|
If DT.Rows.Count > 0 Then
|
|
For Each Row As DataRow In DT.Rows
|
|
Dim col As New DataGridViewTextBoxColumn
|
|
col.HeaderText = Row.Item("SPALTEN_HEADER")
|
|
col.Name = Row.Item("SPALTENNAME")
|
|
col.Width = Row.Item("SPALTENBREITE")
|
|
table.Columns.Add(col)
|
|
Next
|
|
End If
|
|
|
|
' table.AutoResizeColumns()
|
|
|
|
pnldesigner.Controls.Add(table)
|
|
|
|
'AddHandler table.Click, AddressOf OndgvClick
|
|
'AddHandler table.MouseDown, AddressOf MovableDGV_MouseDown
|
|
'AddHandler table.MouseUp, AddressOf MovableCtrl_MouseUp
|
|
'AddHandler table.MouseMove, AddressOf dgv_MouseMove
|
|
SetMovementHandlers(table)
|
|
|
|
AddHandler table.ColumnHeaderMouseClick, AddressOf table_ColumnHeaderMouseClick
|
|
|
|
btnsave.Visible = True
|
|
End Function
|
|
Sub Set_Active_Color()
|
|
CURRENT_CONTROL.BackColor = Color.DarkOrange
|
|
For Each inctrl As Control In Me.pnldesigner.Controls
|
|
If inctrl.Name <> CURRENT_CONTROL.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
|
|
End Select
|
|
End If
|
|
Next
|
|
End Sub
|
|
Public Sub OnlblClick(sender As System.Object, e As System.EventArgs)
|
|
CURRENT_CONTROL = sender
|
|
Set_Active_Color()
|
|
Dim lbl As Label = sender
|
|
CURRENT_CONTROL = lbl
|
|
Load_Control()
|
|
lblBeschriftung.Visible = True
|
|
CTRL_TEXTTextBox.Visible = True
|
|
lblIndex.Visible = False
|
|
|
|
cmbIndex.Visible = False
|
|
rbIndex.Visible = False
|
|
rbVektor.Visible = False
|
|
|
|
VALIDATIONCheckBox.Visible = False
|
|
CheckBoxAuswahlliste.Visible = False
|
|
CHOICE_LISTTextBox.Visible = False
|
|
lblAuswahlliste.Visible = False
|
|
gbxControl.Visible = True
|
|
|
|
READ_ONLYCheckBox.Visible = False
|
|
LOAD_IDX_VALUECheckBox.Visible = False
|
|
|
|
INDEX_NAMETextBox.Visible = False
|
|
End Sub
|
|
Public Sub OntxtClick(sender As System.Object, e As System.EventArgs)
|
|
CURRENT_CONTROL = sender
|
|
Dim txt As TextBox = sender
|
|
Set_Active_Color()
|
|
|
|
|
|
Load_indexe()
|
|
Load_Control()
|
|
Me.lblBeschriftung.Visible = False
|
|
Me.CTRL_TEXTTextBox.Visible = False
|
|
Me.lblIndex.Visible = True
|
|
Me.cmbIndex.Visible = True
|
|
Me.rbIndex.Visible = True
|
|
Me.rbVektor.Visible = True
|
|
Me.CheckBoxAuswahlliste.Visible = False
|
|
Me.VALIDATIONCheckBox.Visible = True
|
|
Me.CheckBoxAuswahlliste.Visible = False
|
|
Me.CHOICE_LISTTextBox.Visible = False
|
|
Me.lblAuswahlliste.Visible = False
|
|
|
|
gbxControl.Visible = True
|
|
' Me.pnlAuswahlliste.Enabled = False
|
|
|
|
Me.READ_ONLYCheckBox.Visible = True
|
|
Me.LOAD_IDX_VALUECheckBox.Visible = True
|
|
End Sub
|
|
Public Sub OnchkboxClick(sender As System.Object, e As System.EventArgs)
|
|
CURRENT_CONTROL = sender
|
|
Dim chk As CheckBox = sender
|
|
Set_Active_Color()
|
|
CURRENT_CONTROL = chk
|
|
Load_indexe()
|
|
Load_Control()
|
|
Me.lblBeschriftung.Visible = True
|
|
Me.CTRL_TEXTTextBox.Visible = True
|
|
Me.lblIndex.Visible = True
|
|
Me.cmbIndex.Visible = True
|
|
Me.rbIndex.Visible = True
|
|
Me.rbVektor.Visible = True
|
|
Me.VALIDATIONCheckBox.Visible = True
|
|
Me.CheckBoxAuswahlliste.Visible = False
|
|
Me.CHOICE_LISTTextBox.Visible = False
|
|
Me.lblAuswahlliste.Visible = False
|
|
gbxControl.Visible = True
|
|
' Me.pnlAuswahlliste.Enabled = False
|
|
Me.READ_ONLYCheckBox.Visible = True
|
|
Me.LOAD_IDX_VALUECheckBox.Visible = True
|
|
End Sub
|
|
Public Sub OncmbClick(sender As System.Object, e As System.EventArgs)
|
|
CURRENT_CONTROL = sender
|
|
Dim cmb As ComboBox = sender
|
|
|
|
Set_Active_Color()
|
|
Load_indexe()
|
|
Me.lblBeschriftung.Visible = False
|
|
Me.CTRL_TEXTTextBox.Visible = False
|
|
Me.lblIndex.Visible = True
|
|
Me.cmbIndex.Visible = True
|
|
Me.rbIndex.Visible = True
|
|
Me.rbVektor.Visible = True
|
|
Me.CheckBoxAuswahlliste.Visible = True
|
|
Me.VALIDATIONCheckBox.Visible = True
|
|
gbxControl.Visible = True
|
|
If CHOICE_LISTTextBox.Text <> "" Then
|
|
CheckBoxAuswahlliste.Checked = True
|
|
Else
|
|
CheckBoxAuswahlliste.Checked = False
|
|
End If
|
|
|
|
' Me.pnlAuswahlliste.Enabled = True
|
|
Me.READ_ONLYCheckBox.Visible = True
|
|
Me.LOAD_IDX_VALUECheckBox.Visible = True
|
|
Load_Control()
|
|
|
|
End Sub
|
|
Public Sub OndtpClick(sender As System.Object, e As System.EventArgs)
|
|
|
|
CURRENT_CONTROL = sender
|
|
Dim dtp As DateTimePicker = sender
|
|
CURRENT_CONTROL = dtp
|
|
Load_indexe()
|
|
Load_Control()
|
|
Me.lblBeschriftung.Visible = False
|
|
Me.CTRL_TEXTTextBox.Visible = False
|
|
Me.lblIndex.Visible = True
|
|
Me.cmbIndex.Visible = True
|
|
Me.rbIndex.Visible = True
|
|
Me.rbVektor.Visible = True
|
|
|
|
Me.CheckBoxAuswahlliste.Visible = False
|
|
Me.VALIDATIONCheckBox.Visible = True
|
|
gbxControl.Visible = True
|
|
CHOICE_LISTTextBox.Visible = False
|
|
' Me.pnlAuswahlliste.Enabled = False
|
|
Me.READ_ONLYCheckBox.Visible = True
|
|
Me.LOAD_IDX_VALUECheckBox.Visible = True
|
|
End Sub
|
|
Public Sub OndgvClick(sender As System.Object, e As System.EventArgs)
|
|
CURRENT_CONTROL = sender
|
|
Dim dgv As DataGridView = sender
|
|
|
|
CURRENT_CONTROL = dgv
|
|
If dgv.ColumnCount > 1 Then
|
|
Me.rbVektor.Visible = False
|
|
Load_Indexe_Vektor()
|
|
Dim selectedColumnCount As Integer = dgv.Columns.GetColumnCount(DataGridViewElementStates.Selected)
|
|
If selectedColumnCount > 0 Then
|
|
COLUMN_GUID = TBPM_CONTROL_TABLETableAdapter.getColumnID(CURRENT_CONTROL_ID, dgv.SelectedColumns(selectedColumnCount).Name)
|
|
End If
|
|
Else
|
|
Load_indexe()
|
|
Me.rbVektor.Visible = True
|
|
COLUMN_GUID = Nothing
|
|
End If
|
|
|
|
|
|
Load_Control()
|
|
Me.lblBeschriftung.Visible = False
|
|
Me.CTRL_TEXTTextBox.Visible = False
|
|
Me.lblIndex.Visible = True
|
|
Me.cmbIndex.Visible = True
|
|
Me.rbIndex.Visible = True
|
|
|
|
Me.CheckBoxAuswahlliste.Visible = False
|
|
Me.CHOICE_LISTTextBox.Visible = False
|
|
Me.lblAuswahlliste.Visible = False
|
|
|
|
Me.VALIDATIONCheckBox.Visible = True
|
|
|
|
gbxControl.Visible = True
|
|
CHOICE_LISTTextBox.Visible = False
|
|
'Me.pnlAuswahlliste.Enabled = False
|
|
Me.READ_ONLYCheckBox.Visible = True
|
|
Me.LOAD_IDX_VALUECheckBox.Visible = True
|
|
End Sub
|
|
Public Sub table_ColumnHeaderMouseClick(sender As System.Object, e As DataGridViewCellMouseEventArgs)
|
|
CURRENT_CONTROL = sender
|
|
Dim dgv As DataGridView = sender
|
|
|
|
CURRENT_CONTROL = dgv
|
|
Me.rbVektor.Visible = False
|
|
|
|
Dim dgvColumn As DataGridViewColumn = dgv.Columns(e.ColumnIndex)
|
|
COLUMN_GUID = TBPM_CONTROL_TABLETableAdapter.getColumnID(CURRENT_CONTROL_ID, dgvColumn.Name)
|
|
If Application.OpenForms().OfType(Of frmControl_Detail).Any Then
|
|
' MessageBox.Show("Opened")
|
|
Else
|
|
frmTableColumn = New frmControl_Detail
|
|
frmTableColumn.Show()
|
|
End If
|
|
frmTableColumn.FillData(COLUMN_GUID)
|
|
frmTableColumn.Text = "Konfiguration von Spalte: " & dgvColumn.Name
|
|
|
|
|
|
|
|
Load_Control()
|
|
Me.lblBeschriftung.Visible = True
|
|
Me.CTRL_TEXTTextBox.Visible = True
|
|
Me.lblIndex.Visible = True
|
|
Me.cmbIndex.Visible = True
|
|
Me.rbIndex.Visible = True
|
|
|
|
Me.CheckBoxAuswahlliste.Visible = False
|
|
Me.CHOICE_LISTTextBox.Visible = False
|
|
Me.lblAuswahlliste.Visible = False
|
|
|
|
Me.VALIDATIONCheckBox.Visible = True
|
|
|
|
gbxControl.Visible = True
|
|
' Me.pnlAuswahlliste.Enabled = False
|
|
Me.READ_ONLYCheckBox.Visible = True
|
|
Me.LOAD_IDX_VALUECheckBox.Visible = True
|
|
End Sub
|
|
Sub IDX_CMB(controlname As String)
|
|
Try
|
|
Dim guid As Integer = TBPM_PROFILE_CONTROLSTableAdapter.cmdGetGUID(CURRENT_ProfilGUID, controlname)
|
|
Dim indexname As String = TBPM_PROFILE_CONTROLSTableAdapter.cmdGetIndexname(guid)
|
|
'If indexname.StartsWith("[%") Then
|
|
' indexname = indexname.Replace("[%", "")
|
|
'End If
|
|
cmbIndex.SelectedIndex = cmbIndex.FindStringExact(indexname)
|
|
Catch ex As Exception
|
|
MsgBox(ex.Message, MsgBoxStyle.Critical, "IDX_CMB:")
|
|
End Try
|
|
|
|
End Sub
|
|
Sub delete_Control(_ctrlname As String)
|
|
Try
|
|
Dim result As MsgBoxResult = MsgBox("Wollen Sie das Control: " & _ctrlname & " wirklich löschen?", MsgBoxStyle.YesNo, "Bestätigung:")
|
|
' wenn Speichern ja
|
|
If result = MsgBoxResult.Yes Then
|
|
Dim guid As Integer = TBPM_PROFILE_CONTROLSTableAdapter.cmdGetGUID(CURRENT_ProfilGUID, _ctrlname)
|
|
If guid > 0 Then
|
|
Me.TBPM_CONTROL_TABLETableAdapter.Delete(guid)
|
|
TBPM_PROFILE_CONTROLSTableAdapter.Delete(guid)
|
|
Controls_laden()
|
|
End If
|
|
End If
|
|
Catch ex As Exception
|
|
MsgBox(ex.Message, MsgBoxStyle.Critical, "delete_Control:")
|
|
End Try
|
|
End Sub
|
|
' +++ Public Helper Methods +++
|
|
Public Function GetCursorPosition() As Point
|
|
Return pnldesigner.PointToClient(Cursor.Position)
|
|
End Function
|
|
Sub Clear_control_Details()
|
|
Try
|
|
CURRENT_CONTROL = Nothing
|
|
TBPM_PROFILE_CONTROLSBindingSource.Clear()
|
|
|
|
Catch ex As Exception
|
|
|
|
End Try
|
|
End Sub
|
|
Private Sub MovableLabel_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles MyBase.MouseDown
|
|
' Check to see if the correct button has been pressed
|
|
If e.Button = Windows.Forms.MouseButtons.Left Then
|
|
Clear_control_Details()
|
|
' MsgBox(ex.Message)
|
|
|
|
Dim lbl As Label = DirectCast(sender, Label)
|
|
CURRENT_CONTROL = sender
|
|
BeginLocation = e.Location
|
|
lbl.BringToFront()
|
|
' Set the mode flag to signal the MouseMove event handler that it
|
|
' needs to now calculate new positions for our control
|
|
MouseMoving = True
|
|
End If
|
|
End Sub
|
|
Private Sub MovableText_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles MyBase.MouseDown
|
|
' Check to see if the correct button has been pressed
|
|
If e.Button = Windows.Forms.MouseButtons.Left Then
|
|
Clear_control_Details()
|
|
|
|
Dim txt As TextBox = DirectCast(sender, TextBox)
|
|
CURRENT_CONTROL = sender
|
|
BeginLocation = e.Location
|
|
txt.BringToFront()
|
|
' Set the mode flag to signal the MouseMove event handler that it
|
|
' needs to now calculate new positions for our control
|
|
MouseMoving = True
|
|
End If
|
|
End Sub
|
|
Private Sub MovableChk_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles MyBase.MouseDown
|
|
' Check to see if the correct button has been pressed
|
|
If e.Button = Windows.Forms.MouseButtons.Left Then
|
|
Clear_control_Details()
|
|
Dim txt As CheckBox = DirectCast(sender, CheckBox)
|
|
CURRENT_CONTROL = sender
|
|
BeginLocation = e.Location
|
|
txt.BringToFront()
|
|
' Set the mode flag to signal the MouseMove event handler that it
|
|
' needs to now calculate new positions for our control
|
|
MouseMoving = True
|
|
End If
|
|
End Sub
|
|
Private Sub Movablecmb_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles MyBase.MouseDown
|
|
' Check to see if the correct button has been pressed
|
|
If e.Button = Windows.Forms.MouseButtons.Left Then
|
|
Clear_control_Details()
|
|
Dim cmb As ComboBox = DirectCast(sender, ComboBox)
|
|
CURRENT_CONTROL = sender
|
|
BeginLocation = e.Location
|
|
|
|
cmb.BringToFront()
|
|
' Set the mode flag to signal the MouseMove event handler that it
|
|
' needs to now calculate new positions for our control
|
|
MouseMoving = True
|
|
End If
|
|
End Sub
|
|
Private Sub Movabledtp_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles MyBase.MouseDown
|
|
' Check to see if the correct button has been pressed
|
|
If e.Button = Windows.Forms.MouseButtons.Left Then
|
|
Clear_control_Details()
|
|
Dim dtp As DateTimePicker = DirectCast(sender, DateTimePicker)
|
|
CURRENT_CONTROL = sender
|
|
|
|
'Console.WriteLine("X: " & cursor.X & ";Y=" & cursor.Y)
|
|
BeginLocation = e.Location
|
|
'begin_location = New Point(cursor.X - Parent.Location.X,
|
|
' cursor.Y - Parent.Location.Y)
|
|
dtp.BringToFront()
|
|
' Set the mode flag to signal the MouseMove event handler that it
|
|
' needs to now calculate new positions for our control
|
|
MouseMoving = True
|
|
|
|
'Jetzt Controleigenschaften laden
|
|
Load_Control()
|
|
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub MovableDGV_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles MyBase.MouseDown
|
|
' Check to see if the correct button has been pressed
|
|
If e.Button = Windows.Forms.MouseButtons.Left And Cursor = Cursors.Default Then
|
|
Clear_control_Details()
|
|
Dim dgv As DataGridView = DirectCast(sender, DataGridView)
|
|
Dim relativeMousePosition As Point = dgv.PointToClient(Cursor.Position)
|
|
Dim hit As DataGridView.HitTestInfo = dgv.HitTest(relativeMousePosition.X, relativeMousePosition.Y)
|
|
If hit.Type.ToString = "ColumnHeader" Then
|
|
Exit Sub
|
|
End If
|
|
|
|
CURRENT_CONTROL = sender
|
|
|
|
BeginLocation = e.Location
|
|
CURRENT_CONTROL.Tag = New clsDragInfo(Form.MousePosition, sender.Location)
|
|
dgv.BringToFront()
|
|
' Set the mode flag to signal the MouseMove event handler that it
|
|
' needs to now calculate new positions for our control
|
|
MouseMoving = True
|
|
|
|
CURRENT_CONTROL = sender
|
|
|
|
'Jetzt Controleigenschaften laden
|
|
Set_Active_Color()
|
|
Load_Control()
|
|
|
|
gbxControl.Visible = True
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub btnsave_Click(sender As System.Object, e As System.EventArgs) Handles btnsave.Click
|
|
Save_Control()
|
|
End Sub
|
|
Sub Save_Control()
|
|
Try
|
|
If rbVektor.Checked Then
|
|
If INDEX_NAMETextBox.Text = "" Then
|
|
MsgBox("Bitte definieren Sie den Bezeichner für dieses Processmanager-Item:", MsgBoxStyle.Exclamation)
|
|
Me.INDEX_NAMETextBox.BackColor = Color.Red
|
|
Exit Sub
|
|
Else
|
|
Me.INDEX_NAMETextBox.BackColor = Color.White
|
|
End If
|
|
' INDEX_NAME_VALUE.Text = "[%VKT" & INDEX_NAMETextBox.Text
|
|
End If
|
|
TBPM_PROFILE_CONTROLSBindingSource.EndEdit()
|
|
If DD_DMSLiteDataSet.TBPM_PROFILE_CONTROLS.GetChanges Is Nothing = False Then
|
|
Me.CHANGED_WHOTextBox.Text = Environment.UserName
|
|
TBPM_PROFILE_CONTROLSBindingSource.EndEdit()
|
|
TBPM_PROFILE_CONTROLSTableAdapter.Update(DD_DMSLiteDataSet.TBPM_PROFILE_CONTROLS)
|
|
tslblAenderungen.Visible = True
|
|
tslblAenderungen.Text = "Änderungen gespeichert - " & Now
|
|
Else
|
|
tslblAenderungen.Visible = False
|
|
End If
|
|
'Wenn Datagridview dann Speichern
|
|
Dim type As String = CURRENT_CONTROL.GetType.ToString
|
|
If type.Contains("DataGridView") Then
|
|
Dim dgv As DataGridView = DirectCast(CURRENT_CONTROL, DataGridView)
|
|
If dgv.ColumnCount > 1 Then
|
|
'For Each col As DataColumn In dgv.Columns
|
|
' MsgBox(col.ColumnName)
|
|
'Next
|
|
End If
|
|
End If
|
|
Catch ex As Exception
|
|
If ex.Message.ToLower.Contains("interne datatable") = True Or ex.Message.ToLower.Contains("internal index is corrupted") = True Then
|
|
Save_Control()
|
|
ElseIf ex.Message.ToLower.Contains("geöffneter datareader") = True Then
|
|
Exit Sub
|
|
Else
|
|
MsgBox(ex.Message, MsgBoxStyle.Critical, "Save Control:")
|
|
End If
|
|
End Try
|
|
|
|
End Sub
|
|
|
|
Private Sub cmbIndex_SelectedIndexChanged(sender As System.Object, e As System.EventArgs) Handles cmbIndex.SelectedIndexChanged
|
|
If cmbIndex.SelectedIndex <> -1 Then
|
|
If cmbIndex.Text = "DD PM-ONLY FOR DISPLAY" Then
|
|
LOAD_IDX_VALUECheckBox.Checked = False
|
|
LOAD_IDX_VALUECheckBox.Enabled = False
|
|
READ_ONLYCheckBox.Checked = True
|
|
VALIDATIONCheckBox.Checked = False
|
|
VALIDATIONCheckBox.Enabled = False
|
|
Else
|
|
LOAD_IDX_VALUECheckBox.Enabled = True
|
|
VALIDATIONCheckBox.Enabled = True
|
|
End If
|
|
If _loading = False Then
|
|
Save_Control()
|
|
End If
|
|
End If
|
|
End Sub
|
|
Private Sub btncmb_MouseMove(sender As System.Object, e As System.Windows.Forms.MouseEventArgs) Handles btncmb.MouseMove
|
|
If MouseIsDown Then
|
|
' Initiate dragging.
|
|
btncmb.DoDragDrop("cmb", DragDropEffects.Copy)
|
|
End If
|
|
MouseIsDown = False
|
|
End Sub
|
|
|
|
Private Sub CheckBox1_CheckedChanged(sender As System.Object, e As System.EventArgs) Handles CheckBoxAuswahlliste.CheckedChanged
|
|
If CheckBoxAuswahlliste.Checked Then
|
|
lblAuswahlliste.Visible = True
|
|
CHOICE_LISTTextBox.Visible = True
|
|
Else
|
|
lblAuswahlliste.Visible = False
|
|
CHOICE_LISTTextBox.Visible = False
|
|
End If
|
|
End Sub
|
|
|
|
|
|
Private Sub btndelete_Click(sender As System.Object, e As System.EventArgs) Handles btndelete.Click
|
|
If CURRENT_CONTROL Is Nothing = False Then
|
|
delete_Control(CURRENT_CONTROL.Name)
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub btnwidth_plus_Click(sender As System.Object, e As System.EventArgs) Handles btnwidth_plus.Click
|
|
If CURRENT_CONTROL Is Nothing = False Then
|
|
CURRENT_CONTROL.Size = New Size(CURRENT_CONTROL.Width + 5, CURRENT_CONTROL.Height)
|
|
UpdateSingleValue("WIDTH", CURRENT_CONTROL.Size.Width)
|
|
End If
|
|
|
|
End Sub
|
|
|
|
Private Sub btnwidth_minus_Click(sender As System.Object, e As System.EventArgs) Handles btnwidth_minus.Click
|
|
If CURRENT_CONTROL Is Nothing = False Then
|
|
CURRENT_CONTROL.Size = New Size(CURRENT_CONTROL.Width - 5, CURRENT_CONTROL.Height)
|
|
UpdateSingleValue("WIDTH", CURRENT_CONTROL.Size.Width)
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub btnheight_plus_Click(sender As System.Object, e As System.EventArgs) Handles btnheight_plus.Click
|
|
If CURRENT_CONTROL Is Nothing = False Then
|
|
Dim newHeight As Integer = CURRENT_CONTROL.Height + 5
|
|
|
|
If newHeight > 21 And TypeOf CURRENT_CONTROL Is TextBox Then
|
|
DirectCast(CURRENT_CONTROL, TextBox).Multiline = True
|
|
End If
|
|
CURRENT_CONTROL.Size = New Size(CURRENT_CONTROL.Width, newHeight)
|
|
UpdateSingleValue("WIDTH", newHeight)
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub btnheight_minus_Click(sender As System.Object, e As System.EventArgs) Handles btnheight_minus.Click
|
|
If CURRENT_CONTROL Is Nothing = False Then
|
|
Dim newHeight As Integer = CURRENT_CONTROL.Height - 5
|
|
|
|
If newHeight < 22 And TypeOf CURRENT_CONTROL Is TextBox Then
|
|
DirectCast(CURRENT_CONTROL, TextBox).Multiline = True
|
|
End If
|
|
CURRENT_CONTROL.Size = New Size(CURRENT_CONTROL.Width, newHeight)
|
|
UpdateSingleValue("WIDTH", newHeight)
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub Button2_MouseMove(sender As System.Object, e As System.Windows.Forms.MouseEventArgs) Handles btndtp.MouseMove
|
|
If MouseIsDown Then
|
|
'Initiate dragging.
|
|
btndtp.DoDragDrop("dtp", DragDropEffects.Copy)
|
|
End If
|
|
MouseIsDown = False
|
|
End Sub
|
|
|
|
|
|
|
|
Private Sub btnVektor_MouseMove(sender As Object, e As MouseEventArgs) Handles btnVektor.MouseMove
|
|
If MouseIsDown Then
|
|
'Initiate dragging.
|
|
btnVektor.DoDragDrop("dgv", DragDropEffects.Copy)
|
|
End If
|
|
MouseIsDown = False
|
|
End Sub
|
|
Private Sub btnTabelle_MouseMove(sender As Object, e As MouseEventArgs) Handles btnTabelle.MouseMove
|
|
If MouseIsDown Then
|
|
'Initiate dragging.
|
|
btnVektor.DoDragDrop("tb", DragDropEffects.Copy)
|
|
End If
|
|
MouseIsDown = False
|
|
End Sub
|
|
Private Sub Button1_MouseMove(sender As Object, e As MouseEventArgs) Handles btnCheckbox.MouseMove
|
|
If MouseIsDown Then
|
|
'Initiate dragging.
|
|
btnCheckbox.DoDragDrop("chk", DragDropEffects.Copy)
|
|
End If
|
|
MouseIsDown = False
|
|
End Sub
|
|
|
|
Private Sub rbIndex_CheckedChanged(sender As Object, e As EventArgs) Handles rbIndex.CheckedChanged
|
|
If rbIndex.Checked Then
|
|
Me.cmbIndex.Visible = True
|
|
Me.INDEX_NAMETextBox.Visible = False
|
|
Me.lblIndex.Text = "Zugeordneter Index"
|
|
Else
|
|
Me.cmbIndex.Visible = False
|
|
Me.INDEX_NAMETextBox.Visible = True
|
|
Me.lblIndex.Text = "Bezeichner und getätigte Eingabe werden in das Vektorfeld geschrieben"
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub rbVektor_CheckedChanged(sender As Object, e As EventArgs) Handles rbVektor.CheckedChanged
|
|
If rbVektor.Checked Then
|
|
Me.INDEX_NAMETextBox.Visible = True
|
|
Me.cmbIndex.Visible = False
|
|
Me.lblIndex.Text = "Bezeichner und getätigte Eingabe werden in das Vektorfeld geschrieben"
|
|
Else
|
|
Me.INDEX_NAMETextBox.Visible = False
|
|
Me.cmbIndex.Visible = True
|
|
Me.lblIndex.Text = "Zugeordneter Index"
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub INDEX_NAMETextBox_Leave(sender As Object, e As EventArgs) Handles INDEX_NAMETextBox.Leave
|
|
If INDEX_NAMETextBox.Text <> "" And CURRENT_CONTROL_ID <> 0 Then
|
|
TBPM_PROFILE_CONTROLSTableAdapter.cmdUpdateIndexname("[%VKT" & INDEX_NAMETextBox.Text, Environment.UserName, CURRENT_CONTROL_ID)
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub READ_ONLYCheckBox_CheckedChanged(sender As Object, e As EventArgs) Handles READ_ONLYCheckBox.CheckedChanged
|
|
If READ_ONLYCheckBox.Checked Then
|
|
Me.VALIDATIONCheckBox.Checked = True
|
|
Me.LOAD_IDX_VALUECheckBox.Checked = True
|
|
End If
|
|
End Sub
|
|
Private Sub btnrefresh_Click(sender As Object, e As EventArgs) Handles btnrefresh.Click
|
|
Controls_laden()
|
|
End Sub
|
|
|
|
Private Sub btnShowConnections_Click(sender As Object, e As EventArgs) Handles btnShowConnections.Click
|
|
frmConnection.ShowDialog()
|
|
Try
|
|
Me.TBPM_CONNECTIONTableAdapter.Fill(Me.DD_DMSLiteDataSet.TBPM_CONNECTION)
|
|
Catch ex As Exception
|
|
ClassLogger.Add(ex.Message)
|
|
End Try
|
|
End Sub
|
|
|
|
Private Sub btnEditor_Click(sender As Object, e As EventArgs) Handles btnEditor.Click
|
|
Dim CONID = 0
|
|
If cmbConnection.SelectedValue > 0 Then
|
|
CONID = cmbConnection.SelectedValue
|
|
End If
|
|
TBPM_PROFILE_CONTROLSBindingSource.EndEdit()
|
|
If DD_DMSLiteDataSet.TBPM_PROFILE_CONTROLS.GetChanges Is Nothing = False Then
|
|
Me.CHANGED_WHOTextBox.Text = Environment.UserName
|
|
TBPM_PROFILE_CONTROLSBindingSource.EndEdit()
|
|
TBPM_PROFILE_CONTROLSTableAdapter.Update(DD_DMSLiteDataSet.TBPM_PROFILE_CONTROLS)
|
|
End If
|
|
If CURRENT_CONTROL_ID <> 0 Then
|
|
Dim sql = "SELECT T.CONNECTION_ID,T1.BEZEICHNUNG AS 'CON_STRING',ISNULL(T.SQL_UEBERPRUEFUNG,'') AS 'SQL_COMMAND' FROM TBPM_PROFILE_CONTROLS T, TBPM_CONNECTION T1 WHERE " &
|
|
"T.CONNECTION_ID = T1.GUID AND T.GUID = " & CURRENT_CONTROL_ID
|
|
CURRENT_DT_SQL_CONFIG_TABLE = ClassDatabase.Return_Datatable(sql, True)
|
|
CURRENT_INDEX_ID = CURRENT_CONTROL_ID
|
|
CURRENT_DESIGN_TYPE = "INPUT_INDEX"
|
|
CURRENT_SQL_COMAMND = SQL_CommandTextBox.Text
|
|
CURRENT_SQL_CON = CONID
|
|
frmSQL_DESIGNER.ShowDialog()
|
|
|
|
Load_Control(CURRENT_CONTROL_ID)
|
|
TabControlEigenschaften.SelectedIndex = 2
|
|
Else
|
|
MsgBox("Please choose a control!", MsgBoxStyle.Information)
|
|
End If
|
|
|
|
End Sub
|
|
|
|
#Region "Rewrite"
|
|
''' <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.Click, AddressOf OnControl_Click
|
|
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
|
|
CURRENT_CONTROL = sender
|
|
BeginLocation = e.Location
|
|
sender.BringToFront()
|
|
MouseMoving = True
|
|
|
|
Console.WriteLine("CURRENT_CONTROL:" & CURRENT_CONTROL.Name)
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub OnControl_MouseUp(sender As Control, e As MouseEventArgs)
|
|
If MouseMoving Then
|
|
MouseMoving = False
|
|
EndLocation = e.Location
|
|
|
|
Dim CurrentPosition As Point = DirectCast(pgControls.SelectedObject, BaseProperties).Location
|
|
|
|
If Point.op_Inequality(CurrentPosition, EndLocation) Then
|
|
DirectCast(pgControls.SelectedObject, BaseProperties).Location = CURRENT_CONTROL.Location
|
|
|
|
UpdateSingleValue("X_LOC", CURRENT_CONTROL.Location.X)
|
|
UpdateSingleValue("Y_LOC", CURRENT_CONTROL.Location.Y)
|
|
End If
|
|
End If
|
|
|
|
MyBase.Cursor = Cursors.Default
|
|
End Sub
|
|
|
|
Private Sub OnControl_MouseMove(sender As Control, e As MouseEventArgs)
|
|
Try
|
|
If CURRENT_CONTROL Is Nothing Then
|
|
Exit Sub
|
|
End If
|
|
|
|
If MouseMoving Then
|
|
Cursor = Cursors.Hand
|
|
Refresh()
|
|
|
|
Dim CurrentPosition As Point = GetCursorPosition()
|
|
|
|
If Point.op_Inequality(CurrentPosition, BeginLocation) Then
|
|
CURRENT_CONTROL.Location = New Point(CurrentPosition.X - BeginLocation.X, CurrentPosition.Y - BeginLocation.Y)
|
|
End If
|
|
End If
|
|
Catch ex As Exception
|
|
MouseMoving = 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"))
|
|
|
|
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 OnControl_Click(sender As Control, e As MouseEventArgs)
|
|
Dim props
|
|
Dim dt As DataTable = DD_DMSLiteDataSet.TBPM_PROFILE_CONTROLS
|
|
Dim row = dt.AsEnumerable().Where(Function(r As DataRow)
|
|
Return r.Item("GUID") = sender.Tag
|
|
End Function).Single()
|
|
|
|
CURRENT_CONTROL = sender
|
|
CURRENT_CONTROL_ID = sender.Tag
|
|
|
|
Set_Active_Color()
|
|
|
|
gbxControl.Visible = True
|
|
|
|
Dim indicies As List(Of String) = _windreamPM.GetIndicesByObjecttype(CURRENT_OBJECTTYPE).ToList()
|
|
Dim choiceLists As List(Of String) = DD_LIB_Standards.clsWD_GET.GetChoiceLists()
|
|
|
|
If 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, indicies)
|
|
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, indicies)
|
|
|
|
props = txtProps
|
|
|
|
ElseIf TypeOf sender Is ComboBox Then
|
|
Dim cmb As ComboBox = sender
|
|
Dim cmbProps As ComboboxProperties = CreatePropsObjectWithIndicies(New ComboboxProperties, row, indicies)
|
|
cmbProps.ChoiceLists = 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, indicies)
|
|
|
|
props = dtpProps
|
|
ElseIf TypeOf sender Is DataGridView Then
|
|
Dim grid As DataGridView = sender
|
|
Dim gridProps As GridViewProperties = CreatePropsObjectWithIndicies(New GridViewProperties, row, indicies)
|
|
|
|
props = gridProps
|
|
Else
|
|
MsgBox("This is not a supported control type!")
|
|
Exit Sub
|
|
End If
|
|
|
|
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)
|
|
|
|
CURRENT_CONTROL.Location = newValue
|
|
|
|
Case "X"
|
|
UpdateSingleValue("X_LOC", CInt(newValue))
|
|
|
|
CURRENT_CONTROL.Location = New Point(newValue, CURRENT_CONTROL.Location.Y)
|
|
|
|
Case "Y"
|
|
UpdateSingleValue("Y_LOC", CInt(newValue))
|
|
|
|
CURRENT_CONTROL.Location = New Point(CURRENT_CONTROL.Location.X, newValue)
|
|
|
|
Case "Size"
|
|
UpdateSingleValue("WIDTH", DirectCast(newValue, Size).Width)
|
|
UpdateSingleValue("HEIGHT", DirectCast(newValue, Size).Height)
|
|
|
|
CURRENT_CONTROL.Size = newValue
|
|
|
|
Case "Width"
|
|
UpdateSingleValue("WIDTH", DirectCast(newValue, Size).Width)
|
|
|
|
CURRENT_CONTROL.Size = New Size(newValue, CURRENT_CONTROL.Size.Height)
|
|
|
|
Case "Height"
|
|
UpdateSingleValue("HEIGHT", DirectCast(newValue, Size).Height)
|
|
|
|
CURRENT_CONTROL.Size = New Size(CURRENT_CONTROL.Size.Width, newValue)
|
|
|
|
Case "Name"
|
|
UpdateSingleValue("NAME", newValue)
|
|
|
|
CURRENT_CONTROL.Name = newValue
|
|
|
|
Case "Index"
|
|
UpdateSingleValue("INDEX_NAME", newValue)
|
|
|
|
Case "Text"
|
|
UpdateSingleValue("CTRL_TEXT", newValue)
|
|
|
|
CURRENT_CONTROL.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)
|
|
|
|
CURRENT_CONTROL.Font = font
|
|
Case "TextColor"
|
|
Dim color As Color = newValue
|
|
UpdateSingleValue("FONT_COLOR", ColorToInt(color))
|
|
|
|
CURRENT_CONTROL.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
|
|
|
|
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
|
|
|
|
ClassDatabase.Execute_non_Query($"UPDATE TBPM_PROFILE_CONTROLS SET {columnName} = {escapedValue} WHERE GUID = {guid}")
|
|
|
|
tslblAenderungen.Visible = True
|
|
tslblAenderungen.Text = "Änderungen gespeichert - " & Now
|
|
End Sub
|
|
#End Region
|
|
End Class |