From 1f93404651333711efc2fd444f4dd4054fabd80b Mon Sep 17 00:00:00 2001 From: Dnomd343 Date: Wed, 15 Apr 2020 01:22:53 +0800 Subject: [PATCH] v2.1 --- Form_Game.frm | 13 +++++--- Form_Solution.frm | 79 ++++++++++++++++++++++++++++++++++++++++++++++- Form_Start.frm | 8 ++--- Form_Wait.frm | 2 +- HRD_Game.vbp | 2 +- HRD_Game.vbw | 4 +-- Module.bas | 8 +++-- 7 files changed, 100 insertions(+), 16 deletions(-) diff --git a/Form_Game.frm b/Form_Game.frm index 7253ce8..d444b7d 100644 --- a/Form_Game.frm +++ b/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 v2.0 by Dnomd343" + Caption = "HRD Game v2.1 by Dnomd343" ClientHeight = 7305 ClientLeft = 45 ClientTop = 690 @@ -214,6 +214,9 @@ Begin VB.Form Form_Game Caption = "保持窗口最前" Checked = -1 'True End + Begin VB.Menu Menu_Output_With_Code + Caption = "输出图片带编码" + End Begin VB.Menu Menu_Debug_Mode Caption = "Debug模式" End @@ -302,16 +305,16 @@ Private Sub Menu_On_Top_Click() SetWindowPos Me.hwnd, -2, 0, 0, 0, 0, 1 Or 2 End If End Sub +Private Sub Menu_Output_With_Code_Click() + Menu_Output_With_Code.Checked = Not Menu_Output_With_Code.Checked + output_with_code = Menu_Output_With_Code.Checked +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 End Sub Private Sub Form_Load() Me.Icon = Me.MouseIcon - debug_mode = False - on_top = True - playing = False - solve_compete = False start_x = 180 start_y = 300 gap = 105 diff --git a/Form_Solution.frm b/Form_Solution.frm index 1a2e00f..10dc05b 100644 --- a/Form_Solution.frm +++ b/Form_Solution.frm @@ -13,6 +13,27 @@ Begin VB.Form Form_Solution ScaleHeight = 5145 ScaleWidth = 5295 StartUpPosition = 2 '屏幕中心 + Visible = 0 'False + Begin VB.PictureBox Picture_Print + AutoRedraw = -1 'True + BorderStyle = 0 'None + BeginProperty Font + Name = "微软雅黑" + Size = 9 + Charset = 134 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 15 + Left = 0 + ScaleHeight = 15 + ScaleWidth = 15 + TabIndex = 8 + Top = 0 + Width = 15 + End Begin VB.CommandButton Command_Output Caption = "导出数据" Height = 470 @@ -166,7 +187,33 @@ Private Sub Timer_Get_Data_Timer() End If End Sub Private Sub Command_Output_Click() - MsgBox "还没做好呢QAQ", , "> _ <" + On Error Resume Next + Dim i As Integer, str_len As Integer + MkDir start_code + Picture_Print.BackColor = case_color + Picture_Print.width = start_x * 2 + gap * 5 + square_width * 4 + Picture_Print.height = start_y * 2 + gap * 6 + square_width * 5 + If output_with_code = True Then Picture_Print.height = start_y * 2 + gap * 6 + square_width * 5 + 600 + str_len = Len(Trim(List_Solution.ListCount - 1)) + For i = 0 To List_Solution.ListCount - 1 + Picture_Print.Cls + Call Analyse_Code(List_Solution.List(i)) + Call Picture_Output_Graph + Picture_Print.FontSize = 30 + Picture_Print.CurrentX = 600 + Picture_Print.CurrentY = 4400 + Picture_Print.Print List_Solution.List(i) + SavePicture Picture_Print.Image, App.Path & "\" & start_code & "\" & String(str_len - Len(Trim(i)), "0") & i & "." & List_Solution.List(i) & ".bmp" + Next i + Picture_Print.Visible = False + Open App.Path & "\" & start_code & "\$Code.txt" For Output As #1 + For i = 0 To List_Solution.ListCount - 1 + Print #1, List_Solution.List(i) + Next i + If Label_Index.Caption = "无解" Then Print #1, "无解" Else Print #1, "共" & Trim(List_Solution.ListCount - 1) & "步" + Close #1 + MsgBox "布局图片导出完成", , "> _ <" + Shell "explorer.exe " & App.Path & "\" & start_code, vbNormalFocus End Sub Private Sub Get_Data(file_name As String) Dim temp As String, i As Integer, num As Integer @@ -187,6 +234,36 @@ Private Sub Get_Data(file_name As String) Close #1 List_Solution.ListIndex = 0 End Sub +Private Sub Picture_Output_Graph() + Dim m, X, Y As Integer + Dim width As Integer, height As Integer + Picture_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 + Picture_Print_Block X, Y, width, height, block_line_width, block_color, block_line_color + End If + Next m +End Sub +Private Sub Picture_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 + Picture_Print.FillStyle = 0 + Picture_Print.DrawWidth = print_line_width + Picture_Print.FillColor = print_color + Picture_Print.Line (print_start_x, print_start_y)-(print_start_x + print_width, print_start_y + print_height), print_color, B + Picture_Print.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 Output_Graph() Dim m, X, Y As Integer Dim width As Integer, height As Integer diff --git a/Form_Start.frm b/Form_Start.frm index 0501cdc..c07d052 100644 --- a/Form_Start.frm +++ b/Form_Start.frm @@ -25,7 +25,7 @@ Begin VB.Form Form_Start Width = 180 End Begin VB.CommandButton Command_Favourite - Caption = "收藏的布局" + Caption = "收藏夹" Height = 1095 Left = 1800 TabIndex = 4 @@ -33,7 +33,7 @@ Begin VB.Form Form_Start Width = 1815 End Begin VB.CommandButton Command_Rand_Case - Caption = "随机生成布局" + Caption = "随机生成" Height = 1095 Left = 0 TabIndex = 3 @@ -41,7 +41,7 @@ Begin VB.Form Form_Start Width = 1815 End Begin VB.CommandButton Command_Select_Case - Caption = "选择经典布局" + Caption = "经典布局" Height = 1095 Left = 1800 TabIndex = 2 @@ -49,7 +49,7 @@ Begin VB.Form Form_Start Width = 1815 End Begin VB.CommandButton Command_Create_Case - Caption = "自定义布局" + Caption = "自定义" Height = 1095 Left = 0 TabIndex = 1 diff --git a/Form_Wait.frm b/Form_Wait.frm index 8da93f9..e44c2cc 100644 --- a/Form_Wait.frm +++ b/Form_Wait.frm @@ -58,7 +58,7 @@ Attribute VB_Exposed = False Option Explicit Private Sub Form_Load() If debug_mode = True Then - Form_Wait.height = 1875 + Form_Wait.height = 1145 Text_Debug.Visible = True Else Form_Wait.height = 465 diff --git a/HRD_Game.vbp b/HRD_Game.vbp index 682685e..5e31392 100644 --- a/HRD_Game.vbp +++ b/HRD_Game.vbp @@ -21,7 +21,7 @@ Name="HRD_Game" HelpContextID="0" CompatibleMode="0" MajorVer=2 -MinorVer=0 +MinorVer=1 RevisionVer=0 AutoIncrementVer=0 ServerSupportFiles=0 diff --git a/HRD_Game.vbw b/HRD_Game.vbw index 413783d..e363484 100644 --- a/HRD_Game.vbw +++ b/HRD_Game.vbw @@ -1,5 +1,5 @@ Form_Game = 52, 51, 883, 479, , 26, 28, 857, 453, C -Module = 52, 52, 883, 479, +Module = 52, 52, 883, 479, Z 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 @@ -8,4 +8,4 @@ Form_Favourite_Add = 156, 156, 933, 583, , 182, 182, 959, 609, C Form_Solution = 104, 104, 862, 531, , 0, 0, 758, 427, C Form_Wait = 104, 104, 862, 531, , 78, 78, 836, 505, C Form_Detail = 26, 26, 784, 453, , 78, 78, 836, 505, C -Form_Start = 130, 130, 888, 557, Z, 104, 104, 862, 531, C +Form_Start = 130, 130, 888, 557, , 104, 104, 862, 531, C diff --git a/Module.bas b/Module.bas index 3fe5098..088395e 100644 --- a/Module.bas +++ b/Module.bas @@ -26,7 +26,7 @@ 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 +Public debug_mode As Boolean, on_top As Boolean, output_with_code As Boolean Public 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 @@ -94,7 +94,11 @@ Sub main() case_line_color = RGB(0, 158, 240) block_color = RGB(225, 245, 255) case_color = RGB(248, 254, 255) - 'Form_Game.Show + debug_mode = False + on_top = True + output_with_code = False + playing = False + solve_compete = False Form_Start.Show End Sub