RiskYourLife/Client
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
5d3cd64a2585d4240fd9ac17917af05aa7ee326a
Client/Library/dxx8/samples/Multimedia/VBSamples/DirectMusic/DMDrums/main.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

640 lines
18 KiB
Plaintext
Raw Blame History

VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Begin VB.Form main
BorderStyle = 1 'Fixed Single
Caption = "DMDrums"
ClientHeight = 5505
ClientLeft = 45
ClientTop = 330
ClientWidth = 6255
Icon = "main.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 5505
ScaleWidth = 6255
StartUpPosition = 3 'Windows Default
Begin VB.CheckBox chkReverb
Caption = "Play with environmental reverb"
Height = 255
Left = 1140
TabIndex = 39
Top = 1500
Value = 1 'Checked
Width = 3015
End
Begin VB.CommandButton cmdExit
Cancel = -1 'True
Caption = "Exit"
Height = 495
Left = 5340
TabIndex = 31
Top = 4980
Width = 855
End
Begin MSComCtl2.UpDown UpDown_Volume
Height = 375
Left = 1740
TabIndex = 36
TabStop = 0 'False
Top = 960
Width = 240
_ExtentX = 423
_ExtentY = 661
_Version = 393216
Value = 100
Max = 100
Enabled = -1 'True
End
Begin MSComCtl2.UpDown UpDown_Tempo
Height = 375
Left = 1740
TabIndex = 35
TabStop = 0 'False
Top = 360
Width = 240
_ExtentX = 423
_ExtentY = 661
_Version = 393216
Value = 120
Max = 1000
Min = 1
Enabled = -1 'True
End
Begin VB.TextBox EDIT_Tempo
Height = 375
Left = 1200
MaxLength = 4
TabIndex = 0
Text = "120"
Top = 360
Width = 495
End
Begin VB.TextBox EDIT_Volume
Height = 375
Left = 1200
TabIndex = 1
Text = "100"
Top = 960
Width = 495
End
Begin VB.CommandButton Stop
Height = 495
Left = 3720
Picture = "main.frx":0442
Style = 1 'Graphical
TabIndex = 3
Top = 840
Width = 495
End
Begin VB.CommandButton Play
Height = 495
Left = 3120
Picture = "main.frx":08F8
Style = 1 'Graphical
TabIndex = 2
Top = 840
Width = 495
End
Begin VB.PictureBox Picture1
BorderStyle = 0 'None
Height = 1695
Left = 120
Picture = "main.frx":0E8A
ScaleHeight = 1695
ScaleWidth = 855
TabIndex = 32
TabStop = 0 'False
Top = 120
Width = 855
End
Begin VB.ListBox LIST_Grooves
Height = 2400
Left = 4320
TabIndex = 29
Top = 840
Width = 1815
End
Begin VB.ListBox LIST_Bands
Height = 1425
Left = 4320
TabIndex = 30
Top = 3480
Width = 1815
End
Begin VB.CommandButton Drum
Caption = "High Q"
Height = 495
Index = 24
Left = 3480
TabIndex = 28
Top = 4440
Width = 735
End
Begin VB.CommandButton Drum
Caption = "Scratch"
Height = 495
Index = 23
Left = 2640
TabIndex = 27
Top = 4440
Width = 735
End
Begin VB.CommandButton Drum
Caption = "Sticks"
Height = 495
Index = 22
Left = 1800
TabIndex = 26
Top = 4440
Width = 735
End
Begin VB.CommandButton Drum
Caption = "Hand Clap"
Height = 495
Index = 21
Left = 960
TabIndex = 25
Top = 4440
Width = 735
End
Begin VB.CommandButton Drum
Caption = "Tamb- ourine"
Height = 495
Index = 20
Left = 120
TabIndex = 24
Top = 4440
Width = 735
End
Begin VB.CommandButton Drum
Caption = "Jingle Bells"
Height = 495
Index = 19
Left = 3480
TabIndex = 23
Top = 3840
Width = 735
End
Begin VB.CommandButton Drum
Caption = "Cast- anets"
Height = 495
Index = 18
Left = 2640
TabIndex = 22
Top = 3840
Width = 735
End
Begin VB.CommandButton Drum
Caption = "Shaker"
Height = 495
Index = 17
Left = 1800
TabIndex = 21
Top = 3840
Width = 735
End
Begin VB.CommandButton Drum
Caption = "Triangle"
Height = 495
Index = 16
Left = 960
TabIndex = 20
Top = 3840
Width = 735
End
Begin VB.CommandButton Drum
Caption = "Cuica"
Height = 495
Index = 15
Left = 120
TabIndex = 19
Top = 3840
Width = 735
End
Begin VB.CommandButton Drum
Caption = "High Block"
Height = 495
Index = 14
Left = 3480
TabIndex = 18
Top = 3240
Width = 735
End
Begin VB.CommandButton Drum
Caption = "Low Block"
Height = 495
Index = 13
Left = 2640
TabIndex = 17
Top = 3240
Width = 735
End
Begin VB.CommandButton Drum
Caption = "Guiro"
Height = 495
Index = 12
Left = 1800
TabIndex = 16
Top = 3240
Width = 735
End
Begin VB.CommandButton Drum
Caption = "Agogo"
Height = 495
Index = 11
Left = 960
TabIndex = 15
Top = 3240
Width = 735
End
Begin VB.CommandButton Drum
Caption = "Timbale"
Height = 495
Index = 10
Left = 120
TabIndex = 14
Top = 3240
Width = 735
End
Begin VB.CommandButton Drum
Caption = "High Conga"
Height = 495
Index = 9
Left = 3480
TabIndex = 13
Top = 2640
Width = 735
End
Begin VB.CommandButton Drum
Caption = "Low Conga"
Height = 495
Index = 8
Left = 2640
TabIndex = 12
Top = 2640
Width = 735
End
Begin VB.CommandButton Drum
Caption = "Crash"
Height = 495
Index = 7
Left = 1800
TabIndex = 11
Top = 2640
Width = 735
End
Begin VB.CommandButton Drum
Caption = "Splash"
Height = 495
Index = 6
Left = 960
TabIndex = 10
Top = 2640
Width = 735
End
Begin VB.CommandButton Drum
Caption = "Ride"
Height = 495
Index = 5
Left = 120
TabIndex = 9
Top = 2640
Width = 735
End
Begin VB.CommandButton Drum
Caption = "High Tom"
Height = 495
Index = 4
Left = 3480
TabIndex = 8
Top = 2040
Width = 735
End
Begin VB.CommandButton Drum
Caption = "Mid Tom"
Height = 495
Index = 3
Left = 2640
TabIndex = 7
Top = 2040
Width = 735
End
Begin VB.CommandButton Drum
Caption = "Low Tom"
Height = 495
Index = 2
Left = 1800
TabIndex = 6
Top = 2040
Width = 735
End
Begin VB.CommandButton Drum
Caption = "Snare"
Height = 495
Index = 1
Left = 960
TabIndex = 5
Top = 2040
Width = 735
End
Begin VB.CommandButton Drum
Caption = "Kick"
Height = 495
Index = 0
Left = 120
TabIndex = 4
Top = 2040
Width = 735
End
Begin VB.Label lblInfo
BackStyle = 0 'Transparent
Caption = "Drum Sets"
Height = 255
Index = 1
Left = 4320
TabIndex = 38
Top = 3240
Width = 1755
End
Begin VB.Label lblInfo
BackStyle = 0 'Transparent
Caption = "Grooves"
Height = 255
Index = 0
Left = 4320
TabIndex = 37
Top = 600
Width = 1755
End
Begin VB.Label Label2
Caption = "Tempo:"
Height = 255
Left = 1200
TabIndex = 34
Top = 120
Width = 615
End
Begin VB.Label Label1
Caption = "Volume:"
Height = 255
Left = 1200
TabIndex = 33
Top = 720
Width = 615
End
End
Attribute VB_Name = "main"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' Copyright (C) 1999-2001 Microsoft Corporation. All Rights Reserved.
'
' File: main.frm
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim dx As New DirectX8
Dim perf As DirectMusicPerformance8
Dim loader As DirectMusicLoader8
Dim style As DirectMusicStyle8
Dim band As DirectMusicBand8
Dim composer As DirectMusicComposer8
Dim seg As DirectMusicSegment8
Dim segBand As DirectMusicSegment8
Dim segMotif() As DirectMusicSegment8
Dim mediapath As String
Dim mtTime As Long
Private Sub chkReverb_Click()
'Ok, they want to switch the default audio paths
Dim dmPath As DirectMusicAudioPath8
If chkReverb.Value = vbUnchecked Then
Set dmPath = perf.CreateStandardAudioPath(DMUS_APATH_DYNAMIC_STEREO, 128, True)
Else
Set dmPath = perf.CreateStandardAudioPath(DMUS_APATH_SHARED_STEREOPLUSREVERB, 128, True)
End If
perf.SetDefaultAudioPath dmPath
ChangeBands
End Sub
Private Sub cmdExit_Click()
Stop_Click
Unload Me
End Sub
Private Sub Drum_Click(Index As Integer)
Call perf.PlaySegmentEx(segMotif(Index), DMUS_SEGF_SECONDARY, 0)
End Sub
Private Sub EDIT_Tempo_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyReturn Then
If Val(EDIT_Tempo.Text) > 0 And Val(EDIT_Tempo.Text) < 1001 And IsNumeric(EDIT_Tempo.Text) Then
UpDown_Tempo.Value = EDIT_Tempo.Text
ChangeTempo (UpDown_Tempo.Value)
Else
EDIT_Tempo.Text = UpDown_Tempo.Value
End If
End If
If KeyAscii = vbKeyReturn Then KeyAscii = 0
End Sub
Private Sub EDIT_Tempo_LostFocus()
If Val(EDIT_Tempo.Text) > 0 And Val(EDIT_Tempo.Text) < 1001 And IsNumeric(EDIT_Tempo.Text) Then
UpDown_Tempo.Value = EDIT_Tempo.Text
ChangeTempo (UpDown_Tempo.Value)
Else
EDIT_Tempo.Text = UpDown_Tempo.Value
End If
End Sub
Private Sub EDIT_Volume_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyReturn Then
If IsNumeric(EDIT_Volume.Text) And Val(EDIT_Volume.Text) >= 0 And Val(EDIT_Volume.Text) < 101 Then
UpDown_Volume.Value = EDIT_Volume.Text
ChangeVolume UpDown_Volume.Value
Else
EDIT_Volume.Text = UpDown_Volume.Value
End If
End If
If KeyAscii = vbKeyReturn Then KeyAscii = 0
End Sub
Private Sub EDIT_Volume_LostFocus()
If IsNumeric(EDIT_Volume.Text) And Val(EDIT_Volume.Text) >= 0 And Val(EDIT_Volume.Text) < 101 Then
UpDown_Volume.Value = EDIT_Volume.Text
ChangeVolume UpDown_Volume
Else
EDIT_Volume.Text = UpDown_Volume.Value
End If
End Sub
Private Sub Form_Load()
Dim dmA As DMUS_AUDIOPARAMS, lCount As Long
Dim MotifName As String
mediapath = FindMediaDir("Drums!.sgt")
Set perf = dx.DirectMusicPerformanceCreate()
Set loader = dx.DirectMusicLoaderCreate()
Set composer = dx.DirectMusicComposerCreate()
'Make sure we can init the audio as well
On Error GoTo FailedInit
' Initialize performance object to use its own DirectSound object
perf.InitAudio Me.hWnd, DMUS_AUDIOF_ALL, dmA, , DMUS_APATH_SHARED_STEREOPLUSREVERB, 128
' SetMasterAutoDownload indicates we the perofmance object
' to attempt to auto download DLS collections when reference in
' sgt and sty files
Call perf.SetMasterAutoDownload(True)
Set style = loader.LoadStyle(mediapath & "drums!.sty")
Set seg = loader.LoadSegment(mediapath & "drums!.sgt")
Get_Bands
LIST_Grooves.AddItem ("Alternative")
LIST_Grooves.AddItem ("Blues")
LIST_Grooves.AddItem ("Country")
LIST_Grooves.AddItem ("Dance - Pop")
LIST_Grooves.AddItem ("Hard Rock")
LIST_Grooves.AddItem ("Hip Hop")
LIST_Grooves.AddItem ("Jazz")
LIST_Grooves.AddItem ("Latin")
LIST_Grooves.AddItem ("R & B")
LIST_Grooves.AddItem ("Rap")
LIST_Grooves.AddItem ("Soft Rock")
LIST_Grooves.AddItem ("World")
' Download the default band so that we can play the drum pads immediately
ChangeBands
ChangeVolume UpDown_Volume.Value
ReDim segMotif(style.GetMotifCount() - 1)
For lCount = 0 To style.GetMotifCount() - 1
MotifName = style.GetMotifName(lCount)
'We could set the drum name here (but we'll just leave them hard coded)
'Drum(lCount).Caption = MotifName
Set segMotif(lCount) = style.GetMotif(MotifName)
Next
LIST_Grooves.ListIndex = 0
LIST_Bands.ListIndex = 0
Exit Sub
FailedInit:
MsgBox "Could not initialize DirectMusic." & vbCrLf & "This sample will exit.", vbOKOnly Or vbInformation, "Exiting..."
Unload Me
End Sub
Private Sub Form_Unload(Cancel As Integer)
Dim lCount As Long
On Error Resume Next
If Not (segBand Is Nothing) Then
perf.StopEx segBand, 0, 0
segBand.Unload perf.GetDefaultAudioPath
End If
If Not (seg Is Nothing) Then perf.StopEx seg, 0, 0
Set seg = Nothing
For lCount = LBound(segMotif) To UBound(segMotif)
If Not (segMotif(lCount) Is Nothing) Then perf.StopEx segMotif(lCount), 0, 0
Set segMotif(lCount) = Nothing
Next
Set segBand = Nothing
Set style = Nothing
Set composer = Nothing
Set loader = Nothing
If Not (band Is Nothing) Then
Call band.Unload(perf)
End If
Set band = Nothing
If Not (perf Is Nothing) Then perf.CloseDown
Set perf = Nothing
End Sub
Private Sub Get_Bands()
Dim BandCount As Integer
Dim counter As Integer
BandCount = style.GetBandCount()
For counter = 0 To (BandCount - 1)
LIST_Bands.AddItem (style.GetBandName(BandCount - counter - 1))
Next counter
End Sub
Private Sub LIST_Bands_Click()
ChangeBands
End Sub
Private Sub LIST_Grooves_Click()
perf.SetMasterGrooveLevel ((LIST_Grooves.ListIndex * 8) + 1)
End Sub
Private Sub Play_Click()
PlaySeg
ChangeBands
chkReverb.Enabled = False
End Sub
Private Sub Stop_Click()
perf.StopEx seg, 0, 0
chkReverb.Enabled = True
End Sub
Private Sub UPDOWN_Tempo_Change()
EDIT_Tempo.Text = UpDown_Tempo.Value
ChangeTempo (UpDown_Tempo.Value)
End Sub
Private Sub UPDOWN_Volume_Change()
EDIT_Volume.Text = UpDown_Volume.Value
Call ChangeVolume(UpDown_Volume.Value)
End Sub
Private Sub ChangeBands()
If Not (band Is Nothing) Then
Call band.Unload(perf)
End If
If LIST_Bands = vbNullString Then
Set band = style.GetBand("Standard")
Else
Set band = style.GetBand(LIST_Bands)
End If
Call band.Download(perf)
Set segBand = band.CreateSegment()
segBand.Download perf.GetDefaultAudioPath
Call perf.PlaySegmentEx(segBand, DMUS_SEGF_SECONDARY, 0)
End Sub
Private Sub PlaySeg()
Call perf.PlaySegmentEx(seg, 0, 0)
End Sub
Private Sub ChangeTempo(tempo As Integer)
perf.SendTempoPMSG 0, DMUS_PMSGF_REFTIME, tempo
End Sub
Sub ChangeVolume(ByVal n As Long)
If n = 0 Then
n = -10000
Else
n = (-50 * (100 - n))
End If
perf.SetMasterVolume n
End Sub
Reference in New Issue View Git Blame Copy Permalink