0
0

[code:28yt70r1]
Option Explicit

Private Type PosAndIncrement_DoublePrecision
val1 As Double
incr As Double
End Type

Private Type MinMax_DoublePrecision
min_v As Double
max_v As Double
End Type

Private Type LeftRight16
SampL As Integer
SampR As Integer
End Type

Private Type Sample16S
SampAry() As LeftRight16
BufLen As Long
UB As Long
Pos As Long
PrevPos As Long
CalcStart As Long
CalcStop As Long
ABSPos As Long
sVol As Single
End Type

Private Type Min_Max_Val_Incr
Bounds As MinMax_DoublePrecision
Pos As PosAndIncrement_DoublePrecision
sPeriod As Single
End Type

Dim SynthData As Sample16S
Dim SlowTriangle As Min_Max_Val_Incr

Private Const note_1of12# = 1.05944
Private Const note_2of12# = note_1of12 * note_1of12
Private Const note_3of12# = note_2of12 * note_1of12
Private Const note_4of12# = note_3of12 * note_1of12
Private Const note_5of12# = note_4of12 * note_1of12
Private Const note_6of12# = note_5of12 * note_1of12
Private Const note_7of12# = note_6of12 * note_1of12
Private Const note_8of12# = note_7of12 * note_1of12
Private Const note_9of12# = note_8of12 * note_1of12
Private Const note_10of12# = note_9of12 * note_1of12
Private Const note_11of12# = note_10of12 * note_1of12

Dim HowManyNotes&

Dim HalfScaleHeight&

Private MaxX&

‘FMod stuff
Dim DestPtr&
Dim SrcPtr&
Dim LSuccess&
Dim hChn&

Dim MainBufSamplingRate As Long

Private Const FSOUND_CDQuality_Signed As Long = fsound_16bits Or fsound_signed Or fsound_stereo
Private Const MainPlayBufFormat As Long = fsound_16bits Or fsound_signed Or fsound_stereo Or FSOUND_LOOP_NORMAL
Private Sub Form_Load()

Show

SynthData.BufLen = 3500

MainBufSamplingRate = 44100

FMod.FSOUND_Init MainBufSamplingRate, 32, 0

SynthData.UB = SynthData.BufLen – 1
ReDim SynthData.SampAry(SynthData.UB)

SynthData.sVol = 1

SrcPtr = VarPtr(SynthData.SampAry(0).SampL)

DestPtr = FMod.FSOUND_Sample_Alloc(0, SynthData.BufLen, MainPlayBufFormat, MainBufSamplingRate, 1000, 0, 0)
hChn = FMod.FSOUND_PlaySound(0, DestPtr)

SlowTriangle.sPeriod = 12

SlowTriangle.Bounds.max_v = 160 / (MainBufSamplingRate – 1)
SlowTriangle.Bounds.min_v = 110 / (MainBufSamplingRate – 1)
SlowTriangle.Pos.incr = (SlowTriangle.Bounds.max_v – _
SlowTriangle.Bounds.min_v) / (MainBufSamplingRate * SlowTriangle.sPeriod / 2 – 1)

SlowTriangle.Pos.val1 = SlowTriangle.Bounds.min_v

Do While DoEvents

If SynthData.PrevPos < SynthData.Pos Then
ExampleFormula SynthData, SynthData.Pos – 1
SynthData.CalcStart = SynthData.Pos
ElseIf SynthData.PrevPos > SynthData.Pos Then
ExampleFormula SynthData, SynthData.UB
SynthData.CalcStart = 0
End If

SynthData.PrevPos = SynthData.Pos
SynthData.Pos = FSOUND_GetCurrentPosition(hChn)

FSOUND_Sample_Upload DestPtr, ByVal SrcPtr, FSOUND_CDQuality_Signed

Loop

FMod.FSOUND_StopSound hChn

End Sub

Private Sub ExampleFormula(SData1 As Sample16S, CalcStop As Long)
Dim I&
Dim sngTmp!
Dim Int1%
Dim Pos1#
Dim maxVal1!
Dim minVal1!
Dim X&
Dim Y&

For I = SData1.CalcStart To CalcStop

Pos1 = SData1.ABSPos * SlowTriangle.Pos.val1

HowManyNotes = 0

sngTmp = AddSawWavePlusRing(Pos1, 1.0035)
‘sngTmp = sngTmp + AddSawWavePlusRing(Pos1 * note_2of12, 1.0035)
‘sngTmp = sngTmp + AddSawWavePlusRing(Pos1 * note_4of12, 1.0035)
‘sngTmp = sngTmp + AddSawWavePlusRing(Pos1 * note_7of12, 1.0035)
‘sngTmp = sngTmp + AddSawWavePlusRing(Pos1 * note_11of12, 1.0035)
‘sngTmp = sngTmp + AddSawWavePlusRing(Pos1 * note_2of12 * 2, 1.0035)
‘sngTmp = sngTmp + AddSawWavePlusRing(Pos1 * note_7of12 * 2, 1.0035)

sngTmp = sngTmp * SData1.sVol

maxVal1 = HowManyNotes / 2 ‘ "/ 2" combined with "65535 / HowManyNotes" (a few lines below) maintains a good signal strength.
minVal1 = -maxVal1

‘prevent overflow
If sngTmp > maxVal1 Then
sngTmp = maxVal1
ElseIf sngTmp < minVal1 Then
sngTmp = minVal1
End If

‘Signal ‘voltage’
Int1 = Int(sngTmp * 65535 / HowManyNotes + 0.49999!)

”Sample
SData1.SampAry(I).SampL = Int1
SData1.SampAry(I).SampR = Int1

”scope
Y = HalfScaleHeight + Int1 / 512
PSet (X, Y)
X = X + 1
If X = MaxX Then
‘Cls
ForeColor = Rnd * vbWhite
X = 0
End If

If SlowTriangle.Pos.incr < 0 Then
SData1.ABSPos = SData1.ABSPos – 1
If SlowTriangle.Pos.val1 < SlowTriangle.Bounds.min_v Then
SlowTriangle.Pos.incr = -SlowTriangle.Pos.incr
End If
Else
SData1.ABSPos = SData1.ABSPos + 1
If SlowTriangle.Pos.val1 > SlowTriangle.Bounds.max_v Then
SlowTriangle.Pos.incr = -SlowTriangle.Pos.incr
End If
End If

SlowTriangle.Pos.val1 = SlowTriangle.Pos.val1 + SlowTriangle.Pos.incr

Next I

End Sub
Private Function AddSawWavePlusRing(ByVal dbl_Pos#, Optional ByVal note_ring# = 1) As Single

HowManyNotes = HowManyNotes + 1

AddSawWavePlusRing = dbl_Pos – Int(dbl_Pos) – 0.5

‘a second, slightly-different frequency can add warmth to a sound
dbl_Pos = dbl_Pos * note_ring
AddSawWavePlusRing = AddSawWavePlusRing + _
dbl_Pos – Int(dbl_Pos) – 0.5

End Function

Private Sub Form_KeyDown(IntKey As Integer, Shift As Integer)
Select Case IntKey
Case vbKeyEscape
Unload Me
End Select
End Sub

Private Sub Form_Resize()
ScaleMode = vbPixels
HalfScaleHeight = ScaleHeight / 2
MaxX = ScaleWidth
End Sub

Private Sub Form_Unload(Cancel As Integer)
FMod.FSOUND_Close
End Sub
[/code:28yt70r1]

  • You must to post comments
0
0

…care to expand on this ? 😮

  • You must to post comments
0
0

Yeah it would be a bit helpful if you would explain the code instead of just posting it. 😆

  • You must to post comments
0
0

in ExampleFormula(), the commented out AddSawWave.. are additional notes. Try them out.

Also,

These three values, 12, 160, 110 are good to mess around with.

SlowTriangle.sPeriod = 12

SlowTriangle.Bounds.max_v = 160 / (MainBufSamplingRate – 1)
SlowTriangle.Bounds.min_v = 110 / (MainBufSamplingRate

  • You must to post comments
Showing 3 results
Your Answer

Please first to submit.