Tipp 0176 Oszillator 8-Bit Synthesizer
Autor/Einsender:
Datum:
  David Katrowski
20.12.2001
Entwicklungsumgebung:
DirectX-Version:
  VB 6
DirectX 7
Dieser Tipp zeigt, wie man mit DirectSound einen Mehrkanal Oszillator mit unterschiedlichen stufenlos einstellbaren Frequenzmodulationen verwirklichen kann.
Code im Codebereich des Moduls
 
Option Explicit

Public Declare Function osQueryPerformanceCounter Lib _
      "kernel32.dll" Alias "QueryPerformanceCounter" _
      (lpPerformanceCount As Currency) As Long

Public Declare Function osQueryPerformanceFrequency Lib _
      "kernel32.dll" Alias "QueryPerformanceFrequency" _
      (lpFrequency As Currency) As Long

Public freq As Currency, Count As Currency

Public DX7 As New DirectX7
Public DS As DirectSound
Public DSB(1) As DirectSoundBuffer

Public dsbd As DSBUFFERDESC, PCM As WAVEFORMATEX

Public O1SBuffer(360) As Byte, O2SBuffer(360) As Byte

Public Osc1Samp As Single, Osc2Samp As Single
Public Osc1FCutoff As Integer, Osc2FCutoff As Integer
Public Osc1Amp As Integer, Osc2Amp As Integer, O2F As Integer
Public AM_Speed As Integer, AM2_Speed As Integer
Public FM_Speed As Integer

Public fm As Long
Public i As Integer, f As Integer
Public n As Single, f2 As Single
Public Temp1 As Integer, Temp2 As Integer

Public Const pi = 3.14159265358979

Function Init_DX7(Hwnd As Long) As Boolean
  On Error GoTo InitErrorOut1
  PCM.nFormatTag = WAVE_FORMAT_PCM
  PCM.nChannels = 1
  PCM.lSamplesPerSec = 11050
  PCM.nBitsPerSample = 8
  PCM.nBlockAlign = 1
  PCM.lAvgBytesPerSec = PCM.lSamplesPerSec * PCM.nBlockAlign
  PCM.nSize = 0

  dsbd.lFlags = DSBCAPS_STATIC
  dsbd.lBufferBytes = 360

  Set DS = DX7.DirectSoundCreate("")

  DS.SetCooperativeLevel Hwnd, DSSCL_NORMAL

  On Error GoTo InitErrorOut2
  Set DSB(0) = DS.CreateSoundBuffer(dsbd, PCM)
  Set DSB(1) = DS.CreateSoundBuffer(dsbd, PCM)

  Init_DX7 = True
  Exit Function

InitErrorOut2:
  Set DSB(0) = Nothing
  Set DSB(1) = Nothing
  Set DS = Nothing

InitErrorOut1:
  Init_DX7 = False
End Function

Sub Term_DX7()
  Set DSB(0) = Nothing
  Set DSB(1) = Nothing
  Set DS = Nothing
End Sub

Sub DSBWRITE(Num As Integer, ByRef Buffer() As Byte)
  DSB(Num).WriteBuffer 0, 0, Buffer(0), DSBLOCK_ENTIREBUFFER
End Sub

Sub DrawVU(Value As Integer, PB As PictureBox)
  If Value < 75 Then PB.Line (0, 0)-(Value, 0), vbGreen
  If Value > 75 And Value <= 95 Then _
        PB.Line (0, 0)-(Value, 0), vbYellow
  If Value > 95 Then PB.Line (0, 0)-(Value, 0), vbRed
End Sub

Sub DrawPOINT(dI As Integer, dSamp As Single, PB As PictureBox)
  PB.PSet (dI, dSamp + 125), vbGreen
End Sub

Public Function Timer() As Single
  osQueryPerformanceFrequency freq
  osQueryPerformanceCounter Count
  Let Timer = Count / freq
End Function
 
Code im Codebereich der Form
 
Option Explicit

Private Sub Form_Load()
  If Not Init_DX7(Me.Hwnd) Then End
  DSB(0).Play DSBPLAY_LOOPING
  DSB(1).Play DSBPLAY_LOOPING
  Osc1Amp = HScroll1.Value
End Sub

Private Sub Form_Unload(Cancel As Integer)
  Term_DX7
End Sub

Private Sub Timer1_Timer(): On Error Resume Next
  Osc1Amp = HScroll1.Value
  Osc2Amp = HScroll3.Value
  Osc1FCutoff = HScroll2.Value
  Osc2FCutoff = HScroll7.Value

  AM_Speed = HScroll4.Value
  AM2_Speed = HScroll9.Value
  FM_Speed = HScroll5.Value

  Temp1 = 0: Temp2 = 0

  f = HScroll6.Value
  O2F = f + HScroll8.Value

  WPB1.Cls: o1VU.Cls: Picture1.Cls: Picture2.Cls
  For i = 0 To 360
    f2 = Timer
    n = i * 0.01745329251994
    If Check4.Value = 1 Then _
          fm = Cos(f2 * (FM_Speed / 2)) * f Else fm = f
    If fm < 0 Then fm = fm + 4

    If Check1.Value = 1 Then Osc1Samp = Sin(n * fm) * Osc1Amp

    If Check2.Value = 1 Then _
          Osc1Samp = Cos(pi * Int(fm * n)) * Osc1Amp

    If Check7.Value = 1 Then Osc2Samp = Sin(n * O2F) * Osc2Amp

    If Check8.Value = 1 Then _
          Osc2Samp = Cos(pi * Int(O2F * n)) * Osc2Amp

    If Check11.Value = 1 Then
       Osc1Samp = Cos(f2 * AM2_Speed) * Osc1Samp
       Osc2Samp = Cos(f2 * AM2_Speed) * Osc2Samp
    End If

    If Check3.Value = 1 Then
      Osc1Samp = Cos(f2 * AM_Speed) * Osc1Samp
      Osc2Samp = Sin(f2 * AM_Speed) * Osc2Samp
    End If

    If Check5.Value = 1 Then
      If Osc1FCutoff > 0 Then
        Osc1Samp = _
            Osc1Samp / (10 * Log(1 + (fm / (0.1 * Osc1FCutoff))))
      End If
    End If

    If Check6.Value = 1 Then
      If Osc1FCutoff > 0 Then
        Osc1Samp = Osc1Samp / (10 * Exp(1 + (Abs(fm) / _
              (0.1 * (Osc1FCutoff))) * (2 ^ 2)))
      End If
    End If

    If Check9.Value = 1 Then
      If Osc2FCutoff > 0 Then
        Osc2Samp = _
            Osc2Samp / (10 * Log(1 + (fm / (0.1 * Osc2FCutoff))))
      End If
    End If

    If Check10.Value = 1 Then
      If Osc2FCutoff > 0 Then
        Osc2Samp = Osc2Samp / (10 * Exp(1 + (Abs(fm) / _
              (0.1 * (Osc2FCutoff))) * (2 ^ 2)))
      End If
    End If

    O1SBuffer(i) = Osc1Samp + 128
    O2SBuffer(i) = Osc2Samp + 128
    If Osc1Samp > Temp1 Then Temp1 = Osc1Samp
    If Osc2Samp > Temp2 Then Temp2 = Osc2Samp
    DrawPOINT i, Osc1Samp, WPB1
    DrawPOINT i, Osc2Samp, Picture1
  Next

  DSBWRITE 0, O1SBuffer()
  DrawVU Temp1, o1VU
  DSBWRITE 1, O2SBuffer()
  DrawVU Temp2, Picture2
End Sub
 
Weitere Links zum Thema
Lautstärke, Balance, Frequenz & Cursorposition
Hinweis
Um dieses Beispiel ausführen zu können, wird die DirectX 7 for Visual Basic Type Library benötigt (siehe dazu die Erläuterungen in der DirectX-Rubrik).

Windows-Version
95
98/SE
ME
NT
2000
XP
Vista
Win 7
VB-Version
VBA 5
VBA 6
VB 4/16
VB 4/32
VB 5
VB 6


Download  (5,3 kB) Downloads bisher: [ 2298 ]

Vorheriger Tipp Zum Seitenanfang Nächster Tipp

Startseite | Projekte | Tutorials | API-Referenz | VB-/VBA-Tipps | Komponenten | Bücherecke | VB/VBA-Forum | VB.Net-Forum | DirectX-Forum | Foren-Archiv | DirectX | VB.Net-Tipps | Chat | Spielplatz | Links | Suchen | Stichwortverzeichnis | Feedback | Impressum

Seite empfehlen Bug-Report
Letzte Aktualisierung: Samstag, 24. September 2011