⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 huarongdao.frm

📁 小游戏
💻 FRM
字号:
VERSION 5.00
Begin VB.Form Form1 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Form1"
   ClientHeight    =   7305
   ClientLeft      =   4245
   ClientTop       =   2010
   ClientWidth     =   5715
   Icon            =   "huarongdao.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   487
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   381
   Begin VB.PictureBox Picture1 
      BackColor       =   &H00FFC0C0&
      DrawWidth       =   5
      Height          =   6000
      Left            =   480
      ScaleHeight     =   396
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   316
      TabIndex        =   0
      Top             =   960
      Visible         =   0   'False
      Width           =   4800
      Begin VB.Label Label1 
         BackStyle       =   0  'Transparent
         Caption         =   "出口"
         BeginProperty Font 
            Name            =   "隶书"
            Size            =   14.25
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Left            =   2040
         TabIndex        =   1
         Top             =   5640
         Width           =   615
      End
      Begin VB.Image character 
         Height          =   1200
         Index           =   9
         Left            =   0
         Stretch         =   -1  'True
         Top             =   0
         Visible         =   0   'False
         Width           =   1200
      End
      Begin VB.Image character 
         Height          =   1200
         Index           =   8
         Left            =   0
         Stretch         =   -1  'True
         Top             =   0
         Visible         =   0   'False
         Width           =   1200
      End
      Begin VB.Image character 
         Height          =   1200
         Index           =   7
         Left            =   0
         Stretch         =   -1  'True
         Top             =   0
         Visible         =   0   'False
         Width           =   1200
      End
      Begin VB.Image character 
         Height          =   1200
         Index           =   6
         Left            =   0
         Stretch         =   -1  'True
         Top             =   0
         Visible         =   0   'False
         Width           =   1200
      End
      Begin VB.Image character 
         Height          =   2400
         Index           =   5
         Left            =   0
         Stretch         =   -1  'True
         Top             =   0
         Visible         =   0   'False
         Width           =   1200
      End
      Begin VB.Image character 
         Height          =   2400
         Index           =   4
         Left            =   0
         Stretch         =   -1  'True
         Top             =   0
         Visible         =   0   'False
         Width           =   1200
      End
      Begin VB.Image character 
         Height          =   2400
         Index           =   3
         Left            =   0
         Stretch         =   -1  'True
         Top             =   0
         Visible         =   0   'False
         Width           =   1200
      End
      Begin VB.Image character 
         Height          =   2400
         Index           =   2
         Left            =   0
         Stretch         =   -1  'True
         Top             =   0
         Visible         =   0   'False
         Width           =   1200
      End
      Begin VB.Image character 
         Height          =   1200
         Index           =   1
         Left            =   0
         Stretch         =   -1  'True
         Top             =   0
         Visible         =   0   'False
         Width           =   2400
      End
      Begin VB.Image character 
         Height          =   2400
         Index           =   0
         Left            =   1200
         Stretch         =   -1  'True
         Top             =   0
         Visible         =   0   'False
         Width           =   2400
      End
   End
   Begin VB.Image Image1 
      Height          =   7335
      Left            =   0
      Stretch         =   -1  'True
      Top             =   0
      Width           =   5775
   End
   Begin VB.Menu mnuGame 
      Caption         =   "游戏&G"
      Begin VB.Menu mnuStart 
         Caption         =   "开始&N"
      End
      Begin VB.Menu mnuNext 
         Caption         =   "下一关&F"
      End
      Begin VB.Menu mnuBack 
         Caption         =   "上一关&B"
      End
      Begin VB.Menu mnuReplay 
         Caption         =   "重玩&R"
      End
      Begin VB.Menu mnuExit 
         Caption         =   "退出&E"
      End
   End
   Begin VB.Menu mnuProcess 
      Caption         =   "进度&P"
      Begin VB.Menu mnuSave 
         Caption         =   "保存进度&S"
      End
      Begin VB.Menu mnuRead 
         Caption         =   "读取进度&I"
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim Index As Integer '记录图片编号
Dim lastone As Image
Dim startx As Integer: Dim starty As Integer: Dim endx As Integer: Dim endy As Integer '记录当前空格的长短
Dim direction As String
Dim n As Integer
Dim movable As Boolean
Dim presentnumber As Integer
Dim savedata(1 To 21) As Integer '存进度的变量数组
Dim datanumber As Integer '供存进度的变量数组用
Dim stage As Integer

Private Sub character_Click(Index As Integer)
lastone.BorderStyle = 0
character(Index).BorderStyle = 1
Set lastone = character(Index)
presentnumber = Index
End Sub

Private Sub Form_Load()
Image1.Picture = LoadPicture(App.Path + "\images\background.jpg")
Me.Caption = "华容道"
Me.Show
Label1.Visible = False
mnuNext.Enabled = False: mnuBack.Enabled = False
'************以下为分布人像图像****************
character(0).Picture = LoadPicture(App.Path + "\images\caocao.jpg")
character(1).Picture = LoadPicture(App.Path + "\images\guanyu.jpg")
character(2).Picture = LoadPicture(App.Path + "\images\zhangfei.jpg")
character(3).Picture = LoadPicture(App.Path + "\images\zhaoyun.jpg")
character(4).Picture = LoadPicture(App.Path + "\images\machao.jpg")
character(5).Picture = LoadPicture(App.Path + "\images\huangzhong.jpg")
'**************************************************
For Index = 6 To 9
  character(Index).Picture = LoadPicture(App.Path + "\images\paw.jpg")
Next Index
mnuSave.Enabled = False: mnuRead.Enabled = False '刚打开程序时让存储及读取菜单不可用
End Sub

Private Sub mnuBack_Click()
Select Case stage
  Case 2
    stageone
  Case 3
    stagetwo
  Case 4
    stagethree
End Select
If stage <> 1 Then
  mnuBack.Enabled = True
Else
  mnuBack.Enabled = False
End If
If stage = 4 Then
  mnuNext.Enabled = False
Else
  mnuNext.Enabled = True
End If
End Sub

Private Sub mnuExit_Click()
End
End Sub

Private Sub mnuNext_Click()
Select Case stage
  Case 1
    stagetwo
  Case 2
    stagethree
  Case 3
    stagefour
End Select
If stage <> 1 Then
  mnuBack.Enabled = True
Else
  mnuBack.Enabled = False
End If
If stage = 4 Then
  mnuNext.Enabled = False
Else
  mnuNext.Enabled = True
End If
End Sub

Private Sub mnuRead_Click()
Open App.Path + "\save\savefile.dat" For Input As 1
For Index = 1 To 21
  Input #1, savedata(Index)
Next Index
Index = 0
For datanumber = 1 To 19 Step 2
  character(Index).Left = savedata(datanumber)
  Index = Index + 1
Next datanumber
Index = 0
For datanumber = 2 To 20 Step 2
  character(Index).Top = savedata(datanumber)
  Index = Index + 1
Next datanumber
stage = savedata(21)
Me.Caption = "华容道-第" + Str(stage) + "关"
Close #1
End Sub

Private Sub mnuReplay_Click()
Select Case stage
  Case 1
    stageone
  Case 2
    stagetwo
  Case 3
    stagethree
  Case 4
    stagefour
End Select
End Sub

Private Sub mnuSave_Click()
Index = 0
For datanumber = 1 To 19 Step 2
  savedata(datanumber) = character(Index).Left
  Index = Index + 1
Next datanumber
Index = 0
For datanumber = 2 To 20 Step 2
  savedata(datanumber) = character(Index).Top
  Index = Index + 1
Next datanumber
savedata(21) = stage
Open App.Path + "\save\savefile.dat" For Output As 1
For datanumber = 1 To 21
  Print #1, savedata(datanumber)
Next datanumber
Close #1
End Sub

Private Sub mnuStart_Click()
Picture1.Visible = True: Label1.Visible = True
For Index = 0 To 9
  character(Index).Visible = True
Next Index
stageone
mnuNext.Enabled = True
Picture1.Line (80, 395)-(240, 395), vbGreen
Set lastone = character(0)
mnuSave.Enabled = True: mnuRead.Enabled = True
End Sub

Private Sub stageone() '************安排人物位置*************
stage = 1
Me.Caption = "华容道-第" + Str(stage) + "关"
character(0).Left = 80: character(0).Top = 0: character(1).Left = 80: character(1).Top = 240
character(2).Left = 0: character(2).Top = 80: character(3).Left = 0: character(3).Top = 240
character(4).Left = 240: character(4).Top = 80: character(5).Left = 240: character(5).Top = 240
character(6).Left = 0: character(6).Top = 0: character(7).Left = 240: character(7).Top = 0
character(8).Left = 80: character(8).Top = 160: character(9).Left = 160: character(9).Top = 160
End Sub

Private Sub stagetwo()
stage = 2
Me.Caption = "华容道-第" + Str(stage) + "关"
character(0).Left = 80: character(0).Top = 0: character(1).Left = 80: character(1).Top = 160
character(2).Left = 0: character(2).Top = 0: character(3).Left = 0: character(3).Top = 160
character(4).Left = 240: character(4).Top = 0: character(5).Left = 240: character(5).Top = 160
character(6).Left = 0: character(6).Top = 320: character(7).Left = 80: character(7).Top = 240
character(8).Left = 160: character(8).Top = 240: character(9).Left = 240: character(9).Top = 320
End Sub

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If X < character(presentnumber).Left Then
  startx = character(presentnumber).Left - (Int((character(presentnumber).Left - X) \ 80) * 80 + 80)
  endx = character(presentnumber).Left
  starty = character(presentnumber).Top: endy = character(presentnumber).Top + character(presentnumber).Height
  direction = "left"
Else
  If X > character(presentnumber).Left And X < character(presentnumber).Left + character(presentnumber).Width Then
    startx = character(presentnumber).Left: endx = character(presentnumber).Left + character(presentnumber).Width
    If Y < character(presentnumber).Top Then
      starty = character(presentnumber).Top - (Int((character(presentnumber).Top - Y) \ 80) * 80 + 80)
      endy = character(presentnumber).Top
      direction = "up"
    Else
      starty = character(presentnumber).Top + character(presentnumber).Height
      endy = character(presentnumber).Top + character(presentnumber).Height + (Int((Y - character(presentnumber).Height - character(presentnumber).Top) \ 80) * 80 + 80)
      direction = "down"
    End If
  End If
  If X > character(presentnumber).Left + character(presentnumber).Width Then
    startx = character(presentnumber).Left + character(presentnumber).Width
    endx = character(presentnumber).Left + character(presentnumber).Width + (Int((X - character(presentnumber).Left - character(presentnumber).Width) \ 80) * 80 + 80)
    starty = character(presentnumber).Top
    endy = character(presentnumber).Top + character(presentnumber).Height
    direction = "right"
  End If
End If
For n = 0 To 9
  If (character(n).Left + character(n).Width <= startx Or character(n).Left >= endx) Or (character(n).Top + character(n).Height <= starty Or character(n).Top >= endy) Then
    movable = True
  Else
    movable = False
    Exit Sub
  End If
Next n
    Select Case direction
      Case "left"
        character(presentnumber).Left = character(presentnumber).Left - (endx - startx)
      Case "right"
        character(presentnumber).Left = character(presentnumber).Left + (endx - startx)
      Case "up"
        character(presentnumber).Top = character(presentnumber).Top - (endy - starty)
      Case "down"
        character(presentnumber).Top = character(presentnumber).Top + (endy - starty)
    End Select
If character(0).Top = 240 And character(0).Left = 80 Then
  MsgBox "你胜利了!", vbOKOnly, "结束"
  mnuNext_Click
End If
End Sub

Private Sub stagethree()
stage = 3
Me.Caption = "华容道-第" + Str(stage) + "关"
character(0).Left = 80: character(0).Top = 0: character(1).Left = 80: character(1).Top = 320
character(2).Left = 80: character(2).Top = 160: character(3).Left = 240: character(3).Top = 80
character(4).Left = 160: character(4).Top = 160: character(5).Left = 0: character(5).Top = 80
character(6).Left = 0: character(6).Top = 0: character(7).Left = 240: character(7).Top = 0
character(8).Left = 0: character(8).Top = 240: character(9).Left = 240: character(9).Top = 240
End Sub

Private Sub stagefour()
stage = 4
Me.Caption = "华容道-第" + Str(stage) + "关"
character(0).Left = 80: character(0).Top = 0: character(1).Left = 80: character(1).Top = 160
character(2).Left = 0: character(2).Top = 0: character(3).Left = 0: character(3).Top = 240
character(4).Left = 240: character(4).Top = 0: character(5).Left = 240: character(5).Top = 240
character(6).Left = 0: character(6).Top = 160: character(7).Left = 80: character(7).Top = 240
character(8).Left = 160: character(8).Top = 240: character(9).Left = 240: character(9).Top = 160
End Sub

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -