home *** CD-ROM | disk | FTP | other *** search
/ Chip 1999 July / Chip_1999-07_cd.bin / zkuste / VBasic / Data / Priklady / mmedia.cls < prev   
Encoding:
Visual Basic class definition  |  1997-03-11  |  8.3 KB  |  260 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "Mmedia"
  6. Attribute VB_GlobalNameSpace = False
  7. Attribute VB_Creatable = True
  8. Attribute VB_PredeclaredId = False
  9. Attribute VB_Exposed = False
  10. Option Explicit
  11.  
  12. '-----------------------------------------------------
  13. '   Name    :   MMedia.cls
  14. '   Author  :   Peter Wright, For BG2VB4 & BG2VB5
  15. '
  16. '   Notes   :   A multimedia class, which when turned
  17. '           :   into an object lets you load and play
  18. '           :   multimedia files, such as sound and
  19. '           :   video.
  20. '-----------------------------------------------------
  21.  
  22. ' -=-=-=- PROPERTIES -=-=-=-
  23. ' Filename      Determines the name of the current file
  24. ' Length        The length of the file (Read Only)
  25. ' Position      The current position through the file
  26. ' Status        The current status of the object (Read Only)
  27. ' Wait          True/False...tells VB to wait until play done
  28.  
  29. ' -=-=-=- METHODS -=-=-=-=-
  30. ' mmOpen <Filename>   Opens the requested filename
  31. ' mmClose             Closes the current file
  32. ' mmPause             Pauses playback of the current file
  33. ' mmStop              Stops playback ready for closedown
  34. ' mmSeek <Position>   Seeks to a position in the file
  35. ' mmPlay              Plays the open file
  36.  
  37. '-------------------------------------------------------------
  38. ' NOTES
  39. ' -----
  40. '
  41. ' Open a file, then play it. Pause it in response to a request
  42. ' from the user. Stop if you intend to seek to the start and
  43. ' play again. Close when you no longer want to play the file
  44. '--------------------------------------------------------------
  45.  
  46. Private sAlias As String        ' Used internally to give an alias name to
  47.                           ' the multimedia resource
  48.  
  49. Private sFilename As String     ' Holds the filename internally
  50. Private nLength As Single       ' Holds the length of the filename
  51.                           ' internally
  52. Private nPosition As Single     ' Holds the current position internally
  53. Private sStatus As String       ' Holds the current status as a string
  54. Private bWait As Boolean        ' Determines if VB should wait until play
  55.                         ' is complete before returning.
  56.  
  57. '------------ API DECLARATIONS -------------
  58. 'note that this is all one code line:
  59. Private Declare Function mciSendString Lib "winmm.dll" _
  60.    Alias "mciSendStringA" (ByVal lpstrCommand As String, _
  61.    ByVal lpstrReturnString As String, ByVal uReturnLength As Long, _
  62.    ByVal hwndCallback As Long) As Long
  63.  
  64. Public Sub mmOpen(ByVal sTheFile As String)
  65.  
  66.     ' Declare a variable to hold the value returned by mciSendString
  67.     Dim nReturn As Long
  68.     
  69.     ' Declare a string variable to hold the file type
  70.     Dim sType As String
  71.  
  72.     ' Opens the specified multimedia file, and closes any
  73.     ' other that may be open
  74.     If sAlias <> "" Then
  75.         mmClose
  76.     End If
  77.     
  78.     ' Determine the type of file from the file extension
  79.     Select Case UCase$(Right$(sTheFile, 3))
  80.        Case "WAV"
  81.           sType = "Waveaudio"
  82.        Case "AVI"
  83.           sType = "AviVideo"
  84.        Case "MID"
  85.           sType = "Sequencer"
  86.        Case Else
  87.           ' If the file extension is not known then exit the subroutine
  88.           Exit Sub
  89.     End Select
  90.     sAlias = Right$(sTheFile, 3) & Minute(Now)
  91.  
  92.     ' At this point there is no file open, and we have determined the
  93.     ' file type. Now would be a good time to open the new file.
  94.     ' Note: if the name contains a space we have to enclose it in quotes
  95.     If InStr(sTheFile, " ") Then sTheFile = Chr(34) & sTheFile & Chr(34)
  96.     nReturn = mciSendString("Open " & sTheFile & " ALIAS " & sAlias _
  97.             & " TYPE " & sType & " wait", "", 0, 0)
  98. End Sub
  99.  
  100. Public Sub mmClose()
  101.     ' Closes the currently opened multimedia file
  102.  
  103.     ' Declare a variable to hold the return value from the mciSendString
  104.     ' command
  105.     Dim nReturn As Long
  106.  
  107.     ' If there is no file currently open then exit the subroutine
  108.     If sAlias = "" Then Exit Sub
  109.     
  110.     nReturn = mciSendString("Close " & sAlias, "", 0, 0)
  111.     sAlias = ""
  112.     sFilename = ""
  113.     
  114. End Sub
  115.  
  116. Public Sub mmPause()
  117.     ' Pause playback of the file
  118.  
  119.     ' Declare a variable to hold the return value from the mciSendString
  120.     ' command
  121.     Dim nReturn As Long
  122.     
  123.     ' If there is no file currently open then exit the subroutine
  124.     If sAlias = "" Then Exit Sub
  125.     
  126.     nReturn = mciSendString("Pause " & sAlias, "", 0, 0)
  127.  
  128. End Sub
  129.  
  130. Public Sub mmPlay()
  131.     ' Plays the currently open file, from the current position
  132.  
  133.     ' Declare a variable to hold the return value from the mciSendString
  134.     ' command
  135.     Dim nReturn As Long
  136.     
  137.     ' If there is no file currently open, then exit the routine
  138.     If sAlias = "" Then Exit Sub
  139.     
  140.     ' Now play the file
  141.     If bWait Then
  142.         nReturn = mciSendString("Play " & sAlias & " wait", "", 0, 0)
  143.     Else
  144.         nReturn = mciSendString("Play " & sAlias, "", 0, 0)
  145.     End If
  146. End Sub
  147.  
  148. Public Sub mmStop()
  149.     ' Stop using a file totally, be it playing or whatever
  150.  
  151.     ' Declare a variable to hold the return value from mciSendString
  152.     Dim nReturn As Long
  153.     
  154.     ' If there is no file currently open then exit the subroutine
  155.     If sAlias = "" Then Exit Sub
  156.     
  157.     nReturn = mciSendString("Stop " & sAlias, "", 0, 0)
  158.     
  159. End Sub
  160.  
  161. Public Sub mmSeek(ByVal nPosition As Single)
  162.     ' Seeks to a specific position within the file
  163.  
  164.     ' Declare a variable to hold the return value from the mciSendString
  165.     ' function
  166.     Dim nReturn As Long
  167.     
  168.     nReturn = mciSendString("Seek " & sAlias & " to " & nPosition, "", 0, 0)
  169.  
  170. End Sub
  171.  
  172. Property Get Filename() As String
  173. ' Routine to return a value when the programmer asks the
  174. ' object for the value of its Filename property
  175.     Filename = sFilename
  176. End Property
  177.  
  178. Property Let Filename(ByVal sTheFile As String)
  179. ' Routine to set the value of the filename property, should the programmer
  180. ' wish to do so. This implies that the programmer actually wants to open
  181. ' a file as well so control is passed to the mmOpen routine
  182.    mmOpen sTheFile
  183. End Property
  184.  
  185. Property Get Wait() As Boolean
  186. ' Routine to return the value of the object's wait property.
  187.    Wait = bWait
  188. End Property
  189.  
  190. Property Let Wait(bWaitValue As Boolean)
  191. ' Routine to set the value of the object's wait property
  192.    bWait = bWaitValue
  193. End Property
  194.  
  195. Property Get Length() As Single
  196.    ' Routine to return the length of the currently opened multimedia file
  197.  
  198.    ' Declare a variable to hold the return value from the mciSendString
  199.    Dim nReturn As Long, nLength As Integer
  200.  
  201.    ' Declare a string to hold the returned length from the mci Status call
  202.    Dim sLength As String * 255
  203.     
  204.    ' If there is no file open then return 0
  205.    If sAlias = "" Then
  206.       Length = 0
  207.       Exit Property
  208.    End If
  209.  
  210.   nReturn = mciSendString("Status " & sAlias & " length", sLength, 255, 0)
  211.   nLength = InStr(sLength, Chr$(0))
  212.   Length = Val(Left$(sLength, nLength - 1))
  213. End Property
  214.  
  215. Property Let Position(ByVal nPosition As Single)
  216. ' Sets the Position property effectively by seeking
  217.     mmSeek nPosition
  218. End Property
  219.  
  220. Property Get Position() As Single
  221.    ' Returns the current position in the file
  222.     
  223.    ' Declare a variable to hold the return value from mciSendString
  224.    Dim nReturn As Integer, nLength As Integer
  225.     
  226.    ' Declare a variable to hold the position returned
  227.    ' by the mci Status position command
  228.    Dim sPosition As String * 255
  229.  
  230.    ' If there is no file currently opened then exit the subroutine
  231.    If sAlias = "" Then Exit Property
  232.     
  233.    ' Get the position and return
  234.    nReturn = mciSendString("Status " & sAlias & " position", sPosition, 255, 0)
  235.    nLength = InStr(sPosition, Chr$(0))
  236.    Position = Val(Left$(sPosition, nLength - 1))
  237.  
  238. End Property
  239.  
  240. Property Get Status() As String
  241.    ' Returns the playback/record status of the current file
  242.  
  243.    ' Declare a variable to hold the return value from mciSendString
  244.    Dim nReturn As Integer, nLength As Integer
  245.     
  246.    ' Declare a variable to hold the return string from mciSendString
  247.    Dim sStatus As String * 255
  248.     
  249.    ' If there is no file currently opened, then exit the subroutine
  250.    If sAlias = "" Then Exit Property
  251.  
  252.    nReturn = mciSendString("Status " & sAlias & " mode", sStatus, 255, 0)
  253.     
  254.    nLength = InStr(sStatus, Chr$(0))
  255.    Status = Left$(sStatus, nLength - 1)
  256.     
  257. End Property
  258.  
  259.  
  260.