실시간 오디오 재생 위치 및 바(Progress bar) 표시

 

오디오를 MCISendString API를 이용해서 재생/일시정지/재시작/정지할 수 있습니다.

여기서 재생위치를 실시간으로 Timer API를 이용해서  표시하는 예시입니다.

 

MCISendString 명령어 목록:

https://docs.microsoft.com/en-us/windows/win32/multimedia/multimedia-command-strings?redirectedfrom=MSDN

 

실행 영상:

 

 

코드 보기:

Option Explicit

#If VBA7 Then
    Public Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, _
        ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
    Public Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
    
    Public Declare PtrSafe Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" _
        (ByVal lpstrCommand As String, ByVal lpstrReturnString As Any, _
        ByVal uReturnLength As Long, ByVal hwndCallback As LongPtr) As Long
    
    Public TimerID As LongPtr
#Else
    Public Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, _
        ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
    Public Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
    
    Public Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" _
        (ByVal lpstrCommand As String, ByVal lpstrReturnString As Any, _
        ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
    
    Public TimerID As Long
#End If
    
Const FileName As String = "bensound.mp3"
Dim TimerPause  As Boolean
Dim audioLength As Long
Const sldNum As Long = 1

Function getLength() As Long
    Dim RetString As String * 256
    
    mciSendString "Set SoundFile time format milliseconds", vbNullString, 0, 0&
    mciSendString "Status SoundFile length", RetString, Len(RetString), 0&
    getLength = (RetString) / 1000
    
End Function

Function getPosition() As Long
    Dim RetString As String * 256
    
    mciSendString "Status SoundFile position", RetString, Len(RetString), 0&
    getPosition = (RetString) / 1000
    
End Function

Function getStatus() As Variant
    Dim RetString As String * 256
    
    mciSendString "Status SoundFile mode", RetString, Len(RetString), 0&
    getStatus = (RetString) '\ 1000
    ActivePresentation.Slides(sldNum).Shapes("Status").TextFrame.TextRange = getStatus
End Function

'Show the current position
Private Sub myTimer()
    On Error Resume Next
    If TimerPause Then Exit Sub
    
    Dim sld As Slide
    Dim posShp As Shape, lineShp As Shape
    Dim p As Long

    p = getPosition
    
    Set sld = ActivePresentation.Slides(sldNum)
    Set posShp = sld.Shapes("position")
    Set lineShp = sld.Shapes("line")
 
    Call showTime("time", p)
    
    With posShp
        .Left = lineShp.Left + lineShp.Width * (p / audioLength) - .Width / 2
    End With
    
    getStatus
End Sub

Function showTime(strShp As String, lngtime As Long)
    ActivePresentation.Slides(sldNum).Shapes(strShp).TextFrame.TextRange = _
        Format(lngtime \ 60, "00") & ":" & Format(lngtime Mod 60, "00")
End Function

Sub PlayAudio()
    
    Call showTime("time", 0)
    mciSendString "close all", vbNullString, 0, 0&
    'enclose the FileName with Chr(34)s for a long filename with blank characters
    mciSendString "Open " & Chr(34) & FileName & Chr(34) & " alias SoundFile", vbNullString, 0, 0&
    mciSendString "Play SoundFile", vbNullString, 0, 0&
    'mciSendString "record record", vbNullString, 0, 0&
    audioLength = getLength
    Call showTime("time_end", audioLength)
    startTimer
End Sub

Sub PauseAudio()
    If TimerPause Then
        mciSendString "Resume SoundFile", vbNullString, 0, 0&
    Else
        mciSendString "Pause SoundFile", vbNullString, 0, 0&
    End If
    pauseTimer
    getStatus
End Sub

Sub StopAudio()

    mciSendString "Stop SoundFile", vbNullString, 0, 0&
    stopTimer
    Call showTime("time", 0)
    Call showTime("time_end", 0)
    With ActivePresentation.Slides(sldNum)
        .Shapes("position").Left = .Shapes("line").Left - .Shapes("position").Width / 2
    End With
    getStatus
End Sub

Private Sub startTimer()
    If TimerID = 0& Then
        TimerID = SetTimer(0&, 0&, 500&, AddressOf myTimer)  ' 1000 = 1초, 500 = 0.5초
    End If
End Sub

Private Sub stopTimer()
    On Error Resume Next
    KillTimer 0&, TimerID
    TimerID = 0&
    TimerPause = False
End Sub

Function pauseTimer()
    TimerPause = Not TimerPause
End Function

Sub onSlideShowTerminate(SSW As SlideShowWindow)
    stopTimer
    mciSendString "close all", vbNullString, 0, 0&
End Sub

 

파일 다운로드:

AudioProgress1.pptm

0.05MB

Status 추가 버전:

AudioProgress2.pptm

0.05MB

 

현재 폴더에 bensound.mp3파일이 있어야 합니다. 다른 파일로 바꿀 수 있습니다.

bensound.mp3

3.19MB

출처:bensound.com