LGram16
e067522598
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>
527 lines
16 KiB
Plaintext
527 lines
16 KiB
Plaintext
VERSION 5.00
|
|
Begin VB.Form frmMain
|
|
BackColor = &H00000000&
|
|
BorderStyle = 4 'Fixed ToolWindow
|
|
Caption = "Club Metamorphous"
|
|
ClientHeight = 7140
|
|
ClientLeft = 3510
|
|
ClientTop = 1890
|
|
ClientWidth = 8310
|
|
ForeColor = &H0000C000&
|
|
Icon = "ClubMet.frx":0000
|
|
LinkTopic = "Form1"
|
|
MaxButton = 0 'False
|
|
MinButton = 0 'False
|
|
ScaleHeight = 476
|
|
ScaleMode = 3 'Pixel
|
|
ScaleWidth = 554
|
|
StartUpPosition = 3 'Windows Default
|
|
Begin VB.CommandButton cmdExit
|
|
BackColor = &H0080FF80&
|
|
Cancel = -1 'True
|
|
Caption = "Exit"
|
|
Height = 495
|
|
Left = 240
|
|
TabIndex = 12
|
|
Top = 6600
|
|
Width = 1215
|
|
End
|
|
Begin VB.CommandButton cmdAdmission
|
|
BackColor = &H00FFC0FF&
|
|
Caption = "Admission"
|
|
BeginProperty Font
|
|
Name = "Times New Roman"
|
|
Size = 9.75
|
|
Charset = 0
|
|
Weight = 700
|
|
Underline = 0 'False
|
|
Italic = 0 'False
|
|
Strikethrough = 0 'False
|
|
EndProperty
|
|
Height = 495
|
|
Left = 240
|
|
Style = 1 'Graphical
|
|
TabIndex = 10
|
|
Top = 6000
|
|
Width = 1215
|
|
End
|
|
Begin VB.CommandButton cmdSpecials
|
|
BackColor = &H008080FF&
|
|
Caption = "Dinner Specials"
|
|
BeginProperty Font
|
|
Name = "Times New Roman"
|
|
Size = 9.75
|
|
Charset = 0
|
|
Weight = 700
|
|
Underline = 0 'False
|
|
Italic = 0 'False
|
|
Strikethrough = 0 'False
|
|
EndProperty
|
|
Height = 495
|
|
Left = 240
|
|
Style = 1 'Graphical
|
|
TabIndex = 9
|
|
Top = 5400
|
|
Width = 1215
|
|
End
|
|
Begin VB.CommandButton cmdDirections
|
|
BackColor = &H0080C0FF&
|
|
Caption = "Directions"
|
|
BeginProperty Font
|
|
Name = "Times New Roman"
|
|
Size = 9.75
|
|
Charset = 0
|
|
Weight = 700
|
|
Underline = 0 'False
|
|
Italic = 0 'False
|
|
Strikethrough = 0 'False
|
|
EndProperty
|
|
Height = 495
|
|
Left = 240
|
|
Style = 1 'Graphical
|
|
TabIndex = 8
|
|
Top = 4800
|
|
Width = 1215
|
|
End
|
|
Begin VB.PictureBox mnCan
|
|
BackColor = &H80000007&
|
|
BorderStyle = 0 'None
|
|
Height = 3795
|
|
Left = 2400
|
|
ScaleHeight = 253
|
|
ScaleMode = 3 'Pixel
|
|
ScaleWidth = 385
|
|
TabIndex = 7
|
|
Top = 1680
|
|
Width = 5775
|
|
End
|
|
Begin VB.Label lblStuff
|
|
BackColor = &H80000007&
|
|
Caption = "Label2"
|
|
ForeColor = &H8000000E&
|
|
Height = 1455
|
|
Left = 2340
|
|
TabIndex = 11
|
|
Top = 5580
|
|
Width = 5835
|
|
End
|
|
Begin VB.Label lblSunday
|
|
AutoSize = -1 'True
|
|
BackColor = &H00000000&
|
|
Caption = "Sunday"
|
|
BeginProperty Font
|
|
Name = "Times New Roman"
|
|
Size = 20.25
|
|
Charset = 0
|
|
Weight = 700
|
|
Underline = 0 'False
|
|
Italic = 0 'False
|
|
Strikethrough = 0 'False
|
|
EndProperty
|
|
ForeColor = &H0000C000&
|
|
Height = 465
|
|
Left = 240
|
|
TabIndex = 6
|
|
Top = 4200
|
|
Width = 1305
|
|
End
|
|
Begin VB.Label lblSaturday
|
|
AutoSize = -1 'True
|
|
BackColor = &H00000000&
|
|
Caption = "Saturday"
|
|
BeginProperty Font
|
|
Name = "Times New Roman"
|
|
Size = 20.25
|
|
Charset = 0
|
|
Weight = 700
|
|
Underline = 0 'False
|
|
Italic = 0 'False
|
|
Strikethrough = 0 'False
|
|
EndProperty
|
|
ForeColor = &H0000C000&
|
|
Height = 465
|
|
Left = 240
|
|
TabIndex = 5
|
|
Top = 3600
|
|
Width = 1605
|
|
End
|
|
Begin VB.Label lblFriday
|
|
AutoSize = -1 'True
|
|
BackColor = &H00000000&
|
|
Caption = "Friday"
|
|
BeginProperty Font
|
|
Name = "Times New Roman"
|
|
Size = 20.25
|
|
Charset = 0
|
|
Weight = 700
|
|
Underline = 0 'False
|
|
Italic = 0 'False
|
|
Strikethrough = 0 'False
|
|
EndProperty
|
|
ForeColor = &H0000C000&
|
|
Height = 465
|
|
Left = 240
|
|
TabIndex = 4
|
|
Top = 3000
|
|
Width = 1185
|
|
End
|
|
Begin VB.Label lblThursday
|
|
AutoSize = -1 'True
|
|
BackColor = &H00000000&
|
|
Caption = "Thursday"
|
|
BeginProperty Font
|
|
Name = "Times New Roman"
|
|
Size = 20.25
|
|
Charset = 0
|
|
Weight = 700
|
|
Underline = 0 'False
|
|
Italic = 0 'False
|
|
Strikethrough = 0 'False
|
|
EndProperty
|
|
ForeColor = &H0000C000&
|
|
Height = 465
|
|
Left = 240
|
|
TabIndex = 3
|
|
Top = 2400
|
|
Width = 1695
|
|
End
|
|
Begin VB.Label lblWednesday
|
|
AutoSize = -1 'True
|
|
BackColor = &H00000000&
|
|
Caption = "Wednesday"
|
|
BeginProperty Font
|
|
Name = "Times New Roman"
|
|
Size = 20.25
|
|
Charset = 0
|
|
Weight = 700
|
|
Underline = 0 'False
|
|
Italic = 0 'False
|
|
Strikethrough = 0 'False
|
|
EndProperty
|
|
ForeColor = &H0000FF00&
|
|
Height = 465
|
|
Left = 240
|
|
TabIndex = 2
|
|
Top = 1800
|
|
Width = 2025
|
|
End
|
|
Begin VB.Label lblName
|
|
Alignment = 2 'Center
|
|
BackColor = &H00000000&
|
|
Caption = "Club Metamorphous"
|
|
BeginProperty Font
|
|
Name = "Times New Roman"
|
|
Size = 36
|
|
Charset = 0
|
|
Weight = 700
|
|
Underline = 0 'False
|
|
Italic = 0 'False
|
|
Strikethrough = 0 'False
|
|
EndProperty
|
|
ForeColor = &H000080FF&
|
|
Height = 915
|
|
Left = 480
|
|
TabIndex = 1
|
|
Top = 0
|
|
Width = 7455
|
|
End
|
|
Begin VB.Label Label1
|
|
BackColor = &H00000000&
|
|
Caption = """The only thing that stays the same is a good time!"""
|
|
BeginProperty Font
|
|
Name = "Times New Roman"
|
|
Size = 15.75
|
|
Charset = 0
|
|
Weight = 700
|
|
Underline = 0 'False
|
|
Italic = -1 'True
|
|
Strikethrough = 0 'False
|
|
EndProperty
|
|
ForeColor = &H000080FF&
|
|
Height = 495
|
|
Left = 840
|
|
TabIndex = 0
|
|
Top = 1020
|
|
Width = 6855
|
|
End
|
|
End
|
|
Attribute VB_Name = "frmMain"
|
|
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: ClubMet.frm
|
|
'
|
|
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
|
|
|
'This application uses conditional compilation. To run this sample in the IDE, you
|
|
'must first go to Project Properties (Project Menu-> Properties). Then on the Make tab
|
|
'change the RunInIDE=0 to RunInIDE=1.
|
|
|
|
'This sample also shows developers how to combine the DX7 and DX8 DLL's to create
|
|
'an app with the latest DMusic and still use older functionality like DDraw
|
|
|
|
Private dx As New DXVBLibA.DirectX8
|
|
Dim day As Integer
|
|
Dim sJazz As DXVBLibA.DirectMusicStyle8
|
|
Dim sDance As DXVBLibA.DirectMusicStyle8
|
|
Dim sBigBand As DXVBLibA.DirectMusicStyle8
|
|
Dim sDisco As DXVBLibA.DirectMusicStyle8
|
|
Dim sClassical As DXVBLibA.DirectMusicStyle8
|
|
Dim sHeartland As DXVBLibA.DirectMusicStyle8
|
|
Dim cmp As DXVBLibA.DirectMusicChordMap8
|
|
Dim com As DXVBLibA.DirectMusicComposer8
|
|
Dim perf As DXVBLibA.DirectMusicPerformance8
|
|
Dim seg As DXVBLibA.DirectMusicSegment8
|
|
Dim loader As DXVBLibA.DirectMusicLoader8
|
|
Dim currentstyle As DXVBLibA.DirectMusicStyle8
|
|
Dim LabelNumber As Integer
|
|
Dim runit As Boolean
|
|
|
|
Private Sub cmdAdmission_Click()
|
|
Call perf.PlaySegmentEx(currentstyle.GetMotif(currentstyle.GetMotifName(2)), DMUS_SEGF_SECONDARY Or DMUS_SEGF_BEAT, 0)
|
|
lblStuff.Caption = ChangeStuffLabel(6)
|
|
End Sub
|
|
|
|
Private Sub cmdDirections_Click()
|
|
|
|
Call perf.PlaySegmentEx(currentstyle.GetMotif(currentstyle.GetMotifName(0)), DMUS_SEGF_SECONDARY Or DMUS_SEGF_BEAT, 0)
|
|
lblStuff.Caption = ChangeStuffLabel(0)
|
|
End Sub
|
|
|
|
Private Sub cmdExit_Click()
|
|
runit = False
|
|
Unload Me
|
|
End Sub
|
|
|
|
Private Sub cmdSpecials_Click()
|
|
Call perf.PlaySegmentEx(currentstyle.GetMotif(currentstyle.GetMotifName(1)), DMUS_SEGF_SECONDARY Or DMUS_SEGF_BEAT, 0)
|
|
lblStuff.Caption = ChangeStuffLabel(LabelNumber)
|
|
End Sub
|
|
|
|
|
|
Private Function ChangeStuffLabel(Index As Integer) As String
|
|
Dim tString(9) As String
|
|
|
|
Call ClearlblStuff
|
|
|
|
'directions
|
|
tString(0) = "Corner of 4th and Stewart, next to the new stadium!"
|
|
|
|
'dinners
|
|
tString(1) = "London Broil with Hollandaise sauce, baby red potatoes, green vegetables, and Lobster Bisque soup."
|
|
tString(2) = "Grilled Mahi-Mahi on a bed of rice pilaf, green vegetables, and Ceasar salad"
|
|
tString(3) = "Chicken Cordon Bleu, steamed vegetables, wild lemon rice, and clam chowder"
|
|
tString(4) = "Bacon CheeseBurger, onion rings, and a vanilla shake"
|
|
tString(5) = "Salmon in parchment, rice pilaf, green vegetables, and lentil soup."
|
|
|
|
'Admission
|
|
tString(6) = "Age 14 - 18, $4.50, age 19 and up, $7.00"
|
|
|
|
ChangeStuffLabel = tString(Index)
|
|
|
|
End Function
|
|
|
|
Private Sub ClearlblStuff()
|
|
lblStuff.Caption = ""
|
|
End Sub
|
|
|
|
Private Sub Form_Load()
|
|
On Error GoTo err_out
|
|
Show
|
|
|
|
ClearlblStuff
|
|
|
|
InitDD hwnd, mnCan
|
|
DoEvents
|
|
initDMusic
|
|
DoEvents
|
|
|
|
|
|
runit = True
|
|
|
|
Do
|
|
MoveFrame day
|
|
DoEvents
|
|
Loop
|
|
|
|
End
|
|
err_out:
|
|
MsgBox "Could not start application!", vbApplicationModal
|
|
End
|
|
|
|
End Sub
|
|
Private Sub initDMusic()
|
|
Dim dma As DMUS_AUDIOPARAMS
|
|
|
|
On Error GoTo FailedInit
|
|
Set perf = dx.DirectMusicPerformanceCreate
|
|
Set com = dx.DirectMusicComposerCreate
|
|
Set loader = dx.DirectMusicLoaderCreate
|
|
|
|
perf.InitAudio Me.hwnd, DMUS_AUDIOF_ALL, dma, , DMUS_APATH_SHARED_STEREOPLUSREVERB, 128
|
|
perf.SetMasterAutoDownload True
|
|
|
|
'Load the objects
|
|
#If RunInIDE = 1 Then
|
|
Dim sMedia As String
|
|
|
|
sMedia = FindMediaDir("bigband.sty")
|
|
If sMedia <> vbNullString Then 'Media is not in current folder
|
|
If (Left$(sMedia, 2) <> Left$(CurDir, 2)) And (InStr(Left$(sMedia, 2), ":") > 0) Then ChDrive Left$(sMedia, 2)
|
|
ChDir sMedia
|
|
End If
|
|
|
|
Set sBigBand = loader.LoadStyle("BIGBAND.STY")
|
|
Set sJazz = loader.LoadStyle("JAZZ.STY")
|
|
Set sDisco = loader.LoadStyle("DISCO.STY")
|
|
Set sClassical = loader.LoadStyle("CLASSICAL.STY")
|
|
Set sDance = loader.LoadStyle("DANCEMIX.STY")
|
|
Set sHeartland = loader.LoadStyle("HEARTLAND.STY")
|
|
|
|
Set currentstyle = sHeartland
|
|
Set cmp = loader.LoadChordMap("CHORDMAP.CDM")
|
|
#Else
|
|
Set sBigBand = loader.LoadStyleFromResource(AddDirSep(App.Path) & App.EXEName & ".exe", "BIGBAND")
|
|
Set sJazz = loader.LoadStyleFromResource(AddDirSep(App.Path) & App.EXEName & ".exe", "JAZZ")
|
|
Set sDisco = loader.LoadStyleFromResource(AddDirSep(App.Path) & App.EXEName & ".exe", "DISCO")
|
|
Set sClassical = loader.LoadStyleFromResource(AddDirSep(App.Path) & App.EXEName & ".exe", "CLASSICAL")
|
|
Set sDance = loader.LoadStyleFromResource(AddDirSep(App.Path) & App.EXEName & ".exe", "DANCEMIX")
|
|
Set sHeartland = loader.LoadStyleFromResource(AddDirSep(App.Path) & App.EXEName & ".exe", "HEARTLAND")
|
|
|
|
Set currentstyle = sHeartland
|
|
Set cmp = loader.LoadChordMapFromResource(AddDirSep(App.Path) & App.EXEName & ".exe", "CHORDMAP")
|
|
#End If
|
|
Set seg = com.ComposeSegmentFromShape(sHeartland, 64, 0, 1, True, False, cmp)
|
|
Call perf.PlaySegmentEx(seg, 0, 0)
|
|
Exit Sub
|
|
|
|
FailedInit:
|
|
MsgBox "Could not initialize DirectMusic." & vbCrLf & "This sample will exit.", vbOKOnly Or vbInformation, "Exiting..."
|
|
Unload Me
|
|
|
|
End Sub
|
|
Private Sub ChangeMusic()
|
|
Set seg = com.ComposeSegmentFromShape(currentstyle, 64, 0, 2, False, False, cmp)
|
|
Call com.AutoTransition(perf, seg, DMUS_COMMANDT_FILL, DMUS_COMPOSEF_MEASURE, cmp)
|
|
End Sub
|
|
|
|
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
|
|
runit = False
|
|
End Sub
|
|
|
|
Private Sub Form_Unload(Cancel As Integer)
|
|
If Not (perf Is Nothing) Then perf.CloseDown
|
|
End
|
|
End Sub
|
|
|
|
Private Sub lblFriday_Click()
|
|
ClearlblStuff
|
|
Set currentstyle = sDisco
|
|
ChangeMusic
|
|
day = 2: LabelNumber = 3
|
|
lblStuff.Caption = LoadMSg(2)
|
|
End Sub
|
|
|
|
Private Sub lblFriday_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
|
|
|
|
lblName.Font = "Courier New"
|
|
lblName.ForeColor = &H8080FF
|
|
|
|
lblFriday.ForeColor = &HFF&
|
|
|
|
lblWednesday.ForeColor = &HC000&
|
|
lblThursday.ForeColor = &HC000&
|
|
lblSaturday.ForeColor = &HC000&
|
|
lblSunday.ForeColor = &HC000&
|
|
End Sub
|
|
|
|
Private Sub lblSaturday_Click()
|
|
ClearlblStuff
|
|
Set currentstyle = sDance
|
|
ChangeMusic
|
|
day = 6: LabelNumber = 4
|
|
lblStuff.Caption = LoadMSg(3)
|
|
End Sub
|
|
|
|
Private Sub lblSaturday_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
|
|
|
|
lblName.Font = "Tahoma"
|
|
lblName.ForeColor = &HC00000
|
|
|
|
lblSaturday.ForeColor = &HFF&
|
|
|
|
lblWednesday.ForeColor = &HC000&
|
|
lblThursday.ForeColor = &HC000&
|
|
lblFriday.ForeColor = &HC000&
|
|
lblSunday.ForeColor = &HC000&
|
|
End Sub
|
|
|
|
Private Sub lblSunday_Click()
|
|
ClearlblStuff
|
|
Set currentstyle = sClassical
|
|
ChangeMusic
|
|
day = 5: LabelNumber = 5
|
|
lblStuff.Caption = LoadMSg(4)
|
|
End Sub
|
|
|
|
Private Sub lblSunday_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
|
|
lblName.Font = "Garamond"
|
|
lblName.ForeColor = &HFFC0C0
|
|
|
|
lblSunday.ForeColor = &HFF&
|
|
|
|
lblWednesday.ForeColor = &HC000&
|
|
lblThursday.ForeColor = &HC000&
|
|
lblFriday.ForeColor = &HC000&
|
|
lblSaturday.ForeColor = &HC000&
|
|
End Sub
|
|
|
|
Private Sub lblThursday_Click()
|
|
ClearlblStuff
|
|
Set currentstyle = sJazz
|
|
ChangeMusic
|
|
day = 3: LabelNumber = 2
|
|
lblStuff.Caption = LoadMSg(1)
|
|
End Sub
|
|
|
|
Private Sub lblThursday_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
|
|
lblName.Font = "Comic Sans MS"
|
|
lblName.ForeColor = &H80FF80
|
|
|
|
lblThursday.ForeColor = &HFF&
|
|
|
|
lblWednesday.ForeColor = &HC000&
|
|
lblFriday.ForeColor = &HC000&
|
|
lblSaturday.ForeColor = &HC000&
|
|
lblSunday.ForeColor = &HC000&
|
|
End Sub
|
|
|
|
Private Sub lblWednesday_Click()
|
|
ClearlblStuff
|
|
Set currentstyle = sBigBand
|
|
ChangeMusic
|
|
day = 1: LabelNumber = 1
|
|
lblStuff.Caption = LoadMSg(0)
|
|
End Sub
|
|
|
|
Private Sub lblWednesday_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
|
|
lblName.Font = "Times New Roman"
|
|
lblName.ForeColor = &HFFFF&
|
|
|
|
|
|
lblWednesday.ForeColor = &HFF&
|
|
|
|
lblThursday.ForeColor = &HC000&
|
|
lblFriday.ForeColor = &HC000&
|
|
lblSaturday.ForeColor = &HC000&
|
|
lblSunday.ForeColor = &HC000&
|
|
End Sub
|
|
|