|
Imports System.Drawing
Imports System.Collections
Imports System.ComponentModel
Imports System.Windows.Forms
Imports System.Data
Imports System.IO
Imports Microsoft.DirectX
Imports Microsoft.DirectX.AudioVideoPlayback
Imports Microsoft.VisualBasic
Public Class Form1
Inherits System.Windows.Forms.Form
Dim video As Video
Dim myAudio As Audio
Dim myVideo As Video
Dim videoPlaying As Boolean = False
Dim fName As String = Nothing
Private Sub OpenAviFile()
Dim vTime As String = Nothing
lblTime.Text = "00:00:00"
With ofd
.InitialDirectory = "F:\movz\"
.RestoreDirectory = True
End With
If ofd.ShowDialog = Windows.Forms.DialogResult.OK Then
Dim height As Integer = pnlVideo.Height
Dim width As Integer = pnlVideo.Width
'Set the video to the selected file.
Video = New Video(ofd.FileName)
'Get the file Length in time.
vTime = GetVideoTime(vTime)
'Display the Labels and what is playing.
txtPlaying.Visible = True
txtPlaying.Text = ""
txtPlaying.Text = ofd.FileName
lblTime.Text = vTime
fName = ofd.FileName
GetFileLength()
'Set the owner of the video.
Video.Owner = pnlVideo
'Set the height and width of the video panel and
'set the progressbar to zero.
pnlVideo.Height = height
pnlVideo.Width = width
videoProgress.Value = 0
'Play the file, enable the timer, set the boolean to true.
Video.Play()
Video.ShowCursor()
lblTimer.Enabled = True
videoPlaying = True
End If
'Do Menu Check.
mnuPlay.Checked = True
cmPlay.Checked = True
mnuPlay.Enabled = False
cmPlay.Enabled = False
mnuPause.Enabled = True
mnuPause.Checked = False
cmPause.Enabled = True
cmPause.Checked = False
mnuStop.Enabled = True
mnuStop.Checked = False
cmStop.Enabled = True
cmStop.Checked = False
End Sub
Private Sub mnuPlay_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuPlay.Click, cmPlay.Click
mnuPlay.Checked = True
cmPlay.Checked = True
video.Play() 'Play the video.
lblTimer.Enabled = True 'Start the timer.
videoPlaying = True 'Set the boolean to True.
video.ShowCursor() 'Show the system cursor in the panel.
videoProgress.Value = videoProgress.Value 'keep the progressbar value.
tb.Value = tb.Value 'keep the trackbar value.
lblDuration.Text = lblDuration.Text 'Keep the current time.
txtPlaying.Text = "" 'Set the textbox to zilch.
txtPlaying.Text = fName 'Display what we are doing.
'Do Menu Check.
mnuPlay.Enabled = False
cmPlay.Enabled = False
mnuPause.Enabled = True
mnuPause.Checked = False
cmPause.Enabled = True
cmPause.Checked = False
mnuStop.Enabled = True
mnuStop.Checked = False
cmStop.Enabled = True
cmStop.Checked = False
tb.Enabled = True
End Sub
Private Sub mnuPause_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuPause.Click, cmPause.Click
mnuPause.Checked = True
cmPause.Checked = True
video.Pause() 'Pause the video
lblTimer.Enabled = False 'Stop the timer.
videoPlaying = False 'Set the boolean to False
lblTime.Text = lblTime.Text 'keep the current time of the video.
videoProgress.Value = videoProgress.Value 'Do the same for the progressbar.
tb.Value = tb.Value 'Do the same for the trackbar.
lblDuration.Text = lblDuration.Text 'Same for this label.
txtPlaying.Text = "" 'Set the textbox to zilch.
txtPlaying.Text = "<<<--- YOUR VIDEO HAS JUST BEEN PAUSED --->>>" 'Display what we are doing.
'Do Menu Check.
mnuPlay.Enabled = True
mnuPlay.Checked = False
cmPlay.Enabled = True
cmPlay.Checked = False
mnuPause.Enabled = False
cmPause.Enabled = False
mnuStop.Enabled = True
mnuStop.Checked = False
cmStop.Enabled = True
cmStop.Checked = False
End Sub
Private Sub mnuStop_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuStop.Click, cmStop.Click
mnuStop.Checked = True
cmStop.Checked = True
video.Stop() 'Stop the video.
lblTimer.Enabled = False 'Stop the timer.
videoPlaying = False 'Set the boolean to False.
txtPlaying.Text = "" 'Set the textbox to zilch.
lblTime.Text = "00:00:00" 'Set the label to 00:00:00
lblDuration.Text = "00:00:00" 'Set the label to 00:00:00
videoProgress.Value = 0 'Set the progressbar to zero
tb.Value = 0 'Set the trackbar to zero.
lblLength.Text = "000 MB"
txtPlaying.Text = "<<<--- YOUR VIDEO HAS BEEN STOPPED --->>>" 'Display what we are doing.
'Do Menu Check.
mnuPlay.Enabled = True
mnuPlay.Checked = False
cmPlay.Enabled = True
cmPlay.Checked = False
mnuPause.Enabled = True
mnuPause.Checked = False
cmPause.Enabled = True
cmPause.Checked = False
mnuStop.Enabled = False
cmStop.Enabled = False
tb.Enabled = False
End Sub
Private Sub mnuOpen_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuOpen.Click
tb.Enabled = True
mnuOpen.Checked = True
OpenAviFile() 'Lets open an avi file to play.
mnuOpen.Enabled = False
End Sub
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
'On Form1 Load
mnuNormal.Checked = True 'Set normal to True.
cmNormal.Checked = True 'Set normal to True.
txtPlaying.Visible = True 'Make sure we can see the textbox.
lblTime.Text = "00:00:00" 'Set the label to 00:00:00
lblLength.Text = "000 MB"
videoProgress.Value = 0 'Set the progressbar to zero
tb.Value = 0 'Set the trackbar to zero.
lblDuration.Text = "00:00:00" 'Set the label to 00:00:00
txtPlaying.Text = "<<<--- WELCOME TO DAD'S AVI PLAYER --->>>" 'Say hello on form load.
mnuFullscreen.Checked = False 'Check fullscreen and set to False.
cmFullscreen.Checked = False 'Check fullscreen and set to False.
mnuFullscreen.Enabled = True
cmFullscreen.Enabled = True
mnuNormal.Enabled = False
cmNormal.Enabled = False
tb.Enabled = False 'Disabled to prevent exceptions from occuring if pressed.
End Sub
Private Sub mnuNormal_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuNormal.Click, cmNormal.Click
video.Fullscreen = False 'Set fullscreen to False.
mnuNormal.Checked = True 'Check Normal and set to True.
cmNormal.Checked = True 'Check Normal and set to True.
mnuFullscreen.Checked = False 'Check fullscreen and set to False.
cmFullscreen.Checked = False 'Check fullscreen and set to False.
'Do menu check.
mnuFullscreen.Enabled = True
cmFullscreen.Enabled = True
mnuNormal.Enabled = False
cmNormal.Enabled = False
mnuFileInfo.Enabled = True 'View FileInfo in Normal mode ONLY.
cmFileInfo.Enabled = True
End Sub
Private Sub mnuFullscreen_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuFullscreen.Click, cmFullscreen.Click
mnuFullscreen.Checked = True 'Check fullscreen and set to True.
cmFullscreen.Checked = True 'Check fullscreen and set to True.
mnuNormal.Checked = False 'Uncheck Normal and set to False.
cmNormal.Checked = False 'Uncheck Normal and set to False.
video.Fullscreen = mnuFullscreen.Checked 'Display the fullscreen.
'Do menu check.
mnuFullscreen.Enabled = False
cmFullscreen.Enabled = False
mnuNormal.Enabled = True
cmNormal.Enabled = True
cmFileInfo.Enabled = False
mnuFileInfo.Enabled = False 'This is to prevent Fullscreen from going
'back to Normal view. This was a bug that I found during a fullscreen viewing
'when I clicked on mnuFileInfo. When I closed the frmFileInfo, Fullscreen reverted back to Normal.
End Sub
Private Sub mnuCloseVideo_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuCloseVideo.Click, cmCloseVideo.Click
ProperlyDispose() 'Dispose of the video and reset all.
End Sub
Private Sub mnuOpen_MouseEnter(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuOpen.MouseEnter
mnuOpen.Image = My.Resources.door_open 'Do some simple animation.
End Sub
Private Sub mnuOpen_MouseLeave(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuOpen.MouseLeave
mnuOpen.Image = My.Resources.door 'Do some simple animation.
End Sub
Private Sub mnuExit_MouseEnter(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuExit.MouseEnter
mnuExit.Image = My.Resources.door 'Do some simple animation.
End Sub
Private Sub mnuExit_MouseLeave(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuExit.MouseLeave
mnuExit.Image = My.Resources.door_open 'Do some simple animation.
End Sub
Private Function GetVideoTime(ByVal vidTime As String) As String
'Displays the length in time on a label.
'Set the vars.
Dim vHours As Integer = 0
Dim vMinutes As Integer = 0
Dim vSeconds As Integer = 0
'Reset the vars.
vHours = Int(video.Duration / 3600)
vMinutes = Int((video.Duration - Int(video.Duration / 3600) * 3600) / 60)
vSeconds = Int(video.Duration - Int(video.Duration / 60) * 60)
'Set the vars to the ByVal String.
vidTime = vHours.ToString() & ":" & vMinutes.ToString() & ":" & vSeconds.ToString()
'Return the ByVal String.
Return vidTime
End Function
Private Sub lblTimer_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles lblTimer.Tick
'Display the current position on the progressBar.
Dim vPosition As Integer = Convert.ToInt32(video.CurrentPosition * 1000)
Dim vDuration As Integer = Convert.ToInt32(video.Duration * 1000)
If vDuration > 0 Then
tb.Value = Convert.ToInt32((vPosition * 100) / vDuration)
videoProgress.Value = Convert.ToInt32((vPosition * 100) / vDuration)
End If
'Display the current time of the video on a label.
lblDuration.Text = Format(Int(video.Duration \ 3600), "00") & ":" & _
Format(Int((video.Duration - video.CurrentPosition) \ 60) Mod 60, "00") & ":" & _
Format(Int((video.Duration - video.CurrentPosition) Mod 60), "00").ToString
If (video.CurrentPosition >= video.Duration) Then
video.Stop()
'Dispose of the video and do a menu check.
ProperlyDispose()
End If
End Sub
Private Sub tbvolume_scroll(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles tbVolume.Scroll
'Here is where we control the volume.
myAudio = video.Audio
myAudio.Volume() = tbVolume.Value()
End Sub
Private Sub tbbalance_scroll(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles tbBalance.Scroll
'Here is where we control the balance.
myAudio = video.Audio
myAudio.Balance = tbBalance.Value
End Sub
Private Sub mnuAbout_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuAbout.Click
'Show the About box.
Dim frm As New About
frm.Show()
End Sub
Private Sub GetFileLength()
'Gets the length of the selected file.
'This sub is called in OpenAVIFile sub.
Dim myFile As FileInfo
myFile = New FileInfo(fName)
Dim length As Long = myFile.Length()
lblLength.Text = Format(Int(length / 1048000), "000") & " MB"
End Sub
Private Sub ProperlyDispose()
'Due to a memory leak problem with AudioVideoPlayback
video.Dispose()
video = Nothing
videoPlaying = False 'Set the boolean to False.
videoProgress.Value = 0 'Set the progress bar to zero.
tb.Value = 0 'Set the trackbar to zero.
lblTime.Text = "00:00:00" 'Reset the labels.
lblDuration.Text = "00:00:00"
lblLength.Text = "000 MB"
txtPlaying.Text = "" 'Reset the textbox.
txtPlaying.Text = "<<<--- SELECT ANOTHER FILE TO PLAY? --->>>"
mnuOpen.Checked = False
mnuOpen.Enabled = True
mnuPlay.Checked = False
mnuPlay.Enabled = True
cmPlay.Checked = False
cmPlay.Enabled = True
mnuPause.Checked = False
mnuPause.Enabled = True
cmPause.Checked = False
cmPause.Enabled = True
mnuStop.Checked = False
mnuStop.Enabled = True
cmStop.Checked = False
cmStop.Enabled = True
tb.Enabled = False
lblTimer.Enabled = False 'Stop the Timer.
End Sub
Private Sub mnuFileInfo_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuFileInfo.Click, cmFileInfo.Click
'Let's get all the file information
'and put it on frmFileInfo's text boxes.
Dim frm As New frmFileInfo
Dim myFile As FileInfo
If Trim(txtPlaying.Text) <> Trim(fName) Then
MessageBox.Show("Video is either 'Stopped of Paused'. Press Play")
Exit Sub
End If
myFile = New FileInfo(fName)
frm.Text = frm.Text & myFile.Name
frm.txtName.Text = fName
frm.txtExtension.Text = Path.GetExtension(fName)
frm.txtCreated.Text = myFile.CreationTime
frm.txtModified.Text = myFile.LastWriteTime
frm.txtFileSize.Text = lblLength.Text
frm.txtLength.Text = lblTime.Text
frm.txtFrameWidth.Text = pnlVideo.Width
frm.Show()
End Sub
Private Sub FadeOut()
'Just some simple opacity animation.
Dim cntr As Integer
For cntr = 90 To 10 Step -10
Me.Opacity = cntr / 100
Me.Refresh()
Threading.Thread.Sleep(50)
Next cntr
Me.Dispose()
End Sub
Private Sub mnuExit_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuExit.Click, Me.FormClosing
Dim ans As String = InputBox("Did you reactivate the screen saver ?" & " Type Yes or No", "Is ScreenSaver Active?", "No")
If ans = "No" Then
Dim f As Form
f = New ScreenSaverTest
f.Show()
Else
FadeOut()
End If
End Sub
Private Sub tb_MouseUp(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles tb.MouseUp
If video.CurrentPosition > 0 Then
Dim newPercent As Double = Convert.ToDouble(tb.Value) / 100
Dim durVideo As Integer = Convert.ToInt32(video.Duration * 1000)
Dim newPosition As Integer = (durVideo * newPercent) / 1000
video.CurrentPosition = newPosition
End If
End Sub
Private Sub tb_MouseDown(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles tb.MouseDown
video.Pause()
mnuPause.Checked = True
cmPause.Checked = True
lblTimer.Enabled = False 'Stop the timer.
videoPlaying = False 'Set the boolean to False
lblTime.Text = lblTime.Text 'keep the current time of the video.
videoProgress.Value = videoProgress.Value 'Do the same for the progressbar.
tb.Value = tb.Value 'Do the same for the trackbar.
lblDuration.Text = lblDuration.Text 'Same for this label.
txtPlaying.Text = "" 'Set the textbox to zilch.
txtPlaying.Text = "<<<--- YOUR VIDEO HAS JUST BEEN PAUSED --->>>" 'Display what we are doing.
'Do Menu Check.
mnuPlay.Enabled = True
mnuPlay.Checked = False
cmPlay.Enabled = True
cmPlay.Checked = False
mnuPause.Enabled = False
cmPause.Enabled = False
mnuStop.Enabled = True
mnuStop.Checked = False
cmStop.Enabled = True
cmStop.Checked = False
End Sub
Private Sub mnuDeActivate_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuDeActivate.Click
If Trim(mnuDeActivate.Text) = Trim("DeActivate ScreenSaver") Then
mnuDeActivate.Text = "ReActivate ScreenSaver"
Else
mnuDeActivate.Text = "DeActivate ScreenSaver"
End If
Dim f As Form
f = New ScreenSaverTest
f.Show()
End Sub
End Class
|
By viewing downloads associated with this article you agree to the Terms of Service and the article's licence.
If a file you wish to view isn't highlighted, and is a text file (not binary), please
let us know and we'll add colourisation support for it.
I am currently retired.
I have no degree but I have some programming experience
when I was in college(Cobol, Pascal).
My accomplishments thus far are;
Best VB.Net article for January(2009)
Best VB.Net article for July(2009)