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!

stuck

Could it possibly be a focus issue?

I briefly looked over your code, so I can't say for sure, but
since your KeyUp event is form-based, it might not respond
if, say, focus is on another control such as an Image or PictureBox.

You'd need a KeyUp sub for that control as well -- or you could make
sure that the focus is always returned to the form.

Spoo

Just a thought, but you may consider adding DoEvents to your loops, at least until you've resolved this.

Just a thought: May be setting the KeyPreview property of the Form to TRUE, might help you. ....:wave: