Tipp-Upload: VB.NET 0252: MCI-Player
von Spatzenkanonier
Ü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.
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
|
Verwendete API-Aufrufe: GetShortPathName (GetShortPathNameA), mciGetErrorString (mciGetErrorStringA), mciSendString (mciSendStringA) |
Download: |
' 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.