Visual Basic 2012 Excel 2013 eigenen Videorecorder programmieren von Selzer-McKenzie SelMcKenzie

Visual Basic 2012 Excel 2013 eigenen Videorecorder programmieren von Selzer-McKenzie SelMcKenzie

Video: http://youtu.be/dj0ICnMccXA

 

 

Author D,.Selzer-McKenzie

 

Heute zeige ich Ihnen, wie Sie einen eigenen Videorecorder programmieren können, mit allen Futures. Natürlich geht das auch mit allen anderen Versionen von Visual Basic wie 2005,2008,2010 und 2012 ebenso mit VBA Excel.

Den Souce Code füge ich nachstehend bei und habe ihn auch abgefilmt. Leider lässt sch der Source Code nicht in die Kommentarspalte dieses Videos schreiben, aber Sie können sich ja die Abfilmung ansehen oder unter

Blogspot.com/Outbackbrumby

in dem entsprechenden Thread direkt herauskopieren.

Hier nun der Source-Code:

 

Imports System.IO

Imports System.Text

Imports System.Runtime.InteropServices

Public Class Form1

 

    Public Class C_MCI

       

        Private Shared Function mciSendString(lpstrCommand As String,

                                lpstrReturnString As StringBuilder, uReturnLength As Integer,

                                hwndCallback As IntPtr) As Integer

        End Function

 

       

        Private Shared Function mciGetErrorString(dwError As Integer,

                                  lpstrBuffer As StringBuilder, uLength As Integer) As Integer

        End Function

 

        Private Function getMciError(errCode As Integer) As String

            Dim errMsg As New StringBuilder(255)

            If mciGetErrorString(errCode, errMsg, errMsg.Capacity) = 0 Then

                Return "MCI-Fehler " & errCode

            Else

                Return errMsg.ToString()

            End If

        End Function

 

        Private _alias As String = "mciAlias"

        Private _isOpen As Boolean = False

 

        Public ReadOnly Property IsOpen As Boolean

            Get

                Return _isOpen

            End Get

        End Property

 

        Public Sub Open(filename As String)

            If Me._isOpen Then Me.Close()

            If Not File.Exists(filename) Then

                MessageBox.Show("Die Datei '" & filename & "' ist nicht vorhanden!", "Fehler",

                                 MessageBoxButtons.OK, MessageBoxIcon.Error)

            End If

            Dim mciStr As String = "open " & Chr(34) & filename & Chr(34) &

                " type mpegvideo alias " & _alias

            'MessageBox.Show(mciStr)

            Dim res As Integer = mciSendString(mciStr, Nothing, 0, IntPtr.Zero)

            If res <> 0 Then

                MessageBox.Show(getMciError(res),

                               "MCI-Fehler beim Öffnen des Geräts ('Open'-Befehl)",

                               MessageBoxButtons.OK, MessageBoxIcon.Error)

                Exit Sub

            End If

 

            mciStr = "set " & Me._alias & " time format ms"

            res = mciSendString(mciStr, Nothing, 0, IntPtr.Zero)

            If res <> 0 Then

                MessageBox.Show(getMciError(res), "MCI-Fehler beim Zuweisen des Zeitformats", _

                                MessageBoxButtons.OK, MessageBoxIcon.Error)

            End If

 

            Me._isOpen = True

 

        End Sub

 

        Public ReadOnly Property Length As Integer

            Get

                Dim buffer As New StringBuilder(255)

                Dim res As Integer = mciSendString("status " & _alias & " length", buffer,

                                           buffer.Capacity, IntPtr.Zero)

                If res <> 0 Then

                    MessageBox.Show(getMciError(res), "MCI-Fehler beim 'Length'-Befehl", _

                                    MessageBoxButtons.OK, MessageBoxIcon.Error)

                End If

                Return Convert.ToInt32(buffer.ToString())

            End Get

        End Property

 

        Public Sub Play(von As Integer, bis As Integer)

            Dim res As Integer = mciSendString("Play " & _alias & " From " & von & " To " _

                                               & bis, Nothing, 0, IntPtr.Zero)

        End Sub

 

        Public Sub Play()

            Play(0, Me.Length)

        End Sub

 

        Public Property Position As Integer

            Get

                Dim buffer As New StringBuilder(261)

                Dim res As Integer = mciSendString("status " & _alias & " position",

                                          buffer, buffer.Capacity, IntPtr.Zero)

                If res <> 0 Then

                    MessageBox.Show(getMciError(res), "MCI-Fehler beim 'Position'-Befehl", _

                                    MessageBoxButtons.OK, MessageBoxIcon.Error)

                End If

                Return Convert.ToInt32(buffer.ToString())

            End Get

            Set(value As Integer)

                Dim res As Integer = mciSendString("seek " & _alias & " to " & value, Nothing, 0, _

                                                   IntPtr.Zero)

                If res <> 0 Then

                    MessageBox.Show(getMciError(res), "Fehler beim 'Seek'-Befehl", _

                                    MessageBoxButtons.OK, MessageBoxIcon.Error)

                End If

                res = mciSendString("play " & _alias, Nothing, 0, IntPtr.Zero)

                If res <> 0 Then

                    MessageBox.Show(getMciError(res), "MCI-Fehler beim 'Play'-Befehl", _

                                    MessageBoxButtons.OK, MessageBoxIcon.Error)

                End If

            End Set

        End Property

 

        Public Sub Pause()

            Dim res As Integer = mciSendString("Pause " & _alias, Nothing, 0, IntPtr.Zero)

            If res <> 0 Then

                MessageBox.Show(getMciError(res), "MCI-Fehler beim 'Pause'-Befehl", _

                                MessageBoxButtons.OK, MessageBoxIcon.Error)

            End If

        End Sub

 

        Public Sub Resume_()

            Dim res As Integer = mciSendString("Resume " & _alias, Nothing, 0, IntPtr.Zero)

            If res <> 0 Then

                MessageBox.Show(getMciError(res), "MCI-Fehler beim 'Resume'-Befehl", _

                                MessageBoxButtons.OK, MessageBoxIcon.Error)

            End If

        End Sub

 

        Public Sub volume(wert As Integer)

            Dim res As Integer = mciSendString("setaudio " & _alias & " volume to " & wert, _

                                               Nothing, 0, IntPtr.Zero)

            If res <> 0 Then

                MessageBox.Show(getMciError(res), "MCI-Fehler beim 'Volume'-Befehl", _

                                MessageBoxButtons.OK, MessageBoxIcon.Error)

            End If

        End Sub

 

        Public Sub Stop_()

            Dim res As Integer = mciSendString("Stop " & _alias, Nothing, 0, IntPtr.Zero)

            If res <> 0 Then

                MessageBox.Show(getMciError(res), "MCI-Fehler beim 'Stop'-Befehl", _

                                MessageBoxButtons.OK, MessageBoxIcon.Error)

            End If

        End Sub

 

        Public Sub Close()

            If Me._isOpen Then

                Dim res As Integer = mciSendString("Close " & _alias, Nothing, 0, IntPtr.Zero)

                If res <> 0 Then

                    MessageBox.Show(getMciError(res), "MCI-Fehler beim 'Close'-Befehl", _

                                    MessageBoxButtons.OK, MessageBoxIcon.Error)

                End If

                Me._isOpen = False

            End If

        End Sub

 

    End Class

 

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

        'gehört zum VideoPlayer

        VideoPlayerTrackBarFilmVorspulen.Maximum = 10000

        VideoPlayerTrackBarFilmVorspulen.LargeChange = 1

        Uhr11.Interval = 100

        VideoPlayerTrackBarLautstärke.Maximum = 1000

        VideoPlayerTrackBarLautstärke.Value = 1000

        VideoPlayerTrackBarLautstärke.LargeChange = 100

    End Sub

 

    Private myMCI As New C_MCI()

 

    Private kf As Single = 1

 

    Private Sub VideoPlayerButtonVideoDateiÖffnen_Click(sender As Object, e As EventArgs) _

        Handles VideoPlayerButtonVideoDateiÖffnen.Click

        If OpenFileDialog1.ShowDialog() = DialogResult.OK Then

            myMCI.Open(OpenFileDialog1.FileName)

            kf = Convert.ToSingle(myMCI.Length) / VideoPlayerTrackBarFilmVorspulen.Maximum

            ToolStripStatusLabel1.Text = OpenFileDialog1.FileName

            VideoPlayerButtonAbspielen.Text = "PLAY"

        End If

    End Sub

 

    Private Sub VideoPlayerButtonAbspielen_Click(sender As Object, e As EventArgs) _

        Handles VideoPlayerButtonAbspielen.Click

        If VideoPlayerButtonAbspielen.Text = "PLAY" Then

            myMCI.Play()

            Uhr11.Enabled = True

            VideoPlayerButtonAbspielen.Text = "STOPP"

        Else

            myMCI.Stop_()

            Uhr11.Enabled = False

            VideoPlayerTrackBarFilmVorspulen.Value = 0

            VideoPlayerLabelZurAnzeige.Text = "00:00"

            VideoPlayerButtonAbspielen.Text = "PLAY"

        End If

    End Sub

 

    Private Sub VideoPlayerButtonPause_Click(sender As Object, e As EventArgs) _

        Handles VideoPlayerButtonPause.Click

        If VideoPlayerButtonPause.Text = "PAUSE" Then

            myMCI.Pause()

            VideoPlayerButtonPause.Text = "WEITER"

        Else

            VideoPlayerButtonPause.Text = "PAUSE"

            myMCI.Resume_()

        End If

    End Sub

 

    Private Function getMinutes() As String

        Dim sekunden As Integer = Convert.ToInt32((VideoPlayerTrackBarFilmVorspulen.Value * kf / 1000))

        Return (sekunden / 60).ToString("00") & ":" & (sekunden Mod 60).ToString("00")

    End Function

 

 

    Private Sub Uhr11_Tick(sender As Object, e As EventArgs) Handles Uhr11.Tick

        Dim val As Integer = Convert.ToInt32(myMCI.Position / kf)

        If val < VideoPlayerTrackBarFilmVorspulen.Maximum Then

            VideoPlayerTrackBarFilmVorspulen.Value = val

            VideoPlayerLabelZurAnzeige.Text = getMinutes()

        Else

            myMCI.Stop_()

            Uhr11.Enabled = False

            VideoPlayerTrackBarFilmVorspulen.Value = 0

            VideoPlayerLabelZurAnzeige.Text = "00:00"

            VideoPlayerButtonAbspielen.Text = "PLAY"

        End If

    End Sub

 

    Private Sub TrackBar1_Scroll(sender As Object, e As EventArgs) Handles _

        VideoPlayerTrackBarFilmVorspulen.Scroll

        Try

            Me.myMCI.Position = Convert.ToInt32(VideoPlayerTrackBarFilmVorspulen.Value * kf)

        Catch ex As Exception

            MessageBox.Show(ex.Message, Application.ProductName,

                MessageBoxButtons.OK, MessageBoxIcon.Error)

        End Try

    End Sub

 

    Private Sub TrackBar2_Scroll(sender As Object, e As EventArgs) Handles _

        VideoPlayerTrackBarLautstärke.Scroll

        myMCI.volume(VideoPlayerTrackBarLautstärke.Value)

    End Sub

End Class