Vaag probleem met scorebord

LuckyFm · 17 aug 2017

Hallo forum leden,

Bij mijn zelf ontworpen scorebord loop ik tegen een heel vaag probleem aan.
eerst maar even de code:

Code:

            KeyCode = 1
            Case vbKeyNumpad1
            Me.txtLastKey1 = ""
            If Me.txtRed1 + Me.txtRed2 = 15 Then
            KeyCode = 0
            Me.txtDirt27 = 0
            Me.txt27 = 27
            Me.txtMax = Me.txtMax - Me.txtSerie1
            Me.picColor.Visible = True
            Me.picColor.Picture = "C:\KCS\Yellow.png"
            Else
            Me.txtRed1 = Me.txtRed1 + 1
            Me.txtPoints1 = Me.txtPoints1 + 1
            Me.txtSerie1 = Me.txtSerie1 + 1
            Me.txtMax = Me.txtMax - 7
            If Me.txtSerie1 > Me.txtHighBreak1 Then
            Me.txtHighBreak1 = Me.txtSerie1
            End If
            End If
            KeyCode = 1

            Case vbKeyNumpad2
            Me.txtLastKey1 = ""
            If Me.txtRed1 + Me.txtRed2 = 15 Then
            Me.txtDirt27 = Me.txtDirt27 + 2
            Me.picColor.Picture = "C:\KCS\Green.png"
            End If
            Me.txtYellow1 = Me.txtYellow1 + 1
            Me.txtPoints1 = Me.txtPoints1 + 2
            Me.txtSerie1 = Me.txtSerie1 + 2
            If Me.txt27 = 27 Then
            Me.txtMax = Me.txtMax - 2
            Else
            Me.txtMax = Me.txtMax + 2
            End If
            If Me.txtSerie1 > Me.txtHighBreak1 Then
            Me.txtHighBreak1 = Me.txtSerie1
            End If
            KeyCode = 1
            Case vbKeyNumpad3
            Me.txtLastKey1 = ""
            If Me.txtRed1 + Me.txtRed2 = 15 Then
            Me.txtDirt27 = Me.txtDirt27 + 3
            Me.picColor.Picture = "C:\KCS\Brown.png"
            End If
            Me.txtGreen1 = Me.txtGreen1 + 1
            Me.txtPoints1 = Me.txtPoints1 + 3
            Me.txtSerie1 = Me.txtSerie1 + 3
            If Me.txt27 = 27 Then
            Me.txtMax = Me.txtMax - 3
            Else
            Me.txtMax = Me.txtMax + 3
            End If
            If Me.txtSerie1 > Me.txtHighBreak1 Then
            Me.txtHighBreak1 = Me.txtSerie1
            End If
            KeyCode = 1
            Case vbKeyNumpad4
            Me.txtLastKey1 = ""
            If Me.txtRed1 + Me.txtRed2 = 15 Then
            Me.txtDirt27 = Me.txtDirt27 + 4
            Me.picColor.Picture = "C:\KCS\Blue.png"
            End If
            Me.txtBrown1 = Me.txtBrown1 + 1
            Me.txtPoints1 = Me.txtPoints1 + 4
            Me.txtSerie1 = Me.txtSerie1 + 4
            If Me.txt27 = 27 Then
            Me.txtMax = Me.txtMax - 4
            Else
            Me.txtMax = Me.txtMax + 4
            End If
            If Me.txtSerie1 > Me.txtHighBreak1 Then
            Me.txtHighBreak1 = Me.txtSerie1
            End If
            KeyCode = 1
            Case vbKeyNumpad5
            Me.txtLastKey1 = ""
            If Me.txtRed1 + Me.txtRed2 = 15 Then
            Me.txtDirt27 = Me.txtDirt27 + 5
            Me.picColor.Picture = "C:\KCS\Pink.png"
            End If
            Me.txtBlue1 = Me.txtBlue1 + 1
            Me.txtPoints1 = Me.txtPoints1 + 5
            Me.txtSerie1 = Me.txtSerie1 + 5
            If Me.txt27 = 27 Then
            Me.txtMax = Me.txtMax - 5
            Else
            Me.txtMax = Me.txtMax + 5
            End If
            If Me.txtSerie1 > Me.txtHighBreak1 Then
            Me.txtHighBreak1 = Me.txtSerie1
            End If
            KeyCode = 1
            Case vbKeyNumpad6
            Me.txtLastKey1 = ""
            If Me.txtRed1 + Me.txtRed2 = 15 Then
            Me.txtDirt27 = Me.txtDirt27 + 6
            Me.picColor.Picture = "C:\KCS\Black.png"
            End If
            Me.txtPink1 = Me.txtPink1 + 1
            Me.txtPoints1 = Me.txtPoints1 + 6
            Me.txtSerie1 = Me.txtSerie1 + 6
            If Me.txt27 = 27 Then
            Me.txtMax = Me.txtMax - 6
            Else
            Me.txtMax = Me.txtMax + 6
            End If
            If Me.txtSerie1 > Me.txtHighBreak1 Then
            Me.txtHighBreak1 = Me.txtSerie1
            End If
            KeyCode = 1
            Case vbKeyNumpad7
            Me.txtLastKey1 = ""
            If Me.txtRed1 + Me.txtRed2 = 15 Then
            Me.txtDirt27 = Me.txtDirt27 + 7
            Me.picColor.Picture = ""
            End If
            Me.txtBlack1 = Me.txtBlack1 + 1
            Me.txtPoints1 = Me.txtPoints1 + 7
            Me.txtSerie1 = Me.txtSerie1 + 7
            If Me.txt27 = 27 Then
            Me.txtMax = Me.txtMax - 7
            Else
            Me.txtMax = Me.txtMax + 7
            End If
            If Me.txtSerie1 > Me.txtHighBreak1 Then
            Me.txtHighBreak1 = Me.txtSerie1
            End If
            KeyCode = 1
            Case vbKeyAdd
            If Me.txtPoints1 = Me.txtPoints2 Then
            DoCmd.OpenForm "frmBlackballGame"
            Exit Sub
            ElseIf Me.txtPoints1 < Me.txtPoints2 And Me.txtBestOf = 0 Then
            Me.txtSp2Frame = Me.txtSp2Frame + 1
            Me.TXTRunFrame = Me.TXTRunFrame + 1
            Else
            Me.txtSp1Frame = Me.txtSp1Frame + 1
            Me.TXTRunFrame = Me.TXTRunFrame + 1
            End If

lijkt mij redelijk recht vooruit, het gaat wat ver om de hele werking en wat alles doet hier uit te leggen doet er ook niet echt toe.
mijn probleem is dat ik een hele partij kan uitspelen dan wordt de stand dus 1-0 en start de volgende partij.

Nu komt het maximaal 147 punten te behalen (Snooker) 10 rode, 9 zwarte ballen 73 punten behaald 67 over.
fout op 6 dus 6 punten voor speler 2 en 67 punten over maakt weer 73.
5 keer rood 5 keer zwart...
De eerste partij werkte dat prima maar bij de tweede partij kan ik onmogelijk de 5e zwarte bal noteren, wordt er gewoon niet bijgeteld.

Met mijn beperkte kennis zou ik zeggen dat het ergens in het formulier fout gaat, maar ik kan echt niet vinden waar.
En als ik speler 1 de eerste partij laat winnen, loopt het vast bij speler 2 en omgekeerd loopt het dan vast bij speler 1.

Hopelijk heeft iemand de oplossing

Alvast bedankt voor de hulp

Groet, Luc.

Code:

            Me.txtLastKey1 = ""
            If Me.txtRed1 + Me.txtRed2 = 15 Then
            KeyCode = 0

Werkt pas nadat ik nogmaals op de 1 heb gedrukt

OctaFish · 17 aug 2017

Is je tabtoets kapot? Code op deze manier opgemaakt zou voor mij onleesbaar zijn

. Zo snap ik 'm wel:

Code:

    Case vbKeyNumpad1
        Me.txtLastKey1 = ""
        If Me.txtRed1 + Me.txtRed2 = 15 Then
            KeyCode = 0
            Me.txtDirt27 = 0
            Me.txt27 = 27
            Me.txtMax = Me.txtMax - Me.txtSerie1
            Me.picColor.Visible = True
            Me.picColor.Picture = "C:\KCS\Yellow.png"
        Else
            Me.txtRed1 = Me.txtRed1 + 1
            Me.txtPoints1 = Me.txtPoints1 + 1
            Me.txtSerie1 = Me.txtSerie1 + 1
            Me.txtMax = Me.txtMax - 7
            If Me.txtSerie1 > Me.txtHighBreak1 Then
                Me.txtHighBreak1 = Me.txtSerie1
            End If
        End If
        KeyCode = 1
    Case vbKeyNumpad2
etc.

Maar goed, als jij het maar snapt is dat natuurlijk prima. Wel graag voor ons, minder snel van begrip zijnde lezers, wat netter opmaken zodat wij sneller kunnen zien wat er gaande is.
Dat is, zonder gelijk in details te treden, best lastig omdat er nogal wat code ontbreekt. Het mooist zou het natuurlijk zijn om de db erbij te hebben. Ik krijg de indruk dat je nu heel erg moeilijk doet. Zelf zou ik voor het bijhouden van de scores een simpel formulier bouwen met de 7 ballen erop en dan met de muis (of, als je een touchscreeen hebt, met een vinger) op de juiste bal klikken. Heeft als voordeel dat je geen verkeerde cijfers kunt indrukken, en je kunt de code ontzettend veel simpeler houden, omdat je meer eigenschappen kunt gebruiken.

LuckyFm · 19 aug 2017

Fout 2585

Beste forumleden,

Allereerst Octafish bedankt voor je reactie, ik weet alleen niet of het handig is om mijn hele database met iedereen te delen.
Wil hem natuurlijk graag naar je toesturen.
En ja het is niet echt duidelijk qua opmaak daar moet ik zeker nog aan werken, mijn excuses hiervoor.

Ik heb ontdekt dat het bovenstaande probleem is opgelost als ik het scorebord formulier afsluit en daarna weer opstart.

Helaas krijg ik dan de melding "Fout 2585 tijdens uitvoering:"

Nu begrijp ik dat kennelijk het formulier nog ergens mee bezig is, maar geen idee waarmee.

Code:

Private Sub txtBrSp1_Exit(Cancel As Integer)

                Me.HighBreak1 = Me.txtHighBreak1
                Me.Break1 = Me.txtSerie1
                Me.txtClr27 = Me.txtDirt27
            
            If Me.picColor.Visible = True Then
                Me.txtMax = Me.txtMax
            Else
                Me.txtMax = (15 - (Me.txtRed1 + Me.txtRed2)) * 8 + 27
            End If
                Me.txtBrSp1 = ""
            
            
            If Me.txtPoints1 > Me.txtMax + Me.txtPoints2 Then
                Me.lblBreak2.Caption = " Snookers Required"
            Else
                Me.lblBreak2.Caption = "Points"
            End If
            
            Me.txtBrSp2.SetFocus
            
    If Me.txtClr27 = 27 And Me.txtPoints1 = Me.txtPoints2 Then
                DoCmd.OpenForm "frmBlackballGame"
            If Me.txtDirt27 <> 20 Then
                Me.txtDirt27 = 20
                Me.txtMax = 7
                Me.txtSerie1 = 0
                Me.txtSerie2 = 0
            End If
            Exit Sub
     ElseIf Me.txtClr27 = 27 Then
            If Me.txtPoints1 < Me.txtPoints2 Then
                Me.txtSp2Frame = Me.txtSp2Frame + 1
                Me.Frames2 = Me.txtSp2Frame
                Me.TXTRunFrame = Me.TXTRunFrame + 1
                Me.txtMax = 0
            Else
                Me.txtSp1Frame = Me.txtSp1Frame + 1
                Me.Frames2 = Me.txtSp1Frame
                Me.TXTRunFrame = Me.TXTRunFrame + 1
                Me.txtMax = 0
            End If
            
            Dim sqlAdd As String
            Dim PlDate As Date
                PlDate = Format(Now, "dd-mm-yyyy")

                sqlAdd = "insert into tblResult(Speler1ID, Speler2ID, Speler1, Speler2, Break1, Break2, HighBreak1, HighBreak2, Frames1, Frames2, PlayDate) values('" & Me.txtSp1ID & "', '" & Me.txtSp2ID & "', '" & Me.txtSpeler1 & "', '" & Me.txtSpeler2 & "', '" & Me.txtPoints1 & "', '" & Me.txtPoints2 & "', '" & Me.txtHighBreak1 & "', '" & Me.txtHighBreak2 & "', '" & Me.txtSp1Frame & "', '" & Me.txtSp2Frame & "',#" & PlDate & "# );"
                DoCmd.RunSQL sqlAdd
                Pause (1)
            
            If Me.txtHighBreak1 > Me.txtHBr1 Then
            
            Dim sqlUpdA As String
            Dim sqlUpdPA As String
            Dim Br1Date As Date
                BrDate = Format(Now, "dd-mm-yyyy")

                sqlUpdA = "UPDATE tblSpelers SET HighBreak= " & Me.txtHighBreak1 & ", BrDate= #" & BrDate & "# WHERE SpelerId=" & Me.txtSp1ID
                sqlUpdPA = "UPDATE tblPartij SET Break1 = " & Me.txtHighBreak1 & " WHERE Speler1ID=" & Me.txtSp1ID

                DoCmd.RunSQL sqlUpdA
            Pause (1)
                DoCmd.RunSQL sqlUpdPA
            End If
            
            Pause (1)
            
            If Me.txtHighBreak2 > Me.txtHBr2 Then
            
            Dim sqlUpdB As String
            Dim sqlUpdPB As String

                sqlUpdB = "UPDATE tblSpelers SET HighBreak = " & Me.txtHighBreak2 & ", BrDate= #" & BrDate & "#  WHERE SpelerId=" & Me.txtSp2ID
                sqlUpdPB = "UPDATE tblPartij SET Break2 = " & Me.txtHighBreak2 & " WHERE Speler2ID=" & Me.txtSp2ID

                DoCmd.RunSQL sqlUpdB
            Pause (1)
                DoCmd.RunSQL sqlUpdPB
            End If
            
            Pause (1)
            
                Me.picColor.Visible = False
                Me.txtPoints1 = 0
                Me.txtPoints2 = 0
                Me.txtHighBreak1 = 0
                Me.txtHighBreak2 = 0
                Me.txtFoul1 = 0
                Me.txtFoul2 = 0
                Me.txt27 = 0
                Me.txtRed1 = 0
                Me.txtRed2 = 0
                Me.txtYellow1 = 0
                Me.txtYellow2 = 0
                Me.txtGreen1 = 0
                Me.txtGreen2 = 0
                Me.txtBrown1 = 0
                Me.txtBrown2 = 0
                Me.txtBlue1 = 0
                Me.txtBlue2 = 0
                Me.txtPink1 = 0
                Me.txtPink2 = 0
                Me.txtBlack1 = 0
                Me.txtBlack2 = 0
                Me.txtMax = 0
                Me.txtDirt27 = ""
                Me.txtClr27 = ""
                DoCmd.RunCommand acCmdSaveRecord
        Pause (1)
             DoCmd.OpenForm "frmFrameEnd"
             DoCmd.Close acForm, "FrmBord"
            
            
    End If

End Sub

Wellicht kijk ik ergens overheen, of moet ik heel ergens anders naar kijken.
Ik heb werkelijk geen idee waar ik het dan moet zoeken, wellicht kan iemand mij op weg helpen.

Alvast bedankt voor de medewerking.

Gr, Luc

OctaFish · 19 aug 2017

Als je wilt, mag je de db wel opsturen. Dan kijk ik er wel even naar.

LuckyFm · 19 aug 2017

Verzonden

Octafish,

De email met database is verzonden.
Bedankt dat je de moeite wil nemen om er even naar te kijken.

Gr, Luc

Vaag probleem met scorebord

LuckyFm

Gebruiker

OctaFish

Verenigingslid

LuckyFm

Gebruiker

OctaFish

Verenigingslid

LuckyFm

Gebruiker

Nieuwste berichten

Wij waarderen jouw privacy