Results 1 to 4 of 4

Thread: Program gets stuck

Threaded View

  1. #1

    Thread Starter
    New Member
    Join Date
    Feb 2010
    Posts
    2

    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
  •  



Click Here to Expand Forum to Full Width