├── .gitattributes ├── .gitignore ├── CWaveFile.cls ├── Demos ├── Generate │ ├── PureTone.vbp │ ├── PureTone.vbw │ ├── modMain.bas │ └── test.wav └── Play │ ├── PlayFile.vbp │ ├── PlayFile.vbw │ ├── file.wav │ └── modMain.bas └── README.md /.gitattributes: -------------------------------------------------------------------------------- 1 | # Auto detect text files and perform LF normalization 2 | * text=auto 3 | * text eol=crlf 4 | 5 | *.bin binary 6 | *.tlb binary 7 | *.ico binary 8 | *.cur binary 9 | *.exe binary 10 | *.dll binary 11 | *.frx binary 12 | *.exp binary 13 | *.lib binary 14 | *.pdb binary 15 | *.RES binary 16 | *.obj binary 17 | *.png binary 18 | *.wav binary -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.vbw 2 | *.pdb 3 | *.exp 4 | *.lib -------------------------------------------------------------------------------- /CWaveFile.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | Persistable = 0 'NotPersistable 5 | DataBindingBehavior = 0 'vbNone 6 | DataSourceBehavior = 0 'vbNone 7 | MTSTransactionMode = 0 'NotAnMTSObject 8 | END 9 | Attribute VB_Name = "CWaveFile" 10 | Attribute VB_GlobalNameSpace = False 11 | Attribute VB_Creatable = True 12 | Attribute VB_PredeclaredId = False 13 | Attribute VB_Exposed = False 14 | ' // 15 | ' // CWaveFile.cls - class for working with WAVE-PCM files 16 | ' // By The trick, 2021 17 | ' // ver. 1.0 18 | ' // 19 | 20 | Option Explicit 21 | Option Base 0 22 | 23 | Public Enum eChannelsMask 24 | CM_0 = 1 25 | CM_1 = 2 26 | CM_2 = 4 27 | CM_3 = 8 28 | CM_4 = 16 29 | CM_5 = 32 30 | CM_6 = 64 31 | CM_7 = 128 32 | CM_LR = 3 33 | CM_ALL = 255 34 | End Enum 35 | 36 | Private Const MODULE_NAME As String = "CWaveFile" 37 | 38 | Private Const FOURCC_MEM As Long = &H204D454D 39 | Private Const MMIO_CREATERIFF As Long = &H20 40 | Private Const MMIO_DIRTY As Long = &H10000000 41 | Private Const MMIO_CREATE As Long = &H1000 42 | Private Const MMIO_WRITE As Long = &H1 43 | Private Const MMIO_READWRITE As Long = &H2 44 | Private Const WAVE_FORMAT_PCM As Long = 1 45 | Private Const WAVE_FORMAT_EXTENSIBLE As Long = -2 46 | Private Const WAVE_FORMAT_IEEE_FLOAT As Long = 3 47 | Private Const SEEK_SET As Long = 0 48 | Private Const MMIO_FINDCHUNK As Long = &H10 49 | Private Const MMIO_FINDRIFF As Long = &H20 50 | Private Const GMEM_FIXED As Long = &H0 51 | Private Const FADF_AUTO As Long = 1 52 | Private Const FOURCC_RIFF As Long = &H46464952 53 | Private Const FOURCC_WAVE As Long = &H45564157 54 | Private Const FOURCC_FMT As Long = &H20746D66 55 | Private Const FOURCC_DATA As Long = &H61746164 56 | Private Const KSDATAFORMAT_SUBTYPE_PCM_STR As String = "00000001-0000-0010-8000-00AA00389B71" 57 | Private Const KSDATAFORMAT_SUBTYPE_IEEE_FLOAT_STR As String = "00000003-0000-0010-8000-00aa00389b71" 58 | Private Const SND_MEMORY As Long = &H4 ' lpszSoundName points to a memory file 59 | Private Const SND_SYNC As Long = &H0 ' play synchronously (default) 60 | 61 | Private Type UUID 62 | Data1 As Long 63 | Data2 As Integer 64 | Data3 As Integer 65 | Data4(7) As Byte 66 | End Type 67 | 68 | Private Type SAFEARRAYBOUND 69 | cElements As Long 70 | lLBound As Long 71 | End Type 72 | 73 | Private Type SAFEARRAY 74 | cDims As Integer 75 | fFeatures As Integer 76 | cbElements As Long 77 | cLocks As Long 78 | pvData As Long 79 | Bounds As SAFEARRAYBOUND 80 | End Type 81 | 82 | Private Type MMCKINFO 83 | ckid As Long 84 | ckSize As Long 85 | fccType As Long 86 | dwDataOffset As Long 87 | dwFlags As Long 88 | End Type 89 | 90 | Private Type MMIOINFO 91 | dwFlags As Long 92 | fccIOProc As Long 93 | pIOProc As Long 94 | wErrorRet As Long 95 | htask As Long 96 | cchBuffer As Long 97 | pchBuffer As Long 98 | pchNext As Long 99 | pchEndRead As Long 100 | pchEndWrite As Long 101 | lBufOffset As Long 102 | lDiskOffset As Long 103 | adwInfo(4) As Long 104 | dwReserved1 As Long 105 | dwReserved2 As Long 106 | hmmio As Long 107 | End Type 108 | 109 | Private Type WAVEFORMATEXTENSIBLE 110 | wFormatTag As Integer 111 | nChannels As Integer 112 | nSamplesPerSec As Long 113 | nAvgBytesPerSec As Long 114 | nBlockAlign As Integer 115 | wBitsPerSample As Integer 116 | cbSize As Integer 117 | wValidBitsPerSample As Integer 118 | dwChannelMask As Long 119 | guidSubFormat As UUID 120 | End Type 121 | 122 | Private Type tTestWaveFile 123 | lRIFFID As Long 124 | lRIFFSize As Long 125 | lDataTypeID As Long 126 | lFmtCunkID As Long 127 | lFmtChunkSize As Long 128 | wFormatTag As Integer 129 | wNumOfChannels As Integer 130 | nSamplesPerSec As Long 131 | nAvgBytesPerSec As Long 132 | nBlockAlign As Integer 133 | wBitsPerSample As Integer 134 | lDataChunkID As Long 135 | lDataChunkSize As Long 136 | End Type 137 | 138 | Private Type tTestWaveExFile 139 | lRIFFID As Long 140 | lRIFFSize As Long 141 | lDataTypeID As Long 142 | lFmtCunkID As Long 143 | lFmtChunkSize As Long 144 | wFormatTag As Integer 145 | wNumOfChannels As Integer 146 | nSamplesPerSec As Long 147 | nAvgBytesPerSec As Long 148 | nBlockAlign As Integer 149 | wBitsPerSample As Integer 150 | cbSize As Integer 151 | wValidBits As Integer 152 | dwChannelMask As Long 153 | guidSubFormat As UUID 154 | lDataChunkID As Long 155 | lDataChunkSize As Long 156 | End Type 157 | 158 | Private Declare Function mmioClose Lib "winmm.dll" ( _ 159 | ByVal hmmio As Long, _ 160 | Optional ByVal uFlags As Long) As Long 161 | Private Declare Function mmioOpen Lib "winmm.dll" _ 162 | Alias "mmioOpenW" ( _ 163 | ByVal szFileName As Long, _ 164 | ByRef lpmmioinfo As Any, _ 165 | ByVal dwOpenFlags As Long) As Long 166 | Private Declare Function mmioStringToFOURCC Lib "winmm.dll" _ 167 | Alias "mmioStringToFOURCCA" ( _ 168 | ByVal sz As String, _ 169 | ByVal uFlags As Long) As Long 170 | Private Declare Function mmioAscend Lib "winmm.dll" ( _ 171 | ByVal hmmio As Long, _ 172 | ByRef lpck As MMCKINFO, _ 173 | ByVal uFlags As Long) As Long 174 | Private Declare Function mmioCreateChunk Lib "winmm.dll" ( _ 175 | ByVal hmmio As Long, _ 176 | ByRef lpck As MMCKINFO, _ 177 | ByVal uFlags As Long) As Long 178 | Private Declare Function mmioWrite Lib "winmm.dll" ( _ 179 | ByVal hmmio As Long, _ 180 | ByRef pch As Any, _ 181 | ByVal cch As Long) As Long 182 | Private Declare Function mmioDescend Lib "winmm.dll" ( _ 183 | ByVal hmmio As Long, _ 184 | ByRef lpck As MMCKINFO, _ 185 | ByRef lpckParent As Any, _ 186 | ByVal uFlags As Long) As Long 187 | Private Declare Function mmioSeek Lib "winmm.dll" ( _ 188 | ByVal hmmio As Long, _ 189 | ByVal lOffset As Long, _ 190 | ByVal iOrigin As Long) As Long 191 | Private Declare Function memcpy Lib "kernel32" _ 192 | Alias "RtlMoveMemory" ( _ 193 | ByRef Destination As Any, _ 194 | ByRef Source As Any, _ 195 | ByVal Length As Long) As Long 196 | Private Declare Function mmioRead Lib "winmm.dll" ( _ 197 | ByVal hmmio As Long, _ 198 | ByRef pch As Any, _ 199 | ByVal cch As Long) As Long 200 | Private Declare Function mmioGetInfo Lib "winmm.dll" ( _ 201 | ByVal hmmio As Long, _ 202 | ByRef lpmmioinfo As Any, _ 203 | ByVal wFlags As Long) As Long 204 | Private Declare Function GlobalAlloc Lib "kernel32" ( _ 205 | ByVal wFlags As Long, _ 206 | ByVal dwBytes As Long) As Long 207 | Private Declare Function GlobalFree Lib "kernel32" ( _ 208 | ByVal hMem As Long) As Long 209 | Private Declare Function ArrPtr Lib "msvbvm60" _ 210 | Alias "VarPtr" ( _ 211 | ByRef pArr() As Any) As Long 212 | Private Declare Function UuidFromString Lib "rpcrt4" _ 213 | Alias "UuidFromStringW" ( _ 214 | ByVal pStringUuid As Long, _ 215 | ByRef pUuid As UUID) As Long 216 | Private Declare Function IsEqualGUID Lib "ole32" ( _ 217 | ByRef rguid1 As UUID, _ 218 | ByRef rguid2 As UUID) As Long 219 | Private Declare Function PlaySound Lib "winmm.dll" _ 220 | Alias "PlaySoundW" ( _ 221 | ByRef lpszName As Any, _ 222 | ByVal hModule As Long, _ 223 | ByVal dwFlags As Long) As Long 224 | 225 | Private Declare Sub PutArr Lib "msvbvm60" _ 226 | Alias "PutMem4" ( _ 227 | ByRef pArr() As Any, _ 228 | Optional ByVal pSA As Long = 0) 229 | Private Declare Sub GetMem4 Lib "msvbvm60" ( _ 230 | ByRef pSrc As Any, _ 231 | ByRef pDst As Any) 232 | Private Declare Sub MoveArray Lib "msvbvm60" _ 233 | Alias "__vbaAryMove" ( _ 234 | ByRef pDestination() As Any, _ 235 | ByRef pSource() As Any) 236 | 237 | Private m_fSamples() As Single 238 | Private m_lSamples As Long 239 | Private m_lChannels As Long 240 | Private m_lSampleRate As Long 241 | 242 | Public Property Get SampleRate() As Long 243 | SampleRate = m_lSampleRate 244 | End Property 245 | 246 | Public Property Let SampleRate( _ 247 | ByVal lValue As Long) 248 | 249 | Const FULL_PROC_NAME As String = MODULE_NAME & "::" & "SampleRate_put" 250 | 251 | If lValue <= 0 Or lValue > 1000000 Then 252 | Err.Raise 5, FULL_PROC_NAME 253 | End If 254 | 255 | m_lSampleRate = lValue 256 | 257 | End Property 258 | 259 | Public Property Get SamplesCount() As Long 260 | SamplesCount = m_lSamples 261 | End Property 262 | 263 | Public Property Let SamplesCount( _ 264 | ByVal lValue As Long) 265 | 266 | Const FULL_PROC_NAME As String = MODULE_NAME & "::" & "SamplesCount_put" 267 | 268 | If lValue < 0 Then 269 | Err.Raise 5, FULL_PROC_NAME 270 | End If 271 | 272 | If lValue > 0 Then 273 | 274 | If m_lChannels = 0 Then 275 | m_lChannels = 1 276 | End If 277 | 278 | ReDim Preserve m_fSamples(m_lChannels - 1, lValue - 1) 279 | 280 | Else 281 | Erase m_fSamples 282 | End If 283 | 284 | m_lSamples = lValue 285 | 286 | End Property 287 | 288 | Public Property Get Channels() As Long 289 | Channels = m_lChannels 290 | End Property 291 | 292 | Public Property Get Duration() As Double 293 | If m_lSampleRate > 0 Then 294 | Duration = m_lSamples / m_lSampleRate 295 | End If 296 | End Property 297 | 298 | ' // Play all as 16-bit 299 | Public Sub Play( _ 300 | ByVal eChannelsMask As eChannelsMask, _ 301 | ByVal lStartSample As Long, _ 302 | ByVal lCountOfSamples As Long) 303 | 304 | Const FULL_PROC_NAME As String = MODULE_NAME & "::" & "Play" 305 | 306 | Dim tFileHeader As tTestWaveExFile 307 | Dim iFileData() As Integer 308 | Dim lIndex As Long 309 | Dim bChUsage(7) As Boolean 310 | Dim lChIndex As Long 311 | Dim lDstIndex As Long 312 | Dim fValue As Single 313 | 314 | If lStartSample < 0 Or lCountOfSamples < 0 Or lStartSample + lCountOfSamples > m_lSamples Then 315 | Err.Raise 5, FULL_PROC_NAME 316 | End If 317 | 318 | For lIndex = 0 To 7 319 | bChUsage(lIndex) = eChannelsMask And 1 320 | eChannelsMask = eChannelsMask \ 2 321 | Next 322 | 323 | With tFileHeader 324 | 325 | .lRIFFID = FOURCC_RIFF 326 | .lRIFFSize = Len(tFileHeader) - 8 + lCountOfSamples * 2 * m_lChannels 327 | .lDataTypeID = FOURCC_WAVE 328 | .lFmtCunkID = FOURCC_FMT 329 | .lFmtChunkSize = 40 330 | .wFormatTag = WAVE_FORMAT_EXTENSIBLE 331 | .wNumOfChannels = m_lChannels 332 | .wBitsPerSample = 16 333 | .nSamplesPerSec = m_lSampleRate 334 | .nBlockAlign = (.wBitsPerSample \ 8) * .wNumOfChannels 335 | .nAvgBytesPerSec = .nBlockAlign * .nSamplesPerSec 336 | .cbSize = 22 337 | .wValidBits = 16 338 | 339 | If m_lChannels = 1 Then 340 | .dwChannelMask = 4 ' // SPEAKER_FRONT_CENTER 341 | Else 342 | .dwChannelMask = (2 ^ m_lChannels) - 1 343 | End If 344 | 345 | .guidSubFormat = KSDATAFORMAT_SUBTYPE_PCM 346 | .lDataChunkID = FOURCC_DATA 347 | .lDataChunkSize = lCountOfSamples * 2 * m_lChannels 348 | 349 | End With 350 | 351 | ReDim iFileData(Len(tFileHeader) \ 2 + lCountOfSamples * m_lChannels - 1) 352 | 353 | memcpy iFileData(0), tFileHeader, Len(tFileHeader) 354 | 355 | lDstIndex = Len(tFileHeader) \ 2 356 | 357 | For lIndex = 0 To lCountOfSamples - 1 358 | For lChIndex = 0 To m_lChannels - 1 359 | 360 | If bChUsage(lChIndex) Then 361 | 362 | fValue = m_fSamples(lChIndex, lIndex) 363 | 364 | If fValue > 1 Then 365 | fValue = 1 366 | ElseIf fValue < -1 Then 367 | fValue = -1 368 | End If 369 | 370 | iFileData(lDstIndex) = fValue * 32767 371 | 372 | End If 373 | 374 | lDstIndex = lDstIndex + 1 375 | 376 | Next 377 | Next 378 | 379 | If PlaySound(iFileData(0), 0, SND_MEMORY Or SND_SYNC) = 0 Then 380 | Err.Raise 7, FULL_PROC_NAME 381 | End If 382 | 383 | End Sub 384 | 385 | ' // Mix channels and play them as 16-bit mono 386 | Public Sub PlayChannels( _ 387 | ByVal eChannelsMask As eChannelsMask, _ 388 | ByVal lStartSample As Long, _ 389 | ByVal lCountOfSamples As Long) 390 | 391 | Const FULL_PROC_NAME As String = MODULE_NAME & "::" & "PlayChannels" 392 | 393 | Dim tFileHeader As tTestWaveFile 394 | Dim iFileData() As Integer 395 | Dim lIndex As Long 396 | Dim lChannels(7) As Long 397 | Dim lChannelIndex As Long 398 | Dim lMixCount As Long 399 | Dim fValue As Single 400 | 401 | If lStartSample < 0 Or lCountOfSamples < 0 Or lStartSample + lCountOfSamples > m_lSamples Then 402 | Err.Raise 5, FULL_PROC_NAME 403 | End If 404 | 405 | For lIndex = 0 To m_lChannels - 1 406 | 407 | If (eChannelsMask And 1) Then 408 | lChannels(lChannelIndex) = lIndex 409 | lChannelIndex = lChannelIndex + 1 410 | End If 411 | 412 | eChannelsMask = eChannelsMask \ 2 413 | 414 | Next 415 | 416 | lMixCount = lChannelIndex 417 | 418 | With tFileHeader 419 | .lRIFFID = FOURCC_RIFF 420 | .lRIFFSize = Len(tFileHeader) - 8 + lCountOfSamples * 2 421 | .lDataTypeID = FOURCC_WAVE 422 | .lFmtCunkID = FOURCC_FMT 423 | .lFmtChunkSize = &H10 424 | .wFormatTag = WAVE_FORMAT_PCM 425 | .wNumOfChannels = 1 426 | .wBitsPerSample = 16 427 | .nSamplesPerSec = m_lSampleRate 428 | .nBlockAlign = .wBitsPerSample \ 8 * .wNumOfChannels 429 | .nAvgBytesPerSec = .nBlockAlign * .nSamplesPerSec 430 | .lDataChunkID = FOURCC_DATA 431 | .lDataChunkSize = lCountOfSamples * 2 432 | End With 433 | 434 | ReDim iFileData(Len(tFileHeader) \ 2 + lCountOfSamples - 1) 435 | 436 | memcpy iFileData(0), tFileHeader, Len(tFileHeader) 437 | 438 | If lMixCount > 0 Then 439 | 440 | For lIndex = 0 To lCountOfSamples - 1 441 | 442 | fValue = 0 443 | 444 | For lChannelIndex = 0 To lMixCount - 1 445 | fValue = fValue + m_fSamples(lChannels(lChannelIndex), lIndex + lStartSample) 446 | Next 447 | 448 | fValue = fValue / lMixCount 449 | 450 | If fValue > 1 Then 451 | fValue = 1 452 | ElseIf fValue < -1 Then 453 | fValue = -1 454 | End If 455 | 456 | iFileData(lIndex + Len(tFileHeader) \ 2) = fValue * 32767 457 | 458 | Next 459 | 460 | End If 461 | 462 | If PlaySound(iFileData(0), 0, SND_MEMORY Or SND_SYNC) = 0 Then 463 | Err.Raise 7, FULL_PROC_NAME 464 | End If 465 | 466 | End Sub 467 | 468 | Public Sub AddChannel( _ 469 | Optional ByVal lIndex As Long = -1) 470 | 471 | Const FULL_PROC_NAME As String = MODULE_NAME & "::" & "AddChannel" 472 | 473 | Dim fResult() As Single 474 | Dim lSmpIndex As Long 475 | Dim lInChIndex As Long 476 | Dim lOutChIndex As Long 477 | 478 | If lIndex >= 8 Or lIndex < -1 Then 479 | Err.Raise 5, FULL_PROC_NAME 480 | ElseIf m_lChannels >= 8 Then 481 | Err.Raise 9, FULL_PROC_NAME 482 | End If 483 | 484 | If lIndex = -1 Then 485 | lIndex = m_lChannels 486 | End If 487 | 488 | If m_lSamples > 0 Then 489 | 490 | ReDim fResult(m_lChannels, m_lSamples - 1) 491 | 492 | For lSmpIndex = 0 To m_lSamples - 1 493 | 494 | lInChIndex = 0 495 | 496 | For lOutChIndex = 0 To m_lChannels 497 | If lOutChIndex <> lIndex Then 498 | fResult(lOutChIndex, lSmpIndex) = m_fSamples(lInChIndex, lSmpIndex) 499 | lInChIndex = lInChIndex + 1 500 | End If 501 | Next 502 | 503 | Next 504 | 505 | MoveArray m_fSamples, fResult 506 | 507 | End If 508 | 509 | m_lChannels = m_lChannels + 1 510 | 511 | End Sub 512 | 513 | Public Sub RemoveChannel( _ 514 | ByVal lIndex As Long) 515 | 516 | Const FULL_PROC_NAME As String = MODULE_NAME & "::" & "RemoveChannel" 517 | 518 | Dim fResult() As Single 519 | Dim lSmpIndex As Long 520 | Dim lInChIndex As Long 521 | Dim lOutChIndex As Long 522 | 523 | If lIndex < 0 Or lIndex >= m_lChannels Then 524 | Err.Raise 5, FULL_PROC_NAME 525 | End If 526 | 527 | If m_lSamples > 0 Then 528 | 529 | If m_lChannels > 1 Then 530 | 531 | ReDim fResult(m_lChannels - 2, m_lSamples - 1) 532 | 533 | For lSmpIndex = 0 To m_lSamples - 1 534 | 535 | lInChIndex = 0 536 | 537 | For lOutChIndex = 0 To m_lChannels - 2 538 | 539 | If lOutChIndex = lIndex Then 540 | lInChIndex = lInChIndex + 1 541 | End If 542 | 543 | fResult(lOutChIndex, lSmpIndex) = m_fSamples(lInChIndex, lSmpIndex) 544 | 545 | lInChIndex = lInChIndex + 1 546 | 547 | Next 548 | 549 | Next 550 | 551 | MoveArray m_fSamples, fResult 552 | 553 | Else 554 | Erase m_fSamples 555 | m_lSamples = 0 556 | End If 557 | 558 | End If 559 | 560 | m_lChannels = m_lChannels - 1 561 | 562 | End Sub 563 | 564 | ' // Get specified channel data 565 | Public Property Get Channel( _ 566 | ByVal lChannelIndex As Long, _ 567 | ByVal lStartSample As Long, _ 568 | ByVal lCountOfSamples As Long) As Single() 569 | 570 | Const FULL_PROC_NAME As String = MODULE_NAME & "::" & "Channel_get" 571 | 572 | Dim fRet() As Single 573 | Dim lIndex As Long 574 | 575 | If lStartSample < 0 Or lCountOfSamples < 0 Or lStartSample + lCountOfSamples > m_lSamples Or _ 576 | lChannelIndex < 0 Or lChannelIndex >= m_lChannels Then 577 | Err.Raise 5, FULL_PROC_NAME 578 | End If 579 | 580 | If lCountOfSamples Then 581 | 582 | ReDim fRet(lCountOfSamples - 1) 583 | 584 | For lIndex = 0 To lCountOfSamples - 1 585 | fRet(lIndex) = m_fSamples(lChannelIndex, lIndex + lStartSample) 586 | Next 587 | 588 | Channel = fRet 589 | 590 | End If 591 | 592 | End Property 593 | 594 | ' // Mix all the channels using channel mask (bitset corresponds to mixed channels) 595 | Public Property Get Mix( _ 596 | ByVal eChannelsMask As eChannelsMask, _ 597 | ByVal lStartSample As Long, _ 598 | ByVal lCountOfSamples As Long) As Single() 599 | 600 | Const FULL_PROC_NAME As String = MODULE_NAME & "::" & "Mix_get" 601 | 602 | Dim fRet() As Single 603 | Dim lIndex As Long 604 | Dim lChannels(7) As Long 605 | Dim lChannelIndex As Long 606 | Dim lMixCount As Long 607 | 608 | If lStartSample < 0 Or lCountOfSamples < 0 Or lStartSample + lCountOfSamples > m_lSamples Then 609 | Err.Raise 5, FULL_PROC_NAME 610 | End If 611 | 612 | If lCountOfSamples Then 613 | 614 | For lIndex = 0 To m_lChannels - 1 615 | 616 | If (eChannelsMask And 1) Then 617 | lChannels(lChannelIndex) = lIndex 618 | lChannelIndex = lChannelIndex + 1 619 | End If 620 | 621 | eChannelsMask = eChannelsMask \ 2 622 | 623 | Next 624 | 625 | ReDim fRet(lCountOfSamples - 1) 626 | 627 | lMixCount = lChannelIndex 628 | 629 | If lMixCount > 0 Then 630 | 631 | For lIndex = 0 To lCountOfSamples - 1 632 | 633 | For lChannelIndex = 0 To lMixCount - 1 634 | fRet(lIndex) = fRet(lIndex) + m_fSamples(lChannels(lChannelIndex), lIndex + lStartSample) 635 | Next 636 | 637 | If lMixCount > 1 Then 638 | fRet(lIndex) = fRet(lIndex) / lMixCount 639 | End If 640 | 641 | Next 642 | 643 | End If 644 | 645 | Mix = fRet 646 | 647 | End If 648 | 649 | End Property 650 | 651 | ' // Set the specified channel data 652 | Public Property Let Channel( _ 653 | ByVal lChannelIndex As Long, _ 654 | ByVal lStartSample As Long, _ 655 | ByVal lCountOfSamples As Long, _ 656 | ByRef fSamples() As Single) 657 | 658 | Const FULL_PROC_NAME As String = MODULE_NAME & "::" & "Channel_put" 659 | 660 | Dim lIndex As Long 661 | Dim pSA As Long 662 | 663 | If lStartSample < 0 Or lCountOfSamples < 0 Or lStartSample + lCountOfSamples > m_lSamples Or _ 664 | lChannelIndex < 0 Or lChannelIndex >= m_lChannels Then 665 | Err.Raise 5, FULL_PROC_NAME 666 | End If 667 | 668 | If lCountOfSamples Then 669 | 670 | GetMem4 ByVal ArrPtr(fSamples), pSA 671 | 672 | If pSA = 0 Then 673 | Err.Raise 5, FULL_PROC_NAME 674 | ElseIf UBound(fSamples) < lCountOfSamples - 1 Then 675 | Err.Raise 5, FULL_PROC_NAME 676 | End If 677 | 678 | For lIndex = 0 To lCountOfSamples - 1 679 | m_fSamples(lChannelIndex, lIndex + lStartSample) = fSamples(lIndex) 680 | Next 681 | 682 | End If 683 | 684 | End Property 685 | 686 | Public Sub InitNew( _ 687 | ByVal lNumberOfChannels As Long, _ 688 | ByVal lNumberOfSamples As Long, _ 689 | ByVal lSampleRate As Long) 690 | 691 | Const FULL_PROC_NAME As String = MODULE_NAME & "::" & "InitNew" 692 | 693 | If lNumberOfChannels <= 0 Or lNumberOfChannels > 8 Or lNumberOfSamples < 0 Or _ 694 | lSampleRate <= 0 Or lSampleRate > 1000000 Then 695 | Err.Raise 5, FULL_PROC_NAME 696 | End If 697 | 698 | If lNumberOfSamples Then 699 | ReDim m_fSamples(lNumberOfChannels - 1, lNumberOfSamples - 1) 700 | Else 701 | Erase m_fSamples 702 | End If 703 | 704 | m_lChannels = lNumberOfChannels 705 | m_lSamples = lNumberOfSamples 706 | m_lSampleRate = lSampleRate 707 | 708 | End Sub 709 | 710 | Public Sub Save( _ 711 | ByRef sFileName As String, _ 712 | ByVal lBitsPerSample As Long, _ 713 | Optional ByVal bUseFloatFor32bit As Boolean) 714 | 715 | Const FULL_PROC_NAME As String = MODULE_NAME & "::" & "Save" 716 | 717 | Dim hMMFile As OLE_HANDLE 718 | 719 | hMMFile = mmioOpen(StrPtr(sFileName), ByVal 0&, MMIO_READWRITE Or MMIO_CREATE) 720 | If hMMFile = 0 Then 721 | Err.Raise 7, FULL_PROC_NAME, "mmioOpen failed" 722 | End If 723 | 724 | On Error GoTo error_handler 725 | 726 | SaveInternal hMMFile, lBitsPerSample, bUseFloatFor32bit 727 | 728 | mmioClose hMMFile 729 | 730 | Exit Sub 731 | 732 | error_handler: 733 | 734 | If hMMFile Then 735 | mmioClose hMMFile 736 | End If 737 | 738 | Err.Raise Err.Number, FULL_PROC_NAME, Err.Description, Err.HelpFile, Err.HelpContext 739 | 740 | End Sub 741 | 742 | Public Function SaveToMemory( _ 743 | ByVal lBitsPerSample As Long, _ 744 | Optional ByVal bUseFloatFor32bit As Boolean) As Byte() 745 | 746 | Const FULL_PROC_NAME As String = MODULE_NAME & "::" & "SaveToMemory" 747 | 748 | Dim hMMFile As OLE_HANDLE 749 | Dim tIoInfo As MMIOINFO 750 | Dim bOut() As Byte 751 | 752 | With tIoInfo 753 | .fccIOProc = FOURCC_MEM 754 | .cchBuffer = &H10000 755 | .adwInfo(0) = &H80000 756 | End With 757 | 758 | hMMFile = mmioOpen(0, tIoInfo, MMIO_READWRITE Or MMIO_CREATE) 759 | If hMMFile = 0 Then 760 | Err.Raise 7, FULL_PROC_NAME, "mmioOpen failed" 761 | End If 762 | 763 | On Error GoTo error_handler 764 | 765 | SaveInternal hMMFile, lBitsPerSample, bUseFloatFor32bit 766 | 767 | On Error GoTo 0 768 | 769 | If mmioGetInfo(hMMFile, tIoInfo, 0) Then 770 | mmioClose hMMFile 771 | Err.Raise 7, FULL_PROC_NAME, "Unable to get stream info" 772 | End If 773 | 774 | If tIoInfo.pchNext > tIoInfo.pchBuffer Then 775 | 776 | ReDim bOut(tIoInfo.pchNext - tIoInfo.pchBuffer - 1) 777 | 778 | memcpy bOut(0), ByVal tIoInfo.pchBuffer, UBound(bOut) + 1 779 | 780 | End If 781 | 782 | mmioClose hMMFile 783 | 784 | SaveToMemory = bOut 785 | 786 | Exit Function 787 | 788 | error_handler: 789 | 790 | If hMMFile Then 791 | mmioClose hMMFile 792 | End If 793 | 794 | Err.Raise Err.Number, FULL_PROC_NAME, Err.Description, Err.HelpFile, Err.HelpContext 795 | 796 | End Function 797 | 798 | Public Sub Load( _ 799 | ByRef sFileName As String) 800 | 801 | Const FULL_PROC_NAME As String = MODULE_NAME & "::" & "Load" 802 | 803 | Dim hMMFile As OLE_HANDLE 804 | 805 | hMMFile = mmioOpen(StrPtr(sFileName), ByVal 0&, MMIO_READWRITE) 806 | If hMMFile = 0 Then 807 | Err.Raise 7, FULL_PROC_NAME, "mmioOpen failed" 808 | End If 809 | 810 | On Error GoTo error_handler 811 | 812 | LoadInternal hMMFile 813 | 814 | mmioClose hMMFile 815 | 816 | Exit Sub 817 | 818 | error_handler: 819 | 820 | If hMMFile Then 821 | mmioClose hMMFile 822 | End If 823 | 824 | Err.Raise Err.Number, FULL_PROC_NAME, Err.Description, Err.HelpFile, Err.HelpContext 825 | 826 | End Sub 827 | 828 | Public Sub LoadFromMemory( _ 829 | ByVal pData As Long, _ 830 | ByVal lSize As Long) 831 | 832 | Const FULL_PROC_NAME As String = MODULE_NAME & "::" & "LoadFromMemory" 833 | 834 | Dim hMMFile As OLE_HANDLE 835 | Dim tIoInfo As MMIOINFO 836 | 837 | With tIoInfo 838 | .fccIOProc = FOURCC_MEM 839 | .cchBuffer = lSize 840 | .pchBuffer = pData 841 | End With 842 | 843 | hMMFile = mmioOpen(0, tIoInfo, MMIO_READWRITE) 844 | If hMMFile = 0 Then 845 | Err.Raise 7, FULL_PROC_NAME, "mmioOpen failed" 846 | End If 847 | 848 | On Error GoTo error_handler 849 | 850 | LoadInternal hMMFile 851 | 852 | mmioClose hMMFile 853 | 854 | Exit Sub 855 | 856 | error_handler: 857 | 858 | If hMMFile Then 859 | mmioClose hMMFile 860 | End If 861 | 862 | Err.Raise Err.Number, FULL_PROC_NAME, Err.Description, Err.HelpFile, Err.HelpContext 863 | 864 | End Sub 865 | 866 | Private Sub SaveInternal( _ 867 | ByVal hMMFile As OLE_HANDLE, _ 868 | ByVal lBitsPerSample As Long, _ 869 | ByVal bFloat As Boolean) 870 | Dim tckRIFF As MMCKINFO 871 | Dim tckWAVE As MMCKINFO 872 | Dim tckFMT As MMCKINFO 873 | Dim tckDATA As MMCKINFO 874 | Dim tFMT As WAVEFORMATEXTENSIBLE 875 | Dim lFmtSize As Long 876 | Dim lSmpIndex As Long 877 | Dim lChIndex As Long 878 | Dim lDstIndex As Long 879 | Dim bArr() As Byte 880 | Dim iArr() As Integer 881 | Dim lArr() As Long 882 | Dim fValue As Single 883 | Dim lTemp As Long 884 | Dim pData As Long 885 | Dim lDataSize As Long 886 | 887 | If (lBitsPerSample <> 8 And lBitsPerSample <> 16 And lBitsPerSample <> 24 And lBitsPerSample <> 32) Or _ 888 | (lBitsPerSample <> 32 And bFloat) Then 889 | Err.Raise 5 890 | ElseIf m_lChannels = 0 Then 891 | Err.Raise 321 892 | End If 893 | 894 | tckRIFF.fccType = mmioStringToFOURCC("WAVE", 0) 895 | 896 | If mmioCreateChunk(hMMFile, tckRIFF, MMIO_CREATERIFF) Then 897 | Err.Raise 7, , "Unable to create RIFF chunk" 898 | End If 899 | 900 | tckFMT.ckid = mmioStringToFOURCC("fmt", 0) 901 | 902 | With tFMT 903 | 904 | .nChannels = m_lChannels 905 | .nSamplesPerSec = m_lSampleRate 906 | .wBitsPerSample = lBitsPerSample 907 | .nBlockAlign = (lBitsPerSample \ 8) * m_lChannels 908 | .nAvgBytesPerSec = .nBlockAlign * m_lSampleRate 909 | 910 | If m_lChannels <= 2 Then 911 | ' // WAVEFORMATEX 912 | 913 | If bFloat Then 914 | .wFormatTag = WAVE_FORMAT_IEEE_FLOAT 915 | Else 916 | .wFormatTag = WAVE_FORMAT_PCM 917 | End If 918 | 919 | lFmtSize = 16 920 | 921 | Else 922 | ' // WAVEFORMATEXTENSIBLE 923 | 924 | .cbSize = 22 925 | .wFormatTag = WAVE_FORMAT_EXTENSIBLE 926 | .dwChannelMask = (2 ^ m_lChannels) - 1 927 | .wValidBitsPerSample = lBitsPerSample 928 | 929 | If bFloat Then 930 | .guidSubFormat = KSDATAFORMAT_SUBTYPE_IEEE_FLOAT 931 | Else 932 | .guidSubFormat = KSDATAFORMAT_SUBTYPE_PCM 933 | End If 934 | 935 | lFmtSize = 40 936 | 937 | End If 938 | 939 | End With 940 | 941 | If mmioCreateChunk(hMMFile, tckFMT, 0) Then 942 | Err.Raise 7, , "Unable to create fmt chunk" 943 | End If 944 | 945 | If mmioWrite(hMMFile, tFMT, lFmtSize) = -1 Then 946 | Err.Raise 7, , "Unable to write fmt chunk" 947 | End If 948 | 949 | mmioAscend hMMFile, tckFMT, 0 950 | 951 | tckDATA.ckid = mmioStringToFOURCC("data", 0) 952 | 953 | If mmioCreateChunk(hMMFile, tckDATA, 0) Then 954 | Err.Raise 7, , "Unable to create data chunk" 955 | End If 956 | 957 | If m_lSamples Then 958 | 959 | Select Case lBitsPerSample 960 | Case 8 961 | 962 | ReDim bArr(m_lChannels - 1, m_lSamples - 1) 963 | 964 | For lSmpIndex = 0 To m_lSamples - 1 965 | For lChIndex = 0 To m_lChannels - 1 966 | 967 | fValue = m_fSamples(lChIndex, lSmpIndex) 968 | 969 | If fValue > 1 Then 970 | fValue = 1 971 | ElseIf fValue < -1 Then 972 | fValue = -1 973 | End If 974 | 975 | bArr(lChIndex, lSmpIndex) = fValue * 127 + 127 976 | 977 | Next 978 | Next 979 | 980 | pData = VarPtr(bArr(0, 0)) 981 | lDataSize = m_lChannels * m_lSamples 982 | 983 | Case 16 984 | 985 | ReDim iArr(m_lChannels - 1, m_lSamples - 1) 986 | 987 | For lSmpIndex = 0 To m_lSamples - 1 988 | For lChIndex = 0 To m_lChannels - 1 989 | 990 | fValue = m_fSamples(lChIndex, lSmpIndex) 991 | 992 | If fValue > 1 Then 993 | fValue = 1 994 | ElseIf fValue < -1 Then 995 | fValue = -1 996 | End If 997 | 998 | iArr(lChIndex, lSmpIndex) = fValue * 32767 999 | 1000 | Next 1001 | Next 1002 | 1003 | pData = VarPtr(iArr(0, 0)) 1004 | lDataSize = m_lChannels * m_lSamples * 2 1005 | 1006 | Case 24 1007 | 1008 | ReDim bArr(m_lChannels * m_lSamples * 3 - 1) 1009 | 1010 | For lSmpIndex = 0 To m_lSamples - 1 1011 | For lChIndex = 0 To m_lChannels - 1 1012 | 1013 | fValue = m_fSamples(lChIndex, lSmpIndex) 1014 | 1015 | If fValue > 1 Then 1016 | fValue = 1 1017 | ElseIf fValue < -1 Then 1018 | fValue = -1 1019 | End If 1020 | 1021 | lTemp = fValue * &H7FFFFF 1022 | 1023 | bArr(lDstIndex) = lTemp And &HFF& 1024 | bArr(lDstIndex + 1) = (lTemp And &HFF00&) \ &H100 1025 | bArr(lDstIndex + 2) = (lTemp And &HFF0000) \ &H10000 1026 | 1027 | lDstIndex = lDstIndex + 3 1028 | 1029 | Next 1030 | Next 1031 | 1032 | pData = VarPtr(bArr(0)) 1033 | lDataSize = m_lChannels * m_lSamples * 3 1034 | 1035 | Case 32 1036 | 1037 | If bFloat Then 1038 | pData = VarPtr(m_fSamples(0, 0)) 1039 | Else 1040 | 1041 | ReDim lArr(m_lChannels - 1, m_lSamples - 1) 1042 | 1043 | For lSmpIndex = 0 To m_lSamples - 1 1044 | For lChIndex = 0 To m_lChannels - 1 1045 | 1046 | fValue = m_fSamples(lChIndex, lSmpIndex) 1047 | 1048 | If fValue > 1 Then 1049 | fValue = 1 1050 | ElseIf fValue < -1 Then 1051 | fValue = -1 1052 | End If 1053 | 1054 | lArr(lChIndex, lSmpIndex) = fValue * 2147483647 1055 | 1056 | Next 1057 | Next 1058 | 1059 | pData = VarPtr(lArr(0, 0)) 1060 | 1061 | End If 1062 | 1063 | lDataSize = m_lChannels * m_lSamples * 4 1064 | 1065 | End Select 1066 | 1067 | If mmioWrite(hMMFile, ByVal pData, lDataSize) = -1 Then 1068 | Err.Raise 7, , "Unable to write data chunk" 1069 | End If 1070 | 1071 | End If 1072 | 1073 | mmioAscend hMMFile, tckDATA, 0 1074 | mmioAscend hMMFile, tckRIFF, 0 1075 | 1076 | End Sub 1077 | 1078 | Private Sub LoadInternal( _ 1079 | ByVal hMMFile As OLE_HANDLE) 1080 | Dim tckRIFF As MMCKINFO 1081 | Dim tckWAVE As MMCKINFO 1082 | Dim tckFMT As MMCKINFO 1083 | Dim tckDATA As MMCKINFO 1084 | Dim tFMT As WAVEFORMATEXTENSIBLE 1085 | Dim lInIndex As Long 1086 | Dim lOutIndex As Long 1087 | Dim lOutSamples As Long 1088 | Dim fSample As Single 1089 | Dim pRawBytes As Long 1090 | Dim bArr() As Byte 1091 | Dim iArr() As Integer 1092 | Dim lArr() As Long 1093 | Dim tArrDesc As SAFEARRAY 1094 | Dim pSafeArray As Long 1095 | Dim lTemp As Long 1096 | Dim lChIndex As Long 1097 | Dim lDivisor As Long 1098 | Dim bIsFloat As Boolean 1099 | 1100 | tckWAVE.fccType = mmioStringToFOURCC("WAVE", 0) 1101 | 1102 | If mmioDescend(hMMFile, tckWAVE, ByVal 0&, MMIO_FINDRIFF) Then 1103 | Err.Raise 321, , "Isn't valid file" 1104 | End If 1105 | 1106 | tckFMT.ckid = mmioStringToFOURCC("fmt", 0) 1107 | 1108 | If mmioDescend(hMMFile, tckFMT, tckWAVE, MMIO_FINDCHUNK) Then 1109 | Err.Raise 321, , "Format chunk not found" 1110 | End If 1111 | 1112 | If tckFMT.ckSize < 0 Then 1113 | Err.Raise 321, , "Invalid format" 1114 | End If 1115 | 1116 | ReDim bFMT(tckFMT.ckSize - 1) 1117 | 1118 | If mmioRead(hMMFile, bFMT(0), tckFMT.ckSize) = -1 Then 1119 | Err.Raise 7, , "Can't read format" 1120 | End If 1121 | 1122 | mmioAscend hMMFile, tckFMT, 0 1123 | 1124 | tckDATA.ckid = mmioStringToFOURCC("data", 0) 1125 | 1126 | If mmioDescend(hMMFile, tckDATA, tckWAVE, MMIO_FINDCHUNK) Then 1127 | Err.Raise 321, , "Wave data isn't found" 1128 | End If 1129 | 1130 | If tckDATA.ckSize <= 0 Then 1131 | Err.Raise 321, , "Invalid data size" 1132 | End If 1133 | 1134 | If tckFMT.ckSize > Len(tFMT) Then 1135 | tckFMT.ckSize = Len(tFMT) 1136 | End If 1137 | 1138 | memcpy tFMT, bFMT(0), tckFMT.ckSize 1139 | 1140 | If ((tFMT.wFormatTag <> WAVE_FORMAT_PCM And tFMT.wFormatTag <> WAVE_FORMAT_EXTENSIBLE And _ 1141 | tFMT.wFormatTag <> WAVE_FORMAT_IEEE_FLOAT) Or _ 1142 | tFMT.nChannels > 8 Or tFMT.nChannels <= 0 Or tFMT.nBlockAlign <> tFMT.wBitsPerSample * tFMT.nChannels \ 8) Or _ 1143 | Not (tFMT.wBitsPerSample = 8 Or tFMT.wBitsPerSample = 16 Or tFMT.wBitsPerSample = 24 Or tFMT.wBitsPerSample = 32) Then 1144 | Err.Raise 321, , "Unsupported format" 1145 | End If 1146 | 1147 | If tFMT.wFormatTag = WAVE_FORMAT_EXTENSIBLE Then 1148 | 1149 | If tFMT.wValidBitsPerSample <= 0 Or tFMT.wValidBitsPerSample > tFMT.wBitsPerSample Then 1150 | Err.Raise 321, , "Invalid file format" 1151 | End If 1152 | 1153 | If tFMT.cbSize <> 22 Then 1154 | Err.Raise 321, , "Unsupported format" 1155 | ElseIf IsEqualGUID(tFMT.guidSubFormat, KSDATAFORMAT_SUBTYPE_PCM) = 0 Then 1156 | 1157 | If IsEqualGUID(tFMT.guidSubFormat, KSDATAFORMAT_SUBTYPE_IEEE_FLOAT) = 0 Then 1158 | Err.Raise 321, , "Unsupported format" 1159 | End If 1160 | 1161 | bIsFloat = True 1162 | 1163 | End If 1164 | 1165 | Else 1166 | 1167 | If tFMT.cbSize Then 1168 | Err.Raise 321, , "Invalid file format" 1169 | End If 1170 | 1171 | tFMT.wValidBitsPerSample = tFMT.wBitsPerSample 1172 | 1173 | bIsFloat = tFMT.wFormatTag = WAVE_FORMAT_IEEE_FLOAT 1174 | 1175 | End If 1176 | 1177 | pRawBytes = GlobalAlloc(GMEM_FIXED, ((tckDATA.ckSize + 3) \ 4) * 4) 1178 | If pRawBytes = 0 Then 1179 | Err.Raise 7, , "GlobalAlloc failed" 1180 | End If 1181 | 1182 | If mmioRead(hMMFile, ByVal pRawBytes, tckDATA.ckSize) = -1 Then 1183 | GlobalFree pRawBytes 1184 | Err.Raise 7, , "Unable to read wave data" 1185 | End If 1186 | 1187 | lOutSamples = tckDATA.ckSize \ tFMT.nBlockAlign 1188 | 1189 | If lOutSamples > 0 Then 1190 | 1191 | ReDim m_fSamples(tFMT.nChannels - 1, lOutSamples - 1) 1192 | 1193 | pSafeArray = VarPtr(tArrDesc) 1194 | 1195 | tArrDesc.cDims = 1 1196 | tArrDesc.fFeatures = FADF_AUTO 1197 | tArrDesc.pvData = pRawBytes 1198 | 1199 | If tFMT.wValidBitsPerSample Then 1200 | lDivisor = (2 ^ (tFMT.wValidBitsPerSample - 1)) - 1 1201 | Else 1202 | lDivisor = 1 1203 | End If 1204 | 1205 | Select Case tFMT.wBitsPerSample 1206 | Case 8 1207 | 1208 | tArrDesc.cbElements = 1 1209 | tArrDesc.Bounds.cElements = lOutSamples * tFMT.nChannels 1210 | 1211 | PutArr bArr, pSafeArray 1212 | 1213 | For lOutIndex = 0 To lOutSamples - 1 1214 | For lChIndex = 0 To tFMT.nChannels - 1 1215 | m_fSamples(lChIndex, lOutIndex) = (CLng(bArr(lInIndex)) - 128&) / lDivisor 1216 | lInIndex = lInIndex + 1 1217 | Next 1218 | Next 1219 | 1220 | PutArr bArr, 0 1221 | 1222 | Case 16 1223 | 1224 | tArrDesc.cbElements = 2 1225 | tArrDesc.Bounds.cElements = lOutSamples * tFMT.nChannels 1226 | 1227 | PutArr iArr, pSafeArray 1228 | 1229 | For lOutIndex = 0 To lOutSamples - 1 1230 | For lChIndex = 0 To tFMT.nChannels - 1 1231 | m_fSamples(lChIndex, lOutIndex) = iArr(lInIndex) / lDivisor 1232 | lInIndex = lInIndex + 1 1233 | Next 1234 | Next 1235 | 1236 | PutArr iArr, 0 1237 | 1238 | Case 24 1239 | 1240 | tArrDesc.cbElements = 1 1241 | tArrDesc.Bounds.cElements = lOutSamples * 3 * tFMT.nChannels 1242 | 1243 | PutArr bArr, pSafeArray 1244 | 1245 | For lOutIndex = 0 To lOutSamples - 1 1246 | For lChIndex = 0 To tFMT.nChannels - 1 1247 | 1248 | lTemp = CLng(bArr(lInIndex * 3)) Or _ 1249 | (bArr(lInIndex * 3 + 1) * &H100&) Or _ 1250 | (bArr(lInIndex * 3 + 2)) * &H10000 Or _ 1251 | -(bArr(lInIndex * 3 + 2) And &H80) * &H20000 1252 | m_fSamples(lChIndex, lOutIndex) = lTemp / lDivisor 1253 | lInIndex = lInIndex + 1 1254 | 1255 | Next 1256 | Next 1257 | 1258 | PutArr bArr, 0 1259 | 1260 | Case 32 1261 | 1262 | tArrDesc.cbElements = 4 1263 | tArrDesc.Bounds.cElements = lOutSamples * tFMT.nChannels 1264 | 1265 | If Not bIsFloat Then 1266 | 1267 | PutArr lArr, pSafeArray 1268 | 1269 | For lOutIndex = 0 To lOutSamples - 1 1270 | For lChIndex = 0 To tFMT.nChannels - 1 1271 | m_fSamples(lChIndex, lOutIndex) = lArr(lInIndex) / lDivisor 1272 | lInIndex = lInIndex + 1 1273 | Next 1274 | Next 1275 | 1276 | PutArr lArr, 0 1277 | 1278 | Else 1279 | memcpy m_fSamples(0, 0), ByVal pRawBytes, lOutSamples * tFMT.nChannels * 4 1280 | End If 1281 | 1282 | End Select 1283 | Else 1284 | Erase m_fSamples 1285 | End If 1286 | 1287 | GlobalFree pRawBytes 1288 | 1289 | m_lSamples = lOutSamples 1290 | m_lSampleRate = tFMT.nSamplesPerSec 1291 | m_lChannels = tFMT.nChannels 1292 | 1293 | End Sub 1294 | 1295 | Private Function KSDATAFORMAT_SUBTYPE_PCM() As UUID 1296 | Static s_tCache As UUID 1297 | 1298 | If s_tCache.Data1 = 0 Then 1299 | UuidFromString StrPtr(KSDATAFORMAT_SUBTYPE_PCM_STR), s_tCache 1300 | End If 1301 | 1302 | KSDATAFORMAT_SUBTYPE_PCM = s_tCache 1303 | 1304 | End Function 1305 | 1306 | Private Function KSDATAFORMAT_SUBTYPE_IEEE_FLOAT() As UUID 1307 | Static s_tCache As UUID 1308 | 1309 | If s_tCache.Data1 = 0 Then 1310 | UuidFromString StrPtr(KSDATAFORMAT_SUBTYPE_IEEE_FLOAT_STR), s_tCache 1311 | End If 1312 | 1313 | KSDATAFORMAT_SUBTYPE_IEEE_FLOAT = s_tCache 1314 | 1315 | End Function 1316 | -------------------------------------------------------------------------------- /Demos/Generate/PureTone.vbp: -------------------------------------------------------------------------------- 1 | Type=Exe 2 | Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#..\..\..\..\..\..\..\Windows\SysWOW64\stdole2.tlb#OLE Automation 3 | Module=modMain; modMain.bas 4 | Class=CWaveFile; ..\..\CWaveFile.cls 5 | Startup="Sub Main" 6 | Command32="" 7 | Name="PureTone" 8 | HelpContextID="0" 9 | CompatibleMode="0" 10 | MajorVer=1 11 | MinorVer=0 12 | RevisionVer=0 13 | AutoIncrementVer=0 14 | ServerSupportFiles=0 15 | VersionCompanyName="Microsoft" 16 | CompilationType=0 17 | OptimizationType=0 18 | FavorPentiumPro(tm)=0 19 | CodeViewDebugInfo=0 20 | NoAliasing=0 21 | BoundsCheck=0 22 | OverflowCheck=0 23 | FlPointCheck=0 24 | FDIVCheck=0 25 | UnroundedFP=0 26 | StartMode=0 27 | Unattended=0 28 | Retained=0 29 | ThreadPerObject=0 30 | MaxNumberOfThreads=1 31 | -------------------------------------------------------------------------------- /Demos/Generate/PureTone.vbw: -------------------------------------------------------------------------------- 1 | modMain = 25, 25, 866, 568, Z 2 | CWaveFile = 0, 0, 0, 0, C 3 | -------------------------------------------------------------------------------- /Demos/Generate/modMain.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "modMain" 2 | ' // 3 | ' // Pure tone generate/play/save using CWaveFile class 4 | ' // 5 | 6 | Option Explicit 7 | 8 | Const PI As Double = 3.14159265358979 9 | 10 | Sub Main() 11 | Dim cFile As CWaveFile 12 | Dim fSamples() As Single 13 | Dim lIndex As Long 14 | Dim lSampleRate As Long 15 | Dim dDelta As Double 16 | 17 | Set cFile = New CWaveFile 18 | 19 | lSampleRate = 22050 20 | 21 | ' // Initialize sound with 22050 Hz 2 seconds 22 | cFile.InitNew 1, lSampleRate * 2, lSampleRate 23 | 24 | ' // Generate 1000 Hz sine wave 25 | ReDim fSamples(lSampleRate * 2 - 1) 26 | 27 | dDelta = 1000 / lSampleRate * PI * 2 28 | 29 | For lIndex = 0 To UBound(fSamples) 30 | fSamples(lIndex) = Sin(lIndex * dDelta) 31 | Next 32 | 33 | ' // Set data 34 | cFile.Channel(0, 0, UBound(fSamples) + 1) = fSamples 35 | 36 | ' // Play 37 | cFile.Play CM_ALL, 0, cFile.SamplesCount 38 | 39 | ' // Save 40 | cFile.Save App.Path & "\test.wav", 8 41 | 42 | End Sub 43 | -------------------------------------------------------------------------------- /Demos/Generate/test.wav: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thetrik/CWaveFile/d167bc9cc59e4283d5bf31d55da8fffde734c4db/Demos/Generate/test.wav -------------------------------------------------------------------------------- /Demos/Play/PlayFile.vbp: -------------------------------------------------------------------------------- 1 | Type=Exe 2 | Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#..\..\..\..\..\..\..\Windows\SysWOW64\stdole2.tlb#OLE Automation 3 | Module=modMain; modMain.bas 4 | Class=CWaveFile; ..\..\CWaveFile.cls 5 | Startup="Sub Main" 6 | Command32="" 7 | Name="PlayFile" 8 | HelpContextID="0" 9 | CompatibleMode="0" 10 | MajorVer=1 11 | MinorVer=0 12 | RevisionVer=0 13 | AutoIncrementVer=0 14 | ServerSupportFiles=0 15 | VersionCompanyName="Microsoft" 16 | CompilationType=0 17 | OptimizationType=0 18 | FavorPentiumPro(tm)=0 19 | CodeViewDebugInfo=0 20 | NoAliasing=0 21 | BoundsCheck=0 22 | OverflowCheck=0 23 | FlPointCheck=0 24 | FDIVCheck=0 25 | UnroundedFP=0 26 | StartMode=0 27 | Unattended=0 28 | Retained=0 29 | ThreadPerObject=0 30 | MaxNumberOfThreads=1 31 | -------------------------------------------------------------------------------- /Demos/Play/PlayFile.vbw: -------------------------------------------------------------------------------- 1 | modMain = 25, 25, 866, 568, Z 2 | CWaveFile = 50, 50, 891, 593, 3 | -------------------------------------------------------------------------------- /Demos/Play/file.wav: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thetrik/CWaveFile/d167bc9cc59e4283d5bf31d55da8fffde734c4db/Demos/Play/file.wav -------------------------------------------------------------------------------- /Demos/Play/modMain.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "modMain" 2 | ' // 3 | ' // Play a file 4 | ' // 5 | 6 | Option Explicit 7 | 8 | Sub Main() 9 | Dim cFile As CWaveFile 10 | 11 | Set cFile = New CWaveFile 12 | 13 | cFile.Load App.Path & "\file.wav" 14 | 15 | ' // You can specify channels to play using OR 16 | cFile.Play CM_0 Or CM_1, 0, cFile.SamplesCount 17 | 18 | 19 | End Sub 20 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # CWaveFile 2 | CWaveFile - class for working with WAVE-PCM files 3 | --------------------------------------------------------------------------------