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>
254 lines
8.9 KiB
Plaintext
254 lines
8.9 KiB
Plaintext
VERSION 5.00
|
|
Begin VB.Form frmWhiteBoard
|
|
Caption = "Whiteboard"
|
|
ClientHeight = 7200
|
|
ClientLeft = 60
|
|
ClientTop = 345
|
|
ClientWidth = 9600
|
|
Icon = "frmWhiteBoard.frx":0000
|
|
LinkTopic = "Form1"
|
|
ScaleHeight = 7200
|
|
ScaleWidth = 9600
|
|
StartUpPosition = 3 'Windows Default
|
|
Begin VB.PictureBox picDraw
|
|
AutoRedraw = -1 'True
|
|
BackColor = &H00FFFFFF&
|
|
Height = 7155
|
|
Left = 0
|
|
ScaleHeight = 7095
|
|
ScaleWidth = 9495
|
|
TabIndex = 0
|
|
Top = 0
|
|
Width = 9555
|
|
End
|
|
Begin VB.Menu Pop
|
|
Caption = "mnuPop"
|
|
Visible = 0 'False
|
|
Begin VB.Menu mnuRed
|
|
Caption = "Draw with Red"
|
|
End
|
|
Begin VB.Menu mnuBlue
|
|
Caption = "Draw with Blue"
|
|
End
|
|
Begin VB.Menu mnuGreen
|
|
Caption = "Draw with Green"
|
|
End
|
|
Begin VB.Menu mnuGrey
|
|
Caption = "Draw with Grey"
|
|
End
|
|
Begin VB.Menu mnuPurp
|
|
Caption = "Draw with Purple"
|
|
End
|
|
Begin VB.Menu mnuYellow
|
|
Caption = "Draw with Yellow"
|
|
End
|
|
Begin VB.Menu mnuSep
|
|
Caption = "-"
|
|
End
|
|
Begin VB.Menu mnuClear
|
|
Caption = "Clear Board"
|
|
End
|
|
End
|
|
End
|
|
Attribute VB_Name = "frmWhiteBoard"
|
|
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: frmWhiteBoard.frm
|
|
'
|
|
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
|
Implements DirectPlay8Event
|
|
Private mlColor As Long
|
|
Private mlLastX As Single: Private mlLastY As Single
|
|
|
|
Private Sub Form_Resize()
|
|
picDraw.Move 0, 0, Me.Width, Me.Height
|
|
End Sub
|
|
|
|
Private Sub mnuBlue_Click()
|
|
mlColor = RGB(0, 0, 255)
|
|
End Sub
|
|
|
|
Private Sub mnuClear_Click()
|
|
Dim lMsg As Long, lOffset As Long
|
|
Dim oBuf() As Byte
|
|
picDraw.Cls
|
|
'Send the clear msg
|
|
lOffset = NewBuffer(oBuf)
|
|
lMsg = MsgClearWhiteBoard
|
|
AddDataToBuffer oBuf, lMsg, LenB(lMsg), lOffset
|
|
dpp.SendTo DPNID_ALL_PLAYERS_GROUP, oBuf, 0, DPNSEND_NOLOOPBACK
|
|
End Sub
|
|
|
|
Private Sub mnuGreen_Click()
|
|
mlColor = RGB(0, 255, 0)
|
|
End Sub
|
|
|
|
Private Sub mnuGrey_Click()
|
|
mlColor = RGB(128, 128, 128)
|
|
End Sub
|
|
|
|
Private Sub mnuPurp_Click()
|
|
mlColor = RGB(156, 56, 167)
|
|
End Sub
|
|
|
|
Private Sub mnuRed_Click()
|
|
mlColor = RGB(255, 0, 0)
|
|
End Sub
|
|
|
|
Private Sub mnuYellow_Click()
|
|
mlColor = RGB(255, 255, 0)
|
|
End Sub
|
|
|
|
Private Sub picDraw_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
|
|
Dim lMsg As Long, lOffset As Long
|
|
Dim oBuf() As Byte
|
|
If Button = vbLeftButton Then 'We are drawing
|
|
If mlColor = 0 Then mlColor = RGB(255, 0, 0)
|
|
'First draw the dot
|
|
picDraw.PSet (X, Y), mlColor
|
|
'Now tell everyone about it
|
|
|
|
'Now let's send a message to draw this dot
|
|
lOffset = NewBuffer(oBuf)
|
|
lMsg = MsgSendDrawPixel
|
|
AddDataToBuffer oBuf, lMsg, LenB(lMsg), lOffset
|
|
AddDataToBuffer oBuf, mlColor, LenB(mlColor), lOffset
|
|
AddDataToBuffer oBuf, X, SIZE_SINGLE, lOffset
|
|
AddDataToBuffer oBuf, Y, SIZE_SINGLE, lOffset
|
|
dpp.SendTo DPNID_ALL_PLAYERS_GROUP, oBuf, 0, DPNSEND_NOLOOPBACK
|
|
'Now store the last x/y
|
|
mlLastX = X: mlLastY = Y
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub picDraw_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
|
|
Dim lMsg As Long, lOffset As Long
|
|
Dim oBuf() As Byte
|
|
If Button = vbLeftButton Then 'We are drawing
|
|
If mlColor = 0 Then mlColor = RGB(255, 0, 0)
|
|
'First draw the dot
|
|
picDraw.Line (mlLastX, mlLastY)-(X, Y), mlColor
|
|
'Now tell everyone about it
|
|
|
|
'Now let's send a message to draw this line
|
|
lOffset = NewBuffer(oBuf)
|
|
lMsg = MsgSendDrawLine
|
|
AddDataToBuffer oBuf, lMsg, LenB(lMsg), lOffset
|
|
AddDataToBuffer oBuf, mlColor, LenB(mlColor), lOffset
|
|
AddDataToBuffer oBuf, mlLastX, SIZE_SINGLE, lOffset
|
|
AddDataToBuffer oBuf, mlLastY, SIZE_SINGLE, lOffset
|
|
AddDataToBuffer oBuf, X, SIZE_SINGLE, lOffset
|
|
AddDataToBuffer oBuf, Y, SIZE_SINGLE, lOffset
|
|
dpp.SendTo DPNID_ALL_PLAYERS_GROUP, oBuf, 0, DPNSEND_NOLOOPBACK
|
|
'Now store the last x/y
|
|
mlLastX = X: mlLastY = Y
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub picDraw_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
|
|
If Button = vbRightButton Then
|
|
PopupMenu Pop
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub DirectPlay8Event_AddRemovePlayerGroup(ByVal lMsgID As Long, ByVal lPlayerID As Long, ByVal lGroupID As Long, fRejectMsg As Boolean)
|
|
'VB requires that we must implement *every* member of this interface
|
|
End Sub
|
|
|
|
Private Sub DirectPlay8Event_AppDesc(fRejectMsg As Boolean)
|
|
'VB requires that we must implement *every* member of this interface
|
|
End Sub
|
|
|
|
Private Sub DirectPlay8Event_AsyncOpComplete(dpnotify As DxVBLibA.DPNMSG_ASYNC_OP_COMPLETE, fRejectMsg As Boolean)
|
|
'VB requires that we must implement *every* member of this interface
|
|
End Sub
|
|
|
|
Private Sub DirectPlay8Event_ConnectComplete(dpnotify As DxVBLibA.DPNMSG_CONNECT_COMPLETE, fRejectMsg As Boolean)
|
|
'VB requires that we must implement *every* member of this interface
|
|
End Sub
|
|
|
|
Private Sub DirectPlay8Event_CreateGroup(ByVal lGroupID As Long, ByVal lOwnerID As Long, fRejectMsg As Boolean)
|
|
'VB requires that we must implement *every* member of this interface
|
|
End Sub
|
|
|
|
Private Sub DirectPlay8Event_CreatePlayer(ByVal lPlayerID As Long, fRejectMsg As Boolean)
|
|
'VB requires that we must implement *every* member of this interface
|
|
End Sub
|
|
|
|
Private Sub DirectPlay8Event_DestroyGroup(ByVal lGroupID As Long, ByVal lReason As Long, fRejectMsg As Boolean)
|
|
'VB requires that we must implement *every* member of this interface
|
|
End Sub
|
|
|
|
Private Sub DirectPlay8Event_DestroyPlayer(ByVal lPlayerID As Long, ByVal lReason As Long, fRejectMsg As Boolean)
|
|
'VB requires that we must implement *every* member of this interface
|
|
End Sub
|
|
|
|
Private Sub DirectPlay8Event_EnumHostsQuery(dpnotify As DxVBLibA.DPNMSG_ENUM_HOSTS_QUERY, fRejectMsg As Boolean)
|
|
'VB requires that we must implement *every* member of this interface
|
|
End Sub
|
|
|
|
Private Sub DirectPlay8Event_EnumHostsResponse(dpnotify As DxVBLibA.DPNMSG_ENUM_HOSTS_RESPONSE, fRejectMsg As Boolean)
|
|
'VB requires that we must implement *every* member of this interface
|
|
End Sub
|
|
|
|
Private Sub DirectPlay8Event_HostMigrate(ByVal lNewHostID As Long, fRejectMsg As Boolean)
|
|
'VB requires that we must implement *every* member of this interface
|
|
End Sub
|
|
|
|
Private Sub DirectPlay8Event_IndicateConnect(dpnotify As DxVBLibA.DPNMSG_INDICATE_CONNECT, fRejectMsg As Boolean)
|
|
'VB requires that we must implement *every* member of this interface
|
|
End Sub
|
|
|
|
Private Sub DirectPlay8Event_IndicatedConnectAborted(fRejectMsg As Boolean)
|
|
'VB requires that we must implement *every* member of this interface
|
|
End Sub
|
|
|
|
Private Sub DirectPlay8Event_InfoNotify(ByVal lMsgID As Long, ByVal lNotifyID As Long, fRejectMsg As Boolean)
|
|
'VB requires that we must implement *every* member of this interface
|
|
End Sub
|
|
|
|
Private Sub DirectPlay8Event_Receive(dpnotify As DxVBLibA.DPNMSG_RECEIVE, fRejectMsg As Boolean)
|
|
'All we care about in this form is what msgs we receive.
|
|
Dim lMsg As Long, lOffset As Long
|
|
Dim lColor As Long
|
|
Dim lX As Single, lY As Single
|
|
Dim lX1 As Single, lY1 As Single
|
|
|
|
With dpnotify
|
|
GetDataFromBuffer .ReceivedData, lMsg, LenB(lMsg), lOffset
|
|
Select Case lMsg
|
|
Case MsgSendDrawPixel
|
|
GetDataFromBuffer .ReceivedData, lColor, LenB(lColor), lOffset
|
|
GetDataFromBuffer .ReceivedData, lX, LenB(lX), lOffset
|
|
GetDataFromBuffer .ReceivedData, lY, LenB(lY), lOffset
|
|
On Error Resume Next
|
|
picDraw.PSet (lX, lY), lColor
|
|
Case MsgSendDrawLine
|
|
GetDataFromBuffer .ReceivedData, lColor, LenB(lColor), lOffset
|
|
GetDataFromBuffer .ReceivedData, lX, LenB(lX), lOffset
|
|
GetDataFromBuffer .ReceivedData, lY, LenB(lY), lOffset
|
|
GetDataFromBuffer .ReceivedData, lX1, LenB(lX), lOffset
|
|
GetDataFromBuffer .ReceivedData, lY1, LenB(lY), lOffset
|
|
On Error Resume Next
|
|
picDraw.Line (lX, lY)-(lX1, lY1), lColor
|
|
Case MsgClearWhiteBoard
|
|
picDraw.Cls
|
|
End Select
|
|
End With
|
|
End Sub
|
|
|
|
Private Sub DirectPlay8Event_SendComplete(dpnotify As DxVBLibA.DPNMSG_SEND_COMPLETE, fRejectMsg As Boolean)
|
|
'VB requires that we must implement *every* member of this interface
|
|
End Sub
|
|
|
|
Private Sub DirectPlay8Event_TerminateSession(dpnotify As DxVBLibA.DPNMSG_TERMINATE_SESSION, fRejectMsg As Boolean)
|
|
'VB requires that we must implement *every* member of this interface
|
|
End Sub
|