Updated problematic code-removed a few typos but problem persisted

W

Wei Cheng

' Declarations
Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal
nIDEvent As Long, _
ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long

Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal
nIDEvent As Long) As Long
Private mlngTimerID As Long
'''''''''''''''''''''''''''''
Dim arrival(200) As Long
Dim getserv(200) As Long
Dim num As Long
Dim simultime As Long
Dim checktime As Long
Dim nextserv As Long
Dim st As Long 'Serve Time
Dim ar As Double 'arrival rate
'Dim keeprunning As Long 'run flag
Dim totaltime As Long
Dim upd As Long 'Speed
'''''''''''''''''''''''''''''

' Module code
Public Sub StartTimer(lngInterval As Long)
mlngTimerID = SetTimer(0, 0, lngInterval, AddressOf OnTimer)
End Sub

Public Sub StopTimer()
KillTimer 0, mlngTimerID
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


Private Sub init()
num = 0
simultime = 0
checktime = 0
nextserv = 0
st = 0
ar = 0
'keeprunning = 0
totaltime = 0
upd = 0
End Sub

Public Sub StartSimulation()
init

'keeprunning = 1
Slide1.btnStartSimulation.Visible = False
Slide1.btnStopSimulation.Visible = True
ar = CLng(Slide1.txtArrivalRate.Text)
st = CLng(Slide1.txtServeTime.Text)
upd = CLng(Slide1.txtSpeed.Text)

'start timer here
StartTimer (upd)
End Sub

Public Sub StopSimulation()
'killtimer here
KillTimer (mlngTimerID)
End Sub

Public Sub OnTimer(ByVal hwnd As Long, ByVal uMsg As Long, _
ByVal idEvent As Long, ByVal dwTime As Long)
On Error Resume Next
Dim rn As Double

checktime = checktime + 1
''output checktime here
rn = Rnd()

If (rn < ar) Then
num = num + 1 'add a new one into the queue
'show num here
arrival(num) = checktime * 1
If (nextserv > arrive(num)) Then
getserv(num) = nextserv + st
Else 'no wait
getserve(num) = arrival(num) + st
End If
nextserv = getserv(num)
totaltime = totaltime + nextserv - arrival(num)

'output average time
'output average wait
End If
waitcalc
If (num >= 200) Then
StopTimer
End If
End Sub

Private Sub waitcalc()
Dim chnum As Long
Dim waitval As Long
Dim valto As Long
Dim J As Long

chnum = 0
waitval = 0
J = num
Do While (J > 0)
If (getserv(J) > checktime) Then
waitval = waitval + 1
End If
J = J - 1
Loop
'output waitval
If (waitval > 0) Then
'show meet picture
If (waitval > 1) Then
valto = 10 - waitval
If (valto < 0) Then
valto = 0
End If
'display valto images
If valto > 0 Then
Slide1.Image2.Visible = True
Else
Slide1.Image2.Visible = False
End If
If valto > 1 Then
Slide1.Image3.Visible = True
Else
Slide1.Image3.Visible = False
End If
If valto > 2 Then
Slide1.Image4.Visible = True
Else
Slide1.Image2.Visible = False
End If
If valto > 3 Then
Slide1.Image5.Visible = True
Else
Slide1.Image5.Visible = False
End If
If valto > 4 Then
Slide1.Image6.Visible = True
Else
Slide1.Image6.Visible = False
End If
If valto > 5 Then
Slide1.Image7.Visible = True
Else
Slide1.Image7.Visible = False
End If
If valto > 6 Then
Slide1.Image8.Visible = True
Else
Slide1.Image8.Visible = False
End If
If valto > 7 Then
Slide1.Image9.Visible = True
Else
Slide1.Image9.Visible = False
End If
If valto > 8 Then
Slide1.Image10.Visible = True
Else
Slide1.Image10.Visible = False
End If
If valto > 9 Then
Slide1.Image11.Visible = True
Else
Slide1.Image11.Visible = False
End If
End If
End If
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top