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,207 @@
|
||||
VERSION 1.0 CLASS
|
||||
BEGIN
|
||||
MultiUse = -1 'True
|
||||
Persistable = 0 'NotPersistable
|
||||
DataBindingBehavior = 0 'vbNone
|
||||
DataSourceBehavior = 0 'vbNone
|
||||
MTSTransactionMode = 0 'NotAnMTSObject
|
||||
END
|
||||
Attribute VB_Name = "CInputMapper"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = True
|
||||
Attribute VB_PredeclaredId = False
|
||||
Attribute VB_Exposed = False
|
||||
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
'
|
||||
' Copyright (C) 1999-2001 Microsoft Corporation. All Rights Reserved.
|
||||
'
|
||||
' File: ActionMap.cls
|
||||
' Content: Use DirectInput action mapper to interpret input from many devices
|
||||
'
|
||||
'
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
|
||||
Option Explicit
|
||||
|
||||
Dim m_NumberofSemantics As Long
|
||||
Dim m_diaf As DIACTIONFORMAT
|
||||
Dim m_DIEnum As DirectInputEnumDevices8
|
||||
Dim m_Devices(100) As DirectInputDevice8
|
||||
Dim m_DeviceTypes(100) As Long
|
||||
Dim m_NumDevices As Long
|
||||
Dim m_DI As DirectInput8
|
||||
Dim m_bInit As Boolean
|
||||
Dim m_hwnd As Long
|
||||
Dim m_strUserName As String
|
||||
Dim m_cdParams As DICONFIGUREDEVICESPARAMS
|
||||
|
||||
Function GetDevice(i As Long) As DirectInputDevice8
|
||||
Set GetDevice = m_Devices(i)
|
||||
End Function
|
||||
|
||||
Function GetNumDevices() As Long
|
||||
GetNumDevices = m_NumDevices
|
||||
|
||||
End Function
|
||||
|
||||
Function GetDInput() As DirectInput8
|
||||
Set GetDInput = m_DI
|
||||
End Function
|
||||
|
||||
Function ConfigureDevices(Optional bAllowEdit = False)
|
||||
ReDim m_cdParams.ActionFormats(0)
|
||||
ReDim m_cdParams.UserNames(0)
|
||||
|
||||
Dim i As Long
|
||||
|
||||
m_cdParams.ActionFormats(0) = m_diaf
|
||||
m_cdParams.FormatCount = 1
|
||||
m_cdParams.UserCount = 1
|
||||
m_cdParams.UserNames(0) = m_strUserName
|
||||
If bAllowEdit Then
|
||||
m_DI.ConfigureDevices 0, m_cdParams, DICD_EDIT
|
||||
Else
|
||||
m_DI.ConfigureDevices 0, m_cdParams, DICD_DEFAULT
|
||||
End If
|
||||
|
||||
m_diaf = m_cdParams.ActionFormats(0)
|
||||
|
||||
'release existing devices
|
||||
For i = 1 To m_NumDevices
|
||||
If Not m_Devices(i) Is Nothing Then m_Devices(i).Unacquire
|
||||
Set m_Devices(i) = Nothing
|
||||
Next
|
||||
|
||||
Set m_DIEnum = Nothing
|
||||
|
||||
Dim ret As Long
|
||||
ret = CreateDevicesFromMAP(m_hwnd, m_strUserName, m_diaf.ActionMapName, _
|
||||
m_diaf.guidActionMap, m_diaf.lGenre, m_diaf.lBufferSize, _
|
||||
m_diaf.lAxisMin, m_diaf.lAxisMax)
|
||||
|
||||
End Function
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: CreateDevicesFromMap()
|
||||
' Desc: Creation method for the class. Creates DInput, and enumerated (i.e.
|
||||
' builds a list) of "suitable" devices. By "suitable", we mean devices
|
||||
' that work with the DInput genre specified in the DIACTIONFORMAT
|
||||
' structure.
|
||||
'-----------------------------------------------------------------------------
|
||||
Function CreateDevicesFromMAP(hWnd As Long, UserName As String, MapName As String, MapGuid As String, Genre As CONST_DIGENRE, Optional buffersize = 16, Optional AxisMin = -100, Optional AxisMax = 100) As Boolean
|
||||
|
||||
|
||||
On Local Error Resume Next
|
||||
Dim i As Long
|
||||
|
||||
' Copy passed in arguments for internal use.
|
||||
m_hwnd = hWnd
|
||||
m_strUserName = UserName
|
||||
m_diaf.guidActionMap = MapGuid
|
||||
m_diaf.lGenre = Genre
|
||||
m_diaf.lBufferSize = buffersize
|
||||
m_diaf.lAxisMax = AxisMax
|
||||
m_diaf.lAxisMin = AxisMin
|
||||
m_diaf.ActionMapName = MapName
|
||||
|
||||
'Create DInput
|
||||
Dim dx As DirectX8
|
||||
Set dx = New DirectX8
|
||||
Set m_DI = dx.DirectInputCreate()
|
||||
Set dx = Nothing
|
||||
|
||||
m_diaf.lActionCount = m_NumberofSemantics
|
||||
|
||||
' Enumerate "suitable" devices that are attached
|
||||
Set m_DIEnum = m_DI.GetDevicesBySemantics(m_strUserName, m_diaf, 0)
|
||||
If Err.Number <> 0 Then
|
||||
CreateDevicesFromMAP = False
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
|
||||
Dim devinst As DirectInputDeviceInstance8
|
||||
|
||||
For i = 1 To m_DIEnum.GetCount
|
||||
|
||||
Set devinst = m_DIEnum.GetItem(i)
|
||||
Set m_Devices(i) = m_DI.CreateDevice(devinst.GetGuidInstance)
|
||||
m_DeviceTypes(i) = devinst.GetDevType
|
||||
Set devinst = Nothing
|
||||
|
||||
If m_DeviceTypes(i) = DI8DEVTYPE_MOUSE Then
|
||||
Dim dipl As DIPROPLONG
|
||||
dipl.lHow = DIPH_DEVICE
|
||||
dipl.lData = DIPROPAXISMODE_REL
|
||||
m_Devices(i).SetProperty "DIPROP_AXISMODE", dipl
|
||||
End If
|
||||
|
||||
' Obtain the action to device control mapping.
|
||||
m_Devices(i).BuildActionMap m_diaf, m_strUserName, 0
|
||||
|
||||
' Once actions have been mapped to the device controls the app can review
|
||||
' the mapping and may want to modify the map. When done, call
|
||||
' SetActionMap() to put the map into effect
|
||||
m_Devices(i).SetActionMap m_diaf, m_strUserName, 0
|
||||
|
||||
' Set the cooperative level
|
||||
m_Devices(i).SetCooperativeLevel m_hwnd, DISCL_EXCLUSIVE Or DISCL_FOREGROUND
|
||||
Next
|
||||
|
||||
m_NumDevices = m_DIEnum.GetCount
|
||||
m_bInit = True
|
||||
CreateDevicesFromMAP = True
|
||||
End Function
|
||||
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: ClearMap()
|
||||
' Desc:
|
||||
'-----------------------------------------------------------------------------
|
||||
Sub ClearMap()
|
||||
On Local Error Resume Next
|
||||
|
||||
Dim i As Long
|
||||
|
||||
m_NumberofSemantics = 0
|
||||
ReDim m_diaf.ActionArray(0)
|
||||
m_bInit = False
|
||||
|
||||
For i = 0 To m_NumDevices
|
||||
If Not m_Devices(i) Is Nothing Then
|
||||
m_Devices(i).Unacquire
|
||||
Set m_Devices(i) = Nothing
|
||||
End If
|
||||
Next
|
||||
|
||||
Set m_DI = Nothing
|
||||
Set m_DIEnum = Nothing
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: AddAction()
|
||||
' Desc:
|
||||
'-----------------------------------------------------------------------------
|
||||
Sub AddAction(user As Long, semantic As Long, flags As Long, strName As String)
|
||||
If m_bInit Then
|
||||
Debug.Print "can not add actions after CreateDevicesFromMAP has been called"
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
ReDim Preserve m_diaf.ActionArray(m_NumberofSemantics)
|
||||
|
||||
With m_diaf.ActionArray(m_NumberofSemantics)
|
||||
.ActionName = strName
|
||||
.lAppData = user
|
||||
.lFlags = flags
|
||||
.lSemantic = semantic
|
||||
End With
|
||||
m_NumberofSemantics = m_NumberofSemantics + 1
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
@@ -0,0 +1,334 @@
|
||||
VERSION 5.00
|
||||
Begin VB.Form Form1
|
||||
BorderStyle = 3 'Fixed Dialog
|
||||
Caption = "DInput Action Mapping"
|
||||
ClientHeight = 3840
|
||||
ClientLeft = 45
|
||||
ClientTop = 330
|
||||
ClientWidth = 4725
|
||||
Icon = "ActionMap.frx":0000
|
||||
LinkTopic = "Form1"
|
||||
MaxButton = 0 'False
|
||||
MinButton = 0 'False
|
||||
ScaleHeight = 256
|
||||
ScaleMode = 3 'Pixel
|
||||
ScaleWidth = 315
|
||||
ShowInTaskbar = 0 'False
|
||||
StartUpPosition = 3 'Windows Default
|
||||
Begin VB.Frame Frame1
|
||||
Height = 855
|
||||
Left = 0
|
||||
TabIndex = 3
|
||||
Top = 3000
|
||||
Width = 4695
|
||||
Begin VB.Label Label2
|
||||
Caption = "Pressing 'd' will allow you to view device configurations"
|
||||
Height = 255
|
||||
Left = 120
|
||||
TabIndex = 5
|
||||
Top = 480
|
||||
Width = 4335
|
||||
End
|
||||
Begin VB.Label Label1
|
||||
Caption = "Press escape to exit "
|
||||
Height = 255
|
||||
Left = 120
|
||||
TabIndex = 4
|
||||
Top = 240
|
||||
Width = 4335
|
||||
WordWrap = -1 'True
|
||||
End
|
||||
End
|
||||
Begin VB.Label GameStateList
|
||||
Height = 255
|
||||
Index = 0
|
||||
Left = 240
|
||||
TabIndex = 2
|
||||
Top = 360
|
||||
Visible = 0 'False
|
||||
Width = 3855
|
||||
End
|
||||
Begin VB.Label TSHIELD
|
||||
Caption = "Label1"
|
||||
Height = 375
|
||||
Left = 3720
|
||||
TabIndex = 1
|
||||
Top = 5160
|
||||
Width = 1215
|
||||
End
|
||||
Begin VB.Label TFIRE
|
||||
Caption = "Label1"
|
||||
Height = 255
|
||||
Left = 1200
|
||||
TabIndex = 0
|
||||
Top = 5160
|
||||
Width = 1095
|
||||
End
|
||||
End
|
||||
Attribute VB_Name = "Form1"
|
||||
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: ActionMap.frm
|
||||
' Content: Use DirectInput action mapper to interpret input from many devices
|
||||
'
|
||||
'
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' App-defined game actions for the DInput action mapper.
|
||||
'-----------------------------------------------------------------------------
|
||||
|
||||
' The following constants are custom for each app, depending on what input the
|
||||
' app needs. This simple sample is pretending to be a space simulator game, so
|
||||
' relevant inputs are for turning left, thrusting, firing weapons, etc.. Also
|
||||
' note that some constants are defines for the axes, which are for recieving
|
||||
' axis data from joysticks and similiar analog devices.
|
||||
Const INPUT_LEFTRIGHT_AXIS = 1
|
||||
Const INPUT_UPDOWN_AXIS = 2
|
||||
Const INPUT_TURNLEFT = 4
|
||||
Const INPUT_TURNRIGHT = 5
|
||||
Const INPUT_FORWARDTHRUST = 6
|
||||
Const INPUT_REVERSETHRUST = 7
|
||||
Const INPUT_FIREWEAPONS = 8
|
||||
Const INPUT_ENABLESHIELD = 9
|
||||
Const INPUT_DISPLAYGAMEMENU = 10
|
||||
Const INPUT_QUITGAME = 11
|
||||
|
||||
|
||||
Const kMapGuid = "{20CAA014-60BC-4399-BDD3-84AD65A38A1C}"
|
||||
Const kUserName = "DInput 8 VB Sample User"
|
||||
Const KGenre = DIVIRTUAL_SPACESIM
|
||||
|
||||
Dim m_mapper As New CInputMapper
|
||||
|
||||
Private Sub DeviceList_Click(Index As Integer)
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub Form_Load()
|
||||
Me.Show
|
||||
DefineActions
|
||||
|
||||
Dim i As Long
|
||||
For i = 1 To 15
|
||||
Load Form1.GameStateList(i)
|
||||
Form1.GameStateList(i).Top = i * 20
|
||||
Form1.GameStateList(i).Visible = True
|
||||
|
||||
Next
|
||||
|
||||
If Not m_mapper.CreateDevicesFromMAP(Me.hWnd, kUserName, "Semantic Mapper VB Sample", kMapGuid, KGenre) Then
|
||||
MsgBox "unable to find any mappable input devices"
|
||||
End
|
||||
End If
|
||||
|
||||
Do While InputLoop()
|
||||
DoEvents
|
||||
Loop
|
||||
|
||||
m_mapper.ClearMap
|
||||
|
||||
End
|
||||
End Sub
|
||||
|
||||
|
||||
' The following array is the global, app-defined game actions, which map real
|
||||
' device input into a semantic. The first column is the app-defined semantics
|
||||
' as defined above. These are the constants the game actually sees in its
|
||||
' input loop. The second column is the physical action recieved by the device
|
||||
' which is to be mapped to the app-defined semantic. For instance, in the
|
||||
' array below, if the user hits the "Left" key on the keyboard, the app will
|
||||
' recieve an input code equal to INPUT_TURNLEFT. The last column is a text
|
||||
' string that DInput uses for displaying a configuration dialog box.
|
||||
|
||||
Sub DefineActions()
|
||||
|
||||
|
||||
m_mapper.ClearMap
|
||||
|
||||
' Device input (joystick, etc.) that is pre-defined by DInput, according
|
||||
' to genre type. The genre for this app is space simulators.
|
||||
With m_mapper
|
||||
.AddAction INPUT_LEFTRIGHT_AXIS, DIAXIS_SPACESIM_LATERAL, 0, "Turn"
|
||||
.AddAction INPUT_UPDOWN_AXIS, DIAXIS_SPACESIM_MOVE, 0, "Move"
|
||||
.AddAction INPUT_FIREWEAPONS, DIBUTTON_SPACESIM_FIRE, 0, "Shoot"
|
||||
.AddAction INPUT_ENABLESHIELD, DIBUTTON_SPACESIM_GEAR, 0, "Shield"
|
||||
.AddAction INPUT_DISPLAYGAMEMENU, DIBUTTON_SPACESIM_DISPLAY, 0, "Display"
|
||||
.AddAction INPUT_QUITGAME, DIBUTTON_SPACESIM_MENU, 0, "Quit Game"
|
||||
|
||||
' Keyboard input mappings
|
||||
.AddAction INPUT_FORWARDTHRUST, DIKEYBOARD_UP, 0, "Forward thrust"
|
||||
.AddAction INPUT_REVERSETHRUST, DIKEYBOARD_DOWN, 0, "Reverse thrust"
|
||||
.AddAction INPUT_FIREWEAPONS, DIKEYBOARD_F, 0, "Fire weapons"
|
||||
.AddAction INPUT_ENABLESHIELD, DIKEYBOARD_S, 0, "Enable shields"
|
||||
.AddAction INPUT_DISPLAYGAMEMENU, DIKEYBOARD_D, 0, "Display game menu"
|
||||
.AddAction INPUT_QUITGAME, DIKEYBOARD_ESCAPE, 0, "Quit game"
|
||||
.AddAction INPUT_TURNRIGHT, DIKEYBOARD_RIGHT, 0, "Right Turn"
|
||||
.AddAction INPUT_TURNLEFT, DIKEYBOARD_LEFT, 0, "Left Turn"
|
||||
|
||||
' Mouse input mappings
|
||||
.AddAction INPUT_LEFTRIGHT_AXIS, DIMOUSE_XAXIS, 0, "Turn"
|
||||
.AddAction INPUT_UPDOWN_AXIS, DIMOUSE_YAXIS, 0, "Move"
|
||||
.AddAction INPUT_FIREWEAPONS, DIMOUSE_BUTTON0, 0, "Fire weapons"
|
||||
.AddAction INPUT_ENABLESHIELD, DIMOUSE_BUTTON1, 0, "Enable shields"
|
||||
|
||||
End With
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
'-----------------------------------------------------------------------------
|
||||
' Name: InputLoop()
|
||||
' Desc: This is the input loop for the app. Input is gathered from the DInput
|
||||
' devices, and output is displayed simply in the app's window.
|
||||
'-----------------------------------------------------------------------------
|
||||
Function InputLoop() As Boolean
|
||||
|
||||
Dim didObjData As DIDEVICEOBJECTDATA
|
||||
Dim strOut As String
|
||||
|
||||
On Local Error Resume Next
|
||||
|
||||
'Static state of the app's input
|
||||
Static bTurningRight As Boolean
|
||||
Static bReverseThrust As Boolean
|
||||
Static bTurningLeft As Boolean
|
||||
Static bForwardThrust As Boolean
|
||||
Static bFiringWeapons As Boolean
|
||||
Static bEnableShields As Boolean
|
||||
Static bDisplayingMenu As Boolean
|
||||
Static dwLRAxisData As Long
|
||||
Static dwUDAxisData As Long
|
||||
|
||||
Dim nItems As Long
|
||||
Dim i As Long, j As Long
|
||||
Dim adod(10) As DIDEVICEOBJECTDATA
|
||||
Static nItemsSave(20) As Long
|
||||
|
||||
Dim dev As DirectInputDevice8
|
||||
|
||||
For i = 1 To m_mapper.GetNumDevices()
|
||||
|
||||
nItems = 10
|
||||
Set dev = m_mapper.GetDevice(i)
|
||||
|
||||
' Need to ensure that the devices are acquired, and pollable devices
|
||||
' are polled.
|
||||
dev.Acquire
|
||||
If Err.Number <> 0 Then GoTo skipDevice
|
||||
|
||||
dev.Poll
|
||||
If Err.Number <> 0 Then GoTo skipDevice
|
||||
|
||||
|
||||
' This call gets the data from the i'th device
|
||||
nItems = 0
|
||||
nItems = dev.GetDeviceData(adod, 0)
|
||||
|
||||
|
||||
|
||||
' Get the sematics codes. The number of input events is stored in
|
||||
' "nItems", and all the events are stored in the "adod" array. Each
|
||||
' event has a type stored in "uAppDate", and actual data stored in
|
||||
' "nData".
|
||||
For j = 0 To nItems - 1
|
||||
|
||||
If (adod(j).lUserData = INPUT_LEFTRIGHT_AXIS) Then ' Left-right axis
|
||||
' Parse the left-right axis data
|
||||
dwLRAxisData = adod(j).lData
|
||||
bTurningRight = False
|
||||
bTurningLeft = False
|
||||
Debug.Print "AXIS"
|
||||
If (dwLRAxisData > 0) Then bTurningRight = True
|
||||
If (dwLRAxisData < -0) Then bTurningLeft = True
|
||||
|
||||
ElseIf (adod(j).lUserData = INPUT_UPDOWN_AXIS) Then ' Up-down axis
|
||||
' Parse the up-down axis data
|
||||
dwUDAxisData = adod(j).lData
|
||||
bReverseThrust = False
|
||||
bForwardThrust = False
|
||||
|
||||
If (dwUDAxisData > 0) Then bReverseThrust = True
|
||||
If (dwUDAxisData < -0) Then bForwardThrust = True
|
||||
Else
|
||||
' Non-axis stuff
|
||||
|
||||
' Non-axis data is recieved as "button pressed" or "button
|
||||
' released". Parse input as such.
|
||||
Dim bState As Boolean
|
||||
If (adod(j).lData = &H80) Then bState = True
|
||||
Debug.Print "BUTTON"
|
||||
Select Case adod(j).lUserData
|
||||
|
||||
Case INPUT_TURNLEFT:
|
||||
bTurningLeft = bState
|
||||
Case INPUT_TURNRIGHT:
|
||||
bTurningRight = bState
|
||||
Case INPUT_FORWARDTHRUST:
|
||||
bForwardThrust = bState
|
||||
Case INPUT_REVERSETHRUST:
|
||||
bReverseThrust = bState
|
||||
Case INPUT_FIREWEAPONS:
|
||||
bFiringWeapons = bState
|
||||
Case INPUT_ENABLESHIELD:
|
||||
bEnableShields = bState
|
||||
Case INPUT_DISPLAYGAMEMENU:
|
||||
bDisplayingMenu = bState
|
||||
|
||||
Case INPUT_QUITGAME:
|
||||
InputLoop = False
|
||||
Exit Function
|
||||
End Select
|
||||
End If
|
||||
Next
|
||||
|
||||
skipDevice:
|
||||
Err.Clear
|
||||
Next
|
||||
|
||||
' Remove conflicts (in a game, you couldn't go left and right at the same
|
||||
' time. Actual conflicts depend on the game logic, and not on the DInput
|
||||
' semantic mappings.)
|
||||
If (bTurningLeft And bTurningRight) Then
|
||||
bTurningLeft = False: bTurningRight = False
|
||||
End If
|
||||
If (bForwardThrust And bReverseThrust) Then
|
||||
bForwardThrust = False: bReverseThrust = False
|
||||
End If
|
||||
If (bFiringWeapons And bEnableShields) Then bFiringWeapons = False
|
||||
|
||||
' The remainder of the this function is simply to output the results of
|
||||
' gathering the input.
|
||||
GameStateList(1).Caption = "Turning Left " + Str(bTurningLeft)
|
||||
GameStateList(2).Caption = "Turning Right " + Str(bTurningRight)
|
||||
GameStateList(3).Caption = "Forward thrust " + Str(bForwardThrust)
|
||||
GameStateList(4).Caption = "Backward thrust " + Str(bReverseThrust)
|
||||
GameStateList(5).Caption = "Firing Weapons " + Str(bFiringWeapons)
|
||||
GameStateList(6).Caption = "Enable Shields" + Str(bEnableShields)
|
||||
GameStateList(7).Caption = "LR Axis " + Str(dwLRAxisData)
|
||||
GameStateList(8).Caption = "UD Axis " + Str(dwUDAxisData)
|
||||
|
||||
If (bDisplayingMenu) Then
|
||||
|
||||
m_mapper.ConfigureDevices True
|
||||
bDisplayingMenu = False
|
||||
End If
|
||||
|
||||
InputLoop = True
|
||||
|
||||
End Function
|
||||
|
||||
|
||||
Private Sub Form_Unload(Cancel As Integer)
|
||||
End
|
||||
End Sub
|
||||
|
||||
|
||||
Binary file not shown.
@@ -0,0 +1,35 @@
|
||||
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=ActionMap.frm
|
||||
Class=CInputMapper; ActionMap.cls
|
||||
Startup="Form1"
|
||||
ExeName32="vb_ActionMapper.exe"
|
||||
Command32=""
|
||||
Name="Project1"
|
||||
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
|
||||
|
||||
[MS Transaction Server]
|
||||
AutoRefresh=1
|
||||
@@ -0,0 +1,2 @@
|
||||
Form1 = -17, 13, 520, 457, C, 44, 44, 581, 488, C
|
||||
CInputMapper = 88, 88, 625, 532, C
|
||||
@@ -0,0 +1,38 @@
|
||||
//-----------------------------------------------------------------------------
|
||||
// Name: ActionMap DirectInput Sample
|
||||
//
|
||||
// Copyright (C) 1999-2001 Microsoft Corporation. All rights reserved.
|
||||
//-----------------------------------------------------------------------------
|
||||
|
||||
|
||||
Description
|
||||
===========
|
||||
The ActionMap sample illustrates the use of DirectInput's Action Mapping feature.
|
||||
This feature allows you to assign various keys to constants that are kept in
|
||||
a queue that the application can read at any time. This sample also shows how
|
||||
those mappings can be user configurable.
|
||||
|
||||
|
||||
Path
|
||||
====
|
||||
Source: DXSDK\Samples\Multimedia\Vbsamples\DirectInput\ActionMap
|
||||
Executable: DXSDK\Samples\Multimedia\vbsamples\DirectInput\Bin
|
||||
|
||||
|
||||
User's Guide
|
||||
============
|
||||
None
|
||||
|
||||
|
||||
Programming Notes
|
||||
=================
|
||||
ActionMap.cls should not be used unmodified. For the purpose of this sample it will
|
||||
query for any and all input devices and does not differentiate where the input is coming
|
||||
from. Most applications will want to modify the class to respond to only one given input
|
||||
or differentiate the input devices into different players or purposes.
|
||||
|
||||
This sample makes use of common DirectX code (consisting of helper functions,
|
||||
etc.) that is shared with other samples on the DirectX SDK. All common
|
||||
classes and modules can be found in the following directory:
|
||||
DXSDK\Samples\Multimedia\VBSamples\Common
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
Binary file not shown.
@@ -0,0 +1,39 @@
|
||||
Type=Exe
|
||||
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\WINNT\System32\stdole2.tlb#OLE Automation
|
||||
Reference=*\G{E1211242-8E94-11D1-8808-00C04FC2C603}#1.0#0#C:\WINNT\System32\dx8vb.dll#DirectX 8 for Visual Basic Type Library
|
||||
Form=ForceFeedback.frm
|
||||
Object={831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0; mscomctl.ocx
|
||||
IconForm="frmForceFeedback"
|
||||
Startup="frmForceFeedback"
|
||||
HelpFile=""
|
||||
Title="Force Feedback"
|
||||
ExeName32="VB_ForceFeedback.exe"
|
||||
Command32=""
|
||||
Name="ForceFeeback"
|
||||
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
|
||||
DebugStartupOption=0
|
||||
|
||||
[MS Transaction Server]
|
||||
AutoRefresh=1
|
||||
@@ -0,0 +1,30 @@
|
||||
//-----------------------------------------------------------------------------
|
||||
// Name: Force Feedback DirectInput Sample
|
||||
//
|
||||
// Copyright (C) 1999-2001 Microsoft Corporation. All rights reserved.
|
||||
//-----------------------------------------------------------------------------
|
||||
|
||||
|
||||
Description
|
||||
===========
|
||||
The Force Feedback sample illustrates the use of DirectInput's force features.
|
||||
The sample shows how to use the various stock feedback effects available
|
||||
to Direct Input.
|
||||
|
||||
|
||||
Path
|
||||
====
|
||||
Source: DXSDK\Samples\Multimedia\Vbsamples\DirectInput\feedback
|
||||
Executable: DXSDK\Samples\Multimedia\vbsamples\DirectInput\Bin
|
||||
|
||||
|
||||
User's Guide
|
||||
============
|
||||
From the list of available effects, choose one.
|
||||
|
||||
The various sliders and controls can shape the effects'
|
||||
duration, force, and direction. Please see the DirectX
|
||||
SDK documentation to see which parameters effect
|
||||
the different types of effects.
|
||||
|
||||
|
||||
Binary file not shown.
|
After Width: | Height: | Size: 1.1 KiB |
@@ -0,0 +1,420 @@
|
||||
VERSION 5.00
|
||||
Begin VB.Form frmMain
|
||||
BorderStyle = 1 'Fixed Single
|
||||
Caption = "JoyStick Sample"
|
||||
ClientHeight = 6240
|
||||
ClientLeft = 45
|
||||
ClientTop = 330
|
||||
ClientWidth = 6000
|
||||
Icon = "frmMain.frx":0000
|
||||
LinkTopic = "Form1"
|
||||
MaxButton = 0 'False
|
||||
MinButton = 0 'False
|
||||
ScaleHeight = 6240
|
||||
ScaleWidth = 6000
|
||||
StartUpPosition = 3 'Windows Default
|
||||
Begin VB.ListBox lstHat
|
||||
Enabled = 0 'False
|
||||
Height = 1230
|
||||
ItemData = "frmMain.frx":0442
|
||||
Left = 4080
|
||||
List = "frmMain.frx":0444
|
||||
TabIndex = 6
|
||||
Top = 3240
|
||||
Width = 1695
|
||||
End
|
||||
Begin VB.ListBox lstButton
|
||||
Enabled = 0 'False
|
||||
Height = 2790
|
||||
ItemData = "frmMain.frx":0446
|
||||
Left = 2160
|
||||
List = "frmMain.frx":0448
|
||||
TabIndex = 2
|
||||
Top = 3240
|
||||
Width = 1695
|
||||
End
|
||||
Begin VB.ListBox lstJoyAxis
|
||||
Enabled = 0 'False
|
||||
Height = 2790
|
||||
ItemData = "frmMain.frx":044A
|
||||
Left = 240
|
||||
List = "frmMain.frx":044C
|
||||
TabIndex = 1
|
||||
Top = 3240
|
||||
Width = 1695
|
||||
End
|
||||
Begin VB.ListBox lstJoySticks
|
||||
Height = 1815
|
||||
ItemData = "frmMain.frx":044E
|
||||
Left = 240
|
||||
List = "frmMain.frx":0450
|
||||
TabIndex = 0
|
||||
Top = 720
|
||||
Width = 5535
|
||||
End
|
||||
Begin VB.Label lblHats
|
||||
Caption = "POVs"
|
||||
BeginProperty Font
|
||||
Name = "MS Sans Serif"
|
||||
Size = 18
|
||||
Charset = 0
|
||||
Weight = 400
|
||||
Underline = 0 'False
|
||||
Italic = 0 'False
|
||||
Strikethrough = 0 'False
|
||||
EndProperty
|
||||
Height = 375
|
||||
Left = 4080
|
||||
TabIndex = 7
|
||||
Top = 2760
|
||||
Width = 1335
|
||||
End
|
||||
Begin VB.Label lblButtons
|
||||
Caption = "Buttons"
|
||||
BeginProperty Font
|
||||
Name = "MS Sans Serif"
|
||||
Size = 18
|
||||
Charset = 0
|
||||
Weight = 400
|
||||
Underline = 0 'False
|
||||
Italic = 0 'False
|
||||
Strikethrough = 0 'False
|
||||
EndProperty
|
||||
Height = 375
|
||||
Left = 2160
|
||||
TabIndex = 5
|
||||
Top = 2760
|
||||
Width = 1575
|
||||
End
|
||||
Begin VB.Label lblAxis
|
||||
Caption = "Axes"
|
||||
BeginProperty Font
|
||||
Name = "MS Sans Serif"
|
||||
Size = 18
|
||||
Charset = 0
|
||||
Weight = 400
|
||||
Underline = 0 'False
|
||||
Italic = 0 'False
|
||||
Strikethrough = 0 'False
|
||||
EndProperty
|
||||
Height = 495
|
||||
Left = 240
|
||||
TabIndex = 4
|
||||
Top = 2760
|
||||
Width = 1335
|
||||
End
|
||||
Begin VB.Label lblJoy
|
||||
Caption = "Joysticks"
|
||||
BeginProperty Font
|
||||
Name = "MS Sans Serif"
|
||||
Size = 18
|
||||
Charset = 0
|
||||
Weight = 400
|
||||
Underline = 0 'False
|
||||
Italic = 0 'False
|
||||
Strikethrough = 0 'False
|
||||
EndProperty
|
||||
Height = 375
|
||||
Left = 240
|
||||
TabIndex = 3
|
||||
Top = 120
|
||||
Width = 4215
|
||||
End
|
||||
End
|
||||
Attribute VB_Name = "frmMain"
|
||||
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: FrmMain.Frm
|
||||
' Content: This sample shows one way to use DirectInput with a Joystick device
|
||||
'
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
|
||||
Option Explicit
|
||||
Implements DirectXEvent8
|
||||
|
||||
|
||||
Dim dx As New DirectX8
|
||||
Dim di As DirectInput8
|
||||
Dim diDev As DirectInputDevice8
|
||||
Dim diDevEnum As DirectInputEnumDevices8
|
||||
Dim EventHandle As Long
|
||||
Dim joyCaps As DIDEVCAPS
|
||||
Dim js As DIJOYSTATE
|
||||
Dim DiProp_Dead As DIPROPLONG
|
||||
Dim DiProp_Range As DIPROPRANGE
|
||||
Dim DiProp_Saturation As DIPROPLONG
|
||||
Dim AxisPresent(1 To 8) As Boolean
|
||||
Dim running As Boolean
|
||||
|
||||
Sub InitDirectInput()
|
||||
|
||||
Set di = dx.DirectInputCreate()
|
||||
Set diDevEnum = di.GetDIDevices(DI8DEVCLASS_GAMECTRL, DIEDFL_ATTACHEDONLY)
|
||||
If diDevEnum.GetCount = 0 Then
|
||||
MsgBox "No joystick attached."
|
||||
Unload Me
|
||||
End If
|
||||
|
||||
'Add attached joysticks to the listbox
|
||||
Dim i As Integer
|
||||
For i = 1 To diDevEnum.GetCount
|
||||
Call lstJoySticks.AddItem(diDevEnum.GetItem(i).GetInstanceName)
|
||||
Next
|
||||
|
||||
' Get an event handle to associate with the device
|
||||
EventHandle = dx.CreateEvent(Me)
|
||||
Exit Sub
|
||||
|
||||
Error_Out:
|
||||
MsgBox "Error initializing DirectInput."
|
||||
Unload Me
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
Private Sub DirectXEvent8_DXCallback(ByVal eventid As Long)
|
||||
|
||||
' This is called whenever there's a change in the joystick state.
|
||||
' We check the new state and update the display.
|
||||
|
||||
|
||||
Dim i As Integer
|
||||
Dim ListPos As Integer
|
||||
Dim S As String
|
||||
|
||||
If diDev Is Nothing Then Exit Sub
|
||||
|
||||
'' Get the device info
|
||||
On Local Error Resume Next
|
||||
diDev.GetDeviceStateJoystick js
|
||||
If Err.Number = DIERR_NOTACQUIRED Or Err.Number = DIERR_INPUTLOST Then
|
||||
diDev.Acquire
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
|
||||
On Error GoTo err_out
|
||||
|
||||
' Display axis coordinates
|
||||
ListPos = 0
|
||||
For i = 1 To 8
|
||||
If AxisPresent(i) Then
|
||||
Select Case i
|
||||
Case 1
|
||||
S = "X: " & js.x
|
||||
Case 2
|
||||
S = "Y: " & js.y
|
||||
Case 3
|
||||
S = "Z: " & js.z
|
||||
Case 4
|
||||
S = "RX: " & js.rx
|
||||
Case 5
|
||||
S = "RY: " & js.ry
|
||||
Case 6
|
||||
S = "RZ: " & js.rz
|
||||
Case 7
|
||||
S = "Slider0: " & js.slider(0)
|
||||
Case 8
|
||||
S = "Slider1: " & js.slider(1)
|
||||
|
||||
End Select
|
||||
lstJoyAxis.List(ListPos) = S
|
||||
ListPos = ListPos + 1
|
||||
|
||||
End If
|
||||
Next
|
||||
|
||||
' Buttons
|
||||
|
||||
For i = 0 To joyCaps.lButtons - 1
|
||||
Select Case js.Buttons(i)
|
||||
Case 0
|
||||
lstButton.List(i) = "Button " + CStr(i + 1) + ": Up"
|
||||
|
||||
Case Else
|
||||
lstButton.List(i) = "Button " + CStr(i + 1) + ": Down"
|
||||
|
||||
End Select
|
||||
Next
|
||||
|
||||
' Hats
|
||||
For i = 0 To joyCaps.lPOVs - 1
|
||||
lstHat.List(i) = "POV " + CStr(i + 1) + ": " + CStr(js.POV(i))
|
||||
Next
|
||||
|
||||
Me.Caption = "Joystick Sample: Available"
|
||||
|
||||
Exit Sub
|
||||
|
||||
err_out:
|
||||
MsgBox Err.Description & " : " & Err.Number, vbApplicationModal
|
||||
End
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
Private Sub Form_Load()
|
||||
running = True
|
||||
InitDirectInput
|
||||
End Sub
|
||||
|
||||
|
||||
Private Sub Form_Unload(cancel As Integer)
|
||||
On Local Error Resume Next
|
||||
If EventHandle <> 0 Then dx.DestroyEvent EventHandle
|
||||
|
||||
running = False
|
||||
|
||||
'Unacquire if we are holding a device
|
||||
If Not diDev Is Nothing Then
|
||||
diDev.Unacquire
|
||||
End If
|
||||
|
||||
DoEvents
|
||||
End
|
||||
End Sub
|
||||
|
||||
Private Sub lstJoySticks_Click()
|
||||
|
||||
|
||||
On Local Error Resume Next
|
||||
|
||||
Call CLRLISTS
|
||||
|
||||
|
||||
'Unacquire the current device
|
||||
'if we are holding a device
|
||||
If Not diDev Is Nothing Then
|
||||
diDev.Unacquire
|
||||
End If
|
||||
|
||||
'Create the joystick device
|
||||
Set diDev = Nothing
|
||||
Set diDev = di.CreateDevice(diDevEnum.GetItem(lstJoySticks.ListIndex + 1).GetGuidInstance)
|
||||
diDev.SetCommonDataFormat DIFORMAT_JOYSTICK
|
||||
diDev.SetCooperativeLevel Me.hWnd, DISCL_BACKGROUND Or DISCL_NONEXCLUSIVE
|
||||
|
||||
' Find out what device objects it has
|
||||
diDev.GetCapabilities joyCaps
|
||||
Call IdentifyAxes(diDev)
|
||||
|
||||
' Ask for notification of events
|
||||
Call diDev.SetEventNotification(EventHandle)
|
||||
|
||||
' Set deadzone for X and Y axis to 10 percent of the range of travel
|
||||
With DiProp_Dead
|
||||
.lData = 1000
|
||||
.lHow = DIPH_BYOFFSET
|
||||
|
||||
.lObj = DIJOFS_X
|
||||
diDev.SetProperty "DIPROP_DEADZONE", DiProp_Dead
|
||||
|
||||
.lObj = DIJOFS_Y
|
||||
diDev.SetProperty "DIPROP_DEADZONE", DiProp_Dead
|
||||
|
||||
End With
|
||||
|
||||
' Set saturation zones for X and Y axis to 5 percent of the range
|
||||
With DiProp_Saturation
|
||||
.lData = 9500
|
||||
.lHow = DIPH_BYOFFSET
|
||||
|
||||
.lObj = DIJOFS_X
|
||||
diDev.SetProperty "DIPROP_SATURATION", DiProp_Saturation
|
||||
|
||||
.lObj = DIJOFS_Y
|
||||
diDev.SetProperty "DIPROP_SATURATION", DiProp_Saturation
|
||||
|
||||
End With
|
||||
|
||||
SetPropRange
|
||||
|
||||
|
||||
diDev.Acquire
|
||||
Me.Caption = "Joystick Sample: Querying Properties"
|
||||
|
||||
' Get the list of current properties
|
||||
' USB joysticks wont call this callback until you play with the joystick
|
||||
' so we call the callback ourselves the first time
|
||||
DirectXEvent8_DXCallback 0
|
||||
|
||||
' Poll the device so that events are sure to be signaled.
|
||||
' Usually this would be done in Sub Main or in the game rendering loop.
|
||||
|
||||
While running = True
|
||||
DoEvents
|
||||
diDev.Poll
|
||||
Wend
|
||||
End Sub
|
||||
|
||||
Sub SetPropRange()
|
||||
' NOTE Some devices do not let you set the range
|
||||
On Local Error Resume Next
|
||||
|
||||
' Set range for all axes
|
||||
With DiProp_Range
|
||||
.lHow = DIPH_DEVICE
|
||||
.lMin = 0
|
||||
.lMax = 10000
|
||||
End With
|
||||
diDev.SetProperty "DIPROP_RANGE", DiProp_Range
|
||||
End Sub
|
||||
|
||||
Sub CLRLISTS()
|
||||
lstJoyAxis.Clear
|
||||
lstButton.Clear
|
||||
lstHat.Clear
|
||||
End Sub
|
||||
|
||||
Sub IdentifyAxes(diDev As DirectInputDevice8)
|
||||
|
||||
' It's not enough to count axes; we need to know which in particular
|
||||
' are present.
|
||||
|
||||
Dim didoEnum As DirectInputEnumDeviceObjects
|
||||
Dim dido As DirectInputDeviceObjectInstance
|
||||
Dim i As Integer
|
||||
|
||||
For i = 1 To 8
|
||||
AxisPresent(i) = False
|
||||
Next
|
||||
|
||||
' Enumerate the axes
|
||||
Set didoEnum = diDev.GetDeviceObjectsEnum(DIDFT_AXIS)
|
||||
|
||||
' Check data offset of each axis to learn what it is
|
||||
Dim sGuid As String
|
||||
For i = 1 To didoEnum.GetCount
|
||||
|
||||
Set dido = didoEnum.GetItem(i)
|
||||
|
||||
sGuid = dido.GetGuidType
|
||||
Select Case sGuid
|
||||
Case "GUID_XAxis"
|
||||
AxisPresent(1) = True
|
||||
Case "GUID_YAxis"
|
||||
AxisPresent(2) = True
|
||||
Case "GUID_ZAxis"
|
||||
AxisPresent(3) = True
|
||||
Case "GUID_RxAxis"
|
||||
AxisPresent(4) = True
|
||||
Case "GUID_RyAxis"
|
||||
AxisPresent(5) = True
|
||||
Case "GUID_RzAxis"
|
||||
AxisPresent(6) = True
|
||||
Case "GUID_Slider"
|
||||
AxisPresent(8) = True
|
||||
AxisPresent(7) = True
|
||||
End Select
|
||||
|
||||
Next
|
||||
End Sub
|
||||
|
||||
|
||||
Binary file not shown.
@@ -0,0 +1,34 @@
|
||||
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=frmMain.frm
|
||||
Startup="frmMain"
|
||||
ExeName32="vb_joystick.exe"
|
||||
Command32=""
|
||||
Name="Project1"
|
||||
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
|
||||
|
||||
[MS Transaction Server]
|
||||
AutoRefresh=1
|
||||
@@ -0,0 +1,29 @@
|
||||
//-----------------------------------------------------------------------------
|
||||
// Name: Joystick DirectInput Sample
|
||||
//
|
||||
// Copyright (C) 1999-2001 Microsoft Corporation. All rights reserved.
|
||||
//-----------------------------------------------------------------------------
|
||||
|
||||
|
||||
Description
|
||||
===========
|
||||
The Joystick sample illustrates the use of DirectInput to poll for joystick position
|
||||
and button information.
|
||||
|
||||
|
||||
Path
|
||||
====
|
||||
Source: DXSDK\Samples\Multimedia\Vbsamples\DirectInput\Joystick
|
||||
Executable: DXSDK\Samples\Multimedia\vbsamples\DirectInput\Bin
|
||||
|
||||
|
||||
User's Guide
|
||||
============
|
||||
Observe how the displayed data changes when you move and twist the stick,
|
||||
rotate the throttle wheel, and press buttons in various combinations.
|
||||
|
||||
|
||||
Programming Notes
|
||||
=================
|
||||
The application retrieves joystick input via a DirectXEvent8 callback.
|
||||
|
||||
Binary file not shown.
|
After Width: | Height: | Size: 1.1 KiB |
@@ -0,0 +1,247 @@
|
||||
VERSION 5.00
|
||||
Begin VB.Form frmMain
|
||||
BorderStyle = 1 'Fixed Single
|
||||
Caption = "DirectInput Keyboard Sample"
|
||||
ClientHeight = 3435
|
||||
ClientLeft = 45
|
||||
ClientTop = 330
|
||||
ClientWidth = 5880
|
||||
Icon = "frmMain.frx":0000
|
||||
LinkTopic = "Form1"
|
||||
MaxButton = 0 'False
|
||||
MinButton = 0 'False
|
||||
ScaleHeight = 3435
|
||||
ScaleWidth = 5880
|
||||
StartUpPosition = 3 'Windows Default
|
||||
Begin VB.Timer tmrKey
|
||||
Left = 0
|
||||
Top = 0
|
||||
End
|
||||
Begin VB.ListBox lstKeys
|
||||
Height = 2595
|
||||
Left = 120
|
||||
TabIndex = 0
|
||||
Top = 360
|
||||
Width = 5655
|
||||
End
|
||||
End
|
||||
Attribute VB_Name = "frmMain"
|
||||
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: FrmMain.frm
|
||||
' Content: This sample will show one way to use DirectInput with the keyboard
|
||||
'
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
|
||||
Dim dx As New DirectX8
|
||||
Dim di As DirectInput8
|
||||
Dim diDEV As DirectInputDevice8
|
||||
Dim diState As DIKEYBOARDSTATE
|
||||
Dim iKeyCounter As Integer
|
||||
Dim aKeys(255) As String
|
||||
|
||||
|
||||
Private Sub Form_Load()
|
||||
|
||||
Set di = dx.DirectInputCreate()
|
||||
|
||||
If Err.Number <> 0 Then
|
||||
MsgBox "Error starting Direct Input, please make sure you have DirectX installed", vbApplicationModal
|
||||
End
|
||||
End If
|
||||
|
||||
|
||||
Set diDEV = di.CreateDevice("GUID_SysKeyboard")
|
||||
|
||||
diDEV.SetCommonDataFormat DIFORMAT_KEYBOARD
|
||||
diDEV.SetCooperativeLevel Me.hWnd, DISCL_BACKGROUND Or DISCL_NONEXCLUSIVE
|
||||
|
||||
Me.Show
|
||||
|
||||
diDEV.Acquire
|
||||
|
||||
tmrKey.Interval = 10
|
||||
tmrKey.Enabled = True
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub Form_Unload(Cancel As Integer)
|
||||
diDEV.Unacquire
|
||||
End Sub
|
||||
|
||||
Private Sub tmrKey_Timer()
|
||||
lstKeys.Clear
|
||||
|
||||
diDEV.GetDeviceStateKeyboard diState
|
||||
|
||||
For iKeyCounter = 0 To 255
|
||||
If diState.Key(iKeyCounter) <> 0 Then
|
||||
lstKeys.AddItem KeyNames(iKeyCounter)
|
||||
End If
|
||||
Next
|
||||
DoEvents
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
Function KeyNames(iNum As Integer) As String
|
||||
|
||||
aKeys(&H1) = "DIK_ESCAPE"
|
||||
aKeys(&H2) = "DIK_1"
|
||||
aKeys(&H3) = "DIK_2"
|
||||
aKeys(&H4) = "DIK_3"
|
||||
aKeys(&H5) = "DIK_4"
|
||||
aKeys(&H6) = "DIK_5"
|
||||
aKeys(&H7) = "DIK_6"
|
||||
aKeys(&H8) = "DIK_7"
|
||||
aKeys(&H9) = "DIK_8"
|
||||
aKeys(&HA) = "DIK_9"
|
||||
aKeys(&HB) = "DIK_0"
|
||||
aKeys(&HC) = "DIK_MINUS" ' - on main keyboard
|
||||
aKeys(&HD) = "DIK_EQUALS"
|
||||
aKeys(&HE) = "DIK_BACK" ' backspace
|
||||
aKeys(&HF) = "DIK_TAB"
|
||||
aKeys(&H10) = "DIK_Q"
|
||||
aKeys(&H11) = "DIK_W"
|
||||
aKeys(&H12) = "DIK_E"
|
||||
aKeys(&H13) = "DIK_R"
|
||||
aKeys(&H14) = "DIK_T"
|
||||
aKeys(&H15) = "DIK_Y"
|
||||
aKeys(&H16) = "DIK_U"
|
||||
aKeys(&H17) = "DIK_I"
|
||||
aKeys(&H18) = "DIK_O"
|
||||
aKeys(&H19) = "DIK_P"
|
||||
aKeys(&H1A) = "DIK_LBRACKET"
|
||||
aKeys(&H1B) = "DIK_RBRACKET"
|
||||
aKeys(&H1C) = "DIK_RETURN" ' Enter on main keyboard
|
||||
aKeys(&H1D) = "DIK_LCONTROL"
|
||||
aKeys(&H1E) = "DIK_A"
|
||||
aKeys(&H1F) = "DIK_S"
|
||||
aKeys(&H20) = "DIK_D"
|
||||
aKeys(&H21) = "DIK_F"
|
||||
aKeys(&H22) = "DIK_G"
|
||||
aKeys(&H23) = "DIK_H"
|
||||
aKeys(&H24) = "DIK_J"
|
||||
aKeys(&H25) = "DIK_K"
|
||||
aKeys(&H26) = "DIK_L"
|
||||
aKeys(&H27) = "DIK_SEMICOLON"
|
||||
aKeys(&H28) = "DIK_APOSTROPHE"
|
||||
aKeys(&H29) = "DIK_GRAVE" ' accent grave
|
||||
aKeys(&H2A) = "DIK_LSHIFT"
|
||||
aKeys(&H2B) = "DIK_BACKSLASH"
|
||||
aKeys(&H2C) = "DIK_Z"
|
||||
aKeys(&H2D) = "DIK_X"
|
||||
aKeys(&H2E) = "DIK_C"
|
||||
aKeys(&H2F) = "DIK_V"
|
||||
aKeys(&H30) = "DIK_B"
|
||||
aKeys(&H31) = "DIK_N"
|
||||
aKeys(&H32) = "DIK_M"
|
||||
aKeys(&H33) = "DIK_COMMA"
|
||||
aKeys(&H34) = "DIK_PERIOD" ' . on main keyboard
|
||||
aKeys(&H35) = "DIK_SLASH" ' / on main keyboard
|
||||
aKeys(&H36) = "DIK_RSHIFT"
|
||||
aKeys(&H37) = "DIK_MULTIPLY" ' * on numeric keypad
|
||||
aKeys(&H38) = "DIK_LMENU" ' left Alt
|
||||
aKeys(&H39) = "DIK_SPACE"
|
||||
aKeys(&H3A) = "DIK_CAPITAL"
|
||||
aKeys(&H3B) = "DIK_F1"
|
||||
aKeys(&H3C) = "DIK_F2"
|
||||
aKeys(&H3D) = "DIK_F3"
|
||||
aKeys(&H3E) = "DIK_F4"
|
||||
aKeys(&H3F) = "DIK_F5"
|
||||
aKeys(&H40) = "DIK_F6"
|
||||
aKeys(&H41) = "DIK_F7"
|
||||
aKeys(&H42) = "DIK_F8"
|
||||
aKeys(&H43) = "DIK_F9"
|
||||
aKeys(&H44) = "DIK_F10"
|
||||
aKeys(&H45) = "DIK_NUMLOCK"
|
||||
aKeys(&H46) = "DIK_SCROLL" ' Scroll Lock
|
||||
aKeys(&H47) = "DIK_NUMPAD7"
|
||||
aKeys(&H48) = "DIK_NUMPAD8"
|
||||
aKeys(&H49) = "DIK_NUMPAD9"
|
||||
aKeys(&H4A) = "DIK_SUBTRACT" ' - on numeric keypad
|
||||
aKeys(&H4B) = "DIK_NUMPAD4"
|
||||
aKeys(&H4C) = "DIK_NUMPAD5"
|
||||
aKeys(&H4D) = "DIK_NUMPAD6"
|
||||
aKeys(&H4E) = "DIK_ADD" ' + on numeric keypad
|
||||
aKeys(&H4F) = "DIK_NUMPAD1"
|
||||
aKeys(&H50) = "DIK_NUMPAD2"
|
||||
aKeys(&H51) = "DIK_NUMPAD3"
|
||||
aKeys(&H52) = "DIK_NUMPAD0"
|
||||
aKeys(&H53) = "DIK_DECIMAL" ' . on numeric keypad
|
||||
aKeys(&H56) = "DIK_OEM_102 < > | on UK/Germany keyboards"
|
||||
aKeys(&H57) = "DIK_F11"
|
||||
aKeys(&H58) = "DIK_F12"
|
||||
aKeys(&H64) = "DIK_F13 on (NEC PC98) "
|
||||
aKeys(&H65) = "DIK_F14 on (NEC PC98) "
|
||||
aKeys(&H66) = "DIK_F15 on (NEC PC98) "
|
||||
aKeys(&H70) = "DIK_KANA on (Japanese keyboard)"
|
||||
aKeys(&H73) = "DIK_ABNT_C1 / ? on Portugese (Brazilian) keyboards "
|
||||
aKeys(&H79) = "DIK_CONVERT on (Japanese keyboard)"
|
||||
aKeys(&H7B) = "DIK_NOCONVERT on (Japanese keyboard)"
|
||||
aKeys(&H7D) = "DIK_YEN on (Japanese keyboard)"
|
||||
aKeys(&H7E) = "DIK_ABNT_C2 on Numpad . on Portugese (Brazilian) keyboards "
|
||||
aKeys(&H8D) = "DIK_NUMPADEQUALS = on numeric keypad (NEC PC98) "
|
||||
aKeys(&H90) = "DIK_PREVTRACK on Previous Track (DIK_CIRCUMFLEX on Japanese keyboard) "
|
||||
aKeys(&H91) = "DIK_AT (NEC PC98) "
|
||||
aKeys(&H92) = "DIK_COLON (NEC PC98) "
|
||||
aKeys(&H93) = "DIK_UNDERLINE (NEC PC98) "
|
||||
aKeys(&H94) = "DIK_KANJI on (Japanese keyboard)"
|
||||
aKeys(&H95) = "DIK_STOP (NEC PC98) "
|
||||
aKeys(&H96) = "DIK_AX (Japan AX) "
|
||||
aKeys(&H97) = "DIK_UNLABELED (J3100) "
|
||||
aKeys(&H99) = "DIK_NEXTTRACK" ' Next Track
|
||||
aKeys(&H9C) = "DIK_NUMPADENTER" ' Enter on numeric keypad
|
||||
aKeys(&H9D) = "DIK_RCONTROL"
|
||||
aKeys(&HA0) = "DIK_MUTE" ' Mute
|
||||
aKeys(&HA1) = "DIK_CALCULATOR" ' Calculator
|
||||
aKeys(&HA2) = "DIK_PLAYPAUSE" ' Play / Pause
|
||||
aKeys(&HA4) = "DIK_MEDIASTOP" ' Media Stop
|
||||
aKeys(&HAE) = "DIK_VOLUMEDOWN" ' Volume -
|
||||
aKeys(&HB0) = "DIK_VOLUMEUP" ' Volume +
|
||||
aKeys(&HB2) = "DIK_WEBHOME" ' Web home
|
||||
aKeys(&HB3) = "DIK_NUMPADCOMMA" ' , on numeric keypad (NEC PC98)
|
||||
aKeys(&HB5) = "DIK_DIVIDE" ' / on numeric keypad
|
||||
aKeys(&HB7) = "DIK_SYSRQ"
|
||||
aKeys(&HB8) = "DIK_RMENU" ' right Alt
|
||||
aKeys(&HC5) = "DIK_PAUSE" ' Pause
|
||||
aKeys(&HC7) = "DIK_HOME" ' Home on arrow keypad
|
||||
aKeys(&HC8) = "DIK_UP" ' UpArrow on arrow keypad
|
||||
aKeys(&HC9) = "DIK_PRIOR" ' PgUp on arrow keypad
|
||||
aKeys(&HCB) = "DIK_LEFT" ' LeftArrow on arrow keypad
|
||||
aKeys(&HCD) = "DIK_RIGHT" ' RightArrow on arrow keypad
|
||||
aKeys(&HCF) = "DIK_END" ' End on arrow keypad
|
||||
aKeys(&HD0) = "DIK_DOWN" ' DownArrow on arrow keypad
|
||||
aKeys(&HD1) = "DIK_NEXT" ' PgDn on arrow keypad
|
||||
aKeys(&HD2) = "DIK_INSERT" ' Insert on arrow keypad
|
||||
aKeys(&HD3) = "DIK_DELETE" ' Delete on arrow keypad
|
||||
aKeys(&HDB) = "DIK_LWIN" ' Left Windows key
|
||||
aKeys(&HDC) = "DIK_RWIN" ' Right Windows key
|
||||
aKeys(&HDD) = "DIK_APPS" ' AppMenu key
|
||||
aKeys(&HDE) = "DIK_POWER" ' System Power
|
||||
aKeys(&HDF) = "DIK_SLEEP" ' System Sleep
|
||||
aKeys(&HE3) = "DIK_WAKE" ' System Wake
|
||||
aKeys(&HE5) = "DIK_WEBSEARCH" ' Web Search
|
||||
aKeys(&HE6) = "DIK_WEBFAVORITES" ' Web Favorites
|
||||
aKeys(&HE7) = "DIK_WEBREFRESH" ' Web Refresh
|
||||
aKeys(&HE8) = "DIK_WEBSTOP" ' Web Stop
|
||||
aKeys(&HE9) = "DIK_WEBFORWARD" ' Web Forward
|
||||
aKeys(&HEA) = "DIK_WEBBACK" ' Web Back
|
||||
aKeys(&HEB) = "DIK_MYCOMPUTER" ' My Computer
|
||||
aKeys(&HEC) = "DIK_MAIL" ' Mail
|
||||
aKeys(&HED) = "DIK_MEDIASELECT" ' Media Select
|
||||
|
||||
KeyNames = aKeys(iNum)
|
||||
|
||||
End Function
|
||||
|
||||
Binary file not shown.
@@ -0,0 +1,34 @@
|
||||
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=frmMain.frm
|
||||
Startup="frmMain"
|
||||
ExeName32="vb_KeyBoard.exe"
|
||||
Command32=""
|
||||
Name="Project1"
|
||||
HelpContextID="0"
|
||||
CompatibleMode="0"
|
||||
MajorVer=1
|
||||
MinorVer=0
|
||||
RevisionVer=0
|
||||
AutoIncrementVer=0
|
||||
ServerSupportFiles=0
|
||||
VersionCompanyName="msft"
|
||||
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
|
||||
|
||||
[MS Transaction Server]
|
||||
AutoRefresh=1
|
||||
@@ -0,0 +1,27 @@
|
||||
//-----------------------------------------------------------------------------
|
||||
// Name: Keyboard DirectInput Sample
|
||||
//
|
||||
// Copyright (C) 1999-2001 Microsoft Corporation. All rights reserved.
|
||||
//-----------------------------------------------------------------------------
|
||||
|
||||
|
||||
Description
|
||||
===========
|
||||
The Keyboard sample illustrates the use of DirectInput to poll for keyboard state.
|
||||
|
||||
|
||||
Path
|
||||
====
|
||||
Source: DXSDK\Samples\Multimedia\Vbsamples\DirectInput\Keyboard
|
||||
Executable: DXSDK\Samples\Multimedia\vbsamples\DirectInput\Bin
|
||||
|
||||
|
||||
User's Guide
|
||||
============
|
||||
Press any series of keys while the application has focus and they will show up
|
||||
in the list box.
|
||||
|
||||
|
||||
Programming Notes
|
||||
=================
|
||||
None
|
||||
@@ -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