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>
347 lines
9.9 KiB
Plaintext
347 lines
9.9 KiB
Plaintext
VERSION 5.00
|
|
Begin VB.Form frmPath
|
|
BorderStyle = 3 'Fixed Dialog
|
|
Caption = "#"
|
|
ClientHeight = 4710
|
|
ClientLeft = 150
|
|
ClientTop = 1530
|
|
ClientWidth = 5955
|
|
ClipControls = 0 'False
|
|
BeginProperty Font
|
|
Name = "MS Sans Serif"
|
|
Size = 8.25
|
|
Charset = 0
|
|
Weight = 700
|
|
Underline = 0 'False
|
|
Italic = 0 'False
|
|
Strikethrough = 0 'False
|
|
EndProperty
|
|
HasDC = 0 'False
|
|
Icon = "path.frx":0000
|
|
LockControls = -1 'True
|
|
MaxButton = 0 'False
|
|
MinButton = 0 'False
|
|
NegotiateMenus = 0 'False
|
|
ScaleHeight = 4710
|
|
ScaleWidth = 5955
|
|
ShowInTaskbar = 0 'False
|
|
Begin VB.CommandButton cmdCancel
|
|
Cancel = -1 'True
|
|
Caption = "#"
|
|
BeginProperty Font
|
|
Name = "MS Sans Serif"
|
|
Size = 8.25
|
|
Charset = 0
|
|
Weight = 400
|
|
Underline = 0 'False
|
|
Italic = 0 'False
|
|
Strikethrough = 0 'False
|
|
EndProperty
|
|
Height = 420
|
|
Left = 4170
|
|
MaskColor = &H00000000&
|
|
TabIndex = 7
|
|
Top = 2640
|
|
Width = 1560
|
|
End
|
|
Begin VB.CommandButton cmdOK
|
|
Caption = "#"
|
|
Default = -1 'True
|
|
BeginProperty Font
|
|
Name = "MS Sans Serif"
|
|
Size = 8.25
|
|
Charset = 0
|
|
Weight = 400
|
|
Underline = 0 'False
|
|
Italic = 0 'False
|
|
Strikethrough = 0 'False
|
|
EndProperty
|
|
Height = 420
|
|
Left = 4170
|
|
MaskColor = &H00000000&
|
|
TabIndex = 6
|
|
Top = 1890
|
|
Width = 1560
|
|
End
|
|
Begin VB.DriveListBox drvDrives
|
|
BeginProperty Font
|
|
Name = "MS Sans Serif"
|
|
Size = 8.25
|
|
Charset = 0
|
|
Weight = 400
|
|
Underline = 0 'False
|
|
Italic = 0 'False
|
|
Strikethrough = 0 'False
|
|
EndProperty
|
|
Height = 315
|
|
Left = 216
|
|
TabIndex = 5
|
|
Top = 4140
|
|
Width = 3510
|
|
End
|
|
Begin VB.DirListBox dirDirs
|
|
BeginProperty Font
|
|
Name = "MS Sans Serif"
|
|
Size = 8.25
|
|
Charset = 0
|
|
Weight = 400
|
|
Underline = 0 'False
|
|
Italic = 0 'False
|
|
Strikethrough = 0 'False
|
|
EndProperty
|
|
Height = 1605
|
|
Left = 204
|
|
TabIndex = 3
|
|
Top = 1896
|
|
Width = 3510
|
|
End
|
|
Begin VB.TextBox txtPath
|
|
BeginProperty Font
|
|
Name = "MS Sans Serif"
|
|
Size = 8.25
|
|
Charset = 0
|
|
Weight = 400
|
|
Underline = 0 'False
|
|
Italic = 0 'False
|
|
Strikethrough = 0 'False
|
|
EndProperty
|
|
Height = 288
|
|
Left = 204
|
|
MaxLength = 240
|
|
TabIndex = 1
|
|
Top = 1056
|
|
Width = 5532
|
|
End
|
|
Begin VB.Label lblDrives
|
|
AutoSize = -1 'True
|
|
Caption = "#"
|
|
BeginProperty Font
|
|
Name = "MS Sans Serif"
|
|
Size = 8.25
|
|
Charset = 0
|
|
Weight = 400
|
|
Underline = 0 'False
|
|
Italic = 0 'False
|
|
Strikethrough = 0 'False
|
|
EndProperty
|
|
Height = 195
|
|
Left = 210
|
|
TabIndex = 4
|
|
Top = 3870
|
|
Width = 105
|
|
End
|
|
Begin VB.Label lblDirs
|
|
AutoSize = -1 'True
|
|
Caption = "#"
|
|
BeginProperty Font
|
|
Name = "MS Sans Serif"
|
|
Size = 8.25
|
|
Charset = 0
|
|
Weight = 400
|
|
Underline = 0 'False
|
|
Italic = 0 'False
|
|
Strikethrough = 0 'False
|
|
EndProperty
|
|
Height = 195
|
|
Left = 210
|
|
TabIndex = 2
|
|
Top = 1590
|
|
Width = 105
|
|
End
|
|
Begin VB.Label lblPath
|
|
AutoSize = -1 'True
|
|
Caption = "#"
|
|
BeginProperty Font
|
|
Name = "MS Sans Serif"
|
|
Size = 8.25
|
|
Charset = 0
|
|
Weight = 400
|
|
Underline = 0 'False
|
|
Italic = 0 'False
|
|
Strikethrough = 0 'False
|
|
EndProperty
|
|
Height = 195
|
|
Left = 210
|
|
TabIndex = 0
|
|
Top = 750
|
|
Width = 105
|
|
End
|
|
Begin VB.Label lblPrompt
|
|
AutoSize = -1 'True
|
|
Caption = "*"
|
|
BeginProperty Font
|
|
Name = "MS Sans Serif"
|
|
Size = 8.25
|
|
Charset = 0
|
|
Weight = 400
|
|
Underline = 0 'False
|
|
Italic = 0 'False
|
|
Strikethrough = 0 'False
|
|
EndProperty
|
|
Height = 192
|
|
Left = 204
|
|
TabIndex = 8
|
|
Top = 204
|
|
Width = 5532
|
|
WordWrap = -1 'True
|
|
End
|
|
End
|
|
Attribute VB_Name = "frmPath"
|
|
Attribute VB_GlobalNameSpace = False
|
|
Attribute VB_Creatable = False
|
|
Attribute VB_PredeclaredId = True
|
|
Attribute VB_Exposed = False
|
|
Option Explicit
|
|
|
|
Private mfMustExist As Integer
|
|
Private mfCancelExit As Integer
|
|
|
|
Private mfSinkEvents As Boolean
|
|
|
|
Private Sub cmdCancel_Click()
|
|
If mfCancelExit Then
|
|
ExitSetup Me, gintRET_EXIT
|
|
Else
|
|
gintRetVal = gintRET_CANCEL
|
|
Unload Me
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub cmdOK_Click()
|
|
Dim strPathName As String
|
|
Dim strMsg As String
|
|
Dim intRet As Integer
|
|
|
|
SetMousePtr vbHourglass
|
|
|
|
strPathName = ResolveDir(txtPath.Text, mfMustExist, True)
|
|
|
|
If Len(strPathName) > 0 Then
|
|
' Avoid Option Compare Text and use explicit UCase comparisons because there
|
|
' is a Unicode character (&H818F) which is equal to a path separator when
|
|
' using Option Compare Text.
|
|
If UCase$(strPathName) <> UCase$(gstrDestDir) Then
|
|
If Not DirExists(strPathName) Then
|
|
strMsg = ResolveResString(resDESTDIR) & vbLf & vbLf & strPathName
|
|
strMsg = strMsg & vbLf & vbLf & ResolveResString(resCREATE)
|
|
intRet = MsgFunc(strMsg, vbYesNo Or vbQuestion, gstrTitle)
|
|
If gfNoUserInput Then
|
|
ExitSetup Me, gintRET_FATAL
|
|
End If
|
|
If intRet = vbNo Then
|
|
txtPath.SetFocus
|
|
SetMousePtr vbDefault
|
|
Exit Sub
|
|
End If
|
|
End If
|
|
|
|
If Not IsValidDestDir(strPathName) Then
|
|
txtPath.SetFocus
|
|
SetMousePtr vbDefault
|
|
Exit Sub
|
|
End If
|
|
End If
|
|
|
|
frmSetup1.Tag = strPathName
|
|
gintRetVal = gintRET_CONT
|
|
Unload Me
|
|
Else
|
|
txtPath.SetFocus
|
|
End If
|
|
|
|
SetMousePtr vbDefault
|
|
End Sub
|
|
|
|
Private Sub dirDirs_Change()
|
|
If mfSinkEvents Then
|
|
mfSinkEvents = False
|
|
txtPath.Text = dirDirs.Path
|
|
drvDrives.Drive = dirDirs.Path
|
|
mfSinkEvents = True
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub drvDrives_Change()
|
|
Static strOldDrive As String
|
|
Dim strDrive As String
|
|
|
|
If mfSinkEvents Then
|
|
mfSinkEvents = False
|
|
If GetDrive(drvDrives.Drive, strDrive) Then
|
|
If CheckDrive(strDrive, Caption) Then
|
|
strOldDrive = strDrive
|
|
dirDirs.Path = strDrive
|
|
txtPath.Text = dirDirs.Path
|
|
Else
|
|
drvDrives.Drive = strOldDrive
|
|
End If
|
|
End If
|
|
mfSinkEvents = True
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub Form_Load()
|
|
Dim strDrive As String
|
|
|
|
On Error Resume Next
|
|
|
|
mfSinkEvents = False
|
|
SetMousePtr vbHourglass
|
|
|
|
SetFormFont Me
|
|
cmdOK.Caption = ResolveResString(resBTNOK)
|
|
lblDrives.Caption = ResolveResString(resLBLDRIVES)
|
|
lblDirs.Caption = ResolveResString(resLBLDIRS)
|
|
lblPath.Caption = ResolveResString(resLBLPATH)
|
|
|
|
Caption = ResolveResString(resCHANGEDIR)
|
|
lblPrompt.Caption = ResolveResString(resDESTPROMPT)
|
|
cmdCancel.Caption = ResolveResString(resBTNCANCEL)
|
|
mfCancelExit = False
|
|
dirDirs.Path = gstrDestDir
|
|
If Err.Number <> 0 Then
|
|
'Next try root of destination drive
|
|
If GetDrive(gstrDestDir, strDrive) Then
|
|
Err.Clear
|
|
dirDirs.Path = strDrive
|
|
End If
|
|
End If
|
|
If Err.Number <> 0 Then
|
|
If GetDrive(App.Path, strDrive) Then
|
|
dirDirs.Path = strDrive
|
|
End If
|
|
End If
|
|
|
|
GetDrive dirDirs.Path, strDrive
|
|
drvDrives.Drive = strDrive
|
|
|
|
mfSinkEvents = True
|
|
|
|
'Init txtPath.Text to gstrDestDir even if this
|
|
' directory does not (yet) exist.
|
|
txtPath.Text = gstrDestDir
|
|
mfMustExist = False
|
|
|
|
SetMousePtr vbDefault
|
|
|
|
CenterForm Me
|
|
|
|
'Highlight all of txtPath's text so that typing immediately overwrites it
|
|
txtPath.SelStart = 0
|
|
txtPath.SelLength = Len(txtPath.Text)
|
|
|
|
Err.Clear
|
|
End Sub
|
|
|
|
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
|
|
If UnloadMode <> vbFormCode Then
|
|
If mfCancelExit Then
|
|
ExitSetup Me, gintRET_EXIT
|
|
Cancel = True
|
|
Else
|
|
gintRetVal = gintRET_CANCEL
|
|
Unload Me
|
|
End If
|
|
End If
|
|
End Sub
|