|
-
Apr 25th, 2010, 08:17 AM
#1
Thread Starter
New Member
Program gets stuck
Hi,
My project involves loading a series of randomly genenerated line images, which are changed through a keystroke. When I run the project it loads the first image, and then gets stuck. It wont respond to keystrokes to move the project on to the next image. Any ideas?
Code:
Code:
Option Explicit
Private Sub Form_Load()
Randomize
Call InitialiseFD
End Sub
'Need to use KeyUp instead of KeyPressed, as the arrow keys do not work.
Private Sub Form_KeyUp(KeyAscii As Integer, shift As Integer) 'escapes program
Dim dbg_msg As String
Dim print_msg As String
If KeyAscii = vbKeyEscape Then
ShowCursor True
End
ElseIf WaitResponse Then
WaitResponse = False
If KeyAscii = vbKeyDown Then
print_msg = "KeyDown "
If LeftSide Then
print_msg = print_msg & ", Bottom "
' it was correct
MyThreshold.response (True)
Else
print_msg = print_msg & ", Top"
MyThreshold.response (False)
End If
ElseIf KeyAscii = vbKeyUp Then
print_msg = "KeyUP"
If Not LeftSide Then
print_msg = print_msg & ", Top"
MyThreshold.response (True)
' it was correct
Else
print_msg = print_msg & ", Bottom "
MyThreshold.response (False)
End If
End If
Call MyThreshold.dbg(dbg_msg)
print_msg = print_msg & ", Cont:, " & Str(Contrast)
ntrials = ntrials + 1
SetUpTrial
Print #1, print_msg & ", " & dbg_msg ' Print Output to file
Contrast = MyThreshold.nextval()
If MyThreshold.finished() Then
ShowCursor True
Print #1, "Finished - Threshold: " & Contrast
Close #1
Unload frmFD
Call MsgBox(dbg_msg, , "Result")
End
End If
End If 'WaitResponse
End Sub
Private Sub InitialiseFD()
' open the logfile
Open filename For Output As #1
'Initialise the threshold
Set MyThreshold = New LogMOBSThreshold
Call MyThreshold.Initialise(0, 128, 6, 0.05)
'Set the Surface
Set objDD = objDX.DirectDrawCreate("") 'Initialize DirectDraw
objDD.SetCooperativeLevel frmFD.hWnd, DDSCL_FULLSCREEN Or DDSCL_EXCLUSIVE Or DDSCL_ALLOWREBOOT 'sets full screen
objDD.SetDisplayMode 1024, 768, 32, 0, DDSDM_STANDARDVGAMODE 'Set the video mode 1024x768x32
'Set Primary Surface (do this for every surface that you want to use)
Dim ddsd As DDSURFACEDESC2
ddsd.lFlags = DDSD_CAPS Or DDSD_BACKBUFFERCOUNT
ddsd.DDSCAPS.lCaps = DDSCAPS_PRIMARYSURFACE Or DDSCAPS_FLIP Or DDSCAPS_COMPLEX Or DDSCAPS_LOCALVIDMEM Or DDSCAPS_VIDEOMEMORY
ddsd.lBackBufferCount = 1
Set Primary = objDD.CreateSurface(ddsd)
'Set Back Buffer
Dim DDSCAPS As DDSCAPS2
DDSCAPS.lCaps = DDSCAPS_BACKBUFFER
Set BackBuffer = Primary.GetAttachedSurface(DDSCAPS)
'Set up the gratings
SetUpGrating 1, 0
SetUpGrating 2, 180
Contrast = 128 ' this is actually 0-128, but we will scale later.
SetUpTrial
ntrials = 0
End Sub
Private Sub FixCross()
' draw fixation cross in centre of the screen
BackBuffer.SetForeColor vbBlack
BackBuffer.DrawLine 506, 384, 519, 384
BackBuffer.DrawLine 512, 378, 512, 390
End Sub
Private Sub SetUpTrial()
' Decide whether the signal is going to be at the top or bottom
If Rnd(1) < 0.5 Then
LeftSide = True
Else
LeftSide = False
End If
FrameNum = 0
DelayFrames = 0
WaitResponse = False
RefreshCount = 0
frmFD.Refresh
End Sub
Private Sub DrawGrating(WhichGrating As Integer)
Dim i As Integer
Dim grayshade As Integer
Dim GratingCentreX As Integer
If LeftSide Then
GratingCentreX = Leftcentre
Else
GratingCentreX = RightCentre
End If
For i = 1 To GratingSize
'grayshade = Int(GratingShades(WhichGrating, i) * 128 * RampContrast / 100 + 128)
grayshade = Int(GratingShades(WhichGrating, i) * RampContrast + 128)
BackBuffer.SetForeColor RGB(grayshade, grayshade, grayshade)
BackBuffer.DrawLine GratingCentreX - GratingSize / 2 + i, GratingCentreY + GratingSize / 2, _
GratingCentreX - GratingSize / 2 + i, GratingCentreY - GratingSize / 2
Next i
End Sub
Private Sub Form_Paint()
Dim dbg_msg As String
Dim pos As String
' This can be the "GameLoop"
' Put all code in here to work out the next frame (on the backbuffer)
' always clear the backbuffer and make it grey
BackBuffer.BltColorFill DDRect(0, 0, 0, 0), RGB(128, 128, 128) 'Make BackBuffer Grey??
' Always draw the cross
FixCross
If DelayFrames < PreTrialDelay Then
DelayFrames = DelayFrames + 1
ElseIf FrameNum < StimTime Then
If RefreshCount = 0 Then
' If frames have all been presented, just do the flip to make sure
' screen is clear. We are waiting for a keypress.
' THe counter is reset by the keyboard event handler.
Ramping
FrameNum = FrameNum + 1
End If
DrawGrating (FrameNum Mod 2 + 1)
Else
WaitResponse = True
End If
If DEBUGGING Then
'Checking the Hertz
PrevCounter = Counter
QueryPerformanceCounter Counter
TimeDiff = Counter - PrevCounter
BackBuffer.SetForeColor (vbBlack)
BackBuffer.DrawText 0, 0, Str(Freq / TimeDiff) & "..." & Str(Contrast), True
'BackBuffer.DrawText 0, 0, Str(RampContrast), True
Call MyThreshold.dbg(dbg_msg)
If LeftSide Then
pos = " Top"
Else
pos = " Bottom"
End If
'BackBuffer.DrawText 20, 0, dbg_msg + pos, True
End If
' Always Flip on next refresh.
Primary.Flip Nothing, DDFLIP_WAIT
RefreshCount = (RefreshCount + 1) Mod RefreshPerFrame
' Then force it to call "Paint" again.
frmFD.Refresh
End Sub
Private Sub SetUpGrating(WhichGrating As Integer, phase As Double)
Dim rphase As Double
Dim radstep As Double
Dim i As Integer
rphase = phase * Pi / 180
radstep = 2 * Pi / FDperiod
For i = 0 To GratingSize
GratingShades(WhichGrating, i) = Sin(rphase)
rphase = rphase + radstep
Next i
End Sub
Private Sub Ramping()
If FrameNum < RampFrames Then
'This should produce a linear ramping function at the beginning of the trial.
RampContrast = Contrast * (FrameNum / RampFrames)
ElseIf FrameNum > StimTime - RampFrames Then
' and at the end...
RampContrast = Contrast * (StimTime - FrameNum) / RampFrames
Else
RampContrast = Contrast
End If
End Sub
Thanks for your help!
Last edited by si_the_geek; Apr 25th, 2010 at 08:24 AM.
Reason: added code tags
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|