Save-Point - Direct Compilable Code

The PNG (Portable Network Graphics) Class

Sun, 18 Jan 2026 04:29:39 +0000

The PNG (Portable Network Graphics) Class
Version: 1.0˃
Based upon work by Elroy of VBForums (June 22, 2022)

Introduction

Permits the loading of standard RGBA type (32bpp).PNG graphics into a Visual Basic 6 environment. Due to their similarities with the format, both .TIF and TIFF graphics files are also usable.

The code has been cleaned up since its original iteration, and provides a more detailed error message system if issues arise. It also bypasses a false positive error with certain png files based on their color indexing. This false error had halt class processing, now resolved.

Features

Supports loading of .png files within the Visual Basic 6 environment.
Supports .tif / .tiff images due to format similarities.
Able to define image opacity and scaling on .png file load.
Transparent background support
An updated error message system in the event issues arise.
Easy to use method/command.

Limitations

Does not adapt/update the default LoadPicture command, but uses its own.
LoadPNG (the command/method) does not have palette nor custom size definition properties.

Code

Code:
' ==============================================================================

' ** The PNG (Portable Network Graphics) Class

' ------------------------------------------------------------------------------

'    by DerVVulfman

'    version 1.0

'    01-17-2026 (mm/dd/yyyy)

'    Based upon work by Elroy of VBForums (June 22, 2022)

' ==============================================================================

'

' INTRODUCTION:

' -------------

'

' Permits the loading of standard RGBA type (32bpp).PNG graphics  into a  Visual

' Basic 6 environment.  Due to their similarities with the format, both .TIF and

' TIFF graphics files are also usable.

'

' The code has been cleaned up since its original iteration, and provides a more

' detailed error message system if issues arise.  It also bypasses a false posi-

' tive error  with certain png files  based on their color indexing.  This false

' error had halt class processing, now resolved.

'

'

' ==============================================================================

'

' CLASS INSTALLATION:

' -------------------

'

' * In the form where used, define this class before any other action.

'    -- Example:  Private clsPNG As New Class_PNG

'

'   The 'clsPNG' (or like) will direct you to commands within this class.

'    -- Example:  clsPNG.LoadPNG

'

' * Ensure the class instance (or instances) removed from memory upon exit.

'   This is done within the form's  "Form_Unload" private subroutine.

'   -- Example:  Set clsPNG = Nothing

'                End

'

'

' ==============================================================================

'

' METHODS:

' --------

'

' There is only one.  This method acts in place of the LoadPicture command,  but

' with different optional parameters:

'

' LOADPNG:  Loads a PNG file into a supported form object (such as  apicture box,

'           image box, etc.).

' * SYNTAX: .picture = LoadPng(Filename [,opacity [,scaling]] )

'

'  * Target   : the image or picturebox that will contain the graphic

'  * Filename : the image file

'  * Opacity  : (Optional) In byte format. IE &HFF is 255 solid and &H00 is 0.

'  * scaling  : (Optional) in Single Precision floating (1 is default).

'

'            -------------------------------------------------------------------

'            FOR REFERENCE:

'            --------------

'            The default LoadPicture used by VBasic 6 has the following syntax:

'              LoadPicture(Filename [,Size [,Colordepth [,x [,y]]]])

'              * Filename :    The image file

'              * Size :        (0-4) defines if icon, cursor, etc.

'              * Color Depth : (0-3): default, monochrome, 16 colors, 256 colors

'              * X & Y :       Custom Icon size if above Size setting is 4

'            - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

'              Size: (0) - System Small Icon

'                    (1) - System Large-size Icon

'                    (2) - Caption-button size setting

'                    (3) - Icon Size setting on the Appearance Tab

'                    (4) - Custom Size based on further X/Y settings

'            -------------------------------------------------------------------

'

'

' ==============================================================================

'

' ERROR MESSAGES:

' ---------------

'

' Based on the original code by Elroy, the Graphics Error Test Subroutine (GErr)

' is a private subroutine that exists throughout the LoadPng method. If there is

' an issue with the .png file loading, a basic popup window will show the error.

' These error messages may be a simple "Generic Error", "File Not Found", or any

' of the 20+ tracable errors.

'

' There are six different innstances within the LoadPng method  where this error

' message system may be called. Unlike the original code of 2022, the error mes-

' sage will now indicate what stage (loading the GDI system, accessing the file,

' etc) the error occurs.

'

' Being able to track which stage was taking place  when a .png file was loading

' was more of  a development tool, but left within  the error message system for

' possible further debugging if ever needed.

'

'

' ==============================================================================

Option Explicit

' Constant Declarations

' ==============================================================================

    Private Const ImageLockModeRead As Long = &H1&

    Private Const PixelFormat32bppPARGB As Long = &HE200B

    Private Const DIB_RGB_COLORS As Long = 0&

    Private Const AC_SRC_ALPHA As Byte = 1

' Structure Type Declarations

' ==============================================================================

    Private Type GdiplusStartupInput

        GdiplusVersion              As Long

        DebugEventCallback          As Long

        SuppressBackgroundThread    As Long

        SuppressExternalCodecs      As Long

    End Type

    Private Type BitmapData

        Width                       As Long

        Height                      As Long

        Stride                      As Long

        PixelFormat                 As Long

        Scan0                       As Long

        Reserved                    As Long

    End Type

    Private Type BITMAPINFOHEADER

        biSize                      As Long

        biWidth                     As Long

        biHeight                    As Long

        biPlanes                    As Integer

        biBitCount                  As Integer

        biCompression               As Long

        biSizeImage                 As Long

        biXPelsPerMeter             As Long

        biYPelsPerMeter             As Long

        biClrUsed                   As Long

        biClrImportant              As Long

    End Type

    Private Type SIZEL

        cx                          As Long

        cy                          As Long

    End Type

    Private Type RECT

        Left                        As Long

        Top                         As Long

        Right                       As Long

        Bottom                      As Long

    End Type

    Private Type BLENDFUNCTION

        BlendOp                     As Byte

        BlendFlags                  As Byte

        SourceConstantAlpha         As Byte

        AlphaFormat                 As Byte

    End Type

    Private Type PictDesc

        cbSize                      As Long

        picType                     As Long

        hgdiObj                     As Long

        hPalOrXYExt                 As Long

        Reserved                    As Long

    End Type

    Private Type ENHMETAHEADER

        iType                       As Long

        nSize                       As Long

        rclBounds                   As RECT

        rclFrame                    As RECT

        dSignature                  As Long

        nVersion                    As Long

        nBytes                      As Long

        nRecords                    As Long

        nHandles                    As Integer

        sReserved                   As Integer

        nDescription                As Long

        offDescription              As Long

        nPalEntries                 As Long

        szlDevice                   As SIZEL

        szlMillimeters              As SIZEL

        cbPixelFormat               As Long

        offPixelFormat              As Long

        bOpenGL                     As Long

        szlMicrometers              As SIZEL

    End Type

    Private Type IID

        Data1                       As Long

        Data2                       As Integer

        Data3                       As Integer

        Data4(7&)                   As Byte

    End Type

' API Function Declarations

' ==============================================================================

    Private Declare Function GdiplusStartup Lib "gdiplus" _

            (ByRef token As Long, _

            ByRef lpInput As GdiplusStartupInput, _

            Optional ByRef lpOutput As Long) As Long

    Private Declare Function GdipLoadImageFromFile Lib "gdiplus" _

            (ByVal sFilename As Long, hImage As Long) As Long

    Private Declare Function GdipBitmapLockBits Lib "gdiplus" _

            (ByVal hBitmap As Long, lpRect As Any, ByVal lFlags As Long, _

            ByVal lPixelFormat As Long, _

            uLockedBitmapData As BitmapData) As Long

    Private Declare Function CreateCompatibleDC Lib "gdi32" _

            (ByVal hDC As Long) As Long

    Private Declare Function CreateDIBSection Lib "gdi32" _

            (ByVal hDC As Long, lpBitsInfo As BITMAPINFOHEADER, _

            ByVal wUsage As Long, lpBitsOut As Long, _

            ByVal hSection As Long, ByVal offset As Long) As Long

    Private Declare Function GdipBitmapUnlockBits Lib "gdiplus" _

            (ByVal hBitmap As Long, _

            uLockedBitmapData As BitmapData) As Long

    Private Declare Function GdipDisposeImage Lib "gdiplus" _

            (ByVal image As Long) As Long

    Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, _

            ByVal hObject As Long) As Long

    Private Declare Function CreateEnhMetaFileW Lib "gdi32" _

            (ByVal hdcRef As Long, _

            ByVal lpFileName As Long, lpRect As Any, _

            ByVal lpDescription As Long) As Long

    Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, _

            ByVal nIndex As Long) As Long

    Private Declare Function GetMem4 Lib "msvbvm60" (ByRef Source As Any, _

            ByRef Dest As Any) As Long ' Ignore the returned value. It's useless.

    Private Declare Function GdiAlphaBlend Lib "gdi32" (ByVal hdcDest As Long, _

            ByVal xoriginDest As Long, ByVal yoriginDest As Long, _

            ByVal wDest As Long, ByVal hDest As Long, ByVal hdcSrc As Long, _

            ByVal xoriginSrc As Long, ByVal yoriginSrc As Long, _

            ByVal wSrc As Long, ByVal hSrc As Long, ByVal ftn As Long) As Long

    Private Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long

    Private Declare Function DeleteObject Lib "gdi32" _

            (ByVal hObject As Long) As Long

    Private Declare Function CloseEnhMetaFile Lib "gdi32" _

            (ByVal hDC As Long) As Long

    Private Declare Function GetEnhMetaFileHeader Lib "gdi32" _

            (ByVal hEmf As Long, ByVal cbBuffer As Long, _

            ByRef lpemh As ENHMETAHEADER) As Long

    Private Declare Function DeleteEnhMetaFile Lib "gdi32" _

            (ByVal hEmf As Long) As Long

    Private Declare Function OleCreatePictureIndirect Lib "oleaut32" _

            (lpPictDesc As PictDesc, riid As IID, ByVal fOwn As Boolean, _

            lplpvObj As Object) As Long

    Private Declare Function IIDFromString Lib "ole32" (ByVal lpsz As Long, _

            ByRef clsid As IID) As Long

    Private Declare Function GdiplusShutdown Lib "gdiplus" _

            (ByVal token As Long) As Long

' API Subroutine Declarations

' ==============================================================================

    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _

            (Destination As Any, Source As Any, ByVal Length As Long)

    Private Declare Sub AtlPixelToHiMetric Lib "atl" (lpSizeInPix As SIZEL, _

            lpSizeInHiMetric As SIZEL)

' Variable Declarations

' ==============================================================================

    Private mlGdipToken                 As Long

    Private gdiTestID                   As Integer

' ==============================================================================

' = CLASS FUNCTIONS ============================================================

' ==============================================================================

' The Initialization routine

'===============================================================================

Private Sub Class_Initialize()

End Sub

' ==============================================================================

' = GENERAL FUNCTIONS ==========================================================

' ==============================================================================

' LOADPNG Function

' ==============================================================================

Public Function LoadPng(sFilename As String, _

        Optional ByVal bbOverallOpacity As Byte = &HFF, _

        Optional ByVal dScalingFactor As Single = 1!) As IPicture

    '   ========================================================================

    '

    ' --------------------------------------------------------------------------

    ' The sFilename should be a valid PNG file.

    ' We can put the return of this directly into a PictureBox.Picture or an

    ' Image.Picture, and it will correctly show any alpha channel.

    ' --------------------------------------------------------------------------

    '

    ' Create BLENDFUNCTION structure for an Alpha Blend.

    Const AC_SRC_OVER       As Byte = 0

    Const AC_SRC_ALPHA      As Byte = 1

    '

    ' Initialize function variables

    Dim StartupInput        As GdiplusStartupInput

    Dim hGdipImage          As Long

    Dim uData               As BitmapData

    Dim hMemDC              As Long

    Dim uHdr                As BITMAPINFOHEADER

    Dim hDib                As Long

    Dim lpBits              As Long

    Dim hPrevDib            As Long

    Dim hEmfDC              As Long

    Dim Xscale              As Double

    Dim Yscale              As Double

    Dim bf                  As BLENDFUNCTION

    Dim ftn                 As Long

    Dim hEmf                As Long

    Dim uDesc               As PictDesc

    '

    ' Get the GDI+ going.

    StartupInput.GdiplusVersion = 1&

    gdiTestID = 0

    GErr GdiplusStartup(mlGdipToken, StartupInput, 0&)

    '

    ' Open the file into hGdipImage.

    gdiTestID = 1

    GErr GdipLoadImageFromFile(StrPtr(sFilename), hGdipImage)

    '

    ' Creates a temporary buffer of the hGdipImage's or hGdipBitmap's bits.

    ' The bits in this temp buffer don't have to be the same format as the ori-

    ' ginal bits format. The uData can be both an input and output, but only out-

    ' put here because uData flag is zero. Also PNG files aren't pre-multiplied,

    ' but we let this function do that for us, as that's what we need.

    gdiTestID = 2

    GErr GdipBitmapLockBits(hGdipImage, ByVal 0&, ImageLockModeRead, _

            PixelFormat32bppPARGB, uData)

    '

    ' Get screen compatible DC.

    hMemDC = CreateCompatibleDC(0&)

    '

    ' Fill the BITMAPINFOHEADER header for making DIB.

    uHdr.biSize = Len(uHdr)

    uHdr.biPlanes = 1

    uHdr.biBitCount = 32

    uHdr.biWidth = uData.Width      ' Pixels.

    uHdr.biHeight = -uData.Height   ' Pixels.

    uHdr.biSizeImage = uData.Stride * uData.Height

    '

    ' Create an EMPTY buffer associated with the DC for image (DIB) bits, and

    ' return pointer to the buffer (lpBits). CreateDIBSection does not use the

    ' BITMAPINFOHEADER biXPelsPerMeter or biYPelsPerMeter and will not provide

    ' resolution information in the BITMAPINFO structure.

    hDib = ApiZ(CreateDIBSection(hMemDC, uHdr, DIB_RGB_COLORS, lpBits, 0&, 0&))

    '

    ' Copy the actual image (PARGB bits) from uData (uData.Scan0)

    ' into our DIBs bits (lpBits).

    Call CopyMemory(ByVal lpBits, ByVal uData.Scan0, uData.Stride * uData.Height)

    '

    ' Cleanup - Done with the uData buffer as well as the hGdipImage.

    gdiTestID = 3

    GErr GdipBitmapUnlockBits(hGdipImage, uData)

    gdiTestID = 4

    GErr GdipDisposeImage(hGdipImage)

    '

    ' Put our DIB into our memory DC.

    hPrevDib = ApiZ(SelectObject(hMemDC, hDib))

    '

    ' Create an EMPTY EMF in a primary monitor DC with no initial size.

    ' The DC returned by CreateEnhMetaFile can be passed to any GDI function.

    ' It actually returns an EMF DC.

    hEmfDC = ApiZ(CreateEnhMetaFileW(0&, 0&, ByVal 0&, 0&))

    '

    ' Calculate the EMF scaling factors from its DC, so we can use it in

    ' GdiAlphaBlend, as GdiAlphaBlend scales based on the hEmfDC.

    Const HORZSIZE   As Long = 4&:  Const VERTSIZE   As Long = 6&

    Const HORZRES    As Long = 8&:  Const VERTRES    As Long = 10&

    Const LOGPIXELSX As Long = 88&: Const LOGPIXELSY As Long = 90&

    '

    Xscale = CDbl(GetDeviceCaps(hEmfDC, HORZRES)) / _

        CDbl(GetDeviceCaps(hEmfDC, HORZSIZE)) * 25.4 / _

        CDbl(GetDeviceCaps(hEmfDC, LOGPIXELSX))

    Yscale = CDbl(GetDeviceCaps(hEmfDC, VERTRES)) / _

        CDbl(GetDeviceCaps(hEmfDC, VERTSIZE)) * 25.4 / _

        CDbl(GetDeviceCaps(hEmfDC, LOGPIXELSY))

    '

    ' Use BLENDFUNCTION structure for an Alpha Blend.

    bf.BlendOp = AC_SRC_OVER

    bf.AlphaFormat = AC_SRC_ALPHA

    bf.SourceConstantAlpha = bbOverallOpacity

    '

    ' Must put into a Long so we can pass it ByVal.

    GetMem4 bf, ftn

    '

    ' Copy our DIB that's in memory into our EMF+ using its DC, and scale.

    ApiZ GdiAlphaBlend(hEmfDC, 0&, 0&, CLng((CDbl(uData.Width)) * Xscale * _

            dScalingFactor) + 1&, CLng((CDbl(uData.Height)) * Yscale * _

            dScalingFactor) + 1&, hMemDC, 0&, 0&, uData.Width, uData.Height, _

            ftn), "AlphaBlend"

    '

    ' Done with hMemDC and hDib, so clean them up.

    ApiZ SelectObject(hMemDC, hPrevDib)

    ApiZ DeleteDC(hMemDC)

    ApiZ DeleteObject(hDib)

    '

    ' Clean the hEmfDC and save into the hEmf

    hEmf = ApiZ(CloseEnhMetaFile(hEmfDC), "CloseEnhMetaFile")

    '

    ' Setup PictDesc with EMF type.

    uDesc.cbSize = Len(uDesc)

    uDesc.picType = vbPicTypeEMetafile

    uDesc.hgdiObj = hEmf

    '

    ' Return the function by wrapping our EMF (uDesc) into the iPicture object.

    ApiE OleCreatePictureIndirect(uDesc, IPictureIID, 1&, LoadPng)

    '

    ' Shutdown the GDI+.

    gdiTestID = 5

    GErr GdiplusShutdown(mlGdipToken)

    '

End Function

' ==============================================================================

' = PRIVATE FUNCTIONS ==========================================================

' ==============================================================================

' GRAPHICS ERROR TEST SUBROUTINE: Used to check for errors during execution

' ==============================================================================

Private Sub GErr(ByVal GdipReturn As Long)

    '

    ' Initialize subroutine variables

    Dim sErr        As String

    Dim InIDE       As Boolean: Debug.Assert MakeTrue(InIDE)

    '

    If GdipReturn = 0& Then Exit Sub ' All is well.

    '

    ' Exit if the error is after a shutdown of the GDI+

    If GdipReturn = 1& Then

        If gdiTestID = 5 Then

            Exit Sub

        End If

    End If

    '

    ' Branch on returned error to get message

    Select Case GdipReturn

    Case 1&:    sErr = "Generic Error"

    Case 2&:    sErr = "Invalid Parameter/Argument"

    Case 3&:    sErr = "Out Of Memory"

    Case 4&:    sErr = "Object Busy, already in use in another thread"

    Case 5&:    sErr = "Insufficient Buffer, buffer specified as an argument in the API call is not large enough"

    Case 6&:    sErr = "Method Not Implemented"

    Case 7&:    sErr = "Win32 Error"

    Case 8&:    sErr = "Wrong State"

    Case 9&:    sErr = "Method Aborted"

    Case 10&:   sErr = "File Not Found"

    Case 11&:   sErr = "Value Overflow, arithmetic operation that produced a numeric overflow"

    Case 12&:   sErr = "Access Denied"

    Case 13&:   sErr = "Unknown Image Format"

    Case 14&:   sErr = "Font Family Not Found"

    Case 15&:   sErr = "Font Style Not Found"

    Case 16&:   sErr = "Not TrueType Font"

    Case 17&:   sErr = "Unsupported Gdiplus Version"

    Case 18&:   sErr = "Gdiplus Not Initialized"

    Case 19&:   sErr = "Property Not Found, does not exist in the image"

    Case 20&:   sErr = "Property Not Supported, not supported by the format of the image"

    Case 21&:   sErr = "Profile Not Found, color profile required to save an image in CMYK format was not found"

    Case Else:  sErr = "Error Not Specified": GdipReturn = 99&

    End Select

    '

    ' Branch on Test ID to relay which GDI+ command caused the error

    Select Case gdiTestID

    Case 1:    sErr = "1 LoadImage: " & sErr

    Case 2:    sErr = "2 LockBits: " & sErr

    Case 3:    sErr = "3 UnlockBits: " & sErr

    Case 4:    sErr = "4 DisposeImage: " & sErr

    Case 5:    sErr = "5 Shutdown: " & sErr

    Case Else: sErr = "0 Startup: " & sErr

    End Select

    '

    ' Include GDI+ Error notification

    sErr = "GDI+ Error:  " & sErr

    '

    ' Display message in Debug or pass as Raised

    If InIDE Then

        Debug.Print sErr

        Stop

    Else

        Err.Raise vbObjectError + 1147221504 - GdipReturn, , sErr

    End If

    '

End Sub

' Convert a string from the StringFromID back to original IID

' ==============================================================================

Private Function IPictureIID() As IID

    '

    ApiE IIDFromString(StrPtr("{7BF80980-BF32-101A-8BBB-00AA00300CAB}"), _

        IPictureIID)

    '

End Function

' Api Zero:  Processes messages when the error report system returns ZERO

' ==============================================================================

Private Function ApiZ(ApiReturn As Long, Optional sApiCall As String) As Long

    '

    ' Initialize subroutine variables

    Dim sErr        As String

    Dim InIDE       As Boolean: Debug.Assert MakeTrue(InIDE)

    '

    ' Set function to passed value and exit if no Zero return

    If ApiReturn <> 0& Then

        ApiZ = ApiReturn

        Exit Function

    End If

    '

    ' Create error message based on API Call

    If Len(sApiCall) Then

        sErr = sApiCall & " error"

    Else

        sErr = "API Error"

    End If

    '

    ' Display message in Debug or pass as Raised

    If InIDE Then

        Debug.Print sErr

        Stop

    Else

        Err.Raise vbObjectError + 1147221504, , sErr

    End If

End Function

' Api Error:  A General error processing prodcedure for Non-GDI+ errors.

' ==============================================================================

Private Sub ApiE(ApiReturn As Long, Optional sApiCall As String)

    '

    ' Initialize subroutine variables

    Dim sErr        As String

    Dim InIDE       As Boolean: Debug.Assert MakeTrue(InIDE)

    '

    ' Exit if no errors

    If ApiReturn = 0& Then Exit Sub

    '

    ' Create error message based on API Call

    If Len(sApiCall) Then

        sErr = sApiCall & " error " & CStr(ApiReturn)

    Else

        sErr = "API Error " & CStr(ApiReturn)

    End If

    '

    ' Display message in Debug or pass as Raised

    If InIDE Then

        Debug.Print sErr

        Stop

    Else

        Err.Raise vbObjectError + 1147221504 - ApiReturn, , sErr

    End If

    '

End Sub

' Make True - Ensures a passed value is set to boolean/true by ref or otherwise.

' ==============================================================================

Private Function MakeTrue(ByRef b As Boolean) As Boolean

    '

    b = True

    MakeTrue = True

    '

End Function

Or within the actual Class_PNG.cls format:
Class_Png.zip (Size: 6.35 KB / Downloads: 72)

Instructions
Plenty... in the code itself.

FAQ
The original code was not in the forum of a class, but as a basic module. It has since been streamlined while the error message system upgraded.

Credits and Thanks
Thanks to Elroy of VBForums who wrote the base code in 2022

Terms and Conditions
Use as you see fit. No requirements other than due credit for both Elroy and myself.

The MCISendString Multimedia Class

Sat, 03 Jan 2026 17:46:08 +0000

The MCISendString Multimedia Class
Version: 1.0
Based upon work by Mark Thesing (July 18, 2002)

Introduction
Permits the loading, playback, and various other actions on a multimedia file.

Since its original creation in 2002, the ability to present video content in a picturebox object has been added. Along with that, more multimedia file extensions are now recognized.

Do note, the class will only load and play one multimedia file at a time. In order for a project to play multiple files, multiple instances of this class need to be defined.

LOOPING:
Using the MCISendstring system, there is always a millisecond break as the MCISendstring attempts to loop back to the start, even with the built-in repeat function.

Features

Supports playback of the following Audio formats: aiff, amr, flac, m4a, midi, mp2, mp3, wav, wma
Supports playback of the following Video formats: avi, mpg, mpeg, mp4, m4v, asf, wmv
Allows custom loop position

Limitations

Video footage does not have stretch-to-fit nor any resizing
Avi footage 'still' has no audio playback
Geared for Visual Basic 6

Code

Code:
' ==============================================================================

' ** The MCISendString Multimedia Class

' ------------------------------------------------------------------------------

'    by DerVVulfman

'    version 1.0

'    01-03-2026 (mm/dd/yyyy)

'    Based upon work by Mark Thesing (July 18, 2002)

' ==============================================================================

'

' INTRODUCTION:

' -------------

'

' Permits the loading, playback, and various other actions on a multimedia file.

'

' Since its original creation in 2002, the ability to present video content in a

' picturebox object has been added. Along with that, more multimedia file exten-

' tions are now recognized.

'

' Do note,  the class will only load and play one multimedia file at a time.  In

' order for a project  to play multiple files,  multiple instances of this class

' need to be defined.

'

' LOOPING:  Using the MCISendstring system,  there is always a millisecond break

'           as the MCISendstring attempts to loop back  to the start,  even with

'           the built-in repeat function.

'

'

' ==============================================================================

'

' CLASS INSTALLATION:

' -------------------

'

' * In the form where used, define this class before any other action.

'    -- Example:  Private clsMM As New Class_MSS

'

' * If you need two or more files playing, define multiple instances like so.

'    -- Example:  Private clsMMOne As New Class_MSS

'                 Private clsMMTwo As New Class_MSS

'

'   The 'clsMM' (or like) will direct you to commands within this class.

'    -- Example:  clsMM.mmPlay

'

' * Ensure the class instance (or instances) removed from memory upon exit.

'   It is also recommended to end any multimedia playback being executed.

'   This is done within the form's  "Form_Unload" private subroutine.

'   -- Example:  clsIni.mmStop

'                Set clsIni = Nothing

'                End

'

'

' ==============================================================================

'

' MULTIMEDIA FORMATS:

' -------------------

'

' Audio:  aiff, amr, flac, m4a, midi, mp2, mp3, wav, wma

' Video:  avi, mpg, mpeg, mp4, m4v, asf, wmv

'

' * Amr format not recommended; playback sounds low quality

' * Avi format has no audio playback

'

' * Formerly, only wav, mid, mp3, avi, mpg and mpeg were supported.

'

'

' ==============================================================================

'

' METHODS:

' --------

'

' CLOSE:    Closes the currently loaded file.

' * SYNTAX: .mmClose

'

'         - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

'

' OPEN:     Opens the desired file. Optionally sets a window for video display.

' * SYNTAX: .mmOpen filename [, object]

'           * filename: The full filename (with path) to be loaded for playback.

'           * object:   (Optional) The hwnd supported form object for video use.

'

'         - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

'

' PAUSE:    Pauses the file or resumes playback.

' * SYNTAX: .mmPause

'

'         - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

'

' PLAY:     Plays the loaded file. Optionally accepts whether the file loops.

' * SYNTAX: .mmPlay [, repeat]

'           * repeat:   (Optional) True/False if the multimedia file loops.

'

'         - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

'

' SEEK:     Sets current playback to a specific position within the file.

' * SYNTAX: .mmSeek location

'           * location: The point within the file (in millisecond) to advance

'

'         - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

'

' SEEK INCREMENT: Sets playback to a position based on 1/1000th of its length.

' * SYNTAX: .mmSeekIncr value

'           * value: (Range 0-1000) The point based on 1/100th of its length.

'

'         - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

'

' STOP:     Ends playback of the loaded file. Sets the reader to the file's end.

' * SYNTAX: .mmStop

'

' ------------------------------------------------------------------------------

'

'

' ------------------------------------------------------------------------------

'

' PROPERTIES:

' -----------

'

' FILENAME: Retrieves the name of the currently loaded file.

' * SYNTAX: returned = .Filename

'           * returned: (String) The name of the currently loaded file

'

'         - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

'

' FILENAME: Opens a specified filename. Does not define a window like OPEN.

' * SYNTAX: .Filename filename

'           * filename: The full filename (with path) to be loaded for playback.

'

'         - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

'

' LENGTH:   Retrieves the length/duration of the current file in milliseconds.

' * SYNTAX: returned = .Length

'           * returned: (Single) The file's playback duration in milliseconds

'

'         - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

'

' PAUSED:   Retrieves if media playback was temporarily halted.

' * SYNTAX: returned = .Paused

'           * returned: (Boolean) Returns True/False on pause status

'

'         - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

'

' PERCENT:  Retrieves the percent of the file played to one decimal position.

' * SYNTAX: returned = .percent

'           * returned: (Single: Range of 0.0-100.0) Current amount played.

'

'         - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

'

' POSITION: Retrieves the current playback position of the current file.

' * SYNTAX: returned = .Position

'           * returned: The full filename (with path) to be loaded for playback.

'

'         - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

'

' POSITION: (as Seek) Sets playback to a specified position of the current file.

' * SYNTAX: .Position location

'           * location: The point within the file (in millisecond) to advance.

'

'         - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

'

' TO_BEGIN: Retrives (in milliseconds) where media playback will begin or resume

' * SYNTAX: returned = .To_Begin

'           * returned: (Single) The position where media playback starts.

'

'         - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

'

' TO_BEGIN: Defines where playback begins, or where to return if set to repeat.

' * SYNTAX: .To_Begin location

'           * location: The point within the file (in millisecond) to start.

'           NOTE:  It must be called 'after' [To_Reloop] if both are used together.

'

'         - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

'

' TO_END:   Retrives (in milliseconds) where media playback is set to end.

' * SYNTAX: returned = .To_End

'           * returned: (Single) The position where media playback ends.

'

'         - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

'

' TO_END:   Defines where playback ends if not at the end of the current file.

' * SYNTAX: .To_End location

'           * location: The point within the file (in millisecond) to end.

'

'         - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

'

' TO_RELOOP: Defines where playback ends if not at the end of the current file.

' * SYNTAX:  .To_ReLoop location

'            * location: The point in the file (in millisecond) to restart loop.

'            NOTE:  If used in tandem with [To_Begin], it must be called first.

'

'         - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

'

' VOLUME:   Gets the playback volume.

' * SYNTAX: returned = .Volume

'           * returned: (Long) The volume amplitude (generally 0-100)

'

'         - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

'

' VOLUME:   Sets the playback volume.

' * SYNTAX: .Volume amplitude

'           * amplitude: The volume of audio playback.

'

'         - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

'

' VOLUME LEFT:  Sets the playback volume for the left volume channel

' * SYNTAX:     .VolumeL amplitude

'               * amplitude: The volume of the left channel playback.

'

'         - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

'

' VOLUME RIGHT: Sets the playback volume for the right volume channel.

' * SYNTAX:     .VolumeR amplitude

'               * amplitude: The volume of the right channel playback.

'

'         - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

' ------------------------------------------------------------------------------

'

'

' ==============================================================================

Option Explicit

' API Function Declarations

' ==============================================================================

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 Variable Declarations

' ==============================================================================

    Private strAlias                As String           ' Mmedia resource name

    Private strFileName             As String           ' Current filename

    Private strFrom                 As String           ' Defined Playback start

    Private strTo                   As String           ' Defined Playback end

    ' --------------------------------------------------------------------------

    Private sngLength               As Single           ' Playback length

    Private sngIncrement            As Single           ' Length divided by 1000

    Private sngPosition             As Single           ' Current position

    Private sngToSkip               As Single           ' Loop flourish skip

    Private sngSeekFrom             As Single           ' Loop starting point

    Private sngSeekTo               As Single           ' Loop ending point

    ' --------------------------------------------------------------------------

    Private strStatus               As String           ' Current playing status

    Private bPlaying                As Boolean          ' If file is playing

    Private bPaused                 As Boolean          ' If paused or not

    Private bRepeat                 As Boolean          ' If loops

    ' --------------------------------------------------------------------------

    Private lngVolume               As Long             ' Current volume

    Private lngVolumeL              As Long             ' (above) Left Volume

    Private lngVolumeR              As Long             ' (above) Right Volume

' ==============================================================================

' = CLASS FUNCTIONS ============================================================

' ==============================================================================

' The Initialization routine

'===============================================================================

Private Sub Class_Initialize()

    '

    strAlias = ""                                       ' Set empty Alias name

    strFileName = ""                                    ' Set empty filename

    bPlaying = False                                    ' No playing at start

    bPaused = False                                     ' No pause at start

    sngToSkip = 0                                       ' Clear loop points

    sngSeekFrom = 0                                     ' Clear loop points

    sngSeekTo = 0                                       ' Clear loop points

    lngVolume = 0                                       ' Clear volume values

    lngVolumeL = 0                                      ' Clear volume values

    lngVolumeR = 0                                      ' Clear volume values

    '

End Sub

' ==============================================================================

' = GENERAL FUNCTIONS ==========================================================

' ==============================================================================

' CLOSE FILE

' Close the currently open multimedia file

' ==============================================================================

Public Sub mmClose()

    '      ---------------------------------------------------------------------

    '

    ' Initialize function variables

    Dim lngReturn       As Long                         ' mciSendString return

    Dim strCmd          As String                       ' Sets the MCI commands

    '

    If strAlias = "" Then Exit Sub                      ' Exit if no file open

    '

    strCmd = "Close " & strAlias                        ' Make MCI Close Command

    lngReturn = mciSendString(strCmd, "", 0, 0)         ' Pass MCI command

    '

    strAlias = ""                                       ' Clear opened file

    strFileName = ""                                    ' Clear filename

    bPlaying = False                                    ' Flag not playing

    '

End Sub

' OPEN FILE

' Open the specified multimedia file and close any others that may be open

' ==============================================================================

Public Sub mmOpen(ByVal strTheFile As String, _

    Optional ByVal objPic As Object = Nothing)

    '      ---------------------------------------------------------------------

    '

    ' Initialize function variables

    Dim lngReturn       As Long                         ' mciSendString return

    Dim strCmd          As String                       ' Sets the MCI commands

    Dim strLen          As String * 255                 ' Gets the file length

    Dim strType         As String                       ' Holds the file type

    Dim intLength       As Integer                      ' Returned data's length

    Dim bVideo          As Boolean                      ' Defined video window

    '

    ' Initialize subroutine constant

    Const WS_CHILD As Long = &H40000000                 ' Define child window

    '

    bPlaying = False                                    ' Flag not playing

    bPaused = False                                     ' Turn off paused flag

    '

    If strAlias <> "" Then mmClose                      ' Close if previous open

    '

    ' Determine playback mode based on file extension

    ' --------------------------------------------------------------------------

    Select Case UCase(Right(strTheFile, 4))             ' Branch on extension

        ' -- AUDIO FORMATS -----------------------------------------------------

        Case ".WAV"                                     ' For Wav extension

            strType = "Waveaudio"                       ' ... assume wave audio

            bVideo = False                              ' ... set no-video usage

        Case ".MID"                                     ' For mid extension

            strType = "Sequencer"                       ' ... assume sequencer

            bVideo = False                              ' ... set no-video usage

        Case "AIFF", ".AMR", "FLAC"                     ' For AIFF, AMR and FLAC

            strType = "MPEGVideo"                       ' ... Mpeg system use

            bVideo = False                              ' ... set no-video usage

        Case ".M4A", ".MP2", ".MP3"                     ' For MP2/3 extensions

            strType = "MPEGVideo"                       ' ... Mpeg system use

            bVideo = False                              ' ... set no-video usage

        Case ".WMA"                                     ' For flaky WMAs

            strType = "MPEGVideo"                       ' ... Mpeg system use

            bVideo = False                              ' ... set no-video usage

        ' -- VIDEO FORMATS -----------------------------------------------------

        Case ".AVI"                                     ' For Avi extension

            strType = "AviVideo"                        ' ... assume avi video

            bVideo = True                               ' ... set video usage

        Case "MPEG", ".MPG", ".MP4"                     ' For MPG, MPEG or MP4

            strType = "MPEGVideo"                       ' ... Mpeg system use

            bVideo = True                               ' ... set video usage

        Case ".ASF", ".M4V"                             ' For ASF or M4V

            strType = "MPEGVideo"                       ' ... Mpeg system use

            bVideo = True                               ' ... set video usage

        Case ".WMV"                                     ' For flaky WMVs

            strType = "MPEGVideo"                       ' ... Mpeg system use

            bVideo = True                               ' ... set video usage

        ' -- NO VALID FORMAT FOUND ---------------------------------------------

        Case Else                                       ' -- otherwise --

            Exit Sub                                    ' Exit if unrecognized

    End Select

    ' --------------------------------------------------------------------------

    '

    strAlias = Right(strTheFile, 3) & Minute(Now)       ' Make unique alias name

    '

    If InStr(strTheFile, " ") Then                      ' If filename has spaces

        strTheFile = Chr(34) & strTheFile & Chr(34)     ' ... wrap in quotes

    End If

    '

    If pvt_ObjExist(objPic) = False Then                ' If no picture object

        bVideo = False                                  ' Force no video usage

    End If

    '

    ' Create the Open MCISendString command

    ' --------------------------------------------------------------------------

    strCmd = "Open " & strTheFile                       ' Make MCI Open command

    strCmd = strCmd & " alias " & strAlias              ' Include alias name

    If bVideo = True Then

        strCmd = strCmd & " parent "                    ' Set target window use

        strCmd = strCmd & CStr(objPic.hWnd)             ' Set actual target

        strCmd = strCmd & " style " & CStr(WS_CHILD)    ' Set as child window

    Else

        strCmd = strCmd & " Type " & strType            ' Add audio type

    End If

    strCmd = strCmd & " WAIT"                           ' Force wait till play

    ' --------------------------------------------------------------------------

    '

    lngReturn = mciSendString(strCmd, "", 0, 0)         ' Pass MCI command

    '

    ' Ensure file set to start position and increments

    ' --------------------------------------------------------------------------

    strCmd = "Status " & strAlias & " length"           ' Make MCI Length cmd

    lngReturn = mciSendString(strCmd, strLen, 255, 0)   ' Pass MCI command

    intLength = InStr(strLen, Chr(0))                   ' Get end of length

    sngLength = Val(Left(strLen, intLength - 1))        ' Set to class variable

    sngIncrement = sngLength / 1000

    '

    ' Define loop start and end defaults

    ' --------------------------------------------------------------------------

    sngToSkip = 0                                       ' Loop flourish point

    sngSeekFrom = 0                                     ' Loop starting point

    sngSeekTo = sngLength                               ' Loop ending point

    ' --------------------------------------------------------------------------

    '

    ' Ensure file set to start position

    ' --------------------------------------------------------------------------

    strCmd = "Seek " & strAlias & " to 0"               ' Make MCI Seek Command

    lngReturn = mciSendString(strCmd, "", 0, 0)         ' Pass MCI command

    ' --------------------------------------------------------------------------

    '

End Sub

' PAUSE PLAYBACK

' Pause playback of the file

' ==============================================================================

Public Sub mmPause()

    '      ---------------------------------------------------------------------

    '

    ' Initialize function variables

    Dim lngReturn       As Long                         ' mciSendString return

    Dim strCmd          As String                       ' Sets the MCI commands

    '

    If strAlias = "" Then Exit Sub                      ' Exit if no file open

    '

    If bPlaying = False Then Exit Sub                   ' Exit if not playing

    '

    If bPaused = False Then                             ' If already paused

        bPaused = True                                  ' ... set flag n pause

        strCmd = "Pause " & strAlias                    ' Make MCI Pause Command

    Else

        bPaused = False                                 ' ... set flag n play

        strCmd = "Resume " & strAlias                   ' Make MCI Resume Cmnd

    End If

    '

    lngReturn = mciSendString(strCmd, "", 0, 0)         ' Pass MCI command

    '

End Sub

' PLAY FILE

' Plays the currently open file from the current position

' ==============================================================================

Public Sub mmPlay()

    '      ---------------------------------------------------------------------

    '

    ' Initialize function variables

    Dim lngReturn       As Long                         ' mciSendString return

    Dim strCmd          As String                       ' Sets the MCI commands

    Dim strTo2 As String

    '

    If strAlias = "" Then Exit Sub                      ' Exit if no file open

    '

    bPlaying = True                                     ' Flag IS playing

    bPaused = False                                     ' Playing, not paused

    '

    strCmd = "Play " & strAlias                         ' Make MCI Play Command

    strFrom = " from " & Trim(Str(sngSeekFrom))         ' Set start position

    strCmd = strCmd & strFrom                           ' Add to Play command

    '

    If pvt_LoopCheck = False Then                       ' If no custom loops

        If bRepeat = True Then                          ' If set to repeat

            strCmd = strCmd & " Repeat"                 ' Add repeat to command

        End If

    End If

    '

    lngReturn = mciSendString(strCmd, "", 0, 0)         ' Pass MCI command

    '

    If bRepeat = False Then Exit Sub                    ' Exit if no repeating

    If pvt_LoopCheck = False Then Exit Sub              ' Exit if no loop spot

    '

    pvt_LoopExecute                                     ' Perform repeat loop

    '

End Sub

' SEEK TO PLAYBACK LOCATION

' Seek a specific position within the file

' ==============================================================================

Public Sub mmSeek(ByVal sngPosition As Single)

    '      ---------------------------------------------------------------------

    '

    ' Initialize function variables

    Dim lngReturn       As Long                         ' mciSendString return

    Dim strCmd          As String                       ' Sets the MCI commands

    '

    strCmd = "Seek " & strAlias                         ' Make MCI Seek Command

    strCmd = strCmd & " to " & Trim(Str(sngPosition))   ' Define seek position

    lngReturn = mciSendString(strCmd, "", 0, 0)         ' Pass MCI command

    '

End Sub

' SEEK TO LOCATION ON INCREMENTAL VALUE

' Seek a specific position within the file based on value

' ==============================================================================

Public Sub mmSeekIncr(ByVal intIncrement As Integer)

    '      ---------------------------------------------------------------------

    '

    ' Initialize function variables

    Dim lngReturn       As Long                         ' mciSendString return

    Dim strCmd          As String                       ' Sets the MCI commands

    Dim sngPosition     As Long

    '

    If intIncrement < 0 Then Exit Sub                   ' Exit if out of range

    If intIncrement > 1000 Then Exit Sub                ' Exit if out of range

    '

    sngPosition = intIncrement * sngIncrement           ' Math based on range

    '

    strCmd = "Seek " & strAlias                         ' Make MCI Seek Command

    strCmd = strCmd & " to " & Trim(Str(sngPosition))   ' Define seek position

    lngReturn = mciSendString(strCmd, "", 0, 0)         ' Pass MCI command

    If bPlaying = False Then Exit Sub                   ' Exit if not playing

    If bPaused = True Then Exit Sub                     ' Exit if paused

    '

    strCmd = "Play " & strAlias                         ' Make MCI Play Command

    '

    If pvt_LoopCheck = False Then                       ' If no custom loops

        If bRepeat = True Then                          ' If set to repeat

            strCmd = strCmd & " Repeat"                 ' Add repeat to command

        End If

    End If

    '

    lngReturn = mciSendString(strCmd, "", 0, 0)         ' Pass MCI command

    '

End Sub

' STOP PLAYBACK

' Stop using a file totally. Running or not.

' ==============================================================================

Public Sub mmStop()

    '      ---------------------------------------------------------------------

    '

    ' Initialize function variables

    Dim lngReturn       As Long                         ' mciSendString return

    Dim strCmd          As String                       ' Sets the MCI commands

    Dim sngLength       As Single                       ' Sets playback length

    '

    If strAlias = "" Then Exit Sub                      ' Exit if no file open

    '

    bPlaying = False                                    ' Flag not playing

    '

    strCmd = "Stop " & strAlias                         ' Make MCI Stop Command

    lngReturn = mciSendString(strCmd, "", 0, 0)         ' Pass MCI command

    '

    sngLength = Length                                  ' Get playback length

    '

    strCmd = "Seek " & strAlias                         ' Make MCI Seek Command

    strCmd = strCmd & " to " & Trim(Str(sngLength))     ' Define seek end

    lngReturn = mciSendString(strCmd, "", 0, 0)         ' Pass MCI command

    '

End Sub

' ==============================================================================

' = PROPERTY SETTINGS ==========================================================

' ==============================================================================

' FILENAME (GET)

' Returns the object FileName Property

' ==============================================================================

Public Property Get Filename() As String

    '           ----------------------------------------------------------------

    '

    Filename = strFileName                              ' Get value from class

    '

End Property

' FILENAME (LET)

' Sets the objects FileName property.

' ==============================================================================

Public Property Let Filename(ByVal New_FileName As String)

    '           ----------------------------------------------------------------

'   Sets the objects FileName property. This also implies

'   that you also want to open the file so control is passed

'   to the mmOpen method

    '

    strFileName = New_FileName

    mmOpen New_FileName

    '

End Property

' PLAYBACK LENGTH (GET)

' Returns the length of the file, the value acquired when file was opened

' ==============================================================================

Public Property Get Length() As Single

    '           ----------------------------------------------------------------

    '

    If strAlias = "" Then                               ' If no file is open

        Length = 0                                      ' Set zero length

        Exit Property                                   ' and Exit

    End If

    '

    Length = sngLength                                  ' Get value from class

    '

End Property

' PAUSED (GET)

' Returns the status of being paused (using in-class variables)

' ==============================================================================

Public Property Get Paused() As Boolean

    '           ----------------------------------------------------------------

    '

    Paused = bPaused                                    ' Get value from class

    '

End Property

' PERCENT (GET)

' Returns the relative position in the media relative to its size in 0-100 range

' ==============================================================================

Public Property Get Percent() As Single

    '           ----------------------------------------------------------------

    '

    ' Initialize property variables

    Dim fLength         As Single                       ' Media file duration

    Dim fPosition       As Single                       ' Current play position

    Dim fPercent        As Single                       ' Percent value as float

    Dim iPercent        As Integer                      ' Integer in deciseconds

    '

    ' Initialize function variables

    If strAlias = "" Then                               ' If no file is open

        Percent = 0                                     ' Set zero length

        Exit Property                                   ' and Exit

    End If

    '

    fLength = Length                                    ' Get media duration

    fPosition = Position                                ' Get current position

    '

    fPercent = fPosition / fLength                      ' Get increment

    iPercent = fPercent * 1000                          ' Get range 0-1000

    Percent = iPercent / 10                             ' Set to range 0.0-100.0

    '

End Property

' PLAYBACK POSITION (GET)

' Returns the current position in the file if a file is open

' ==============================================================================

Public Property Get Position() As Single

    '           ----------------------------------------------------------------

    '

    ' Initialize function variables

    Dim lngReturn       As Long                         ' mciSendString return

    Dim strCmd          As String                       ' Sets the MCI commands

    Dim strPos          As String * 255                 ' Returned pos buffer

    Dim intLength       As Integer                      ' Returned data's length

    '

    If strAlias = "" Then                               ' If no file is open

        Position = 0                                    ' Set zero position

        Exit Property                                   ' and Exit

    End If

    '

    strCmd = "Status " & strAlias & " position"         ' Make MCI Position cmd

    lngReturn = mciSendString(strCmd, strPos, 255, 0)   ' Pass MCI command

    '

    intLength = InStr(strPos, Chr(0))                   ' Get end of position

    Position = Val(Left(strPos, intLength - 1))         ' Set to function

    '

End Property

' PLAYBACK LENGTH (LET)

' Set the position property by seeking

' ==============================================================================

Public Property Let Position(ByVal New_Position As Single)

    '           ----------------------------------------------------------------

    '

    sngPosition = New_Position                          ' Get value from class

    mmSeek New_Position                                 ' Pass into mmSeek

    '

End Property

' REPEAT (GET)

' Returns the objects Repeat property

' ==============================================================================

Public Property Get Repeat() As Boolean

    '           ----------------------------------------------------------------

    '

    Repeat = bRepeat                                    ' Get value from class

    '

End Property

' REPEAT (LET)

' Sets the value of the object Repeat property

' ==============================================================================

Public Property Let Repeat(ByVal New_Repeat As Boolean)

    '           ----------------------------------------------------------------

    '

    bRepeat = New_Repeat                                ' Set into class value

    '

End Property

' PLAYBACK STATUS (GET)

' Return the playback/record status of the current file

' ==============================================================================

Public Property Get Status() As String

    '           ----------------------------------------------------------------

    '

    ' Initialize function variables

    Dim lngReturn       As Long                         ' mciSendString return

    Dim strCmd          As String                       ' Sets the MCI commands

    Dim strStat         As String * 255                 ' Returned status buffer

    Dim intLength       As Integer                      ' Returned data's length

    '

    If strAlias = "" Then Exit Property                 ' Exit if no file open

    '

    strCmd = "Status " & strAlias & " mode"             ' Make MCI Status cmd

    lngReturn = mciSendString(strCmd, strStat, 255, 0)  ' Pass MCI command

    '

    intLength = InStr(strStat, Chr(0))                  ' Get end of status

    Status = Left(strStat, intLength - 1)               ' Set to function

    '

End Property

' PLAYBACK BEGIN LOOP (GET)

' Retrieves the position (in milliseconds) where the media playback begins

' ==============================================================================

Public Property Get To_Begin() As Single

    '           ----------------------------------------------------------------

    '

    To_Begin = sngSeekFrom                              ' Get value from class

    '

End Property

' PLAYBACK BEGIN LOOP (LET)

' Sets the position(in milliseconds) media playback is to begin or resume

' ==============================================================================

Public Property Let To_Begin(ByVal New_Begin As Single)

    '           ----------------------------------------------------------------

    '

    If New_Begin < 0 Then Exit Property                 ' Exit if invalid point

    If New_Begin > sngLength Then Exit Property         ' Exit if invalid point

    If New_Begin >= sngToSkip Then Exit Property        ' Exit if past To_Skip

    If New_Begin >= sngSeekTo Then Exit Property        ' Exit if past the end

    ' --------------------------------------------------------------------------

    If New_Begin = sngSeekFrom Then Exit Property       ' Exit if already set

    ' --------------------------------------------------------------------------

    sngSeekFrom = New_Begin                             ' Set playback start

    '

End Property

' PLAYBACK BEGIN LOOP (GET)

' Retrieves (in milliseconds) the start position of a loop.

' ==============================================================================

Public Property Get To_End() As Single

    '           ----------------------------------------------------------------

    '

    To_End = sngSeekTo                                  ' Get value from class

    '

End Property

' PLAYBACK BEGIN LOOP (LET)

' Sets the position(in milliseconds) media playback ends, to possibly loop back

' ==============================================================================

Public Property Let To_End(ByVal New_End As Single)

    '           ----------------------------------------------------------------

    '

    If New_End < 0 Then Exit Property                   ' Exit if invalid point

    If New_End > sngLength Then Exit Property           ' Exit if invalid point

    If New_End <= sngToSkip Then Exit Property          ' Exit if before To_Skip

    If New_End <= sngSeekFrom Then Exit Property        ' Exit if before start

    ' --------------------------------------------------------------------------

    If New_End = sngSeekTo Then Exit Property           ' Exit if already set

    ' --------------------------------------------------------------------------

    sngSeekTo = New_End                                 ' Set playback end

    '

End Property

' PLAYBACK RELOOP TO (Let)

' Sets the position(in milliseconds) playback is to resume if it began earlier

' ==============================================================================

Public Property Let To_ReLoop(ByVal New_To_Skip As Single)

    '           ----------------------------------------------------------------

    '

    If New_To_Skip < 0 Then Exit Property               ' Exit if invalid position

    If New_To_Skip > sngLength Then Exit Property       ' Exit if invalid position

    If New_To_Skip >= sngSeekTo Then Exit Property      ' Exit if past loop end

    ' --------------------------------------------------------------------------

    If New_To_Skip = sngToSkip Then Exit Property       ' Exit if already set

    ' --------------------------------------------------------------------------

    sngToSkip = New_To_Skip                             ' Set To_Skip Point

    sngSeekFrom = 0                                     ' Reset start point

    '

End Property

' PLAYBACK VOLUME (GET)

' Return the playback volume of the current file

' ==============================================================================

Public Property Get Volume() As Long

    '           ----------------------------------------------------------------

    '

    ' Initialize function variables

    Dim lngReturn       As Long                         ' mciSendString return

    Dim strCmd          As String                       ' Sets the MCI commands

    Dim strStat         As String * 255                 ' Returned status buffer

    Dim intLength       As Integer                      ' Returned data's length

    '

    If strAlias = "" Then                               ' If no file is open

        Volume = 0                                      ' Set zero volume

        Exit Property                                   ' and Exit

    End If

    '

    strCmd = "Status " & strAlias & " volume"           ' Make MCI Status cmd

    lngReturn = mciSendString(strCmd, strStat, 255, 0)  ' Pass MCI command

    '

    intLength = InStr(strStat, Chr(0))                  ' Get end of status

    Volume = Val(Left(strStat, intLength - 1)) / 10     ' Set to function

    '

End Property

' PLAYBACK VOLUME (LET)

' Sets the playback volume

' ==============================================================================

Public Property Let Volume(ByVal New_Volume As Long)

    '           ----------------------------------------------------------------

    '

    ' Initialize function variables

    Dim lngReturn       As Long                         ' mciSendString return

    Dim strCmd          As String                       ' Sets the MCI commands

    '

    If strAlias = "" Then Exit Property                 ' Exit if no file open

    '

    If New_Volume < 0 Or New_Volume > 100 Then          ' If volume is invalid

        Exit Property                                   ' Exit

    End If

    '

    lngVolume = New_Volume * 10                         ' Set the volume

    '

    strCmd = "setaudio " & strAlias                     ' Make MCI command

    strCmd = strCmd & " Volume to "                     ' Define for volume

    strCmd = strCmd & lngVolume                         ' Define volume level

    lngReturn = mciSendString(strCmd, "", 0, 0&)        ' Pass MCI command

    '

End Property

' PLAYBACK LEFT VOLUME LET)

' Sets the playback volume for the left channel

' ==============================================================================

Public Property Let VolumeL(ByVal New_Volume As Integer)

    '           ----------------------------------------------------------------

    '

    ' Initialize function variables

    Dim lngReturn       As Long                         ' mciSendString return

    Dim strCmd          As String                       ' Sets the MCI commands

    '

    If strAlias = "" Then Exit Property                 ' Exit if no file open

    '

    If New_Volume < 0 Or New_Volume > 100 Then          ' If volume is invalid

        Exit Property                                   ' Exit

    End If

    '

    lngVolumeL = New_Volume * 10                        ' Set the volume

    '

    strCmd = "setaudio " & strAlias                     ' Make MCI command

    strCmd = strCmd & " left volume to "                ' Define left volume

    strCmd = strCmd & lngVolumeL                        ' Define volume level

    lngReturn = mciSendString(strCmd, "", 0, 0&)        ' Pass MCI command

    '

End Property

' PLAYBACK RIGHT VOLUME LET)

' Sets the playback volume for the right channel

' ==============================================================================

Public Property Let VolumeR(ByVal New_Volume As Integer)

    '           ----------------------------------------------------------------

    '

    ' Initialize function variables

    Dim lngReturn       As Long                         ' mciSendString return

    Dim strCmd          As String                       ' Sets the MCI commands

    '

    If strAlias = "" Then Exit Property                 ' Exit if no file open

    '

    If New_Volume < 0 Or New_Volume > 100 Then          ' If volume is invalid

        Exit Property                                   ' Exit

    End If

    '

    lngVolumeR = New_Volume * 10                        ' Set the volume

    '

    strCmd = "setaudio " & strAlias                     ' Make MCI command

    strCmd = strCmd & " right volume to "               ' Define left volume

    strCmd = strCmd & lngVolumeR                        ' Define volume level

    lngReturn = mciSendString(strCmd, "", 0, 0&)        ' Pass MCI command

    '

End Property

' ==============================================================================

' = PRIVATE FUNCTIONS ==========================================================

' ==============================================================================

' CHECK FOR CUSTOM LOOP

' Runs constantly when envoked to repeat media based on custom start/stop points

' ==============================================================================

Private Function pvt_LoopCheck() As Boolean

    '           ----------------------------------------------------------------

    '

    pvt_LoopCheck = False                               ' Set function false

    If sngSeekTo <> sngLength Then pvt_LoopCheck = True ' Set true if loop end

    If sngSeekFrom <> 0 Then pvt_LoopCheck = True       ' Set true if start

    If sngToSkip <> 0 Then pvt_LoopCheck = True         ' Set true if To_Skip

    '

End Function

' EXECUTE CUSTOM LOOP

' Runs constantly when envoked to repeat media based on custom start/stop points

' ==============================================================================

Private Sub pvt_LoopExecute()

    '           ----------------------------------------------------------------

    '

    If bRepeat = False Then Exit Sub                    ' Exit if repeat is OFF

    '

    Do While bPlaying = True                            ' Loop only if playing

        DoEvents                                        ' Permit other functions

        If bRepeat = False Then Exit Do                 ' Exit if repeat is OFF

        If Position >= sngSeekTo Then                   ' If loop end point found

            If sngToSkip > 0 Then                       ' -- if To_Skip exists

                sngSeekFrom = sngToSkip                 ' -- ... replace start

            End If

            mmPlay                                      ' Re-start play

        End If

    Loop

    '

End Sub

' OBJECT EXISTS?

' Returns whether a defined object exists or not

' ==============================================================================

Private Function pvt_ObjExist(objParm As Object) As Boolean

    '           ----------------------------------------------------------------

    '

    pvt_ObjExist = IIf(objParm Is Nothing, False, True)

    '

End Function

Or within the actual Class_MSS.cls format:
Class_MSS.zip (Size: 6.93 KB / Downloads: 77)

Instructions
Plenty... in the code itself.

FAQ
The original code which this was based had no set-up for video playback, no pointing to any hwnd supported objects. This was one of the main additions I included

Credits and Thanks
Thanks to Mark Thesing who wrote the base code in 2002

Terms and Conditions
Use as you see fit. No requirements other than due credit for both Mr. Thesing and myself.

Audio Module

Sun, 23 Jan 2022 13:47:46 +0000

Audio Module (C++ / SFML)
Version 0.2

Description

This is a C++ rewrite of the RPG Maker Audio module implemented with Simple and Fast Multimedia Library by Laurent Gomilla and team.

The end user is responsible for compiling and deploying this in their project. I may provide a plug-n-play DLL later but for now its all on you to figure it out.

The system is written to RGSS3 specifications (and should be backwards compatible with RGSS and RGSS2 since all it does is add features and doesn't change fundamentals.) I have not implemented this in Ruby or any of the RPG Maker systems. It might be awhile but I will get back to that at a later date.

Features

Supports multiple filetypes; wav, ogg, flac, probably others.
Play 1 Background Music
Play 1 Background Sound
Play 1 Music Effect
Play multiple Sound Effects
Adjust fade in/fade out timing of Music Effects
Available Functions : Play, Pause, Stop, Fade In/Out, Replay, Volume=, Pitch=
Please see SFML/Audio for more information.

(NOTE: Lack of mp3 support is a legal issue, apparently. This is outside the scope of my script and more related to SFML. End user is responsible for implementing their own mp3 support, if desired. (I find ogg to be a better format, personally. Ogg BGM and BGS seem to loop better than mp3 so I actually encourage people to switch formats.))

Requirements

SFML (Simple and Fast Multimedia Library)
Should only require SFML/Audio (for audio) and SFML/System (for sf::Time functionality). See header file for more details.
Working knowledge of C++ and the build tools required to compile and run it.

Instructions

This is NOT a plug-n-play RPG Maker script, you'd need to compile it yourself with C++ and configure it to your needs.
While this is designed to be RGSS compliant, it has not been implemented in Ruby/RPG Maker.
I'm just sharing it for anybody who can do something with it.
If I get the C++ and Ruby to communicate, I will return with a full plug-in-play implementation anyone can use.

Content Hidden

Differences from Original RGSS

There are minor differences between this and the vanilla RGSS, RGSS2 and RGSS3 implementations (personal taste)...

When playing Music Effects, all other audio (BGM, BGS, SE) fade out in 2 seconds instead of instant.
When playing Music Effects, the volume of all other audio is reduced to 10 instead of 0.
When playing Music Effects, the volume fades in approximately 4 seconds. Adjustable.
These timing features should be easily adjustable by changing the member variable values in the header file.
NOTE: The Fade Out for music effects should be a minimum of 1.0f or it won't fade out at all. Of course, you can edit the script yourself if you're trying to do, say, a half second.

Source Files

RGL/Audio.hpp

Content Hidden

Code:
/*=============================================================================*/

// ** rgl::Audio

/*-----------------------------------------------------------------------------*/

// Public Members

// ==============

// sf::Music     m_BGM

// sf::Music     m_BGS

// sf::Sound    m_ME

// sf::Vector   m_VectorSE

//

// Public Functions

// ================

// Audio.playBGM()

// Audio.playBGM(name)

// Audio.playBGM(name, volume, pitch)

// Audio.replayBGM()

// Audio.pauseBGM()

// Audio.stopBGM()

// Audio.playBGS()

// Audio.playBGS(name)

// Audio.playBGS(name, volume, pitch)

// Audio.replayBGS()

// Audio.pauseBGS()

// Audio.stopBGS()

// Audio.playME()

// Audio.playME(name)

// Audio.playME(name, volume, pitch)

// Audio.replayME()

// Audio.pauseME()

// Audio.stopME()

// Audio.playSE()

// Audio.playSE(name)

// Audio.playSE(name, volume, pitch)

// Audio.replaySE()

// Audio.pauseSE()

// Audio.stopSE()

// Audio.update()

//

// Private Members

// ===============

// bool     m_waitME

/*=============================================================================*/

#ifndef RGL_AUDIO_H

#define RGL_AUDIO_H

#include 

#include 

#include 

#include 

#include 

#include 

#include 

#include 

#include 

#include 

#include 

/*============================================================================*/

// ** rgl

/*============================================================================*/

namespace rgl {

static const int NUM_OF_SE = 16;

//template sf::Sound;

//template sf::SoundBuffer;

class Audio {

    public:

        // Construct and Destruct

        Audio();

        virtual ~Audio();

        // Public Members

        bool m_OutOfFocus = false;

        // Public Functions : BGM

        bool playBGM(const sf::String& l_name, float volume, float pitch);

        bool playBGM(const sf::String& l_name);

        bool playBGM();

        bool replayBGM();

        void pauseBGM();

        void stopBGM();

        void fadeBGM(float volume, float duration);

        // Public Functions : BGS

        bool playBGS(const sf::String& l_name, float volume, float pitch);

        bool playBGS(const sf::String& l_name);

        bool playBGS();

        bool replayBGS();

        void pauseBGS();

        void stopBGS();

        void fadeBGS(float volume, float duration);

        // Public Functions : ME

        bool playME(const sf::String& l_name, float volume, float pitch);

        bool playME(const sf::String& l_name);

        bool playME();

        bool replayME();

        void pauseME();

        void stopME();

        void fadeME(float volume, float duration);

        // Public Functions : SE

        bool playSE(const sf::String& l_name, float volume, float pitch);

        bool playSE(const sf::String& l_name);

        bool playSE();

        bool replaySE();

        void pauseSE();

        void stopSE();

        void fadeSE(float volume, float duration);

        // Public Functions : Update

        void update();

        void reset();

        void fadeAll(float volume, float duration);

    protected:

        // ...

    private:

        // Private Member Constants

        const float m_MEFadeOutT = 2.0f;

        const float m_MEFadeInT  = 4.0f;

        // Private Member Variables

        sf::Music m_BGM;        // Background Music

        sf::Music m_BGS;        // Background Sound

        sf::Music m_ME;         // Music Effect

        sf::Sound m_SE;         // Sound Effect

        std::deque m_SoundV;

        std::deque m_BufferV;

        int       m_phaseME = 0;// Music Effect phase (0 None, 1 Fade in, 2 Play, 3 Fade Out)

        sf::Clock m_timeME;     // Music effect clock

        sf::Clock m_timeSE;     // Sound effect clock

        sf::Time  m_timeSEMax = sf::seconds(3.0);

        float     m_BGMFadeV    = 0.0; // BGM Fade Volume

        float     m_BGSFadeV    = 0.0; // BGS Fade Volume

        float     m_MEFadeV     = 0.0; // ME Fade Volume

        float     m_SEFadeV     = 0.0; // SE Fade Volume

        float     m_BGMFadeD    = 0.0f; // BGM Fade Duration

        float     m_BGSFadeD    = 0.0f; // BGS Fade Duration

        float     m_MEFadeD     = 0.0f; // ME Fade Duration

        float     m_SEFadeD     = 0.0f; // SE Fade Duration

        float     m_BGMLastV    = 0.0;// BGM Last Volume

        float     m_BGSLastV    = 0.0;// BGS Last Volume

        //float     m_MELastV     = 0.0;// ME Last Volume (Not used/needed)

        float     m_SELastV     = 0.0;// ME Last Volume

        // Private Functions

        void updateBGM();

        void updateBGS();

        void updateME();

        void updateSE();

        void updateSE(int i);

        void updateBuffers();

        void updateMusicEffect();

        // ...Need to add limited vector for sound queue

};

}

#endif //RGL_AUDIO_H

RGL/Audio.cpp

Content Hidden

Code:
/*=============================================================================*/

// ** rgl::Audio

/*-----------------------------------------------------------------------------*/

// Public Members

// ==============

// sf::Music     m_BGM

// sf::Music     m_BGS

// sf::Sound    m_ME

// sf::Vector   m_VectorSE

//

// Public Functions

// ================

// Audio.playBGM()

// Audio.playBGM(name)

// Audio.playBGM(name, volume, pitch)

// Audio.pauseBGM()

// Audio.stopBGM()

// Audio.fadeBGM(volume, duration)

// Audio.playBGS()

// Audio.playBGS(name)

// Audio.playBGS(name, volume, pitch)

// Audio.pauseBGS()

// Audio.stopBGS()

// Audio.fadeBGS(volume, duration)

// Audio.playME()

// Audio.playME(name)

// Audio.playME(name, volume, pitch)

// Audio.pauseME()

// Audio.stopME()

// Audio.fadeME(volume, duration)

// Audio.playSE()

// Audio.playSE(name)

// Audio.playSE(name, volume, pitch)

// Audio.fadeSE(volume, duration)

// Audio.pauseSE()

// Audio.stopSE()

// Audio.fadeSE(volume, duration)

// Audio.reset()

// Audio.fadeAll(duration)

// Audio.update()

//

// Private Members

// ===============

// bool     m_waitME

// float    m_bgmVolB4ME

// float     m_bgsVolB4ME

// float     m_bgmFade

// float     m_bgsFade

/*=============================================================================*/

#include 

#include 

#include 

#include 

#include 

//#include 

/*============================================================================*/

// ** rgl

/*============================================================================*/

namespace rgl {

/*----------------------------------------------------------------------------*/

// ** Audio() [Constructor]

/*----------------------------------------------------------------------------*/

Audio::Audio() {}

/*----------------------------------------------------------------------------*/

// ** ~Audio() [Destructor]

/*----------------------------------------------------------------------------*/

Audio::~Audio() {}

/*----------------------------------------------------------------------------*/

// ** Audio.playBGM(name, volume, pitch)

/*----------------------------------------------------------------------------*/

bool Audio::playBGM(const sf::String& l_name, float volume, float pitch) {

    // If name is empty

    if (l_name.isEmpty()) {

        // Stop the BGM

        m_BGM.stop();

        // Nothing wrong with stopping the BGM

        return true;

    }

    // If unable to open from file

    if (!m_BGM.openFromFile(l_name)) {

        // Error opening file

        return false;

    }

    // Set volume, pitch and loop

    m_BGM.setVolume(volume);

    m_BGM.setPitch(pitch);

    m_BGM.setLoop(true);

    // Play the BGM

    m_BGM.play();

    // Opened file successfully

    return true;

}

/*----------------------------------------------------------------------------*/

// ** Audio.playBGM(name)

/*----------------------------------------------------------------------------*/

bool Audio::playBGM(const sf::String& l_name) {

    // Play BGM by name

    return playBGM(l_name, 80.0, 1.0);

}

/*----------------------------------------------------------------------------*/

// ** Audio.playBGM()

/*----------------------------------------------------------------------------*/

bool Audio::playBGM() {

    // Ensure BGM loops

    m_BGM.setLoop(true);

    // Play BGM without any arguments

    m_BGM.play();

    // Return true

    return true;

}

/*----------------------------------------------------------------------------*/

// ** Audio.replayBGM()

/*----------------------------------------------------------------------------*/

bool Audio::replayBGM() {

    m_BGM.stop();

    m_BGM.play();

    // Return true

    return true;

}

/*----------------------------------------------------------------------------*/

// ** Audio.pauseBGM()

/*----------------------------------------------------------------------------*/

void Audio::pauseBGM() {

    // Pause BGM

    m_BGM.pause();

}

/*----------------------------------------------------------------------------*/

// ** Audio.fadeBGM(volume, duration, memorize = false)

/*----------------------------------------------------------------------------*/

void Audio::fadeBGM(float volume, float duration) {

    // Set BGM fade volume and duration

    m_BGMFadeV = volume;

    m_BGMFadeD = sf::seconds(duration).asSeconds();

}

/*----------------------------------------------------------------------------*/

// ** Audio.stopBGM()

/*----------------------------------------------------------------------------*/

void Audio::stopBGM() {

    // Stop BGM

    m_BGM.stop();

}

/*----------------------------------------------------------------------------*/

// ** Audio.playBGS(name, volume, pitch)

/*----------------------------------------------------------------------------*/

bool Audio::playBGS(const sf::String& l_name, float volume, float pitch) {

    // If name is empty

    if (l_name.isEmpty()) {

        // Stop the BGS

        m_BGS.stop();

        // Nothing wrong with stopping the BGS

        return true;

    }

    // If unable to open from file

    if (!m_BGS.openFromFile(l_name)) {

        // Error opening file

        return false;

    }

    // Set volume, pitch and loop

    m_BGS.setVolume(volume);

    m_BGS.setPitch(pitch);

    m_BGS.setLoop(true);

    // Play the BGS

    m_BGS.play();

    // Opened file successfully

    return true;

}

/*----------------------------------------------------------------------------*/

// ** Audio.playBGS(name)

/*----------------------------------------------------------------------------*/

bool Audio::playBGS(const sf::String& l_name) {

    // Play BGS by name

    return playBGS(l_name, 80.0, 1.0);

}

/*----------------------------------------------------------------------------*/

// ** Audio.playBGS()

/*----------------------------------------------------------------------------*/

bool Audio::playBGS() {

    // Ensure BGS loops

    m_BGS.setLoop(true);

    // Play BGS without any arguments

    m_BGS.play();

    // Return true

    return true;

}

/*----------------------------------------------------------------------------*/

// ** Audio.replayBGS()

/*----------------------------------------------------------------------------*/

bool Audio::replayBGS() {

    // Restart BGS

    m_BGS.stop();

    m_BGS.play();

    // Return true

    return true;

}

/*----------------------------------------------------------------------------*/

// ** Audio.pauseBGS()

/*----------------------------------------------------------------------------*/

void Audio::pauseBGS() {

    // Pause BGS

    m_BGS.pause();

}

/*----------------------------------------------------------------------------*/

// ** Audio.stopBGS()

/*----------------------------------------------------------------------------*/

void Audio::stopBGS() {

    // Stop BGS

    m_BGS.stop();

}

/*----------------------------------------------------------------------------*/

// ** Audio.fadeBGS(volume, duration, memorize = false)

/*----------------------------------------------------------------------------*/

void Audio::fadeBGS(float volume, float duration) {

    // Set BGS fade volume and duration

    m_BGSFadeV = volume;

    m_BGSFadeD = duration;

}

/*----------------------------------------------------------------------------*/

// ** Audio.playME(name, volume, pitch)

/*----------------------------------------------------------------------------*/

bool Audio::playME(const sf::String& l_name, float volume, float pitch) {

    // If name is empty

    if (l_name.isEmpty()) {

        // Ensure phase is 0

        m_phaseME = 0;

        // Stop the ME

        m_ME.stop();

        // Nothing wrong with stopping the ME

        return true;

    }

    // If unable to open from file

    if (!m_ME.openFromFile(l_name)) {

        // Print to console

        cout << "Error loading file" << endl;;

        // Error opening file

        return false;

    }

    // Set phase to 1

    m_phaseME = 1;

    // Set volume, pitch and loop

    m_ME.setVolume(volume);

    m_ME.setPitch(pitch);

    m_ME.setLoop(false);

    // Play the ME

    m_ME.play();

    // Opened file successfully

    return true;

}

/*----------------------------------------------------------------------------*/

// ** Audio.playME(name)

/*----------------------------------------------------------------------------*/

bool Audio::playME(const sf::String& l_name) {

    // Play ME by name

    return playME(l_name, 80.0, 1.0);

}

/*----------------------------------------------------------------------------*/

// ** Audio.playME()

/*----------------------------------------------------------------------------*/

bool Audio::playME() {

    // Ensure ME does not loop

    m_ME.setLoop(false);

    // Play ME without any arguments

    m_ME.play();

    // Return true

    return true;

}

/*----------------------------------------------------------------------------*/

// ** Audio.replayME()

/*----------------------------------------------------------------------------*/

bool Audio::replayME() {

    // Restart ME

    m_ME.stop();

    m_ME.play();

    // Return true

    return true;

}

/*----------------------------------------------------------------------------*/

// ** Audio.pauseME()

/*----------------------------------------------------------------------------*/

void Audio::pauseME() {

    // Pause ME

    m_ME.pause();

}

/*----------------------------------------------------------------------------*/

// ** Audio.stopME()

/*----------------------------------------------------------------------------*/

void Audio::stopME() {

    // Stop ME

    m_ME.stop();

}

/*----------------------------------------------------------------------------*/

// ** Audio.fadeME(volume, duration, memorize = false)

/*----------------------------------------------------------------------------*/

void Audio::fadeME(float volume, float duration) {

    // Set ME fade volume and duration

    m_MEFadeV = volume;

    m_MEFadeD = duration;

}

/*----------------------------------------------------------------------------*/

// ** Audio.playSE(name, volume, pitch)

/*----------------------------------------------------------------------------*/

bool Audio::playSE(const sf::String& l_name, float volume, float pitch) {

    // End function doing nothing if no name given

    if (l_name.isEmpty()) { return true; }

    // Create sound and sound buffer

    sf::Sound sound;

    sf::SoundBuffer buffer;

    // If unable to open from file

    if (!buffer.loadFromFile(l_name)) {

        // Print to console

        cout << "Unable to load Sound Effect" << endl;

        // Error opening file

        return false;

    }

    // Set volume, pitch and loop

    sound.setVolume(volume);

    sound.setPitch(pitch);

    sound.setLoop(false);

    // If sound duration is more than current max time

    if (buffer.getDuration() > m_timeSEMax) {

        // Restart timer and set time max duration

        m_timeSE.restart();

        m_timeSEMax = (buffer.getDuration());

        m_timeSEMax += (buffer.getDuration());

    }

    // Add to vectors

    m_SoundV.push_back(sound);

    m_BufferV.push_back(buffer);

    // Set the last buffer on the stack

    m_SoundV[m_SoundV.size() - 1].setBuffer(m_BufferV[m_BufferV.size() - 1]);

    // Play the sound

    m_SoundV[m_SoundV.size() - 1].play();

    cout << "Playing SE : " << m_SoundV.size() << endl;

    // Opened file successfully

    return true;

}

/*----------------------------------------------------------------------------*/

// ** Audio.playSE(name)

/*----------------------------------------------------------------------------*/

bool Audio::playSE(const sf::String& l_name) {

    // Play SE by name

    return playSE(l_name, 80.0, 1.0);

}

/*----------------------------------------------------------------------------*/

// ** Audio.playSE()

/*----------------------------------------------------------------------------*/

bool Audio::playSE() {

    // Ensure SE does not loop

    m_SE.setLoop(false);

    // Play SE without any arguments

    m_SE.play();

    // Return true

    return true;

}

/*----------------------------------------------------------------------------*/

// ** Audio.replaySE()

/*----------------------------------------------------------------------------*/

bool Audio::replaySE() {

    // Restart SE

    m_SE.stop();

    m_SE.play();

    // Return true

    return true;

}

/*----------------------------------------------------------------------------*/

// ** Audio.pauseSE()

/*----------------------------------------------------------------------------*/

void Audio::pauseSE() {

    // Pause SE

    m_SE.pause();

}

/*----------------------------------------------------------------------------*/

// ** Audio.stopSE()

/*----------------------------------------------------------------------------*/

void Audio::stopSE() {

    // Stop SE

    m_SE.stop();

}

/*----------------------------------------------------------------------------*/

// ** Audio.fadeSE(volume, duration, memorize = false)

/*----------------------------------------------------------------------------*/

void Audio::fadeSE(float volume, float duration) {

    // Set SE fade volume and duration

    m_SEFadeV = volume;

    m_SEFadeD = duration;

}

/*----------------------------------------------------------------------------*/

// ** Audio.reset()

/*----------------------------------------------------------------------------*/

void Audio::reset() {

    m_BGM.stop();

    m_BGS.stop();

    m_ME.stop();

    m_SE.stop();

}

/*----------------------------------------------------------------------------*/

// ** Audio.fadeAll(duration)

/*----------------------------------------------------------------------------*/

void Audio::fadeAll(float volume, float duration) {

    fadeBGM(volume, duration);

    fadeBGS(volume, duration);

    fadeME(volume, duration);

    fadeSE(volume, duration);

}

/*----------------------------------------------------------------------------*/

// ** Audio.update()

/*----------------------------------------------------------------------------*/

void Audio::update() {

    // End method unless a second has passed

    if (m_timeME.getElapsedTime() < sf::seconds(0.1f)) { return; }

    // Update audio

    updateBGM();

    updateBGS();

    updateME();

    updateSE();

    // Update buffers

    updateBuffers();

    // Restart tick

    m_timeME.restart();

}

/*----------------------------------------------------------------------------*/

// ** Audio.updateBGM()

/*----------------------------------------------------------------------------*/

void Audio::updateBGM() {

    // End method if no music is playing

    if (m_BGM.getStatus() == sf::Music::Stopped) { return;}

    // End method if not fading

    if (m_BGMFadeD <= 0.0) { return; }

    // Decrease wait duration

    m_BGMFadeD -= 0.1f;

    // If duration is 0

    if (m_BGMFadeD <= 0.0) {

        // Reset fade to 0

        m_BGMFadeV = m_BGMFadeD = 0.0;

        // End function

        return;

    }

    // If fade volume is more than ME volume

    if (m_BGMFadeV > m_BGM.getVolume()) {

        // Get volume increment

        float vol = (abs(m_BGMFadeV - m_BGM.getVolume()) / m_BGMFadeD);

        // Increase volume

        m_BGM.setVolume(m_BGM.getVolume() + vol);

    // If fade volume is less than ME volume

    } else if (m_BGMFadeV < m_BGM.getVolume()) {

        // Get volume increment

        float vol = (abs(m_BGM.getVolume() - m_BGMFadeV) / m_BGMFadeD);

        // Decrease volume

        m_BGM.setVolume(m_BGM.getVolume() - vol);

    } else if (m_BGMFadeD <= 0.0) {

        // Reset fade to 0

        m_BGMFadeV = m_BGMFadeD = 0.0;

        // End function

        return;

    }

}

/*----------------------------------------------------------------------------*/

// ** Audio.updateBGS()

/*----------------------------------------------------------------------------*/

void Audio::updateBGS() {

    // End method if no music is playing

    if (m_BGS.getStatus() == sf::Music::Stopped) { return;}

    // End method if not fading

    if (m_BGSFadeD <= 0.0) { return; }

    // Decrease wait duration

    m_BGSFadeD -= 0.1f;

    // If duration is 0

    if (m_BGSFadeD <= 0.0) {

        // Reset fade to 0

        m_BGSFadeV = m_BGSFadeD = 0.0;

        // End function

        return;

    }

    // If fade volume is more than ME volume

    if (m_BGSFadeV > m_BGS.getVolume()) {

        // Get volume increment

        float vol = (abs(m_BGSFadeV - m_BGS.getVolume()) / m_BGSFadeD);

        // Increase volume

        m_BGS.setVolume(m_BGS.getVolume() + vol);

    // If fade volume is less than ME volume

    } else if (m_BGSFadeV < m_BGS.getVolume()) {

        // Get volume increment

        float vol = (abs(m_BGS.getVolume() - m_BGSFadeV) / m_BGSFadeD);

        // Decrease volume

        m_BGS.setVolume(m_BGS.getVolume() - vol);

    } else if (m_BGSFadeD <= 0.0) {

        // Reset fade to 0

        m_BGSFadeV = m_BGSFadeD = 0.0;

        // End function

        return;

    }

}

/*----------------------------------------------------------------------------*/

// ** Audio.updateME()

/*----------------------------------------------------------------------------*/

void Audio::updateME() {

    // End method if no music is playing

    if (m_ME.getStatus() == sf::Music::Stopped) { return;}

    // Do internal music effect update

    updateMusicEffect();

    //if (m_MEFadeD <= 0.0) { return; }

    // Decrease wait duration

    m_MEFadeD -= 0.1f;

    // If duration is 0

    if (m_MEFadeD <= 0.0) {

        // Reset fade to 0

        m_MEFadeV = m_MEFadeD = 0.0;

        // End function

        return;

    }

    // If fade volume is more than ME volume

    if (m_MEFadeV > m_ME.getVolume()) {

        // Get volume increment

        float vol = (abs(m_MEFadeV - m_ME.getVolume()) / m_MEFadeD);

        // Increase volume

        m_ME.setVolume(m_ME.getVolume() + vol);

    // If fade volume is less than ME volume

    } else if (m_MEFadeV < m_ME.getVolume()) {

        // Get volume increment

        float vol = (abs(m_ME.getVolume() - m_MEFadeV) / m_MEFadeD);

        // Decrease volume

        m_ME.setVolume(m_ME.getVolume() - vol);

    } else if (m_MEFadeD <= 0.0) {

        // Reset fade to 0

        m_MEFadeV = m_MEFadeD = 0.0;

        // End function

        return;

    }

}

/*----------------------------------------------------------------------------*/

// ** Audio.updateMusicEffect()

/*----------------------------------------------------------------------------*/

void Audio::updateMusicEffect() {

    // Get current and total duration

    float sec = m_ME.getPlayingOffset().asSeconds();

    float all = m_ME.getDuration().asSeconds();

    // If phase 1 : Fade Out

    if (m_phaseME == 1 && sec < 1.0) {

        // Memorize volumes

        m_BGMLastV = m_BGM.getVolume();

        m_BGSLastV = m_BGS.getVolume();

        m_SELastV = ((m_SoundV.size() > 0) ? m_SoundV[0].getVolume() : 80.0 );

        // Trigger a rolling fade out of audio assets

        fadeBGM(10.0, m_MEFadeOutT);

        fadeBGS(10.0, m_MEFadeOutT);

        fadeSE(10.0, m_MEFadeOutT);

        // Set next phase : play the body of the music effect

        m_phaseME = 2;

        // End function

        return;

    // If phase 2 : Play Body

    } else if (m_phaseME == 2 &&

    (sec > 1.0 && sec < (all * 0.9))) {

        // Set next phase : fade back in

        m_phaseME = 3;

        // End function

        return;

    // If phase 3 : Fade In

    } else if (m_phaseME == 3 && sec > (all * 0.9)) {

        // Trigger a rolling fade in of audio assets

        fadeBGM(m_BGMLastV, m_MEFadeInT);

        fadeBGS(m_BGSLastV, m_MEFadeInT);

        fadeSE(m_SELastV, m_MEFadeInT);

        // Set next phase : DONE

        m_phaseME = 0;

        // End function

        return;

    }

}

/*----------------------------------------------------------------------------*/

// ** Audio.updateSE()

/*----------------------------------------------------------------------------*/

void Audio::updateSE() {

    // Update each sound

    for(unsigned int i = 0; i < m_SoundV.size() ; i++){ updateSE(i);}

}

/*----------------------------------------------------------------------------*/

// ** Audio.updateSE()

/*----------------------------------------------------------------------------*/

void Audio::updateSE(int i) {

    // End method if no music is playing

    if (m_SoundV[i].getStatus() == sf::Sound::Stopped) {

        // Erase sound at iterator position

        m_SoundV.erase(m_SoundV.begin()+i);

        // Print to console

        return;

    }

    // End method if not fading

    if (m_SEFadeD <= 0.0) { return; }

    // Decrease wait duration

    m_SEFadeD -= 0.1f;

    // If duration is 0

    if (m_SEFadeD <= 0.0) {

        // Reset fade to 0

        m_SEFadeV = m_SEFadeD = 0.0;

        // End function

        return;

    }

    // If fade volume is more than SE volume

    if (m_SEFadeV > m_SoundV[i].getVolume()) {

        // Get volume increment

        float vol = (abs(m_SEFadeV - m_SoundV[i].getVolume()) / m_SEFadeD);

        // Increase volume

        m_SoundV[i].setVolume(m_SoundV[i].getVolume() + vol);

    // If fade volume is less than SE volume

    } else if (m_SEFadeV < m_SoundV[i].getVolume()) {

        // Get volume increment

        float vol = (abs(m_SoundV[i].getVolume() - m_SEFadeV) / m_SEFadeD);

        // Decrease volume

        m_SoundV[i].setVolume(m_SoundV[i].getVolume() - vol);

    // If fade duration is less than or equal to 0 seconds

    } else if (m_SEFadeD <= 0.0) {

        // Reset fade and volume to 0

        m_SEFadeV = m_SEFadeD = 0.0;

        // End function

        return;

    }

}

/*----------------------------------------------------------------------------*/

// ** Audio.updateBuffers();

/*----------------------------------------------------------------------------*/

void Audio::updateBuffers() {

    // End function if no buffers

    if (m_BufferV.empty()) { return; }

    // Clear buffers if enough time has passed by

    if (m_timeSE.getElapsedTime() >= m_timeSEMax) {

        // Clear buffers and restart timer

        m_BufferV.clear();

        m_timeSE.restart();

    }

}

} // End of rgl::Audio

Author's Notes

Notes : Classes and Memory

Content Hidden

Notes : What Could Be Improved?

Content Hidden

Notes : About (lack of) rbSFML Bindings

I am well aware that there is a SFML bindings for Ruby (rbSFML). It doesn't look like it has been updated in 6 years and I don't know if anybody still uses or supports it, nor do I know how stable it is. The SFML forum doesn't have a sub-forum for it in their bindings so I can only assume rbSFML may not be a stable library? I made the personal choice to do this without rbSFML. I would like to learn for myself how to extend Ruby with C++ so it was a personal choice to do it in C++.

Thank you for checking it out, feel free to lend me a hand if you know anything about this stuff.

Terms and Conditions

End user is responsible for figuring out how to compile and use this themselves. I will only be providing limited support and future updates.
Free to use in commercial and non-commercial projects, you don't even have to credit me (but I do like credits -_^).
SFML has its own terms under the ZLIB/PNG License. SFML is an open source multimedia library written by Laurent Gomilla and a team of programming ninjas.