von MerlinOO » Do, 08.12.2022 18:28
Vielen Dank für die Mühe. Ganz zufrieden bin ich leider noch nicht.
Zur Info eine kurze Beschreibung
Ablauf des Spiels:
Klick auf Button Start
>im Hintergrund werden 14 Zufallszahlen erzeugt – bleiben aber noch versteckt
>Info über Grenzwerte
>Abfrage des xxtime-Wertes um die Zeitbegrenzung verändern zu können
> Wenn keine Eingabe erfolgt wird der letzte Wert übernommen
> erste Zahl wird gezeigt – Uhr beginnt zu laufen
>wird die Zahl gecheckt muss ein Button Team A oder B geklickt werden
>alternativ kann auch „geschoben“ werden, d.h. die Zahl gilt als nicht gecheckt und keiner erhält Punkte und es folgt die nächste Zahl.
>Punkte werden eingetragen – neue Zahl erscheint – Timer läuft neu.
Am Ende (nach 14 Durchgängen) werden Ergebnisse ausgewertet ect. und das Spiel kann durch Klicken auf Startbutton neu gestartet werden.
…genau da hakt es jetzt noch. Wenn ich ein neues Spiel starte und den alten Zeitwert übernehme rennt meine Zeit wieder durch.
Tom hat damit Recht, dass das setzen von timex in dem Beispiel unnötig ist. Bei vielem Probieren (ohne ausreichendes Grundwissen) habe ich viel experimentiert. Daher hatte ich timex als global gewählt, weil ich den Wert in anderen Sub‘s testweise neu gesetzt habe. Ich habe die Variablen jetzt als public dimensioniert.
Leider habe ich das mit dem Flag noch nicht verstanden.
Wenn ich die Zeitschleife unterbreche (durch Button der andere Makros auslöst) dann muss nach der Auswertung doch die Uhr von neuem laufen. Warum ist dann der Neuaufruf „warten“ dann falsch? Wenn das Programm nach allen „Umwegen“ ja wieder in der For – to Schleife(Countdown) ankommen würde, wäre das schön. Aber das klappt bei mir nicht so. Ich hatte es auch schon, dass der Zeitwert ins minus gelaufen ist.
Daher meine Idee irgendwo in den anderen Makros den xxtime-wert wieder hoch zu setzen.
Ich füge den Code aus diesem Modul mal hier ein. Es gibt noch andere Module die nur die Buttons beeinhalten oder andere Spielvarianten. Die vielen Print Anweisungen sollten mir helfen Fehler zu finden.
Code: Alles auswählen
REM ***** BASIC *****
dim bFlag as Boolean
public winteam as string
public GameO as Boolean
public oPlayer1
public bInit
public timex 'as integer
public xxtime as integer
'const xxtime=6
public timeout as Boolean
sub loeschen
myDoc = thisComponent
mySheet = myDoc.sheets.getbyname("Jacky4Check")
mySheet.getCellRangeByName("J3:J16").clearContents(7)
mySheet.getCellRangeByName("N3:N16").clearContents(7)
mySheet.getCellRangeByName("H3:H16").clearContents(7)
End sub
Sub Start
print "Start Gameover", GameO
Dim toCheck(14) As integer
Dim reihe As integer
Dim Von As integer
Dim Bis As Integer
Dim i As integer
Dim i2 As integer
myDoc = thisComponent
mySheet = myDoc.sheets.getbyname("Jacky4Check")
mycell = mysheet.getCellByPosition(5,0)
Von = mycell.value
mycell = mysheet.getCellByPosition(7,0)
Bis = mycell.value
MsgBox "Der Scoring-Bereich ist zwischen "& Von & " und " & Bis & " und kann oben geändert werden. Änderungen gelten im neuen Spiel", 0+64, "Säckchenspiel ***GAME ON***"
myDoc = thisComponent
mySheet = myDoc.sheets.getbyname("Jacky4Check")
Reihe = 0
beep
If Bis = 170 then ' Pruefen wegen Boogiezahlen - sonst keine 14 Zahlen möglich.
Bis = 163
If Von > 149 then Von = 149
End if
loeschen
For i = 1 to 14
toCheck(i) = Int((Bis - Von) *Rnd) + Von
If i > 1 then
for i2 = 1 to i-1
if toCheck(i) = toCheck(i2) then
i = i - 1
exit for
end if
next
End if
mycell = mysheet.getCellByPosition(13,i+1)
mycell.value = toCheck(i)
mycell = mysheet.getCellByPosition(14,i+1)
mycell.value = i
next i
settimeout
'xxtime = sWert
'timex=xxtime
print timex , xxtime
warten
End Sub
sub settimeout
Dim sWert As integer
Dim min as integer
min = 5
myDoc = thisComponent
mySheet = myDoc.sheets.getbyname("Jacky4Check")
mycell = mysheet.getCellByPosition(0,0)
altWert = mycell.value
mineingabe:
sWert = InputBox ("Zeitlimit in Sek. eingeben. Wird nicht innerhalb der Zeit gecheckt, "& _
"kann die Zeit neu gestartet werden oder es werden beiden Teams 0 Punkte eingetragen."& _
"Bei 0 oder 'enter' wird der zuletzt eingegbenen Wert von " & altWert & " Sek. übernommen","Zeitlimit bis zum Timeout")
'MsgBox ( sWert , 64, "Bestätigung")
if sWert = 0 or "" then
' mycell = mysheet.getCellByPosition(15,0)
sWert = altWert
print "Wert bleibt bei: ", sWert
end if
if sWert < min then
msgbox "Ein Wert unter "& min &" Sekunden macht wenig Sinn. So schnell ist nur ""Bully Boy""."
goto mineingabe
'settimeout
end if
'print "SWert in set ", sWert
'print sWert
xxtime = sWert
'myDoc = thisComponent
'mySheet = myDoc.sheets.getbyname("Jacky4Check")
mycell = mysheet.getCellByPosition(0,0)
mycell.value = sWert
'print "xxtime vor End Sub", xxtime
End Sub
Sub warten 'warten und Zeit in B1 anzeigen
bFlag = false
'myHeader = "Jacky 4 Check"
myDoc = thisComponent
mySheet = myDoc.sheets.getbyname("Jacky4Check")
mycell = mysheet.getCellByPosition(1,0)
myString = mycell.string
'print "xxtime in warten", xxtime
for timex = xxtime to 0 step -1
wait 1000
mycell.value = timex
next
'msgbox "timeout!" '################################################## TIMEOUT
timeout = true
if MsgBox ("TIMEOUT!- keine der Mannschaften erhält Punkte. --- " & _
" 'Ja' für nächste Zahl ---- 'Nein' = Zeit zurücksetzen und nochmal versuchen. ", 4+48 ,"TIMEOUT - zur nächsten Zahl oder nochmal versuchen?") = IDYES then
timex=xxtime
winteam = "x"
Teamwin
'exit sub
''warten
end if
'print "zurück von Teamwin"
warten
end sub
Sub Teamwin
Dim Zeile as integer
Zeile = 0
odoc = thiscomponent
oSheet = oDoc.sheets.getbyname("Jacky4Check")
oCellRange = oSheet.getCellRangeByName("H2:H16")
oEmptyCells = oCellRange.queryEmptyCells
oFirstEmptyCell = oEmptyCells(0).getCellByPosition(0,0)
sColumn = oFirstEmptyCell.Columns(0).Name
aCelladdress = oFirstEmptyCell.Celladdress
Zeile = aCelladdress.Row
myDoc = thisComponent
'mySheet = myDoc.sheets(0)
mySheet = myDoc.sheets.getbyname("Jacky4Check")
mycell = mysheet.getCellByPosition(7, Zeile)
mycell.string = winteam
Jacky
Gameover
If GameO = true then
mySheet = myDoc.sheets.getbyname("Jacky4Check")
mycell = mysheet.getCellByPosition(1,16)
myString=mycell.string
MsgBox "GAME OVER - " & myCell.string , 6+64, "OK - für neues Spiel"
'bFlag = true
Start
Exit Sub
End If
timex=xxtime
End Sub
Sub Jacky
myDoc = thisComponent
mySheet = myDoc.sheets.getbyname("Jacky4Check")
mycell = mysheet.getCellByPosition(9,0)
myString=mycell.string
Score = mysheet.getCellByPosition(1,2)
myScore = Score.value
myString=mycell.string
If myString = "Jacky" then
Beep
' Wait 1000 ' Millisekunden warten
Beep
' S_InitSounds 'aktivieren wenn Soundausgabe möglich ist.
MsgBox "Wer die " & myScore & " mit der nächsten Aufnahme checkt verdient einen Jacky-Cola (oder ähnliches)!", 6, "J A C K Y for C H E C K ! - für die " & myScore
End If
End Sub
Sub Gameover
GameO = false
'print "sub gameover"
myDoc = thisComponent
mySheet = myDoc.sheets.getbyname("Jacky4Check")
mycell = mysheet.getCellByPosition(2,1)
myString=mycell.string
If myString = "GAME OVER" then
GameO = true
End If
End Sub
'*******************************************************************************
'Soundausgabe
Sub S_InitSounds
if bInit then
S_Start_New
exit sub
endif
sUrlSound = F_get_Sound_URL("Jacky.m4a")
dim oPlayer as Object
If GetGuiType() = 1 Then
oSounMgr = CreateUnoService("com.sun.star.media.Manager_DirectX")
Else
oSounMgr = CreateUnoService("com.sun.star.media.Manager_GStreamer")
End If
If NOT IsNull(oSounMgr) Then
If fileexists(sUrlSound) Then
oPlayer1 = oSounMgr.createPlayer(sUrlSound)
oPlayer1.setPlaybackLoop(False)
oPlayer1.setMediaTime(0.0)
oPlayer1.start()
bInit = true 'nach dem ersten Abspielen true -> beim den nächsten Durchlauf wird kein neuer Player initialisiert, sondern S_Start_New aufgerufen.
End If
End If
End Sub
function F_get_Sound_URL(sSoundname)
sFolderUrl = Replace(ThisComponent.URL, ThisComponent.Title,"")'Bestimmung des aktuellen Verzeichnisses
F_get_Sound_URL = sFolderUrl & sSoundname
end function
sub S_Start_New
oPlayer1.setMediaTime(0.0)
oPlayer1.start()
end sub
'****************************************************************************
Vielen Dank für die Mühe. Ganz zufrieden bin ich leider noch nicht.
Zur Info eine kurze Beschreibung
Ablauf des Spiels:
Klick auf Button Start
>im Hintergrund werden 14 Zufallszahlen erzeugt – bleiben aber noch versteckt
>Info über Grenzwerte
>Abfrage des xxtime-Wertes um die Zeitbegrenzung verändern zu können
> Wenn keine Eingabe erfolgt wird der letzte Wert übernommen
> erste Zahl wird gezeigt – Uhr beginnt zu laufen
>wird die Zahl gecheckt muss ein Button Team A oder B geklickt werden
>alternativ kann auch „geschoben“ werden, d.h. die Zahl gilt als nicht gecheckt und keiner erhält Punkte und es folgt die nächste Zahl.
>Punkte werden eingetragen – neue Zahl erscheint – Timer läuft neu.
Am Ende (nach 14 Durchgängen) werden Ergebnisse ausgewertet ect. und das Spiel kann durch Klicken auf Startbutton neu gestartet werden.
…genau da hakt es jetzt noch. Wenn ich ein neues Spiel starte und den alten Zeitwert übernehme rennt meine Zeit wieder durch.
Tom hat damit Recht, dass das setzen von timex in dem Beispiel unnötig ist. Bei vielem Probieren (ohne ausreichendes Grundwissen) habe ich viel experimentiert. Daher hatte ich timex als global gewählt, weil ich den Wert in anderen Sub‘s testweise neu gesetzt habe. Ich habe die Variablen jetzt als public dimensioniert.
Leider habe ich das mit dem Flag noch nicht verstanden.
Wenn ich die Zeitschleife unterbreche (durch Button der andere Makros auslöst) dann muss nach der Auswertung doch die Uhr von neuem laufen. Warum ist dann der Neuaufruf „warten“ dann falsch? Wenn das Programm nach allen „Umwegen“ ja wieder in der For – to Schleife(Countdown) ankommen würde, wäre das schön. Aber das klappt bei mir nicht so. Ich hatte es auch schon, dass der Zeitwert ins minus gelaufen ist.
Daher meine Idee irgendwo in den anderen Makros den xxtime-wert wieder hoch zu setzen.
Ich füge den Code aus diesem Modul mal hier ein. Es gibt noch andere Module die nur die Buttons beeinhalten oder andere Spielvarianten. Die vielen Print Anweisungen sollten mir helfen Fehler zu finden.
[code]REM ***** BASIC *****
dim bFlag as Boolean
public winteam as string
public GameO as Boolean
public oPlayer1
public bInit
public timex 'as integer
public xxtime as integer
'const xxtime=6
public timeout as Boolean
sub loeschen
myDoc = thisComponent
mySheet = myDoc.sheets.getbyname("Jacky4Check")
mySheet.getCellRangeByName("J3:J16").clearContents(7)
mySheet.getCellRangeByName("N3:N16").clearContents(7)
mySheet.getCellRangeByName("H3:H16").clearContents(7)
End sub
Sub Start
print "Start Gameover", GameO
Dim toCheck(14) As integer
Dim reihe As integer
Dim Von As integer
Dim Bis As Integer
Dim i As integer
Dim i2 As integer
myDoc = thisComponent
mySheet = myDoc.sheets.getbyname("Jacky4Check")
mycell = mysheet.getCellByPosition(5,0)
Von = mycell.value
mycell = mysheet.getCellByPosition(7,0)
Bis = mycell.value
MsgBox "Der Scoring-Bereich ist zwischen "& Von & " und " & Bis & " und kann oben geändert werden. Änderungen gelten im neuen Spiel", 0+64, "Säckchenspiel ***GAME ON***"
myDoc = thisComponent
mySheet = myDoc.sheets.getbyname("Jacky4Check")
Reihe = 0
beep
If Bis = 170 then ' Pruefen wegen Boogiezahlen - sonst keine 14 Zahlen möglich.
Bis = 163
If Von > 149 then Von = 149
End if
loeschen
For i = 1 to 14
toCheck(i) = Int((Bis - Von) *Rnd) + Von
If i > 1 then
for i2 = 1 to i-1
if toCheck(i) = toCheck(i2) then
i = i - 1
exit for
end if
next
End if
mycell = mysheet.getCellByPosition(13,i+1)
mycell.value = toCheck(i)
mycell = mysheet.getCellByPosition(14,i+1)
mycell.value = i
next i
settimeout
'xxtime = sWert
'timex=xxtime
print timex , xxtime
warten
End Sub
sub settimeout
Dim sWert As integer
Dim min as integer
min = 5
myDoc = thisComponent
mySheet = myDoc.sheets.getbyname("Jacky4Check")
mycell = mysheet.getCellByPosition(0,0)
altWert = mycell.value
mineingabe:
sWert = InputBox ("Zeitlimit in Sek. eingeben. Wird nicht innerhalb der Zeit gecheckt, "& _
"kann die Zeit neu gestartet werden oder es werden beiden Teams 0 Punkte eingetragen."& _
"Bei 0 oder 'enter' wird der zuletzt eingegbenen Wert von " & altWert & " Sek. übernommen","Zeitlimit bis zum Timeout")
'MsgBox ( sWert , 64, "Bestätigung")
if sWert = 0 or "" then
' mycell = mysheet.getCellByPosition(15,0)
sWert = altWert
print "Wert bleibt bei: ", sWert
end if
if sWert < min then
msgbox "Ein Wert unter "& min &" Sekunden macht wenig Sinn. So schnell ist nur ""Bully Boy""."
goto mineingabe
'settimeout
end if
'print "SWert in set ", sWert
'print sWert
xxtime = sWert
'myDoc = thisComponent
'mySheet = myDoc.sheets.getbyname("Jacky4Check")
mycell = mysheet.getCellByPosition(0,0)
mycell.value = sWert
'print "xxtime vor End Sub", xxtime
End Sub
Sub warten 'warten und Zeit in B1 anzeigen
bFlag = false
'myHeader = "Jacky 4 Check"
myDoc = thisComponent
mySheet = myDoc.sheets.getbyname("Jacky4Check")
mycell = mysheet.getCellByPosition(1,0)
myString = mycell.string
'print "xxtime in warten", xxtime
for timex = xxtime to 0 step -1
wait 1000
mycell.value = timex
next
'msgbox "timeout!" '################################################## TIMEOUT
timeout = true
if MsgBox ("TIMEOUT!- keine der Mannschaften erhält Punkte. --- " & _
" 'Ja' für nächste Zahl ---- 'Nein' = Zeit zurücksetzen und nochmal versuchen. ", 4+48 ,"TIMEOUT - zur nächsten Zahl oder nochmal versuchen?") = IDYES then
timex=xxtime
winteam = "x"
Teamwin
'exit sub
''warten
end if
'print "zurück von Teamwin"
warten
end sub
Sub Teamwin
Dim Zeile as integer
Zeile = 0
odoc = thiscomponent
oSheet = oDoc.sheets.getbyname("Jacky4Check")
oCellRange = oSheet.getCellRangeByName("H2:H16")
oEmptyCells = oCellRange.queryEmptyCells
oFirstEmptyCell = oEmptyCells(0).getCellByPosition(0,0)
sColumn = oFirstEmptyCell.Columns(0).Name
aCelladdress = oFirstEmptyCell.Celladdress
Zeile = aCelladdress.Row
myDoc = thisComponent
'mySheet = myDoc.sheets(0)
mySheet = myDoc.sheets.getbyname("Jacky4Check")
mycell = mysheet.getCellByPosition(7, Zeile)
mycell.string = winteam
Jacky
Gameover
If GameO = true then
mySheet = myDoc.sheets.getbyname("Jacky4Check")
mycell = mysheet.getCellByPosition(1,16)
myString=mycell.string
MsgBox "GAME OVER - " & myCell.string , 6+64, "OK - für neues Spiel"
'bFlag = true
Start
Exit Sub
End If
timex=xxtime
End Sub
Sub Jacky
myDoc = thisComponent
mySheet = myDoc.sheets.getbyname("Jacky4Check")
mycell = mysheet.getCellByPosition(9,0)
myString=mycell.string
Score = mysheet.getCellByPosition(1,2)
myScore = Score.value
myString=mycell.string
If myString = "Jacky" then
Beep
' Wait 1000 ' Millisekunden warten
Beep
' S_InitSounds 'aktivieren wenn Soundausgabe möglich ist.
MsgBox "Wer die " & myScore & " mit der nächsten Aufnahme checkt verdient einen Jacky-Cola (oder ähnliches)!", 6, "J A C K Y for C H E C K ! - für die " & myScore
End If
End Sub
Sub Gameover
GameO = false
'print "sub gameover"
myDoc = thisComponent
mySheet = myDoc.sheets.getbyname("Jacky4Check")
mycell = mysheet.getCellByPosition(2,1)
myString=mycell.string
If myString = "GAME OVER" then
GameO = true
End If
End Sub
'*******************************************************************************
'Soundausgabe
Sub S_InitSounds
if bInit then
S_Start_New
exit sub
endif
sUrlSound = F_get_Sound_URL("Jacky.m4a")
dim oPlayer as Object
If GetGuiType() = 1 Then
oSounMgr = CreateUnoService("com.sun.star.media.Manager_DirectX")
Else
oSounMgr = CreateUnoService("com.sun.star.media.Manager_GStreamer")
End If
If NOT IsNull(oSounMgr) Then
If fileexists(sUrlSound) Then
oPlayer1 = oSounMgr.createPlayer(sUrlSound)
oPlayer1.setPlaybackLoop(False)
oPlayer1.setMediaTime(0.0)
oPlayer1.start()
bInit = true 'nach dem ersten Abspielen true -> beim den nächsten Durchlauf wird kein neuer Player initialisiert, sondern S_Start_New aufgerufen.
End If
End If
End Sub
function F_get_Sound_URL(sSoundname)
sFolderUrl = Replace(ThisComponent.URL, ThisComponent.Title,"")'Bestimmung des aktuellen Verzeichnisses
F_get_Sound_URL = sFolderUrl & sSoundname
end function
sub S_Start_New
oPlayer1.setMediaTime(0.0)
oPlayer1.start()
end sub
'****************************************************************************
[/code]