frmmain.frm

《Visual Basic 6.0趣味程序导学》光盘

      TabIndex        =   6
      Top             =   1965
      Width           =   3300
   End
   Begin VB.Label Label4 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "斯是游戏，唯吾闲情"
      BeginProperty Font 
         Name            =   "幼圆"
         Size            =   15
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H0000FF00&
      Height          =   300
      Left            =   4500
      TabIndex        =   5
      Top             =   1515
      Width           =   2700
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "将不在广，五虎则灵"
      BeginProperty Font 
         Name            =   "幼圆"
         Size            =   15
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H0000FF00&
      Height          =   300
      Left            =   4500
      TabIndex        =   4
      Top             =   1065
      Width           =   2700
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "兵不在多，四个则行"
      BeginProperty Font 
         Name            =   "幼圆"
         Size            =   15
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H0000FF00&
      Height          =   300
      Left            =   4500
      TabIndex        =   3
      Top             =   615
      Width           =   2700
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "华容小径"
      BeginProperty Font 
         Name            =   "幼圆"
         Size            =   15
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H0000FF00&
      Height          =   300
      Left            =   5200
      TabIndex        =   2
      Top             =   165
      Width           =   1200
   End
   Begin VB.Label lblTime 
      Caption         =   "所花时间：0 秒"
      ForeColor       =   &H000000FF&
      Height          =   300
      Left            =   4905
      TabIndex        =   1
      Top             =   4245
      Width           =   2655
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'鼠标按下时鼠标位置（相对于Image控件）
Dim m_DragX, m_DragY As Integer
'鼠标按下时Image控件的左上角位置
Dim m_OldX, m_OldY As Integer
'鼠标松开时Image控件的左上角位置
Dim m_NewX, m_NewY As Integer
'游戏时间
Dim m_lngTime As Long

Private Sub cmdExit_Click()
    Unload Me
End Sub

Private Sub cmdStart_Click()
'恢复计时器重新计时
cmdStart.Caption = "重新开始"
tmrGameTime.Enabled = True
m_lngTime = 0
'移动图片到起始位置
imgGeneral(0).Move 0, 0
imgGeneral(1).Move 3000, 0
imgGeneral(2).Move 0, 2000
imgGeneral(3).Move 3000, 2000

imgSoldier(0).Move 0, 4000
imgSoldier(1).Move 1000, 3000
imgSoldier(2).Move 2000, 3000
imgSoldier(3).Move 3000, 4000

imgCaocao.Move 1000, 0
imgGuanyu.Move 1000, 2000
'让图片可以拖动
imgGeneral(0).Enabled = True
imgGeneral(1).Enabled = True
imgGeneral(2).Enabled = True
imgGeneral(3).Enabled = True

imgSoldier(0).Enabled = True
imgSoldier(1).Enabled = True
imgSoldier(2).Enabled = True
imgSoldier(3).Enabled = True

imgCaocao.Enabled = True
imgGuanyu.Enabled = True

End Sub

Private Sub imgCaocao_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
'鼠标按下时，开始拖动，记录鼠标位置
imgCaocao.Drag vbBeginDrag
m_DragX = X
m_DragY = Y
m_OldX = imgCaocao.Left
m_OldY = imgCaocao.Top

End Sub

Private Sub imgGeneral_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
imgGeneral(Index).Drag vbBeginDrag
m_DragX = X
m_DragY = Y
m_OldX = imgGeneral(Index).Left
m_OldY = imgGeneral(Index).Top

End Sub

Private Sub imgGuanyu_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
imgGuanyu.Drag vbBeginDrag
m_DragX = X
m_DragY = Y
m_OldX = imgGuanyu.Left
m_OldY = imgGuanyu.Top


End Sub

Private Sub imgSoldier_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
imgSoldier(Index).Drag vbBeginDrag
m_DragX = X
m_DragY = Y
m_OldX = imgSoldier(Index).Left
m_OldY = imgSoldier(Index).Top

End Sub

Private Sub picFrame_DragDrop(Source As Control, X As Single, Y As Single)
'拖动结束后先把图片控件移动到位
Source.Move (X - m_DragX), (Y - m_DragY)
'记录左上角位置
m_NewX = Source.Left
m_NewY = Source.Top
'判断移动方向
If (Abs(m_NewX - m_OldX) > Abs(m_NewY - m_OldY)) Then
    If (m_NewX - m_OldX > 0) Then
        '向右移动
        Source.Move m_OldX + 1000, m_OldY
    Else
        '向左移动
        Source.Move m_OldX - 1000, m_OldY
    End If
Else
    If (m_NewY - m_OldY > 0) Then
        '向下移动
        Source.Move m_OldX, m_OldY + 1000
    Else
        '向上移动
        Source.Move m_OldX, m_OldY - 1000
    End If
End If
'判断是否有重叠
'取被拖动控件中点，判断是否落在其它图片内部
Dim intCenterX, intCenterY As Integer
intCenterX = Source.Left + Source.Width / 2
intCenterY = Source.Top + Source.Height / 2

If (Source.Tag <> imgCaocao.Tag) Then
    If (PointInRect(imgCaocao, intCenterX, intCenterY)) Then
        Source.Move m_OldX, m_OldY
    End If
End If

If (Source.Tag <> imgGuanyu.Tag) Then
    If (PointInRect(imgGuanyu, intCenterX, intCenterY)) Then
        Source.Move m_OldX, m_OldY
    End If
End If

Dim intTemp As Integer
For intTemp = 0 To 3
    If (Source.Tag <> imgGeneral(intTemp).Tag) Then
        If (PointInRect(imgGeneral(intTemp), intCenterX, intCenterY)) Then
            Source.Move m_OldX, m_OldY
        End If
    End If
    If (Source.Tag <> imgSoldier(intTemp).Tag) Then
        If (PointInRect(imgSoldier(intTemp), intCenterX, intCenterY)) Then
            Source.Move m_OldX, m_OldY
        End If
    End If

Next intTemp
If (imgCaocao.Left = 1000 And imgCaocao.Top = 3000) Then
    '游戏成功，曹操逃出华容道
    MsgBox "你胜利了！你真行！，所花时间为 " & CStr(m_lngTime) & " 秒", vbOKOnly, "恭喜恭喜"
    '停止计时
    tmrGameTime.Enabled = False
    
    imgGeneral(0).Enabled = False
    imgGeneral(1).Enabled = False
    imgGeneral(2).Enabled = False
    imgGeneral(3).Enabled = False
    
    imgSoldier(0).Enabled = False
    imgSoldier(1).Enabled = False
    imgSoldier(2).Enabled = False
    imgSoldier(3).Enabled = False
    
    imgCaocao.Enabled = False
    imgGuanyu.Enabled = False
End If

End Sub

Private Function PointInRect(Image As Control, ByVal X As Integer, ByVal Y As Integer) As Boolean
'判断一个点是否在Image控件内部
If (X >= Image.Left And X <= (Image.Left + Image.Width) And Y >= Image.Top And Y <= (Image.Top + Image.Height)) Then
    PointInRect = True
Else
    PointInRect = False
End If
End Function


Private Sub tmrGameTime_Timer()
'设置游戏时间标签
m_lngTime = m_lngTime + 1
Dim strTime As String
strTime = "所花时间：" & CStr(m_lngTime) & " 秒"
lblTime.Caption = strTime
End Sub