http://dieseyer.de • all rights reserved • © 2011 v11.4
<!--
'*** v8.3 *** www.dieseyer.de *******************************
'
' Datei: spielchen.hta
' Autor: mike-winxp@gmx.de
' Auf: www.dieseyer.de
'
'************************************************************
-->
<head>
<meta http-equiv="Content-Language" content="de">
<meta http-equiv="Content-Type" content="text/html; charset=windows-1252">
<title>Game without a name</title>
<HTA:APPLICATION ID="oHTA"
SCROLL="yes"
SHOWINTASKBAR="yes"
APPLICATIONNAME="Game without a name"
singleinstance="yes"
>
<style type="text/css">
<!--
body,td,th {
color: #CCCCCC;
font-family: Arial, Helvetica, sans-serif;
font-size: 10px;
}
body {
background-color: #4a4a4a;
}
a {
font-size: 10px;
color: #CCCCCC;
}
a:link {
text-decoration: none;
}
a:visited {
text-decoration: none;
color: #CCCCCC;
}
a:hover {
text-decoration: underline;
}
a:active {
text-decoration: none;
}
.Stil1 {font-size: 14px}
.Stil2 {font-size: 10px; }
-->
</style>
</head>
<script language="VBscript">
Dim WshShell : Set WSHShell = CreateObject("Wscript.Shell")
Dim WSHnet : Set WSHnet = CreateObject("WScript.NetWork")
Dim Fso : Set Fso = CreateObject("Scripting.FileSystemObject")
Dim Zahlen : Zahlen = "123456789111213141516171819"
Dim click : click = 0
Dim click2
Dim save
'****************************************
sub Beim_Laden()
'****************************************
' window.moveto Links, Oben
' window.moveto 0, 0
' window.resizeto Breite, Höhe
window.resizeto 750, screen.height-130
' window.resizeto 650, 550
call Install
iText = iText & "<center><input type='button' value='Infos ausblenden' name='information' onClick='ausblenden()' style='background-color: #54514D; background-repeat: repeat; background-attachment: scroll; color: #CCCCCC; position: relative; border-style: outset; border-width: 1; background-position: 0% 50%' ></center>"
iText = iText & "<br></br><br></br>"
iText = iText & "<center><u>Die Regeln:</u></font></center>"
iText = iText & "<p align='center'><font face='Lucida Calligraphy' size'1'>Du darfst gleiche Zahlen, die übereinander bzw. "
iText = iText & "nebeneinander liegen, wegstreichen.<br>"
iText = iText & "<br>"
iText = iText & "Auch wenn die Summe zweier (nebeneinander / übereinander liegender) Zahlen 10 ergibt, dürfen diese gestrichen werden. <br>"
iText = iText & "<br>"
iText = iText & "Dies gilt auch für die letzte Zahl in einer Reihe und die erste Zahl der darauf folgenden Reihe.<br>"
iText = iText & "<br>"
iText = iText & "Wenn sich keine Zahlen mehr wegstreichen lassen, werden die übriggebliebenen Zahlen abgeschrieben "
iText = iText & "und alles beginnt von Neuem.<br>"
iText = iText & "<br>"
iText = iText & "Wenn eine Zahl gestrichen wurde, dürfen auch die Zahlen daneben gestrichen werden, wenn einer der oben genannten Fälle eingetreten ist:<br>"
iText = iText & "<br>"
iText = iText & "Beispiel:<br>"
iText = iText & "Stehen 121 nebeneinander und über der 2 steht eine 8, ergibt das 10, dann dürfen auch die 1er gestrichen "
iText = iText & "werden (da gleiche Zahl). </font><font size='3' face='Lucida Calligraphy'><br>"
iText = iText & "<a href='http://www.picupload.net/uploads/c955b2368186d1c1beec9e08ca83edde.jpg' target='_blank'><font color='#FFFF00'>Weitere Infos</font></a></center>"
document.all.info.innerHTML = iText
iText = ""
save = Zahlen
end sub
'****************************************
sub Install()
'****************************************
TXT = TXT & "<table border='0' width='220' cellspacing='0' cellpadding='0'>"
TXT = TXT & "<tr>"
Do until a = Len(Zahlen)
a = a + 1
Zahl = Mid(Zahlen,a,1)
TXT = TXT & "<td width='100'><input type='button' id=" & a & " value='"&Zahl&"' onClick='Play(" & a & ")' name='" & a & "' style='width: 25; float: right; position: relative; border-width: 1; color: #CCCCCC; background-color: #54514D; height: 25' ></td>"
If a/9 = Fix(a/9)then TXT = TXT & "</tr><tr>"
Loop
TXT = TXT & "</tr></table>"
document.all.WeekEnd.innerHTML = TXT
TXT = ""
End Sub
'****************************************
Sub new_numbers()
'****************************************
if Len(Zahlen) >= 1000 Then overflow = WSHShell.popup("Overflow: Mehr als 1000 Zahlen werden nicht unterstützt",30,"Error",16) : exit Sub
a = 1
Do while a < Len(Zahlen)
If mid(Zahlen, a ,9 ) = " " Then Zahlen = left(Zahlen, a - 1) & Right(Zahlen,Len(Zahlen) - Len(left(Zahlen, a - 1)) - 9 ) : a = a - 9
a = a + 9
Loop
Zahlen = Zahlen & Replace(Zahlen," ", "")
call Install()
end Sub
'****************************************
Sub reset()
'****************************************
reset_nachfrage = WshShell.Popup("Möchten Sie dieses Spiel aufgeben?", 30,"Spiel ohne Name", 4 + 32 + 256)
if reset_nachfrage = 7 Then exit sub
Zahlen = "123456789111213141516171819"
call Install()
end sub
'**************************************** Button ueberpruefen
sub Play(button)
'****************************************
on error resume next
if button = click Then Exit sub
If Mid(Zahlen,button,1) = " " Then click = 0 : Exit sub
If click = 0 Then click = button : Exit Sub
If button = click - 1 or button = click + 1 or button = click - 9 or button = click + 9 Then
call click_erfolg(button)
Else
Set RegExp = new RegExp
With RegExp
.Pattern = "^ +$"
.IgnoreCase = True
.Global = True
End With
if button < click Then
if RegExp.Test(Mid(Zahlen,button + 1,click - button - 1)) = True Then call click_erfolg(button)
If (click - button)/9 = Fix((click - button)/9) then
i = 1
Do while i < (click - button)/9
if not Mid(Zahlen,i * 9 + button,1) = " " Then error = 1 : exit do
i = i + 1
loop
if error = 0 Then call click_erfolg(button)
End if
Else
if RegExp.Test(Mid(Zahlen,click + 1,button - click - 1)) = True Then call click_erfolg(button)
If (button - click)/9 = Fix((button - click)/9) then
i = 1
Do while i < (button - click)/9
if not Mid(Zahlen,i * 9 + click,1) = " " Then error = 1 : exit do
i = i + 1
loop
if error = 0 Then call click_erfolg(button)
End if
End if
Set RegExp = nothing
End if
error = 0
click = 0
end sub
'****************************************
Sub click_erfolg(click2)
'****************************************
on error resume next
var1 = Mid(Zahlen,click,1)/1
var2 = Mid(Zahlen,click2,1)/1
if var1 + var2 = 10 or var1 = var2 Then
save = Zahlen
Zahlen = Left(Zahlen ,click2 - 1 ) & " " & Right(Zahlen,Len(Zahlen)-click2 )
Zahlen = Left(Zahlen ,click - 1 ) & " " & Right(Zahlen,Len(Zahlen)-click )
Document.GetElementByID(click2).value=" "
Document.GetElementByID(click).value=" "
end if
end sub
'****************************************
Sub rueckgaengig()
'****************************************
Zahlen = save
call Install()
End Sub
'****************************************
Sub ausblenden()
'****************************************
document.all.info.innerHTML = ""
' window.moveto Links, Oben
' window.moveto 0, 0
' window.resizeto Breite, Höhe
window.resizeto 380, screen.height-130
' window.resizeto 320, 550
TXT = "<INPUT TYPE='button' value='Info einblenden' onClick='show_info' style='background-color: #54514D; background-repeat: repeat; background-attachment: scroll; color: #CCCCCC; position: relative; width: 150; border-style: outset; border-width: 1; background-position: 0% 50%' >"
document.all.einblenden.innerHTML = TXT
TXT = ""
call Install
End sub
'****************************************
Sub show_info
'****************************************
call Beim_Laden()
document.all.einblenden.innerHTML = ""
End sub
'****************************************
Sub test()
'****************************************
geht = False
a = 1
Do While a < Len(Zahlen)
If Mid(Zahlen,a,1) <> " " Then
number = Mid(Zahlen,a,1)/1
var1 = 0
var2 = 0
If Mid(Zahlen,a + 1,1) <> " " Then var1 = Mid(Zahlen,a + 1,1)/1
If Mid(Zahlen,a + 9,1) <> " " And a + 9 <= Len(Zahlen) Then var2 = Mid(Zahlen,a + 9,1)/1
If number = var1 Or number = var2 Or (number + var1) = 10 Or (number + var2) = 10 Then
geht = True
Else
b = 1
Do while Mid(zahlen,a + b,1) = " "
b = b + 1
Loop
If a + b <= Len(Zahlen) Then
If number = Mid(zahlen,a + b,1)/1 Or (number + Mid(zahlen,a + b,1)/1) = 10 Then geht = True
End If
b = 9
Do While Mid(zahlen,a + b,1) = " "
b = b + 9
Loop
If a + b <= Len(Zahlen) Then
If number = Mid(zahlen,a + b,1)/1 Or (number + Mid(zahlen,a + b,1)/1) = 10 Then geht = True
End If
End If
End If
a = a + 1
If geht = True Then messenge = msgbox("Test positiv. Es können noch weitere Zahlen weggestrichen werden.",64,"Test") : Exit Sub
Loop
messenge = msgbox("Test negativ. Es können keine weiteren Zahlen weggestrichen werden.",64,"Test")
End Sub
</script>
<body onLoad="ausblenden()">
<p>
<marquee style="font-size: 12pt" width="747" height="18">Bitte beachten Sie, dass sich dieses Programm
in der Betaphase befindet. Programmfehler sind nicht ausgeschlossen. Nutzung auf
eigene Gefahr</marquee>
</p>
<table border="0" width="103%" height="8" cellpadding="2">
<tr>
<td width="14%" height="8">
<center>
<div id=einblenden </div style="width: 157; height: 17">
</center>
</div>
</td>
<td width="13%" height="8">
<center><INPUT TYPE="button" value="Reset" onClick="reset()" style="background-color: #54514D; background-repeat: repeat; background-attachment: scroll; color: #CCCCCC; position: relative; width: 150; border-style: outset; border-width: 1; background-position: 0% 50%" >
</center>
</td>
<td width="33%" height="8" rowspan="2"></td>
<td width="44%" height="4" rowspan="4"></td>
</tr>
<tr>
<td width="14%" height="1">
<center><INPUT TYPE="button" value="Rückgängig" onClick="rueckgaengig()" style="background-color: #54514D; background-repeat: repeat; background-attachment: scroll; color: #CCCCCC; position: relative; width: 150; border-style: outset; border-width: 1; background-position: 0% 50%" ></center>
</td>
<td width="13%" height="1">
<center><INPUT TYPE="button" value="Zahlen geben" onClick="new_numbers()" style="background-color: #54514D; background-repeat: repeat; background-attachment: scroll; color: #CCCCCC; position: relative; width: 150; border-style: outset; border-width: 1; background-position: 0% 50%" >
</center>
</td>
</tr>
<tr>
<td width="27%" height="29" colspan="2">
<center> <INPUT TYPE="button" value="Können noch weitere Zahlen gestrichen werden?" onClick="test()" style="background-color: #54514D; background-repeat: repeat; background-attachment: scroll; color: #CCCCCC; position: relative; width: 312; border-style: outset; border-width: 1; background-position: 0% 50%" >
</center>
</td>
<td width="33%" height="2" rowspan="2">
<font face="Lucida Calligraphy" size="1">
<div id=info style="width: 346; height: 32"> </div>
</font></td>
</tr>
<tr>
<td width="27%" height="29" colspan="2">
<center><div id=WeekEnd style="width: 315; height: 25"></div></center>
</td>
</tr>
</table>
<p><center></center></p>
<p>
</p>
</body>
http://dieseyer.de • all rights reserved • © 2011 v11.4