frmmain.frm

普通波形发生器 开发环境：VisualBadsic

Private Sub ctDial2_DialChange(nValue As Integer)
   nVolume = nValue / 100
   SinBuffer nFreq, nVolume
End Sub

Private Sub Form_Load()
    
    lblhead.Caption = "欢迎光临枕善居    http://www.mndsoft.com"
    nMod = 1
    sep = Chr$(9)
    nSamples = 48000
    nBasicBufferSize = 16384
    
    Set DS = DX7.DirectSoundCreate(vbNullString)
    DS.SetCooperativeLevel hWnd, DSSCL_PRIORITY
    
    PCM.nFormatTag = WAVE_FORMAT_PCM
    PCM.nChannels = 1
    PCM.lSamplesPerSec = nSamples
    PCM.nBitsPerSample = 8
    PCM.nBlockAlign = 1
    PCM.lAvgBytesPerSec = PCM.lSamplesPerSec * PCM.nBlockAlign
    DSBD.lFlags = DSBCAPS_STATIC
    
    HScroll1.Value = nSamples \ 10
    hscrChop_DialChange 30
    HScroll2_DialChange 30
    bttnSamples_Click 3
    
    ctDial2_DialChange 50
    
    nFreq = 1 + ctDial1.Value * 22.049! * Log(1 + ctDial1.Value / 1000) / Log(2)
    txtSweep(0).Text = nFreq
    SinBuffer nFreq, nVolume
    InitializeDigitalSelector
    centerform Me
    

End Sub

Private Sub Form_Unload(Cancel As Integer)
     
     Set DSB = Nothing
     TmrProgram.Enabled = False

End Sub

Private Sub hscMod_Change()
    hscMod_Scroll
    lblAmpMod = hscMod.Value
End Sub

Private Sub hscMod_Scroll()
    If hscMod.Value = 0 Then
        tmrMod.Interval = 0
        nMod = 1
    Else
        tmrMod.Interval = 1
    End If
End Sub

Private Sub hscrChop_DialChange(nValue As Integer)
   
   iChopMarkSpace = nValue * 1.666
   lblChop = Str$(iChopMarkSpace) & " %"
   
End Sub

Private Sub HScroll1_Change()
    HScroll1_Scroll
End Sub

Private Sub HScroll1_Scroll()

    On Error Resume Next
    DSB.SetFrequency HScroll1.Value * 10&
    
End Sub
Private Sub HScroll2_DialChange(nValue As Integer)
   
   lblChopFrequency.Caption = FormatNumber(nValue / 6, 0) & " Hz"
   iChopFrequency = nValue / 6
   If iChopFrequency = 0 Then iChopFrequency = 1
   tmrChop.Interval = (1000 / iChopFrequency) / 5
   
End Sub

Private Sub hscrolPercent_DialChange(nValue As Integer)
  
  wobValue = nValue
  CalculateWobbulation

End Sub

Private Sub LED1_Click()
    
  Dim tmp As Integer
  
  If LED1.State = True Then
    iWobulator = DSB.GetFrequency
    tmp = (wobpercent * iWobulator) / 100
    iWobulatorMax = iWobulator + tmp
    iWobulatorMin = iWobulator - tmp
    iWobulatorStep = tmp / 10
    wobProgress = iWobulator
    TimerWob.Interval = 10
  
    TimerWob.Enabled = True
  
  Else
   
   TimerWob.Enabled = False
   DSB.SetFrequency DSBFREQUENCY_ORIGINAL
  End If

End Sub
Private Sub scrDecimal_Change()
    
    txtDecimal.Text = Str(scrDecimal.Value)
    conFreq
    
End Sub

Private Sub TimerWob_Timer()
  
  Static signflag As Boolean
  
  If Not signflag Then
   wobProgress = wobProgress + iWobulatorStep
   If wobProgress > iWobulatorMax Then
      signflag = True
   End If
  Else
   wobProgress = wobProgress - iWobulatorStep
   If wobProgress < iWobulatorMin Then
      signflag = False
   End If
  End If
  DSB.SetFrequency wobProgress
  
End Sub

Private Sub tmrChop_Timer()
  
  Static iState As Integer
    
  iState = nMod
  
  iCounter = iCounter + 20
  If iCounter > 100 Then
      iCounter = 0
  End If
 
  If iCounter >= iChopMarkSpace Then
    nMod = False
  Else
    nMod = True
    
  End If
  
  If iState <> nMod Then
     iState = nMod
       If nMod = 0 Then
        DSB.SetVolume -10000
       Else
        DSB.SetVolume iPrevVolume
       End If
       'SinBuffer nFreq, nVolume
  End If
  DoEvents
End Sub

Private Sub tmrMod_Timer()
    
    If nModDir >= 0 Then
        nMod = nMod + 0.2! / (101 - hscMod.Value)
        If nMod > 1 Then nMod = 1: nModDir = -1
    Else
        nMod = nMod - 0.2! / (101 - hscMod.Value)
        If nMod < -1 Then nMod = -1: nModDir = 1
    End If
    SinBuffer nFreq, nVolume
   ' DSB.SetVolume (nMod * 5000) - 5000
        
End Sub

'Select Units Value

Private Sub scrUnits_Change()

    txtUnits.Text = Str(scrUnits.Value)
    conFreq
    
End Sub

'Select Tens Value

Private Sub scrTens_Change()

    txtTens.Text = Str(scrTens.Value)
    conFreq
    
End Sub

'Select Hundreds and mask leading zeroes

Private Sub scrHundreds_Change()

    txtHundreds.Text = Str(scrHundreds.Value)
    If scrHundreds.Value = 0 And scrThousands.Value = 0 Then
        txtHundreds.Text = ""
    End If

    conFreq
    
End Sub

'Select Thousands and mask leading zero

Private Sub scrThousands_Change()

    txtThousands.Text = Str(scrThousands.Value)
    If scrThousands.Value = 0 Then
        txtThousands.Text = ""
    End If
    
    conFreq
    
End Sub

'Concatenate the frequency selector settings
Private Sub conFreq()

   If DontChangeFlag Then Exit Sub
    nFreq = (scrThousands.Value * 1000) + (scrHundreds.Value * 100) + (scrTens.Value * 10) + scrUnits.Value + (scrDecimal.Value / 10)
    txtSweep(0).Text = nFreq
   
   ' If nFreq < 20 Then
   '     MsgBox "Frequency cannot be lower than 20 Hz."
   '     nFreq = 20
   '     txtTens.Text = "2"
   '     txtUnits.Text = "0"
   '     txtDecimal.Text = "0"
   ' End If
    
    SinBuffer nFreq, nVolume

End Sub

Sub InitializeDigitalSelector()
    
    'Initialize the Freqency Selector buttons
    
    scrDecimal.Max = 0
    scrDecimal.Min = 9
    scrDecimal.Value = 0
    txtDecimal.Text = Str(scrDecimal.Value / 10)
    
    scrUnits.Max = 0
    scrUnits.Min = 9
    scrUnits.Value = 0
    txtUnits.Text = Str(scrUnits.Value)
    
    scrTens.Max = 0
    scrTens.Min = 9
    scrTens.Value = 0
    txtTens.Text = Str(scrTens.Value)
    
    scrHundreds.Max = 0
    scrHundreds.Min = 9
    scrHundreds.Value = 0
    txtHundreds.Text = Str(scrHundreds.Value)
    
    scrThousands.Max = 0
    scrThousands.Min = 9
    scrThousands.Value = 1
    txtThousands.Text = Str(scrThousands.Value)

End Sub
Sub SetDigitalSelector()
       
    Dim tt As Integer
    Dim sDum As String
    Dim cc As Integer
    sDum = Trim$(Format$(nFreq, "0.0"))
    
    DontChangeFlag = True
    
    scrDecimal.Value = 0
    scrUnits.Value = 0
    scrTens.Value = 0
    scrHundreds.Value = 0
    scrThousands.Value = 0

    For tt = Len(sDum) To 1 Step -1
      Select Case cc
       Case 0
          scrDecimal.Value = Val(Mid$(sDum, tt, 1))
       Case 2
          scrUnits.Value = Val(Mid$(sDum, tt, 1))
       Case 3
          scrTens.Value = Val(Mid$(sDum, tt, 1))
       Case 4
          scrHundreds.Value = Val(Mid$(sDum, tt, 1))
       Case 5
          scrThousands.Value = Val(Mid$(sDum, tt, 1))
      End Select
      cc = cc + 1
    Next
    DontChangeFlag = False
    
End Sub
Sub CalculateWobbulation()
  
  Dim tmp As Integer
  Dim sVariation As Single

  lblWob = Str$(wobValue / 100) & " %"
  wobpercent = wobValue / 100
  
  iWobulator = DSB.GetFrequency
  tmp = (wobpercent * iWobulator) / 100
  iWobulatorMax = iWobulator + tmp
  iWobulatorMin = iWobulator - tmp
  iWobulatorStep = tmp / 10
  wobProgress = iWobulator
  TimerWob.Interval = 10
  
  sVariation = (wobpercent * nFreq) / 100
  lblFreq(0).Caption = FormatNumber(nFreq - sVariation, 1, , , vbFalse)
  lblFreq(1).Caption = FormatNumber(nFreq + sVariation, 1, , , vbFalse)

End Sub

Function mVal(vVal As Variant) As Currency
   
   On Error GoTo WrongArguments
   
   If IsNull(vVal) Then
     mVal = 0
     Exit Function
   End If
   
   If Val(vVal) = 0 Then
     mVal = 0
     Exit Function
   End If
   
   If Len(vVal) = 0 Then
     mVal = 0
     Exit Function
   End If
   
   mVal = CCur(vVal)
  
ExitMval:
   
   Exit Function

WrongArguments:
    
    mVal = 0
    Resume ExitMval
    
End Function

Private Sub TmrProgram_Timer()
    lSeconds = lSeconds + 1
End Sub
Sub centerform(frm As Form)
    frm.Move (Screen.Width - frm.Width) \ 2, (Screen.Height - frm.Height) \ 2
    Screen.MousePointer = vbNormal
End Sub

Private Sub tmrSweep_Timer()
  
  Static istep As Integer
      
  DSB.SetFrequency iSweepValue
  iSweepValue = iSweepValue + (iSweepStep * iSign)
  
  istep = istep + 1
  If istep > 10 Then
     istep = 0
     LCDDisplay1.Value = FormatNumber(nFreq * (iSweepValue / iSweeNormValue), 0, , , vbFalse)
  End If
  
  If iSweepValue >= iSweepMaxValue Then
      iSign = -1
      nFreq = iSweep1
      SinBuffer nFreq, nVolume
      DSB.SetFrequency DSBFREQUENCY_ORIGINAL
      tmrSweep.Enabled = False
      bSweepInProgress = False
  End If
'  If iSweepValue <= MinDSBFrequency Then
'      iSign = 1
'  End If
  
End Sub

Private Sub txtSweep_KeyPress(Index As Integer, KeyAscii As Integer)
     Select Case Index
        Case 2
            IntKP txtSweep(Index), 9, KeyAscii
        Case Else
           PointKP txtSweep(Index), 9, 2, KeyAscii
     End Select
End Sub