frmain.frm

拼图游戏

VERSION 5.00
Object = "{27395F88-0C0C-101B-A3C9-08002B2F49FB}#1.1#0"; "PICCLP32.OCX"
Begin VB.Form frmmain 
   BackColor       =   &H80000004&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "卡通拼图"
   ClientHeight    =   6330
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   7455
   Enabled         =   0   'False
   ForeColor       =   &H8000000A&
   Icon            =   "frmain.frx":0000
   LinkTopic       =   "Form3"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   ScaleHeight     =   6330
   ScaleWidth      =   7455
   StartUpPosition =   1  '所有者中心
   Begin VB.Timer Timer1 
      Interval        =   1000
      Left            =   6180
      Top             =   6480
   End
   Begin VB.PictureBox Picture2 
      Height          =   435
      Left            =   2100
      ScaleHeight     =   375
      ScaleWidth      =   555
      TabIndex        =   2
      Top             =   6540
      Width           =   615
   End
   Begin VB.PictureBox Picture1 
      Height          =   435
      Left            =   1200
      ScaleHeight     =   375
      ScaleWidth      =   735
      TabIndex        =   1
      Top             =   6540
      Width           =   795
   End
   Begin PicClip.PictureClip PicClip 
      Left            =   1200
      Top             =   6720
      _ExtentX        =   12700
      _ExtentY        =   9525
      _Version        =   393216
      Rows            =   6
      Cols            =   6
   End
   Begin VB.PictureBox Picture3 
      BackColor       =   &H80000008&
      Enabled         =   0   'False
      Height          =   5460
      Left            =   120
      Negotiate       =   -1  'True
      ScaleHeight     =   5400
      ScaleWidth      =   7200
      TabIndex        =   0
      TabStop         =   0   'False
      Top             =   180
      Width           =   7260
   End
   Begin VB.Image imgchage 
      Height          =   180
      Left            =   1200
      Picture         =   "frmain.frx":030A
      ToolTipText     =   "改变难易度"
      Top             =   5880
      Width           =   210
   End
   Begin VB.Label labchage 
      AutoSize        =   -1  'True
      Caption         =   "难易度:初级"
      Height          =   180
      Left            =   120
      TabIndex        =   4
      Top             =   5880
      Width           =   990
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "选择"
      Height          =   180
      Left            =   6735
      TabIndex        =   3
      Top             =   5880
      Width           =   360
   End
   Begin VB.Image imgprev 
      Height          =   180
      Left            =   6495
      Picture         =   "frmain.frx":03EC
      ToolTipText     =   "上一张"
      Top             =   5880
      Width           =   180
   End
   Begin VB.Image imgnext 
      Height          =   180
      Left            =   7140
      Picture         =   "frmain.frx":04CE
      ToolTipText     =   "下一张"
      Top             =   5880
      Width           =   180
   End
   Begin VB.Line Line3 
      BorderColor     =   &H80000005&
      Index           =   1
      X1              =   7380
      X2              =   7380
      Y1              =   180
      Y2              =   5655
   End
   Begin VB.Line Line2 
      BorderColor     =   &H80000005&
      Index           =   0
      X1              =   0
      X2              =   7500
      Y1              =   15
      Y2              =   15
   End
   Begin VB.Line Line1 
      BorderColor     =   &H80000003&
      Index           =   0
      X1              =   0
      X2              =   7500
      Y1              =   0
      Y2              =   0
   End
   Begin VB.Line Line3 
      BorderColor     =   &H80000005&
      Index           =   3
      X1              =   105
      X2              =   7385
      Y1              =   5655
      Y2              =   5655
   End
   Begin VB.Line Line3 
      BorderColor     =   &H80000006&
      Index           =   2
      X1              =   105
      X2              =   7400
      Y1              =   165
      Y2              =   165
   End
   Begin VB.Line Line3 
      BorderColor     =   &H80000006&
      Index           =   0
      X1              =   105
      X2              =   105
      Y1              =   165
      Y2              =   5640
   End
   Begin VB.Shape Shape1 
      BorderWidth     =   2
      Height          =   555
      Left            =   420
      Top             =   6600
      Width           =   735
   End
   Begin VB.Image picbox 
      Appearance      =   0  'Flat
      BorderStyle     =   1  'Fixed Single
      Height          =   555
      Index           =   0
      Left            =   120
      Top             =   6600
      Width           =   615
   End
   Begin VB.Line Line1 
      BorderColor     =   &H80000003&
      Index           =   1
      X1              =   60
      X2              =   7440
      Y1              =   5760
      Y2              =   5760
   End
   Begin VB.Line Line2 
      BorderColor     =   &H80000005&
      Index           =   4
      X1              =   60
      X2              =   7440
      Y1              =   5775
      Y2              =   5775
   End
   Begin VB.Menu E_games 
      Caption         =   "游戏(&G)"
      Visible         =   0   'False
      Begin VB.Menu E_game 
         Caption         =   "开始游戏(&game)"
      End
      Begin VB.Menu E_restart 
         Caption         =   "重新开始(&replay)"
         Enabled         =   0   'False
      End
      Begin VB.Menu E_2 
         Caption         =   "-"
      End
      Begin VB.Menu E_help 
         Caption         =   "使用帮助(&help)"
      End
      Begin VB.Menu E_reg 
         Caption         =   "注册版权(&option)"
      End
      Begin VB.Menu E_1 
         Caption         =   "-"
      End
      Begin VB.Menu E_exit 
         Caption         =   "退出游戏(&exit)"
      End
   End
End
Attribute VB_Name = "frmmain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private flag As Boolean
Private patfade As PatternFade
Private Misize As Integer
Private Miemptyindex As Integer
Private Picarray(49) As Integer
Private Picarrayb(49) As Integer
Private startflag As Boolean
Private Picmunber As Integer
Private Picmunindex As Integer
Private Restartflag As Integer
Private Sub Command1_Click()
End
End Sub
Private Sub E_exit_Click()
Dim j%
If E_game.Enabled = False Then
  E_game.Enabled = True
  E_restart.Enabled = False
  imgnext.Enabled = True
  imgprev.Enabled = True
  imgchage.Enabled = True
  For j = 0 To Misize ^ 2 - 1
     picbox(j).Visible = False
  Next j
  Picture3.Visible = True
  Picture3.Picture = LoadPicture(App.Path & "\image\angle" & Picmunber & ".jpg")
Else
  End
End If
End Sub
Private Sub E_game_Click()
imgnext.Enabled = False
imgprev.Enabled = False
imgchage.Enabled = False
E_game.Enabled = False
E_restart.Enabled = True
Picture1.Picture = LoadPicture(App.Path & "\image\angle" & Picmunber & ".jpg")
patfade.FadeOut (100)
PicClip.Picture = LoadPicture(App.Path & "\image\angle" & Picmunber & ".jpg")
wash
show_bmp
Picture3.Visible = False
End Sub

Private Sub E_help_Click()
MsgBox "详情请见readme.txt", , "使用帮助"
End Sub

Private Sub E_reg_Click()
frmabout.Show 1
End Sub
Private Sub E_restart_Click()
show_bmp
End Sub
Private Sub Form_Load()
Dim i%
Randomize
Open (App.Path & "\image\picture.txt") For Input As #1
Input #1, Picmunindex
Close #1
Picmunber = 1
flag = True
startflag = True
Misize = 3
For i = 1 To 6 ^ 2 - 1
Load picbox(i)
Next i
Picture1.Picture = LoadPicture(App.Path & "\image\angle" & Picmunber & ".jpg")
End Sub
Private Sub wash()
Dim Bmove As Boolean
Dim i%, xcoord%, ycoord%, iRand%, j%
Miemptyindex = Misize ^ 2 - 1
PicClip.Rows = Misize
PicClip.Cols = Misize
For i = 0 To Misize ^ 2 - 1
Picarray(i) = i
Next i
xcoord = Miemptyindex Mod Misize
ycoord = Miemptyindex \ Misize
i = 0
While i < Misize ^ 4
    Bmove = False
    iRand = Int(4 * Rnd)
    If (iRand = 0) And (xcoord > 0) Then
        xcoord = xcoord - 1
        Bmove = True
    ElseIf (iRand = 1) And (xcoord < Misize - 1) Then
        xcoord = xcoord + 1
        Bmove = True
    ElseIf (iRand = 2) And (ycoord > 0) Then
        ycoord = ycoord - 1
        Bmove = True
    ElseIf (iRand = 3) And (ycoord < Misize - 1) Then
        ycoord = ycoord + 1
        Bmove = True
    End If
    If Bmove Then
       j = Picarray(Miemptyindex)
       Picarray(Miemptyindex) = Picarray(Misize * ycoord + xcoord)
       Picarray(Misize * ycoord + xcoord) = j
       Miemptyindex = Misize * ycoord + xcoord
       i = i + 1
    End If
Wend
Restartflag = Miemptyindex
End Sub
Private Sub show_bmp()
Dim i%
Miemptyindex = Restartflag
For i = 0 To 35
picbox(i).Visible = False
Next i
For i = 0 To Misize ^ 2 - 1
If i <> Restartflag Then
picbox(i).Picture = PicClip.GraphicCell(Picarray(i))
picbox(i).Visible = True
Else
picbox(i).Picture = PicClip.GraphicCell(Misize ^ 2 - 1)
End If
Next i
For i = 0 To Misize ^ 2 - 1
Picarrayb(i) = Picarray(i)
Next i
For i = 0 To Misize ^ 2 - 1
picbox(i).Left = 120 + (picbox(0).Width - 20) * (i Mod Misize)
picbox(i).Top = 170 + (picbox(0).Height - 20) * (i \ Misize)
Next i
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)
If Button = 2 Then
PopupMenu E_games
End If
End Sub
Private Sub imgchage_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)
imgchage.Left = 1215
imgchage.Top = 5890
Select Case Misize
Case 3
     Misize = 4
     labchage = "难易度:中级"
Case 4
     Misize = 5
     labchage = "难易度:高级"
Case 5
     Misize = 6
     labchage = "难易度:特级"
Case 6
     Misize = 3
     labchage = "难易度:初级"
End Select
PlaySound App.Path & "\move.wav"
End Sub
Private Sub imgchage_MouseUp(Button As Integer, Shift As Integer, x As Single, Y As Single)
imgchage.Left = 1200
imgchage.Top = 5880
End Sub
Private Sub imgnext_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)
Picmunber = Picmunber + 1
If Picmunber > Picmunindex Then Picmunber = 1
imgnext.Left = 7150
imgnext.Top = 5890
Picture3.Picture = LoadPicture(App.Path & "\image\angle" & Picmunber & ".jpg")
PlaySound App.Path & "\move.wav"
End Sub
Private Sub imgnext_MouseUp(Button As Integer, Shift As Integer, x As Single, Y As Single)
imgnext.Left = 7140
imgnext.Top = 5880
End Sub
Private Sub imgprev_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)
Picmunber = Picmunber - 1
If Picmunber < 1 Then Picmunber = Picmunindex
imgprev.Left = 6485
imgprev.Top = 5890
Picture3.Picture = LoadPicture(App.Path & "\image\angle" & Picmunber & ".jpg")
PlaySound App.Path & "\move.wav"
End Sub
Private Sub imgprev_MouseUp(Button As Integer, Shift As Integer, x As Single, Y As Single)
imgprev.Left = 6500
imgprev.Top = 5880
End Sub
Private Sub picbox_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, Y As Single)
Dim xEmpty%, yEmpty%, yClicked%, xClicked%, j%
If Button = 1 Then
xEmpty = Miemptyindex Mod Misize
yEmpty = Miemptyindex \ Misize
xClicked = Index Mod Misize
yClicked = Index \ Misize
    If (xClicked = xEmpty + 1 And yClicked = yEmpty) Or _
        (xClicked = xEmpty - 1 And yClicked = yEmpty) Or _
        (yClicked = yEmpty + 1 And xClicked = xEmpty) Or _
        (yClicked = yEmpty - 1 And xClicked = xEmpty) Then
            j = Picarrayb(Miemptyindex)
            Picarrayb(Miemptyindex) = Picarrayb(Index)
            Picarrayb(Index) = j
            picbox(Miemptyindex).Picture = picbox(Index).Picture
            picbox(Miemptyindex).Visible = True
            Miemptyindex = Index
            picbox(Miemptyindex).Visible = False
            PlaySound App.Path & "\move.wav"
    End If
    For j = 0 To Misize ^ 2 - 1
       If Picarrayb(j) <> j Then
           Exit Sub
       End If
    Next j
    E_game.Enabled = True
    E_restart.Enabled = False
    imgnext.Enabled = True
    imgprev.Enabled = True
    imgchage.Enabled = True
    For j = 0 To Misize ^ 2 - 1
        picbox(j).Visible = False
    Next j
    Picture3.Visible = True
    patfade.FadeOut (100)
    Picture3.Picture = LoadPicture(App.Path & "\image\angle" & Picmunber & ".jpg")
Else
PopupMenu E_games
End If
End Sub
Private Sub Timer1_Timer()
If flag = True Then
 Set patfade = New PatternFade
 Set patfade.pic1 = Picture1
 Set patfade.pic2 = Picture2
 Set patfade.pic3 = Picture3
 patfade.Setup
 patfade.FadeIn (100)
 flag = False
 Me.Enabled = True
 Timer1.Enabled = False
End If
End Sub