vcr.frm

该文件包含一些关于软件的知识,里面有一些比较经典的东西,值得大家去卡看.

      Height          =   615
      Left            =   480
      TabIndex        =   12
      Top             =   4920
      Width           =   1935
   End
   Begin VB.Label lblBrand 
      BackStyle       =   0  'Transparent
      Caption         =   "北大青鸟BTest项目组"
      ForeColor       =   &H00FFFFFF&
      Height          =   375
      Left            =   3360
      TabIndex        =   9
      Top             =   5160
      Width           =   2895
   End
   Begin VB.Image imgTapeSlot 
      BorderStyle     =   1  'Fixed Single
      Height          =   735
      Left            =   2640
      Top             =   4920
      Width           =   4215
   End
   Begin VB.Label lblChannel 
      Alignment       =   2  'Center
      BackStyle       =   0  'Transparent
      BorderStyle     =   1  'Fixed Single
      Caption         =   "3"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   24
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H0000FF00&
      Height          =   615
      Left            =   6120
      TabIndex        =   8
      ToolTipText     =   "频道显示"
      Top             =   240
      Width           =   735
   End
End
Attribute VB_Name = "frmVCR"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'**********************************************
' 目的：  VCR 示例应用程序的主窗体。
' 用 Visual Basic 对象仿真一个录像机。
'**********************************************
Option Explicit

' 创建一个 Tape 类的实例
Dim Tape As New clsTape

Dim vntChannel As Variant   '频道号

' QBColor 函数的常数
Const vcrBlack = 0
Const vcrGreen = 2
Const vcrCyan = 3
Const vcrRed = 4
Const vcrMagenta = 5
Const vcrYellow = 6
Const vcrWhite = 7
Const vcrGray = 8
Const vcrLightBlue = 9
Const vcrLightGreen = 10
Const vcrLightCyan = 11
Const vcrLightRed = 12
Const vcrLightMagenta = 13




Private Sub cmdDown_Click()
    ' 如果在范围内，设置频道号
    If vntChannel > 2 Then
        vntChannel = vntChannel - 1
    Else
        vntChannel = 13
    End If
    
    ' 将频道变量赋值给显示
    lblChannel.Caption = vntChannel
End Sub

Private Sub cmdExit_Click()
    ' 卸载窗体，释放引用
    Unload Me
    Set frmVCR = Nothing
End Sub

Private Sub cmdForward_Click()
    ' 调用保存旧频道的函数
    SaveChannel vntChannel
    ' 必须在 3 频道播放录象带
    vntChannel = 3
    lblChannel.Caption = vntChannel
    ' 设置 Tape 类的属性
    Tape.Forward = True
    Tape.Speed = 50
    ' 启动记时器
    tmr2.Enabled = True
    tmr2.Interval = Tape.Speed
    ' 调用更新控件的函数
    ButtonManager frmVCR.cmdForward
End Sub

Private Sub cmdPause_Click()
    ' 停止记时器
    tmr2.Enabled = False
    ' 调用更新控件的函数
    ButtonManager frmVCR.cmdPause
End Sub

Private Sub cmdPlay_Click()
    ' 调用保存旧频道的函数
    SaveChannel vntChannel
    ' 必须在 3 频道播放录象带
    vntChannel = 3
    lblChannel.Caption = vntChannel
    ' 设置 Tape 类的属性
    Tape.Forward = True
    Tape.Speed = 300
    ' 启动记时器
    tmr2.Enabled = True
    tmr2.Interval = Tape.Speed
    ' 调用更新控件的函数
    ButtonManager frmVCR.cmdPlay
End Sub

Private Sub cmdRec_Click()
    Dim strStatus As String     '显示文本
    
    ' 调用保存旧频道的函数
    SaveChannel vntChannel
    ' 清除显示
    picTV.Cls
    ' 显示状态
    strStatus = "录像：" & vntChannel & " 频道"
    picTV.Print strStatus
    strStatus = lblTime.Caption
    picTV.Print strStatus
    ' 调用更新控件的函数
    ButtonManager frmVCR.cmdRec
End Sub

Private Sub cmdRewind_Click()
    ' 调用保存旧频道的函数
    SaveChannel vntChannel
    ' 必须在 3 频道播放录象带
    vntChannel = 3
    lblChannel.Caption = vntChannel
    ' 设置 Tape 类的属性
    Tape.Forward = False
    Tape.Speed = 50
    ' 启动记时器
    tmr2.Enabled = True
    tmr2.Interval = Tape.Speed
    ' 调用更新控件的函数
    ButtonManager frmVCR.cmdRewind
End Sub

Private Sub cmdSet_Click()
    ' 以模态方式显示用户输入
    frmSetTime.Show vbModal
End Sub

Private Sub cmdStop_Click()
    Dim intChannel As Integer   '频道号
    
    ' 停止记时器
    tmr2.Enabled = False
    ' 调用更新控件的函数
    ButtonManager frmVCR.cmdStop
    ' 清除显示
    picTV.Cls
    ' 恢复旧频道
    intChannel = SaveChannel(0)
    vntChannel = intChannel
    lblChannel.Caption = vntChannel
End Sub

Private Sub cmdUp_Click()
    ' 如果在范围内，设置频道号
    If vntChannel < 13 Then
        vntChannel = vntChannel + 1
    Else
        vntChannel = 2
    End If
    
     ' 将频道变量赋值给显示
     lblChannel.Caption = vntChannel
End Sub

Private Sub Form_Load()
    ' 显示当前时间
    lblTime.Caption = Format((Now), "h:mm AM/PM")
    ' 设置窗体高度
    frmVCR.Height = 6990
    img1.Visible = True
    ' 显示窗体
    Me.Show
    ' 设置初始频道
    vntChannel = 3
    lblChannel.Caption = vntChannel
End Sub

Private Sub Form_Unload(Cancel As Integer)
    ' 释放引用
    Set Tape = Nothing
    Set Recorder = Nothing
    Set frmVCR = Nothing
End Sub

Private Sub lblChannel_Change()
    ' 基于频道改变显示的颜色
    Select Case vntChannel
        Case 2
            picTV.BackColor = QBColor(vcrGreen)
        Case 3
            picTV.BackColor = QBColor(vcrWhite)
        Case 4
            picTV.BackColor = QBColor(vcrRed)
        Case 5
            picTV.BackColor = QBColor(vcrMagenta)
        Case 6
            picTV.BackColor = QBColor(vcrYellow)
        Case 7
            picTV.BackColor = QBColor(vcrCyan)
        Case 8
            picTV.BackColor = QBColor(vcrGray)
        Case 9
            picTV.BackColor = QBColor(vcrLightBlue)
        Case 10
            picTV.BackColor = QBColor(vcrLightGreen)
        Case 11
            picTV.BackColor = QBColor(vcrLightCyan)
        Case 12
            picTV.BackColor = QBColor(vcrLightRed)
        Case 13
            picTV.BackColor = QBColor(vcrLightMagenta)
    End Select
    
    ' 清除显示
    picTV.Cls
    ' 显示频道和时间
    picTV.Print "Channel: " & vntChannel
    picTV.Print lblTime.Caption
End Sub

Private Sub tmr1_Timer()
    ' 更新时间显示
    lblTime.Caption = Format((Now), "h:mm AM/PM")
    ' 如果 Recorder 属性被打开
    If Recorder.Enabled = True Then
        ' 如果是录像的时间
        If Recorder.StartRecording = lblTime.Caption Then
            ' 开始“录像”
            vntChannel = Recorder.Channel
            lblChannel.Caption = vntChannel
            ' 激活“录像”按钮
            cmdRec.Value = True
            ' 清除 Recorder 类中的属性
            Recorder.StartRecording = Empty
        End If
    Else
        ' 如果是停止录像的时间
        If Recorder.StopRecording = lblTime.Caption Then
            ' 激活“停止”按钮
            cmdStop.Value = True
            ' 清除 Recorder 类中的属性
            Recorder.StopRecording = Empty
        End If
    End If
End Sub


Private Sub tmr2_Timer()
    Dim intWidth As Integer     'Width 值
    Dim intLeft As Integer      'Left 值
    Dim objImage As Control     'Image 控件
    
    ' 获取显示的宽度
    intWidth = picTV.Width
    ' 调用 Tape 类中的方法
    ' 来“播放”磁带。
    Tape.Animate intWidth
    
    ' 从类中取出 Left 属性
    intLeft = Tape.Left
    ' 显示第一幅或第二幅图像
    If img1.Visible = True Then
        img1.Visible = False
        Set objImage = img2
    Else
        img1.Visible = True
        Set objImage = img1
    End If
    
    ' 清除显示
    picTV.Cls
    ' 在新位置上显示新图像
    picTV.PaintPicture objImage.Picture, intLeft, 1200
End Sub