shot.frm

Visual Basic课程举例1 有很好的例题

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "打靶游戏"
   ClientHeight    =   6510
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   8445
   LinkTopic       =   "Form1"
   ScaleHeight     =   6510
   ScaleWidth      =   8445
   StartUpPosition =   3  '窗口缺省
   Begin VB.PictureBox P1 
      BackColor       =   &H00E0E0E0&
      BorderStyle     =   0  'None
      Height          =   5655
      Left            =   120
      ScaleHeight     =   5655
      ScaleWidth      =   8175
      TabIndex        =   1
      Top             =   720
      Width           =   8175
   End
   Begin VB.CommandButton CmdPlay 
      BackColor       =   &H008080FF&
      Caption         =   "开始游戏"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   120
      Style           =   1  'Graphical
      TabIndex        =   0
      Top             =   120
      Width           =   1455
   End
   Begin VB.Label L2 
      BackColor       =   &H0080FF80&
      Caption         =   "最后一枪环数：0环"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   6120
      TabIndex        =   3
      Top             =   240
      Width           =   2175
   End
   Begin VB.Label L1 
      Alignment       =   1  'Right Justify
      BackColor       =   &H00FFFF80&
      Caption         =   "脱靶：000 命中：000 总分：0000"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   1800
      TabIndex        =   2
      Top             =   240
      Width           =   4095
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'
'VB综合演示程序
'
'本程序演示了数学函数、选择结构、循环结构等内容。
'
'设计：曹新国
'日期：2008年3月

' 程序用法：
'
'点击"开始游戏"按钮，随后会出现靶子，用鼠标点击靶子，然后得分。
'
'
' 功能扩展指南：
'
' 可以用图片代替靶子，或者同时出现数个分值不同的靶子，让用户自行打击

'定义靶子出现的位置和大小
Dim TX As Single, TY As Single, TR As Single

'脱靶数，命中数和总分
Dim Miss%, TakeIt%, TotalScore%

'命中状态
Dim ShotON As Boolean


Private Sub CmdPlay_Click()
    Dim St As Single, Wt As Single
    
    '分数及统计结果清0
    Miss = 0
    TakeIt = 0
    TotalScore = 0
    
    '靶子大小
    TR = 500
    
    '游戏共出现20次靶子
    For I = 1 To 20
        
        ' 延时0-3秒不等
        St = Timer + Rnd() * 3
        Do
            DoEvents
        Loop While St > Timer
        
        '画出靶子
        TX = TR + Rnd * (P1.Width - TR)
        TY = TR + Rnd * (P1.Height - TR)
        P1.Line (TX - TR, TY)-(TX + TR, TY)
        P1.Line (TX, TY - TR)-(TX, TY + TR)
        For J = 100 To TR Step 100
            P1.Circle (TX, TY), J, vbRed
        Next J
        
        '等待命中或者1秒超时
        ShotON = False
        St = Timer + 1
        Do
            DoEvents
        Loop While Not ShotON And St > Timer
        
        ' 统计命中靶子的次数和脱靶次数
        If Not ShotON Then Miss = Miss + 1 Else TakeIt = TakeIt + 1
        
        '消去靶子
        P1.Line (TX - TR, TY)-(TX + TR, TY), P1.BackColor
        P1.Line (TX, TY - TR)-(TX, TY + TR), P1.BackColor
        For J = 100 To TR Step 100
            P1.Circle (TX, TY), J, P1.BackColor
        Next J
        
        '更新得分
        L1.Caption = Format(Miss, "脱靶：000 ") & _
                     Format(TakeIt, "命中：000 ") & _
                     Format(TotalScore, "总分：0000")
    Next I
End Sub


Private Sub P1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim D As Single, Score As Integer
    
    '算出命中点距靶心距离
    D = Sqr((X - TX) ^ 2 + (Y - TY) ^ 2)
    
    '如果命中，则算出环数并算出得分
    If D < TR Then
    
        '设置命中标志
        ShotON = True
        
        '算出环数
        Score = 10 - Int(10 * D / TR)
        
        '将本次命中计入总分
        TotalScore = TotalScore + Score
        
        '更新最后一枪的成绩
        L2.Caption = Format(Score, "最后一枪环数：0环")
    End If
End Sub