用vb编了个数独计算器

平时很喜欢玩数独游戏,每天只要信报上有数独游戏,那就不看别的了,专心致志玩一路。

昨天突然想自己编一个软件来算吧,于是就有了这篇文章和一个vb的数独计算器。

下载地址:

http://download.youkuaiyun.com/source/1381913

 

谈思想吧,思想最重要:我用了最最笨的方法,就是每个空位都从1~9挨个填,出了问题再折回来重新填。

 

所以这样的想法一定要用到递归了,就是不断调用自身来达到目的。

 

东西简单,所以代码也简单:

我用了81个text来填数:text1(0)~text1(80),存到一个 Mtx(81)的数组中。

而且先写了一个填写检查程序:(目的是检查是否可以在x,y这个位置填入此Num。)

Function Tcheck(arrayc() As Integer, x As Integer, y As Integer,num As Integer)
For i = 0 To 8
    If Mtx(i, y) = num Then
        Tcheck = False
        Exit Function
    End If
    If Mtx(x, i) = num Then
        Tcheck = False
        Exit Function
    End If
Next i

            For i = 0 To 2
                For j = 0 To 2
                        If (arrayc((x/3)*3 + i, (y/3)*3 + j) = num) Then
                            Tcheck = False
                            Exit Function
                        End If
                Next j
            Next i
Tcheck = True

End Function

 

Private Function checkexistNum()
'检查现有的数据是否存在问题
Dim i As Integer
Dim j As Integer
Dim temp As Integer

For i = 0 To 8
    For j = 0 To 8
        If (Mtx(i, j) <> 0) Then
            temp = Mtx(i, j)
            Mtx(i, j) = 0
            If Tcheck(Mtx, i, j, temp) = False Then
                checkexistNum = False
                errorstr = temp
                Text1(i * 9 + j).SetFocus
                Exit Function
            End If
            Mtx(i, j) = temp
        End If
    Next j
Next i
checkexistNum = True
End Function

 

下面这个程序就是最重要的递归函数了:

Function CalcArray(arrayn() As Integer)
Dim k As Integer
Dim i As Integer
Dim j As Integer

 For i = 0 To 8
    For j = 0 To 8
        If arrayn(i * 9 + j) = 0 Then '原来的值为0才能进行赋值试验
            Dim flag As Boolean
            flag = False
           
            For k = 1 To 9 '准备填数
                flag = Tcheck(arrayn(), i, j, k)
                If flag = True Then
                    arrayn(i * 9 + j) = k
                    If CalcArray(arrayn) = False Then
                        arrayn(i * 9 + j) = 0
                        flag = False
                    Else
                        CalcArray= True
                        Exit Function
                    End If
                End If
            Next k
           
            If flag = False Then
                CalcArray = False
                Exit Function
            End If
           
        End If
    Next j
 Next i
 CalcArray = True
 End Function

 

ok,最后一步就是主函数了:

Private Sub CalculatorCT_Click()

Dim i, j As Integer

SodoError = 0
t = Timer
transfer '这个就是将text1转到Mtx()中去
If SodoError = 1 Then
    Exit Sub
End If

If checkexistNum = False Then
 MsgBox "现有数据存在问题:" & errorstr
 Exit Sub
End If

If CalcArray(Mtx) = False Then
    MsgBox "无法解出", , "龙卷风数独"
Else
        '将资料填回Text1中
        For i = 0 To 8
           For j = 0 To 8
                Text1(j + (i * 9)) = Mtx(i, j)
           Next j
        Next i
        MsgBox "计算完成", , "龙卷风数独"
End If

End Sub

呵呵,简单吧!

发个我做的软件链接:

 http://download.youkuaiyun.com/source/1381913

这个绝对不是病毒,我自己用visual basic写的解答数独的小程序。。。。不收费哦。。欢迎大家下载使用!! 什么是数独游戏(可以参考百度百科) 数独(すうどく,Sūdoku)是一种运用纸、笔进行演算的逻辑游戏。玩家需要根据9×9盘面上的已知数字,推理出所有剩余空格的数字,并满足每一行、每一列、每一个粗线宫内的数字均含1-9,不重复。 独盘面是个九宫,每一宫又分为九个小格。在这八十一格中给出一定的已知数字和解题条件,利用逻辑和推理,在其他的空格上填入1-9的数字。使1-9每个数字在每一行、每一列和每一宫中都只出现一次,所以又称“九宫格”。 http://baike.baidu.com/subview/961/10842669.htm?fr=aladdin(参考百度百科的内容) 程的初衷 办公室里忽然开始玩数独了,在百度的文库里下载了几道题,回家玩了几个晚上,挺好玩的,但是苦于没有答案可对,有些题解到最后无解了也不知道是题目错了还是自己解错了。利用出差的闲暇时间,我用visual basic写了这个小程序。现在和大家分享一下,希望喜欢数独的你可以对对答案。 当然了,有些人说我毁了这个游戏的乐趣。对不起啊,这个东西就是一把双刃剑,看你怎么用了,我的初衷是对答案,不是偷懒。。。 使用注意事项 1)网格里可以用左右上下键控制光标 2)程序库里一共128道题,均来源于网络。您也可以手动输入数独题目求解 3)本程序免费提供给你,如果因此造成您机器的死机等等概不负责!(万亿分之一的概率,但是我怕遇到流氓额我啊!) 4)程序里有我的email地址,有疑问的可以email我,嘿嘿。 5)我要保留我的版权,未经允许不得转载,不得用于商业用途 6)不得将我的程序重新发布并且打包设置权限骗取注册,本来及时免费的,否则法庭见! 7)要源代码的就省省吧。嘻嘻。给你一条鱼,你就不要管钓到的方法了!!
数独算法说明:用三个二维数组记录数独每个点的状态,SD(i, j)显示数值,也是真实数值(1到9)。ST(i, j)状态,1可由用户输入,2是题目给定的,不能改。SY(i, j)字符串,记录每个点中可能的值。 1、在进行自动计算时,只计算ST(i, j)为1的点,首先将所有状态为1的点的SY(i, j)值全部设为"123456789",SD(i, j)值全部设为0 2、逐点扫描,找到一个点,然后将该点所在的行、列、区域中已存在的SD(x, y)值从SY(i, j)中删除,因为数独规则是一个数值,在行、列、区域都不重复。 3、经第二步处理后,SY(i, j)为空,说明前面的步骤出错,SY(i, j)值为一位数字,就说明该点的值是唯一的,可以确定了。重复第2步。 4、剩余的SY(i, j)中字符串长度最少也是两位,或更多位数。随机从这些两位数的SY(i, j)中选取一个点。取其中的一位确定为该点的值后,重复第2步。如果错误遇错,则重复执行第4步。直到所有点都被确定。 注意:第2步是需要多次重复执行的,所以可用递归函数完成。如果执行结果出现错误(某数出现重复,或某点无值),需要对该过程所执行的所有操作进行回退。 第4步也是需要重复执行的。本程序用Goto跳转方式实现多次执行。 简单的数独,要么所有的点都具有唯一值,第1步执行完成后,就已全部完成。或者具有多个解,随意猜测一个二位数的SY(i, j)的值都能成功。 难的数独是:可唯一确定的点很少,大部分点都有两种或多种可能的值,但最终正确答案只有一种或很少种解。 软件在自动计算过程中,具有很大的偶然性,对于骨灰级的数独题目在计算过程中,时间短的可能不到1秒就能完成,长的可能要几分钟,需要将各种可能性都测试一遍才会有结果。 只要题目正确,多计算几次就能得到答案。 软件是VB6.0开发的,只用到MSHFLXGD控件用于显示。程序只处理各点有两种可能值的情况,对只存在三种可能值的情况未进一步处理,该情况非常极端了。 软件可以保存布局,可选择预存的关数,退出时自动保存界面状态。程序在用到配置文件枚举方法、表格辑、递归函数等,可作入门级学习研究。 软件可以进一步修改拓展,增加对数独题目难容度的判断等功能。 软件中自带网上下载的200个数独题目。
评论 8
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值