frmmain.frm

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

      TabIndex        =   45
      Top             =   2190
      Width           =   435
   End
   Begin VB.Label Label4 
      BackColor       =   &H00FFFFC0&
      BackStyle       =   0  'Transparent
      Caption         =   "Hz"
      BeginProperty Font 
         Name            =   "Comic Sans MS"
         Size            =   14.25
         Charset         =   238
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H0080FFFF&
      Height          =   435
      Index           =   0
      Left            =   2010
      TabIndex        =   43
      Top             =   1080
      Width           =   405
   End
   Begin VB.Label lblhead 
      BackStyle       =   0  'Transparent
      Caption         =   "欢迎光临枕善居    http://www.mndsoft.com"
      ForeColor       =   &H00E0E0E0&
      Height          =   540
      Left            =   660
      TabIndex        =   41
      Top             =   90
      Width           =   2160
   End
   Begin VB.Image Image4 
      Height          =   645
      Left            =   240
      Picture         =   "frmMain.frx":0A03
      Top             =   0
      Width           =   11640
   End
   Begin VB.Image Image3 
      Height          =   8775
      Index           =   1
      Left            =   11880
      Picture         =   "frmMain.frx":1914D
      Top             =   0
      Width           =   255
   End
   Begin VB.Image Image3 
      Height          =   8775
      Index           =   0
      Left            =   0
      Picture         =   "frmMain.frx":1A2E3
      Top             =   0
      Width           =   255
   End
   Begin VB.Image Image2 
      Height          =   285
      Index           =   1
      Left            =   330
      Picture         =   "frmMain.frx":1B479
      Top             =   5430
      Width           =   375
   End
   Begin VB.Image Image2 
      Height          =   285
      Index           =   0
      Left            =   330
      Picture         =   "frmMain.frx":1BACF
      Top             =   5430
      Visible         =   0   'False
      Width           =   390
   End
End
Attribute VB_Name = "hscrolPercent"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'****************************************************************************
'人人为我，我为人人
'枕善居汉化收藏整理
'发布日期：2007/05/25
'描    述：普通波形发生器 Version 1.0
'网    站：http://www.Mndsoft.com/  (VB6源码博客)
'网    站：http://www.VbDnet.com/   (VB.NET源码博客,主要基于.NET2005)
'e-mail  ：[e-mail]
'e-mail  ：[e-mail]
'OICQ    ：88382850
'          如果您有新的好的代码别忘记给枕善居哦!
'****************************************************************************
Option Explicit

Dim sep As String
Dim iProgramMode As Integer
Dim lSeconds As Long

Dim iShape As Integer
Dim iChopFrequency As Integer
Dim wobValue As Integer
Dim wobpercent As Single
Dim iWobulator As Long
Dim wobProgress As Long
Dim iWobulatorMax As Long
Dim iWobulatorMin As Long
Dim iWobulatorStep As Integer

Dim iPrevVolume As Integer
Dim iChopMarkSpace As Integer
Dim iCounter As Integer
Dim DontChangeFlag As Boolean
Dim tmp As Single

Dim bSweepInProgress As Boolean
Dim iSweep0 As Single
Dim iSweep1 As Single
Dim iSweepSteps As Single
Dim iSweepStep As Single
Dim iSweepValue As Long
Dim iSweepMaxValue As Long
Dim iSweeNormValue As Long
Dim iSign As Integer
Dim MinDSBFrequency As Long

Dim nVolume As Single
Const MaxVolume = 0
Const MinVolume = -10000
Const MaxFrequency = 100000
Const MinFrequency = 100

Dim nSamples As Long
Dim nBasicBufferSize As Long
Const pi = 3.14159265358979
Dim c As Double
Dim DX7         As New DirectX7
Dim DS          As DirectSound
Dim DSB         As DirectSoundBuffer
Dim PCM         As WAVEFORMATEX
Dim DSBD        As DSBUFFERDESC
Dim i As Long

Dim nFreq As Single, nMod!, nModDir%

Private Sub SinBuffer(ByVal nFrequency As Single, ByVal nVolume!)
    
    Dim lpBuffer() As Byte, c#, nBuffer&
    Dim sValue As Double

    If nFrequency <= 0 Then Exit Sub
    
    SetDigitalSelector
    
    LCDDisplay1.Value = FormatNumber(nFreq, 1, , , vbFalse)
    LCDDisplay2.Value = FormatNumber(1000 / nFrequency, 2, , , vbFalse)
        
    lblVol = FormatPercent(nVolume, 0)
    
    c = nSamples / nFrequency
    
    nBuffer = (nBasicBufferSize \ c) * c
    If nBuffer = 0 Then nBuffer = c

    ReDim lpBuffer(nBuffer - 1)
    
    sValue = (2 * pi * nFrequency / nSamples)
    
    For i = 0 To nBuffer - 1
        c = Sin(i * sValue)
        If iShape = 1 Then
            c = Sgn(c)
            If c = 0 Then c = 1
        End If
        lpBuffer(i) = (c * nMod * nVolume + 1) * 127.5!
    ' lpBuffer(i) = (127.5! * Sin(2 * pi * (i * nSamples/ nFrequency ))) + 127.5!
    Next
    
    If DSBD.lBufferBytes <> nBuffer Then
        DSBD.lBufferBytes = nBuffer
        DSBD.lFlags = DSBCAPS_CTRLFREQUENCY Or DSBCAPS_CTRLVOLUME Or DSBCAPS_STATIC
        Set DSB = DS.CreateSoundBuffer(DSBD, PCM)
    End If

    DSB.WriteBuffer 0, 0, lpBuffer(0), DSBLOCK_ENTIREBUFFER
    If bttnOnOff(1).Value Then
       DSB.Play DSBPLAY_LOOPING
    End If
    CalculateWobbulation
    
    c = 1000

    Do While nFrequency * 20 > picOsc.ScaleWidth
        nFrequency = nFrequency \ 2
        c = c / 2
    Loop

    lblGraph = FormatNumber(c, 1) & " ms"

    picOsc.Cls
    picOsc.Line (0, picOsc.ScaleHeight \ 2)-(picOsc.ScaleWidth, picOsc.ScaleHeight \ 2), &H8000&
    picOsc.Line (0, (picOsc.ScaleHeight \ 2) * (1 - nVolume))-(picOsc.ScaleWidth, (picOsc.ScaleHeight \ 2) * (1 - nVolume)), &H6000&
    picOsc.Line (0, (picOsc.ScaleHeight \ 2) * (1 + nVolume))-(picOsc.ScaleWidth, (picOsc.ScaleHeight \ 2) * (1 + nVolume)), &H6000&

    If iShape = 1 Then
        For i = 0 To picOsc.ScaleWidth
            c = Sgn(Sin(i / picOsc.ScaleWidth * pi * 2 * nFrequency))
            If c = 0 Then c = 1
            picOsc.PSet (i, ((picOsc.ScaleHeight - 1) \ 2) * (1 - c * nMod * nVolume)), vbGreen
        Next
    Else
        tmp = 255 / picOsc.ScaleHeight
        picOsc.Line (0, picOsc.ScaleHeight \ 2)-(0, picOsc.ScaleHeight \ 2)
        For i = 0 To picOsc.ScaleWidth
            picOsc.Line -(i, (picOsc.ScaleHeight \ 2) * (1 - Sin(i / picOsc.ScaleWidth * pi * 2 * nFrequency) * nMod * nVolume)), vbGreen
            'picOsc.Line -(i, ((picOsc.ScaleHeight \ 2) * (1 - ((lpBuffer(i)) / picOsc.ScaleWidth) * nMod * nVolume))), vbGreen
        Next
    End If

End Sub

Private Sub bttnBuffer_Click(Index As Integer)
     
    For i = 0 To 3
      If i <> Index Then
         bttnBuffer(i).Value = False
      End If
    Next
   
    Select Case Index
     Case 0: nBasicBufferSize = 4096
     Case 1: nBasicBufferSize = 8192
     Case 2: nBasicBufferSize = 16384
     Case 3: nBasicBufferSize = 32768
    End Select
    SinBuffer nFreq, nVolume

End Sub

Private Sub bttnDB_Click(Index As Integer)
  Dim iVol As Long
  
  For i = 0 To 3
    If i <> Index Then
       bttnDB(i).Value = False
    End If
  Next
  
  Select Case Index
    Case 0: iVol = DSBVOLUME_MAX
    Case 1: iVol = -1000 ' - 10db
    Case 2: iVol = -2000 ' etc
    Case 3: iVol = -3000
  End Select
  DSB.SetVolume iVol

End Sub

Private Sub bttnOnOff_Click(Index As Integer)
    
    For i = 0 To 1
      If i <> Index Then
         bttnOnOff(i).Value = False
      End If
    Next
   
   Select Case Index
      Case 0
          DSB.Stop
          Image2(0).Visible = False
          Image2(1).Visible = True
      Case 1
          DSB.Play DSBPLAY_LOOPING
          Image2(0).Visible = True
          Image2(1).Visible = False
   End Select

End Sub

Private Sub bttnProg_Click(Index As Integer)
    DSB.Stop
    End
End Sub

Private Sub bttnSamples_Click(Index As Integer)
  
    For i = 0 To 3
      If i <> Index Then
         bttnSamples(i).Value = False
      End If
    Next
    
    Select Case Index
      Case 0: nSamples = 11025
      Case 1: nSamples = 22050
      Case 2: nSamples = 24000
      Case 3: nSamples = 48000
    End Select
    
    PCM.nFormatTag = WAVE_FORMAT_PCM
    PCM.nChannels = 1
    PCM.lSamplesPerSec = nSamples
    PCM.nBitsPerSample = 8
    PCM.nBlockAlign = 1
    PCM.lAvgBytesPerSec = nSamples * PCM.nBlockAlign
    
    HScroll1.Max = (nSamples / 10) * 2
    HScroll1.Min = HScroll1.Max / 20
    HScroll1.Value = nSamples / 10
    SinBuffer nFreq, nVolume

End Sub

Private Sub bttnShape_Click(Index As Integer)
  
    For i = 0 To 3
      If i <> Index Then
         bttnShape(i).Value = False
      End If
    Next
    
    iShape = Index
    SinBuffer nFreq, nVolume

End Sub

Private Sub chkChop_Click()
  
  If chkChop.State Then
    iCounter = 0
    iPrevVolume = DSB.GetVolume
    
    tmrChop.Interval = (1000 / iChopFrequency) / 5
    tmrChop.Enabled = True
    
  Else
  
    tmrChop.Enabled = False
    nMod = 1
    nVolume = 1
    DSB.SetVolume 0
    SinBuffer nFreq, nVolume
    
  End If
  
  
End Sub

Private Sub cmbEndSweep_Click()
      
      nFreq = 1000
      txtSweep(0).Text = nFreq
      SinBuffer nFreq, nVolume
      DSB.SetFrequency DSBFREQUENCY_ORIGINAL
      tmrSweep.Enabled = False
      bttnOnOff_Click 0

End Sub

Private Sub cmbSweep_Click()
  
  Dim StepsPerSecond As Single
  Dim TotalSteps As Single
  Dim MaxDSBFrequency As Long
    
  LED1.State = False
  LED1_Click
  
  iSweep0 = Val(txtSweep(0).Text)
  iSweep1 = Val(txtSweep(1).Text)
  iSign = 1
  
  nFreq = iSweep1 \ 2 ' First set our frequency as half of maximum
      
  StepsPerSecond = 10
  TotalSteps = mVal(txtSweep(2).Text) * StepsPerSecond
  
  If TotalSteps <= 0 Then
     Exit Sub
  End If
  
  iSweeNormValue = DSB.GetFrequency
  
  MaxDSBFrequency = iSweeNormValue * 2
  MinDSBFrequency = iSweeNormValue * (iSweep0 / iSweep1) * 2
  
  iSweepValue = MinDSBFrequency
  iSweepStep = (MaxDSBFrequency - MinDSBFrequency) / TotalSteps
  iSweepMaxValue = MaxDSBFrequency
  
  bSweepInProgress = True
  tmrSweep.Interval = 1000 \ StepsPerSecond
  
  DSB.Stop
  DSB.SetFrequency iSweepValue
  
  SinBuffer nFreq, nVolume
  LCDDisplay1.Value = FormatNumber(nFreq * (iSweepValue / iSweeNormValue), 0, , , vbFalse)
  tmrSweep.Enabled = True
  
End Sub
Private Sub Command2_Click()
   DSB.SetFrequency DSBFREQUENCY_ORIGINAL
End Sub
Private Sub ctDial1_DialChange(nValue As Integer)
    nFreq = 1 + ctDial1.Value * 22.049! * Log(1 + ctDial1.Value / 100) / Log(2)
    txtSweep(0).Text = nFreq
    SinBuffer nFreq, nVolume
End Sub