Visual Basic

Imports System.ComponentModel
Imports System.ComponentModel.Design
Imports System.Runtime.CompilerServices
Imports System.Windows.Forms.Design
Imports System.Windows.Forms.Design.Behavior
Imports System.Drawing.Drawing2D

'=======================================================================================================================================================================

<Description("Anzeige zur Darstellung eines Analogwertes mit zugehörigem Beschreibungs-Text und Einheit")>
<ToolboxItem(True)>
<Designer(GetType(RMValueDisplay.Designer))>
Public Class RMValueDisplay
    Inherits Control
    Implements ICustomTypeDescriptor

#Region "Konstruktor / Dispose"
     Public Sub New()
        Me.Size = New Size(300, 40)

        'SetTransparenz()

        Me.Invalidate()

    End Sub

    'UserControl überschreibt den Löschvorgang, um die Komponentenliste zu bereinigen.
    <System.Diagnostics.DebuggerNonUserCode()> _
    Protected Overrides Sub Dispose(ByVal disposing As Boolean)
        MyBase.Dispose(disposing)
    End Sub

#End Region

#Region "Echte Transparenz herstellen"
     Private Sub SetTransparenz()

        Me.SetStyle(ControlStyles.Opaque, True)
        Me.SetStyle(ControlStyles.OptimizedDoubleBuffer, False)
        Me.SetStyle(ControlStyles.ResizeRedraw, True)

    End Sub

    Protected Overrides ReadOnly Property CreateParams() As System.Windows.Forms.CreateParams
        Get
            Dim cp As CreateParams = MyBase.CreateParams
            cp.ExStyle = cp.ExStyle Or &H20  ' Turn on WS_EX_TRANSPARENT
            Return cp
        End Get
    End Property

#End Region

#Region "ausgeblendete Properties"
     'Private myRemoveProperties As String() = {}
    Private myRemoveProperties As String() = {
            "AllowDrop",
            "Anchor",
            "BackgroundImage",
            "BackgroundImageLayout",
            "CausesValidation",
            "Cursor",
            "Dock",
            "Enabled",
            "ImeMode",
            "Margin",
            "MaximumSize",
            "MinimumSize",
            "Padding",
            "RightToLeft",
            "TabIndex",
            "TabStop",
            "Text",
            "UseWaitCursor"
            }

#End Region

#Region "eigene Definitionen"
     <TypeConverter(GetType(SpaltenTrennerDefinition.Converter))>
    Public Class SpaltenTrennerDefinition

        <Description("Position der 1. Spalte im Control")>
        Property Pos1 As Int32
            Get
                Return my_Pos1
            End Get
            Set(ByVal value As Int32)
                If my_Pos1 <> value Then
                    If value < 0 Then value = 0
                    If value > my_Pos2 Then value = my_Pos2
                    my_Pos1 = value

                    If Parent IsNot Nothing Then my_Pos1Proz = CSng(my_Pos1) / CSng(CType(Parent, Control).Width)
                    RaiseEvent Changed()
                End If
            End Set
        End Property
        Private my_Pos1Proz As Single = 0.6
        Private my_Pos1 As Int32 = my_Pos1Proz * 300

        <Description("Position der 2. Spalte im Control")>
        Property Pos2 As Int32
            Get
                Return my_Pos2
            End Get
            Set(ByVal value As Int32)
                If my_Pos2 <> value Then
                    my_Pos2 = value
                    If my_Pos2 < my_Pos1 Then my_Pos2 = my_Pos1

                    If Parent IsNot Nothing Then my_Pos2Proz = CSng(my_Pos2) / CSng(CType(Parent, Control).Width)
                    RaiseEvent Changed()
                End If
            End Set
        End Property
        Private my_Pos2Proz As Single = 0.85
        Private my_Pos2 As Int32 = my_Pos2Proz * 300

        Public Event Changed()

        Property Parent As Object = Nothing

        Public Sub New(xParent As Object, setPos1 As Int32, setPos2 As Int32)
            Parent = CType(xParent, Control)
            Dim my_Width As Integer = Parent.Width

            If setPos1 < 0 Then setPos1 = 0
            If setPos2 < 0 Then setPos2 = 0

            If setPos1 > setPos2 Then setPos1 = setPos2
            If setPos2 < setPos1 Then setPos2 = setPos1

            If setPos1 > my_Width Then setPos1 = my_Width
            If setPos2 > my_Width Then setPos2 = my_Width

            my_Pos1 = setPos1
            my_Pos1Proz = my_Pos1 / my_Width
            my_Pos2 = setPos2
            my_Pos2Proz = my_Pos2 / my_Width

            RaiseEvent Changed()
        End Sub

        Public Sub New()
        End Sub

        Public Sub New(setPos1 As Int32, setPos2 As Int32)
            If setPos1 < 0 Then setPos1 = 0
            If setPos2 < 0 Then setPos2 = 0

            If setPos1 > setPos2 Then setPos1 = setPos2
            If setPos2 < setPos1 Then setPos2 = setPos1

            my_Pos1 = setPos1
            my_Pos2 = setPos2

            RaiseEvent Changed()
        End Sub

        Public Sub ReCalculate(my_Width As Integer)
            my_Pos1 = my_Pos1Proz * my_Width
            my_Pos2 = my_Pos2Proz * my_Width

            'RaiseEvent Changed()
        End Sub

        Public Overrides Function ToString() As String
            Return my_Pos1.ToString + "; " + my_Pos2.ToString
        End Function



        Public Class Converter
            Inherits ExpandableObjectConverter

            Public Overloads Overrides Function CanConvertFrom(ByVal context As ITypeDescriptorContext, ByVal sourceType As Type) As Boolean
                'Konvertierung von string zulassen
                If sourceType Is GetType(String) Then Return True

                Return MyBase.CanConvertFrom(context, sourceType)
            End Function

            Public Overloads Overrides Function ConvertFrom(ByVal context As ITypeDescriptorContext, ByVal culture As System.Globalization.CultureInfo, ByVal value As Object) As Object
                If value.GetType Is GetType(String) Then
                    'Konvertierung von string
                    Dim s As String = CType(value, String)
                    Dim sa As String() = Split(s, ";")
                    If sa.Length >= 2 Then
                        Dim p1, p2 As Integer
                        If Integer.TryParse(sa(0), p1) AndAlso Integer.TryParse(sa(1), p2) Then
                            Return New SpaltenTrennerDefinition(context.Instance, p1, p2)
                        End If
                    End If
                    Throw New FormatException()
                End If

                Return MyBase.ConvertFrom(context, culture, value)
            End Function



            Public Overloads Overrides Function CanConvertTo(context As System.ComponentModel.ITypeDescriptorContext, destinationType As System.Type) As Boolean
                If destinationType Is GetType(System.ComponentModel.Design.Serialization.InstanceDescriptor) Then Return True

                Return MyBase.CanConvertTo(context, destinationType)
            End Function

            Public Overloads Overrides Function ConvertTo(context As System.ComponentModel.ITypeDescriptorContext, culture As System.Globalization.CultureInfo, value As Object, destinationType As System.Type) As Object

                If destinationType Is GetType(System.ComponentModel.Design.Serialization.InstanceDescriptor) Then
                    Dim ctor As Reflection.ConstructorInfo
                    Dim s As String = value.ToString
                    Dim sa As String() = Split(s, ";")
                    If sa.Length >= 2 Then
                        Dim p1, p2 As Integer
                        If Integer.TryParse(sa(0), p1) AndAlso Integer.TryParse(sa(1), p2) Then
                            ctor = GetType(SpaltenTrennerDefinition).GetConstructor(New Type() {GetType(Int32), GetType(Int32)})
                            Return New System.ComponentModel.Design.Serialization.InstanceDescriptor(ctor, New Object() {p1, p2}, True)
                        End If
                    End If
                End If

                Return MyBase.ConvertTo(context, culture, value, destinationType)
            End Function

        End Class

    End Class

#End Region

#Region "Expandable Properties"
     <Category("Layout"), Description("Definition der Spalten-Aufteilung im Control")>
     <RefreshProperties(RefreshProperties.All)>
    Property SpaltenTrenner As SpaltenTrennerDefinition
        Get
            Return my_SpaltenTrenner
        End Get
        Set(ByVal value As SpaltenTrennerDefinition)
            my_SpaltenTrenner = value
            'ResizeElements()
            Me.Invalidate()
        End Set
    End Property
    Private WithEvents my_SpaltenTrenner As New SpaltenTrennerDefinition()

#End Region

#Region "Properties zur Darstellung"
     <Category("Layout"), Description("Definition der Größe des Control")>
    <RefreshProperties(RefreshProperties.All)>
    Shadows Property Size As Size
        Get
            Return MyBase.Size
        End Get
        Set(ByVal value As Size)
            If value.Width <> MyBase.Width Then
                MyBase.Width = value.Width
                my_SpaltenTrenner.ReCalculate(value.Width)
            End If
            MyBase.Height = value.Height
        End Set
    End Property

    ' -----------------------------------------------------------------------------------

    <Category("Darstellung"), Description("legt die Hintergrundfarbe im Control fest")>
    <DefaultValue(GetType(Color), "LightGray")>
    Shadows Property BackColor As Color
        Get
            Return my_BackColor
        End Get
        Set(ByVal value As Color)
            MyBase.BackColor = value
            my_BackColor = value
            Me.Invalidate()
        End Set
    End Property
    Private my_BackColor As Color = Color.LightGray

    <Category("Darstellung"), Description("legt die Schriftfarbe im Control fest")>
    <DefaultValue(GetType(Color), "Black")>
    Shadows Property ForeColor As Color
        Get
            Return my_ForeColor
        End Get
        Set(ByVal value As Color)
            MyBase.ForeColor = value
            my_ForeColor = value
            Me.Invalidate()
        End Set
    End Property
    Private my_ForeColor As Color = Color.Black

    <Category("Darstellung"), Description("legt die Rahmen-Farbe des Labels fest")>
    <DefaultValue(GetType(System.Drawing.Color), "Gray")>
    <DesignerSerializationVisibility(DesignerSerializationVisibility.Visible)>
    Property BorderColor As Color
        Get
            Return my_BorderColor
        End Get
        Set(ByVal value As Color)
            my_BorderColor = value
            Me.Invalidate()
        End Set
    End Property
    Private my_BorderColor As Color = Color.Gray

    <Category("Anzeige"), Description("legt die Schriftart im Control fest")>
    Shadows Property Font As Font
        Get
            Return MyBase.Font
        End Get
        Set(ByVal value As Font)
            MyBase.Font = value
        End Set
    End Property

#End Region

#Region "interne Aktionen"
     Private Sub SpaltenTrenner_Changed() Handles my_SpaltenTrenner.Changed
        'If DesignMode And Activated Then PropertyHelper.RefreshProperties(Me)
        Me.Invalidate()
    End Sub

    Protected Overrides Sub OnResize(e As EventArgs)

        my_SpaltenTrenner.ReCalculate(Me.Width)

        MyBase.OnResize(e)

        Me.Invalidate()

    End Sub




    Protected Overrides Sub OnHandleCreated(e As System.EventArgs)
        myParent = Parent

        isInitialized = True
        Me.Invalidate()

        MyBase.OnHandleCreated(e)
    End Sub
    Private WithEvents myParent As Control
    Private isInitialized As Boolean = False

#End Region

#Region "Implementierung der ISelectionService-Schnittstelle um festzustellen, dass das Control angewählt wurde"
     <Browsable(False)>
    ReadOnly Property Activated As Boolean
        Get
            If selectionService IsNot Nothing Then Return selectionService.GetComponentSelected(Me)
            Return False
        End Get
    End Property

    Private selectionService As ISelectionService

    <Browsable(False), EditorBrowsable(EditorBrowsableState.Never)>
    Public Overrides Property Site() As ISite
        Get
            Return MyBase.Site
        End Get
        Set(ByVal Value As ISite)
            MyBase.Site = Value

            If MyBase.Site Is Nothing Then Return

            ' The selection service is not available outside of 
            ' design mode. A call requesting the service 
            ' using GetService while not in design mode will 
            ' return null.
            selectionService = Me.Site.GetService(GetType(ISelectionService))
        End Set
    End Property

#End Region

    '==============================================================================================

#Region "Properties bedingt ein-/ausblenden"
     Private Function FilterProperties(ByVal origProperties As PropertyDescriptorCollection) As PropertyDescriptorCollection

        Dim myPD As PropertyDescriptor
        Dim myListe As New List(Of PropertyDescriptor)
        Dim setHidden As Boolean

        For i As Integer = 0 To origProperties.Count - 1
            myPD = origProperties.Item(i)
            setHidden = False

            'Select Case myPD.Name
            '    Case "BorderRadius"
            '        If BorderStyle <> BorderViewDefinition.rounded _
            '        And BorderStyle <> BorderViewDefinition.phased Then setHidden = True
            '    Case "BorderColor"
            '        If BorderStyle = BorderViewDefinition.none _
            '        Or BorderStyle = BorderViewDefinition.raised _
            '        Or BorderStyle = BorderViewDefinition.lowered _
            '        Or BorderStyle = BorderViewDefinition.elevated _
            '        Or BorderStyle = BorderViewDefinition.sunken _
            '            Then setHidden = True
            '    Case "BorderSize"
            '        If BorderStyle = BorderViewDefinition.none _
            '              Then setHidden = True

            'End Select

            If setHidden Then
                ' Property ausblenden
                myPD = TypeDescriptor.CreateProperty(myPD.ComponentType, myPD, New Attribute() {New BrowsableAttribute(False), New EditorBrowsableAttribute(EditorBrowsableState.Never)})
            End If
            If Not myRemoveProperties.Contains(myPD.Name) Then myListe.Add(myPD)
        Next

        Dim myPDListe(myListe.Count - 1) As PropertyDescriptor
        myListe.CopyTo(myPDListe)
        Return New PropertyDescriptorCollection(myPDListe)
    End Function

#End Region

#Region "ICustomTypeDescriptor - Properties ein-/ausblenden"
     <Description("Simply delegates to the TypeDescriptor method.")> _
    Public Function GetAttributes() As System.ComponentModel.AttributeCollection Implements System.ComponentModel.ICustomTypeDescriptor.GetAttributes
        Return TypeDescriptor.GetAttributes(Me, True)
    End Function

    <Description("Simply delegates to the TypeDescriptor method.")> _
    Public Function GetClassName() As String Implements System.ComponentModel.ICustomTypeDescriptor.GetClassName
        Return TypeDescriptor.GetClassName(Me, True)
    End Function

    <Description("Simply delegates to the TypeDescriptor method.")> _
    Public Function GetComponentNaMe() As String Implements System.ComponentModel.ICustomTypeDescriptor.GetComponentName
        Return TypeDescriptor.GetComponentName(Me, True)
    End Function

    <Description("Simply delegates to the TypeDescriptor method.")> _
    Public Function GetConverter() As System.ComponentModel.TypeConverter _
           Implements System.ComponentModel.ICustomTypeDescriptor.GetConverter
        Return TypeDescriptor.GetConverter(Me, True)
    End Function

    <Description("Simply delegates to the TypeDescriptor method.")> _
    Public Function GetDefaultEvent() As System.ComponentModel.EventDescriptor _
           Implements System.ComponentModel.ICustomTypeDescriptor.GetDefaultEvent
        Return TypeDescriptor.GetDefaultEvent(Me, True)
    End Function

    <Description("Simply delegates to the TypeDescriptor method.")> _
    Public Function GetDefaultProperty() As System.ComponentModel.PropertyDescriptor _
           Implements System.ComponentModel.ICustomTypeDescriptor.GetDefaultProperty
        Return TypeDescriptor.GetDefaultProperty(Me, True)
    End Function

    <Description("Simply delegates to the TypeDescriptor method.")> _
    Public Function GetEditor(ByVal editorBaseType As System.Type) As Object _
           Implements System.ComponentModel.ICustomTypeDescriptor.GetEditor
        Return TypeDescriptor.GetEditor(Me, editorBaseType, True)
    End Function

    <Description("Simply delegates to the TypeDescriptor method.")> _
    Public Overloads Function GetEvents() As System.ComponentModel.EventDescriptorCollection _
           Implements System.ComponentModel.ICustomTypeDescriptor.GetEvents
        Return TypeDescriptor.GetEvents(Me, True)
    End Function

    <Description("Simply delegates to the TypeDescriptor method.")> _
    Public Overloads Function GetEvents(ByVal attributes() As System.Attribute) As System.ComponentModel.EventDescriptorCollection _
           Implements System.ComponentModel.ICustomTypeDescriptor.GetEvents
        Return TypeDescriptor.GetEvents(Me, attributes, True)
    End Function

    <Description("Returns the wrapped object.")> _
    Public Function GetPropertyOwner(ByVal pd As System.ComponentModel.PropertyDescriptor) As Object _
           Implements System.ComponentModel.ICustomTypeDescriptor.GetPropertyOwner
        Return Me
    End Function

    <Description("Returns the list of properties as defined in the constructor")> _
    Public Overloads Function GetProperties() As System.ComponentModel.PropertyDescriptorCollection _
           Implements System.ComponentModel.ICustomTypeDescriptor.GetProperties
        Dim pd As PropertyDescriptorCollection = TypeDescriptor.GetProperties(Me, True)
        Return FilterProperties(pd)
    End Function

    <Description("Returns the list of properties as defined in the constructor")> _
    Public Overloads Function GetProperties(ByVal attributes() As System.Attribute) As System.ComponentModel.PropertyDescriptorCollection _
           Implements System.ComponentModel.ICustomTypeDescriptor.GetProperties
        Dim pd As PropertyDescriptorCollection = TypeDescriptor.GetProperties(Me, attributes, True)
        Return FilterProperties(pd)
    End Function

#End Region

    '==============================================================================================

#Region "Designer"
     Public Class Designer
        Inherits System.Windows.Forms.Design.ControlDesigner

        Private HostControl As RMValueDisplay = Nothing

        Public Overrides Sub Initialize(ByVal component As System.ComponentModel.IComponent)
            MyBase.Initialize(component)

            HostControl = DirectCast(component, RMValueDisplay)
        End Sub

        ' hier werden nur für die Designer-Sicht zusätzliche Properties hinzugefügt oder vorhandene entfernt
        Protected Overrides Sub PreFilterProperties(ByVal properties As System.Collections.IDictionary)
            MyBase.PreFilterProperties(properties)

            properties.Remove("AccessibleDescription")
            properties.Remove("AccessibleName")
            properties.Remove("AccessibleRole")
            properties.Remove("ApplicationSettings")
            properties.Remove("DataBindings")

            properties.Remove("ContextMenuStrip")
            properties.Remove("GenerateMember")
            properties.Remove("Locked")

        End Sub


        Public Overrides ReadOnly Property SnapLines As System.Collections.IList
            Get
                Dim snaps As ArrayList = New ArrayList(MyBase.SnapLines)
                snaps.Add(New SnapLine(SnapLineType.Horizontal, Me.Control.Height \ 2))
                snaps.Add(New SnapLine(SnapLineType.Vertical, Me.Control.Width \ 2))
                Return snaps
            End Get
        End Property




        ' schaltet im Design-Modus die Maus-Cursor-Darstellung um
        Protected Overrides Sub OnSetCursor()
            Dim myPoint As Point = HostControl.PointToClient(Cursor.Position)

            If inShiftPosition(myPoint) > 0 Then
                If Dragging_Aktiv Then
                    Cursor.Current = Cursors.Arrow
                Else
                    Cursor.Current = Cursors.SizeWE
                    'Cursor.Current = Cursors.VSplit
                End If
            Else
                MyBase.OnSetCursor()
            End If
        End Sub

        ''' <summary>
        ''' gibt den Übergang an dem sich die Maus aktuell befindet zurück
        ''' 0 = kein Übergang
        ''' 1 = Übergang zwischen Beschreibung und Wert
        ''' 2 = Übergang zwischen Wert und Einheit
        ''' </summary>
        ''' <param name="p"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Private Function inShiftPosition(ByVal p As Point) As Integer

            If HostControl IsNot Nothing AndAlso HostControl.Activated Then
                If (p.X >= HostControl.SpaltenTrenner.Pos1 - Dragging_ShiftHysterese) AndAlso (p.X <= HostControl.SpaltenTrenner.Pos1 + Dragging_ShiftHysterese) Then
                    Return 1
                ElseIf (p.X >= HostControl.SpaltenTrenner.Pos2 - Dragging_ShiftHysterese) AndAlso (p.X <= HostControl.SpaltenTrenner.Pos2 + Dragging_ShiftHysterese) Then
                    Return 2
                Else
                    Return 0
                End If
            Else
                Return 0
            End If

        End Function

        Private Dragging_ShiftHysterese As Integer = 3
        Private Dragging_Aktiv As Boolean = False
        Private Dragging_ShiftPoint As Integer = 0
        Private Dragging_Offset As Integer = 0


        ' ggf. Start der Verschiebung der Elemente im Control
        Protected Overrides Sub OnMouseDragBegin(ByVal x As Integer, ByVal y As Integer)
            If HostControl Is Nothing Then Exit Sub
            Dim myPoint As Point = HostControl.PointToClient(New Point(x, y))
            Dragging_ShiftPoint = inShiftPosition(myPoint)

            If Dragging_ShiftPoint = 1 Then
                Dragging_Offset = HostControl.SpaltenTrenner.Pos1 - myPoint.X
                Dragging_Aktiv = True
            ElseIf Dragging_ShiftPoint = 2 Then
                Dragging_Offset = HostControl.SpaltenTrenner.Pos2 - myPoint.X
                Dragging_Aktiv = True
            Else
                MyBase.OnMouseDragBegin(x, y)
            End If
        End Sub

        ' wenn Dragging aktiv ist dann können die Übergänge verschoben werden
        Protected Overrides Sub OnMouseDragMove(ByVal x As Integer, ByVal y As Integer)
            If HostControl Is Nothing Then Exit Sub
            Dim myPoint As Point = HostControl.PointToClient(New Point(x, y))

            If Dragging_Aktiv Then
                If Dragging_ShiftPoint = 1 Then
                    HostControl.SpaltenTrenner.Pos1 = myPoint.X + Dragging_Offset
                ElseIf Dragging_ShiftPoint = 2 Then
                    HostControl.SpaltenTrenner.Pos2 = myPoint.X + Dragging_Offset
                End If
            Else
                MyBase.OnMouseDragMove(x, y)
            End If
        End Sub

        ' Dragging beendet
        Protected Overrides Sub OnMouseDragEnd(ByVal cancel As Boolean)
            Dragging_Aktiv = False

            MyBase.OnMouseDragEnd(cancel)
        End Sub

        ' zeichnen der Umrandungs-Linien für die Bereiche
        Protected Overrides Sub OnPaintAdornments(ByVal pe As System.Windows.Forms.PaintEventArgs)

            If HostControl Is Nothing Then Exit Sub

            If HostControl.Activated Then
                Dim borderPen As New Pen(HostControl.ForeColor)
                If HostControl.BackColor = Color.Transparent Then borderPen = New Pen(HostControl.Parent.ForeColor)
                borderPen.DashStyle = Drawing2D.DashStyle.Dash
                pe.Graphics.DrawRectangle(borderPen, 0, 0, HostControl.SpaltenTrenner.Pos1 - 1, HostControl.Height - 1)
                pe.Graphics.DrawRectangle(borderPen, HostControl.SpaltenTrenner.Pos1 + 1, 0, HostControl.SpaltenTrenner.Pos2 - HostControl.SpaltenTrenner.Pos1 - 2, HostControl.Height - 1)
                pe.Graphics.DrawRectangle(borderPen, HostControl.SpaltenTrenner.Pos2 + 1, 0, HostControl.Width - HostControl.SpaltenTrenner.Pos2 - 2, HostControl.Height - 1)

                borderPen.Dispose()
            Else
                If (HostControl.BackColor = Color.Transparent) Then
                    Dim borderPen As New Pen(HostControl.ForeColor)
                    If HostControl.BackColor = Color.Transparent Then borderPen = New Pen(HostControl.Parent.ForeColor)
                    borderPen.DashStyle = Drawing2D.DashStyle.Dash
                    pe.Graphics.DrawRectangle(borderPen, 0, 0, HostControl.Width - 1, HostControl.Height - 1)

                    borderPen.Dispose()
                End If
            End If

            MyBase.OnPaintAdornments(pe)
        End Sub

    End Class

#End Region

End Class

Protected Overrides Sub OnPaintAdornments(ByVal pe As System.Windows.Forms.PaintEventArgs)

     If HostControl Is Nothing Then Exit Sub

         Dim borderPen As New Pen(HostControl.ForeColor)
         borderPen.DashStyle = Drawing2D.DashStyle.Dash
         pe.Graphics.DrawRectangle(borderPen, 0, 0, HostControl.SpaltenTrenner.Pos1 - 1, HostControl.Height - 1)
         pe.Graphics.DrawRectangle(borderPen, HostControl.SpaltenTrenner.Pos1 + 1, 0, HostControl.SpaltenTrenner.Pos2 - HostControl.SpaltenTrenner.Pos1 - 2, HostControl.Height - 1)
         pe.Graphics.DrawRectangle(borderPen, HostControl.SpaltenTrenner.Pos2 + 1, 0, HostControl.Width - HostControl.SpaltenTrenner.Pos2 - 2, HostControl.Height - 1)

         borderPen.Dispose()

     MyBase.OnPaintAdornments(pe)
 End Sub

Public Class myControlDesigner
     Inherits System.Windows.Forms.Design.ControlDesigner

     Private HostControl As RMWertAnzeigeValue2 = Nothing

     Public Overrides Sub Initialize(ByVal component As System.ComponentModel.IComponent)
         MyBase.Initialize(component)

         HostControl = DirectCast(component, RMWertAnzeigeValue2)
     End Sub


     ' schaltet im Design-Modus die Maus-Cursor-Darstellung um
     Protected Overrides Sub OnSetCursor()
         Dim myPoint As Point = HostControl.PointToClient(Cursor.Position)

         If inShiftPosition(myPoint) > 0 Then
             If Dragging_Aktiv Then
                 Cursor.Current = Cursors.Arrow
             Else
                 Cursor.Current = Cursors.SizeWE
             End If
         Else
             MyBase.OnSetCursor()
         End If
     End Sub

     ''' <summary>
     ''' gibt den Übergang an dem sich die Maus aktuell befindet zurück
     ''' 0 = kein Übergang
     ''' 1 = Übergang zwischen Beschreibung und Wert
     ''' 2 = Übergang zwischen Wert und Einheit
     ''' </summary>
     ''' <param name="p"></param>
     ''' <returns></returns>
     ''' <remarks></remarks>
     Private Function inShiftPosition(ByVal p As Point) As Integer

         If HostControl IsNot Nothing AndAlso HostControl.Activated Then
             If (p.X >= HostControl.SpaltenTrenner.Pos1 - Dragging_ShiftHysterese) AndAlso (p.X <= HostControl.SpaltenTrenner.Pos1 + Dragging_ShiftHysterese) Then
                 Return 1
             ElseIf (p.X >= HostControl.SpaltenTrenner.Pos2 - Dragging_ShiftHysterese) AndAlso (p.X <= HostControl.SpaltenTrenner.Pos2 + Dragging_ShiftHysterese) Then
                 Return 2
             Else
                 Return 0
             End If
         Else
             Return 0
         End If

     End Function

     Private Dragging_ShiftHysterese As Integer = 3
     Private Dragging_Aktiv As Boolean = False
     Private Dragging_ShiftPoint As Integer = 0
     Private Dragging_Offset As Integer = 0


     ' ggf. Start der Verschiebung der Elemente im Control
     Protected Overrides Sub OnMouseDragBegin(ByVal x As Integer, ByVal y As Integer)
         If HostControl Is Nothing Then Exit Sub
         Dim myPoint As Point = HostControl.PointToClient(New Point(x, y))
         Dragging_ShiftPoint = inShiftPosition(myPoint)

         If Dragging_ShiftPoint = 1 Then
             Dragging_Offset = HostControl.SpaltenTrenner.Pos1 - myPoint.X
             Dragging_Aktiv = True
         ElseIf Dragging_ShiftPoint = 2 Then
             Dragging_Offset = HostControl.SpaltenTrenner.Pos2 - myPoint.X
             Dragging_Aktiv = True
         Else
             MyBase.OnMouseDragBegin(x, y)
         End If
     End Sub

     ' wenn Dragging aktiv ist dann können die Übergänge verschoben werden
     Protected Overrides Sub OnMouseDragMove(ByVal x As Integer, ByVal y As Integer)
         If HostControl Is Nothing Then Exit Sub
         Dim myPoint As Point = HostControl.PointToClient(New Point(x, y))

         If Dragging_Aktiv Then
             If Dragging_ShiftPoint = 1 Then
                 HostControl.SpaltenTrenner.Pos1 = myPoint.X + Dragging_Offset
             ElseIf Dragging_ShiftPoint = 2 Then
                 HostControl.SpaltenTrenner.Pos2 = myPoint.X + Dragging_Offset
             End If
         Else
             MyBase.OnMouseDragMove(x, y)
         End If
     End Sub

     ' Dragging beendet
     Protected Overrides Sub OnMouseDragEnd(ByVal cancel As Boolean)
         Dragging_Aktiv = False

         MyBase.OnMouseDragEnd(cancel)
     End Sub

 End Class

<pre>Public Class Form1

    Dim chan As Integer = 0

    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles Me.Load
        Dim list As String() = Jazz.MidiOutList()
        For Each s In list
            Out.Items.Add(s)
        Next s
        Out.SelectedIndex = 0
        tone.SelectedIndex = 0
        Channel.SelectedIndex = 0
    End Sub

    Private Sub Out_SelectedIndexChanged(sender As Object, e As EventArgs) Handles Out.SelectedIndexChanged
        Jazz.MidiOutOpen(Out.SelectedItem)
    End Sub

    Private Sub Channel_SelectedIndexChanged(sender As Object, e As EventArgs) Handles Channel.SelectedIndexChanged
        chan = Channel.SelectedIndex
    End Sub

    Private Function Note(ByVal obj As System.Object)
        If ReferenceEquals(obj, Button1) Then
            Return 53
        ElseIf ReferenceEquals(obj, Button2) Then
            Return 55
        End If
        Return 0
    End Function

    Private Sub ToneChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles tone.SelectedIndexChanged
        Jazz.MidiOut(&HC0 + chan, tone.SelectedIndex, 0)
    End Sub

    Private Sub Down(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Button1.MouseDown, Button2.MouseDown
        Jazz.MidiOut(&H90 + chan, Note(sender), 100)
    End Sub

    Private Sub Up(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Button1.MouseUp, Button2.MouseUp
        Jazz.MidiOut(&H80 + chan, Note(sender), 0)
    End Sub

End Class

<pre>    Private Sub ToneChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles tone.SelectedIndexChanged
        Jazz.MidiOut(&HC0 + chan, tone.SelectedIndex, 0)
    End Sub

    Private Sub Down(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Button1.MouseDown, Button2.MouseDown
        Jazz.MidiOut(&H90 + chan, Note(sender), 100)
    End Sub

    Private Sub Up(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Button1.MouseUp, Button2.MouseUp
        Jazz.MidiOut(&H80 + chan, Note(sender), 0)
    End Sub

Alienoiz wrote:

and its returnning the errors on these lines:

Severity	Code	Description	Project	File	Line	Suppression State
Error	BC30311	Value of type 'Integer' cannot be converted to 'Object()'.	WindowsApplication1	C:\Users\beata\Documents\Visual Studio 2015\Projects\WindowsApplication1\WindowsApplication1\Form1.vb	35	Active
Error	BC30057	Too many arguments to 'Public Overridable Overloads Sub MidiOut([in] As Object())'.	WindowsApplication1	C:\Users\beata\Documents\Visual Studio 2015\Projects\WindowsApplication1\WindowsApplication1\Form1.vb	35	Active

STOPAllMIDINotes()

<pre>    Public Declare Function midiInGetNumDevs Lib "winmm.dll" () As Integer
    Public Declare Function midiInGetDevCaps Lib "winmm.dll" Alias "midiInGetDevCapsA" (ByVal uDeviceID As Integer, ByRef lpCaps As MIDIINCAPS, ByVal uSize As Integer) As Integer
    Public Declare Function midiInOpen Lib "winmm.dll" (ByRef hMidiIn As Integer, ByVal uDeviceID As Integer, ByVal dwCallback As MidiInCallback, ByVal dwInstance As Integer, ByVal dwFlags As Integer) As Integer
    Public Declare Function midiInStart Lib "winmm.dll" (ByVal hMidiIn As Integer) As Integer
    Public Declare Function midiInStop Lib "winmm.dll" (ByVal hMidiIn As Integer) As Integer
    Public Declare Function midiInReset Lib "winmm.dll" (ByVal hMidiIn As Integer) As Integer
    Public Declare Function midiInClose Lib "winmm.dll" (ByVal hMidiIn As Integer) As Integer

    Public Delegate Function MidiInCallback(ByVal hMidiIn As Integer, ByVal wMsg As UInteger, ByVal dwInstance As Integer, ByVal dwParam1 As Integer, ByVal dwParam2 As Integer) As Integer
    Public ptrCallback As New MidiInCallback(AddressOf MidiInProc)
    Public Const CALLBACK_FUNCTION As Integer = &H30000
    Public Const MIDI_IO_STATUS = &H20

    Public Delegate Sub DisplayDataDelegate(dwParam1)

    Public Structure MIDIINCAPS
        Dim wMid As Int16 ' Manufacturer ID
        Dim wPid As Int16 ' Product ID
        Dim vDriverVersion As Integer ' Driver version
        <MarshalAs(UnmanagedType.ByValTStr, SizeConst:=32)> Dim szPname As String ' Product Name
        Dim dwSupport As Integer ' Reserved
    End Structure

    Dim hMidiIn As Integer
    Dim DataByte1 As Byte

    Dim m As New clsMIDI

    Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
        FillInstrumentCombo()
        If midiInGetNumDevs() = 0 Then
            MsgBox("No MIDI devices connected")
            Application.Exit()
        End If

        Dim InCaps As New MIDIINCAPS
        Dim DevCnt As Integer

        For DevCnt = 0 To (midiInGetNumDevs - 1)
            midiInGetDevCaps(DevCnt, InCaps, Len(InCaps))
            ComboBox1.Items.Add(InCaps.szPname)
        Next DevCnt

        midiInStart(hMidiIn)
    End Sub


    Function MidiInProc(ByVal hMidiIn As Integer, ByVal wMsg As UInteger, ByVal dwInstance As Integer, ByVal dwParam1 As Integer, ByVal dwParam2 As Integer) As Integer
        DataByte1 = (dwParam1 And &HFF00) >> 8
        m.PlayMIDINote(DataByte1, 127)
        m.STOPAllMIDINotes()
    End Function

    Private Sub ComboBox1_SelectedIndexChanged(sender As System.Object, e As System.EventArgs) Handles ComboBox1.SelectedIndexChanged
        Dim DeviceID As Integer = ComboBox1.SelectedIndex
        midiInOpen(hMidiIn, DeviceID, ptrCallback, 0, CALLBACK_FUNCTION Or MIDI_IO_STATUS)
        midiInStart(hMidiIn)
    End Sub

    Private Sub Form1_Closed(sender As Object, e As EventArgs) Handles Me.Closed
        midiInStop(hMidiIn)
        midiInReset(hMidiIn)
        midiInClose(hMidiIn)
        Application.Exit()
    End Sub

<pre>Public Class Form1
    Dim m As New clsMIDI
    Dim hMidiIn As Integer

    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load

        FillInstrumentCombo()

        If midiInGetNumDevs() = 0 Then
            MsgBox("No MIDI devices connected")
        End If

        Dim InCaps As New MIDIINCAPS
        Dim DevCnt As Integer

        For DevCnt = 0 To (midiInGetNumDevs - 1)
            midiInGetDevCaps(DevCnt, InCaps, Len(InCaps))
            ComboBox1.Items.Add(InCaps.szPname)
        Next DevCnt

        midiInStart(hMidiIn)
    End Sub

    Private Sub Form1_Closed(sender As Object, e As EventArgs) Handles Me.Closed
        midiInStop(hMidiIn)
        midiInReset(hMidiIn)
        midiInClose(hMidiIn)
    End Sub

    Private Sub ComboBox1_SelectedIndexChanged(sender As Object, e As EventArgs) Handles ComboBox1.SelectedIndexChanged
        Dim DeviceID As Integer = ComboBox1.SelectedIndex
        midiInOpen(hMidiIn, DeviceID, AddressOf MidiInProc, 0, CALLBACK_FUNCTION)
        midiInStart(hMidiIn)
    End Sub

    Private Sub FillInstrumentCombo()
        For i = 0 To 128
            cboInstruments.Items.Add(Instrument.GMInstrumentNames(i))
        Next
        cboInstruments.SelectedIndex = 0
    End Sub

    Private Sub cboInstruments_SelectedIndexChanged(sender As Object, e As EventArgs) Handles cboInstruments.SelectedIndexChanged
        m.CurrentInstrument = cboInstruments.Text
    End Sub

    Private Sub hsbVolume_ValueChanged(sender As Object, e As EventArgs) Handles hsbVolume.ValueChanged
        m.Volume = hsbVolume.Value
    End Sub

    Function MidiInProc(ByVal hMidiIn As Integer, ByVal wMsg As UInteger, ByVal dwInstance As Integer, ByVal dwParam1 As Integer, ByVal dwParam2 As Integer) As Integer
        Dim DataByte1 = (dwParam1) >> 8
        m.PlayMIDINote(DataByte1, 127)
        m.NoteDuration = CInt(cboduration.Text)
        m.Pan = 50
    End Function

End Class

midiInOpen(hMidiIn, DeviceID, AddressOf MidiInProc, 0, CALLBACK_FUNCTION)

m.NoteDuration = CInt(cboduration.Text)

m.NoteDuration = duration