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,101 @@
|
||||
VERSION 5.00
|
||||
Begin VB.Form frmAbout
|
||||
BorderStyle = 3 'Fixed Dialog
|
||||
Caption = "About Scrawl"
|
||||
ClientHeight = 2340
|
||||
ClientLeft = 2340
|
||||
ClientTop = 1935
|
||||
ClientWidth = 4260
|
||||
ClipControls = 0 'False
|
||||
LinkTopic = "Form2"
|
||||
MaxButton = 0 'False
|
||||
MinButton = 0 'False
|
||||
ScaleHeight = 1615.11
|
||||
ScaleMode = 0 'User
|
||||
ScaleWidth = 4000.36
|
||||
ShowInTaskbar = 0 'False
|
||||
StartUpPosition = 1 'CenterOwner
|
||||
Begin VB.PictureBox picIcon
|
||||
AutoSize = -1 'True
|
||||
ClipControls = 0 'False
|
||||
Height = 540
|
||||
Left = 240
|
||||
Picture = "frmAbout.frx":0000
|
||||
ScaleHeight = 337.12
|
||||
ScaleMode = 0 'User
|
||||
ScaleWidth = 337.12
|
||||
TabIndex = 1
|
||||
Top = 240
|
||||
Width = 540
|
||||
End
|
||||
Begin VB.CommandButton cmdOK
|
||||
Cancel = -1 'True
|
||||
Caption = "OK"
|
||||
Default = -1 'True
|
||||
BeginProperty Font
|
||||
Name = "Arial"
|
||||
Size = 9.75
|
||||
Charset = 0
|
||||
Weight = 400
|
||||
Underline = 0 'False
|
||||
Italic = 0 'False
|
||||
Strikethrough = 0 'False
|
||||
EndProperty
|
||||
Height = 345
|
||||
Left = 1500
|
||||
TabIndex = 0
|
||||
Top = 1560
|
||||
Width = 1260
|
||||
End
|
||||
Begin VB.Label lblDescription
|
||||
Caption = "Copyright ©1999 Microsoft Corporation"
|
||||
ForeColor = &H00000000&
|
||||
Height = 330
|
||||
Left = 1050
|
||||
TabIndex = 2
|
||||
Top = 720
|
||||
Width = 2925
|
||||
End
|
||||
Begin VB.Label lblTitle
|
||||
Caption = "Scrawl (Visual Basic Version)"
|
||||
BeginProperty Font
|
||||
Name = "Arial"
|
||||
Size = 9.75
|
||||
Charset = 0
|
||||
Weight = 400
|
||||
Underline = 0 'False
|
||||
Italic = 0 'False
|
||||
Strikethrough = 0 'False
|
||||
EndProperty
|
||||
ForeColor = &H00000000&
|
||||
Height = 345
|
||||
Left = 1050
|
||||
TabIndex = 3
|
||||
Top = 240
|
||||
Width = 2925
|
||||
End
|
||||
End
|
||||
Attribute VB_Name = "frmAbout"
|
||||
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: FrmAbout.frm
|
||||
' Content: About box for scrawlb
|
||||
'
|
||||
'
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
|
||||
|
||||
Option Explicit
|
||||
|
||||
|
||||
Private Sub cmdOK_Click()
|
||||
Unload Me
|
||||
End Sub
|
||||
|
||||
Binary file not shown.
@@ -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
|
||||
Binary file not shown.
@@ -0,0 +1,111 @@
|
||||
Attribute VB_Name = "modMain"
|
||||
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
'
|
||||
' Copyright (C) 1999-2001 Microsoft Corporation. All Rights Reserved.
|
||||
'
|
||||
' File: ModMain.bas
|
||||
' Content: Scrawl DirectInput Sample
|
||||
'
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
|
||||
|
||||
' This sample application demonstrates use of the mouse in exclusive mode and how to use
|
||||
' event notification for retrieving input data.
|
||||
'
|
||||
' Hold down the left button to draw. Click the right button or press the AppMenu key
|
||||
' to bring up a context menu.
|
||||
'
|
||||
' An important issue in using exclusive mode is being able to release and reacquire the mouse
|
||||
' as needed, so that the system cursor can be used. Any exclusive-mode app is forced to release
|
||||
' the mouse when the user switches to another window by Alt+Tab. In addition, Scrawl surrenders
|
||||
' the mouse so that the user can navigate the context menu. Reacquisition occurs in the
|
||||
' MouseMove event, which is called only when Windows has the mouse.
|
||||
'
|
||||
' The context menu allows the user to set the mouse sensitivity, since DirectInput ignores any
|
||||
' such settings in Control Panel.
|
||||
'
|
||||
' Choosing Suspend from the menu releases the system cursor and prevents
|
||||
' the application from reacquiring till the user clicks on the client area.
|
||||
'
|
||||
' The sample also demonstrates how to subclass a window in order to intercept Windows messages
|
||||
' that are not otherwise available in a Visual Basic app. In this case, we want to get the
|
||||
' WM_ENTERMENULOOP message, so that we can release the mouse and get the
|
||||
' system cursor when the user opens the system menu by pressing Alt+Spacebar. Note that
|
||||
' subclassing can make debugging difficult. If you want to play around with this code and debug it,
|
||||
' comment out the indicated line in Sub Main.
|
||||
|
||||
|
||||
Option Explicit
|
||||
|
||||
Public objDX As New DirectX8
|
||||
Public objDXEvent As DirectXEvent8
|
||||
Public objDI As DirectInput8
|
||||
Public objDIDev As DirectInputDevice8
|
||||
|
||||
Public g_cursorx As Long
|
||||
Public g_cursory As Long
|
||||
Public g_Sensitivity
|
||||
Public Const BufferSize = 10
|
||||
|
||||
Public EventHandle As Long
|
||||
Public Drawing As Boolean
|
||||
Public Suspended As Boolean
|
||||
|
||||
Public procOld As Long
|
||||
|
||||
' Windows API declares and constants
|
||||
|
||||
Public Const GWL_WNDPROC = (-4)
|
||||
Public Const WM_ENTERMENULOOP = &H211
|
||||
Public Const WM_EXITMENULOOP = &H212
|
||||
Public Const WM_SYSCOMMAND = &H112
|
||||
|
||||
Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
|
||||
Public Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
|
||||
Public Declare Function ScreenToClient Lib "user32" (ByVal hWnd As Long, lpPoint As POINTAPI) As Long
|
||||
Public Declare Function ClientToScreen Lib "user32" (ByVal hWnd As Long, lpPoint As POINTAPI) As Long
|
||||
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
|
||||
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
|
||||
|
||||
Public Type POINTAPI
|
||||
x As Long
|
||||
y As Long
|
||||
End Type
|
||||
|
||||
|
||||
Sub Main()
|
||||
|
||||
' Show the main form first so we can use its window handle
|
||||
frmCanvas.Show
|
||||
|
||||
' Initialize our private cursor
|
||||
g_cursorx = frmCanvas.ScaleWidth \ 2
|
||||
g_cursory = frmCanvas.ScaleHeight \ 2
|
||||
g_Sensitivity = 2
|
||||
frmCanvas.mnuSpeed2.Checked = True
|
||||
|
||||
' Create DirectInput and set up the mouse
|
||||
Set objDI = objDX.DirectInputCreate
|
||||
Set objDIDev = objDI.CreateDevice("guid_SysMouse")
|
||||
Call objDIDev.SetCommonDataFormat(DIFORMAT_MOUSE)
|
||||
Call objDIDev.SetCooperativeLevel(frmCanvas.hWnd, DISCL_FOREGROUND Or DISCL_EXCLUSIVE)
|
||||
|
||||
' Set the buffer size
|
||||
Dim diProp As DIPROPLONG
|
||||
diProp.lHow = DIPH_DEVICE
|
||||
diProp.lObj = 0
|
||||
diProp.lData = BufferSize
|
||||
|
||||
Call objDIDev.SetProperty("DIPROP_BUFFERSIZE", diProp)
|
||||
|
||||
' Ask for notifications
|
||||
|
||||
EventHandle = objDX.CreateEvent(frmCanvas)
|
||||
Call objDIDev.SetEventNotification(EventHandle)
|
||||
|
||||
' Acquire the mouse
|
||||
frmCanvas.AcquireMouse
|
||||
|
||||
End Sub
|
||||
|
||||
@@ -0,0 +1,39 @@
|
||||
//-----------------------------------------------------------------------------
|
||||
// Name: Scrawlb DirectInput Sample
|
||||
//
|
||||
// Copyright (C) 1999-2001 Microsoft Corporation. All rights reserved.
|
||||
//-----------------------------------------------------------------------------
|
||||
|
||||
|
||||
Description
|
||||
===========
|
||||
The Scrawlb sample illustrates the use of DirectInput to create a simple drawing program.
|
||||
It shows the use of callbacks to receive mouse movement events.
|
||||
|
||||
|
||||
Path
|
||||
====
|
||||
Source: DXSDK\Samples\Multimedia\Vbsamples\DirectInput\ScrawlB
|
||||
Executable: DXSDK\Samples\Multimedia\vbsamples\DirectInput\Bin
|
||||
|
||||
|
||||
User's Guide
|
||||
============
|
||||
Left Click and drag on the canvas to draw
|
||||
Right Click will bring up a pop up menu with choices
|
||||
About Application information
|
||||
Speed 1 Slow mouse movement
|
||||
Speed 2 Fast mouse movement
|
||||
Speed 3 Faster mouse movement
|
||||
Clear Clear the canvas
|
||||
Release Mouse Change from pencil to cursor pointer
|
||||
|
||||
|
||||
Programming Notes
|
||||
=================
|
||||
The application subclasses the Display window to capture ENTERMENU messages so that
|
||||
the cursor can be reset when selecting the menu. This is done through a call to
|
||||
SetWindowLong. Note that failure to comment out these lines while running the sample from
|
||||
within the Visual Basic environment will result in undefined behavior.
|
||||
|
||||
|
||||
@@ -0,0 +1,200 @@
|
||||
VERSION 5.00
|
||||
Begin VB.Form frmCanvas
|
||||
AutoRedraw = -1 'True
|
||||
BackColor = &H80000005&
|
||||
Caption = "Visual Basic Scrawl Sample"
|
||||
ClientHeight = 6150
|
||||
ClientLeft = 165
|
||||
ClientTop = 450
|
||||
ClientWidth = 9990
|
||||
Icon = "ScrawlB.frx":0000
|
||||
LinkTopic = "Form1"
|
||||
ScaleHeight = 410
|
||||
ScaleMode = 3 'Pixel
|
||||
ScaleWidth = 666
|
||||
StartUpPosition = 2 'CenterScreen
|
||||
Begin VB.Image imgPencil
|
||||
Appearance = 0 'Flat
|
||||
Height = 480
|
||||
Left = 840
|
||||
Picture = "ScrawlB.frx":0442
|
||||
Top = 600
|
||||
Width = 480
|
||||
End
|
||||
Begin VB.Menu mnuContext
|
||||
Caption = "none"
|
||||
Visible = 0 'False
|
||||
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 Sep1
|
||||
Caption = "-"
|
||||
End
|
||||
Begin VB.Menu mnuClear
|
||||
Caption = "Clear"
|
||||
End
|
||||
Begin VB.Menu Sep2
|
||||
Caption = "-"
|
||||
End
|
||||
Begin VB.Menu mnuSuspend
|
||||
Caption = "Suspend"
|
||||
End
|
||||
Begin VB.Menu mnuExit
|
||||
Caption = "Exit"
|
||||
End
|
||||
End
|
||||
End
|
||||
Attribute VB_Name = "frmCanvas"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
||||
Implements DirectXEvent
|
||||
|
||||
|
||||
Dim Suspended As Boolean
|
||||
|
||||
Private Sub DirectXEvent_DXCallback(ByVal eventid As Long)
|
||||
Dim diDeviceData(1 To BufferSize) As DIDEVICEOBJECTDATA
|
||||
Dim NumItems As Integer
|
||||
Dim i As Integer
|
||||
Dim windowRect As RECT
|
||||
Static OldSequence As Long
|
||||
|
||||
On Error GoTo INPUTLOST
|
||||
NumItems = objDIDev.GetDeviceData(diDeviceData, 0)
|
||||
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.
|
||||
If OldSequence <> diDeviceData(i).lSequence Then
|
||||
UpdateCursor
|
||||
End If
|
||||
OldSequence = diDeviceData(i).lSequence
|
||||
|
||||
Case DIMOFS_Y
|
||||
g_cursory = g_cursory + diDeviceData(i).lData * g_Sensitivity
|
||||
If OldSequence <> diDeviceData(i).lSequence Then
|
||||
UpdateCursor
|
||||
End If
|
||||
OldSequence = diDeviceData(i).lSequence
|
||||
|
||||
Case DIMOFS_BUTTON0
|
||||
If diDeviceData(i).lData And &H80 Then
|
||||
Drawing = True
|
||||
CurrentX = g_cursorx
|
||||
CurrentY = g_cursory
|
||||
Else
|
||||
Drawing = False
|
||||
End If
|
||||
|
||||
Case DIMOFS_BUTTON1
|
||||
If diDeviceData(i).lData = 0 Then ' button up
|
||||
objDIDev.Unacquire
|
||||
|
||||
' Get the system cursor into the same position as the private cursor
|
||||
Call GetWindowRect(hwnd, windowRect)
|
||||
Call SetCursorPos(g_cursorx + windowRect.Left, g_cursory + windowRect.Top)
|
||||
|
||||
' Pop up menu at that position
|
||||
Call PopupMenu(mnuContext)
|
||||
End If
|
||||
|
||||
|
||||
End Select
|
||||
Next i
|
||||
Exit Sub
|
||||
|
||||
INPUTLOST:
|
||||
' Since no events are signalled if the device is not acquired, this can only happen
|
||||
' if the device is lost between signalling and retrieval.
|
||||
|
||||
If Err.Number = DIERR_INPUTLOST Then
|
||||
objDIDev.Acquire
|
||||
Else
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
Public Sub UpdateCursor()
|
||||
|
||||
If g_cursorx < 1 Then g_cursorx = 1
|
||||
If g_cursorx >= Canvas.ScaleWidth Then g_cursorx = Canvas.ScaleWidth - 1
|
||||
If g_cursory < 1 Then g_cursory = 1
|
||||
If g_cursory >= Canvas.ScaleHeight Then g_cursory = Canvas.ScaleHeight - 1
|
||||
Canvas.imgPencil.Left = g_cursorx
|
||||
Canvas.imgPencil.Top = g_cursory
|
||||
If Drawing Then
|
||||
Line -(g_cursorx, g_cursory)
|
||||
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Private Sub Form_Click()
|
||||
' Allow user to resume drawing after suspending
|
||||
|
||||
Suspended = False
|
||||
End Sub
|
||||
|
||||
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
|
||||
' This is a bit of a kludge. We need a way 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 appears to happen even when there's no mouse activity, e.g. we have just
|
||||
' Alt+Tabbed back, or cancelled out of the context menu with the Esc key.
|
||||
|
||||
If Suspended Then Exit Sub ' Allow use of Windows cursor
|
||||
On Error Resume Next
|
||||
objDIDev.Acquire
|
||||
End Sub
|
||||
|
||||
Private Sub mnuClear_Click()
|
||||
Cls
|
||||
End Sub
|
||||
|
||||
Private Sub mnuExit_Click()
|
||||
End
|
||||
End Sub
|
||||
|
||||
Private Sub mnuSpeed1_Click()
|
||||
g_Sensitivity = 1
|
||||
mnuSpeed1.Checked = True
|
||||
mnuSpeed2.Checked = False
|
||||
mnuSpeed3.Checked = False
|
||||
objDIDev.Acquire
|
||||
End Sub
|
||||
|
||||
Private Sub mnuSpeed2_Click()
|
||||
g_Sensitivity = 2
|
||||
mnuSpeed2.Checked = True
|
||||
mnuSpeed1.Checked = False
|
||||
mnuSpeed3.Checked = False
|
||||
objDIDev.Acquire
|
||||
End Sub
|
||||
|
||||
Private Sub mnuSpeed3_Click()
|
||||
g_Sensitivity = 3
|
||||
mnuSpeed3.Checked = True
|
||||
mnuSpeed1.Checked = False
|
||||
mnuSpeed2.Checked = False
|
||||
objDIDev.Acquire
|
||||
End Sub
|
||||
|
||||
Private Sub mnuSuspend_Click()
|
||||
Suspended = True
|
||||
objDIDev.Unacquire
|
||||
End Sub
|
||||
Binary file not shown.
@@ -0,0 +1,37 @@
|
||||
Type=Exe
|
||||
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#stdole2.tlb#OLE Automation
|
||||
Reference=*\G{E1211242-8E94-11D1-8808-00C04FC2C603}#1.0#0#dx8vb.dll#DirectX 8 for Visual Basic Type Library
|
||||
Form=frmCanvas.frm
|
||||
Module=modMain; modMain.bas
|
||||
Form=frmAbout.frm
|
||||
Object={1F6AF2BA-798F-4586-8F76-CD0DB05515D9}#1.0#0; vb_SubClass.OCX
|
||||
IconForm="frmCanvas"
|
||||
Startup="Sub Main"
|
||||
HelpFile=""
|
||||
Title="ScrawlB"
|
||||
ExeName32="vb_ScrawlB.exe"
|
||||
Command32=""
|
||||
Name="ScrawlB"
|
||||
HelpContextID="0"
|
||||
CompatibleMode="0"
|
||||
MajorVer=1
|
||||
MinorVer=0
|
||||
RevisionVer=0
|
||||
AutoIncrementVer=0
|
||||
ServerSupportFiles=0
|
||||
VersionCompanyName="Microsoft"
|
||||
CompilationType=0
|
||||
OptimizationType=0
|
||||
FavorPentiumPro(tm)=0
|
||||
CodeViewDebugInfo=0
|
||||
NoAliasing=0
|
||||
BoundsCheck=0
|
||||
OverflowCheck=0
|
||||
FlPointCheck=0
|
||||
FDIVCheck=0
|
||||
UnroundedFP=0
|
||||
StartMode=0
|
||||
Unattended=0
|
||||
Retained=0
|
||||
ThreadPerObject=0
|
||||
MaxNumberOfThreads=1
|
||||
Reference in New Issue
Block a user