Sv:Varför 99% av mina systemresurser när jag läser av gamepaden?

Varför 99% av mina systemresurser när jag läser av gamepaden?

Postades av 2007-01-23 20:55:34 - Christer Lundqvist, i forum activeX, Tråden har 2 Kommentarer och lästs av 2690 personer

Jag knappar på ett program som läser av en gamepad med ActiveX. Det enda jag behöver (just nu iallafall) är att VB6 ska reagera när jag trycker på knapparna.
Det funkar som jag vill nu (en label räknat upp +1 vid varje tryck), förutom att den enkla grejen tar 99% av datorns processorkraft, hela tiden. Efter att cmdStep2_Click() klickas börjar det... (den + cmdstep1... aktiverar gamepaden)

Det gör det oanvändbart.

Jag har utgått från ett exempel (som även i original kräver lika mycket) så jag får väl erkänna att jag inte har full koll på vad som händer.

Bifogar koden här nedan om någon har några bra tips. Jag är minst lika tacksam för en alternativ lösning :)

Den är lite lång, men vet man vad som kan vara problemet så hoppas jag man bara behöver skumma igenom det mesta.

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

217

218

219

220

221

222

223

224

225

226

227

228

229

230

231

232

233

234

235

236

237

238

239

240

241

242

243

244

245

246

247

248

249

250

251

252

253

254

255

256

257

258

259

260

261

262

263

264

265

266

267

268

269

270

271

272

273

274

275

276

277

278

279

280

281

282

283

284

285

286

287

288

289

290

291

292

293

294

295

296

297

298

299

300

301

302

303

304

305

306

307

308

309

310

311

312

313

314

315

316

317

318

319

320

321

322

323

324

325

326

327

328

329

330

331

332

333

334

335

336

337

338

339

340

341

342

343

344

345

346

347

348

349

350

351

352

353

354

355

356

357

358

359

360

361

362

363

364

365

366

367

368

369

370

371

372

373

374

375

Option Explicit
'The DirectXEvent tells us when stuff's happened
Implements DirectXEvent
 
'The root DirectX object; everything comes
'from here
Dim dx As New DirectX7
'The root DirectInput driver
Dim di As DirectInput
'This device will represent the joystick hardware
Dim diDev As DirectInputDevice
'This lets us count the available devices
Dim diDevEnum As DirectInputEnumDevices
Dim EventHandle As Long
Dim joyCaps As DIDEVCAPS
'js holds information ont he status
'of the joystick - Coordinates; buttons etc...
Dim js As DIJOYSTATE
'This is for the DeadZone
Dim DiProp_Dead As DIPROPLONG
'This sets the numbers that we use for our coordinates.
Dim DiProp_Range As DIPROPRANGE
'Saturation is where a value is automatically maxed
'above a certain point.
'if the scale were 1-100, and the saturation was
'90; any value above 89 would automatically be made 100
Dim DiProp_Saturation As DIPROPLONG
'Internal variables that we can access to tell if an axis is present
Dim AxisPresent(1 To 8) As Boolean
Dim running As Boolean
 
' *************** Nedan mina egna grejor********************
Dim TenSec As Integer  'spara varje 10 sek för framräkning av medelvärde
Dim OneMinute As Integer 'spara varje minut
Dim OneHour As Integer 'spara varje timme
 
 
Sub InitDirectInput()
     
    Set di = dx.DirectInputCreate()
    'Because DirectInput Enumerations contain information on lots of different
    'devices we must specify what we're looking for - in this case we want a
    'Joystick. We also want to make sure it's attached to the system. Without
    'this flag, DI may detect a set of joystick drivers; and report that there is
    'a joystick - even when it's not actually present.
    Set diDevEnum = di.GetDIEnumDevices(DIDEVTYPE_JOYSTICK, DIEDFL_ATTACHEDONLY)
    'Warn the user that there is no joystick present.
    If diDevEnum.GetCount = 0 Then
      MsgBox "No joystick attached."
      'There is no point continuing if there is
      'no joystick
      Unload Me
    End If
     
    'This is the enumeration; we've got this far
    'so we know there is at least one. For the purpose of
    'this tutorial we'll only bother using the default (first) device
    Dim i As Integer
    For i = 1 To diDevEnum.GetCount
        'There may well only be 1
        Call lstJoySticks.AddItem(diDevEnum.GetItem(i).GetInstanceName)
    Next
     
    ' Get an event handle to associate with the device
    EventHandle = dx.CreateEvent(Me)
    Exit Sub
     
'Something went wrong - there are several error flags
'that can be used to detect what the error problem was...
Error_Out:
    MsgBox "Error initializing DirectInput."
    Unload Me
     
End Sub
 
 
Private Sub cmdStep1_Click()
    'This is used in a loop later...
    running = True
        
    Set di = dx.DirectInputCreate()
    'Because DirectInput Enumerations contain information on lots of different
    'devices we must specify what we're looking for - in this case we want a
    'Joystick. We also want to make sure it's attached to the system. Without
    'this flag, DI may detect a set of joystick drivers; and report that there is
    'a joystick - even when it's not actually present.
    Set diDevEnum = di.GetDIEnumDevices(DIDEVTYPE_JOYSTICK, DIEDFL_ATTACHEDONLY)
    'Warn the user that there is no joystick present.
    If diDevEnum.GetCount = 0 Then
      MsgBox "No joystick attached."
      'There is no point continuing if there is
      'no joystick
      Unload Me
    End If
     
    'This is the enumeration; we've got this far
    'so we know there is at least one. For the purpose of
    'this tutorial we'll only bother using the default (first) device
    Dim i As Integer
    i = 1
    For i = 1 To diDevEnum.GetCount
       ' There may well only be 1
      '  Call lstJoySticks.AddItem(diDevEnum.GetItem(i).GetInstanceName)
    Next
     
    ' Get an event handle to associate with the device
    EventHandle = dx.CreateEvent(Me)
     
    'Changing these buttons around allows the user
    'to progress to the next step.
    cmdStep2.Enabled = True
    cmdStep1.Enabled = False
     
    Exit Sub
     
'Something went wrong - there are several error flags
'that can be used to detect what the error problem was...
Error_Out:
    MsgBox "Error initializing DirectInput."
    Unload Me
End Sub
 
Private Sub cmdStep2_Click()
 
     
    On Local Error Resume Next
     
    'Create the joystick device
    Set diDev = Nothing
    'Get the 1st Joystick. You'll want to enumerate available
    'devices first...
    Set diDev = di.CreateDevice(diDevEnum.GetItem(1).GetGuidInstance)
    'Tell DirectInput we're interacting with a Joystick
    diDev.SetCommonDataFormat DIFORMAT_JOYSTICK
    'With the cooperativelevel set to NONEXCLUSIVE we're likely to lose the
    'joystick easier - setting this to Exclusive will make it more difficult
    'for windows or other applications to steal it from us.
    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
        .lObj = DIJOFS_X
        .lSize = Len(DiProp_Dead)
        .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
        .lSize = Len(DiProp_Saturation)
        .lObj = DIJOFS_X
         diDev.SetProperty "DIPROP_SATURATION", DiProp_Saturation
        .lObj = DIJOFS_Y
         diDev.SetProperty "DIPROP_SATURATION", DiProp_Saturation
    End With
     
    SetProp
     
     
    'Get the joystick
    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
    DirectXEvent_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
 
Private Sub DirectXEvent_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
    'i = 1
    'If we haven't initialised yet; go no further
    If diDev Is Nothing Then Exit Sub
         
    'Get the device info
    On Local Error Resume Next
    diDev.GetDeviceStateJoystick js
    'Js should now contain all the up-to-date information
    'on the joystick. Unless there was an error:
     
    'If we lost the joystick then we want to get it back again.
    If Err.Number = DIERR_NOTACQUIRED Or Err.Number = DIERR_INPUTLOST Then
        diDev.Acquire
        Exit Sub
    End If
       
        'A simple example of moving a dummy sprite
        'around based on input from the joystick
        Select Case js.x
            Case 0 'Full Left
                Shape1.Left = 0
            Case 5000 'Middle
                Shape1.Left = 1
            Case 10000 'Full Right
                Shape1.Left = 2
        End Select
         
        Select Case js.y
            Case 0 'Full up
                Shape1.Top = 0
            Case 5000 'Middle
                Shape1.Top = 1
            Case 10000 'Full down
                Shape1.Top = 2
        End Select
                     
                    
               'Use these properties to get the coordinates of other
               'axis; this example isn't interested in them though.
               'Remember to make sure that they exist before checking
               'them though.
               '    js.z
 
               '    js.rx
 
               '    js.ry
 
               '    js.rz
 
               '    js.slider(0)
 
               '    js.slider(1)
       
       
    'For the next set of information you'll need to create two
    'standard Listboxes; lstButtons and lstHats.
     
    'If you're interested in the buttons; uncomment this
    'code:
    For i = 0 To joyCaps.lButtons - 1
        Select Case js.buttons(i)
      Case 0 '
           ' lstButton.List(i) = "Button " + CStr(i + 1) + ": av"
             
   
            
            'Label1.Caption = "av"
             
     
        Case Else  'knapp sluten
           ' lstButton.List(i) = "Button " + CStr(i + 1) + ": Down"
             
             
             
     If js.buttons(0) Then
            Label1.Caption = Label1.Caption + 1
     End If
      
             
             
     
        End Select
         
         
         
         
    Next
         
    'This is how to get at the Hats on a joystick
    'But this example is not interested in them
    'For i = 0 To joyCaps.lPOVs - 1
    '    lstHat.List(i) = "POV " + CStr(i + 1) + ": " + CStr(js.POV(i))
    'Next
 
    Exit Sub
     
err_out:
    'Replace this in a normal application; the chances are that
    'this message box will say "Automation Error : -20880808" (or similiar)
    'the user is not going to know what this is....
    MsgBox Err.Description & " : " & Err.Number, vbApplicationModal
    End
 
End Sub
 
Private Sub Form_Unload(cancel As Integer)
        Me.Caption = "Unloading..."
        DoEvents
        If EventHandle <> 0 Then dx.DestroyEvent EventHandle
        running = False
        DoEvents
        End
End Sub
 
Sub SetProp()
    ' Set range for all axes
    With DiProp_Range
        .lHow = DIPH_DEVICE
        .lSize = Len(DiProp_Range)
        'When the joystick is centered it will
        'be half way between these two values,
        'in this case; 5000
        .lMin = 0
        .lMax = 10000
        'Should you want to have a calibrate facility
        'you could use this...
    End With
    'Apply the property to DirectInput
    diDev.SetProperty "DIPROP_RANGE", DiProp_Range
End Sub
 
 
 
Sub IdentifyAxes(diDev As DirectInputDevice)
'Call this procedure if you want to know more about the axis.....
 
    'For safe usage we not only want to know how
    'many axis are present; but which axis are present.
    
   Dim didoEnum As DirectInputEnumDeviceObjects
   Dim dido As DirectInputDeviceObjectInstance
   Dim i As Integer
    
   For i = 1 To 8
     'By default we'll assume no axis is present
     AxisPresent(i) = False
     'then we'll set the balue to true if we detect one:
   Next
    
   ' Enumerate the axes by telling DirectInput we only
   'want it to list the available axis
   Set didoEnum = diDev.GetDeviceObjectsEnum(DIDFT_AXIS)
    
   ' Check data offset of each axis to learn what it is
    
   For i = 1 To didoEnum.GetCount
     Set dido = didoEnum.GetItem(i)
         Select Case dido.GetOfs
            'These are the two normal ones
            Case DIJOFS_X
              AxisPresent(1) = True
            Case DIJOFS_Y
              AxisPresent(2) = True
            'These lot are the diagonals
            Case DIJOFS_Z
              AxisPresent(3) = True
            Case DIJOFS_RX
              AxisPresent(4) = True
            Case DIJOFS_RY
              AxisPresent(5) = True
            Case DIJOFS_RZ
              AxisPresent(6) = True
            Case DIJOFS_SLIDER0
              AxisPresent(7) = True
            Case DIJOFS_SLIDER1
              AxisPresent(8) = True
         End Select
  
   Next
End Sub

Svara