v1.4

Form_Favourite.frm

@@ -0,0 +1,281 @@
+VERSION 5.00
+Begin VB.Form Form_Favourite 
+   AutoRedraw      =   -1  'True
+   BorderStyle     =   1  'Fixed Single
+   Caption         =   "我的收藏"
+   ClientHeight    =   4590
+   ClientLeft      =   45
+   ClientTop       =   390
+   ClientWidth     =   6765
+   LinkTopic       =   "Form1"
+   MaxButton       =   0   'False
+   MinButton       =   0   'False
+   ScaleHeight     =   4590
+   ScaleWidth      =   6765
+   StartUpPosition =   2  '屏幕中心
+   Begin VB.TextBox Text_Code 
+      Alignment       =   2  'Center
+      BeginProperty Font 
+         Name            =   "微软雅黑"
+         Size            =   15
+         Charset         =   134
+         Weight          =   400
+         Underline       =   0   'False
+         Italic          =   0   'False
+         Strikethrough   =   0   'False
+      EndProperty
+      Height          =   495
+      Left            =   3720
+      Locked          =   -1  'True
+      TabIndex        =   5
+      Top             =   3960
+      Width           =   1935
+   End
+   Begin VB.CommandButton Command_Confirm 
+      Caption         =   "确定"
+      Height          =   495
+      Left            =   5640
+      TabIndex        =   4
+      Top             =   3960
+      Width           =   975
+   End
+   Begin VB.CommandButton Command_Delete 
+      Caption         =   "删除"
+      Height          =   495
+      Left            =   5640
+      TabIndex        =   3
+      Top             =   3480
+      Width           =   975
+   End
+   Begin VB.CommandButton Command_Modify 
+      Caption         =   "修改"
+      Height          =   495
+      Left            =   4680
+      TabIndex        =   2
+      Top             =   3480
+      Width           =   975
+   End
+   Begin VB.CommandButton Command_Add 
+      Caption         =   "添加"
+      Height          =   495
+      Left            =   3720
+      TabIndex        =   1
+      Top             =   3480
+      Width           =   975
+   End
+   Begin VB.ListBox List_Favourite 
+      Height          =   3300
+      ItemData        =   "Form_Favourite.frx":0000
+      Left            =   3720
+      List            =   "Form_Favourite.frx":0002
+      TabIndex        =   0
+      Top             =   120
+      Width           =   2895
+   End
+   Begin VB.Timer Timer 
+      Interval        =   100
+      Left            =   0
+      Top             =   0
+   End
+End
+Attribute VB_Name = "Form_Favourite"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = False
+Option Explicit
+Private Type Case_Block
+  address As Integer
+  style As Integer
+End Type
+Dim change_mode As Boolean
+Dim Block(0 To 9) As Case_Block
+Dim start_x As Integer, start_y As Integer, square_width As Integer, gap As Integer
+Private Sub Form_Load()
+  start_x = 135
+  start_y = 135
+  square_width = 770
+  gap = 75
+  If on_top = True Then
+    SetWindowPos Me.hwnd, -1, 0, 0, 0, 0, 1 Or 2
+  Else
+    SetWindowPos Me.hwnd, -2, 0, 0, 0, 0, 1 Or 2
+  End If
+  Call Get_Data
+  If Not List_Favourite.ListCount = 0 Then List_Favourite.ListIndex = 0
+End Sub
+Private Sub Command_Confirm_Click()
+  Dim temp As String
+  If List_Favourite.ListCount = 0 Then Exit Sub
+  temp = List_Favourite.List(List_Favourite.ListIndex)
+  change_case_title = Left(temp, Len(temp) - 9)
+  change_case_code = Text_Code
+  change_case = True
+  Unload Form_Favourite
+End Sub
+Private Sub Command_Add_Click()
+  change_mode = False
+  favourite_add_init_name = ""
+  favourite_add_init_code = ""
+  Form_Favourite_Add.Show 1
+End Sub
+Private Sub Command_Modify_Click()
+  Dim temp As String
+  If List_Favourite.ListCount = 0 Then Exit Sub
+  change_mode = True
+  temp = List_Favourite.List(List_Favourite.ListIndex)
+  favourite_add_init_name = Left(temp, Len(temp) - 9)
+  favourite_add_init_code = Left(Right(temp, 8), 7)
+  Form_Favourite_Add.Show 1
+End Sub
+Private Sub Command_Delete_Click()
+  Dim temp As Integer
+  If List_Favourite.ListCount = 0 Then Exit Sub
+  temp = List_Favourite.ListIndex
+  List_Favourite.RemoveItem temp
+  If List_Favourite.ListCount = temp Then
+    List_Favourite.ListIndex = List_Favourite.ListCount - 1
+  Else
+    List_Favourite.ListIndex = temp
+  End If
+  Call Save_Data
+End Sub
+Private Sub List_Favourite_Click()
+  Dim temp As String
+  temp = List_Favourite.List(List_Favourite.ListIndex)
+  Text_Code = Mid(temp, Len(temp) - 7, 7)
+  Call Analyse_Code(Text_Code)
+  Call Output_Graph
+End Sub
+Private Sub Timer_Timer()
+  If favourite_add_confirm = True Then
+    If change_mode = True Then Call Command_Delete_Click
+    If List_Favourite.ListCount = 0 Then
+      List_Favourite.AddItem favourite_add_name & "(" & favourite_add_code & ")"
+      List_Favourite.ListIndex = 0
+    Else
+      List_Favourite.AddItem favourite_add_name & "(" & favourite_add_code & ")", List_Favourite.ListIndex
+      List_Favourite.ListIndex = List_Favourite.ListIndex - 1
+    End If
+    favourite_add_confirm = False
+    Call Save_Data
+  End If
+End Sub
+Private Sub Get_Data()
+  Dim i As Long
+  Call Get_Favourite_Cases
+  For i = 1 To UBound(Favourite_Cases_name)
+    List_Favourite.AddItem Favourite_Cases_name(i) & "(" & Favourite_Cases_code(i) & ")"
+  Next i
+End Sub
+Private Sub Save_Data()
+  Dim i As Integer, temp As String
+  ReDim Favourite_Cases_code(List_Favourite.ListCount)
+  ReDim Favourite_Cases_name(List_Favourite.ListCount)
+  For i = 0 To List_Favourite.ListCount - 1
+    temp = List_Favourite.List(i)
+    Favourite_Cases_code(i + 1) = Left(Right(temp, 8), 7)
+    Favourite_Cases_name(i + 1) = Left(temp, Len(temp) - 9)
+  Next i
+  Call Save_Favourite_Cases
+End Sub
+Private Sub Output_Graph()
+  Dim m, x, y As Integer
+  Dim width As Integer, height As Integer
+  Print_Block start_x, start_y, square_width * 4 + gap * 5, square_width * 5 + gap * 6, case_line_width, case_color, case_line_color
+  For m = 0 To 9
+    If Block(m).address <> 25 Then
+      x = (Block(m).address Mod 4) * (square_width + gap) + gap + start_x
+      y = Int(Block(m).address / 4) * (square_width + gap) + gap + start_y
+      If Block(m).style = 0 Or Block(m).style = 1 Then
+        width = square_width * 2 + gap
+      Else
+        width = square_width
+      End If
+      If Block(m).style = 0 Or Block(m).style = 2 Then
+        height = square_width * 2 + gap
+      Else
+        height = square_width
+      End If
+      Print_Block x, y, width, height, block_line_width, block_color, block_line_color
+    End If
+  Next m
+End Sub
+Private Sub Print_Block(print_start_x, print_start_y, print_width, print_height, print_line_width, print_color, print_line_color)
+  If print_width < 0 Or print_height < 0 Then Exit Sub
+  FillStyle = 0
+  DrawWidth = print_line_width
+  FillColor = print_color
+  Line (print_start_x, print_start_y)-(print_start_x + print_width, print_start_y + print_height), print_color, B
+  Line (print_start_x, print_start_y)-(print_start_x + print_width, print_start_y + print_height), print_line_color, B
+End Sub
+Private Sub Analyse_Code(code As String)
+  On Error Resume Next
+  Dim temp(1 To 12) As Integer
+  Dim i, addr, style As Integer
+  Dim type_1, type_2, type_3 As Integer
+  Dim Table(0 To 19) As Integer
+  Dim num As Integer, b1 As Integer, b2 As Integer
+  Dim dat As String
+  For i = 1 To 6
+    dat = Mid(code, i + 1, 1)
+    If Asc(dat) >= 48 And Asc(dat) <= 57 Then num = Int(dat)
+    If Asc(dat) >= 65 And Asc(dat) <= 70 Then num = Asc(dat) - 55
+    b1 = num Mod 4
+    b2 = (num - b1) / 4 Mod 4
+    temp(i * 2 - 1) = b2
+    temp(i * 2) = b1
+  Next i
+  type_1 = 0: type_2 = 0: type_3 = 5
+  For i = 0 To 19
+    Table(i) = 69
+  Next i
+  For i = 0 To 9
+    Block(i).address = 69
+    Block(i).style = 69
+  Next i
+  dat = Left(code, 1)
+  If Asc(dat) >= 48 And Asc(dat) <= 57 Then num = Int(dat)
+  If Asc(dat) >= 65 And Asc(dat) <= 70 Then num = Asc(dat) - 55
+  Block(0).address = num
+  Block(0).style = 0
+  If Block(0).address > 14 Then GoTo err
+  Table(Block(0).address) = 0
+  Table(Block(0).address + 1) = 0
+  Table(Block(0).address + 4) = 0
+  Table(Block(0).address + 5) = 0
+  addr = 0
+  For i = 1 To 11
+    Do While Table(addr) <> 69
+      If addr < 19 Then
+        addr = addr + 1
+      Else
+        Exit Do
+      End If
+    Loop
+    style = temp(i)
+    If style = 0 Then
+      Table(addr) = 10
+    ElseIf style = 1 Then
+      If type_2 < 5 Then type_2 = type_2 + 1
+      If addr > 18 Then GoTo err
+      Block(type_2).style = 1
+      Block(type_2).address = addr
+      Table(addr) = type_2
+      Table(addr + 1) = type_2
+    ElseIf style = 2 Then
+      If type_2 < 5 Then type_2 = type_2 + 1
+      If addr > 15 Then GoTo err
+      Block(type_2).style = 2
+      Block(type_2).address = addr
+      Table(addr) = type_2
+      Table(addr + 4) = type_2
+    ElseIf style = 3 Then
+      If type_3 < 9 Then type_3 = type_3 + 1
+      Block(type_3).style = 3
+      Block(type_3).address = addr
+      Table(addr) = type_3
+    End If
+  Next i
+err:
+End Sub

Form_Favourite_Add.frm

@@ -0,0 +1,265 @@
+VERSION 5.00
+Begin VB.Form Form_Favourite_Add 
+   AutoRedraw      =   -1  'True
+   BorderStyle     =   1  'Fixed Single
+   Caption         =   "我的收藏"
+   ClientHeight    =   5535
+   ClientLeft      =   45
+   ClientTop       =   390
+   ClientWidth     =   3870
+   LinkTopic       =   "Form1"
+   MaxButton       =   0   'False
+   MinButton       =   0   'False
+   ScaleHeight     =   5535
+   ScaleWidth      =   3870
+   StartUpPosition =   2  '屏幕中心
+   Begin VB.CommandButton Command_Confirm 
+      Caption         =   "确认"
+      Height          =   615
+      Left            =   2640
+      TabIndex        =   4
+      Top             =   4800
+      Width           =   1120
+   End
+   Begin VB.TextBox Text_Code 
+      Alignment       =   2  'Center
+      Height          =   270
+      Left            =   600
+      TabIndex        =   3
+      Top             =   5160
+      Width           =   1935
+   End
+   Begin VB.TextBox Text_Name 
+      Alignment       =   2  'Center
+      Height          =   270
+      Left            =   600
+      TabIndex        =   2
+      Top             =   4800
+      Width           =   1935
+   End
+   Begin VB.Label Label_Code 
+      AutoSize        =   -1  'True
+      Caption         =   "编码:"
+      Height          =   180
+      Left            =   120
+      TabIndex        =   1
+      Top             =   5200
+      Width           =   450
+   End
+   Begin VB.Label Label_Name 
+      AutoSize        =   -1  'True
+      Caption         =   "名称:"
+      Height          =   180
+      Left            =   120
+      TabIndex        =   0
+      Top             =   4840
+      Width           =   450
+   End
+End
+Attribute VB_Name = "Form_Favourite_Add"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = False
+Option Explicit
+Private Type Case_Block
+  address As Integer
+  style As Integer
+End Type
+Dim Block(0 To 9) As Case_Block
+Dim Rand_Cases(1 To 8000) As String
+Dim start_x As Integer, start_y As Integer, square_width As Integer, gap As Integer
+Private Sub Form_Load()
+  start_x = 120
+  start_y = 120
+  square_width = 815
+  gap = 75
+  favourite_add_confirm = False
+  If on_top = True Then
+    SetWindowPos Me.hwnd, -1, 0, 0, 0, 0, 1 Or 2
+  Else
+    SetWindowPos Me.hwnd, -2, 0, 0, 0, 0, 1 Or 2
+  End If
+  Text_Name = favourite_add_init_name
+  Text_Code = favourite_add_init_code
+  Call Text_Code_Change
+End Sub
+Private Sub Command_Confirm_Click()
+  If Text_Name = "" Then MsgBox "你还没有填名称喔", , "(⊙-⊙)": Exit Sub
+  Call Analyse_Code(UCase(Text_Code))
+  If Check = False Then MsgBox "编码出错啦", , "(⊙-⊙)": Exit Sub
+  favourite_add_confirm = True
+  favourite_add_name = Text_Name
+  favourite_add_code = Text_Code
+  Unload Form_Favourite_Add
+End Sub
+Private Sub Text_Code_Change()
+  Print_Block start_x, start_y, square_width * 4 + gap * 5, square_width * 5 + gap * 6, case_line_width, case_color, case_line_color
+  If Len(Text_Code) = 7 Then
+    Call Analyse_Code(UCase(Text_Code))
+    If Check = True Then
+      Text_Code = UCase(Text_Code)
+      Call Output_Graph
+    End If
+  End If
+End Sub
+Private Sub Text_Code_KeyPress(KeyAscii As Integer)
+  If KeyAscii = 13 Then Call Command_Confirm_Click
+End Sub
+Private Sub Text_Name_KeyPress(KeyAscii As Integer)
+  If KeyAscii = 13 Then Text_Code.SetFocus
+End Sub
+Private Sub Output_Graph()
+  Dim m, x, y As Integer
+  Dim width As Integer, height As Integer
+  Print_Block start_x, start_y, square_width * 4 + gap * 5, square_width * 5 + gap * 6, case_line_width, case_color, case_line_color
+  For m = 0 To 9
+    If Block(m).address <> 25 Then
+      x = (Block(m).address Mod 4) * (square_width + gap) + gap + start_x
+      y = Int(Block(m).address / 4) * (square_width + gap) + gap + start_y
+      If Block(m).style = 0 Or Block(m).style = 1 Then
+        width = square_width * 2 + gap
+      Else
+        width = square_width
+      End If
+      If Block(m).style = 0 Or Block(m).style = 2 Then
+        height = square_width * 2 + gap
+      Else
+        height = square_width
+      End If
+      Print_Block x, y, width, height, block_line_width, block_color, block_line_color
+    End If
+  Next m
+End Sub
+Private Sub Print_Block(print_start_x, print_start_y, print_width, print_height, print_line_width, print_color, print_line_color)
+  If print_width < 0 Or print_height < 0 Then Exit Sub
+  FillStyle = 0
+  DrawWidth = print_line_width
+  FillColor = print_color
+  Line (print_start_x, print_start_y)-(print_start_x + print_width, print_start_y + print_height), print_color, B
+  Line (print_start_x, print_start_y)-(print_start_x + print_width, print_start_y + print_height), print_line_color, B
+End Sub
+Private Function Check() As Boolean
+  Dim temp(0 To 19) As Boolean
+  Dim addr As Integer, i As Integer, j As Integer
+  For i = 0 To 19
+    temp(i) = False
+  Next i
+  Check = True
+  If Block(0).style <> 0 Or Block(0).address > 20 Or Block(0).address < 0 Then
+    Check = False
+  Else
+    addr = Block(0).address
+    If addr > 14 Or (addr Mod 4 = 3) Then Check = False
+    temp(addr) = True
+    temp(addr + 1) = True
+    temp(addr + 4) = True
+    temp(addr + 5) = True
+  End If
+  For i = 1 To 5
+    If Block(i).address > 20 Or Block(i).address < 0 Then
+      Check = False
+    ElseIf Block(i).style <> 1 And Block(i).style <> 2 Then
+      Check = False
+    Else
+      addr = Block(i).address
+      If Block(i).style = 1 Then
+        If addr > 18 Or (addr Mod 4 = 3) Then Check = False
+        If temp(addr) = True Or temp(addr + 1) = True Then Check = False
+        temp(addr) = True
+        temp(addr + 1) = True
+      End If
+      If Block(i).style = 2 Then
+        If addr > 15 Then Check = False
+        If temp(addr) = True Or temp(addr + 4) = True Then Check = False
+        temp(addr) = True
+        temp(addr + 4) = True
+      End If
+    End If
+  Next i
+  For i = 6 To 9
+    If Block(i).style <> 3 Or Block(i).address > 20 Or Block(i).address < 0 Then
+      Check = False
+    Else
+      addr = Block(i).address
+      If addr > 19 Then Check = False
+      If temp(addr) = True Then Check = False
+      temp(addr) = True
+    End If
+  Next i
+  j = 0
+  For i = 0 To 19
+    If temp(i) = False Then j = j + 1
+  Next i
+  If j <> 2 Then Check = False
+End Function
+Private Sub Analyse_Code(code As String)
+  On Error Resume Next
+  Dim temp(1 To 12) As Integer
+  Dim i, addr, style As Integer
+  Dim type_1, type_2, type_3 As Integer
+  Dim Table(0 To 19) As Integer
+  Dim num As Integer, b1 As Integer, b2 As Integer
+  Dim dat As String
+  For i = 1 To 6
+    dat = Mid(code, i + 1, 1)
+    If Asc(dat) >= 48 And Asc(dat) <= 57 Then num = Int(dat)
+    If Asc(dat) >= 65 And Asc(dat) <= 70 Then num = Asc(dat) - 55
+    b1 = num Mod 4
+    b2 = (num - b1) / 4 Mod 4
+    temp(i * 2 - 1) = b2
+    temp(i * 2) = b1
+  Next i
+  type_1 = 0: type_2 = 0: type_3 = 5
+  For i = 0 To 19
+    Table(i) = 69
+  Next i
+  For i = 0 To 9
+    Block(i).address = 69
+    Block(i).style = 69
+  Next i
+  dat = Left(code, 1)
+  If Asc(dat) >= 48 And Asc(dat) <= 57 Then num = Int(dat)
+  If Asc(dat) >= 65 And Asc(dat) <= 70 Then num = Asc(dat) - 55
+  Block(0).address = num
+  Block(0).style = 0
+  If Block(0).address > 14 Then GoTo err
+  Table(Block(0).address) = 0
+  Table(Block(0).address + 1) = 0
+  Table(Block(0).address + 4) = 0
+  Table(Block(0).address + 5) = 0
+  addr = 0
+  For i = 1 To 11
+    Do While Table(addr) <> 69
+      If addr < 19 Then
+        addr = addr + 1
+      Else
+        Exit Do
+      End If
+    Loop
+    style = temp(i)
+    If style = 0 Then
+      Table(addr) = 10
+    ElseIf style = 1 Then
+      If type_2 < 5 Then type_2 = type_2 + 1
+      If addr > 18 Then GoTo err
+      Block(type_2).style = 1
+      Block(type_2).address = addr
+      Table(addr) = type_2
+      Table(addr + 1) = type_2
+    ElseIf style = 2 Then
+      If type_2 < 5 Then type_2 = type_2 + 1
+      If addr > 15 Then GoTo err
+      Block(type_2).style = 2
+      Block(type_2).address = addr
+      Table(addr) = type_2
+      Table(addr + 4) = type_2
+    ElseIf style = 3 Then
+      If type_3 < 9 Then type_3 = type_3 + 1
+      Block(type_3).style = 3
+      Block(type_3).address = addr
+      Table(addr) = type_3
+    End If
+  Next i
+err:
+End Sub

Form_Game.frm

@@ -2,7 +2,7 @@ VERSION 5.00
 Begin VB.Form Form_Game 
    AutoRedraw      =   -1  'True
    BorderStyle     =   1  'Fixed Single
-   Caption         =   "HRD Game v1.3 by Dnomd343"
+   Caption         =   "HRD Game v1.4 by Dnomd343"
    ClientHeight    =   7305
    ClientLeft      =   45
    ClientTop       =   690
@@ -14,12 +14,20 @@ Begin VB.Form Form_Game
    ScaleHeight     =   7305
    ScaleWidth      =   7290
    StartUpPosition =   2  'ÆÁÄ»ÖÐÐÄ
+   Begin VB.CommandButton Command_Favourite 
+      Caption         =   "我的收藏"
+      Height          =   495
+      Left            =   5760
+      TabIndex        =   11
+      Top             =   2760
+      Width           =   1335
+   End
    Begin VB.CommandButton Command_Reduction_Snapshot 
       Caption         =   "»¹Ô­¿ìÕÕ"
       Height          =   495
       Left            =   5760
       TabIndex        =   10
-      Top             =   3480
+      Top             =   4080
       Width           =   1335
    End
    Begin VB.CommandButton Command_Create_Snapshot 
@@ -27,7 +35,7 @@ Begin VB.Form Form_Game
       Height          =   495
       Left            =   5760
       TabIndex        =   9
-      Top             =   2880
+      Top             =   3480
       Width           =   1335
    End
    Begin VB.CommandButton Command_Rand_Case 
@@ -64,7 +72,7 @@ Begin VB.Form Form_Game
       Height          =   495
       Left            =   5760
       TabIndex        =   1
-      Top             =   4080
+      Top             =   4680
       Width           =   1335
    End
    Begin VB.Timer Timer_Get_Time 
@@ -155,28 +163,6 @@ Dim last_move As Integer, move_times As Integer
 Dim total_steps As Long, total_time As Long
 Dim Start_Code As String
 Dim snapshot_code As String, snapshot_step As Long
-
-Private Sub Command_Create_Snapshot_Click()
-  If solve_compete = True Then MsgBox "你已经解好啦", , "> _ <": Exit Sub
-  If playing = False Then MsgBox "你还没开始呢", , "> _ <": Exit Sub
-  snapshot_code = Label_Code
-  snapshot_step = total_steps
-  MsgBox "快照创建成功" & vbCrLf & "编码: " & snapshot_code & vbCrLf & "步数: " & snapshot_step, , "> _ <"
-End Sub
-
-Private Sub Command_Reduction_Snapshot_Click()
-  If solve_compete = True Then MsgBox "你已经解好啦", , "> _ <": Exit Sub
-  If playing = False Then MsgBox "你还没开始呢", , "> _ <": Exit Sub
-  If snapshot_step = -1 Then MsgBox "你还没创建快照呢", , "> _ <": Exit Sub
-  If MsgBox("真要还原快照?", vbOKCancel, "^ - ^") = vbCancel Then Exit Sub
-  total_steps = snapshot_step
-  last_move = 10
-  Call Analyse(snapshot_code)
-  Call Output_Graph
-  Label_Step = "步数: " & total_steps
-  Label_Code = snapshot_code
-End Sub
-
 Private Sub Menu_Debug_Mode_Click()
   Menu_Debug_Mode.Checked = Not Menu_Debug_Mode.Checked
   If Menu_Debug_Mode.Checked = True Then debug_mode = True Else debug_mode = False
@@ -299,6 +285,29 @@ End Sub
 Private Sub Command_Rand_Case_Click()
   Form_Rand_Case.Show 1
 End Sub
+Private Sub Command_Favourite_Click()
+  favourite_add_confirm = False
+  Form_Favourite.Show 1
+End Sub
+Private Sub Command_Create_Snapshot_Click()
+  If solve_compete = True Then MsgBox "你已经解好啦", , "> _ <": Exit Sub
+  If playing = False Then MsgBox "你还没开始呢", , "> _ <": Exit Sub
+  snapshot_code = Label_Code
+  snapshot_step = total_steps
+  MsgBox "快照创建成功" & vbCrLf & "编码: " & snapshot_code & vbCrLf & "步数: " & snapshot_step, , "> _ <"
+End Sub
+Private Sub Command_Reduction_Snapshot_Click()
+  If solve_compete = True Then MsgBox "你已经解好啦", , "> _ <": Exit Sub
+  If playing = False Then MsgBox "你还没开始呢", , "> _ <": Exit Sub
+  If snapshot_step = -1 Then MsgBox "你还没创建快照呢", , "> _ <": Exit Sub
+  If MsgBox("真要还原快照?", vbOKCancel, "^ - ^") = vbCancel Then Exit Sub
+  total_steps = snapshot_step
+  last_move = 10
+  Call Analyse(snapshot_code)
+  Call Output_Graph
+  Label_Step = "步数: " & total_steps
+  Label_Code = snapshot_code
+End Sub
 Private Sub Command_Reset_Click()
   total_steps = 0
   total_time = 0

HRD_Game.vbp

@@ -5,6 +5,8 @@ Module=Module; Module.bas
 Form=Form_Classic_Cases.frm
 Form=Form_Creator.frm
 Form=Form_Rand_Case.frm
+Form=Form_Favourite.frm
+Form=Form_Favourite_Add.frm
 IconForm="Form_Game"
 Startup="Form_Game"
 HelpFile=""
@@ -15,7 +17,7 @@ Name="HRD_Game"
 HelpContextID="0"
 CompatibleMode="0"
 MajorVer=1
-MinorVer=3
+MinorVer=4
 RevisionVer=0
 AutoIncrementVer=0
 ServerSupportFiles=0

HRD_Game.vbw

@@ -1,5 +1,7 @@
 Form_Game = 52, 52, 883, 479, , 26, 28, 857, 453, C
-Module = 52, 52, 883, 479, Z
+Module = 52, 52, 883, 479, 
 Form_Classic_Cases = 104, 104, 891, 531, , 104, 104, 937, 531, C
 Form_Creator = 130, 130, 917, 557, , 104, 104, 891, 531, C
 Form_Rand_Case = 78, 78, 855, 505, , 156, 156, 933, 583, C
+Form_Favourite = 52, 52, 829, 479, Z, 26, 26, 803, 453, C
+Form_Favourite_Add = 156, 156, 933, 583, , 182, 182, 959, 609, C

Module.bas

@@ -1,9 +1,76 @@
 Attribute VB_Name = "Module"
+Option Explicit
+Public Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" (ByVal hkey As Long, ByVal dwIndex As Long, ByVal lpName As String, lpcbName As Long, ByVal lpReserved As Long, ByVal lpClass As String, lpcbClass As Long, lpftLastWriteTime As FILETIME) As Long
+Public Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hkey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
+Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hkey As Long) As Long
 Public Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
+Public Declare Function SHDeleteKey Lib "shlwapi.dll" Alias "SHDeleteKeyA" (ByVal hkey As Long, ByVal pszSubKey As String) As Long
+Public Type FILETIME
+  dwLowDateTime As Long
+  dwHighDateTime As Long
+End Type
+Public Const HKEY_CLASSES_ROOT = &H80000000
+Public Const HKEY_CURRENT_CONFIG = &H80000005
+Public Const HKEY_CURRENT_USER = &H80000001
+Public Const HKEY_DYN_DATA = &H80000006
+Public Const HKEY_LOCAL_MACHINE = &H80000002
+Public Const HKEY_USERS = &H80000003
+
 Public debug_mode As Boolean, on_top As Boolean, playing As Boolean, solve_compete As Boolean
 Public block_line_width As Integer, case_line_width As Integer
 Public block_color, block_line_color, case_color, case_line_color
 Public change_case As Boolean, change_case_title As String, change_case_code As String
-
+Public Favourite_Cases_name() As String, Favourite_Cases_code() As String
+Public favourite_add_name As String, favourite_add_code As String, favourite_add_confirm As Boolean
+Public favourite_add_init_name As String, favourite_add_init_code As String
+Public Sub FindKeys(hkey As Long, SubKey As String)
+  Dim phkRet As Long, lRet As Long, Index As Long, lName As Long, lReserved As Long, lClass As Long
+  Dim name As String, Class As String
+  Dim LWT As FILETIME
+  lReserved = 0
+  Index = 0
+  lRet = RegOpenKey(hkey, SubKey, phkRet)
+  If lRet = 0 Then
+    Do
+      name = String(255, Chr(0)): lName = Len(name)
+      lRet = RegEnumKeyEx(phkRet, Index, name, lName, lReserved, Class, lClass, LWT)
+      If lRet = 0 Then
+        ReDim Preserve Favourite_Cases_name(UBound(Favourite_Cases_name) + 1)
+        Favourite_Cases_name(UBound(Favourite_Cases_name)) = name
+      Else
+        Exit Do
+      End If
+      Index = Index + 1
+    Loop While lRet = 0
+  End If
+  Call RegCloseKey(phkRet)
+End Sub
+Public Sub Get_Favourite_Cases()
+  Dim i As Long, w
+  Dim temp As String
+  Set w = CreateObject("WScript.Shell")
+  ReDim Favourite_Cases_name(0)
+  Call FindKeys(HKEY_CURRENT_USER, "Software\HRD_Game\Favourite")
+  ReDim Favourite_Cases_code(UBound(Favourite_Cases_name))
+  For i = 1 To UBound(Favourite_Cases_name)
+    temp = Favourite_Cases_name(i)
+    temp = Left(temp, InStr(1, temp, Chr(0)) - 1)
+    Favourite_Cases_code(i) = w.RegRead("HKEY_CURRENT_USER\Software\HRD_Game\Favourite\" & temp & "\")
+    temp = Right(temp, Len(temp) - InStr(1, temp, "."))
+    Favourite_Cases_name(i) = temp
+  Next i
+End Sub
+Public Sub Save_Favourite_Cases()
+  Dim i As Long, length As Integer, w
+  Dim temp As String
+  Set w = CreateObject("WScript.Shell")
+  Call SHDeleteKey(HKEY_CURRENT_USER, "Software\HRD_Game\Favourite")
+  length = Len(Trim(UBound(Favourite_Cases_name)))
+  For i = 1 To UBound(Favourite_Cases_name)
+    temp = i
+    temp = String(length - Len(temp), "0") & temp
+    w.regWrite "HKEY_CURRENT_USER\Software\HRD_Game\Favourite\" & temp & "." & Favourite_Cases_name(i) & "\", Favourite_Cases_code(i), "REG_SZ"
+  Next i
+End Sub