DIM Policko(9,9)
DIM TiChaKontrola
DIM Urceno(9,9)

DIM PocetPrvkuMnoziny
DIM Mnozina(81)
DIM HVstup(81)

DIM English

Sub DocVao() 
DIM value

for i=1 to 9
	for j=1 to 9
			value = document.getElementById("c"+Cstr(i)+Cstr(j)).value
			if trim(value)<>"" then
				Policko(i,j) = value
				document.getElementById("c"+Cstr(i)+Cstr(j)).style.background="magenta"
				
				Urceno(i,j)=true
			end if
	next 
next		

End Sub	


Sub HienThi()
for i=1 to 9
	for j=1 to 9
		document.getElementById("c"+Cstr(i)+Cstr(j)).src="9.jpg"
		
	next 
next
End Sub

Sub AnDinh(id,GiaTri)
document.getElementById(id).value=GiaTri
End Sub

Function MocDuoi(a)
If a = 1 Then MocDuoi = 1
If a = 2 Then MocDuoi = 4
If a = 3 Then MocDuoi = 7
End Function

Function MocTren(a)
If a = 1 Then MocTren = 3
If a = 2 Then MocTren = 6
If a = 3 Then MocTren = 9
End Function

Function KiemTraDauVao()
Dim Pom(9)
dim Msg_

TichaKontrola=false
KiemTraDauVao=true

DocVao()

Msg_=true
'So co gia tri
for i=1 to 9
	for j=1 to 9
	if trim(policko(i,j))<>"" then
		if len(trim(policko(i,j)))>1 or trim(policko(i,j))<"1" or trim(policko(i,j))>"9" then 
		Msg_=false
		i=9
		j=9
		end if
	end if
	next
next
	
if Msg_=false then
	KiemTraDauVao=false
	if English=false then
	msgBox"Chyba - neplatné číslo."
	else
	msgBox"Wrong number."
	end if
end if	


' Theo hang
	for i=1 to 9
		for j=1 to 8
			for k=j+1 to 9
			if Trim(Policko(i,j))<>"" and Policko(i,j)=Policko(i,k) then 
				KiemTraDauVao=false
								
				if TichaKontrola=false then
					if English=false then
						MsgBox("Chyba - 2 stejná čísla v řádě "+ Cstr(i)+".")
					else
						MsgBox("Wrong - 2 same numbers in row "+ Cstr(i)+".")
					end if
				end if
			end if
			next
		next
	next
'Theo cot
	for j=1 to 9
		for i=1 to 8
			for k=i+1 to 9
			if Trim(Policko(i,j))<>"" and Policko(i,j)=Policko(k,j) then 
				KiemTraDauVao=false
				
				if TichaKontrola=false then
					if English=false then

						MsgBox("Chyba - 2 stejná čísla ve sloupci "+ Cstr(j)+".")
					else
						MsgBox("Wrong - 2 same numbers in column "+ Cstr(j)+".")
					end if
				end if
			end if
			next
		next
	next
'Theo block
 
For i = 1 To 3
    For j = 1 To 3
    k = 0
        For iii = MocDuoi(i) To MocTren(i)
            For jjj = MocDuoi(j) To MocTren(j)
            k = k + 1
            Pom(k) = Trim(Policko(iii, jjj))
            Next 
        Next 
    For iii = 1 To 8
        For jjj = iii + 1 To 9
            If Trim(Pom(iii)) <> "" And Pom(iii) = Pom(jjj) Then
            If TichaKontrola = False Then
		if English=false then
  	          sss = "Chybné zadání, 2 stejná čísla v bloku " + Cstr(i) + Cstr(j)
		else
		  sss="Wrong, 2 same numbers in block "+ Cstr(i) + Cstr(j)
		end if	
            MsgBox sss
            End If
            KiemTraDauVao = False
	    	
            End If
        Next 
    Next 
    Next 
Next 


End Function

Function Pozice(i, j)
Pozice = (j - 1) * 9 + i - 1
End Function

Function C_Pozice(i) 
C_Pozice = Int((i) / 9) + 1
End Function

Function R_Pozice(i)
If (i + 1) Mod 9 <> 0 Then
R_Pozice = (i + 1) Mod 9
Else
R_Pozice = 9
End If
End Function

Sub FirstSetting()
For i = 1 To 9
    For j = 1 To 9
        Policko(i, j) = "123456789"
        Urceno(i, j) = False
    Next 
Next 
End Sub

Sub Redukce(r,c,h)
Dim ss
Dim hh
ss = ""
hh = Trim(Policko(r, c))
    If Len(hh) > 1 Then
    For i = 1 To Len(hh)
    If Mid(hh, i, 1) <> Trim(h) Then ss = ss + Mid(hh, i, 1)
    Next 
   
	Policko(r, c) = ss
	End If

End Sub

Sub MotChuSo()
For i = 1 To 9
    For j = 1 To 9
        If Len(Trim(Policko(i, j))) = 1 Then Urceno(i, j) = True
    Next 
Next 
End Sub 

Sub LoaiTru(r,c,h)
    
Dim i
Dim j
Dim rr
Dim cc
    
    
'Dle rady
For j = 1 To 9
    If j <> r And Urceno(j, c) = False Then Redukce j, c, h
Next 
    
'Dle sloupce

For i = 1 To 9
    If i <> c And Urceno(r, i) = False Then Redukce r, i, h
Next 

'Dle bloku
If r >= 1 And r <= 3 Then rr = 1
If r >= 4 And r <= 6 Then rr = 4
If r >= 7 And r <= 9 Then rr = 7

If c >= 1 And c <= 3 Then cc = 1
If c >= 4 And c <= 6 Then cc = 4
If c >= 7 And c <= 9 Then cc = 7


For i = rr To rr + 2
   For j = cc To cc + 2
            
            
            If i = r And j = c Then
            
            Else
                If Urceno(i, j) = False Then
                Redukce i, j, h
                End If
            End If
    Next 
Next 



End Sub

Sub Vyrazovani()
Dim i
Dim j
    For i = 1 To 9
        For j = 1 To 9
             
           If Urceno(i, j) = True Then LoaiTru i,j,Trim(Policko(i, j))
        Next 
    Next 
MotChuSo()

End Sub

Sub Dosadit (ii,jj,ss)
Policko(ii,jj)=ss
End Sub

Function Vyskyt(a, b)
Vyskyt = False
If Len(a) > 0 Then
For i = 1 To Len(a)
    If Mid(a, i, 1) = b Then Vyskyt = True
Next 
End If

End Function



Sub Dosazeni()
Dim Ch(9) 
Dim k 
Dim Pocet(9)
Dim i 
Dim j 
Dim ii
Dim jj
Dim Exist
Dim Hodnota
Dim iii  
Dim jjj 
Dim xxx 
Dim yyy 





Ch(1) = "1"
Ch(2) = "2"
Ch(3) = "3"
Ch(4) = "4"
Ch(5) = "5"
Ch(6) = "6"
Ch(7) = "7"
Ch(8) = "8"
Ch(9) = "9"


'Podle rady

For i = 1 To 9

    For k = 1 To 9
    Pocet(k) = 0

        For j = 1 To 9
            If Vyskyt(Trim(Policko(i, j)), Ch(k)) Then
            Pocet(k) = Pocet(k) + 1
            End If
        Next 
    
    If Pocet(k) = 1 Then
    
        For j = 1 To 9
            If Vyskyt(Trim(Policko(i, j)), Ch(k)) Then
            iii = i
            jjj = j
            Hodnota = k
            End If
        Next 
    
    
    If Urceno(iii, jjj) = False Then
        
                LoaiTru iii, jjj, Ch(Hodnota)
                Dosadit iii, jjj, Ch(Hodnota)
                
                
                Urceno(iii, jjj) = True
               
    End If
    End If

    Next 
    
    
Next 

MotChuSo()

'podle sloupce


For j = 1 To 9

    For k = 1 To 9
    Pocet(k) = 0

        For i = 1 To 9
            If Vyskyt(Policko(i, j), Ch(k)) Then
            Pocet(k) = Pocet(k) + 1
        
                
            End If
        Next 

    If Pocet(k) = 1 Then
        For i = 1 To 9
            If Vyskyt(Policko(i, j), Ch(k)) Then
            iii = i
            jjj = j
            Hodnota = k
            End If
        Next 
    
    If Urceno(iii, jjj) = False Then
        
                Dosadit iii, jjj, Ch(Hodnota)
                LoaiTru iii, jjj, Ch(Hodnota)
                Urceno(iii, jjj) = True
               
    End If
    
    End If


    Next 
    


    
    
Next 

'Podle bloku

for i=1 to 3
	for j=1 to 3
   
	For k = 1 To 9
    Pocet(k) = 0

	   for iii=MocDuoi(i) to MocTren(i)
			for jjj=MocDuoi(j) to MocTren(i)
            If Vyskyt(Policko(iii, jjj), Ch(k)) Then
            Pocet(k) = Pocet(k) + 1
        
                
            End If
            next 'jjj
       next 'iii
      
	if Pocet(k)=1 then

	   for iii=MocDuoi(i) to MocTren(i)
			for jjj=MocDuoi(j) to MocTren(i)
            If Vyskyt(Policko(iii, jjj), Ch(k)) and Urceno(iii,jjj)=false Then
  
                Dosadit iii, jjj, Ch(k)
                LoaiTru iii, jjj, Ch(k)
                Urceno(iii, jjj) = True
            
        
                
            End If
            next 'jjj
       next 'iii
	

	end if			


    next 'k
	next 'j   		
next 'i

MotChuSo()


End Sub

Function KetThuc()
KetThuc=true
for i=1 to 9
	for j=1 to 9
		if len(trim(policko(i,j)))>1 then 
			KetThuc=false
			i=9
			j=9
		end if
	next 'j
next 'i

End Function

Function KiemTraKetQua()
Dim i 
Dim j 
Dim k 
Dim iii
Dim jjj 
Dim kkk 
Dim sss 

Dim Pom(9) 

KiemTraKetQua = True


For i = 1 To 9
    For j = 1 To 8
        For k = j + 1 To 9
            If Trim(Policko(i, j)) <> "" And Trim(Policko(i, j)) = Trim(Policko(i, k)) Then
                KiemTraKetQua = False
            End If
        Next 'k
    Next 'j
Next 'i

For j = 1 To 9
    For i = 1 To 8
        For k = i + 1 To 9
            If Trim(Policko(i, j)) <> "" And Trim(Policko(i, j)) = Trim(Policko(k, j)) Then
                KiemTraKetQua = False
            End If
        Next 'k
    Next 'i
Next 'j
            
For i = 1 To 3
    For j = 1 To 3
    k = 0
        For iii = MocDuoi(i) To MocTren(i)
            For jjj = MocDuoi(j) To MocTren(j)
            k = k + 1
            Pom(k) = Trim(Policko(iii, jjj))
            Next 'jjj
        Next 'iii
    For iii = 1 To 8
        For jjj = iii + 1 To 9
            If Trim(Pom(iii)) <> "" And Pom(iii) = Pom(jjj) Then
            KiemTraKetQua = False
            End If
        Next 'jjj
    Next 'iii
    Next 'j
Next 'i

End Function

Sub KhaNang12

Dim i 
Dim j 
Dim ii
Dim jj
Dim KHANANG(2)
Dim XX 
Dim YY 
Dim KROK 
Dim Exist


Dim Zapamatuj(9, 9) 
Dim UrcenoP(9, 9) 

Exist = False

For i = 1 To 9
    For j = 1 To 9
   
    
        If Len(Trim(Policko(i, j))) = 2 Then
            KHANANG(1) = Mid(Policko(i, j), 1, 1)
            KHANANG(2) = Mid(Policko(i, j), 2, 1)
            XX = i
            YY = j
            For ii = 1 To 9
                For jj = 1 To 9
                Zapamatuj(ii, jj) = Policko(ii, jj)
                UrcenoP(ii, jj) = Urceno(ii, jj)
                Next 'jj
            Next 'ii
            Exist = True
            i = 9
            j = 9
        End If
       
        
    Next 'j
Next 'i

If Exist Then

'1. krok


Dosadit XX, YY, KHANANG(1)

Urceno(XX, YY) = True

Vyrazovani
Dosazeni

KROK = 0
While KetThuc=false And KROK < 50
Vyrazovani
Dosazeni
KROK = KROK + 1
Wend


If KiemTraKetQua() = False Then


    '2. krok


    For ii = 1 To 9
        For jj = 1 To 9
            Policko(ii, jj) = Zapamatuj(ii, jj)
            Urceno(ii, jj) = UrcenoP(ii, jj)
        Next 'jj
    Next 'ii
    
  Dosadit XX, YY, KHANANG(2)
    
Urceno(XX, YY) = True


Vyrazovani
Dosazeni

KROK = 0
While KetThuc=false And KROK < 50
KROK = KROK + 1

Vyrazovani
Dosazeni

Wend

'nekonecny cyklus
If KROK >= 50 Then
    'MsgBox " Ne&oslash;ešitelné sudoku."
    Exit Sub
End If



End If

End If   'Exist

End Sub

Sub Ulozit()
Dim ss
Dim Value
Dim id
for i=1 to 9
	for j=1 to 9
		id="c"+cstr(i)+cstr(j)
			Value=document.getElementById(id).value
			if trim(value)="" then 
				ss=ss+"0"
				else
					if len(trim(value))=1 then 
						ss=ss+trim(value)
					end if
				end if
	next 'j
next 'i

document.cookie=ss
End Sub

Sub Nahrat()
dim ss
ss=document.cookie
if len(ss)<82 then
	for i=1 to 9
		for j=1 to 9
			id="c"+cstr(i)+cstr(j)		
				if mid(ss,(i-1)*9+j,1)<>"0" then document.getElementById(id).value=mid(ss,(i-1)*9+j,1)
		next
	next
end if	
End Sub

Function KontrolaVstupu()
Dim Pom(9)

KontrolaVstupu=true




' Theo hang
	for i=1 to 9
		for j=1 to 8
			for k=j+1 to 9
			if Trim(HVstup(Pozice(i,j)))<>"" and HVstup(pozice(i,j))=HVstup(pozice(i,k)) then 
				KontrolaVstupu=false
								
				
			end if
			next
		next
	next
'Theo cot
	for j=1 to 9
		for i=1 to 8
			for k=i+1 to 9
			if Trim(HVstup(Pozice(i,j)))<>"" and HVstup(Pozice(i,j))=HVstup(Pozice(k,j)) then 
				KontrolaVstupu=false
				
				
			end if
			next
		next
	next
'Theo block
 
For i = 1 To 3
    For j = 1 To 3
    k = 0
        For iii = MocDuoi(i) To MocTren(i)
            For jjj = MocDuoi(j) To MocTren(j)
            k = k + 1
            Pom(k) = Trim(HVstup(pozice(iii, jjj)))
            Next 
        Next 
    For iii = 1 To 8
        For jjj = iii + 1 To 9
            If Trim(Pom(iii)) <> "" And Pom(iii) = Pom(jjj) Then
            
            KontrolaVstupu = False
	    	
            End If
        Next 
    Next 
    Next 
Next 


End Function