home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD102739292000.psc / modsynth_dx7.bas < prev    next >
Encoding:
BASIC Source File  |  2000-09-29  |  2.3 KB  |  81 lines
  1. Attribute VB_Name = "modSynth_DX7"
  2. Public DX7 As New DirectX7, DS As DirectSound, Primary As DirectSoundBuffer, DSB(1) As DirectSoundBuffer
  3. Public dsbd As DSBUFFERDESC, PD As DSBUFFERDESC, PCM As WAVEFORMATEX, PCM2 As WAVEFORMATEX
  4. Public Const BSize = 89 '179 '359
  5. Public O1SBuffer(BSize) As Byte, O2SBuffer(BSize) As Byte
  6. Public Osc1Samp As Single, Osc2Samp As Single
  7. Public i As Integer, ii As Long, n As Single, pcolor As Long
  8.     
  9. Public Const pi = 3.14159265358979
  10.  
  11. Function Init_DX7(Hwnd As Long) As Boolean: On Error GoTo InitErrorOut1
  12. Set DS = DX7.DirectSoundCreate("")
  13. ''Set the Cooperative Level
  14. DS.SetCooperativeLevel Hwnd, DSSCL_EXCLUSIVE
  15.  
  16. ''Fill WaveFormat Structure
  17. PCM.nFormatTag = WAVE_FORMAT_PCM
  18. PCM.nChannels = 1
  19. PCM.lSamplesPerSec = 11050
  20. PCM.nBitsPerSample = 8
  21. PCM.nBlockAlign = 1
  22. PCM.lAvgBytesPerSec = PCM.lSamplesPerSec * PCM.nBlockAlign
  23. PCM.nSize = 0
  24. ''Fill BufferDescription Structure
  25. dsbd.lFlags = DSBCAPS_CTRLFREQUENCY Or DSBCAPS_STATIC
  26. dsbd.lBufferBytes = BSize
  27.  
  28. ''Create Buffers
  29. On Error GoTo InitErrorOut2
  30. PD.lFlags = DSBCAPS_CTRLVOLUME Or DSBCAPS_PRIMARYBUFFER
  31. Set Primary = DS.CreateSoundBuffer(PD, PCM2)
  32. Set DSB(0) = DS.CreateSoundBuffer(dsbd, PCM)
  33. Set DSB(1) = DS.CreateSoundBuffer(dsbd, PCM)
  34. Primary.SetFormat PCM
  35.  
  36. Init_DX7 = True
  37. Exit Function 'Function WAS successful!
  38. InitErrorOut2:
  39. Set DSB(0) = Nothing
  40. Set DSB(1) = Nothing
  41. Set DS = Nothing
  42. InitErrorOut1:
  43. Init_DX7 = False
  44. End Function 'Function WAS NOT successful!
  45.  
  46. Sub Term_DX7()
  47. Set DSB(0) = Nothing
  48. Set DSB(1) = Nothing
  49. Set DS = Nothing
  50. End Sub
  51.  
  52. Sub DSBWRITE(Num As Integer, ByRef Buffer() As Byte)
  53. DSB(Num).WriteBuffer 0, 0, Buffer(0), DSBLOCK_ENTIREBUFFER
  54. End Sub
  55.  
  56.  
  57. Sub DrawPOINT(dI As Integer, dSamp As Single, PB As PictureBox)
  58. If Abs(dSamp) < 63 Then
  59. pcolor = Abs(dSamp * 4) + vbGreen
  60. Else
  61. pcolor = &HFF
  62. End If
  63. PB.PSet (dI, dSamp + &H7F), pcolor
  64. End Sub
  65.  
  66. Public Sub SetVolume(Value As Integer)
  67. Select Case Value
  68. Case 0: Primary.SetVolume -10000
  69. Case 1: Primary.SetVolume -2700
  70. Case 2: Primary.SetVolume -2400
  71. Case 3: Primary.SetVolume -2100
  72. Case 4: Primary.SetVolume -1800
  73. Case 5: Primary.SetVolume -1500
  74. Case 6: Primary.SetVolume -1200
  75. Case 7: Primary.SetVolume -900
  76. Case 8: Primary.SetVolume -600
  77. Case 9: Primary.SetVolume -300
  78. Case 10: Primary.SetVolume 0
  79. End Select
  80. End Sub
  81.