Public Class frmLevel_Designer #Region "+++++ Konstanten +++++" 'Private akt_ctrl As Control Private Shared _Instance As frmLevel_Designer = Nothing Private m_Moving As Boolean = False Private LastCursor As Point = Nothing 'Private begin_location As System.Drawing.Point 'Private end_location As System.Drawing.Point 'Public Shared CtrlBuilder As ClassControlBuilder #End Region Dim formloaded As Boolean = False Public Shared Function Instance() As frmLevel_Designer If _Instance Is Nothing OrElse _Instance.IsDisposed = True Then _Instance = New frmLevel_Designer End If _Instance.BringToFront() Return _Instance End Function Public Sub SetFormTitle(title As String) Me.Text = "Formulardesigner für Formular: " & title End Sub Public Sub SetFormName(name As String) Me.lblFormName.Text = "Name: " & name & " - Form-ID: " & CURRENT_FORM_ID End Sub Public Sub Check_Document_Config(FORM_ID As Integer) Try Dim res = ClassDatabase.Execute_Scalar("SELECT DOCUMENT_VIEW FROM TBPMO_FORM_VIEW WHERE FORM_ID = " & CURRENT_FORM_ID & " and SCREEN_ID = " & CURRENT_SCREEN_ID) If res = True Then chkbxdocview.Checked = True Dim DT As DataTable = ClassDatabase.Return_Datatable("SELECT WINDREAM_SEARCH,SEARCH_PATTERN1,SEARCH_PATTERN2,SEARCH_PATTERN3,SEARCH_PATTERN4,SEARCH_PATTERN5 FROM TBPMO_FORM_VIEW WHERE FORM_ID = " & CURRENT_FORM_ID & " and SCREEN_ID = " & CURRENT_SCREEN_ID) If DT.Rows.Count = 1 Then If Not IsDBNull(DT.Rows(0).Item(0)) Then txtWindreamsuche.Text = ClassHelper.CheckDBNull(DT.Rows(0).Item(0), "String") 'Form-ID (Entity) 'Record -ID Dim result result = ClassHelper.CheckDBNull(DT.Rows(0).Item(1), "String") If result <> "" Then If result.ToString.ToUpper.Contains("RECORD") Then cmbSearchPattern1.SelectedIndex = 1 Else cmbSearchPattern1.SelectedIndex = 0 End If End If result = ClassHelper.CheckDBNull(DT.Rows(0).Item(2), "String") If result <> "" Then If result.ToString.ToUpper.Contains("RECORD") Then cmbSearchPattern2.SelectedIndex = 1 Else cmbSearchPattern2.SelectedIndex = 0 End If End If result = ClassHelper.CheckDBNull(DT.Rows(0).Item(3), "String") If result <> "" Then If result.ToString.ToUpper.Contains("RECORD") Then cmbSearchPattern3.SelectedIndex = 1 Else cmbSearchPattern3.SelectedIndex = 0 End If End If result = ClassHelper.CheckDBNull(DT.Rows(0).Item(4), "String") If result <> "" Then If result.ToString.ToUpper.Contains("RECORD") Then cmbSearchPattern4.SelectedIndex = 1 Else cmbSearchPattern4.SelectedIndex = 0 End If End If result = ClassHelper.CheckDBNull(DT.Rows(0).Item(5), "String") If result <> "" Then If result.ToString.ToUpper.Contains("RECORD") Then cmbSearchPattern5.SelectedIndex = 1 Else cmbSearchPattern5.SelectedIndex = 0 End If End If 'cmbSearchPattern1.SelectedIndex = cmbSearchPattern1.FindStringExact(ClassHelper.CheckDBNull("@" & DT.Rows(0).Item(1), "String")) 'cmbSearchPattern2.SelectedIndex = cmbSearchPattern2.FindStringExact(ClassHelper.CheckDBNull("@" & DT.Rows(0).Item(2), "String")) 'cmbSearchPattern3.SelectedIndex = cmbSearchPattern3.FindStringExact(ClassHelper.CheckDBNull("@" & DT.Rows(0).Item(3), "String")) 'cmbSearchPattern4.SelectedIndex = cmbSearchPattern4.FindStringExact(ClassHelper.CheckDBNull("@" & DT.Rows(0).Item(4), "String")) 'cmbSearchPattern5.SelectedIndex = cmbSearchPattern5.FindStringExact(ClassHelper.CheckDBNull("@" & DT.Rows(0).Item(5), "String")) End If End If Me.grpbxDocumentView.Visible = True Else chkbxdocview.Visible = True chkbxdocview.Checked = False Me.grpbxDocumentView.Visible = False End If Catch ex As Exception MsgBox("Error in Check_Document_Config:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub #Region "+++++ Drag Drop Funktionen +++++" Public Sub ControlDragDrop(type As String, Parent As GroupBox) Dim r As New System.Random() Dim def_font_family As String = DefaultFont.Name Dim def_font_color As Integer = DefaultForeColor.ToArgb Dim def_font_style As Integer = 0 Dim def_font_size As Integer = 8 Dim random As Integer = r.Next(8, 100) Select Case type Case "lbl" CtrlBuilder.AddLabel("lbl" & random, "Bezeichnung definieren", 0, 0, def_font_family, def_font_color, def_font_size, def_font_style, "", True, Parent) ' Aktuelles Control in die Datenbank speichern ClassControlCommands.InsertControl(CtrlBuilder.CurrentControl) Case "txt" CtrlBuilder.AddTextBox("txt" & random, 0, 0, def_font_family, def_font_color, def_font_size, def_font_style, 0, True, 0, 0, False, False, "String", True, Parent) ' Aktuelles Control in die Datenbank speichern ClassControlCommands.InsertControl(CtrlBuilder.CurrentControl) Case "cmb" CtrlBuilder.AddComboBox("cmb" & random, 0, 0, def_font_family, def_font_color, def_font_size, def_font_style, 0, True, 0, 0, "String", True, False, "", "", Parent) ' Aktuelles Control in die Datenbank speichern ClassControlCommands.InsertControl(CtrlBuilder.CurrentControl) Case "dtp" CtrlBuilder.AddDateTimePicker("dtp" & random, 0, 0, def_font_family, def_font_size, def_font_style, 0, False, 0, 0, False, True, Parent) ' Aktuelles Control in die Datenbank speichern ClassControlCommands.InsertControl(CtrlBuilder.CurrentControl) Case "dgv" CtrlBuilder.AddDataGridView("dgv" & random, 0, 0, 0, 0, True, False, Parent) ' Aktuelles Control in die Datenbank speichern ClassControlCommands.InsertControl(CtrlBuilder.CurrentControl) Case "chk" CtrlBuilder.AddCheckBox("chk" & random, "Bezeichn. defnieren", False, 0, 0, def_font_family, def_font_color, def_font_size, def_font_style, 0, False, 0, 0, True, False, Parent) ' Aktuelles Control in die Datenbank speichern ClassControlCommands.InsertControl(CtrlBuilder.CurrentControl) Case "rb" CtrlBuilder.AddRadioButton("rb" & random, "Bezeichn. defnieren", False, 0, 0, def_font_family, def_font_color, def_font_size, def_font_style, 0, False, 0, 0, True, False, Parent) ' Aktuelles Control in die Datenbank speichern ClassControlCommands.InsertControl(CtrlBuilder.CurrentControl) Case "pb" CtrlBuilder.AddPictureBox("pb" & random, 0, 0, 0, 0, True, False, Parent) ' Aktuelles Control in die Datenbank speichern ClassControlCommands.InsertControl(CtrlBuilder.CurrentControl) Case "gb" CtrlBuilder.AddGroupBox("gb" & random, "Bezeichn. defnieren", 0, 0, 0, 0, ColorToInt(SystemColors.Control), def_font_color, def_font_family, def_font_size, def_font_style, True, Parent) ' Aktuelles Control in die Datenbank speichern ClassControlCommands.InsertControl(CtrlBuilder.CurrentControl) Case "f_addappointment" CtrlBuilder.FunctionAddAppointment("f_addappointment" & random, "Zu Kalender hinzufügen", 0, 0, 0, 0, True, Parent) If ClassControlCommands.InsertControl(CtrlBuilder.CurrentControl) = True Then Dim ControlId = GetControlID_for_Name(CtrlBuilder.CurrentControl.Name, CURRENT_FORM_ID) ClassFunctionCommands.InsertFunction(ControlId, "ADDAPPOINTMENT") End If Case "f_addformdata" CtrlBuilder.FunctionAddFormData("f_addformdata" & random, "Add form Data", 0, 0, 0, 0, True, Parent) If ClassControlCommands.InsertControl(CtrlBuilder.CurrentControl) = True Then Dim ControlId = GetControlID_for_Name(CtrlBuilder.CurrentControl.Name, CURRENT_FORM_ID) ClassFunctionCommands.InsertFunction(ControlId, "ADDFORMDATA") End If Case "lstbxcheck" CtrlBuilder.AddCheckedListBox("chlb" & random, 0, 0, def_font_family, def_font_color, def_font_size, def_font_style, 0, True, 0, 0, True, False, "", "", Parent) ' Aktuelles Control in die Datenbank speichern ClassControlCommands.InsertControl(CtrlBuilder.CurrentControl) Case "lstbx" CtrlBuilder.AddListBox("lbx" & random, 0, 0, def_font_family, def_font_color, def_font_size, def_font_style, 0, True, 0, 0, True, False, "", "", Parent) ' Aktuelles Control in die Datenbank speichern ClassControlCommands.InsertControl(CtrlBuilder.CurrentControl) Case Else MsgBox("Event '" & type & "' nicht definiert") End Select End Sub Public Sub Groupbox_DragDrop(sender As Object, e As DragEventArgs) Dim type As String = e.Data.GetData(DataFormats.Text) Dim GroupBox As GroupBox = CType(sender, GroupBox) ControlDragDrop(type, GroupBox) End Sub Private Sub pnlDesigner_DragDrop(sender As Object, e As DragEventArgs) Handles pnlDesigner.DragDrop Dim type As String = e.Data.GetData(DataFormats.Text) ControlDragDrop(type, Nothing) End Sub Private Sub pnlDesigner_DragEnter(sender As 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 #End Region #Region "+++++ Form Events +++++" Private Sub frmLevel_Designer_FormClosing(sender As Object, e As FormClosingEventArgs) Handles Me.FormClosing Try ClassWindowLocation.SaveFormLocationSize(Me, 1, CURRENT_SCREEN_ID, "frmLevel_Designer") My.Settings.Save() RebuildView() Dim wid As Integer = Me.Width Dim update_sizepnl As String = "UPDATE TBPMO_FORM_VIEW SET HEIGHT = " & pnlDesigner.Height & ",WIDTH = " & wid & " where FORM_ID = " & CURRENT_FORM_ID & " and SCREEN_ID = " & CURRENT_SCREEN_ID ClassDatabase.Execute_non_Query(update_sizepnl) frmTool_ControlProperties.Instance.Close() frmTool_ControlDesigner.Instance.Close() Catch ex As Exception End Try End Sub Private Sub frmLevel_Designer_Load(sender As Object, e As EventArgs) Handles Me.Load ClassWindowLocation.LoadFormLocationSize(Me, 1, CURRENT_SCREEN_ID, "frmLevel_Designer") ' ADDED 18.11 CtrlBuilder = New ClassControlBuilder(pnlDesigner, AddressOf Control_MouseDown, AddressOf Control_MouseUp, AddressOf Control_MouseMove, AddressOf Control_Click, AddressOf Groupbox_DragDrop, ttTooltip) If ClassDatabase.Init = True Then LoadFormProperties() LoadControls() End If End Sub #End Region #Region "+++++ Load Funktionen +++++" Public Sub LoadFormProperties() Dim NAME_SQL As String = "SELECT NAME FROM TBPMO_FORM WHERE GUID = " & CURRENT_FORM_ID Dim TITLE_SQL As String = "SELECT FORM_TITLE FROM TBPMO_FORM_VIEW WHERE FORM_ID = " & CURRENT_FORM_ID & " and SCREEN_ID = " & CURRENT_SCREEN_ID Dim Height = ClassDatabase.Execute_Scalar("SELECT HEIGHT FROM TBPMO_FORM_VIEW WHERE FORM_ID = " & CURRENT_FORM_ID & " and SCREEN_ID = " & CURRENT_SCREEN_ID) Dim width = ClassDatabase.Execute_Scalar("SELECT WIDTH FROM TBPMO_FORM_VIEW WHERE FORM_ID = " & CURRENT_FORM_ID & " and SCREEN_ID = " & CURRENT_SCREEN_ID) Dim name = ClassDatabase.Execute_Scalar(NAME_SQL) Dim title = ClassDatabase.Execute_Scalar(TITLE_SQL) Check_Document_Config(CURRENT_FORM_ID) If Not IsDBNull(Height) Then If Height > 100 Then Me.pnlDesigner.Height = Height End If 'If Not IsDBNull(width) Then If width > 500 Then ' Me.Width = width End If 'End If End If SetFormName(name) SetFormTitle(title) End Sub Public Sub LoadControls() Dim dt As DataTable = ClassDatabase.Return_Datatable("SELECT * FROM VWPMO_CONTROL_SCREEN where FORM_ID = " & CURRENT_FORM_ID & " and SCREEN_ID = " & CURRENT_SCREEN_ID) For Each dr As DataRow In dt.Rows Dim parent As GroupBox = Nothing If (dr.Item("CONTROL_PARENT_ID") <> 0) Then Dim parentname As String = GetName_for_ControlID(dr.Item("CONTROL_PARENT_ID"), CURRENT_FORM_ID) parent = CtrlBuilder.GetControlByName(parentname) End If Select Case dr.Item("CTRLTYPE_ID") Case 1 ' Label CtrlBuilder.AddLabel(dr.Item("CONTROL_NAME"), dr.Item("CTRLSCR_CAPTION"), dr.Item("CTRLSCR_X_LOC"), dr.Item("CTRLSCR_Y_LOC"), dr.Item("CTRLSCR_FONT_FAMILY"), dr.Item("CTRLSCR_FONT_COLOR"), dr.Item("CTRLSCR_FONT_SIZE"), dr.Item("CTRLSCR_FONT_STYLE"), dr.Item("CONTROL_SQLCOMMAND_1"), False, parent, True) Case 2 ' TextBox CtrlBuilder.AddTextBox(dr.Item("CONTROL_NAME"), dr.Item("CTRLSCR_X_LOC"), dr.Item("CTRLSCR_Y_LOC"), dr.Item("CTRLSCR_FONT_FAMILY"), dr.Item("CTRLSCR_FONT_COLOR"), dr.Item("CTRLSCR_FONT_SIZE"), dr.Item("CTRLSCR_FONT_STYLE"), dr.Item("CTRLSCR_TAB_INDEX"), dr.Item("CTRLSCR_TAB_STOP"), dr.Item("CTRLSCR_WIDTH"), dr.Item("CTRLSCR_HEIGHT"), dr.Item("CONTROL_MULTILINE"), dr.Item("CONTROL_READ_ONLY"), dr.Item("CONTROL_FORMAT_TYPE"), False, parent, True) Case 3 ' ComboBox CtrlBuilder.AddComboBox(dr.Item("CONTROL_NAME"), dr.Item("CTRLSCR_X_LOC"), dr.Item("CTRLSCR_Y_LOC"), dr.Item("CTRLSCR_FONT_FAMILY"), dr.Item("CTRLSCR_FONT_COLOR"), dr.Item("CTRLSCR_FONT_SIZE"), dr.Item("CTRLSCR_FONT_STYLE"), dr.Item("CTRLSCR_TAB_INDEX"), dr.Item("CTRLSCR_TAB_STOP"), dr.Item("CTRLSCR_WIDTH"), dr.Item("CTRLSCR_HEIGHT"), dr.Item("CONTROL_FORMAT_TYPE"), False, dr.Item("CONTROL_READ_ONLY"), dr.Item("CONTROL_STATIC_LIST"), dr.Item("CONTROL_SQLCOMMAND_1"), parent, True) Case 4 ' DateTimePicker CtrlBuilder.AddDateTimePicker(dr.Item("CONTROL_NAME"), dr.Item("CTRLSCR_X_LOC"), dr.Item("CTRLSCR_Y_LOC"), dr.Item("CTRLSCR_FONT_FAMILY"), dr.Item("CTRLSCR_FONT_SIZE"), dr.Item("CTRLSCR_FONT_STYLE"), dr.Item("CTRLSCR_TAB_INDEX"), dr.Item("CTRLSCR_TAB_STOP"), dr.Item("CTRLSCR_WIDTH"), dr.Item("CTRLSCR_HEIGHT"), dr.Item("CONTROL_READ_ONLY"), False, parent, True) Case 5 ' GroupBox CtrlBuilder.AddGroupBox(dr.Item("CONTROL_NAME"), dr.Item("CTRLSCR_CAPTION"), dr.Item("CTRLSCR_X_LOC"), dr.Item("CTRLSCR_Y_LOC"), dr.Item("CTRLSCR_WIDTH"), dr.Item("CTRLSCR_HEIGHT"), dr.Item("CTRLSCR_BACK_COLOR"), dr.Item("CTRLSCR_FONT_COLOR"), dr.Item("CTRLSCR_FONT_FAMILY"), dr.Item("CTRLSCR_FONT_SIZE"), dr.Item("CTRLSCR_FONT_STYLE"), False, parent, True) Case 6 ' PictureBox CtrlBuilder.AddPictureBox(dr.Item("CONTROL_NAME"), dr.Item("CTRLSCR_X_LOC"), dr.Item("CTRLSCR_Y_LOC"), dr.Item("CTRLSCR_WIDTH"), dr.Item("CTRLSCR_HEIGHT"), False, dr.Item("CONTROL_READ_ONLY"), parent, True) Case 7 ' DataGridView CtrlBuilder.AddDataGridView(dr.Item("CONTROL_NAME"), dr.Item("CTRLSCR_X_LOC"), dr.Item("CTRLSCR_Y_LOC"), dr.Item("CTRLSCR_WIDTH"), dr.Item("CTRLSCR_HEIGHT"), False, dr.Item("CONTROL_READ_ONLY"), parent, True) Case 10 ' Checkbox Dim Checked As Boolean If IsDBNull(dr.Item("CONTROL_DEF_VALUE")) Then Checked = False Else Checked = StrToBool(dr.Item("CONTROL_DEF_VALUE")) End If CtrlBuilder.AddCheckBox(dr.Item("CONTROL_NAME"), dr.Item("CTRLSCR_CAPTION"), Checked, dr.Item("CTRLSCR_X_LOC"), dr.Item("CTRLSCR_Y_LOC"), dr.Item("CTRLSCR_FONT_FAMILY"), dr.Item("CTRLSCR_FONT_COLOR"), dr.Item("CTRLSCR_FONT_SIZE"), dr.Item("CTRLSCR_FONT_STYLE"), dr.Item("CTRLSCR_TAB_INDEX"), dr.Item("CTRLSCR_TAB_STOP"), dr.Item("CTRLSCR_WIDTH"), dr.Item("CTRLSCR_HEIGHT"), False, dr.Item("CONTROL_READ_ONLY"), parent, True) Case 8 'AddAppointment Button CtrlBuilder.FunctionAddAppointment(dr.Item("CONTROL_NAME"), dr.Item("CTRLSCR_CAPTION"), dr.Item("CTRLSCR_X_LOC"), dr.Item("CTRLSCR_Y_LOC"), dr.Item("CTRLSCR_WIDTH"), dr.Item("CTRLSCR_HEIGHT"), False, parent, True) Case 9 'AddFormData CtrlBuilder.FunctionAddFormData(dr.Item("CONTROL_NAME"), dr.Item("CTRLSCR_CAPTION"), dr.Item("CTRLSCR_X_LOC"), dr.Item("CTRLSCR_Y_LOC"), dr.Item("CTRLSCR_WIDTH"), dr.Item("CTRLSCR_HEIGHT"), False, parent, True) Case 11 ' RadioButton Dim Checked As Boolean If IsDBNull(dr.Item("CONTROL_DEF_VALUE")) Then Checked = False Else Checked = StrToBool(dr.Item("CONTROL_DEF_VALUE")) End If CtrlBuilder.AddRadioButton(dr.Item("CONTROL_NAME"), dr.Item("CTRLSCR_CAPTION"), Checked, dr.Item("CTRLSCR_X_LOC"), dr.Item("CTRLSCR_Y_LOC"), dr.Item("CTRLSCR_FONT_FAMILY"), dr.Item("CTRLSCR_FONT_COLOR"), dr.Item("CTRLSCR_FONT_SIZE"), dr.Item("CTRLSCR_FONT_STYLE"), dr.Item("CTRLSCR_TAB_INDEX"), dr.Item("CTRLSCR_TAB_STOP"), dr.Item("CTRLSCR_WIDTH"), dr.Item("CTRLSCR_HEIGHT"), False, dr.Item("CONTROL_READ_ONLY"), parent, True) Case 12 'CheckedListBox CtrlBuilder.AddCheckedListBox(dr.Item("CONTROL_NAME"), dr.Item("CTRLSCR_X_LOC"), dr.Item("CTRLSCR_Y_LOC"), dr.Item("CTRLSCR_FONT_FAMILY"), dr.Item("CTRLSCR_FONT_COLOR"), dr.Item("CTRLSCR_FONT_SIZE"), dr.Item("CTRLSCR_FONT_STYLE"), dr.Item("CTRLSCR_TAB_INDEX"), dr.Item("CTRLSCR_TAB_STOP"), dr.Item("CTRLSCR_WIDTH"), dr.Item("CTRLSCR_HEIGHT"), False, dr.Item("CONTROL_READ_ONLY"), dr.Item("CONTROL_STATIC_LIST"), dr.Item("CONTROL_SQLCOMMAND_1"), parent, True) Case 13 'ListBox CtrlBuilder.AddListBox(dr.Item("CONTROL_NAME"), dr.Item("CTRLSCR_X_LOC"), dr.Item("CTRLSCR_Y_LOC"), dr.Item("CTRLSCR_FONT_FAMILY"), dr.Item("CTRLSCR_FONT_COLOR"), dr.Item("CTRLSCR_FONT_SIZE"), dr.Item("CTRLSCR_FONT_STYLE"), dr.Item("CTRLSCR_TAB_INDEX"), dr.Item("CTRLSCR_TAB_STOP"), dr.Item("CTRLSCR_WIDTH"), dr.Item("CTRLSCR_HEIGHT"), False, dr.Item("CONTROL_READ_ONLY"), dr.Item("CONTROL_STATIC_LIST"), dr.Item("CONTROL_SQLCOMMAND_1"), parent, True) End Select Next End Sub #End Region #Region "+++++ Mouse Events +++++" Private Sub Control_Click(sender As Object, e As EventArgs) Dim control As Control = DirectCast(sender, Control) ' Aktuelles Control highlighten control.BringToFront() CtrlBuilder.SetAllActiveColor() ' GUID des aktuellen Controls speichern CURRENT_CONTROL_ID = ClassControlCommands.GetControlGuid(CtrlBuilder.CurrentControl.Name) ' Control Eigenschaften laden frmTool_ControlProperties.Instance.pgControlProperties.Enabled = True frmTool_ControlProperties.Instance.LoadControlProperties(CtrlBuilder.CurrentControl) End Sub Private Sub Control_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 CtrlBuilder.CurrentControl = sender CtrlBuilder.BeginLocation = e.Location ' Set the mode flag to signal the MouseMove event handler that it ' needs to now calculate new positions for our control m_Moving = True End If End Sub Private Sub Control_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseUp ' The button was released, so we're going back to Static mode. If m_Moving = True Then m_Moving = False 'end_location = e.Location CtrlBuilder.EndLocation = e.Location frmTool_ControlProperties.Instance.UpdateControlLocation(CtrlBuilder.CurrentControl) ClassControlCommands.UpdateControlPosition(CtrlBuilder.CurrentControl.Location.X, CtrlBuilder.CurrentControl.Location.Y, CtrlBuilder.CurrentControl) 'Save_Control() End If ' Restore the cursor image to the way we found it when the mouse ' button was pressed MyBase.Cursor = Cursors.Default End Sub Private Sub Control_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles MyBase.MouseMove Try If CtrlBuilder.CurrentControl Is Nothing Then Exit Sub End If If m_Moving = True Then Me.Cursor = Cursors.Hand Me.Refresh() Dim control As Control = DirectCast(sender, Control) Dim NowCursor As Point = CtrlBuilder.GetCursorPosition() ' Wenn das Control in einer GroupBox steckt If ParentIsGroupBox(control) Then Dim p As Control = control.Parent Dim newPos As Point = New Point(NowCursor.X - p.Location.X - e.Location.X, NowCursor.Y - p.Location.Y - e.Location.Y) ' Verhindert, dass das Control links+oben außerhalb der Groupbox geschoben wird = unerreichbar If newPos.X < 0 Or newPos.Y < 0 Then Exit Sub End If ' Verhindert, dass das Control rechts+unten außerhalb der Groupbox geschoben wird = unerreichbar If (newPos.X + control.Size.Width) > p.Size.Width Or (newPos.Y + control.Size.Height) > p.Size.Height Then Exit Sub End If If Point.op_Inequality(NowCursor, LastCursor) Then control.Location = newPos LastCursor = NowCursor End If Else ' Alle normalen Controls control.Location = New Point(NowCursor.X - CtrlBuilder.BeginLocation.X, NowCursor.Y - CtrlBuilder.BeginLocation.Y) End If End If Catch ex As Exception MsgBox(ex.Message, MsgBoxStyle.Exclamation, "MovableLabel_MouseMove") m_Moving = False End Try 'Try ' 'If akt_ctrl Is Nothing Then ' If CtrlBuilder.CurrentControl Is Nothing Then ' Exit Sub ' End If ' 'Check which mode we're in. If we're supposed to be moving ' 'our control ' If m_Moving = True Then ' Me.Cursor = Cursors.Hand ' Me.Refresh() ' Dim LastCursor As Point ' ' ADDED 18.11 ' Dim control As Control = DirectCast(sender, Control) ' ' get the screen position of the mouse pointer and map it ' ' to the position relative to the top-left corner of our ' ' parent container ' Dim NowCursor As Point = New Point(Cursor.Position.X, ' Cursor.Position.Y) ' Dim clientPosition As Point = CtrlBuilder.GetCursorPosition() ' If Point.op_Inequality(NowCursor, LastCursor) Then ' Console.WriteLine("MOUSE: " & clientPosition.X & " " & clientPosition.Y) ' Console.WriteLine("CNTRL: " & clientPosition.X - CtrlBuilder.BeginLocation.X & " " & clientPosition.Y - CtrlBuilder.BeginLocation.Y) ' control.Location = New Point(clientPosition.X - CtrlBuilder.BeginLocation.X, ' clientPosition.Y - CtrlBuilder.BeginLocation.Y) ' End If ' End If 'Catch ex As Exception ' MsgBox(ex.Message, MsgBoxStyle.Exclamation, "MovableLabel_MouseMove") ' m_Moving = False 'End Try End Sub #End Region Private Sub Control_PressTab(sender As Object, e As PreviewKeyDownEventArgs) 'NOOP End Sub Private Function RebuildView() Try Dim noerror As Boolean = False Dim sql = "EXECUTE PRPMO_CREATE_SQL " & CURRENT_FORM_ID noerror = ClassDatabase.Execute_non_Query(sql) sql = "EXECUTE PRPMO_CREATE_TEMP_VIEWS" noerror = ClassDatabase.Execute_non_Query(sql) Return noerror Catch ex As Exception MsgBox("Error in btnexecute_CreateViewSql:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) Return False End Try End Function Private Sub ToolStripButton1_Click(sender As Object, e As EventArgs) Handles ToolStripButton1.Click If RebuildView() = True Then MsgBox("The Views have been created successful.", MsgBoxStyle.Information) End If End Sub Private Sub btnWindreamsuche_Click(sender As Object, e As EventArgs) Handles btnWindreamsuche.Click If Not Me.txtWindreamsuche.Text = "" Then Me.OFDWindreamsuche.FileName = Me.txtWindreamsuche.Text End If If Me.OFDWindreamsuche.ShowDialog = Windows.Forms.DialogResult.OK Then Me.txtWindreamsuche.Text = Me.OFDWindreamsuche.FileName End If End Sub Private Sub btnsavedocView_Click(sender As Object, e As EventArgs) Handles btnsavedocView.Click Try Dim SP1, SP2, SP3, SP4, SP5 If cmbSearchPattern1.SelectedIndex <> -1 Then SP1 = "@" & cmbSearchPattern1.Text Else SP1 = "" End If If cmbSearchPattern2.SelectedIndex <> -1 Then SP2 = "@" & cmbSearchPattern2.Text Else SP2 = "" End If If cmbSearchPattern3.SelectedIndex <> -1 Then SP3 = "@" & cmbSearchPattern3.Text Else SP3 = "" End If If cmbSearchPattern4.SelectedIndex <> -1 Then SP4 = "@" & cmbSearchPattern4.Text Else SP4 = "" End If If cmbSearchPattern5.SelectedIndex <> -1 Then SP5 = "@" & cmbSearchPattern5.Text Else SP5 = "" End If Dim sql = "UPDATE TBPMO_FORM_VIEW SET WINDREAM_SEARCH = '" & txtWindreamsuche.Text & "',SEARCH_PATTERN1 = '" & SP1 & "',SEARCH_PATTERN2= '" & SP2 & "',SEARCH_PATTERN3= '" & SP3 & _ "',SEARCH_PATTERN4 = '" & SP4 & "',SEARCH_PATTERN5 = '" & SP5 & "', CHANGED_WHO = '" & Environment.UserName & "' where FORM_ID = " & CURRENT_FORM_ID & " and SCREEN_ID = " & CURRENT_SCREEN_ID If ClassDatabase.Execute_non_Query(sql) = True Then tsstatus.Text = "Document-View properties changed - " & Now tsstatus.Visible = True End If Catch ex As Exception MsgBox("Error in Save DocView-properties:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) tsstatus.Visible = False End Try End Sub Private Sub chkbxdocview_CheckedChanged(sender As Object, e As EventArgs) Handles chkbxdocview.CheckedChanged If formloaded = True Then Dim sql If chkbxdocview.Checked = True Then sql = "UPDATE TBPMO_FORM_VIEW SET DOCUMENT_VIEW = 1, CHANGED_WHO = '" & Environment.UserName & "' WHERE FORM_ID = " & CURRENT_FORM_ID & " and SCREEN_ID = " & CURRENT_SCREEN_ID Else sql = "UPDATE TBPMO_FORM_VIEW SET DOCUMENT_VIEW = 0, CHANGED_WHO = '" & Environment.UserName & "' WHERE FORM_ID = " & CURRENT_FORM_ID & " and SCREEN_ID = " & CURRENT_SCREEN_ID End If If ClassDatabase.Execute_non_Query(sql) = False Then MsgBox("Fehler bei Update Document-View - Check log", MsgBoxStyle.Critical) End If Check_Document_Config(CURRENT_FORM_ID) End If End Sub Private Sub frmLevel_Designer_Shown(sender As Object, e As EventArgs) Handles Me.Shown formloaded = True End Sub End Class