Die Community zu .NET und Classic VB.
Menü

Tipp-Upload: VB.NET 0252: MCI-Player

 von 

Über den Tipp  

Dieser Tippvorschlag ist noch unbewertet.

Der Vorschlag ist in den folgenden Kategorien zu finden:

  • Multimedia
  • Sonstiges
  • Steuerelemente

Dem Tippvorschlag wurden folgende Schlüsselwörter zugeordnet:
mci,mcisendstring,mcisendcommand,binding,databinding

Der Vorschlag wurde erstellt am: 11.04.2008 01:28.
Die letzte Aktualisierung erfolgte am 09.07.2009 11:14.

Zurück zur Übersicht

Beschreibung  

Kleiner Media-Player, basierend auf der mciSendString()-API. Eine Offline-Doku für mcsSendString findet sich auf meinem System unter: ms-help://MS.VSCC.v80/MS.MSDN.v80/MS.WIN32COM.v10.en/multimed/htm/_win32_classifications_of_mci_commands.htm - Ich weiß aber nicht, inwieweit das zu verallgemeinern ist.
Die wechselseitige Kommunikation zwischen Player und Steuerelementen basiert auf Databinding
Außerdem ein UserControl in Funktion einer beschrifteten Trackbar

Schwierigkeitsgrad

Schwierigkeitsgrad 3

Verwendete API-Aufrufe:

GetShortPathName (GetShortPathNameA), mciGetErrorString (mciGetErrorStringA), mciSendString (mciSendStringA)

Download:

Download des Beispielprojektes [95,03 KB]

' Dieser Source stammt von http://www.activevb.de
' und kann frei verwendet werden. Für eventuelle Schäden
' wird nicht gehaftet.

' Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
' Ansonsten viel Spaß und Erfolg mit diesem Source!
'
' Beachten Sie, das vom Designer generierter Code hier ausgeblendet wird.
' In den Zip-Dateien ist er jedoch zu finden.

' ------------ Anfang Projektgruppe MCIPlayer.sln ------------
' ----------- Anfang Projektdatei MCIPlayer.vbproj -----------
' ------------------ Anfang Datei ApiBuf.vb ------------------
' IDE-Voreinstellungen:
' Option Explicit On
' Option Strict On

' "My Project"-Einstellungen:
' Imports Microsoft.VisualBasic.ControlChars
' Imports System.Windows.Forms

Imports system.Text
''' <summary>
''' vereinfacht das Verfahren, aus der API Strings zu ermitteln
''' </summary>
Public Class ApiBuf

    Public Shared ReadOnly Singleton As New ApiBuf

    Private ReadOnly SB As New StringBuilder

    Public ReadOnly Length As Integer = 256

    Private Sub New()

    End Sub

    Public ReadOnly Property ToApi() As StringBuilder
        Get
            SB.Append(New String(NullChar, Length - SB.Length))
            Return SB

        End Get

    End Property

    Public ReadOnly Property Result() As String
        Get
            Return SB.ToString

        End Get

    End Property

    Public ReadOnly Property Success() As Boolean
        Get
            Return SB.Length > 0

        End Get

    End Property

#Region "nützliches Anwendungsbeispiel"

    Private Declare Function GetShortPathName Lib "kernel32" _
                             Alias "GetShortPathNameA" ( _
                             ByVal LongPath As String, _
                             ByVal AnswerBuffer As StringBuilder, _
                             ByVal BufferLength As Integer) As Integer

    ''' <summary>
    ''' gibt die kurze Version eines langen Dateinamens zurück ( einige APIs können keine langen
    ''' Dateinamen verarbeiten )
    ''' </summary>
    Public Shared Function ShortPathName(ByVal LongPath As String) As String

        With ApiBuf.Singleton
            GetShortPathName(LongPath, .ToApi, .Length)

            If .Success Then Return .Result
            If Not (IO.File.Exists(LongPath)) Then
                Throw New System.IO.FileNotFoundException(LongPath)
            End If

            If Not (IO.Directory.Exists(LongPath)) Then
                Throw New System.IO.DirectoryNotFoundException(LongPath)
            End If

            Throw New Exception("Erstellung eines DOS-Namens aus '" & LongPath & "' nicht möglich!")
        End With

    End Function

#End Region ' nützliches Anwendungsbeispiel

End Class

' ------------------- Ende Datei ApiBuf.vb -------------------
' ------------------ Anfang Datei Player.vb ------------------
Imports System.ComponentModel
Imports System.Text

Public Class Player

    Inherits Control

    ' Implementierung von INotifyPropertyChanged macht den Player DataBinding-fähig.
    ' Ich kann also Änderungen von IsPlaying und Position per PropertyChanged-Event melden.
    Implements INotifyPropertyChanged

    Public Event PropertyChanged(ByVal sender As Object, ByVal e As PropertyChangedEventArgs) _
        Implements INotifyPropertyChanged.PropertyChanged

    Private _Current As String = Nothing
    Private _Position As Integer
    Private _RightVolume As Integer = 1000
    Private _LeftVolume As Integer = 1000
    Private _IsPlaying As Boolean
    Private _Length As Integer

    Private _ID As String = Guid.NewGuid.ToString

    ' nicht abspielen kanner: .mid, .mp4, .ogg, .wav
    Private Shared _KnownMedia As IList(Of String) = New String() { ".wma", ".mp3", _
        ".asf", ".wmv", ".avi", ".qt", ".mov", ".mpg", ".mpeg"}

    Public Shared Function CanPlay(ByVal File As String) As Boolean

        Return _KnownMedia.Contains(IO.Path.GetExtension(File).ToLower)

    End Function

    Public Sub New()

        InitializeComponent()
        MyBase.Visible = False

    End Sub

    Public ReadOnly Property Length() As Integer
        Get
            Return _Length

        End Get

    End Property

    Protected Overrides Sub OnPaint(ByVal e As PaintEventArgs)

        ' nur, um Sichtbarkeit im Designer zu gewährleisten
        MyBase.OnPaint(e)

        With Me
            e.Graphics.DrawString(.Text, .Font, Brushes.Black, Point.Empty)
        End With

    End Sub

    Public Property IsPlaying() As Boolean
        Get
            Return _IsPlaying

        End Get

        Set(ByVal NewValue As Boolean)

            If Not AssignSave(_IsPlaying, NewValue) Then Return
            If _IsPlaying Then
                Play()

            Else

                [Stop]()
            End If

            RaiseEvent PropertyChanged(Me, New PropertyChangedEventArgs("IsPlaying"))

        End Set

    End Property

    Public Property Current() As String
        Get
            Return _Current

        End Get

        Set(ByVal NewValue As String)

            If _Current = NewValue Then Return
            If Not String.IsNullOrEmpty(_Current) Then Close()
            _Current = NewValue

            If Not String.IsNullOrEmpty(_Current) Then Open(_Current)

        End Set

    End Property

    Public Property LeftVolume() As Integer
        Get
            Return _LeftVolume

        End Get

        Set(ByVal NewValue As Integer)

            If AssignSave(_LeftVolume, NewValue) Then LeftVolSet(_LeftVolume)

        End Set

    End Property

    Public Property RightVolume() As Integer
        Get
            Return _RightVolume

        End Get

        Set(ByVal NewValue As Integer)

            If AssignSave(_RightVolume, NewValue) Then RightVolSet(_RightVolume)

        End Set

    End Property

    Public Property Position() As Integer
        Get
            Return _Position

        End Get

        Set(ByVal NewValue As Integer)

            If Not AssignSave(_Position, NewValue) Then Return
            PositionSet(_Position)

            If _IsPlaying Then Play()
            RaiseEvent PropertyChanged(Me, New PropertyChangedEventArgs("Position"))

        End Set

    End Property

    Protected Overrides Sub Dispose(ByVal disposing As Boolean)

        If _Current IsNot Nothing Then
            ExecuteMCI("close", _ID) ' MCI schließen
            _Current = Nothing
        End If

        If disposing Then
            If components IsNot Nothing Then
                components.Dispose()
                components = Nothing
            End If
        End If

        MyBase.Dispose(disposing)

    End Sub

    Private Enum MCI_NOTIFY As Integer
        ABORTED = &H4
        FAILURE = &H8
        SUCCESSFUL = &H1
        SUPERSEDED = &H2
    End Enum

    Protected Overrides Sub WndProc(ByRef m As Message)

        ' Bei MCI-Device-Meldung "Abspielende erreicht" den Player zurücksetzen
        Const msgMCI_NOTIFY As Integer = &H3B9
        MyBase.WndProc(m)

        If m.Msg = msgMCI_NOTIFY Then
            If m.WParam.ToInt32() = MCI_NOTIFY.SUCCESSFUL Then
                Me.IsPlaying = False
                Me.Position = 0
            End If
        End If

    End Sub

#Region "ExecuteMCI"

    ' Die Syntax des CommandTexts von mciSendString() läßt sich (hoffentlich) anhand der Aufrufe
    ' von ExecuteMCI() ungefähr erahnen. Beachten Sie v.a. die Ausgabe im Ausgabe- Fenster

    Public Declare Function mciSendString Lib "winmm.dll" _
                            Alias "mciSendStringA" ( _
                            ByVal lpstrCommand As String, _
                            ByVal lpstrReturnString As StringBuilder, _
                            ByVal uReturnLength As Integer, _
                            ByVal hwndCallback As IntPtr) As Integer

    Private Declare Function mciGetErrorString Lib "winmm" _
                             Alias "mciGetErrorStringA" ( _
                             ByVal fdwError As Integer, _
                             ByVal lpszErrorText As StringBuilder, _
                             ByVal cchErrorText As Integer) As Integer

    Private Function ExecuteMCI(ByVal ParamArray Elements() As Object) As String

        ' Der MCI-Commandtext wird gebildet durch Aneinanderhängen der Elemente
        Dim CommandText As String = StrJoin(Elements)

        With ApiBuf.Singleton

            Try

                Dim ErrorCode As Integer = mciSendString(CommandText, .ToApi, .Length, Me.Handle)

                If ErrorCode = 0 Then Return .Result
                mciGetErrorString(ErrorCode, .ToApi, .Length)

                Throw XException.Sender(Me)("Fehler mit folgendem Command:\n'", CommandText, _
                    "'\nFehler ", ErrorCode, ": ", .Result)

            Finally

                ' CommandText und ggfs. Ergebnis-String des mciSendString()-Aufrufs ausgeben
                DBG("Command: ", CommandText, Tab, Tab, "Result: ", .Result)

            End Try
        End With

    End Function

    Private Sub Open(ByVal Path As String)

        ' Der open-CommandText ist bes. wichtig: Hier wird der Pfad gegeben, und eine ID, unter
        ' ! der weitere Commands diesen Abspielvorgang identifizieren. Außerdem ein Window-Handle,
        ' ! an welches der Media- Device  Nachrichten senden kann, die dann in WndProc() empfangen
        ' ! werden.
        ExecuteMCI("open", """" & Path & """", "alias", _ID, "parent", Me.Handle)
        ExecuteMCI("set", _ID, "time format milliseconds")
        _Length = Integer.Parse(ExecuteMCI("status", _ID, "length"))
        Me.Position = 0
        LeftVolSet(_LeftVolume)
        RightVolSet(_RightVolume)

    End Sub

    Private Sub Close()

        IsPlaying = False
        ExecuteMCI("close", _ID)
        _Current = Nothing

    End Sub

    Private Sub Play()

        ExecuteMCI("play", _ID, "notify")
        Timer1.Start()

    End Sub

    Private Sub [Stop]()

        ExecuteMCI("stop", _ID)
        Timer1.Stop()

    End Sub

    Private Sub Timer1_Tick(ByVal sender As Object, ByVal e As EventArgs) Handles Timer1.Tick

        ' sekündlich die Position updaten
        _Position = Integer.Parse(ExecuteMCI("status", _ID, "position"))
        RaiseEvent PropertyChanged(Me, New PropertyChangedEventArgs("Position"))

    End Sub

    Private Sub PositionSet(ByVal Value As Integer)

        ExecuteMCI("seek", _ID, "to", Value)

    End Sub

    Private Sub RightVolSet(ByVal Value As Integer)

        ExecuteMCI("setaudio", _ID, "right volume to", Value)

    End Sub

    Private Sub LeftVolSet(ByVal Value As Integer)

        ExecuteMCI("setaudio", _ID, "left volume to", Value)

    End Sub

#Region "Hier nicht verwendete MCI-Commands"

    Private Sub VolumeSet(ByVal Value As Integer)

        ' unbrauchbar: setzt leider beide Kanäle gleich
        ExecuteMCI("setaudio", _ID, "volume to", Value)

    End Sub

    Private Function VolumeGet() As Integer

        Return Integer.Parse(ExecuteMCI("status", _ID, "volume"))

    End Function

    Private Function RightVolGet() As Integer

        Return Integer.Parse(ExecuteMCI("status", _ID, "right volume"))

    End Function

    Private Function LeftVolGet() As Integer

        Return Integer.Parse(ExecuteMCI("status", _ID, "left volume"))

    End Function

#End Region ' Hier nicht verwendete MCI-Commands

#End Region ' ExecuteMCI

End Class

' ------------------- Ende Datei Player.vb -------------------
' --------------- Anfang Datei frmMCIPlayer.vb ---------------
Imports System.ComponentModel

''' <summary>experimenteller Media-Player. Medien-Anwahl durch Droppen aufs Form</summary>
Public Class frmMCIPlayer

    Private _SelectedFile As String

    Private Sub frmMCIPlayer_Shown(ByVal sender As Object, ByVal e As EventArgs) Handles Me.Shown

        EnableDragDrop(Me)

        ' Die Eigenschaften Position und IsPlaying des Players ändern sich während des Abspielens.
        ' ! Insbesondere hierfür ist die Steuerung per DataBinding günstiger als die Steuerung per
        ' ! Eventhandling, da Databinding wechselseitig wirken kann.
        PropBind(scrPosition, "Value", Player1, "Position")
        PropBind(scrLeftVolume, "Value", Player1, "LeftVolume")
        PropBind(scrRightVolume, "Value", Player1, "RightVolume")
        PropBind(ckIsPlaying, "Checked", Player1, "IsPlaying")
        _SelectedFile = "..\..\Begruessung.mp3"

        If IO.File.Exists(_SelectedFile) Then LoadSelected(False)

    End Sub

    Private Function PropBind( _
                ByVal Ctl As IBindableComponent, _
                ByVal [Property] As String, _
                ByVal Datasource As INotifyPropertyChanged, _
                ByVal DataMember As String) As Binding

        Return Ctl.DataBindings.Add([Property], Datasource, DataMember, False, _
            DataSourceUpdateMode.OnPropertyChanged)

    End Function

    Private Sub EnableDragDrop(ByVal Ctl As Control)

        ' aktiviert die DragDrop-Verarbeitung für alle Controls
        If Not Ctl.Visible Then Return
        Ctl.AllowDrop = True
        AddHandler Ctl.DragDrop, AddressOf Control_Drop
        AddHandler Ctl.DragEnter, AddressOf Control_DragEnter

        For Each Child As Control In Ctl.Controls
            EnableDragDrop(Child)
        Next

    End Sub

    Private Sub Control_DragEnter(ByVal sender As Object, ByVal e As DragEventArgs)

        Dim DTO As DataObject = DirectCast(e.Data, DataObject)

        _SelectedFile = Nothing

        If DTO.ContainsFileDropList Then

            For Each File As String In DTO.GetFileDropList

                If Player.CanPlay(File) Then

                    ' Erstbestes abspielbares File vormerken - keine Wiedergabelisten-Verwaltung
                    _SelectedFile = File
                    e.Effect = DragDropEffects.Move
                    Return
                End If

            Next

        End If

    End Sub

    Private Sub Control_Drop(ByVal sender As Object, ByVal e As DragEventArgs)

        ' Während des Droppens ausgelöste Fehler kann die IDE nicht richtig debuggen.
        ' Daher Entkoppelung per Application.Idle
        AddHandler Application.Idle, AddressOf Application_Idle

    End Sub

    Private Sub Application_Idle(ByVal sender As Object, ByVal e As EventArgs)

        ' Application.Idle wird gefeuert, bevor die Anwendung in die Warteschleife zurückfällt
        RemoveHandler Application.Idle, AddressOf Application_Idle
        LoadSelected(True)

    End Sub

    Private Sub LoadSelected(ByVal Start As Boolean)

        For Each Ctl As Control In New Control() { ckIsPlaying, scrPosition, scrLeftVolume, _
            scrRightVolume}

            Ctl.Enabled = True
        Next

        ckIsPlaying.Focus()

        Dim S As String = IO.Path.GetFullPath(_SelectedFile)

        Me.Text = String.Concat(IO.Path.GetFileName(S), " (", S, ")")
        Player1.Current = _SelectedFile
        Me.scrPosition.Maximum = Me.Player1.Length
        Player1.IsPlaying = Start

    End Sub

End Class

' ---------------- Ende Datei frmMCIPlayer.vb ----------------
' ---------------- Anfang Datei modHelpers.vb ----------------
Imports System.Text.RegularExpressions

Public Module modHelpers

    Public Function CreateUnescapeRegex(ByVal Pattern As String) As Regex

        ' der vorangestellte Pattern schließt escaped Matches ('\X' etc.) aus
        Return New Regex("(?<=(^|[^\\](\\\\)*))" & Pattern, RegexOptions.Compiled)

    End Function

    Private _LineFeedRegex As Regex = CreateUnescapeRegex("\\n")

    '''<summary>verkettet Args, wandelt \n in ControlChars.CrLf um</summary>
    ''' <example>
    ''' Debug.WriteLine(StrConcat("Die Datei\n", "XY.txt", "\nkonnte nicht gefunden werden"))
    ''' </example>
    Public Function StrConcat(ByVal ParamArray Args As Object()) As String

        Dim Texts(Args.Length - 1) As String
        Dim Interprete As Boolean = True

        For I As Integer = 0 To Args.Length - 1

            If Args(I) Is Nothing Then
                Texts(I) = "NULL"

            Else

                If Interprete Then

                    ' Newlines einfügen
                    Texts(I) = _LineFeedRegex.Replace(Args(I).ToString, CrLf)
                Else

                    Texts(I) = Args(I).ToString
                    Interprete = True
                End If

                If Texts(I).EndsWith("\x") Then ' auf Interprete-Next-Off - Schalter testen

                    ' Schalter-Token verschwinden lassen
                    Texts(I) = Texts(I).Substring(0, Texts(I).Length - 2)
                    Interprete = False
                End If
            End If

        Next

        Return String.Concat(Texts)

    End Function

    Public Sub DBG(ByVal ParamArray Args As Object())

        Console.WriteLine(StrConcat(Args))

    End Sub

    ''' <summary>
    ''' entspricht ungefähr String.Join(), akzeptiert allerdings Object-Arrays
    ''' </summary>
    Public Function StrJoin(ByVal Args As Object(), Optional ByVal Separator As String = _
        " ") As String

        With New System.Text.StringBuilder

            For Each Arg As Object In Args
                .Append(Arg).Append(Separator)
            Next

            .Remove(.Length - Separator.Length, Separator.Length)
            Return .ToString
        End With

    End Function

    ''' <summary>
    ''' testet vor einer Zuweisung, ob der neue Wert überhaupt eine Änderung bringt 
    ''' </summary>
    ''' <remarks>
    ''' nützlich bei Zuweisungen an performance-intensive Properties, 
    ''' oder wenn auf Änderungen reagiert werden muß
    ''' </remarks>
    Public Function AssignSave(Of T)(ByRef Dest As T, ByVal Src As T) As Boolean

        If Object.Equals(Dest, Src) Then Return False
        Dest = Src
        Return True

    End Function

    Public Function IsBetween(Of T As IComparable)( _
              ByVal Bord0 As T, _
              ByVal ToTest As T, _
              ByVal Bord1 As T, _
              Optional ByVal AutoSort As Boolean = False) As Boolean

        If AutoSort Then

            Dim C0 As Integer = Bord0.CompareTo(ToTest)
            Dim C1 As Integer = ToTest.CompareTo(Bord1)

            Return C0 = 0 OrElse C1 = 0 OrElse (C0 < 0) = (C1 < 0)

        Else

            Return Bord0.CompareTo(ToTest) <= 0 AndAlso ToTest.CompareTo(Bord1) <= 0
        End If

    End Function

End Module

' ----------------- Ende Datei modHelpers.vb -----------------
' --------------- Anfang Datei uclScrollbar.vb ---------------
Imports System.ComponentModel
Imports System.ComponentModel.Design

''' <summary>
''' beschriftete, selbstjustierende Scrollbar. Angezeigt werden: Titel, Minimum, Value, Maximum.
''' Schlitten -Position und -Breite bleiben bei Min/Max-Änderungen stabil. Anders als bei der
''' normalen Scrollbar kann das Maximum auch durch Scrollen erreicht werden.
''' </summary>
<DefaultEvent("ValueChanged")> Public Class uclScrollbar

    Private _Minimum As Integer = 0
    Private _Maximum As Integer = 100
    Private _Range As Integer = _Maximum - _Minimum
    Private _Format As String = ""
    Private _IsScrolling As Boolean
    Private _ChangeOnScrollEnd As Boolean

    Public Event ValueChanged As EventHandler

    Public Sub New()

        InitializeComponent()

    End Sub

#Region "Public Properties"

    <Browsable(False)> <DesignerSerializationVisibility( _
        DesignerSerializationVisibility.Hidden)> <Bindable(True)> Public Property Value() As _
        Integer

        Get
            Return HScrollbar1.Value

        End Get

        Set(ByVal NewValue As Integer)

            If _IsScrolling Then Return
            AssignSave(HScrollbar1.Value, NewValue)

        End Set

    End Property

    ''' <summary>Ein Wert zwischen 0 und 1</summary>
    <DefaultValue(0.0F)> <Category("Verhalten")> <Description("Ein Wert zwischen 0 und 1")> _
        Public Property ValueRelative() As Single

        Get
            Return CSng((HScrollbar1.Value - HScrollbar1.Minimum) / _Range)

        End Get

        Set(ByVal NewValue As Single)

            If Not IsBetween(0.0F, NewValue, 1.0F) Then Throw XException.Sender(Me)( _
                "Value '", NewValue, "' liegt nicht zwischen 0 und 1.")

            Me.Value = _Minimum + CInt(NewValue * _Range)

        End Set

    End Property

    <Category("Verhalten")> <DefaultValue(0)> Public Property Minimum() As Integer
        Get
            Return _Minimum

        End Get

        Set(ByVal NewValue As Integer)

            If AssignSave(_Minimum, NewValue) Then UpdateControls()

        End Set

    End Property

    <Category("Verhalten")> <DefaultValue(100)> Public Property Maximum() As Integer
        Get
            Return _Maximum

        End Get

        Set(ByVal NewValue As Integer)

            If AssignSave(_Maximum, NewValue) Then UpdateControls()

        End Set

    End Property

    <DefaultValue(False)> <Category("Verhalten")> <Description("Bestimmt, ob ValueChanged " & _
        "erst am Ende des Ziehens ausgelöst wird")> Public Property ChangeOnScrollEnd() As _
        Boolean

        Get
            Return _ChangeOnScrollEnd

        End Get

        Set(ByVal NewValue As Boolean)
            _ChangeOnScrollEnd = NewValue

        End Set

    End Property

    <DefaultValue("")> <Category("Darstellung")> Public Property Format() As String
        Get
            Return _Format

        End Get

        Set(ByVal NewValue As String)

            If Not AssignSave(_Format, NewValue) Then Return
            lbMin.Text = _Minimum.ToString(_Format)
            lbVal.Text = Me.Value.ToString(_Format)
            lbMax.Text = _Maximum.ToString(_Format)

        End Set

    End Property

    <Category("Darstellung")> Public Overrides Property Text() As String
        Get
            Return MyBase.Text

        End Get

        Set(ByVal NewValue As String)

            If Not AssignSave(MyBase.Text, NewValue) Then Return
            lbCaption.Text = NewValue

            ' Breite von lbCaption neu bestimmen
            With lbCaption
                .Width = TextRenderer.MeasureText(.Text, .Font).Width
            End With

        End Set

    End Property

#End Region ' Public Properties

#Region "Overrides, Events"

    Protected Overrides Sub OnFontChanged(ByVal e As EventArgs)

        ' Breite von lbCaption neu bestimmen
        With lbCaption
            .Width = TextRenderer.MeasureText(.Text, .Font).Width
        End With

        MyBase.OnFontChanged(e)

    End Sub

    Private Sub HScrollbar1_Scroll(ByVal sender As Object, ByVal e As ScrollEventArgs) _
              Handles HScrollbar1.Scroll

        _IsScrolling = e.Type <> ScrollEventType.EndScroll

        If _ChangeOnScrollEnd AndAlso Not _IsScrolling Then OnValueChanged()

    End Sub

    Private Sub HScrollbar1_ValueChanged(ByVal sender As Object, ByVal e As EventArgs) _
              Handles HScrollbar1.ValueChanged

        lbVal.Text = HScrollbar1.Value.ToString(_Format)

        If Not _ChangeOnScrollEnd Then OnValueChanged()

    End Sub

#End Region ' Overrides, Events

#Region "Helpers"

    Protected Overridable Sub OnValueChanged()

        RaiseEvent ValueChanged(Me, EventArgs.Empty)

    End Sub

    Private Sub UpdateControls()

        Dim ValRel As Single = Me.ValueRelative

        _Range = _Maximum - _Minimum

        With HScrollbar1
            .Minimum = _Minimum
            .LargeChange = _Range \ 10
            .Maximum = _Maximum + .LargeChange - 1
            .SmallChange = .LargeChange \ 10
            lbMin.Text = .Minimum.ToString(_Format)
            lbMax.Text = _Maximum.ToString(_Format)
        End With

        Me.ValueRelative = ValRel ' ValueRelative wiederherstellen

    End Sub

#End Region ' Helpers

End Class

' ---------------- Ende Datei uclScrollbar.vb ----------------
' ---------------- Anfang Datei XException.vb ----------------
''' <summary>
''' vereinfacht bedienbare Exception-Klasse
''' Throw XException.Sender(Me)("Die Datei\n'", FileName, "'\nkonnte nicht gefunden wern.")
''' </summary>
''' <remarks></remarks>
Public Class XException

    Inherits Exception

    Public Shared _WithStop As Boolean = False

    Public Class ExceptionBuilder

        Private _Sender As Object
        Private _InnerEx As Exception

        Public Function InnerEx(ByVal Value As Exception) As ExceptionBuilder

            _InnerEx = Value
            Return Me

        End Function

        Public Function Sender(ByVal Value As Object) As ExceptionBuilder

            _Sender = Value
            Return Me

        End Function

        Public Function Create(ByVal ParamArray MessageSegments() As Object) As XException

            Return XException.Create(_InnerEx, MessageSegments)

        End Function

        Default Public ReadOnly Property Message(ByVal MessageSegment0 As Object, ByVal _
            ParamArray MessageSegments() As Object) As XException

            Get

                Dim Msg As String = StrConcat(MessageSegment0, StrConcat(MessageSegments))

                If _Sender IsNot Nothing Then
                    Msg = String.Concat(_Sender.GetType.Name, "-Exception: ", Msg)
                End If

                Return XException.Create(_InnerEx, Msg)

            End Get

        End Property

    End Class ' ExceptionBuilder

    Public Shared Function WithStop(ByVal Value As Boolean) As ExceptionBuilder

        XException._WithStop = Value
        Return New ExceptionBuilder

    End Function

    Public Shared Function InnerEx(ByVal Value As Exception) As ExceptionBuilder

        Return (New ExceptionBuilder).InnerEx(Value)

    End Function

    Public Shared Function Sender(ByVal Value As Object) As ExceptionBuilder

        Return (New ExceptionBuilder).Sender(Value)

    End Function

    Public Shared Shadows Function Message(ByVal ParamArray MessageSegments() As Object) As _
        XException

        Return Create(Nothing, MessageSegments)

    End Function

    Private Shared Function Create(ByVal InnerEx As Exception, ByVal ParamArray _
        MessageSegments() As Object) As XException

        Dim X As New XException(InnerEx, MessageSegments)

#If DEBUG Then

        ' Die IDE hat die nervtötende Angewohnheit, im Application-Designer rauszufliegen, wenn
        ' ! bei Erstellung des MainForms ein Fehler auftritt. Da stoppe ich doch besser hier, und
        ' ! kann in der Aufrufeliste die genaue Fehlerquelle aufsuchen
        If _WithStop Then Stop
#End If
        Return X

    End Function

    Private Sub New(ByVal ParamArray MessageSegments() As Object)

        MyBase.new(StrConcat(MessageSegments))

    End Sub

    Private Sub New(ByVal InnerEx As Exception, ByVal ParamArray MessageSegments() As Object)

        MyBase.new(StrConcat(MessageSegments), InnerEx)

    End Sub

End Class ' XException

' ----------------- Ende Datei XException.vb -----------------
' ------------ Ende Projektdatei MCIPlayer.vbproj ------------
' ------------- Ende Projektgruppe MCIPlayer.sln -------------

	

Diskussion  

Diese Funktion ermöglicht es, Fragen, die die Veröffentlichung des Tipps betreffen, zu klären, oder Anregungen und Verbesserungsvorschläge einzubringen. Nach der Veröffentlichung des Tipps werden diese Beiträge nicht weiter verlinkt. Allgemeine Fragen zum Inhalt sollten daher hier nicht geklärt werden.
Folgende Diskussionen existieren bereits

Um eine Diskussion eröffnen zu können, müssen sie angemeldet sein.