By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
444,041 Members | 1,046 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 444,041 IT Pros & Developers. It's quick & easy.

Help converting this code from vb6 to vb.net?

P: n/a
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
Nov 20 '05 #1
Share this Question
Share on Google+
11 Replies


P: n/a
In VB.NET there is a code updater. It can be found under Tools\Upgrade VB6
code... Have you tried that?

"Steve" <sf**@rsd-tc.com> wrote in message
news:a7**************************@posting.google.c om...
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

Nov 20 '05 #2

P: n/a
"Steve" <sf**@rsd-tc.com> schrieb
With rsSort2
.MoveLast
.MoveFirst
End If
End With


Can the code be compiled in VB6? This "End if" doesn't fit in here.

You are using DAO. Do you intend to replace it by ADO.NET?
--
Armin

http://www.plig.net/nnq/nquote.html
http://www.netmeister.org/news/learn2quote.html

Nov 20 '05 #3

P: n/a
"Steve" <sf**@rsd-tc.com> schrieb
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...


I'll have a look at it, but, first, have you already tried to use the
upgrade wizard? Do you have specific problems to upgrade the code?
--
Armin

http://www.plig.net/nnq/nquote.html
http://www.netmeister.org/news/learn2quote.html

Nov 20 '05 #4

P: n/a
Shawn,

Thanks for your reply. I did, but it's too much for the code
converter to handle, especially with the differences between DAO and
ADO.NET. There's a ton of messages like:

'UPGRADE_ISSUE: The preceding line couldn't be parsed. Click for
more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1010"'
'UPGRADE_WARNING: Couldn't resolve default property of object
rsSort!TotalScore. Click for more:
'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'

Thanks.
Steve

"Shawn Hogan" <NOSPAM> wrote in message news:<#h**************@TK2MSFTNGP11.phx.gbl>...
In VB.NET there is a code updater. It can be found under Tools\Upgrade VB6
code... Have you tried that?

<snip/> :)
Nov 20 '05 #5

P: n/a
"Steve" <sf**@rsd-tc.com> schrieb
Shawn,

Thanks for your reply. I did, but it's too much for the code
converter to handle, especially with the differences between DAO
and ADO.NET.
The upgrade wizard doesn't change the used database component.
There's a ton of messages like:

'UPGRADE_ISSUE: The preceding line couldn't be parsed. Click
for
more:
'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1010"'
'UPGRADE_WARNING: Couldn't resolve default property of object
rsSort!TotalScore. Click for more:
'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'

Why don't you convert the whole project or put the code in a convertable
project?
--
Armin

http://www.plig.net/nnq/nquote.html
http://www.netmeister.org/news/learn2quote.html

Nov 20 '05 #6

P: n/a
Armin,

Thanks for your replies. Yes, I am definitely replacing DAO with
ADO.NET. The upgrade utility for VS.NET doesn't handle this code well
at all. It's a mess. :)

The real problem I have is: I don't know how to handle the logic of
moving through a DataTable and updating other records in the same
table while still in a loop of the original DataTable. For instance,
consider this "Pseudo-Code" (keeping in mind that I have maybe 20
records, each with a "Score" for a competitor:

1. Loop through all competitors for this competition, in order of
highest to lowest score.
2. Check to see if there are any other records (other than the current
one) with the same score.
3. If there is a tie, loop through those (we may have more than two
with a tie). I need to know how many tied.
4. If there is a tie, I need to take all of the points for those spots
that tied (points are determined by your ranking) and add them up and
divide by the number that tied. At this point, we don't want to
include any of the tied people when we now go back to #1 and continue.
5. If there is no tie for this position, assign a certain number of
"Points" to this record and go back to #1.

It's somewhat complicated, so I apologize. Also, there is a sub
called "PrintReport" that simply printed the results using Crystal
Reports. It's not pertinent here...

Thanks!
Steve

"Armin Zingler" <az*******@freenet.de> wrote in message news:<#e**************@tk2msftngp13.phx.gbl>...
"Steve" <sf**@rsd-tc.com> schrieb
With rsSort2
.MoveLast
.MoveFirst
End If
End With


Can the code be compiled in VB6? This "End if" doesn't fit in here.

You are using DAO. Do you intend to replace it by ADO.NET?

Nov 20 '05 #7

P: n/a
Cor
Hi Steve,

You have a lot more posibilities with Ado.net than with old Ado I think

You can sort with a dataview
You can select datarows with a datatabel select
You can find with a rowcollection.find (although I think that is seldom
used)
You can loop through a dataset with a count
You can loop through a datatable row by row
You can find the last row in a table with rows(table(0).rows.count -1)
You can find the first row in a table with rows(0)
You can find if there are no rows with count = 0

Will I go on (there is more)?

Cor
Nov 20 '05 #8

P: n/a
"Cor" <no*@non.com> schrieb

You have a lot more posibilities with Ado.net than with old Ado I
think


I think it was DAO, not ADO. DAO can be ~60-85 times faster than ADO.NET, so
ADO.NET is not really something I would personally ever use - not before
connected recordsets will come back.

--
Armin

http://www.plig.net/nnq/nquote.html
http://www.netmeister.org/news/learn2quote.html

Nov 20 '05 #9

P: n/a
Cor
Hi Armin,

Maybe when you start using the Internet for your applications?

However maybe it is than so fast than you can read long quotes and the user
can stay connected.

:-)

Cor
Nov 20 '05 #10

P: n/a
Cor
Hi Steve,

Where I wrote old Ado I did mean the older systems

I hope you did understand that.

Cor
Nov 20 '05 #11

P: n/a
"Cor" <no*@non.com> schrieb

Maybe when you start using the Internet for your applications?


Local Database.
--
Armin

Nov 20 '05 #12

This discussion thread is closed

Replies have been disabled for this discussion.