RiskYourLife/Client
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Initial commit: ROW Client source code

Browse Source 
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>
This commit is contained in:
tindevil
2025-11-29 16:24:34 +09:00
commit e067522598
5135 changed files with 1745744 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

587
Library/dxx8/samples/Multimedia/VBSamples/Demos/ClubMet/basDD.bas Normal file
View File

@@ -0,0 +1,587 @@
Attribute VB_Name = "basDD"
Option Explicit
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' Copyright (C) 1999-2001 Microsoft Corporation. All Rights Reserved.
'
' File: basDD.bas
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As DxVBLib.RECT) As Long
'******
'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 DxVBLib.DirectX7
Private DD As DxVBLib.DirectDraw7
Private DDS As DxVBLib.DirectDrawSurface7
Private dC As DxVBLib.DirectDrawClipper
Private DDSD As DxVBLib.DDSURFACEDESC2
Private DR As DxVBLib.RECT
Private bB As DxVBLib.DirectDrawSurface7
Private BD As DxVBLib.DDSURFACEDESC2
Private BBR As DxVBLib.RECT
Private ar() As Byte
Private AlphaRect As DxVBLib.RECT
Private lPixelDepth As Byte
Private clr As Long
Private cols As Long
Private rows As Long
Private col As Long
Private row As Long
Private Sprites(9) As DxVBLib.DirectDrawSurface7
Private SpriteD(9) As DxVBLib.DDSURFACEDESC2
Private SpriteR(9) As DxVBLib.RECT
Private key(9) As DDCOLORKEY
Private spriteWidth As Integer
Private spriteHeight As Integer
Private currentframe As Integer
Private slide(39) As DxVBLib.RECT
Private Pal(255) As DxVBLib.PALETTEENTRY
Private Palette As DxVBLib.DirectDrawPalette
Private Fish(2) As DxVBLib.DirectDrawSurface7
Private fishD(2) As DxVBLib.DDSURFACEDESC2
Private fishR(2) As DxVBLib.RECT
Private fishkey(2) As DxVBLib.DDCOLORKEY
Private sMSG As String
Private x%, y%
Private tmpR As DxVBLib.RECT
Private Type fis
sR As DxVBLib.RECT
x As Long
y As Single
End Type
Private fi(2) As fis
'Registry constants
Private Const KEY_READ = 131097
Private Const REG_SZ = 1
Private Const HKEY_LOCAL_MACHINE = &H80000002
'Registry API's
Private Declare Function RegConnectRegistry Lib "advapi32.dll" Alias "RegConnectRegistryA" (ByVal lpMachineName As String, ByVal hKey As Long, phkResult As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
'Sleep
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Sub InitDD(hwnd As Long, ClipperHwnd As PictureBox)
Dim oPixelFormat As DDPIXELFORMAT
On Local Error GoTo err_
Set DD = dx.DirectDrawCreate(vbNullString)
DD.SetCooperativeLevel hwnd, DDSCL_NORMAL
DDSD.lFlags = DDSD_CAPS
DDSD.ddsCaps.lCaps = DDSCAPS_PRIMARYSURFACE
Set DDS = DD.CreateSurface(DDSD)
Set dC = DD.CreateClipper(0)
dC.SetHWnd ClipperHwnd.hwnd
DDS.SetClipper dC
DDS.GetPixelFormat oPixelFormat
If oPixelFormat.lRGBBitCount < 8 Then
If Not (DD Is Nothing) Then
DD.SetCooperativeLevel frmMain.hwnd, DDSCL_NORMAL
DoEvents
End If
MsgBox "Must run at 16bit color or higher.", vbApplicationModal
End
Else
lPixelDepth = oPixelFormat.lRGBBitCount
End If
BD.lFlags = DDSD_HEIGHT Or DDSD_WIDTH Or DDSD_CAPS
BD.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
BD.lWidth = ClipperHwnd.ScaleWidth
BD.lHeight = ClipperHwnd.ScaleHeight
Set bB = DD.CreateSurface(BD)
BBR.bottom = ClipperHwnd.Height
BBR.Right = ClipperHwnd.Width
loadSprites
AlphaRect.Right = BD.lWidth - 1
AlphaRect.bottom = BD.lHeight - 1
Exit Sub
err_:
If Not (DD Is Nothing) Then
DD.SetCooperativeLevel frmMain.hwnd, DDSCL_NORMAL
DoEvents
End If
MsgBox "Unable to initalize DirectDraw.", vbApplicationModal
End
End Sub
Private Sub loadSprites()
'0
SpriteD(0).lFlags = DDSD_CAPS
SpriteD(0).ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
#If RunInIDE = 1 Then
'ide
Dim sMedia As String
sMedia = FindMediaDir("base.bmp")
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 Sprites(0) = DD.CreateSurfaceFromFile("base.bmp", SpriteD(0))
#Else
'exe
Set Sprites(0) = DD.CreateSurfaceFromResource(AddDirSep(App.Path) & App.EXEName & ".exe", "BASE", SpriteD(0))
#End If
SpriteR(0).Right = SpriteD(0).lWidth
SpriteR(0).bottom = SpriteD(0).lHeight
'1
SpriteD(1).lFlags = DDSD_CAPS
SpriteD(1).ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
#If RunInIDE = 1 Then
'ide
Set Sprites(1) = DD.CreateSurfaceFromFile("sax.bmp", SpriteD(1))
#Else
'exe
Set Sprites(1) = DD.CreateSurfaceFromResource(AddDirSep(App.Path) & App.EXEName & ".exe", "sax", SpriteD(1))
#End If
SpriteR(1).Right = SpriteD(1).lWidth
SpriteR(1).bottom = SpriteD(1).lHeight
'notes
SpriteD(6).lFlags = DDSD_CAPS Or DDSD_HEIGHT Or DDSD_WIDTH
SpriteD(6).ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
SpriteD(6).lWidth = 64: SpriteD(6).lHeight = 64
#If RunInIDE = 1 Then
'ide
Set Sprites(6) = DD.CreateSurfaceFromFile("notes.bmp", SpriteD(6))
#Else
'exe
Set Sprites(6) = DD.CreateSurfaceFromResource(AddDirSep(App.Path) & App.EXEName & ".exe", "NOTES", SpriteD(6))
#End If
SpriteR(6).Right = SpriteD(6).lWidth
SpriteR(6).bottom = SpriteD(6).lHeight
key(6).low = 0
key(6).high = 0
Sprites(6).SetColorKey DDCKEY_SRCBLT, key(6)
'2
SpriteD(2).lFlags = DDSD_CAPS
SpriteD(2).ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
#If RunInIDE = 1 Then
'ide
Set Sprites(2) = DD.CreateSurfaceFromFile("keys.bmp", SpriteD(2))
#Else
Set Sprites(2) = DD.CreateSurfaceFromResource(AddDirSep(App.Path) & App.EXEName & ".exe", "KEYS", SpriteD(2))
#End If
SpriteR(2).Right = SpriteD(2).lWidth
SpriteR(2).bottom = SpriteD(2).lHeight
''''''''''''''''''''''''''''''''''''''''''
'loadFish
''''''''''''''''''''''''''''''''''''''''''
fishD(0).lFlags = DDSD_CAPS Or DDSD_HEIGHT Or DDSD_WIDTH
fishD(0).ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
fishD(0).lWidth = 64: fishD(0).lHeight = 64
fishD(1).lFlags = DDSD_CAPS Or DDSD_HEIGHT Or DDSD_WIDTH
fishD(1).ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
fishD(1).lWidth = 64: fishD(1).lHeight = 64
fishD(2).lFlags = DDSD_CAPS Or DDSD_HEIGHT Or DDSD_WIDTH
fishD(2).ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
fishD(2).lWidth = 64: fishD(2).lHeight = 64
#If RunInIDE = 1 Then
'ide
Set Fish(0) = DD.CreateSurfaceFromFile("f1.bmp", fishD(0))
Set Fish(1) = DD.CreateSurfaceFromFile("f2.bmp", fishD(1))
Set Fish(2) = DD.CreateSurfaceFromFile("f3.bmp", fishD(2))
#Else
'exe
Set Fish(0) = DD.CreateSurfaceFromResource(AddDirSep(App.Path) & App.EXEName & ".exe", "F1", fishD(0))
Set Fish(1) = DD.CreateSurfaceFromResource(AddDirSep(App.Path) & App.EXEName & ".exe", "F2", fishD(1))
Set Fish(2) = DD.CreateSurfaceFromResource(AddDirSep(App.Path) & App.EXEName & ".exe", "F3", fishD(2))
#End If
Dim i As Integer
For i = 0 To UBound(Fish)
fishR(i).Right = fishD(i).lWidth
fishR(i).bottom = fishD(i).lHeight
fishkey(i).low = 0
fishkey(i).high = 0
Fish(i).SetColorKey DDCKEY_SRCBLT, fishkey(i)
Next i
'sprite(5) animated hand
SpriteD(5).lFlags = DDSD_CAPS
SpriteD(5).ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
#If RunInIDE = 1 Then
'ide
Set Sprites(5) = DD.CreateSurfaceFromFile("handani.bmp", SpriteD(5))
#Else
'exe
Set Sprites(5) = DD.CreateSurfaceFromResource(AddDirSep(App.Path) & App.EXEName & ".exe", "handani", SpriteD(5))
#End If
SpriteR(5).Right = SpriteD(5).lWidth
SpriteR(5).bottom = SpriteD(5).lHeight
spriteWidth = 272
spriteHeight = 177
cols = SpriteD(5).lWidth / spriteWidth
rows = SpriteD(5).lHeight / spriteHeight
key(5).low = 0
key(5).high = 0
Sprites(5).SetColorKey DDCKEY_SRCBLT, key(5)
'9
SpriteD(9).lFlags = DDSD_CAPS
SpriteD(9).ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
#If RunInIDE = 1 Then
'ide
Set Sprites(9) = DD.CreateSurfaceFromFile("bknote.bmp", SpriteD(9))
#Else
'exe
Set Sprites(9) = DD.CreateSurfaceFromResource(AddDirSep(App.Path) & App.EXEName & ".exe", "bknote", SpriteD(9))
#End If
SpriteR(9).Right = SpriteD(9).lWidth
SpriteR(9).bottom = SpriteD(9).lHeight
StripVert slide(), SpriteR(9).Right, SpriteR(9).bottom
'8
SpriteD(8).lFlags = DDSD_CAPS
SpriteD(8).ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
#If RunInIDE = 1 Then
'ide
Set Sprites(8) = DD.CreateSurfaceFromFile("dance.bmp", SpriteD(8))
#Else
'exe
Set Sprites(8) = DD.CreateSurfaceFromResource(AddDirSep(App.Path) & App.EXEName & ".exe", "dance", SpriteD(8))
#End If
SpriteR(8).Right = SpriteD(8).lWidth
SpriteR(8).bottom = SpriteD(8).lHeight
End Sub
Public Sub MoveFrame(Index As Integer)
On Local Error GoTo err_
Select Case Index
Case 0
bB.Blt BBR, Sprites(Index), SpriteR(Index), DDBLT_WAIT
bB.Lock AlphaRect, BD, DDLOCK_WAIT, 0
bB.GetLockedArray ar()
DoEvents
clr = Rnd * 255
For y = 0 To (AlphaRect.bottom - 1)
For x = 0 To (AlphaRect.Right - 1) * 2
If ar(x, y) <> 0 And ar(x, y) <> 64 And ar(x, y) <> 255 And ar(x, y) <> 127 Then
If ar(x, y) = 224 Then
ar(x, y) = clr
End If
End If
Next
DoEvents
Next
DoEvents
bB.Unlock AlphaRect
GetWindowRect frmMain.mnCan.hwnd, DR
DDS.Blt DR, bB, BBR, DDBLT_WAIT
Case 1
tmpR.Top = Rnd * 200
tmpR.Left = Rnd * 50
bB.Blt BBR, Sprites(Index), SpriteR(Index), DDBLT_WAIT
bB.BltFast tmpR.Left, tmpR.Top, Sprites(6), SpriteR(6), DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY
GetWindowRect frmMain.mnCan.hwnd, DR
DDS.Blt DR, bB, BBR, DDBLT_WAIT
Sleep 50
Case 2
On Error Resume Next
Dim nColor As Integer, tmp As Integer
bB.Blt BBR, Sprites(Index), SpriteR(Index), DDBLT_WAIT
GetWindowRect frmMain.mnCan.hwnd, DR
bB.Lock AlphaRect, BD, DDLOCK_WAIT, 0
bB.GetLockedArray ar()
DoEvents
nColor = Rnd * 256
If nColor = 0 Then nColor = 1
For y = 0 To (AlphaRect.bottom - 1)
For x = 0 To (AlphaRect.Right - 1) * (lPixelDepth \ 8)
If ar(x, y) <> 0 And ar(x, y) <> 124 Then
ar(x, y) = nColor
End If
Next
DoEvents
Next
DoEvents
bB.Unlock AlphaRect
DDS.Blt DR, bB, BBR, DDBLT_WAIT
On Error GoTo 0
Case 3
With fi(0)
.x = .x + 1: If .x > frmMain.mnCan.ScaleWidth Then .x = 0
.y = Sin(.x / 5) * 5 + (frmMain.mnCan.ScaleHeight \ 2)
End With
With fi(1)
.x = .x + 2: If .x > frmMain.mnCan.ScaleWidth Then .x = 0
.y = Sin(.x / 20) * 20 + (frmMain.mnCan.ScaleHeight \ 4)
End With
With fi(2)
.x = .x - 2: If .x < frmMain.mnCan.ScaleLeft Then .x = frmMain.mnCan.ScaleWidth
.y = Sin(.x / 40) * 40 + (frmMain.mnCan.ScaleHeight \ 3)
End With
Dim i As Integer
bB.BltColorFill BBR, &H0
For i = 0 To UBound(fi)
bB.BltFast fi(i).x, fi(i).y, Fish(i), fishR(i), DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY
Next i
GetWindowRect frmMain.mnCan.hwnd, DR
DDS.Blt DR, bB, BBR, DDBLT_WAIT
Sleep 50
Case 5
Dim rSprite As DxVBLib.RECT
currentframe = currentframe + 1
If currentframe > rows * cols - 1 Then currentframe = 0
col = currentframe Mod cols
row = Int(currentframe / cols)
rSprite.Left = col * spriteWidth
rSprite.Top = row * spriteHeight
rSprite.Right = rSprite.Left + spriteWidth
rSprite.bottom = rSprite.Top + spriteHeight
bB.BltColorFill BBR, &H0
Set bB = MoveBackRight(bB, Sprites(9), slide)
DoEvents
bB.BltFast 0, frmMain.mnCan.ScaleHeight \ 3, Sprites(Index), rSprite, DDBLTFAST_SRCCOLORKEY Or DDBLTFAST_WAIT
GetWindowRect frmMain.mnCan.hwnd, DR
DDS.Blt DR, bB, BBR, DDBLT_WAIT
Sleep 80
Case 6
bB.Blt BBR, Sprites(8), SpriteR(8), DDBLT_WAIT
bB.Lock AlphaRect, BD, DDLOCK_WAIT, 0
bB.GetLockedArray ar()
DoEvents
For y = 0 To (AlphaRect.bottom - 1)
For x = 0 To (AlphaRect.Right - 1) * 2
If ar(x, y) <> 0 And ar(x, y) <> 255 Then
ar(x, y) = Rnd * 255
End If
Next
DoEvents
Next
DoEvents
bB.Unlock AlphaRect
DDS.Blt DR, bB, BBR, DDBLT_WAIT
GetWindowRect frmMain.mnCan.hwnd, DR
DDS.Blt DR, bB, BBR, DDBLT_WAIT
' Sleep 20
End Select
Exit Sub
err_:
If Not (DD Is Nothing) Then
DD.SetCooperativeLevel frmMain.hwnd, DDSCL_NORMAL
DoEvents
End If
MsgBox "There was an issue with playing the current frame." & vbCrLf & _
Err.Number & vbCrLf & _
Err.Description, vbApplicationModal
End
End Sub
Public Sub StripVert(cChop() As DxVBLib.RECT, wD As Long, hD As Long)
Dim cntr As Integer
Dim nN As Long
Dim sZ As Long
For cntr = 0 To UBound(cChop)
sZ = wD / UBound(cChop)
nN = nN + sZ
cChop(cntr).Left = (nN - sZ)
cChop(cntr).Right = nN
cChop(cntr).bottom = hD
Next
'StripVert = cChop
End Sub
Public Function MoveBackRight(ByVal bB As DirectDrawSurface7, ByVal backgrounds As DirectDrawSurface7, recArray() As DxVBLib.RECT) As DirectDrawSurface7
Dim tmpC As Integer
Dim stp As Integer
Static cntrFR As Integer
For tmpC = 0 To UBound(recArray)
If cntrFR >= (UBound(recArray) - 1) Then
cntrFR = 0
End If
bB.BltFast recArray(cntrFR).Left, (frmMain.mnCan.ScaleHeight \ 3), backgrounds, recArray(tmpC), DDBLTFAST_WAIT
cntrFR = cntrFR + 1
DoEvents
Next
Set MoveBackRight = bB
DoEvents
End Function
Public Function LoadMSg(Index As Integer) As String
Dim tempMSG(7) As String
'wed
tempMSG(0) = "Big Band!" & vbCrLf & _
"Join us for a blast from the past! Enjoy cutting the rug " & vbCrLf & _
"with the finest big band musicians from the area. Whether " & vbCrLf & _
"you want to swing dance the night away, or just listen to " & vbCrLf & _
"the big sound from the stage, you're sure to have a great time." & vbCrLf & _
"Just don't forget the zoot suit at home!"
'thur
tempMSG(1) = "Jazz Night!" & vbCrLf & _
"Thursdays are a big night at Club Met, because our jazz music" & vbCrLf & _
"is always cool and fresh. The musicians that join us are always" & vbCrLf & _
"Grade A, including local band Benny HaHa and the Blue Wave." & vbCrLf & _
"Jazz has never been better!"
'fri
tempMSG(2) = "Disco!" & vbCrLf & _
"If the 70's are making a comeback, you'll find Friday Night at Club Met" & vbCrLf & _
"to be the headquarters. Always a blast, we bring in some of the original" & vbCrLf & _
"disco artists to play their most popular numbers. It's even more fun to" & vbCrLf & _
"come dressed to the part. Come once and it's sure to be your Friday Night" & vbCrLf & _
"hang out!"
'sat
tempMSG(3) = "Dance Night!" & vbCrLf & _
"A definite favorite of Generation X (and Y) is Dance night at Club Met." & vbCrLf & _
"Our own DJ, Flavor Mike, spins the latest dance hits all night long." & vbCrLf & _
"Once you start dancing, you can't slow down. Plenty of new people to " & vbCrLf & _
"meet, and always a good time."
'sun
tempMSG(4) = "Classical!" & vbCrLf & _
"If your tastes are more refined, we encourage you to join us on Sunday" & vbCrLf & _
"night at Club Met. You'll enjoy intellectual conversation and delightful" & vbCrLf & _
"music from the Baroque, Classical, and Romantic eras, played by renowned" & vbCrLf & _
"local artists. A great way to energize yourself for the week ahead."
LoadMSg = tempMSG(Index)
End Function