VERSION 5.00 Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX" Begin VB.Form frmMain BorderStyle = 1 'Fixed Single Caption = "DLS Sound Effects" ClientHeight = 4920 ClientLeft = 45 ClientTop = 330 ClientWidth = 5670 Icon = "DLSFX.frx":0000 LinkTopic = "Form1" MaxButton = 0 'False MinButton = 0 'False ScaleHeight = 4920 ScaleWidth = 5670 StartUpPosition = 3 'Windows Default Begin VB.Frame Frame1 Caption = "Heartbeat" Height = 3255 Left = 120 TabIndex = 17 Top = 1560 Width = 2895 Begin VB.CommandButton cmdB7 Caption = "&On" BeginProperty Font Name = "Arial" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 495 Left = 480 TabIndex = 8 Top = 360 Width = 735 End Begin VB.CommandButton cmdOff Caption = "O&ff" Enabled = 0 'False BeginProperty Font Name = "Arial" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 495 Left = 1800 TabIndex = 9 Top = 360 Width = 735 End Begin MSComctlLib.Slider sliderB7 Height = 375 Left = 360 TabIndex = 11 Top = 1440 Width = 2295 _ExtentX = 4048 _ExtentY = 661 _Version = 393216 LargeChange = 3 Min = 1 Max = 13 SelStart = 1 Value = 1 End Begin MSComctlLib.Slider sliderPitch Height = 375 Left = 360 TabIndex = 13 Top = 2400 Width = 2295 _ExtentX = 4048 _ExtentY = 661 _Version = 393216 LargeChange = 1365 SmallChange = 128 Max = 16383 SelStart = 8065 TickFrequency = 1365 Value = 8065 End Begin VB.Label Label2 Caption = "&Note (B7-B8)" Height = 255 Left = 480 TabIndex = 10 Top = 1080 Width = 1695 End Begin VB.Label lblPitch Caption = "&Pitch Bend" Height = 255 Left = 480 TabIndex = 12 Top = 2040 Width = 1815 End End Begin VB.CommandButton cmdExit Cancel = -1 'True Caption = "E&xit" Height = 495 Left = 3720 TabIndex = 16 Top = 3120 Width = 1335 End Begin VB.CommandButton cmdC10 BackColor = &H00FFFFFF& Caption = "C&10" BeginProperty Font Name = "Arial" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 495 Left = 4688 TabIndex = 6 Top = 720 Width = 615 End Begin VB.CommandButton cmdC9 Caption = "C&9" BeginProperty Font Name = "Arial" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 495 Left = 3968 TabIndex = 5 Top = 720 Width = 615 End Begin VB.CommandButton cmdC5 Caption = "C&5" BeginProperty Font Name = "Arial" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 495 Left = 1808 TabIndex = 2 Top = 720 Width = 615 End Begin VB.CommandButton cmdC4 Caption = "C&4" BeginProperty Font Name = "Arial" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 495 Left = 1088 TabIndex = 1 Top = 720 Width = 615 End Begin VB.CommandButton cmdC6 Caption = "C&6" BeginProperty Font Name = "Arial" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 495 Left = 2528 TabIndex = 3 Top = 720 Width = 615 End Begin VB.CommandButton cmdC3 Caption = "C&3" BeginProperty Font Name = "Arial" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 495 Left = 368 TabIndex = 0 Top = 720 Width = 615 End Begin VB.CommandButton cmdC7 Caption = "C&7" BeginProperty Font Name = "Arial" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 495 Left = 3248 TabIndex = 4 Top = 720 Width = 615 End Begin MSComctlLib.Slider sliderVelocity Height = 195 Left = 3360 TabIndex = 15 Top = 1920 Width = 2295 _ExtentX = 4048 _ExtentY = 344 _Version = 393216 LargeChange = 16 Max = 127 SelStart = 127 TickFrequency = 16 Value = 127 End Begin VB.Label Label3 Caption = "&Velocity of New Notes" Height = 255 Left = 3480 TabIndex = 14 Top = 1560 Width = 1935 End Begin VB.Label Label1 Alignment = 2 'Center Caption = "Boids.dls - ""Vocals"" Instrument Regions" BeginProperty Font Name = "Arial" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Left = 428 TabIndex = 7 Top = 240 Width = 4815 End End Attribute VB_Name = "frmMain" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' ' Copyright (C) 1999-2001 Microsoft Corporation. All Rights Reserved. ' ' File: dlsfx.frm ' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' This application demonstrates the use of Downloadable Sounds for sound ' effects, and how to send MIDI notes. ' The DLS instruments are taken from Boids.dls. That collection actually ' contains only a single instrument, called Vocals. However, the instrument ' is based on different wave samples for different "regions" or ranges ' of notes. For example, the first speech sound is used when any note ' between C3 and B3 is sent. The speech sounds are played at the correct ' pitch only when the note is the lowest one in the region. ' One of the samples, called Heartbeat, is valid for the range B7-B8. ' Because this is not a vocal sample, we can reasonably vary the pitch ' by playing various notes within that range, as determined by the ' slider setting. ' Heartbeat is also the only sample in the DLS collection that is based ' on a looped wave. Hence it can be played continuously for up to the ' maximum duration of a note. The other samples will play only once ' regardless of the duration of the note sent. Option Explicit Const patch = 127 ' Assigned to "Vocals" instrument in Boids.dls Const channel = 1 Const hbchannel = 32 ' NoteDur is the duration of any of the non-repeating samples. It should ' be long enough to accommodate all the sound effects but not so long ' that notes continue using up resources (voices) after the sample has ' finished playing. Note that if you send the same note before the last ' one has finished playing, it might not play properly. Const NoteDurC3 = 4000 ' milliseconds Const NoteDurC4 = 7000 ' milliseconds Const NoteDurC5 = 5500 ' milliseconds Const NoteDurC6 = 5000 ' milliseconds Const NoteDurC7 = 2800 ' milliseconds Const NoteDurC9 = 5000 ' milliseconds Const NoteDurC10 = 3800 ' milliseconds Dim B7Freq As Byte Dim B7Playing As Boolean Dim gVelocity As Byte Dim mediapath As String Dim dx As New DirectX8 Dim perf As DirectMusicPerformance8 Dim coll As DirectMusicCollection8 Dim seg As DirectMusicSegment8 Private Sub SendNote(chan As Integer, pitch As Byte, dur As Long) Dim noteMsg As DMUS_NOTE_PMSG noteMsg.velocity = gVelocity noteMsg.flags = DMUS_NOTEF_NOTEON noteMsg.midiValue = pitch noteMsg.mtDuration = dur Call perf.SendNotePMSG(0, DMUS_PMSGF_REFTIME, chan, noteMsg) End Sub Private Sub B7NoteOff() ' To turn off a note, we send a note-off message on the same ' channel and at the same pitch. Dim noteMsg As DMUS_NOTE_PMSG noteMsg.flags = 0 noteMsg.midiValue = B7Freq Call perf.SendNotePMSG(0, DMUS_PMSGF_REFTIME, hbchannel, noteMsg) End Sub Private Sub cmdB7_Click() ' For the hearbeat we'll send the note using a standard MIDI message. ' That way we don't have to worry about the duration of the note; ' it will play till we stop it. Call perf.SendMIDIPMSG(0, DMUS_PMSGF_REFTIME, hbchannel, &H90, B7Freq, gVelocity) B7Playing = True cmdB7.Enabled = False cmdOff.Enabled = True End Sub Private Sub cmdExit_Click() Unload Me End Sub Private Sub cmdOff_Click() B7NoteOff B7Playing = False cmdB7.Enabled = True cmdOff.Enabled = False End Sub Private Sub cmdC3_Click() SendNote channel, 36, NoteDurC3 End Sub Private Sub cmdC4_Click() SendNote channel, 48, NoteDurC4 End Sub Private Sub cmdC5_Click() SendNote channel, 60, NoteDurC5 End Sub Private Sub cmdC6_Click() SendNote channel, 72, NoteDurC6 End Sub Private Sub cmdC7_Click() SendNote channel, 84, NoteDurC7 End Sub Private Sub cmdC9_Click() SendNote channel, 108, NoteDurC9 End Sub Private Sub cmdC10_Click() SendNote channel, 120, NoteDurC10 End Sub Private Sub Form_Load() On Error GoTo FAILEDINIT Dim dmA As DMUS_AUDIOPARAMS Set perf = dx.DirectMusicPerformanceCreate perf.InitAudio Me.hWnd, DMUS_AUDIOF_ALL, dmA, , DMUS_APATH_SHARED_STEREOPLUSREVERB, 64 On Error GoTo FAILEDLOAD mediapath = FindMediaDir("sample.sgt") If mediapath <> vbNullString Then ChDir mediapath Dim loader As DirectMusicLoader8 Set loader = dx.DirectMusicLoaderCreate Set coll = loader.LoadCollection(mediapath & "boids.dls") ' Load any segment. We're not actually going to play it, ' but we need a valid segment object so we can download the DLS. Set seg = loader.LoadSegment(mediapath & "sample.sgt") seg.ConnectToCollection coll seg.Download perf.GetDefaultAudioPath On Error GoTo 0 ' Assign the Vocals instrument to two channels ' One will be used only for the heartbeat so we can pitch bend Call perf.SendPatchPMSG(0, DMUS_PMSGF_REFTIME, channel, patch, 5, 0) Call perf.SendPatchPMSG(0, DMUS_PMSGF_REFTIME, hbchannel, patch, 5, 0) ' Initialize heartbeat note. B7 is MIDI note 95. B7Freq = sliderB7.Value + 94 gVelocity = sliderVelocity.Value Exit Sub FAILEDINIT: MsgBox "Could not initialize DirectMusic." & vbCrLf & "This sample will exit.", vbOKOnly Or vbInformation, "Exiting..." Unload Me Exit Sub FAILEDLOAD: MsgBox "Failed to load file." Unload Me Exit Sub End Sub Private Sub Form_Unload(Cancel As Integer) If Not (seg Is Nothing) Then seg.Unload perf.GetDefaultAudioPath Set seg = Nothing If Not (perf Is Nothing) Then perf.CloseDown Set perf = Nothing End End Sub Private Sub sliderB7_Change() B7NoteOff B7Freq = 94 + sliderB7.Value If B7Playing Then Call perf.SendMIDIPMSG(0, DMUS_PMSGF_REFTIME, hbchannel, &H90, B7Freq, gVelocity) End If End Sub Private Sub sliderPitch_Change() Dim hi As Byte, lo As Byte ' Split value into 7-bit bytes hi = Fix(sliderPitch.Value / 128) lo = CByte(sliderPitch.Value And 127) ' Send pitch bend message Call perf.SendMIDIPMSG(0, DMUS_PMSGF_REFTIME, hbchannel, &HE0, _ lo, hi) End Sub Private Sub sliderVelocity_Change() gVelocity = sliderVelocity.Value End Sub