cut_pic.cls

一个桌面游戏

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "cut_Pic"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'************************************************
'**           程式设计：饶明惠(蛇夫)           **
'**           职    业：阿兵哥                 **
'**           E-Mail  ：[e-mail]  **
'************************************************
Option Explicit
Private in_Form As Form
Private in_srcPic As PictureBox, in_desPic As PictureBox
Private in_Piece As Integer
Private Gini_Width As Integer, Gini_Height As Integer
Private in_FormX As Integer, in_FormY As Integer
Private in_MoveDistance As Integer
Private GiniX As Integer, GiniY As Integer, GiniY1 As Integer
Private Direct As Integer
Private scrpixelX As Integer, scrpixelY As Integer
Private Wav() As Byte
Private in_Auto As Boolean
Private in_Sound As Boolean
Private CheckGoal As Boolean      '检查是否已到了目的
Private CheckMove As Boolean      '检查是否有移动

'**********************************本类别为切割Gini图用**************************

Sub Ini(out_Form As Form, out_srcPic As PictureBox, out_desPic As PictureBox, out_Piece As Integer, out_MoveDistance As Integer)
Set in_Form = out_Form
Set in_srcPic = out_srcPic
Set in_desPic = out_desPic
'in_Form.ScaleMode = vbPixels
in_srcPic.ScaleMode = vbPixels
in_desPic.ScaleMode = vbPixels

'计算Gini图的宽、高
in_Piece = out_Piece
Gini_Width = in_srcPic.ScaleWidth / in_Piece
Gini_Height = in_srcPic.ScaleHeight / 2        '输入图片为两倍Gini图高

'表单的宽、高与Gini图相同，但转成twips
in_Form.Width = Gini_Width * Screen.TwipsPerPixelX
in_Form.Height = Gini_Height * Screen.TwipsPerPixelY
in_desPic.Width = in_Form.Width
in_desPic.Height = in_Form.Height
in_MoveDistance = out_MoveDistance
scrpixelX = Screen.TwipsPerPixelX
scrpixelY = Screen.TwipsPerPixelY

'置于最顶层
Call SetWindowPos(in_Form.hwnd, -1, 0, 0, 0, 0, 3)

'载入资源
Wav = LoadResData(111, "WAVE")
          
Randomize Timer
End Sub
Sub cutPic()
Dim Index As Integer
Static Mouse As POINTAPI

If in_Auto = False Then
  '取得滑鼠位置
   Call GetCursorPos(Mouse)
Else
   If CheckGoal = True Then       '随机取得新目标
      With Screen
        Mouse.X = Int((.Width / .TwipsPerPixelX) * Rnd)
        Mouse.Y = Int((.Height / .TwipsPerPixelY) * Rnd)
      End With
      CheckGoal = False
   End If
End If

'运算后给予相对的Gini图和方向
If Mouse.X > ((in_Form.Left / scrpixelX) + Gini_Width) Then
  If Mouse.Y < (in_Form.Top / scrpixelY) Then                        '右上
     Direct = 0: Index = 1
  ElseIf Mouse.Y > ((in_Form.Top / scrpixelY) + (Gini_Height)) Then  '右下
     Direct = 0: Index = 3
  Else                                                               '右
     Direct = 0: Index = 2
  End If
  CheckMove = True
ElseIf Mouse.X < (in_Form.Left / scrpixelX) Then
  If Mouse.Y < (in_Form.Top / scrpixelY) Then                        '左上
     Direct = 1: Index = 1
  ElseIf Mouse.Y > ((in_Form.Top / scrpixelY) + (Gini_Height)) Then  '左下
     Direct = 1: Index = 3
  Else                                                               '左
     Direct = 1: Index = 2
  End If
  CheckMove = True
Else
  If Mouse.Y < (in_Form.Top / scrpixelY) Then                        '上
     Direct = 0: Index = 0
  ElseIf Mouse.Y > ((in_Form.Top / scrpixelY) + (Gini_Height)) Then  '下
     Direct = 0: Index = 4
  Else
     '到了目的地
     CheckGoal = True
     If CheckMove = True Then
        If in_Sound = True Then Call sndPlaySound(Wav(0), 5)           '音效
        CheckMove = False
     End If
     Exit Sub
  End If
  CheckMove = True
End If


'输入图片第一列为 Gini 遮罩图
'        第二列为 Gini 图

'计算Gini图位置
GiniX = Gini_Width * (Index Mod in_Piece)
GiniY = Gini_Height * (Index \ in_Piece)
GiniY1 = Gini_Height * ((in_Piece + Index) \ in_Piece)

'转换表单与萤幕的单位为 pixel 关系
If ((in_Form.Left / scrpixelX) + (Gini_Width / 2)) < Mouse.X Then
   in_FormX = in_FormX + in_MoveDistance                              '往右走
ElseIf ((in_Form.Left / scrpixelX)) > Mouse.X Then
   in_FormX = in_FormX - in_MoveDistance                              '往左走
End If
If ((in_Form.Top / scrpixelY) + (Gini_Height / 2)) < Mouse.Y Then
   in_FormY = in_FormY + in_MoveDistance                              '往下走
ElseIf ((in_Form.Top / scrpixelY)) > Mouse.Y Then
   in_FormY = in_FormY - in_MoveDistance                              '往上走
End If


in_srcPic.AutoRedraw = True
in_desPic.AutoRedraw = True
in_Form.AutoRedraw = True

'还原萤幕背景 = in_Form的内容
in_desPic.Visible = False
DoEvents

Dim ScrhDC As Long
'取得萤幕资源
ScrhDC = GetDC(0)
'备份萤幕背景
Call BitBlt(in_Form.hdc, 0, 0, Gini_Width, Gini_Height, ScrhDC, in_FormX, in_FormY, vbSrcCopy)
'copy萤幕背景作为 in_desPic的背景
Call BitBlt(in_desPic.hdc, 0, 0, Gini_Width, Gini_Height, ScrhDC, in_FormX, in_FormY, vbSrcCopy)
'释放萤幕资源
Call ReleaseDC(0, ScrhDC)

'正常copy Gini图
If Direct = 0 Then
Call StretchBlt(in_desPic.hdc, 0, 0, Gini_Width, Gini_Height, in_srcPic.hdc, GiniX, GiniY, Gini_Width, Gini_Height, vbSrcAnd)
Call StretchBlt(in_desPic.hdc, 0, 0, Gini_Width, Gini_Height, in_srcPic.hdc, GiniX, GiniY1, Gini_Width, Gini_Height, vbSrcPaint)
'水平反转Gini图
ElseIf Direct = 1 Then
Call StretchBlt(in_desPic.hdc, Gini_Width, 0, -Gini_Width, Gini_Height, in_srcPic.hdc, GiniX, GiniY, Gini_Width, Gini_Height, vbSrcAnd)
Call StretchBlt(in_desPic.hdc, Gini_Width, 0, -Gini_Width, Gini_Height, in_srcPic.hdc, GiniX, GiniY1, Gini_Width, Gini_Height, vbSrcPaint)
End If
in_desPic.Visible = True

'移动表单
in_Form.Move in_FormX * scrpixelX, in_FormY * scrpixelY

in_srcPic.AutoRedraw = False
in_desPic.AutoRedraw = False
in_Form.AutoRedraw = False
End Sub

Public Property Get Auto() As Boolean
Auto = in_Auto
End Property

Public Property Let Auto(ByVal out_Auto As Boolean)
in_Auto = out_Auto
End Property

Public Property Get Sound() As Boolean
Sound = in_Sound
End Property

Public Property Let Sound(ByVal out_Sound As Boolean)
in_Sound = out_Sound
End Property

Private Sub Class_Initialize()
CheckGoal = True
End Sub