|
Option Explicit |
|
' ■ クラスモジュール: Cls_SoundPlayer |
|
' 簡易サウンドプレイヤー |
|
|
|
Private Enum MCIERROR |
|
MCIERR_NO_ERROR = 0 |
|
MCIERR_UNRECOGNIZED_KEYWORD = 259 |
|
MCIERR_UNRECOGNIZED_COMMAND = 261 |
|
MCIERR_HARDWARE = 262 |
|
MCIERR_INVALID_DEVICE_NAME = 263 |
|
MCIERR_OUT_OF_MEMORY = 264 |
|
MCIERR_DEVICE_OPEN = 265 |
|
MCIERR_CANNOT_LOAD_DRIVER = 266 |
|
MCIERR_MISSING_COMMAND_STRING = 267 |
|
MCIERR_PARAM_OVERFLOW = 268 |
|
MCIERR_MISSING_STRING_ARGUMENT = 269 |
|
MCIERR_BAD_INTEGER = 270 |
|
MCIERR_PARSER_INTERNAL = 271 |
|
MCIERR_DRIVER_INTERNAL = 272 |
|
MCIERR_MISSING_PARAMETER = 273 |
|
MCIERR_UNSUPPORTED_FUNCTION = 274 |
|
MCIERR_FILE_NOT_FOUND = 275 |
|
MCIERR_DEVICE_NOT_READY = 276 |
|
MCIERR_INTERNAL = 277 |
|
MCIERR_DRIVER = 278 |
|
MCIERR_CANNOT_USE_ALL = 279 |
|
MCIERR_MULTIPLE = 280 |
|
MCIERR_EXTENSION_NOT_FOUND = 281 |
|
MCIERR_OUTOFRANGE = 282 |
|
MCIERR_FLAGS_NOT_COMPATIBLE = 284 |
|
MCIERR_FILE_NOT_SAVED = 286 |
|
MCIERR_DEVICE_TYPE_REQUIRED = 287 |
|
MCIERR_DEVICE_LOCKED = 288 |
|
MCIERR_DUPLICATE_ALIAS = 289 |
|
MCIERR_BAD_CONSTANT = 290 |
|
MCIERR_MUST_USE_SHAREABLE = 291 |
|
MCIERR_MISSING_DEVICE_NAME = 292 |
|
MCIERR_BAD_TIME_FORMAT = 293 |
|
MCIERR_NO_CLOSING_QUOTE = 294 |
|
MCIERR_DUPLICATE_FLAGS = 295 |
|
MCIERR_INVALID_FILE = 296 |
|
MCIERR_NULL_PARAMETER_BLOCK = 297 |
|
MCIERR_UNNAMED_RESOURCE = 298 |
|
MCIERR_NEW_REQUIRES_ALIAS = 299 |
|
MCIERR_NOTIFY_ON_AUTO_OPEN = 300 |
|
MCIERR_NO_ELEMENT_ALLOWED = 301 |
|
MCIERR_NONAPPLICABLE_FUNCTION = 302 |
|
MCIERR_ILLEGAL_FOR_AUTO_OPEN = 303 |
|
MCIERR_FILENAME_REQUIRED = 304 |
|
MCIERR_EXTRA_CHARACTERS = 305 |
|
MCIERR_DEVICE_NOT_INSTALLED = 306 |
|
MCIERR_GET_CD = 307 |
|
MCIERR_SET_CD = 308 |
|
MCIERR_SET_DRIVE = 309 |
|
MCIERR_DEVICE_LENGTH = 310 |
|
MCIERR_DEVICE_ORD_LENGTH = 311 |
|
MCIERR_NO_INTEGER = 312 |
|
MCIERR_WAVE_OUTPUTSINUSE = 320 |
|
MCIERR_WAVE_SETOUTPUTINUSE = 321 |
|
MCIERR_WAVE_INPUTSINUSE = 322 |
|
MCIERR_WAVE_SETINPUTINUSE = 323 |
|
MCIERR_WAVE_OUTPUTUNSPECIFIED = 324 |
|
MCIERR_WAVE_INPUTUNSPECIFIED = 325 |
|
MCIERR_WAVE_OUTPUTSUNSUITABLE = 326 |
|
MCIERR_WAVE_SETOUTPUTUNSUITABLE = 327 |
|
MCIERR_WAVE_INPUTSUNSUITABLE = 328 |
|
MCIERR_WAVE_SETINPUTUNSUITABLE = 329 |
|
MCIERR_SEQ_DIV_INCOMPATIBLE = 336 |
|
MCIERR_SEQ_PORT_INUSE = 337 |
|
MCIERR_SEQ_PORT_NONEXISTENT = 338 |
|
MCIERR_SEQ_PORT_MAPNODEVICE = 339 |
|
MCIERR_SEQ_PORT_MISCERROR = 340 |
|
MCIERR_SEQ_TIMER = 341 |
|
MCIERR_SEQ_PORTUNSPECIFIED = 342 |
|
MCIERR_SEQ_NOMIDIPRESENT = 343 |
|
MCIERR_NO_WINDOW = 346 |
|
MCIERR_CREATEWINDOW = 347 |
|
MCIERR_FILE_READ = 348 |
|
MCIERR_FILE_WRITE = 349 |
|
MCIERR_NO_IDENTITY = 350 |
|
MCIERR_CUSTOM_DRIVER_BASE = 512 |
|
End Enum |
|
|
|
Private Declare PtrSafe Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" ( _ |
|
ByVal lpstrCommand As String, _ |
|
Optional ByVal lpstrReturnString As String = vbNullString, _ |
|
Optional ByVal uReturnLength As Long = 0, _ |
|
Optional ByVal hwndCallback As LongPtr = 0 _ |
|
) As Long |
|
|
|
Private Const SoundAliasPrefix As String = "VBA-SoundPlayer-" |
|
Private Const MaxSoundAliasNumber As Long = 100 |
|
|
|
Private SoundAlias As String |
|
|
|
Public Function InitSound( _ |
|
ByVal SoundPath As String, _ |
|
Optional ByVal PlayStart As Boolean = True _ |
|
) As String |
|
Call StopSound |
|
Dim SoundId As Long |
|
Dim Ret As Long |
|
' [備忘] 未使用のaliasを探して割り当て(Cls_SoundPlayerのインスタンスが並列で使用されている場合を想定) |
|
' TODO: もっと効率的な割り当て方があるかも? |
|
For SoundId = 1 To MaxSoundAliasNumber |
|
SoundAlias = SoundAliasPrefix & SoundId |
|
Ret = mciSendString("open """ & SoundPath & """ alias " & SoundAlias) |
|
If Ret <> MCIERR_DUPLICATE_ALIAS Then Exit For |
|
Next |
|
If Ret <> 0 Then |
|
Err.Raise 9999, Description:="Open Failure [Ret] " & Ret & " [SoundAlias] " & SoundAlias & " [SoundPath] " & SoundPath |
|
SoundAlias = "" |
|
Exit Function |
|
End If |
|
If PlayStart Then Call StartSound |
|
InitSound = SoundAlias |
|
End Function |
|
|
|
Public Sub StartSound() |
|
If SoundAlias = "" Then Exit Sub |
|
Call mciSendString("play " & SoundAlias) |
|
End Sub |
|
|
|
Public Sub SeekSound(ByVal SeekSec As Double, Optional ByVal PlayStart As Boolean = False) |
|
If SoundAlias = "" Then Exit Sub |
|
Call mciSendString("seek " & SoundAlias & " to " & CLng(SeekSec * 1000#)) |
|
If PlayStart Then Call StartSound |
|
End Sub |
|
|
|
Public Sub PauseSound() |
|
If SoundAlias = "" Then Exit Sub |
|
Call mciSendString("pause " & SoundAlias) |
|
End Sub |
|
|
|
Public Sub ResumeSound() |
|
If SoundAlias = "" Then Exit Sub |
|
Call mciSendString("resume " & SoundAlias) |
|
End Sub |
|
|
|
Public Sub StopSound() |
|
If SoundAlias = "" Then Exit Sub |
|
Call mciSendString("stop " & SoundAlias) |
|
Call mciSendString("close " & SoundAlias) |
|
SoundAlias = "" |
|
End Sub |
|
|
|
Public Sub CloseAllSounds() |
|
' [備忘] Cls_SoundPlayerでopenされたすべてのサウンドをclose(VBEによる強制停止時等、正しく再生が停止されなかった場合等の利用を想定) |
|
' TODO: もっと効率的なやり方があるかも? |
|
Dim SoundId As Long |
|
For SoundId = 1 To MaxSoundAliasNumber |
|
SoundAlias = SoundAliasPrefix & SoundId |
|
Call StopSound |
|
Next |
|
End Sub |
|
|
|
Private Sub Class_Terminate() |
|
Call StopSound |
|
End Sub |