RiskYourLife/Client
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
e0675225989be571b799ac5eb9b1f7adf2d68e21
Client/Library/dxx8/samples/Multimedia/VBSamples/DirectMusic/DLSEffects/dlsfx.frm
LGram16 e067522598 Initial commit: ROW Client source code 
Game client codebase including:
- CharacterActionControl: Character and creature management
- GlobalScript: Network, items, skills, quests, utilities
- RYLClient: Main client application with GUI and event handlers
- Engine: 3D rendering engine (RYLGL)
- MemoryManager: Custom memory allocation
- Library: Third-party dependencies (DirectX, boost, etc.)
- Tools: Development utilities

🤖 Generated with [Claude Code](https://claude.com/claude-code)

Co-Authored-By: Claude <noreply@anthropic.com>
2025-11-29 16:24:34 +09:00

494 lines
15 KiB
Plaintext
Raw Blame History

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
Reference in New Issue View Git Blame Copy Permalink