MS Button und IDB Logik

This commit is contained in:
2019-11-20 16:19:22 +01:00
parent 8b9b409769
commit 3508aa486c
15 changed files with 706 additions and 649 deletions

View File

@@ -5,6 +5,7 @@ Imports DevExpress.XtraGrid.Columns
Imports DevExpress.XtraGrid.Views.Grid
Imports DevExpress.XtraGrid.Views.Grid.ViewInfo
Imports DigitalData.Controls.LookupGrid
Imports System.Drawing
Public Class frmFormDesigner
Public ProfileId As Integer
@@ -673,57 +674,65 @@ Public Class frmFormDesigner
End Sub
Private Sub OnControl_MouseUp(sender As Control, e As MouseEventArgs)
Mouse_IsPressed = False
Try
Mouse_IsPressed = False
' Control Eigenschaften laden
LoadControlProperties(sender)
' 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)
If Mouse_IsMoving = False Then
MyBase.Cursor = Cursors.Default
Exit Sub
End If
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Critical)
LOGGER.Error(ex)
Mouse_IsMoving = False
Mouse_IsPressed = False
End Try
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
End Sub
Private Sub OnControl_MouseMove(sender As Control, e As MouseEventArgs)
@@ -910,8 +919,12 @@ Public Class frmFormDesigner
oButtonProps.Override_SQL = New SQLValue(NotNull(row.Item("SQL2"), ""))
oButtonProps.Enable_SQL = New SQLValue(NotNull(row.Item("SQL_ENABLE"), ""))
If Not IsDBNull(row.Item("IMAGE_CONTROL")) Then
oButtonProps.CtrlImage = New ImageValue(row.Item("IMAGE_CONTROL"))
Dim obimg() As Byte = row.Item("IMAGE_CONTROL")
Dim oBitmap As Bitmap = ByteArrayToBitmap(obimg)
oButtonProps.CtrlImage = New ImageValue(Nothing)
oButton.Image = oBitmap
End If
props = oButtonProps
Else
MsgBox("This is not a supported control type!")
@@ -928,7 +941,7 @@ Public Class frmFormDesigner
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 newValue = e.ChangedItem.Value
Dim prop As String = e.ChangedItem.Label
Select Case prop
@@ -1009,7 +1022,10 @@ Public Class frmFormDesigner
Case "SQLCommand"
UpdateSingleValue("SQL_UEBERPRUEFUNG", newValue)
UpdateSingleValue("CHOICE_LIST", "")
Case "Enable_SQL"
UpdateSingleValue("SQL_ENABLE", newValue)
Case "Override_SQL"
UpdateSingleValue("SQL2", newValue)
Case "ChoiceList"
UpdateSingleValue("CHOICE_LIST", newValue)
UpdateSingleValue("SQL_UEBERPRUEFUNG", "")
@@ -1031,9 +1047,39 @@ Public Class frmFormDesigner
Case "RegexMessage"
UpdateSingleValue("REGEX_MESSAGE_DE", newValue)
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)
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
Return True
Catch ex As Exception
LOGGER.Error(ex)
Dim msg = $"UpdateImage - Error while saving Control (Id: {CURRENT_CONTROL_ID}): {vbCrLf}{ex.Message}"
MsgBox(msg)
LOGGER.Info(msg)
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