Keskustelu: Koodit: VB6: Movie player

'
' KOMPONENTIT:
'
' Microsoft Common Dialog Control 6.0 (SP3) - C:\Windows\System32\comdlg32.ocx
' Microsoft Windows Common Control 6.0 (SP6) - C:\Windows\System32\MSCOMCTL.OCX
'
' OBJEKTIT:
'
' Form          1 Kpl
' CommonDialog  1 Kpl
' Timer         1 Kpl
' Progressbar   1 Kpl
' Label         2 Kpl
' Commandbutton 6 Kpl
' Picturebox    1 Kpl
' Textbox       2 Kpl
'
' CLASS MODULE  1 Kpl
'
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''                                                                                                            '''''''''''''''
'''''''''''''                                            HUOM!!!!!!!!!!!!!!!!!!                                          '''''''''''''''
'''''''''''''                                                                                                            '''''''''''''''
'''''''''''''                                  Tarvitsee Divx Codec ajurit toimiakseen.                                  '''''''''''''''
'''''''''''''                            Toistaa ainakin AVI, MPG, MPEG, MOV ja WMV tiedostot.
'''''''''''''                      Jos leffan kehyskorkeus on yli 300, progressbar jää kuvan päälle.                     '''''''''''''''
'''''''''''''                                         Tämä on esimerkki. ;D                                              '''''''''''''''
'''''''''''''                                                                                                            '''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Dim MLeffa As New Class1 'MLeffa on Class Module

Private Sub Command1_Click()

    On Error Resume Next
    MLeffa.Toista 'Haetaan Moduulista Funktio - TOISTA
    Timer1.Enabled = True 'Timeri päälle
    ProgressBar1.Max = Val(MLeffa.Pituus_Sek) 'Asetetaan progressbarille "Loppupiste".
    MLeffa.Odotus 0.5 'Annetaan MCI:lle aikaa latailla (0.5 sekunttia)
    Label2.Caption = "Pituus: " & MLeffa.Pituus 'Näytetään leffan pituus
    Picture1.Visible = True
    Picture1.Width = Val(Text1.Text) * 15 'Pictureboxin leveys
    Picture1.Height = Val(Text2.Text) * 15 ' pictureboxin korkeus
    MLeffa.Koko 0, 0, Val(Text1.Text), Val(Text2.Text)   ' Leffan koko pixeleissä
    ProgressBar1.Width = Picture1.Width ' Progressbar1 pituus on yhtäpitkä kuin picture1
    ProgressBar1.Visible = True ' Progressbar näkyville
    Command2.Enabled = True ' Loputkin namiskat aktiivisiksi
    Command3.Enabled = True
    Command6.Enabled = True
  End Sub
Private Sub Command2_Click()

    MLeffa.Seis ' Pysäytetään leffa
    Timer1.Enabled = False ' Timeri pois päältä
    MLeffa.Odotus 1 'Annetaan MCI:lle aikaa latailla (0.5 sekunttia)
    MLeffa.AloitaAlusta ' Aloitetaan leffa alusta
    Label1.Caption = "Aika: " & MLeffa.Kohta ' Nollataan aika
    ProgressBar1.Value = MLeffa.Kohta_Sek ' Nollataan sliderin kohta
    MLeffa.Pause ' Pistetään leffa paussille.
End Sub

Private Sub Command3_Click()
    If Command3.Caption = "Pause." Then 'Jos "Pause." - nappulan "Otsake" on Pause: ,
        MLeffa.Pause ' Haetaan Moduulista Funktio - PAUSE
        Command3.Caption = "Jatka." ' "Pause" - nappulan "Otsake" = Jatka,
        Timer1.Enabled = False ' Timeri pois päältä (Ettei progressbar liiku ja aika kulu.)
    Else
        MLeffa.Jatka ' Muuten antaa leffan jatkua,
        Command3.Caption = "Pause." ' Pause-nappulan "Otsake" pysyy samana,
        Timer1.Enabled = True ' Timeri pysyy päällä.
    End If

End Sub

Private Sub Command4_Click()

    Dim a As Long
    Dim b As Long
    ' Määritetään uusi leffa CommonDialog:in kautta. Kelpuutetaan AVI, MPEG, MPG ja MOV päätteiset tiedostot.
    CommonDialog1.Filter = "Avi Files  (*.avi)|*.avi|Mpeg Files (*.mpeg)|*.mpeg|Mpg Files (*.mpg)|*.mpg|Mov Files (*.mov)|*.mov|Windows Video(*.wmv)|*.wmv|All Files (*.*)|*.*"
    CommonDialog1.ShowOpen ' Avataan Windowsin "Browser" tai mikälie...
    MLeffa.Filename = CommonDialog1.Filename ' Valittu tiedosto,
    MLeffa.AvaaIkkuna Picture1.hWnd, "child"  ' Avataan Leffa "pikkuikkunaan"
    CommonDialog1.Filename = "" ' Poistetaan valitun leffan "Tiedot"
    MLeffa.Alkup_Koko a, b ' Haetaan leffan alkuperäinen koko
    Text1.Text = CStr(a) ' text1 teksti on leffan leveys pikseleissä
    Text2.Text = CStr(b) ' text2 teksti on leffan korkeus pikseleissä
    Command1.Enabled = True ' "Toista" - painike aktiiviseksi

End Sub

Private Sub Command5_Click()

    MLeffa.Lopeta ' Sammutetaan MCI
    Timer1.Enabled = False ' Timeri sammutetaan.

End Sub

Private Sub Command6_Click()

MLeffa.AloitaAlusta ' Aloitetaan leffa uudellen alusta.

End Sub

Private Sub Form_Load() ' Formille ja muille objekteille vähän asettelua.
Me.Width = 13000        ' Tässä tää on toteutettu vähän "kömpelösti",
Me.Height = 6500        ' mutta tehköön jokainen itse kuinka haluaa..
Me.BackColor = vbBlack

With ProgressBar1
.Scrolling = 1
.Height = 200
.left = 1800
.Width = 100
.Visible = False
.top = 5200
End With

Picture1.top = 500
Picture1.left = 1800
Picture1.Visible = False
Picture1.BackColor = vbBlack

With Label1
.Caption = "Aika :"
.BackColor = vbBlack
.ForeColor = vbWhite
.Width = 1200
.Height = 300
.left = 1800
.top = 5500
End With

With Label2
.Caption = "Pituus: "
.BackColor = vbBlack
.ForeColor = vbWhite
.Width = 1200
.Height = 300
.left = 300
.top = 4600
.Alignment = 2
End With

With Text1
.Text = ""
.ForeColor = vbWhite
.BackColor = vbBlack
.Height = 200
.Width = 500
.top = 4000
.left = 300
End With

With Text2
.Text = ""
.ForeColor = vbWhite
.BackColor = vbBlack
.Height = 200
.Width = 500
.top = 4000
.left = 1000
End With

With Command1
.Caption = "Toista."
.Width = 1200
.Height = 300
.left = 300
.top = 1800
.Enabled = False
End With

With Command2
.Caption = "Seis."
.Width = 1200
.Height = 300
.left = 300
.top = 2200
.Enabled = False
End With

With Command3
.Caption = "Pause."
.Width = 1200
.Height = 300
.left = 300
.top = 2600
.Enabled = False
End With

With Command4
.Caption = "Avaa tiedosto."
.Width = 1200
.Height = 400
.left = 300
.top = 500
End With

With Command5
.Caption = "Sulje tiedosto."
.Width = 1200
.Height = 400
.left = 300
.top = 1000
End With

With Command6
.Caption = "Alkuun."
.Width = 1200
.Height = 300
.left = 300
.top = 3000
.Enabled = False
End With

Timer1.Interval = 1000

End Sub

Private Sub Form_Unload(Cancel As Integer)

    MLeffa.Lopeta ' Suljetaan MCI
    Unload Me ' Formi pois
    End ' Lopetetaan ohjelma

End Sub

Private Sub Timer1_Timer()
    On Error Resume Next

    Label1.Caption = "Aika: " & MLeffa.Kohta ' Haetaan "Aika" - Labellille leffan kohta,
    ProgressBar1.Value = MLeffa.Kohta_Sek ' ja progressbarin kohta...

End Sub

'
Option Explicit

Private Declare Function mciGetErrorString Lib "winmm.dll" Alias "mciGetErrorStringA" (ByVal dwError As Long, ByVal lpstrBuffer As String, ByVal uLength As Long) As Long
Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long

Private Data As String * 128
Public Error As Long
Public Filename  As String
Public Function AvaaIkkuna(hWnd As Long, WindowStyle As String)
    Filename = Chr$(34) & Filename & Chr$(34)
    Error = mciSendString("close movie", 0, 0, 0)
    Error = mciSendString("open " & Filename & " type mpegvideo alias movie parent " & hWnd & " style " & WindowStyle & " ", 0, 0, 0)
    Error = mciSendString("open " & Filename & " alias movie parent " & hWnd & " style " & WindowStyle & " ", 0, 0, 0)
End Function
Public Function Toista()
    Error = mciSendString("play movie", 0, 0, 0)
End Function
Public Function Seis()
   Error = mciSendString("stop movie", 0, 0, 0)
End Function
Public Function Pituus_Millisek() As Long
    Error = mciSendString("set movie time format ms", 0, 0, 0)
    Error = mciSendString("status movie length", Data, 128, 0)
    Pituus_Millisek = Val(Data)
End Function
Public Function Pituus_Sek() As Long
    Pituus_Sek = Pituus_Millisek \ 1000
End Function
Public Function Pause()
    Error = mciSendString("pause movie", 0, 0, 0)
End Function
Public Function Jatka()
    Error = mciSendString("resume movie", 0, 0, 0)
End Function
Public Function Kohta_Millisek() As Long
    Error = mciSendString("set movie time format ms", 0, 0, 0)
    Error = mciSendString("status movie position wait", Data, 128, 0)
    Kohta_Millisek = Val(Data)
End Function
Public Function Lopeta()
    Error = mciSendString("close all", 0, 0, 0)
End Function

Public Function Kohta() As String
    Kohta = Aika(Kohta_Millisek)
End Function

Public Function Pituus() As String
    Pituus = Aika(Pituus_Millisek)
End Function

Private Function Aika(ByVal timein As Long) As String
     On Error GoTo Virhe
    Dim Tunti As Integer
    Dim Minuutti As Integer
    Dim Sekuntti As Integer
    Dim Jäljellä As Long
    Dim Kesto As String
    Jäljellä = timein / 1000
    Tunti = Int(Jäljellä / 3600)
    Jäljellä = Jäljellä Mod 3600
    Minuutti = Int(Jäljellä / 60)
    Jäljellä = Jäljellä Mod 60
    Sekuntti = Jäljellä
    If Tunti > 0 Then
       Kesto = Trim(Str(Tunti)) & ":"
    Else
        Aika = ""
    End If
    If Minuutti >= 10 Then
        Kesto = Kesto & Trim(Str(Minuutti))
    ElseIf Minuutti > 0 Then
        Kesto = Kesto & Trim(Str(Minuutti))
    Else
        Kesto = Kesto & "0"
    End If
    Kesto = Kesto & ":"
    If Sekuntti >= 10 Then
        Kesto = Kesto & Trim(Str(Sekuntti))
    ElseIf Sekuntti > 0 Then
        Kesto = Kesto & "0" & Trim(Str(Sekuntti))
    Else
        Kesto = Kesto & "00"
    End If
    Aika = Kesto
    Exit Function
Virhe:      MsgBox Err.Description, , " Virhe."
End Function
Public Function Kohta_Sek() As Long
      Kohta_Sek = Kohta_Millisek \ 1000
   End Function
Sub Odotus(duration)
    Dim StartTime As Long
    Dim X As Long
    StartTime = Timer
    Do While Timer - StartTime < duration
        X = DoEvents()
    Loop
    Exit Sub
End Sub
Public Function AloitaAlusta()
    Error = mciSendString("seek movie to start", 0, 0, 0)
    Toista
End Function
Public Function Koko(left As Long, top As Long, Width As Long, Height As Long)
    Error = mciSendString("put movie window at " & left & " " & top & " " & Width & " " & Height, 0, 0, 0)
End Function
Public Function Alkup_Koko(wWidth As Long, wHeight As Long)
    On Error Resume Next
    Dim a As String
    Dim b As String
    Dim C As String
    Dim f As String
    Dim g As String
    a = Alkup_Koko2
    b = InStr(1, a, " ") '2
    C = InStr(b + 1, a, " ") '4
    f = Mid(a, C + 1) '9
    g = InStr(1, f, " ")
    wWidth = Val(left(f, g))
    wHeight = Val(Mid(f, g))
End Function
Public Function Alkup_Koko2() As String
    Error = mciSendString("where movie source", Data, 128, 0)
    Alkup_Koko2 = Data
End Function