Questo sito utilizza cookies solo per scopi di autenticazione sul sito e nient'altro. Nessuna informazione personale viene tracciata. Leggi l'informativa sui cookies.
Username: Password: oppure
DiVX PLaYeR - MPEGModule.bas

MPEGModule.bas

Caricato da:
Scarica il programma completo

  1. Attribute VB_Name = "MPEG"
  2. Public Declare Function ReleaseCapture Lib "user32" () As Long
  3. Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
  4. Public 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
  5. Public Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
  6. Public Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
  7.  
  8. Public strFileToPlay As String
  9. Public bPlaying As Boolean
  10. Public ffSpeed As Long
  11. Public lTotalFrames As Long
  12. Public lTotalTime As Long
  13.  
  14. Public Sub DragForm(frm As Form)
  15.     Call ReleaseCapture
  16.     Call SendMessage(frm.hwnd, &HA1, 2, 0)
  17. End Sub
  18.  
  19. Public Sub PlayMovie()
  20.     If strFileToPlay <> "" Then
  21.         mciSendString "play " & strFileToPlay, 0, 0, 0
  22.         bPlaying = True
  23.         frmMain.lblCaption.Caption = "[In ESeCuZioNe]"
  24.        
  25.     End If
  26. End Sub
  27.  
  28. Public Sub StopMovie()
  29.     If bPlaying Then
  30.         mciSendString "stop " & strFileToPlay, 0, 0, 0
  31.         bPlaying = False
  32.         frmMain.lblCaption.Caption = "[SToPPaTo]"
  33.     End If
  34. End Sub
  35.  
  36. Public Sub CloseMovie()
  37.     If bPlaying Then
  38.         mciSendString "close " & strFileToPlay, 0, 0, 0
  39.         bPlaying = False
  40.         frmMain.lblCaption.Caption = "[No FiLe]"
  41.         UpdateScreen
  42.     End If
  43. End Sub
  44.  
  45. Public Sub CloseAll()
  46.     mciSendString "close all", 0, 0, 0
  47. End Sub
  48.  
  49. Public Sub OpenMovie()
  50.     If strFileToPlay <> "" Then
  51.         mciSendString "open " & strFileToPlay & " type MPEGVideo", 0, 0, 0
  52.     End If
  53. End Sub
  54.  
  55. Public Sub PauseMovie()
  56.     If bPlaying Then
  57.         mciSendString "pause " & strFileToPlay, 0, 0, 0
  58.         bPlaying = False
  59.         frmMain.lblCaption.Caption = "[ Paused ]"
  60.     End If
  61. End Sub
  62.  
  63. Public Sub FForward()
  64.     If bPlaying Then
  65.         Dim command As String
  66.         Dim s As String * 40
  67.         mciSendString "set " & strFileToPlay & " time format milliseconds", s, 128, 0&
  68.         mciSendString "status " & strFileToPlay & " position wait", s, Len(s), 0
  69.         command = "play " & strFileToPlay & " from " & CStr(CLng(s) + ffSpeed * 1000)
  70.         mciSendString command, 0, 0, 0
  71.         bPlaying = True
  72.         mciSendString "set " & strFileToPlay & " time format frames", 0, 0, 0
  73.     End If
  74. End Sub
  75.  
  76. Public Sub Rewind()
  77.     If bPlaying Then
  78.         Dim command As String
  79.         Dim s As String * 40
  80.         mciSendString "set " & strFileToPlay & " time format milliseconds", s, 128, 0&
  81.         mciSendString "status " & strFileToPlay & " position wait", s, Len(s), 0
  82.         command = "play " & strFileToPlay & " from " & CStr(CLng(s) - ffSpeed * 1000)
  83.         mciSendString command, 0, 0, 0
  84.         bPlaying = True
  85.         mciSendString "set " & strFileToPlay & " time format frames", 0, 0, 0
  86.     End If
  87.  
  88. End Sub
  89.  
  90. Public Function GetThisTime(ByVal timein As Long) As String
  91.     Dim conH As Integer
  92.     Dim conM As Integer
  93.     Dim conS As Integer
  94.     Dim remTime As Long
  95.     Dim strRetTime As String
  96.    
  97.     remTime = timein / 1000
  98.     conH = Int(remTime / 3600)
  99.     remTime = remTime Mod 3600
  100.     conM = Int(remTime / 60)
  101.     remTime = remTime Mod 60
  102.     conS = remTime
  103.    
  104.     If conH > 0 Then
  105.         strRetTime = Trim(Str(conH)) & ":"
  106.     Else
  107.         strRetTime = ""
  108.     End If
  109.    
  110.     If conM >= 10 Then
  111.         strRetTime = strRetTime & Trim(Str(conM))
  112.     ElseIf conM > 0 Then
  113.         strRetTime = strRetTime & "0" & Trim(Str(conM))
  114.     Else
  115.         strRetTime = strRetTime & "00"
  116.     End If
  117.    
  118.     strRetTime = strRetTime & ":"
  119.    
  120.     If conS >= 10 Then
  121.         strRetTime = strRetTime & Trim(Str(conS))
  122.     ElseIf conS > 0 Then
  123.         strRetTime = strRetTime & "0" & Trim(Str(conS))
  124.     Else
  125.         strRetTime = strRetTime & "00"
  126.     End If
  127.    
  128.     GetThisTime = strRetTime
  129. End Function
  130.  
  131.  
  132. Public Sub TotalFrames()
  133.     Dim TotalFrames As String * 128
  134.  
  135.     mciSendString "status " & strFileToPlay & " length", TotalFrames, 128, 0&
  136.     lTotalFrames = Val(TotalFrames)
  137. End Sub
  138.  
  139. Public Sub TotalTime()
  140.     Dim TotalTime As String * 128
  141.  
  142.     mciSendString "set " & strFileToPlay & " time format ms", TotalTime, 128, 0&
  143.     mciSendString "status " & strFileToPlay & " length", TotalTime, 128, 0&
  144.  
  145.     mciSendString "set " & strFileToPlay & " time format frames", 0&, 0&, 0&
  146.    
  147.     lTotalTime = Val(TotalTime)
  148. End Sub
  149.  
  150. Public Sub UpdateScreen()
  151.     Dim s As String * 1000
  152.     Dim t As String
  153.     t = GetThisTime(lTotalTime)
  154.     frmMain.lblTime.Caption = "Total Time: " & t
  155.     frmMain.lblFrame.Caption = "Total Frm: " & lTotalFrames
  156.    
  157.     mciSendString "status " & strFileToPlay & " position", s, Len(s), 0
  158.     frmMain.lbl.Caption = "FrM CoRReNTi: " & s
  159. End Sub