-
2 Attachment(s)
Multiple viewing of Matching Data frp, a Textfile.
Hello everybody,
Probably shouldn't have closed my old thread (listbox help) but i forgot to ask.
I have the reading of 2 text files, 1 which includes names and details of a user, and 1 which includes the name, and scoring details.
I have correctly set it up (with doogle's expertise) so that name clicked in a listbox (loaded from 1st textfile) checks for the name in the other text file and if it finds it displays its corresponding data. If that makes sense.
Basically What I want to do now, is; if in the second text file there was a multiple number of entry under the one name(on different lines), with different scores. How would i go about displaying each of these for instance in sequence one underneath each other in a label on another form.
Code:
Option Explicit
Dim myNameArray() As String
Dim myUserArray() As String
Dim myPwdArray() As String
Dim myDifficultArray() As String
Dim myScoreArray() As String
Dim myViewScoreArray() As String
Dim myOutofArray() As String
Dim myName1Array() As String
Dim myStarsArray() As String
Private Sub cmdadd_Click()
frmnewuser.Show
frmnewuser.txtfullname.SetFocus
Me.Hide
Unload Me
End Sub
Private Sub cmdviewscores_Click()
frmviewscore.Show
Me.Hide
End Sub
Private Sub Form_Load()
Dim intFile As Integer, x As Integer
Dim myLine As String, displayData As String
'
' Dimension the Dynamic Arrays to hold 200 elements
'
ReDim myPwdArray(199)
ReDim myUserArray(199)
intFile = FreeFile()
Open "P:\IPT\project\vb prject2013\names.txt" For Input As intFile
Do While Not EOF(intFile)
Line Input #intFile, myLine
myLine = Replace(myLine, """", "")
If Len(Trim$(myLine)) > 0 Then
myNameArray = Split(myLine, ",")
lstusers.AddItem (myNameArray(0))
If x > UBound(myPwdArray) Then
'
' If we've run out of elements then add another 200
'
ReDim Preserve myPwdArray(UBound(myPwdArray) + 200)
ReDim Preserve myPwdArray(UBound(myUserArray) + 200)
End If
myPwdArray(x) = (myNameArray(2))
myUserArray(x) = (myNameArray(1))
x = x + 1
End If
Loop
'
'Resize the arrays to the actual number of elements used
'
ReDim Preserve myPwdArray(x - 1)
ReDim Preserve myPwdArray(x - 1)
Close intFile
x = 0
ReDim myName1Array(199)
ReDim myScoreArray(199)
ReDim myOutofArray(199)
ReDim myDifficultArray(199)
ReDim myStarsArray(199)
intFile = FreeFile
Open "P:\IPT\project\vb prject2013\scores.txt" For Input As intFile
Do While Not EOF(intFile)
Line Input #intFile, myLine
myLine = Replace(myLine, """", "")
If Len(Trim(myLine)) > 0 Then
If x > UBound(myNameArray) Then
ReDim Preserve myName1Array(UBound(myName1Array) + 200)
ReDim Preserve myScoreArray(UBound(myScoreArray) + 200)
ReDim Preserve myOutofArray(UBound(myOutofArray) + 200)
ReDim Preserve myDifficultArray(UBound(myDifficultArray) + 200)
ReDim Preserve myStarsArray(UBound(myStarsArray) + 200)
End If
myViewScoreArray = Split(myLine, ",")
myName1Array(x) = myViewScoreArray(0)
myScoreArray(x) = myViewScoreArray(1)
myOutofArray(x) = myViewScoreArray(2)
myStarsArray(x) = myViewScoreArray(4)
myDifficultArray(x) = myViewScoreArray(3)
x = x + 1
End If
Loop
ReDim Preserve myName1Array(x - 1)
ReDim Preserve myScoreArray(x - 1)
ReDim Preserve myOutofArray(x - 1)
ReDim Preserve myDifficultArray(x - 1)
ReDim Preserve myStarsArray(x - 1)
Close #intFile
End Sub
Private Sub lstusers_Click()
Dim I As Integer
frmviewuser.lblfullname.Caption = lstusers.List(lstusers.ListIndex)
frmviewuser.lblpassword.Caption = myPwdArray(lstusers.ListIndex)
frmviewuser.lblusername.Caption = myUserArray(lstusers.ListIndex)
frmviewscore.lblscore.Caption = vbNullString
Do
If Trim$(myName1Array(I)) = Trim$(frmviewuser.lblusername.Caption) Then
'
' (I) is the Index into the second set of arrays that match the name
' e.g. myscorearray(I) would be the score for this username
'
frmviewscore.lblstarsearned.Caption = myStarsArray(I)
frmviewscore.lblscore.Caption = myScoreArray(I)
Else
I = I + 1
End If
Loop Until frmviewscore.lblscore.Caption <> vbNullString Or I > UBound(myName1Array)
End Sub
also here are the text files:
Attachment 100735
Attachment 100737
Thanks in advance. (I know i should have not closed that other thread, ...rookie error...)
-
Re: Multiple viewing of Matching Data frp, a Textfile.
Like this, perhaps
Code:
Private Sub lstusers_Click()
Dim I As Integer
frmviewuser.lblfullname.Caption = lstusers.List(lstusers.ListIndex)
frmviewuser.lblpassword.Caption = myPwdArray(lstusers.ListIndex)
frmviewuser.lblusername.Caption = myUserArray(lstusers.ListIndex)
frmviewscore.lblscore.Caption = vbNullString
For I = 0 To UBound(myName1array)
If Trim$(myName1array(I)) = Trim$(frmviewuser.lblusername.Caption) Then
frmviewscore.lblstarsearned.Caption = frmviewscore.lblstarsearned.Caption & myStarsArray(I) & vbNewLine
frmviewscore.lblscore.Caption = frmviewscors.lblscore.Caption & myScoreArray(I) & vbNewLine
End If
Next I
End Sub
-
Re: Multiple viewing of Matching Data frp, a Textfile.
Thanks that worked for viewing the scores for the users. I split it up so i have 2 different list boxes for both admins and users. Another problem though
How would I on the next form when i'm clicking on the username of the admin(adminlistbox), the first one displays the correct information but then the next one displays the info for the second person in the text file which is not set to be an admin. How would i change it so it only reads the 'admins'? I have used an if statement when opening the file, and that seems to display the correct users in the list box but not the corresponding data when they are clicked.
Second problem. if i acidently click a user more than once, or click one and then another it displays the information for both users rather than just the one that is 'highlighted' as such.
Main teacher code
Code:
Option Explicit
Dim mynameArray() As String
Dim myUserArray() As String
Dim myPwdArray() As String
Dim myDifficultArray() As String
Dim myScoreArray() As String
Dim myViewScoreArray() As String
Dim myOutofArray() As String
Dim myName1Array() As String
Dim myStarsArray() As String
Private Sub cmdadd_Click()
frmnewuser.Show
frmnewuser.txtfullname.SetFocus
Me.Hide
Unload Me
End Sub
Private Sub cmdviewadmin_Click()
frmviewadmins.Show
Me.Hide
End Sub
Private Sub cmdviewscores_Click()
frmviewscore.Show
Me.Hide
End Sub
Private Sub Form_Load()
Dim intfile As Integer, x As Integer
Dim myLine As String, displayData As String
'
' Dimension the Dynamic Arrays to hold 200 elements
'
ReDim myPwdArray(199)
ReDim myUserArray(199)
intfile = FreeFile()
Open "H:\IPT\project\vb prject2013\names.txt" For Input As intfile
Do While Not EOF(intfile)
Line Input #intfile, myLine
myLine = Replace(myLine, """", "")
If Len(Trim$(myLine)) > 0 Then
mynameArray = Split(myLine, ",")
If mynameArray(3) = "0" Then
lstusers.AddItem (mynameArray(0))
End If
If x > UBound(myPwdArray) Then
'
' If we've run out of elements then add another 200
'
ReDim Preserve myPwdArray(UBound(myPwdArray) + 200)
ReDim Preserve myPwdArray(UBound(myUserArray) + 200)
End If
myPwdArray(x) = (mynameArray(2))
myUserArray(x) = (mynameArray(1))
x = x + 1
End If
Loop
'
'Resize the arrays to the actual number of elements used
'
ReDim Preserve myPwdArray(x - 1)
ReDim Preserve myPwdArray(x - 1)
Close intfile
x = 0
ReDim myName1Array(199)
ReDim myScoreArray(199)
ReDim myOutofArray(199)
ReDim myDifficultArray(199)
ReDim myStarsArray(199)
intfile = FreeFile
Open "H:\IPT\project\vb prject2013\scores.txt" For Input As intfile
Do While Not EOF(intfile)
Line Input #intfile, myLine
myLine = Replace(myLine, """", "")
If Len(Trim(myLine)) > 0 Then
If x > UBound(mynameArray) Then
ReDim Preserve myName1Array(UBound(myName1Array) + 200)
ReDim Preserve myScoreArray(UBound(myScoreArray) + 200)
ReDim Preserve myOutofArray(UBound(myOutofArray) + 200)
ReDim Preserve myDifficultArray(UBound(myDifficultArray) + 200)
ReDim Preserve myStarsArray(UBound(myStarsArray) + 200)
End If
myViewScoreArray = Split(myLine, ",")
myName1Array(x) = myViewScoreArray(0)
myScoreArray(x) = myViewScoreArray(1)
myOutofArray(x) = myViewScoreArray(2)
myStarsArray(x) = myViewScoreArray(4)
myDifficultArray(x) = myViewScoreArray(3)
x = x + 1
End If
Loop
ReDim Preserve myName1Array(x - 1)
ReDim Preserve myScoreArray(x - 1)
ReDim Preserve myOutofArray(x - 1)
ReDim Preserve myDifficultArray(x - 1)
ReDim Preserve myStarsArray(x - 1)
Close #intfile
End Sub
Private Sub lstusers_Click()
'Dim I As Integer
'frmviewuser.lblfullname.Caption = lstusers.List(lstusers.ListIndex)
'frmviewuser.lblpassword.Caption = myPwdArray(lstusers.ListIndex)
'frmviewuser.lblusername.Caption = myUserArray(lstusers.ListIndex)
'frmviewscore.lblscore.Caption = vbNullString
'Do
'If Trim$(myName1Array(I)) = Trim$(frmviewuser.lblusername.Caption) Then
'
' (I) is the Index into the second set of arrays that match the name
' e.g. myscorearray(I) would be the score for this username
'
' frmviewscore.lblstarsearned.Caption = myStarsArray(I)
'
' frmviewscore.lblscore.Caption = myScoreArray(I)
' Else
' I = I + 1
' End If
'Loop Until frmviewscore.lblscore.Caption <> vbNullString Or I > UBound(myName1Array)
'End Sub
Dim I As Integer
frmviewuser.lblfullname.Caption = lstusers.List(lstusers.ListIndex)
frmviewuser.lblpassword.Caption = myPwdArray(lstusers.ListIndex)
frmviewuser.lblusername.Caption = myUserArray(lstusers.ListIndex)
frmviewscore.lblscore.Caption = vbNullString
For I = 0 To UBound(myName1Array)
If Trim$(myName1Array(I)) = Trim$(frmviewuser.lblusername.Caption) Then
frmviewscore.lblstarsearned.Caption = frmviewscore.lblstarsearned.Caption & myStarsArray(I) & vbNewLine
frmviewscore.lbldisplayscore.Caption = frmviewscore.lbldisplayscore.Caption & myScoreArray(I) & " out of " & myOutofArray(I) & " on " & myDifficultArray(I) & " difficulty" & vbNewLine
End If
Next I
End Sub
ViewAdmin Code
Code:
Option Explicit
Dim mynameArray() As String
Dim myUserArray() As String
Dim myPwdArray() As String
Private Sub cmdback_Click()
frmteachermain.Show
Me.Hide
End Sub
Private Sub Form_Load()
Dim intfile As Integer, x As Integer
Dim myLine As String, displayData As String
'
' Dimension the Dynamic Arrays to hold 200 elements
'
ReDim myPwdArray(199)
ReDim myUserArray(199)
intfile = FreeFile()
Open "H:\IPT\project\vb prject2013\names.txt" For Input As intfile
Do While Not EOF(intfile)
Line Input #intfile, myLine
myLine = Replace(myLine, """", "")
If Len(Trim$(myLine)) > 0 Then
mynameArray = Split(myLine, ",")
If mynameArray(3) = "1" Then
lstadmins.AddItem (mynameArray(0))
End If
If x > UBound(myPwdArray) Then
'
' If we've run out of elements then add another 200
'
ReDim Preserve myPwdArray(UBound(myPwdArray) + 200)
ReDim Preserve myPwdArray(UBound(myUserArray) + 200)
End If
myPwdArray(x) = (mynameArray(2))
myUserArray(x) = (mynameArray(1))
x = x + 1
End If
Loop
End Sub
Private Sub lstadmins_Click()
lblpassword.Caption = myPwdArray(lstadmins.ListIndex)
lblusername.Caption = myUserArray(lstadmins.ListIndex)
End Sub
-
Re: Multiple viewing of Matching Data frp, a Textfile.
Perhaps you could zip up your entire Project, (including the Data Files, if possible) and attach it to a Post here. That way we can get a better idea of the Forms' interactions etc and be in a better position to advise.
-
1 Attachment(s)
Re: Multiple viewing of Matching Data frp, a Textfile.
OK Here its is:
Attachment 100829
Beare in mind, there is alot, i mean ALOT of unessercary crap that i don't need that may be commented out or not commented out. I still need to change a lot of things but here are my main problems at the moment:
1) When i go on to the viewadmins form, the correct information loads to the list box. However when i click on any other admin except for the top one listed, it displays incorrect information. --> It shows the details for whoever is listed 2nd in the text file, regardless if they are admin or not.
2) When view scores. If I click more than once on the lstusers listbox on the main teacher form and precede to the go to the view scores page, the scores from each person i have clicked show. I only want the one who is last clicked/highlighted to show.
3) On the test screen: When doing division, I only want to be able to divide numbers that are equally divisible by each other-ie 54/8, 12/3,etc and not 9/4, 7/6 etc. I know i can check for divisibility by using the MOD = 0 but i'm not sure on the exact placement of the code in amongst my other code.
4) Deleteing a user/Changing password: Haven't actually put this in yet, but i think it involves copying the text file to a temp_txt, changing the data, killing the old one, and renaming?? Is this the correct way to go with this?
I know this really does seem like i'm nagging a bit but I am still only fairly new to vb.
Thanks in advance.
-
Re: Multiple viewing of Matching Data frp, a Textfile.
On the question of dividing, if the numbers in question are, for instance 11 and 4 do you want the answer to be 2, or 3 (i.e. Rounded to nearest integer) or do you just not want to perform the division?
-
Re: Multiple viewing of Matching Data frp, a Textfile.
Quote:
Originally Posted by
Doogle
On the question of dividing, if the numbers in question are, for instance 11 and 4 do you want the answer to be 2, or 3 (i.e. Rounded to nearest integer) or do you just not want to perform the division?
Not perform it, but comtinue to randomize the numbers until 2 come up that are divisible evenly by each other.
-
Re: Multiple viewing of Matching Data frp, a Textfile.
would this be the right way to go about the 'evenly divisible' division.
Code:
If divnumber <> 0 Then
If numberdivid Mod divnumber = 0 Then
divisby = True
yes = True
Else
Do
Randomize 'Randomizes numbers to be displayed'
lbltable.Caption = Int(Rnd * 3) + 1 'The levels of tables (1-3) to which this text box will display. (as integars)
lblrandom.Caption = Int(Rnd * 12) + 1 'The tables which the 1-3 will be multiplyed by (1-12). Displayed in other text box (as integars)
Loop Until Val(lblrandom.Caption) Mod Val(lbltable.Caption) = 0
divisby = True
yes = True
End If
End If
-
Re: Multiple viewing of Matching Data frp, a Textfile.
I'd use
Code:
Dim intRnd1 As Integer
Dim intRnd2 As Integer
intRnd2 = Int(Rnd * 12) + 1
Do
intRnd1 = Int(Rnd * 3) + 1
Loop Until intRnd2 Mod intRnd1 = 0
lblrandom.Caption = CStr(intRnd2)
lbltable.Caption = CStr(intRnd1)
BTW You should only execute the 'Randomize' statement once per execution of the program. I suggest you put it in the Form Load event of the startup Form (frmLogin)
-
Re: Multiple viewing of Matching Data frp, a Textfile.
Quote:
Originally Posted by
homer5677
1) When i go on to the viewadmins form, the correct information loads to the list box. However when i click on any other admin except for the top one listed, it displays incorrect information. --> It shows the details for whoever is listed 2nd in the text file, regardless if they are admin or not.
I've been looking at the Project. To resolve this particular issue you can use the ItemData property of the Item in the ListBox, (I think this might have been suggested before in your original thread).
Each Item in a ListBox can have a Long value associated with it e.g.
Code:
ListBox.AddItem "Fred"
ListBox.ItemData(ListBox.NewIndex) = 20
The first statement adds "Fred" as an Item to ListBox, the following statement sets the ItemData property for the last added item (ListBox.NewIndex) to 20. This 'associates' the value 20 to the item containing "Fred".
In your case, when you add an admin to the ListBox you want to associate the element number of the Array that represents that admins information.
Code:
Private Sub Form_Load()
Dim intfile As Integer, x As Integer
Dim myLine As String, displayData As String
'
' Dimension the Dynamic Arrays to hold 200 elements
'
ReDim myPwdArray(199)
ReDim myUserArray(199)
intfile = FreeFile()
Open "H:\IPT\project\vb prject2013\names.txt" For Input As intfile
Do While Not EOF(intfile)
Line Input #intfile, myLine
myLine = Replace(myLine, """", "")
If Len(Trim$(myLine)) > 0 Then
mynameArray = Split(myLine, ",")
If x > UBound(myPwdArray) Then
'
' If we've run out of elements then add another 200
'
ReDim Preserve myPwdArray(UBound(myPwdArray) + 200)
ReDim Preserve myPwdArray(UBound(myUserArray) + 200)
End If
myPwdArray(x) = (mynameArray(2))
myUserArray(x) = (mynameArray(1))
If mynameArray(3) = "1" Then
lstadmins.AddItem (mynameArray(0)) 'Add this admin to the ListBox
lstadmins.ItemData(lstadmins.NewIndex) = x 'remember this admins element number
End If
x = x + 1
End If
Loop
End Sub
In order to display the details, in the Click event you have to use the ItemData property as the element of the array you wish to display
Code:
Private Sub lstadmins_Click()
lblpassword.Caption = myPwdArray(lstadmins.ItemData(lstadmins.ListIndex))
lblusername.Caption = myUserArray(lstadmins.ItemData(lstadmins.ListIndex))
End Sub
-
Re: Multiple viewing of Matching Data frp, a Textfile.
would i use the .itemdata property for the mainteacher form to view the user data (frmviewuser) as currently the full name is displaying correct, however the username, password is displaying as whoever is previous in the file-(the person above in the txt file)?
-
Re: Multiple viewing of Matching Data frp, a Textfile.
Yes, you'd use exactly the same method
-
Re: Multiple viewing of Matching Data frp, a Textfile.
Got that to work!
However I'm getting "runtime error 55: file already open" on my change password code:
Code:
Dim newpass1 As String
Dim newpass2 As String
Dim fullname, username, password As String
Dim level As Integer
Dim intfile, intfile2, intfile3 As Integer
'pass =
'newpass1 = InputBox("To continue please enter your current password", "Change Password")
newpass1 = InputBox("Please enter a new password", "Change Password")
newpass2 = InputBox("Please re-enter your new password", "Change Password")
If MsgBox("Save New Password?", vbQuestion + vbYesNo, "Save?") = vbYes Then
If newpass1 = newpass2 Then
intfile = FreeFile()
Open "Q:\IPT\project\vb prject2013\names.txt" For Input As intfile
Do Until EOF(intfile) = True
Input #intfile, fullname, username, password, level
If newpass1 = password Then
If MsgBox("You have entered your current password. Please enter a different one to change.", vbExclamation + vbOKOnly, "Error") = vbOK Then
End If
Else
intfile2 = FreeFile()
Open "Q:\IPT\project\vb prject2013\names_temp.txt" For Append As intfile2
Write #intfile2, fullname, username, password, level
Close #intfile2
End If
Loop
Close #infile
intfile3 = FreeFile()
Open "Q:\IPT\project\vb prject2013\names_temp.txt" For Append As intfile3
Write #intfile3, fullname, username, newpass1, level
Close #intfile3
Kill "Q:\IPT\project\vb prject2013\names.txt"
Name "Q:\IPT\project\vb prject2013\names_temp.txt" As "H:\IPT\project\vb prject2013\names.txt"
Else
MsgBox ("The passwords didn't match")
End If
End If
End Sub
I'm sure i've closed everything that needs to be closed, why else would i be getting this error?
-
Re: Multiple viewing of Matching Data frp, a Textfile.
guess that should be
I think you need 'Option Explicit' at the top of the Form !
-
Re: Multiple viewing of Matching Data frp, a Textfile.
BTW there's a few 'issues' with the code and you're likely to lose data
See below
Code:
Dim newpass1 As String
Dim newpass2 As String
'Dim fullname, username, password As String 'Only password will be defined as string
Dim fullname As String, username As String, password As String
Dim strUser As String
Dim level As Integer
'Dim intfile, intfile2, intfile3 As Integer 'Only intfile3 will be defined as string
Dim intfile As Integer, intfile2 As Integer 'intfile3 isn't needed
'pass =
'newpass1 = InputBox("To continue please enter your current password", "Change Password")
'*****************************************************************************************
strUser = "?????" '<-------- you need to assign the username you're looking for to strUser
'*****************************************************************************************
newpass1 = InputBox("Please enter a new password", "Change Password")
newpass2 = InputBox("Please re-enter your new password", "Change Password")
If MsgBox("Save New Password?", vbQuestion + vbYesNo, "Save?") = vbYes Then
If newpass1 = newpass2 Then
intfile = FreeFile()
Open "Q:\IPT\project\vb prject2013\names.txt" For Input As intfile
intfile2 = FreeFile
Open "Q:\IPT\project\vb prject2013\names_temp.txt" For Output As intfile2
Do Until EOF(intfile)
Input #intfile, fullname, username, password, level
'If newpass1 = password Then
' If MsgBox("You have entered your current password. Please enter a different one to change.", vbExclamation + vbOKOnly, "Error") = vbOK Then
' End If
'Else
'
' you need to check you've got the right username before checking the password
'
If strUser = username Then
If password1 <> password Then
'
' Output the user's record with the new password
'
Write #intfile2, fullname; ","; username; ","; password1; ","; level
Else
MsgBox "You have entered your current password. Please enter a different one", , "Error"
'
' The user got it wrong so write the original back to the file
'
Write #intfile3, fullname; ","; username; ","; password; ","; level
End If
Else
'
' Not the user we're interested in so just write the record to the file
'
Write #intfile2, fullname; ","; username; ","; password; ","; level
End If
Loop
Close #intfile
Close #intfile2
' intfile3 = FreeFile()
' Open "Q:\IPT\project\vb prject2013\names_temp.txt" For Append As intfile3
' Write #intfile3, fullname, username, newpass1, level
' Close #intfile3
Kill "Q:\IPT\project\vb prject2013\names.txt"
Name "Q:\IPT\project\vb prject2013\names_temp.txt" As "H:\IPT\project\vb prject2013\names.txt"
Else
MsgBox ("The passwords didn't match")
End If
End If
End Sub
Also, as you're not using the Double Quotations round the data in the file, I suggest you use 'Print #' rather than 'Write #'
-
Re: Multiple viewing of Matching Data frp, a Textfile.
so the change password is working with the main teacher form updating as required. For the delete user button on the main teacher form, would i use some of the code on the change pass so that it copys everything (except the line i want to delete) to a temp file, kills the old one and then renames? Also how would i link it to whatever user is selected. Would i use the .itemdata property again under the buttons code or would i put it under the click event of the list box
-
Re: Multiple viewing of Matching Data frp, a Textfile.
What do you have in the ListBox? Is it the Full Name ? If so then yes, you'd use the ItemData of the selected Item as the element in the UserID Array.
I'd put it in the Click Event of the ListBox.
-
Re: Multiple viewing of Matching Data frp, a Textfile.
In the coping of everything, is there a specific process such as what Print/Write does that you can use that will delete the line
-
Re: Multiple viewing of Matching Data frp, a Textfile.
No, you just identify the record you want to delete and don't copy it
Code:
intfile = FreeFile()
Open "Q:\IPT\project\vb prject2013\names.txt" For Input As intfile
intfile2 = FreeFile
Open "Q:\IPT\project\vb prject2013\names_temp.txt" For Output As intfile2
Do Until EOF(intfile)
Input #intfile, fullname, username, password, Level
If strUser <> username Then
Print #intfile2, fullname; ","; username; ","; password; ","; Level
End If
Loop
-
Re: Multiple viewing of Matching Data frp, a Textfile.
I have put it on a button as i want the user to select then press the button etc. However since the rest of my code for loading the names into the listbox is on the form load event, once i have deleted the user it just goes back to form and the user i just deleted is still displayed in the list box. Since i'm not doing the delete on a different form, i can't unload and load the original form again, updating the listbox data. How would i go about doing this?
-
Re: Multiple viewing of Matching Data frp, a Textfile.
Just clear the ListBox and re-add the items as you save them to the new names file
Code:
intfile = FreeFile()
Open "Q:\IPT\project\vb prject2013\names.txt" For Input As intfile
intfile2 = FreeFile
Open "Q:\IPT\project\vb prject2013\names_temp.txt" For Output As intfile2
frmXXX.LstXXX.Clear 'frmXXX is the Form where LstXXX (i.e. the list of names) is
Do Until EOF(intfile)
Input #intfile, fullname, username, password, Level
If strUser <> username Then
Print #intfile2, fullname; ","; username; ","; password; ","; Level
frmXX.LstXX.AddItem fullname
End If
Loop
-
Re: Multiple viewing of Matching Data frp, a Textfile.
The other thing you're going to have to do is to remove all the data from the scores file for the deleted user. Then you're going to have to re-populate all the arrays from the updated files. Also, when you change a user's password you'll have to change the entry in the password array for that user so it matches the new one.
-
Re: Multiple viewing of Matching Data frp, a Textfile.
i got all that going, but i have a problem with the add user. It's not writing it to a new line. and therefore won't read into the text box.
Code:
If txtusername.Text <> "" Then
If txtfullname.Text <> "" Then
If txtpassword1.Text <> "" Then
If pass1 = pass2 Then
If chkteacher.Enabled = True Then
savefile = FreeFile()
Open "Q:\IPT\project\vb prject2013\names.txt" For Append As #savefile
Write #savefile, ; (txtfullname.Text); (txtusername.Text); (txtpassword1.Text); "1";
Close #savefile
Else
savefile = FreeFile()
Open "Q:\IPT\project\vb prject2013\names.txt" For Append As #savefile
Write #savefile, ; (txtfullname.Text); (txtusername.Text); (txtpassword1.Text); "0";
Close #savefile
End If
Me.Hide
txtusername.Text = ""
txtpassword1.Text = ""
txtpassword2.Text = ""
txtfullname.Text = ""
I'm sure i've just missed a semicolen or something but i've had a bit of a fiddle around with it and its either writing to the same line or adding more quotations then i already have.
-
Re: Multiple viewing of Matching Data frp, a Textfile.
You appear to be missing the commas and you need to remove remove the trailing semi-colon at the end of the Write statement.
e.g.
Code:
Write #savefile, txtfullname.Text; "," ; txtusername.Text; "," ; txtpassword1.Text; "," ; "1"
-
Re: Multiple viewing of Matching Data frp, a Textfile.
it still seems to be writing it to that line first(next to the last entry). If i add a user again after that, it goes below though
-
Re: Multiple viewing of Matching Data frp, a Textfile.
This should add a new user
Code:
Dim strAdmin As String
If txtusername.Text <> "" Then
If txtfullname.Text <> "" Then
If txtpassword1.Text <> "" Then
If txtpassword1.Text = txtpassword2.Text Then
If chkteacher.Enabled = True Then
strAdmin = "1"
Else
strAdmin = "0"
End If
savefile = FreeFile()
Open "Q:\IPT\project\vb prject2013\names.txt" For Append As #savefile
Write #savefile, txtfullname.Text; ","; txtusername.Text; ","; txtpassword1.Text; ","; strAdmin
Close #savefile
txtusername.Text = ""
txtpassword1.Text = ""
txtpassword2.Text = ""
txtfullname.Text = ""
Me.Hide
Else
MsgBox "Passwords do not match - Please re-enter"
End If
Else
MsgBox "Password is blank. Please enter a Password"
End If
Else
MsgBox "Please enter your full name"
End If
Else
MsgBox "Please enter your UserName"
End If
EDIT: You need to be careful, once you've added a user you don't want to add them again. Perhaps you need to check that the user doesn't exist before you add a new user. The problem is, what defines a new user. I guess it has to be UserID since a FullName could have multiple UserIDs (eg. Full Name Doogle could have a userID of 'Doogle' and 'Doog'.)
Perhaps you need a Function that checks if the UserID already exists and reject the add if it does.
Code:
Dim strAdmin As String
If txtusername.Text <> "" Then
If Not DoesUserExist(textusername.Text) Then
If txtfullname.Text <> "" Then
If txtpassword1.Text <> "" Then
If txtpassword1.Text = txtpassword2.Text Then
If chkteacher.Enabled = True Then
strAdmin = "1"
Else
strAdmin = "0"
End If
savefile = FreeFile()
Open "Q:\IPT\project\vb prject2013\names.txt" For Append As #savefile
Write #savefile, txtfullname.Text; ","; txtusername.Text; ","; txtpassword1.Text; ","; strAdmin
Close #savefile
txtusername.Text = ""
txtpassword1.Text = ""
txtpassword2.Text = ""
txtfullname.Text = ""
Me.Hide
Else
MsgBox "Passwords do not match - Please re-enter"
End If
Else
MsgBox "Password is blank. Please enter a Password"
End If
Else
MsgBox "Please enter your full name"
End If
Else
MsgBox "Username " & txtusername.Text & " Already Exists"
End If
Else
MsgBox "Please enter a UserID"
End If
End Sub
Private Function DoesUserExist(strUserID As String) As Boolean
Dim intFile As Integer
Dim strFulName As String
Dim strFUserID As String
Dim strPassword As String
Dim strAdmin As String
intFile = FreeFile
Open "Q:\IPT\project\vb prject2013\names.txt" For Input As #intFile
Do
Input #intFile, strFullName, strFUserID, strPassword, strAdmin
If strUserID = strFUserID Then
DoesUserExist = True
End If
Loop Until DoesUserExist = True Or EOF(intFile)
Close intFile
End Function
-
Re: Multiple viewing of Matching Data frp, a Textfile.
it still seems to be going on the end. and not to the new line. Could it be how my text file is formatted?
Original:
"admin","admin","1234","1"
"user1","user1","user1","0"
"user2","user2","user2","0"
"user3","user3","user3","0"
"admin2","admin2","admin2","1"
"fullname","username","password","0"
After adding user:
"admin","admin","1234","1"
"user1","user1","user1","0"
"user2","user2","user2","0"
"user3","user3","user3","0"
"admin2","admin2","admin2","1"
"fullname","username","password","0""dan",",","dan",",","1234",",","1"
-
Re: Multiple viewing of Matching Data frp, a Textfile.
Looks to me like you've got a trailing comma or semi-colon at the end of a Write statement
-
Re: Multiple viewing of Matching Data frp, a Textfile.
i got it to work by using print but adding a function to write the inverted commas.
On a nother instance of my project. I want to replace a new specific part of the names txt file while also adding a new line to the other text file.
Code:
Private Sub Form_Load()
Dim intfile As Integer
Dim savefile As Long
Dim sOut As String
Dim username As String, score As String, outoff As String, difficulty As String, starsearned As String, type1 As String
Dim fullname As String, username1 As String, pass As String, admin As String, Currentstars As String
Dim usercheck As String
Dim pickdiff As String
Dim picktype As String
Dim intfile2 As Integer
Dim newstars As String
Dim intfile3 As Integer
If frmquickgame.opteasy = True Then
pickdiff = "Easy"
ElseIf frmquickgame.optmedium = True Then
pickdiff = "Medium"
ElseIf frmquickgame.optmedium = True Then
pickdiff = "Hard"
End If
If frmquickgame.optaddition = True Then
picktype = "Addition"
ElseIf frmquickgame.optminus = True Then
picktype = "Subtraction"
ElseIf frmquickgame.opttimes = True Then
picktype = "Multiplication"
ElseIf frmquickgame.optdivide = True Then
picktype = "Division"
ElseIf frmquickgame.optall = True Then
picktype = "A Mixture"
End If
intfile = FreeFile()
Open "Q:\IPT\project\vb prject2013\scores.txt" For Input As #intfile
Do Until EOF(intfile)
Input #intfile, username, score, outoff, difficulty, type1
If frmmain.lblname.Caption = username Then
sOut = QuoteString(frmmain.lblname.Caption) & "," & QuoteString(lblright.Caption) & "," & QuoteString(frmtest.lblinvisible.Caption) & "," & QuoteString(pickdiff) & "," & QuoteString(lblstars.Caption) & "," & QuoteString(picktype)
savefile = FreeFile()
Open "Q:\IPT\project\vb prject2013\scores.txt" For Append As #savefile
Print #savefile, sOut
End If
Loop
Close #savefile
Close #intfile
intfile2 = FreeFile()
Open "Q:\IPT\project\vb prject2013\names.txt" For Input As intfile2
intfile3 = FreeFile()
Open "Q:\IPT\project\vb prject2013\names_temp.txt" For Output As intfile3
Do Until EOF(intfile2)
Input #intfile2, fullname, username1, pass, admin, Currentstars
If frmmain.lblname.Caption = username1 Then
newstars = Currentstars + Val(lblstars.Caption)
Write #intfile3, fullname; username1; pass; admin; newstars
End If
Loop
Close #intfile2
Close #intfile3
Kill "Q:\IPT\project\vb prject2013\names.txt"
Name "Q:\IPT\project\vb prject2013\names_temp.txt" As "Q:\IPT\project\vb prject2013\names.txt"
End Sub
Private Function QuoteString(ByVal sText As String) As String
QuoteString = Chr$(34) & sText & Chr$(34)
End Function
I tried to basically replicate my change pass code but i am now getting the text file deleting everything except the specific user logged in at the moment.
Any ideas on why this would be?
-
Re: Multiple viewing of Matching Data frp, a Textfile.
Your indentation seems to have gone a bit 'funny' and it's quite difficult to see what's happending. Here it is re-indented:
Code:
Private Sub Form_Load()
Dim intfile As Integer
Dim savefile As Long
Dim sOut As String
Dim username As String, score As String, outoff As String, difficulty As String, starsearned As String, type1 As String
Dim fullname As String, username1 As String, pass As String, admin As String, Currentstars As String
Dim usercheck As String
Dim pickdiff As String
Dim picktype As String
Dim intfile2 As Integer
Dim newstars As String
Dim intfile3 As Integer
If frmquickgame.opteasy = True Then
pickdiff = "Easy"
ElseIf frmquickgame.optmedium = True Then
pickdiff = "Medium"
ElseIf frmquickgame.optmedium = True Then
pickdiff = "Hard"
End If
If frmquickgame.optaddition = True Then
picktype = "Addition"
ElseIf frmquickgame.optminus = True Then
picktype = "Subtraction"
ElseIf frmquickgame.opttimes = True Then
picktype = "Multiplication"
ElseIf frmquickgame.optdivide = True Then
picktype = "Division"
ElseIf frmquickgame.optall = True Then
picktype = "A Mixture"
End If
intfile = FreeFile()
Open "Q:\IPT\project\vb prject2013\scores.txt" For Input As #intfile
Do Until EOF(intfile)
Input #intfile, username, score, outoff, difficulty, type1
If frmmain.lblname.Caption = username Then
sOut = QuoteString(frmmain.lblname.Caption) & "," & QuoteString(lblright.Caption) & "," & QuoteString(frmtest.lblinvisible.Caption) & "," & QuoteString(pickdiff) & "," & QuoteString(lblstars.Caption) & "," & QuoteString(picktype)
savefile = FreeFile()
Open "Q:\IPT\project\vb prject2013\scores.txt" For Append As #savefile
Print #savefile, sOut
End If
Loop
Close #savefile
Close #intfile
intfile2 = FreeFile()
Open "Q:\IPT\project\vb prject2013\names.txt" For Input As intfile2
intfile3 = FreeFile()
Open "Q:\IPT\project\vb prject2013\names_temp.txt" For Output As intfile3
Do Until EOF(intfile2)
Input #intfile2, fullname, username1, pass, admin, Currentstars
If frmmain.lblname.Caption = username1 Then
newstars = Currentstars + Val(lblstars.Caption)
Write #intfile3, fullname; username1; pass; admin; newstars
End If
Loop
Close #intfile2
Close #intfile3
Kill "Q:\IPT\project\vb prject2013\names.txt"
Name "Q:\IPT\project\vb prject2013\names_temp.txt" As "Q:\IPT\project\vb prject2013\names.txt"
End Sub
Private Function QuoteString(ByVal sText As String) As String
QuoteString = Chr$(34) & sText & Chr$(34)
End Function
The code affecting the scores file is only copying the record for the matching username, you're ignoring all the others rather than copying them.
You need something like
Code:
intfile = FreeFile()
Open "Q:\IPT\project\vb prject2013\scores.txt" For Input As #intfile
savefile = FreeFile()
Open "Q:\IPT\project\vb prject2013\scores_temp.txt" For Output As #savefile
Do Until EOF(intfile)
Input #intfile, username, score, outoff, difficulty, type1
'
' If the usernames match then output the modified details
'
If frmmain.lblname.Caption = username Then
sOut = QuoteString(frmmain.lblname.Caption) & "," & QuoteString(lblright.Caption) & "," & QuoteString(frmtest.lblinvisible.Caption) & "," & QuoteString(pickdiff) & "," & QuoteString(lblstars.Caption) & "," & QuoteString(picktype)
Else
'
' if the usernames don't match write the existing details
'
sOut = QuoteString(username) & "," & QuoteString(score) & "," & QuoteString(outoff) & "," & QuoteString(difficulty) & "," & QuoteString(type1)
End If
Print #savefile, sOut
Loop
Close #savefile
Close #intfile
Note that you can't read and write to the same file at the same time so you need to adopt the same strategy you use for the names file.
Similarly, with the names file,
Code:
intfile2 = FreeFile()
Open "Q:\IPT\project\vb prject2013\names.txt" For Input As intfile2
intfile3 = FreeFile()
Open "Q:\IPT\project\vb prject2013\names_temp.txt" For Output As intfile3
Do Until EOF(intfile2)
Input #intfile2, fullname, username1, pass, admin, Currentstars
If frmmain.lblname.Caption = username1 Then
Currentstars = Currentstars + Val(lblstars.Caption)
End If
Write #intfile3, fullname; ","; username1; ","; pass; ","; admin; ","; Currentstars
End If
Loop
Close #intfile2
Close #intfile3
then you need to rename both new files
Code:
Kill "Q:\IPT\project\vb prject2013\names.txt"
Name "Q:\IPT\project\vb prject2013\names_temp.txt" As "Q:\IPT\project\vb prject2013\names.txt"
Kill "Q:\IPT\project\vb project2013\scores.txt"
Name "Q:\IPT\project\vb project2013\scores_temp.txt" As "Q:\IPT\project\vb project2013\scores.txt"
EDIT: I can't see how your 'QuoteString' Function resolved your earlier problem. All that does is replicate the functionality of the 'Write' statement.
Perhaps I shouldn't have mentioned using 'Print' rather than 'Write'
Code:
If frmmain.lblname.Caption = username Then
sOut = QuoteString(frmmain.lblname.Caption) & "," & QuoteString(lblright.Caption) & "," & QuoteString(frmtest.lblinvisible.Caption) & "," & QuoteString(pickdiff) & "," & QuoteString(lblstars.Caption) & "," & QuoteString(picktype)
Else
'
' if the usernames don't match write the existing details
'
sOut = QuoteString(username) & "," & QuoteString(score) & "," & QuoteString(outoff) & "," & QuoteString(difficulty) & "," & QuoteString(type1)
End If
Print #savefile, sOut
is functionally equivalent to
Code:
If frmmain.lblname.Caption = username Then
Write #savefile, frmmain.lblname.Caption; ","; lblright.Caption; ","; frmtest.lblinvisible.Caption; ","; pickdiff; ","; lblstart.Caption; ","; picktype
Else
'
' if the usernames don't match write the existing details
'
Write #savefile, username; ","; score; ","; outoff; ","; difficulty; ","; type1
End If
-
Re: Multiple viewing of Matching Data frp, a Textfile.
BTW: I know it's late in the day, but does your establishment have access to any Database systems (e.g. Microsoft Access)? This would be so much simpler if you were using a Database of some sort rather than flat files. Even if you're a 'beginner' gaining a basic 'grasp' of SQL is not difficult and the Database does all the 'hard work' involved in updating data in-situe, inserting and deleting records.
Also, if there's likely to be more than one Teacher / Administrator performing additions, deletions and updates you might (you're going to) have to consider how to manage the situation where two or more are attempting to simultaneously update the files (e.g. Lock the files when you open them). Again, a Database system looks after all that for you.
-
Re: Multiple viewing of Matching Data frp, a Textfile.
Sorry doogle, i think i messed up what i was trying to do.
Code:
Private Sub Form_Load()
Dim intfile As Integer
Dim savefile As Long
Dim sOut As String
Dim username As String, score As String, outoff As String, difficulty As String, starsearned As String, type1 As String, gametype As String
Dim fullname As String, username1 As String, pass As String, admin As String, Currentstars As String
Dim usercheck As String
Dim pickdiff As String
Dim picktype As String
Dim intfile2 As Integer
Dim newstars As String
Dim intfile3 As Integer
Dim newgametype As String
If frmquickgame.opteasy = True Then
pickdiff = "Easy"
ElseIf frmquickgame.optmedium = True Then
pickdiff = "Medium"
ElseIf frmquickgame.optmedium = True Then
pickdiff = "Hard"
End If
If frmquickgame.optaddition = True Then
picktype = "Addition"
ElseIf frmquickgame.optminus = True Then
picktype = "Subtraction"
ElseIf frmquickgame.opttimes = True Then
picktype = "Multiplication"
ElseIf frmquickgame.optdivide = True Then
picktype = "Division"
ElseIf frmquickgame.optall = True Then
picktype = "A Mixture"
End If
If qgame = True Then
newgametype = "Quick Game"
End If
intfile = FreeFile()
Open "Q:\IPT\project\vb prject2013\scores.txt" For Input As #intfile
Input #intfile, username, score, outoff, difficulty, starsearned, type1, gametype
sOut = QuoteString(username) & "," & QuoteString(frmtest.lblright.Caption) & "," & QuoteString(frmtest.lblinvisible.Caption) & "," & QuoteString(pickdiff) & "," & QuoteString(frmtest.lblstarscount.Caption) & "," & QuoteString(picktype) & "," & QuoteString(gametype)
Close intfile
savefile = FreeFile()
Open "Q:\IPT\project\vb prject2013\scores.txt" For Append As #savefile
Print #savefile, sOut
Close #savefile
intfile2 = FreeFile()
Open "Q:\IPT\project\vb prject2013\names.txt" For Input As intfile2
intfile3 = FreeFile()
Open "Q:\IPT\project\vb prject2013\names_temp.txt" For Output As intfile3
Do Until EOF(intfile2)
Input #intfile2, fullname, username1, pass, admin, Currentstars
If frmmain.lblname.Caption = username1 Then
newstars = Currentstars + Val(frmtest.lblstarscount.Caption)
Write #intfile3, fullname; username1; pass; admin; newstars
Else
Write #intfile3, fullname; username1; pass; admin; Currentstars
End If
Loop
Close #intfile2
Close #intfile3
Kill "Q:\IPT\project\vb prject2013\names.txt"
Name "Q:\IPT\project\vb prject2013\names_temp.txt" As "Q:\IPT\project\vb prject2013\names.txt"
End Sub
The addition of the stars to the names.txt is working fine however the scores.txt is adding a extra line of half information like so:
"user1","2","10","Easy","4","Multiplication","Quick Game"
"user2","8","10","Easy","8","Multiplication","Quick Game"
"user3","5","10","Easy","6","Addition","Quick Game"
"user2","6","12","Medium","5","Division","Quick Game"
"user1","0","0","","0","Addition","Quick Game"
"user1","3","12","","6","Addition","Quick Game"
When i want it to be:
"user1","2","10","Easy","4","Multiplication","Quick Game"
"user2","8","10","Easy","8","Multiplication","Quick Game"
"user3","5","10","Easy","6","Addition","Quick Game"
"user2","6","12","Medium","5","Division","Quick Game"
"user1","3","12","","6","Addition","Quick Game"
The the reason why i'm not using write statment because it was still not formatting the way i wanted it to. (i did try it on another computer and it worked-but the computer i'm on now is the predominate computer for use)
Could the print statement be causeing this extra line or possible the function. I did have a think that it may have something to do with the form loading when the this data hasnt been gathered since this whole thing is on the form load event.
-
Re: Multiple viewing of Matching Data frp, a Textfile.
Quote:
Originally Posted by
homer5677
I did have a think that it may have something to do with the form loading when the this data hasnt been gathered since this whole thing is on the form load event.
I would say that's exactly what the problem is. If you reference that Form before setting up any of the labels etc. then it will write the sort of line you're seeing.
-
Re: Multiple viewing of Matching Data frp, a Textfile.
that was it.
Say for instance if i had another text file formatted like so: username,0,0,0,0,0,0
on login i wanted to check if one or more of these is 1,(previously written as 1)
Can i do it as a case statement, for each 0. I dont want it too be like only one of these values because more than one may = 1 with different actions for each.
Trying to explain better:
I have unlocks as the '0' values. If they have been previously unlocked they are changed to a '1'. On login i want to be able to read what has been unlocked and disable the respective things that need to specifc to that particular unlock.
My code may help, but haven't actually attempted as i dont really know how to go about it.
Code:
Dim intfile As Integer
intfile = FreeFile()
Open "H:\IPT\project\vb prject2013\names.txt" For Input As intfile
intfile2 = FreeFile()
Open "H:\IPT\project\vb prject2013\unlocks.txt" For Input As intfile2
Do Until EOF(intfile)
Input #intfile, strItem1, strItem2, strItem3, strItem4, strItem5
If username = strItem2 And pass = strItem3 And strItem4 = "1" Then
LoginSucceeded = True 'Show next form and close this one'
adminsucceed = True
ElseIf username = strItem2 And pass = strItem3 And strItem4 = "0" Then
LoginSucceeded = True
adminsucceed = False
frmmain.lblwelcomename.Caption = "Welcome" & " " & strItem1
frmmain.lblname.Caption = strItem2
frmmain.lblstar.Caption = strItem5
Input #intfile2, doublestars, star5, theme1, theme2, theme3, theme4
If doublestars = 1 Then
'heree-dont know what to do here
End If
Loop
Close intfile
cheers
-
Re: Multiple viewing of Matching Data frp, a Textfile.
You're going to have to check that the usernames match then I think a simple If Then construct should be ok
Code:
Input #intfile2, usern, doublestars, star5, theme1, theme2, theme3, theme4
If usern = username Then
If doublestars = 1 Then
'
' code here to 'unlock' whatever
' needs to be unlocked if doublestars = 1
'
End If
If star5 = 1 Then
'
' code here to 'unlock' whatever
' needs to be unlocked if star5 = 1
'
End If
'etc
End If
-
Re: Multiple viewing of Matching Data frp, a Textfile.
Is there anything wrong with this code. Its just seems to be clearing the file instead of writing the required info to it!
Code:
Private Sub cmdunlockwrongstars_Click() 'Unlock -5 stars even if all answers are wrong!'
Ndoublestars = "0"
Nstars5 = "0"
Ntheme1 = "0"
Ntheme2 = "0"
Ntheme3 = "0"
Ntheme4 = "0"
If MsgBox("Are you sure you want to unlock this item for 20 stars?", vbYesNo + vbQuestion, "Confirm Choice") = vbYes Then 'Alerts the user about that it will cost them 5 stars'
If Val(lblstars.Caption) < 20 Then 'If the user doesn't have 5 stars they cannot pruchase the item'
If MsgBox("You do not have enough stars for this unlock!", vbExclamation + vbOKOnly, "Error") = vbOK Then 'Alerts the user that they need more stars'
lblstars.Caption = lblstars.Caption 'The total number of stars stays the same'
End If
Else 'If the user has more than 5 stars they can purchase the item
lblstars.Caption = lblstars.Caption - 20 '5 stars are taken away from the users current total
'message appears telling user to enable in options
cmdunlockwrongstars.Enabled = False 'the unlock button disappears so the user does not accidently press it and lose stars'
frmoptions.chkwrongstars.Enabled = True 'this unlock/option becomes enabled in options screen
Nstars5 = "1"
intfile = FreeFile()
Open "Q:\IPT\project\vb prject2013\unlocks.txt" For Input As intfile
intfile2 = FreeFile()
Open "Q:\IPT\project\vb prject2013\unlocks_temp.txt" For Output As intfile2
Do Until EOF(intfile2)
Input #intfile2, usernameq, doublestars, stars5, theme1, theme2, theme3, theme4
If usernameq = frmmain.lblname.Caption Then
Write #intfile2, usernameq, doublestars, Nstars5, theme1, theme2, theme3, theme4
Else
Write #intfile2, usernameq, doublestars, stars5, theme1, theme2, theme3, theme4
End If
Loop
Close #intfile
Close #intfile2
Kill "Q:\IPT\project\vb prject2013\unlocks.txt"
Name "Q:\IPT\project\vb prject2013\unlocks_temp.txt" As "Q:\IPT\project\vb prject2013\unlocks.txt"
End If
End If
End Sub
-
Re: Multiple viewing of Matching Data frp, a Textfile.
You should be inputting from intfile not intfile2
EDIT: BTW should '< 20' be '< 5' in the If statement ?
-
Re: Multiple viewing of Matching Data frp, a Textfile.
Quote:
Originally Posted by
Doogle
EDIT: BTW should '< 20' be '< 5' in the If statement ?
That is a different thing to do with if they have enough 'stars' to get the item. When i log in however it doesn't disable the things as instructed. I think below is alright, so it would have to be something else acting up this on the same button or form load of the next form?
THE SAVING NOW WORKS. however for them to not be able to press the button again i have this on the login enter button
Code:
intfile = FreeFile()
Open "Q:\IPT\project\vb prject2013\names.txt" For Input As intfile
intfile2 = FreeFile()
Open "Q:\IPT\project\vb prject2013\unlocks.txt" For Input As intfile2
Do Until EOF(intfile)
Input #intfile, strItem1, strItem2, strItem3, strItem4, strItem5
If username = strItem2 And pass = strItem3 And strItem4 = "1" Then
LoginSucceeded = True 'Show next form and close this one'
adminsucceed = True
ElseIf username = strItem2 And pass = strItem3 And strItem4 = "0" Then
LoginSucceeded = True
adminsucceed = False
frmmain.lblwelcomename.Caption = "Welcome" & " " & strItem1
frmmain.lblname.Caption = strItem2
frmmain.lblstar.Caption = strItem5
Input #intfile2, username1, doublestars, star5, theme1, theme2, theme3, theme4
If username1 = strItem2 Then
If doublestars = "1" Then
frmoptions.chkdoublestars.Enabled = True
frmshop.cmddoublestars.Enabled = False
End If
If star5 = 1 Then
frmoptions.chkwrongstars.Enabled = True
frmshop.cmdunlockwrongstars.Enabled = False
End If
If theme1 = "1" Then
frmoptions.optforresttheme.Enabled = True
frmshop.cmdforresttheme.Enabled = False
End If
If theme2 = "1" Then
frmoptions.optdarktheme.Enabled = True
frmshop.cmddarktheme.Enabled = False
End If
If theme3 = "1" Then
frmoptions.optluxurytheme.Enabled = True
frmshop.cmdluxtheme.Enabled = False
End If
If theme4 = "1" Then
frmoptions.optauroratheme.Enabled = True
frmshop.cmdaurtheme.Enabled = False
End If
End If
End If
Loop
Close intfile
Close intfile2
-
Re: Multiple viewing of Matching Data frp, a Textfile.
Accessing Forms 'frmoptions' and 'frmshop' will cause the Forms to be loaded and the Enables / Disables will be performed. If you subsequently Load the Forms then new copis will be loaded and the changes you've made will be lost. Since they're alread loaded then instead of Loading them just use the .Show method
e.g. If you've got 'Load frmoptions' somewhere, use 'frmoptions.Show' instead.
-
Re: Multiple viewing of Matching Data frp, a Textfile.
All good, silly mistake-> declares as integer instead of string (i know they probably should be as integer but they are strings everywhere in the program and to change would take a lot of fiddling around!)
Also found a problem when clicking users on the main teacher form. Can i some how lock what is clicked to the specific click because at the moment it is showing me 2 sets of data if i click 2 different users or the same user twice.
Teacher form:
Code:
Option Explicit
Dim mynameArray() As String
Dim myUserArray() As String
Dim myPwdArray() As String
Dim myDifficultArray() As String
Dim myScoreArray() As String
Dim myViewScoreArray() As String
Dim myOutofArray() As String
Dim myName1Array() As String
Dim myStarsArray() As String
Dim myTypeArray() As String
Dim myModeArray() As String
Private Sub cmdadd_Click()
frmnewuser.Show
frmnewuser.txtfullname.SetFocus
Unload Me
End Sub
Private Sub cmddelete_Click()
Dim fullname As String, username As String, password As String, level As String, stars As String
Dim strUser As String
Dim intfile As Integer, intfile2 As Integer
strUser = lstusers.List(lstusers.ListIndex)
If MsgBox("Are you sure you want to delete the user: " & strUser, vbQuestion + vbYesNo, "Delete") = vbYes Then
intfile = FreeFile()
Open "Q:\IPT\project\vb prject2013\names.txt" For Input As intfile
intfile2 = FreeFile
Open "Q:\IPT\project\vb prject2013\names_temp.txt" For Output As intfile2
lstusers.Clear
Do Until EOF(intfile)
Input #intfile, fullname, username, password, level, stars
If strUser <> fullname Then
Write #intfile2, fullname; username; password; level; stars
End If
Loop
Close #intfile
Close #intfile2
Kill "Q:\IPT\project\vb prject2013\names.txt"
Name "Q:\IPT\project\vb prject2013\names_temp.txt" As "Q:\IPT\project\vb prject2013\names.txt"
End If
End Sub
Private Sub cmdview_Click()
frmviewuser.Show
Me.Hide
Unload Me
End Sub
Private Sub cmdviewadmin_Click()
frmviewadmins.Show
Me.Hide
End Sub
Private Sub cmdviewscores_Click()
frmviewscore.Show
Me.Hide
End Sub
Private Sub Form_Load()
Dim intfile As Integer, x As Integer, y As Integer
Dim myLine As String, displayData As String
'
' Dimension the Dynamic Arrays to hold 200 elements
'
ReDim myPwdArray(199)
ReDim myUserArray(199)
intfile = FreeFile()
Open "Q:\IPT\project\vb prject2013\names.txt" For Input As intfile
Do While Not EOF(intfile)
Line Input #intfile, myLine
myLine = Replace(myLine, """", "")
If Len(Trim$(myLine)) > 0 Then
mynameArray = Split(myLine, ",")
If mynameArray(3) = "0" Then
lstusers.AddItem (mynameArray(0))
lstusers.ItemData(lstusers.NewIndex) = y
End If
If x > UBound(myPwdArray) Then
'
' If we've run out of elements then add another 200
'
ReDim Preserve myPwdArray(UBound(myPwdArray) + 200)
ReDim Preserve myPwdArray(UBound(myUserArray) + 200)
End If
myPwdArray(x) = (mynameArray(2))
myUserArray(x) = (mynameArray(1))
x = x + 1
y = y + 1
End If
Loop
'
'Resize the arrays to the actual number of elements used
'
ReDim Preserve myPwdArray(x - 1)
ReDim Preserve myPwdArray(x - 1)
Close intfile
x = 0
ReDim myName1Array(199)
ReDim myScoreArray(199)
ReDim myOutofArray(199)
ReDim myDifficultArray(199)
ReDim myStarsArray(199)
ReDim myTypeArray(199)
ReDim myModeArray(199)
intfile = FreeFile
Open "Q:\IPT\project\vb prject2013\scores.txt" For Input As intfile
Do While Not EOF(intfile)
Line Input #intfile, myLine
myLine = Replace(myLine, """", "")
If Len(Trim(myLine)) > 0 Then
If x > UBound(mynameArray) Then
ReDim Preserve myName1Array(UBound(myName1Array) + 200)
ReDim Preserve myScoreArray(UBound(myScoreArray) + 200)
ReDim Preserve myOutofArray(UBound(myOutofArray) + 200)
ReDim Preserve myDifficultArray(UBound(myDifficultArray) + 200)
ReDim Preserve myStarsArray(UBound(myStarsArray) + 200)
ReDim Preserve myStarsArray(UBound(myTypeArray) + 200)
ReDim Preserve myModeArray(UBound(myModeArray) + 200)
End If
myViewScoreArray = Split(myLine, ",")
myName1Array(x) = myViewScoreArray(0)
myScoreArray(x) = myViewScoreArray(1)
myOutofArray(x) = myViewScoreArray(2)
myStarsArray(x) = myViewScoreArray(4)
myDifficultArray(x) = myViewScoreArray(3)
myTypeArray(x) = myViewScoreArray(5)
myModeArray(x) = myViewScoreArray(6)
x = x + 1
End If
Loop
ReDim Preserve myName1Array(x - 1)
ReDim Preserve myScoreArray(x - 1)
ReDim Preserve myOutofArray(x - 1)
ReDim Preserve myDifficultArray(x - 1)
ReDim Preserve myStarsArray(x - 1)
ReDim Preserve myTypeArray(x - 1)
ReDim Preserve myModeArray(x - 1)
Close #intfile
End Sub
Private Sub lstusers_Click()
Dim I As Integer
frmviewuser.lblfullname.Caption = lstusers.List(lstusers.ListIndex)
frmviewuser.lblpassword.Caption = myPwdArray(lstusers.ItemData(lstusers.ListIndex))
frmviewuser.lblusername.Caption = myUserArray(lstusers.ItemData(lstusers.ListIndex))
frmviewscore.lblscore.Caption = vbNullString
For I = 0 To UBound(myName1Array)
If Trim$(myName1Array(I)) = Trim$(frmviewuser.lblusername.Caption) Then
frmviewscore.lblstarsearned.Caption = frmviewscore.lblstarsearned.Caption & myStarsArray(I) & vbNewLine
frmviewscore.lbldisplayscore.Caption = frmviewscore.lbldisplayscore.Caption & "On a " & myModeArray(I) & " game: " & myScoreArray(I) & " out of " & myOutofArray(I) & " at " & myTypeArray(I) & " on " & myDifficultArray(I) & " difficulty" & vbNewLine
End If
Next I
End Sub
-
Re: Multiple viewing of Matching Data frp, a Textfile.
I suspect you should set all the labels' Caption properties to vbNullString as you do with lblscore
Code:
frmviewscore.lblscore.Caption = vbNullString
frmviewscore.lblstarsearned.Caption = vbNullString
frmviewscore.lbldisplayscore.Caption = vbNullString
before the For loop in the lstusers_Click event.
