picg.frm

一个有趣的拼图游戏

 Mov(用以确定Start是否按下）, Nub（图片数量）, _
 Dif(难度变量）, SS（秒）, MM（分）
'PicN（图片名）, _
 PL(15)图片数组的Left,PT(15)图片数组的Top , _
 PHid (隐藏图片的序号)

Private Sub difficulty_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
 If Button = 2 Then
  SetTime.Show           '启动游戏时间设置窗口
 End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
 End
End Sub

Private Sub showpic_Click()
  If Image1.Visible = False And Hig = 0 Then    '判断是否处于高难状态
    Renew  '恢复图片控件的位置
  End If
End Sub
Private Sub difficulty_Click()
'难度按键
PICG.Hide
 Dim a, b As Integer
 If Nub = 8 Then   '调整为16张图片的组合
   difficulty.Caption = "Easy"
   Nub = 15: Image2.Top = 3720 '调整图像控件的位置
   Dif = 1: Image3.Width = 3900
   Image3.Left = 120
   For I = 0 To 15
    PIC(I).Visible = True  '将隐藏图片复原
   Next
   If Hig = 0 Then
     GTiM = 3: GTiS = 0
   End If
 Else
   difficulty.Caption = "Hard"  '同上原理
   Nub = 8: Image2.Top = 3200
   Dif = 0: Image3.Width = 2100
   Image3.Left = 900
   For I = 0 To 8
     PIC(I).Visible = True
   Next
   For I = 9 To 15
     PIC(I).Visible = False
   Next
   If Hig = 0 Then
     GTiM = 1: GTiS = 30
   End If
 End If
 NEWPIC          '调整各图片数组控件的位置及重画图像
  a = PIC(Nub).Left: b = PIC(Nub).Top   '调整各控件及窗体的位置
  PICG.Width = a + 1500
  PICG.Height = b + 2600
  Watch.Left = a - 100: Watch.Top = b + 1700
  Image3.Top = b + 1700
PICG.Show
If Hig = 1 Then          '判断高难状态为真
  start = True
End If
End Sub
Private Sub exit_Click()
  End '退出
End Sub
Private Sub picopen_Click()
  CommonDialog1.Copies = &H2000
  '打开文件
  Dim CA As Integer          '取消变量
  CA = Mov
  Mov = 0                    '停止计时
  CommonDialog1.CancelError = True  '取消为真
  On Error GoTo HANDLER
  CommonDialog1.Filter = _
   "JPG图像,位图(*.jpg,*.bmp,*.gif)|*.jpg;*.bmp;*.gif|"
   CommonDialog1.ShowOpen
   '设置打开文件类型
On Error GoTo HANDLER
 If PICG.PicN <> CommonDialog1.FileName Then
     PICG.PicN = CommonDialog1.FileName  '载入图片
     Image1.Picture = LoadPicture("")
     Image1.Picture = LoadPicture(PICG.PicN)
 Else
   GoTo HANDLER
 End If
   PICG.Mov = 0  '不能移动PIC数组控件
   NEWPIC       '调整各图片数组控件的位置及重画图像
If Hig = 1 Then      '判断高难状态为真
  start = True
  Exit Sub
End If
HANDLER:
  '按取消按钮
Mov = CA          '恢复计时
End Sub
Private Sub NEWPIC()
'重画各PIC数组控件的图像
Renew  '将PIC数组控件的位置复原
If Image1.Picture = LoadPicture("") Then
  PICG.Mov = 0      '没有图片不动作
  WINER             '没图片时将PIC数组控件隐藏显示Image的边框
Else
  Dim C As Integer
  If Dif = 1 Then  '分割图像的大小
    C = 4
  Else
    C = 3
  End If
  For k = 0 To Nub
    PIC(k).PaintPicture Image1.Picture, 0, 0, _
    PIC(k).ScaleWidth, PIC(k).ScaleHeight, _
    (PIC(k).Left - PIC(0).Left) / 1200 * PICG.ImW / C, _
    (PIC(k).Top - PIC(0).Top) / 1600 * PICG.ImH / C, _
    PICG.ImW / C, PICG.ImH / C, _
    vbSrcCopy
  Next
  '将分割得到的图像画如各PIC数组控件
End If
End Sub
Private Sub start_Click()
'移动PIC数组控件的位置得到要拼的图
If start.Caption = "Anew" Then
   If PicN = "" Then
     PICG.PicN = CommonDialog1.FileName  '载入图片
   End If
   Image1.Picture = LoadPicture("")
   Image1.Picture = LoadPicture(PICG.PicN)
   start.Caption = "Start"
End If
If Image1.Picture <> LoadPicture("") Then  '判断是否有图片载入
 MM = 0: SS = 0   '时间置零
 Renew        '将PIC数组控件的位置复原
  Dim a, b, C As Integer   '移动图片的交换变量
  PHid = Int((Nub + 1) * Rnd + 0)  '随机取隐藏的PIC数组控件序号
  For I = 1 To 50   '交换移动50次
    For l = 0 To Nub
      a = PIC(PHid).Left: b = PIC(PHid).Top
      If PIC(l).Left = a + 1200 Or _
        PIC(l).Left = a - 1200 Then    '将左右PIC控件与之相移
        If PIC(l).Top = b Then         '将上下PIC控件与之相移
          PIC(PHid).Left = PIC(l).Left
          PIC(l).Left = a
        End If
      End If
      If PIC(l).Top = b + 1600 Or _
        PIC(l).Top = b - 1600 Then        '同上
        If PIC(l).Left = a Then
          PIC(PHid).Top = PIC(l).Top
          PIC(l).Top = b
        End If
      End If
    Next
  Next
  PIC(PHid).Visible = False      '隐藏该PIC控件
  PHidL = PIC(PHid).Left: PHidT = PIC(PHid).Top
  '得到不可见PIC控件的位置数据
  PIC(PHid).Left = PL(PHid)   '将其先放回原位置
  PIC(PHid).Top = PT(PHid)
  PICG.Mov = 1                '可移动变量
End If
End Sub
Private Sub Rude()
For l = 0 To Nub     '得到原始的各PIC数组控件的位置数据
  PL(l) = PIC(l).Left
  PT(l) = PIC(l).Top
Next
PIC(PHid).Visible = True   '隐藏PIC控件可见
End Sub
Private Sub Renew()
Watch.Text = "Time 00:00"  '计时重画
For I = 0 To Nub           '载入PIC数组控件的原始位置数据
  PIC(I).Left = PL(I)
  PIC(I).Top = PT(I)
Next
  PICG.Mov = 0              '不能操作拼图
If Nub = 15 Then            '隐藏PIC控件看情况置可见与否与否
  PIC(PHid).Visible = True
Else
  If PHid < 9 Then
    PIC(PHid).Visible = True
  End If
End If
Image1.Stretch = False
Image1.Visible = False
Image1.BorderStyle = 0    '调整Image1的边框样式得到图像的原始大小
PICG.ImH = Image1.Height  '得到图像的大小尺寸
PICG.ImW = Image1.Width
For I = 0 To Nub
  PIC(I).Visible = True   '置各PIC控件于可见
Next
End Sub
Private Sub Form_Load()
Dim path As String
'PICG.Left = 10240 / 2 - PICG.Width / 2 '居中
'PICG.Top = 7680 / 2 - PICG.Height / 2
'在注册表中 HKEY_CURRENT_CONFIG_\ _
DISPLAY\SETTINGS\RSOLUTION "1024,768"
'从该键值里可知显示的分辨率
Nub = 15: Dif = 1    '控件数，难度为1
Watch.Text = "Time 00:00"
Rude  '保存各PIC的原始位置数据
PicN = App.path & "\" & "pic01.jpg"   '路径及图片
On Error GoTo EXSU
  Image1.Picture = LoadPicture(PicN)
EXSU:
  '无此文件
If Image1.Picture = LoadPicture("") Then
  PICG.Mov = 0
Else
  NEWPIC       '调整各图片数组控件的位置及重画图像
End If
GTiM = 3
difficulty = True
End Sub
Private Sub pic_Click(Index As Integer)
Static a As Integer
Static b As Integer
'设置交换变量
If PICG.Mov = 1 Then         '从隐藏的PIC控件处开始
  '空白附近的PIC控件才可移动
  If PIC(Index).Left = PHidL + 1200 _
    Or PIC(Index).Left = PHidL - 1200 Then   '水平移动
    If PIC(Index).Top = PHidT Then
      a = PIC(Index).Left
      PIC(Index).Left = PHidL: PIC(Index).Top = PHidT
      PHidL = a
    End If
  End If
  If PIC(Index).Top = PHidT + 1600 Or _
    PIC(Index).Top = PHidT - 1600 Then        '上下移动
    If PIC(Index).Left = PHidL Then
      b = PIC(Index).Top
      PIC(Index).Left = PHidL: PIC(Index).Top = PHidT
      PHidT = b
    End If
  End If
  WINER   '判断是否胜利
End If
End Sub
Private Sub WINER()
For I = 0 To Nub
  '通过PIC各数组控件位置数据的比较做出判断
  If PIC(I).Left <> PL(I) Or PIC(I).Top <> PT(I) Then
    Exit Sub
  End If
Next I
For I = 0 To Nub
  PIC(I).Visible = False       '隐藏全部PIC控件
Next
 If Nub > 8 Then              '调整Image1的位置大小
  Image1.Height = 6380: Image1.Width = 4800
Else
  Image1.Height = 4780: Image1.Width = 3600
End If
Image1.Stretch = True
Image1.Visible = True
Image1.BorderStyle = 1         '显示边框
If Mov <> 0 Then               '判断是过关调用还是高难过程调用
  WIN.Show   '过关
End If
Mov = 0
End Sub
Private Sub Timer1_Timer()
 '计时器
 If Mov = 0 Then             '没进行拼图则退出
  Exit Sub
 End If
 If SS > 59 Then             '秒进分
   MM = MM + 1: SS = 0
 End If
 If SS < 10 Then             '当秒或分小于十时补前面一个字符“0”
  If SS = 0 Then
   ST = "00"
  Else
   ST = "0" & SS
  End If
 Else
  ST = SS
 End If
 If MM < 10 Then
  If MM = 0 Then
   MT = "00"
  Else
 MT = "0" & MM
 End If
 Else
   MT = MM
 End If
 SS = SS + 1                  '秒进一
 Watch.Text = "Time " & MT & ":" & ST   '计时显示
 If Hig = 0 Then     '不是高难的游戏时间
   If difficulty.Caption = "Hard" Then
     GTiM = 1: GTiS = 30
   Else
     GTiM = 3
   End If
 End If
 If MM = GTiM Then            '时间到（分钟）
   If GTiS <> 0 Then          '判断秒
     If SS <> GTiS + 1 Then
       Exit Sub
     End If
   End If
   TOVER = MsgBox("Time over,You lose !", vbOKOnly + vbExclamation, "GAME OVER")
   Image1.Picture = LoadPicture("")
   If PicN <> App.path & "\" & "pic01.jpg" Then
     PicN = ""
   End If
   For I = 0 To 15
     PIC(I).Left = PL(I)
     PIC(I).Top = PT(I)
   Next
   Mov = 0
   start.Caption = "Anew"
   WINER              '显示原拼图
 End If
End Sub