frmplay.frm

来自「广播级有线电视台MTV互动点播系统」· FRM 代码 · 共 163 行

VERSION 5.00
Object = "{D27CDB6B-AE6D-11CF-96B8-444553540000}#1.0#0"; "swflash.ocx"
Begin VB.Form frmPLay 
   AutoRedraw      =   -1  'True
   BackColor       =   &H00000000&
   BorderStyle     =   0  'None
   Caption         =   "Form1"
   ClientHeight    =   9000
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   12000
   LinkTopic       =   "Form1"
   ScaleHeight     =   9000
   ScaleWidth      =   12000
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   WindowState     =   2  'Maximized
   Begin ShockwaveFlashObjectsCtl.ShockwaveFlash Flash 
      Height          =   735
      Left            =   8280
      TabIndex        =   3
      Top             =   0
      Width           =   3735
      _cx             =   4200892
      _cy             =   4195600
      Movie           =   ""
      Src             =   ""
      WMode           =   "Window"
      Play            =   -1  'True
      Loop            =   -1  'True
      Quality         =   "High"
      SAlign          =   ""
      Menu            =   -1  'True
      Base            =   ""
      Scale           =   "ShowAll"
      DeviceFont      =   0   'False
      EmbedMovie      =   0   'False
      BGColor         =   ""
      SWRemote        =   ""
   End
   Begin VB.Timer YF_Timer 
      Enabled         =   0   'False
      Interval        =   100
      Left            =   960
      Top             =   120
   End
   Begin VB.PictureBox PicTV 
      Appearance      =   0  'Flat
      BackColor       =   &H00000000&
      ForeColor       =   &H80000008&
      Height          =   255
      Left            =   240
      ScaleHeight     =   225
      ScaleWidth      =   345
      TabIndex        =   0
      Top             =   2640
      Width           =   375
   End
   Begin VB.Label YF 
      AutoSize        =   -1  'True
      BackColor       =   &H0080C0FF&
      BackStyle       =   0  'Transparent
      BeginProperty Font 
         Name            =   "隶书"
         Size            =   42
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FF0000&
      Height          =   840
      Left            =   1080
      TabIndex        =   1
      Top             =   8040
      Width           =   435
   End
   Begin VB.Label YF_BJ 
      BackColor       =   &H0080C0FF&
      Height          =   960
      Left            =   0
      TabIndex        =   2
      Top             =   8040
      Width           =   14655
   End
End
Attribute VB_Name = "frmPLay"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Dim pMC As Object
Dim pVW As IVideoWindow
Dim pMP As IMediaPosition
Dim Old_W, Old_H

Private Sub Form_Load()
On Error Resume Next
'===系统再次摘机===================
    TV_OffHookCtrl sCOM
    sCOMx.VoiceTimer = False
'===停止播放背景音乐=============
    frmXSCZ.MP1.Pause
    Me.Show
'====停止限时操作================
    frmXSCZ.Visible = False
    frmXSCZ.Timer1.Enabled = False
    Flash.Movie = App.Path + "\picturebj\play.swf"
'====设置播放画面的高和宽================
    frmPLay.Height = Screen.Height
    frmPLay.Width = Screen.Width
    Me.Refresh
    Set pMC = New FilgraphManager
    pMC.RenderFile FileName
    Set pVW = pMC
    pVW.WindowStyle = CLng(&H6000000)
    pVW.Left = 0
    pVW.Top = 0
    PicTV.Left = 0
    PicTV.Top = 0
    pVW.Width = Screen.Width
    pVW.Height = Screen.Height
'====设置游飞字幕的高度================
    pVW.Height = pVW.Height - Int(pVW.Height * (YF_BJ.Height + 10) / Screen.Height)
    PicTV.Width = Screen.Width
    PicTV.Height = Screen.Height - YF_BJ.Height - 10
'====播放MTV================
    pVW.Owner = PicTV.hwnd
    pMC.Run
    Set pMP = pMC
'====设置字幕属性================
    YF.Left = Screen.Width
    YF.Caption = YfZm
    WWW = YF.Width
    YF_Timer.Enabled = True
End Sub

Private Sub YF_Timer_Timer()
On Error Resume Next
Dim pHnd As Long
Dim RetVal As Long
'===控制游飞字幕的内容=======================
  YF.Caption = YfZm
  WWW = YF.Width
  YF.Left = YF.Left - 150
  If YF.Left + WWW <= -100 Then
      YF.Left = Screen.Width
  End If
  BuSy = 0
'===判断是否停止播放MTV=======================
  If pMP.CurrentPosition >= pMP.StopTime Then
      BuSy = 1
      pMC.Stop
      Set pMP = Nothing
      Set pMC = Nothing
      YF_Timer.Interval = 0
      TV_Exit
  End If
End Sub