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>
This commit is contained in:
@@ -0,0 +1,338 @@
|
||||
VERSION 5.00
|
||||
Object = "{1F6AF2BA-798F-4586-8F76-CD0DB05515D9}#1.0#0"; "vb_SubClass.OCX"
|
||||
Begin VB.Form frmCanvas
|
||||
AutoRedraw = -1 'True
|
||||
BackColor = &H80000005&
|
||||
Caption = "Visual Basic Scrawl Sample"
|
||||
ClientHeight = 6150
|
||||
ClientLeft = 165
|
||||
ClientTop = 450
|
||||
ClientWidth = 9990
|
||||
Icon = "frmCanvas.frx":0000
|
||||
LinkTopic = "Form1"
|
||||
ScaleHeight = 410
|
||||
ScaleMode = 3 'Pixel
|
||||
ScaleWidth = 666
|
||||
StartUpPosition = 2 'CenterScreen
|
||||
Begin vbSubClass.SubClasser subClass
|
||||
Left = 9360
|
||||
Top = 60
|
||||
_ExtentX = 900
|
||||
_ExtentY = 873
|
||||
End
|
||||
Begin VB.Image imgPencil
|
||||
Appearance = 0 'Flat
|
||||
Height = 480
|
||||
Left = 0
|
||||
Picture = "frmCanvas.frx":0442
|
||||
Top = 0
|
||||
Width = 480
|
||||
End
|
||||
Begin VB.Menu mnuContext
|
||||
Caption = "none"
|
||||
Visible = 0 'False
|
||||
Begin VB.Menu mnuAbout
|
||||
Caption = "About..."
|
||||
End
|
||||
Begin VB.Menu Sep1
|
||||
Caption = "-"
|
||||
End
|
||||
Begin VB.Menu mnuSpeed1
|
||||
Caption = "Speed 1"
|
||||
End
|
||||
Begin VB.Menu mnuSpeed2
|
||||
Caption = "Speed 2"
|
||||
End
|
||||
Begin VB.Menu mnuSpeed3
|
||||
Caption = "Speed 3"
|
||||
End
|
||||
Begin VB.Menu Sep2
|
||||
Caption = "-"
|
||||
End
|
||||
Begin VB.Menu mnuClear
|
||||
Caption = "Clear"
|
||||
End
|
||||
Begin VB.Menu Sep3
|
||||
Caption = "-"
|
||||
End
|
||||
Begin VB.Menu mnuSuspend
|
||||
Caption = "Release Mouse"
|
||||
End
|
||||
End
|
||||
End
|
||||
Attribute VB_Name = "frmCanvas"
|
||||
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: frmCanvas.frm
|
||||
' Content: This Form holds the DirectInput callback for mouse messages
|
||||
'
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
|
||||
Option Explicit
|
||||
Implements DirectXEvent8
|
||||
|
||||
Private Sub DirectXEvent8_DXCallback(ByVal eventid As Long)
|
||||
|
||||
' This is where we respond to any change in mouse state. Usually this will be an axis movement
|
||||
' or button press or release, but it could also mean we've lost acquisition.
|
||||
' Note: no event is signalled if we voluntarily Unacquire. Normally loss of acquisition will
|
||||
' mean that the app window has lost the focus.
|
||||
|
||||
Dim diDeviceData(1 To BufferSize) As DIDEVICEOBJECTDATA
|
||||
Dim NumItems As Integer
|
||||
Dim i As Integer
|
||||
Static OldSequence As Long
|
||||
|
||||
' Get data
|
||||
On Error GoTo INPUTLOST
|
||||
NumItems = objDIDev.GetDeviceData(diDeviceData, 0)
|
||||
On Error GoTo 0
|
||||
|
||||
' Process data
|
||||
For i = 1 To NumItems
|
||||
Select Case diDeviceData(i).lOfs
|
||||
Case DIMOFS_X
|
||||
g_cursorx = g_cursorx + diDeviceData(i).lData * g_Sensitivity
|
||||
|
||||
' We don't want to update the cursor or draw a line is response to
|
||||
' separate axis movements, or we will get a staircase instead of diagonal lines.
|
||||
' A diagonal movement of the mouse results in two events with the same sequence number.
|
||||
' In order to avoid postponing the last event till the mouse moves again, we always
|
||||
' reset OldSequence after it's been tested once.
|
||||
|
||||
If OldSequence <> diDeviceData(i).lSequence Then
|
||||
UpdateCursor
|
||||
OldSequence = diDeviceData(i).lSequence
|
||||
Else
|
||||
OldSequence = 0
|
||||
End If
|
||||
|
||||
Case DIMOFS_Y
|
||||
g_cursory = g_cursory + diDeviceData(i).lData * g_Sensitivity
|
||||
If OldSequence <> diDeviceData(i).lSequence Then
|
||||
UpdateCursor
|
||||
OldSequence = diDeviceData(i).lSequence
|
||||
Else
|
||||
OldSequence = 0
|
||||
End If
|
||||
|
||||
Case DIMOFS_BUTTON0
|
||||
If diDeviceData(i).lData And &H80 Then
|
||||
Drawing = True
|
||||
|
||||
' Keep record for Line function
|
||||
CurrentX = g_cursorx
|
||||
CurrentY = g_cursory
|
||||
|
||||
' Draw a point in case button-up follows immediately
|
||||
PSet (g_cursorx, g_cursory)
|
||||
Else
|
||||
Drawing = False
|
||||
End If
|
||||
|
||||
Case DIMOFS_BUTTON1
|
||||
If diDeviceData(i).lData = 0 Then ' button up
|
||||
Popup
|
||||
End If
|
||||
|
||||
End Select
|
||||
Next i
|
||||
Exit Sub
|
||||
|
||||
INPUTLOST:
|
||||
' Windows stole the mouse from us. DIERR_INPUTLOST is raised if the user switched to
|
||||
' another app, but DIERR_NOTACQUIRED is raised if the Windows key was pressed.
|
||||
If (Err.Number = DIERR_INPUTLOST) Or (Err.Number = DIERR_NOTACQUIRED) Then
|
||||
SetSystemCursor
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
|
||||
|
||||
Select Case KeyCode
|
||||
Case 93 ' AppMenu key
|
||||
Popup
|
||||
|
||||
End Select
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub Form_Load()
|
||||
subClass.Hook Me.hWnd
|
||||
End Sub
|
||||
|
||||
Private Sub Form_Unload(Cancel As Integer)
|
||||
|
||||
' Restore the default window procedure
|
||||
subClass.UnHook
|
||||
If EventHandle <> 0 Then objDX.DestroyEvent EventHandle
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
|
||||
|
||||
Dim didevstate As DIMOUSESTATE
|
||||
|
||||
' We want to force acquisition of the mouse whenever the context menu is closed,
|
||||
' whenever we switch back to the application, or in any other circumstance where
|
||||
' Windows is finished with the cursor. If a MouseMove event happens,
|
||||
' we know the cursor is in our app window and Windows is generating mouse messages, therefore
|
||||
' it's time to reacquire.
|
||||
|
||||
' Note: this event is triggered whenever the window gets the mouse, even when there's no mouse
|
||||
' activity -- for example, when we have just Alt+Tabbed back, or cancelled out of the context
|
||||
' menu with the Esc key.
|
||||
|
||||
If Suspended Then Exit Sub ' Allow continued use of Windows cursor
|
||||
|
||||
' This event gets called again after we acquire the mouse. In order to prevent the cursor
|
||||
' position being set to the middle of the window, we check to see if we've already acquired,
|
||||
' and if so, we don't reposition our private cursor. The only way to find out if the mouse
|
||||
' is acquired is to try to retrieve data.
|
||||
|
||||
On Error GoTo NOTYETACQUIRED
|
||||
Call objDIDev.GetDeviceStateMouse(didevstate)
|
||||
On Error GoTo 0
|
||||
Exit Sub
|
||||
|
||||
NOTYETACQUIRED:
|
||||
Call AcquireMouse
|
||||
End Sub
|
||||
|
||||
Sub AcquireMouse()
|
||||
|
||||
Dim CursorPoint As POINTAPI
|
||||
|
||||
' Move private cursor to system cursor.
|
||||
Call GetCursorPos(CursorPoint) ' Get position before Windows loses cursor
|
||||
Call ScreenToClient(hWnd, CursorPoint)
|
||||
|
||||
On Error GoTo CANNOTACQUIRE
|
||||
objDIDev.Acquire
|
||||
g_cursorx = CursorPoint.x
|
||||
g_cursory = CursorPoint.y
|
||||
|
||||
UpdateCursor
|
||||
frmCanvas.imgPencil.Visible = True
|
||||
On Error GoTo 0
|
||||
Exit Sub
|
||||
|
||||
CANNOTACQUIRE:
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
|
||||
|
||||
' Allows user to resume by clicking on the canvas.
|
||||
If Button = 1 Then Suspended = False
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub mnuAbout_Click()
|
||||
|
||||
Call frmAbout.Show(vbModal, Me)
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub mnuClear_Click()
|
||||
|
||||
Cls
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
Private Sub mnuSpeed1_Click()
|
||||
|
||||
g_Sensitivity = 1
|
||||
mnuSpeed1.Checked = True
|
||||
mnuSpeed2.Checked = False
|
||||
mnuSpeed3.Checked = False
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub mnuSpeed2_Click()
|
||||
|
||||
g_Sensitivity = 2
|
||||
mnuSpeed2.Checked = True
|
||||
mnuSpeed1.Checked = False
|
||||
mnuSpeed3.Checked = False
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub mnuSpeed3_Click()
|
||||
|
||||
g_Sensitivity = 3
|
||||
mnuSpeed3.Checked = True
|
||||
mnuSpeed1.Checked = False
|
||||
mnuSpeed2.Checked = False
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub mnuSuspend_Click()
|
||||
|
||||
Suspended = Not Suspended
|
||||
imgPencil.Visible = Not Suspended
|
||||
|
||||
End Sub
|
||||
|
||||
Public Sub UpdateCursor()
|
||||
|
||||
' Update the position of our private cursor
|
||||
If g_cursorx < 0 Then g_cursorx = 0
|
||||
If g_cursorx >= frmCanvas.ScaleWidth Then g_cursorx = frmCanvas.ScaleWidth - 1
|
||||
If g_cursory < 0 Then g_cursory = 0
|
||||
If g_cursory >= frmCanvas.ScaleHeight Then g_cursory = frmCanvas.ScaleHeight - 1
|
||||
frmCanvas.imgPencil.Left = g_cursorx
|
||||
frmCanvas.imgPencil.Top = g_cursory
|
||||
If Drawing Then
|
||||
Line -(g_cursorx, g_cursory)
|
||||
End If
|
||||
|
||||
End Sub
|
||||
|
||||
Public Sub Popup()
|
||||
|
||||
objDIDev.Unacquire
|
||||
SetSystemCursor
|
||||
Call PopupMenu(mnuContext)
|
||||
|
||||
End Sub
|
||||
|
||||
Public Sub SetSystemCursor()
|
||||
|
||||
' Get the system cursor into the same position as the private cursor,
|
||||
' and stop drawing
|
||||
|
||||
Dim point As POINTAPI
|
||||
|
||||
imgPencil.Visible = False
|
||||
Drawing = False
|
||||
point.x = g_cursorx
|
||||
point.y = g_cursory
|
||||
Call ClientToScreen(hWnd, point)
|
||||
Call SetCursorPos(point.x, point.y)
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub subClass_WindowsMessage(ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long)
|
||||
' This procedure intercepts Windows messages and looks for any that might encourage us
|
||||
' to Unacquire the mouse.
|
||||
|
||||
If (uMsg = WM_ENTERMENULOOP) And (Not Suspended) Then
|
||||
objDIDev.Unacquire
|
||||
SetSystemCursor
|
||||
End If
|
||||
|
||||
End Sub
|
||||
Reference in New Issue
Block a user