.NET开发

本类阅读TOP10
·NHibernate快速指南(翻译)
·vs.net 2005中文版下载地址收藏
·【小技巧】一个判断session是否过期的小技巧
·VB/ASP 调用 SQL Server 的存储过程
·？dos下编译.net程序找不到csc.exe文件
·通过Web Services上传和下载文件
·学习笔记（补）《.NET框架程序设计（修订版）》--目录
·VB.NET实现DirectDraw9 (2) 动画
·VB.NET实现DirectDraw9 (1) 托管的DDraw
·建站框架规范书之——文件命名

→ 分类导航
VC语言Delphi
VB语言ASP
PerlJava
Script数据库
其他语言游戏开发
文件格式网站制作
软件工程.NET开发
利用VB解决华容道问题的源代码

作者：未知 来源：月光软件站 加入时间：2005-2-28　月光软件站

全局变量定义 


Type HRDState            '华容道的棋局表示
state(1 To 12) As Long   '棋盘上的12个棋子的当前位置
Superid As Long        '上一步棋盘的位置编号,0代表无上一步
Level  As Long         '这一不棋局的级别,0代表是开始状态
End Type
Public G_Next As CHRDNext
Public G_Save As CHRDSave
Public G_State As HRDState



应用程序启动 


Sub Main()
frmHRDMAIN.Show     '显示主窗口
End Sub
<B>CHRDNext封装计算下一步算法的类</b>
Dim bs(1 To 12) As Long '棋子的开始状态,接收输入值
Dim ES(1 To 12) As Long '棋子的计算结束状态,生成输出值,中间变量
Dim hnum As Long        '横放的将军的数量,输入值
Public iEndNum As Long  '计算结束的下一步的数量,输出值
Dim SaveEnd(1 To 240) As Long '最后生成的存放结果数组,输出值
Public Function getid(id As Long) As Long
getid = SaveEnd(id)
End Function
Public Sub GetNext(BEGINSTATE() As Long, BEGINHNUM As Long)
Dim i As Long
Dim MoveType As Long   '移动方向
Dim iend As Long       '记录移动结果
For i = 1 To 12
 bs(i) = BEGINSTATE(i) '初始状态
Next i
hnum = BEGINHNUM          '横放的将军数量
iEndNum = 0               '初始化结果数量为0
If MoveCaoCao() = 0 Then AddEnd
For i = 2 To hnum + 1      '移动横放的将军
    For MoveType = 1 To 4
        If MoveHtiger(MoveType, i) = 0 Then AddEnd
    Next MoveType
Next i
For i = hnum + 2 To 6       '移动竖放的将军
    For MoveType = 1 To 4
       If MoveVtiger(MoveType, i) = 0 Then AddEnd
    Next MoveType
Next i
For i = 7 To 10             '移动小卒
    For MoveType = 1 To 4
        If MoveFighter(MoveType, i) = 0 Then AddEnd
    Next MoveType
Next i
End Sub
Private Sub AddEnd()
'将End数组中的数据添加到SaveEnd中去,最后将iendnum的值加1
Dim i As Long
    For i = 1 To 12
       SaveEnd(iEndNum * 12 + i) = ES(i)
    Next i
    iEndNum = iEndNum + 1
End Sub
Private Sub SortEnd(BeginId As Long, EndId As Long)
'将输出结果进行排序,保证小者在前,大者在后
Dim i As Long
Dim j As Long
Dim Swap As Long
i = BeginId
Do While i <= EndId - 1
    j = i + 1
    Do While j <= EndId
        If ES(i) > ES(j) Then
           Swap = ES(i): ES(i) = ES(j): ES(j) = Swap
        End If
        j = j + 1
    Loop
    i = i + 1
Loop
End Sub
Private Function MoveFighter(move_type As Long, id As Long)
As Long
'初始化下一步的数据
Dim i As Long
For i = 1 To 12
    ES(i) = bs(i)
Next i
MoveFighter = -1 '初始化返回值
Select Case move_type
    Case 1 'up
        If ES(11) = ES(id) - 4 Then
            ES(id) = ES(id) - 4: ES(11) = ES(11) + 4
            MoveFighter = 0: GoTo Sort
        End If
        If ES(12) = ES(id) - 4 Then
            ES(id) = ES(id) - 4: ES(12) = ES(12) + 4
            MoveFighter = 0: GoTo Sort
        End If
    Case 2 'down
        If ES(11) = ES(id) + 4 Then
            ES(id) = ES(id) + 4: ES(11) = ES(11) - 4
            MoveFighter = 0: GoTo Sort
        End If
        If ES(12) = ES(id) + 4 Then
            ES(id) = ES(id) + 4: ES(12) = ES(12) - 4
            MoveFighter = 0: GoTo Sort
        End If
    Case 3 'left
        If ES(11) = ES(id) - 1 And ES(11) Mod 4 <> 0 Then
            ES(id) = ES(id) - 1: ES(11) = ES(11) + 1
            MoveFighter = 0: GoTo Sort
        End If
        If ES(12) = ES(id) - 1 And ES(12) Mod 4 <> 0 Then
            ES(id) = ES(id) - 1: ES(12) = ES(12) + 1
            MoveFighter = 0: GoTo Sort
        End If
    Case 4 'right
        If ES(11) = ES(id) + 1 And ES(11) Mod 4 <> 1 Then
            ES(id) = ES(id) + 1: ES(11) = ES(11) - 1
            MoveFighter = 0: GoTo Sort
       End If
        If ES(12) = ES(id) + 1 And ES(12) Mod 4 <> 1 Then
           ES(id) = ES(id) + 1: ES(12) = ES(12) - 1
           MoveFighter = 0: GoTo Sort
        End If
End Select
Sort:
    If MoveFighter = 0 Then
        SortEnd 7, 10      '对小卒排序
        SortEnd 11, 12     '对空格排序
    End If
End Function
Private Function MoveCaoCao() As Long
'step1初始化下一步的数据
Dim i As Long
For i = 1 To 12
    ES(i) = bs(i)
Next i
MoveCaoCao = -1 '初始化返回值,-1代表不成功
'up按照规则,限制曹操不能向上移动
'If ES(11) = ES(1) - 8 And ES(12) = ES(11) + 1 Then
'    ES(1) = ES(1) - 4: ES(11) = ES(11) + 8: ES(12)
 = ES(12) + 8
'    MoveCaoCao = 0
'end if
'down
If ES(11) = ES(1) + 8 And ES(12) = ES(11) + 1 Then
    ES(1) = ES(1) + 4: ES(11) = ES(11) - 8: ES(12) 
= ES(12) - 8
   MoveCaoCao = 0: GoTo Sort
End If
'left
If ES(11) = ES(1) - 1 And ES(12) 
= ES(11) + 4 And (ES(11) Mod 4) <> 0 Then
    ES(1) = ES(1) - 1: ES(11) = ES(11) + 2: ES(12) = ES(12) + 2
   MoveCaoCao = 0: GoTo Sort
End If
'right
If ES(11) = ES(1) + 2 And ES(12)
 = ES(11) + 4 And (ES(11) Mod 4) <> 1 Then
    ES(1) = ES(1) + 1: ES(11) = ES(11) - 2: ES(12) = ES(12) - 2
   MoveCaoCao = 0: GoTo Sort
 
End If
'移动曹操以后,不需要重新进行排序
Sort:
 'Do nothing
End Function
Private Function MoveHtiger(MoveType As Long, id As Long)
 As Long
'初始化下一步的数据
Dim i As Long
For i = 1 To 12
    ES(i) = bs(i)
Next i
MoveHtiger = -1       '设置初始值
Select Case MoveType
    Case 1 'up
        If ES(11) = ES(id) - 4 And ES(12) = ES(11) + 1 Then
            ES(id) = ES(id) - 4: ES(11) = ES(11) + 4: ES(12) = ES(12) + 4
            MoveHtiger = 0: GoTo Sort
        End If
  Case 2 'down
       If ES(11) = ES(id) + 4 And ES(12) = ES(11) + 1 Then
            ES(id) = ES(id) + 4: ES(11) = ES(11) - 4: ES(12) = ES(12) - 4
            MoveHtiger = 0: GoTo Sort
        End If
 Case 3 'left
       If ES(11) = ES(id) - 1 And ES(11) Mod 4 <> 0 Then
           ES(id) = ES(id) - 1: ES(11) = ES(11) + 2
           MoveHtiger = 0: GoTo Sort
        End If
       If ES(12) = ES(id) - 1 And ES(12) Mod 4 <> 0 Then
            ES(id) = ES(id) - 1: ES(12) = ES(12) + 2
            MoveHtiger = 0: GoTo Sort
        End If
    Case 4 'right
        If ES(11) = ES(id) + 2 And ES(11) Mod 4 <> 1 Then
            ES(id) = ES(id) + 1: ES(11) = ES(11) - 2
            MoveHtiger = 0: GoTo Sort
        End If
        If ES(12) = ES(id) + 2 And ES(12) Mod 4 <> 1 Then
            ES(id) = ES(id) + 1: ES(12) = ES(12) - 2
            MoveHtiger = 0: GoTo Sort
        End If
End Select
Sort:
    If MoveHtiger = 0 Then
        SortEnd 2, hnum + 1      '横放将领排序
        SortEnd 11, 12           '空格排序
    End If
End Function
Private Function MoveVtiger(MoveType As Long, id As Long) As Long
'初始化下一步的数据
Dim i As Long
For i = 1 To 12
    ES(i) = bs(i)
Next i
MoveVtiger = -1
Select Case MoveType
    Case 1 'up
        If ES(11) = ES(id) - 4 Then
            ES(id) = ES(id) - 4: ES(11) = ES(11) +
 8: MoveVtiger = 0: GoTo Sort
        End If
        If ES(12) = ES(id) - 4 Then
            ES(id) = ES(id) - 4: ES(12) = ES(12) +
 8: MoveVtiger = 0: GoTo Sort
        End If
    Case 2 'down
        If ES(11) = ES(id) + 8 Then
            ES(id) = ES(id) + 4: ES(11) = ES(11) - 
8: MoveVtiger = 0: GoTo Sort
        End If
        If ES(12) = ES(id) + 8 Then
            ES(id) = ES(id) + 4: ES(12) = ES(12) -
 8: MoveVtiger = 0: GoTo Sort
        End If
    Case 3 'left
        If ES(11) = ES(id) - 1 And ES(12) = ES(11) + 
4 And ES(11) Mod 4 <> 0 Then
            ES(id) = ES(id) - 1: ES(11) = ES(11) + 
1: ES(12) = ES(12) + 1
            MoveVtiger = 0: GoTo Sort
        End If
    Case 4 'right
        If ES(11) = ES(id) + 1 And ES(12) = ES(11) +
 4 And ES(11) Mod 4 <> 1 Then
            ES(id) = ES(id) + 1: ES(11) = ES(11) - 
1: ES(12) = ES(12) - 1
            MoveVtiger = 0: GoTo Sort
        End If
End Select
Sort:
    If MoveVtiger = 0 Then
        SortEnd hnum + 2, 6      '竖放将领排序
        SortEnd 11, 12           '空格排序
    End If
End Function



CHRDSave 保存已经走过的节点记录类 


Option Explicit
Dim SaveState(1 To 300000) As HRDState '最多走3万步
Public iCurrentNum As Long  '当前位置的指针
Private Function IsExist(NewState() As Long, ilevel As Long) As Boolean
IsExist = False
Dim i As Long
For i = iCurrentNum To 1 Step -1
    If SaveState(i).Level < ilevel - 2 Then
        i = 0: Exit Function
    End If
    If SaveState(i).state(1) = NewState(1) And _
        SaveState(i).state(2) = NewState(2) And _
        SaveState(i).state(3) = NewState(3) And _
        SaveState(i).state(4) = NewState(4) And _
        SaveState(i).state(5) = NewState(5) And _
        SaveState(i).state(6) = NewState(6) And _
        SaveState(i).state(7) = NewState(7) And _
        SaveState(i).state(8) = NewState(8) And _
        SaveState(i).state(9) = NewState(9) And _
        SaveState(i).state(10) = NewState(10) Then
    IsExist = True: i = 0: Exit Function
    End If
Next i
End Function
Public Sub AddState(NewState() As Long, isuperid As Long, ilevel As Long)
Dim i As Long
    If Not IsExist(NewState, ilevel) Then
       iCurrentNum = iCurrentNum + 1
        For i = 1 To 12
            SaveState(iCurrentNum).state(i) = NewState(i)
        Next
        SaveState(iCurrentNum).Superid = isuperid
        SaveState(iCurrentNum).Level = ilevel
    End If
End Sub
Private Sub Class_Initialize()
    iCurrentNum = 0
End Sub
Public Function GetState(id As Long)
If id > 0 Then
   G_State = SaveState(id)
End If
End Function



主界面窗体的代码 


Private Sub ShowId(id As Long, deep As Long)
  Label1.Caption = "节点数:" & CStr(id) & " 测试深度:" & CStr(deep)
End Sub
Private Function isvalid(state() As Long, ByVal hnum As Long)
Dim bs(1 To 20) As Integer
Dim i As Integer
Dim k As Integer
'init
For i = 1 To 20
    bs(i) = 1
Next
'check
For i = 1 To 12
k = state(i)
Select Case i
    Case 1                  '曹操
        bs(k) = 0
        bs(k + 1) = 0
        bs(k + 4) = 0
        bs(k + 5) = 0
    Case 2, 3, 4, 5, 6
        If i <= hnum + 1 Then '横放的将军
            bs(k) = 0
            bs(k + 1) = 0
        Else                '竖放的将军
            bs(k) = 0
            bs(k + 4) = 0
   End If
   Case 7, 8, 9, 10, 11, 12 '小卒和空格
        bs(k) = 0
End Select
Next i
isvalid = True
For i = 1 To 20
    If bs(i) > 0 Then
        isvalid = False
        Exit Function
  End If
Next i
End Function
Private Sub cmdStart_Click()
Dim BEGINSTATE(1 To 12) As Long
Dim i As Long
Dim j As Long
Dim k As Long
Dim iHnum As Long
Dim time1 As Date
Dim time2 As Date
Dim ifile As Integer
ifile = FreeFile()
time1 = Now()
For i = 1 To 12
    BEGINSTATE(i) = Int(Mid(TextBegin.Text, i * 2 - 1, 2))
Next i
iHnum = CLng(txtNum.Text)
 If Not isvalid(BEGINSTATE, iHnum) Then
    MsgBox "初始状态不合法，请检查!"
    Exit Sub
End If
Set G_Next = New CHRDNext
Set G_Save = New CHRDSave
G_Save.AddState BEGINSTATE, 0, 0 '记录到最终的记录中去
i = 1
Do While i <= G_Save.iCurrentNum '堆栈尚未完成
    '读入当前记录
    G_Save.GetState i
    ShowId i, G_State.Level
    '判断是否可以结束循环
 If G_State.state(1) = 14 Then
      G_Save.iCurrentNum = i
      Exit Do
  End If
   '计算所有下级步骤
    G_Next.GetNext G_State.state, iHnum
    j = 1
    Do While j <= G_Next.iEndNum
       '下一步赋值
       For k = 1 To 12
       BEGINSTATE(k) = G_Next.getid(j * 12 - 12 + k)
       Next k
        '存入队列之中
        G_Save.AddState BEGINSTATE, i, G_State.Level + 1
        j = j + 1
  Loop
i = i + 1
 If i Mod 19 = 0 Then DoEvents
Loop
time2 = Now()
i = (time2 - time1) * 3600 * 24
G_Save.GetState G_Save.iCurrentNum
If G_State.state(1) = 14 Then
 MsgBox "行走步数：" & G_Save.iCurrentNum &
 "用时: " & i, vbOKOnly, "恭喜恭喜，行走成功"
Else
   MsgBox "行走步数：" & G_Save.iCurrentNum &
 "用时: " & i, vbOKOnly, "抱歉，行走失败"
End If
i=i+1
End Sub
Private Sub Command1_Click()
List1.Clear
Dim i As Long
i = G_Save.iCurrentNum
G_Save.GetState i
If G_State.state(1) <> 14 Then
   MsgBox "没有找到合理的解"
   Exit Sub
End If
Dim strtemp(1 To 1000) As String
Dim k As Long
j = 1
Do While G_State.Level > 0
    strtemp(j) = ""
    For k = 1 To 12
    strtemp(j) = strtemp(j) & CStr(G_State.state(k)) & "_"
    Next k
    strtemp(j) = strtemp(j) & "----" & CStr(G_State.Level)
    i = G_State.Superid
    G_Save.GetState i
j = j + 1
Loop
   strtemp(j) = ""
    For k = 1 To 12
    strtemp(j) = strtemp(j) & CStr(G_State.state(k)) & "_"
    Next k
    strtemp(j) = strtemp(j) & "----" & CStr(G_State.Level)
For k = j To 1 Step -1
    List1.AddItem strtemp(k)
Next k
End Sub
Private Sub Form_Load()
Set G_Next = New CHRDNext
Set G_Save = New CHRDSave
End Sub
Private Sub mnuAbout_Click()
frmAbout.Show
End Sub
Private Sub mnuExit_Click()
End'退出程序
End Sub

相关文章：

相关软件：