S
Steve
I'm hoping someone can help me out. I'm a newbie to vb.net still.
I'm trying to convert the code below from VB6 to VB.NET. I'm not sure
of the best way to go. This is basically a simple application to do
scoring for a competition. I'm using an Access database and all of
this code happens "behind the scenes" when all of the scores have been
entered on another screen (that piece is done). If someone could help
me, I'd really be grateful... I'm not necessarily looking for someone
to re-write it all for me (but I wouldn't complain either - ha ha) -
but if I could get some ideas, it sure would be great...
Thanks!
Steve
Private Sub cmdAllDone_Click()
rsCompetition.FindFirst "[CompNum] = " & "'" & txtCompNum2 & "'"
If rsCompetition.NoMatch = True Then
MsgBox "Sorry, try again"
txtCompNum2.SetFocus
txtCompNum2.SelStart = 0
txtCompNum2.SelLength = Len(txtCompNum2)
End If
Call ComputePoints("TotalScoreA")
Call RankJudge("TotalScoreA", "RankA", "IrishPointsA")
Call ComputePoints("TotalScoreB")
Call RankJudge("TotalScoreB", "RankB", "IrishPointsB")
Call ComputePoints("TotalScoreC")
Call RankJudge("TotalScoreC", "RankC", "IrishPointsC")
ComputePlaces
PrintReport
End Sub
Private Sub ComputePoints(strt1 As String)
Dim strt3 As String
strt3 = "SELECT * " _
& "FROM Results WHERE " _
& "CompNum = " & "'" & txtCompNum2 _
& "' AND ScoreA1 > 0 " _
& "ORDER BY " & strt1 & " DESC"
Set rsSort = dbs.OpenRecordset(strt3)
End Sub
Private Sub RankJudge(strt1 As String, strt2 As String, strt3 As
String)
Dim tempScore As Single
Dim myTempScore As Single
Dim kounter As Integer
Dim tempPoints As Integer 'points from rsIrishPoints
Dim xxxRank As Integer
Dim tempRank As Integer 'Ranking by judge - includes possibility
for tie
Dim varBookmark As Variant
Dim varBookmarkB As Variant
Dim tieKntr As Integer
tempScore = 0
kounter = 0
tempRank = 0
With rsSort
.MoveFirst
Do Until .EOF
kounter = kounter + 1
tempScore = rsSort.Fields(strt1).Value
If (rsSort.Fields(strt1).Value > 0) Then
Call CheckForTies(tempScore, rsSort!Cardnum, tempRank,
strt1, strt2, strt3, myTempScore, tieKntr)
Else
rsSort.Edit
rsSort.Fields(strt2).Value = 0
rsSort.Fields(strt3).Value = 0
rsSort.Update
End If
.MoveNext
Loop
rsCompetition.Edit
rsCompetition!numofCompetitors = .RecordCount
rsCompetition.Update
.Close
End With
End Sub
Private Sub CheckForTies(tempScore As Single, tempCardNum As Integer,
tempRank As Integer, strt1 As String, strt2 As String, strt3 As
String, myTempScore As Single, tieKntr As Integer)
Dim cond2 As String
Dim kounter As Integer
Dim strT7 As String
Dim numTie As Integer
Dim actualRank As Integer 'ranking - if tie, skip
Dim myTempRank As Integer
strT7 = "SELECT * FROM Results WHERE " _
& "CompNum = " & "'" & txtCompNum2.Text & "'" _
& " AND " & strt1 & " = " & tempScore _
& " AND " & strt1 & " > 0 AND CardNum <> " _
& tempCardNum _
& " ORDER BY CardNum DESC"
Set rsSort2 = dbs.OpenRecordset(strT7)
tempRank = tempRank + 1
numTie = rsSort2.RecordCount + 1
With rsSort2
.MoveLast
.MoveFirst
End If
End With
If tempScore <> myTempScore Then
tieKntr = 1
ElseIf tempScore = myTempScore And numTie > 1 Then
tieKntr = tieKntr + 1
End If
rsSort.Edit
rsSort.Fields(strt3).Value = 0
myTempRank = tempRank
'MsgBox diffTempRank
kounter = 0
Do Until kounter >= numTie
kounter = kounter + 1
rsIrishPoints.FindFirst "[Rank] = " & myTempRank 'Kounter
rsSort.Fields(strt3).Value = rsSort.Fields(strt3).Value _
+ (rsIrishPoints!Score / numTie)
myTempRank = myTempRank + 1
Loop
myTempScore = tempScore
rsSort.Fields(strt2).Value = tempRank 'Kounter
If tieKntr > 1 And tieKntr = numTie And tempScore = myTempScore
Then
' we had a tie and we're on the last record of the tie
tempRank = tempRank + numTie ' - 1
End If
If tieKntr >= 1 And numTie > 1 Then
tempRank = tempRank - 1
End If
If rsCompetition!Prelim = True Or _
rsCompetition!Open = True Then
rsSort!TotalScore = rsSort!IrishPointsA _
+ rsSort!IrishPointsB _
+ rsSort!IrishPointsC
Else
rsSort!TotalScore = rsSort!TotalScoreA
End If
rsSort.Update
End Sub
Private Sub ComputePlaces()
Dim strt3 As String
Dim tempScore As Single
Dim kounter As Integer
Dim tempRank As Integer
strt3 = "SELECT * " _
& "FROM Results WHERE " _
& "CompNum = " & "'" & txtCompNum2 _
& "' AND ScoreA1 > 0 " _
& "ORDER BY TotalScore Desc"
Set rsSort = dbs.OpenRecordset(strt3)
tempScore = 0
kounter = 0
tempRank = 0
With rsSort
.MoveFirst
rsCompetition.Edit
rsCompetition!HighestScore = rsSort!TotalScore
rsCompetition.Update
Do Until .EOF
kounter = kounter + 1
If tempScore = rsSort!TotalScore Then
'tie
'numTie = numTie + 1
tempRank = tempRank - 1
Else
'no tie
'numTie = 0
End If
tempRank = tempRank + 1
tempScore = rsSort!TotalScore
.Edit
rsSort!NetRank = 0
Select Case tempRank
Case 1 To 4
rsSort!NetRank = tempRank
Case 5
If rsCompetition!numofCompetitors >= 11 Or
rsCompetition!Prelim = True Or rsCompetition!Open = True Then
rsSort!NetRank = tempRank
ElseIf rsCompetition!CompDesc = "Reel" Then
rsSort!NetRank = 99
End If
Case 6
If rsCompetition!numofCompetitors >= 21 Or
rsCompetition!Prelim = True Or rsCompetition!Open = True Then
rsSort!NetRank = tempRank
ElseIf rsCompetition!CompDesc = "Reel" Then
rsSort!NetRank = 99
End If
Case 7
If rsCompetition!numofCompetitors >= 25 Or
rsCompetition!Prelim = True Or rsCompetition!Open = True Then
rsSort!NetRank = tempRank
ElseIf rsCompetition!CompDesc = "Reel" Then
rsSort!NetRank = 99
End If
Case Else
If rsCompetition!CompDesc = "Reel" Then
rsSort!NetRank = 99
ElseIf rsCompetition!Prelim = True Or
rsCompetition!Open = True Then
rsSort!NetRank = tempRank
Else
rsSort!NetRank = 0
End If
End Select
rsSort!GrossRank = tempRank
.Update
.MoveNext
Loop
.Close
End With
End Sub
I'm trying to convert the code below from VB6 to VB.NET. I'm not sure
of the best way to go. This is basically a simple application to do
scoring for a competition. I'm using an Access database and all of
this code happens "behind the scenes" when all of the scores have been
entered on another screen (that piece is done). If someone could help
me, I'd really be grateful... I'm not necessarily looking for someone
to re-write it all for me (but I wouldn't complain either - ha ha) -
but if I could get some ideas, it sure would be great...
Thanks!
Steve
Private Sub cmdAllDone_Click()
rsCompetition.FindFirst "[CompNum] = " & "'" & txtCompNum2 & "'"
If rsCompetition.NoMatch = True Then
MsgBox "Sorry, try again"
txtCompNum2.SetFocus
txtCompNum2.SelStart = 0
txtCompNum2.SelLength = Len(txtCompNum2)
End If
Call ComputePoints("TotalScoreA")
Call RankJudge("TotalScoreA", "RankA", "IrishPointsA")
Call ComputePoints("TotalScoreB")
Call RankJudge("TotalScoreB", "RankB", "IrishPointsB")
Call ComputePoints("TotalScoreC")
Call RankJudge("TotalScoreC", "RankC", "IrishPointsC")
ComputePlaces
PrintReport
End Sub
Private Sub ComputePoints(strt1 As String)
Dim strt3 As String
strt3 = "SELECT * " _
& "FROM Results WHERE " _
& "CompNum = " & "'" & txtCompNum2 _
& "' AND ScoreA1 > 0 " _
& "ORDER BY " & strt1 & " DESC"
Set rsSort = dbs.OpenRecordset(strt3)
End Sub
Private Sub RankJudge(strt1 As String, strt2 As String, strt3 As
String)
Dim tempScore As Single
Dim myTempScore As Single
Dim kounter As Integer
Dim tempPoints As Integer 'points from rsIrishPoints
Dim xxxRank As Integer
Dim tempRank As Integer 'Ranking by judge - includes possibility
for tie
Dim varBookmark As Variant
Dim varBookmarkB As Variant
Dim tieKntr As Integer
tempScore = 0
kounter = 0
tempRank = 0
With rsSort
.MoveFirst
Do Until .EOF
kounter = kounter + 1
tempScore = rsSort.Fields(strt1).Value
If (rsSort.Fields(strt1).Value > 0) Then
Call CheckForTies(tempScore, rsSort!Cardnum, tempRank,
strt1, strt2, strt3, myTempScore, tieKntr)
Else
rsSort.Edit
rsSort.Fields(strt2).Value = 0
rsSort.Fields(strt3).Value = 0
rsSort.Update
End If
.MoveNext
Loop
rsCompetition.Edit
rsCompetition!numofCompetitors = .RecordCount
rsCompetition.Update
.Close
End With
End Sub
Private Sub CheckForTies(tempScore As Single, tempCardNum As Integer,
tempRank As Integer, strt1 As String, strt2 As String, strt3 As
String, myTempScore As Single, tieKntr As Integer)
Dim cond2 As String
Dim kounter As Integer
Dim strT7 As String
Dim numTie As Integer
Dim actualRank As Integer 'ranking - if tie, skip
Dim myTempRank As Integer
strT7 = "SELECT * FROM Results WHERE " _
& "CompNum = " & "'" & txtCompNum2.Text & "'" _
& " AND " & strt1 & " = " & tempScore _
& " AND " & strt1 & " > 0 AND CardNum <> " _
& tempCardNum _
& " ORDER BY CardNum DESC"
Set rsSort2 = dbs.OpenRecordset(strT7)
tempRank = tempRank + 1
numTie = rsSort2.RecordCount + 1
With rsSort2
.MoveLast
.MoveFirst
End If
End With
If tempScore <> myTempScore Then
tieKntr = 1
ElseIf tempScore = myTempScore And numTie > 1 Then
tieKntr = tieKntr + 1
End If
rsSort.Edit
rsSort.Fields(strt3).Value = 0
myTempRank = tempRank
'MsgBox diffTempRank
kounter = 0
Do Until kounter >= numTie
kounter = kounter + 1
rsIrishPoints.FindFirst "[Rank] = " & myTempRank 'Kounter
rsSort.Fields(strt3).Value = rsSort.Fields(strt3).Value _
+ (rsIrishPoints!Score / numTie)
myTempRank = myTempRank + 1
Loop
myTempScore = tempScore
rsSort.Fields(strt2).Value = tempRank 'Kounter
If tieKntr > 1 And tieKntr = numTie And tempScore = myTempScore
Then
' we had a tie and we're on the last record of the tie
tempRank = tempRank + numTie ' - 1
End If
If tieKntr >= 1 And numTie > 1 Then
tempRank = tempRank - 1
End If
If rsCompetition!Prelim = True Or _
rsCompetition!Open = True Then
rsSort!TotalScore = rsSort!IrishPointsA _
+ rsSort!IrishPointsB _
+ rsSort!IrishPointsC
Else
rsSort!TotalScore = rsSort!TotalScoreA
End If
rsSort.Update
End Sub
Private Sub ComputePlaces()
Dim strt3 As String
Dim tempScore As Single
Dim kounter As Integer
Dim tempRank As Integer
strt3 = "SELECT * " _
& "FROM Results WHERE " _
& "CompNum = " & "'" & txtCompNum2 _
& "' AND ScoreA1 > 0 " _
& "ORDER BY TotalScore Desc"
Set rsSort = dbs.OpenRecordset(strt3)
tempScore = 0
kounter = 0
tempRank = 0
With rsSort
.MoveFirst
rsCompetition.Edit
rsCompetition!HighestScore = rsSort!TotalScore
rsCompetition.Update
Do Until .EOF
kounter = kounter + 1
If tempScore = rsSort!TotalScore Then
'tie
'numTie = numTie + 1
tempRank = tempRank - 1
Else
'no tie
'numTie = 0
End If
tempRank = tempRank + 1
tempScore = rsSort!TotalScore
.Edit
rsSort!NetRank = 0
Select Case tempRank
Case 1 To 4
rsSort!NetRank = tempRank
Case 5
If rsCompetition!numofCompetitors >= 11 Or
rsCompetition!Prelim = True Or rsCompetition!Open = True Then
rsSort!NetRank = tempRank
ElseIf rsCompetition!CompDesc = "Reel" Then
rsSort!NetRank = 99
End If
Case 6
If rsCompetition!numofCompetitors >= 21 Or
rsCompetition!Prelim = True Or rsCompetition!Open = True Then
rsSort!NetRank = tempRank
ElseIf rsCompetition!CompDesc = "Reel" Then
rsSort!NetRank = 99
End If
Case 7
If rsCompetition!numofCompetitors >= 25 Or
rsCompetition!Prelim = True Or rsCompetition!Open = True Then
rsSort!NetRank = tempRank
ElseIf rsCompetition!CompDesc = "Reel" Then
rsSort!NetRank = 99
End If
Case Else
If rsCompetition!CompDesc = "Reel" Then
rsSort!NetRank = 99
ElseIf rsCompetition!Prelim = True Or
rsCompetition!Open = True Then
rsSort!NetRank = tempRank
Else
rsSort!NetRank = 0
End If
End Select
rsSort!GrossRank = tempRank
.Update
.MoveNext
Loop
.Close
End With
End Sub