form1.frm

fanlsh播放器,效果非常好,经典的播放软件

VERSION 5.00
Object = "{D27CDB6B-AE6D-11CF-96B8-444553540000}#1.0#0"; "Flash.ocx"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form Form1 
   AutoRedraw      =   -1  'True
   Caption         =   "SWF 浏览器 Ver 1.0  枕善居 http://www.mndsoft.com/blog/"
   ClientHeight    =   4335
   ClientLeft      =   4275
   ClientTop       =   3630
   ClientWidth     =   7815
   Icon            =   "Form1.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   289
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   521
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton cmdTempInt 
      Caption         =   "W"
      Height          =   375
      Left            =   120
      TabIndex        =   5
      ToolTipText     =   "临时文件夹"
      Top             =   120
      Width           =   375
   End
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   2400
      Top             =   120
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin ShockwaveFlashObjectsCtl.ShockwaveFlash ShockwaveFlash1 
      Height          =   3495
      Left            =   2400
      TabIndex        =   4
      Top             =   720
      Width           =   5295
      _cx             =   9340
      _cy             =   6165
      FlashVars       =   ""
      Movie           =   ""
      Src             =   ""
      WMode           =   "Window"
      Play            =   -1  'True
      Loop            =   -1  'True
      Quality         =   "High"
      SAlign          =   ""
      Menu            =   -1  'True
      Base            =   ""
      AllowScriptAccess=   "always"
      Scale           =   "ShowAll"
      DeviceFont      =   0   'False
      EmbedMovie      =   0   'False
      BGColor         =   ""
      SWRemote        =   ""
      MovieData       =   ""
   End
   Begin VB.DirListBox Dir1 
      Height          =   1215
      Left            =   120
      TabIndex        =   2
      Top             =   600
      Width           =   2175
   End
   Begin VB.FileListBox File1 
      Height          =   2070
      Left            =   120
      Pattern         =   "*.swf"
      TabIndex        =   1
      ToolTipText     =   "RightClick=>SaveAs"
      Top             =   1920
      Width           =   2175
   End
   Begin VB.DriveListBox Drive1 
      Height          =   315
      Left            =   600
      TabIndex        =   0
      Top             =   120
      Width           =   1695
   End
   Begin VB.Label lblFileName 
      Alignment       =   2  'Center
      Caption         =   "枕善居  [e-mail]"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FF0000&
      Height          =   255
      Left            =   3120
      TabIndex        =   3
      Top             =   240
      Width           =   4455
   End
   Begin VB.Menu mnuTmpInt 
      Caption         =   "临时文件夹"
   End
   Begin VB.Menu mnuAbout 
      Caption         =   "关于"
   End
   Begin VB.Menu mnuExit 
      Caption         =   "退出"
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'****************************************************************************
'人人为我，我为人人
'枕善居
'发布日期：05/04/01
'描  述：小巧SWF格式的Flash文件浏览器源码示例
'网  站：http://www.mndsoft.com
'e-mail：[e-mail]
'OICQ  : 88382850
'****************************************************************************
Dim SourceFileName As String

Private Sub cmdTempInt_Click()
Call mnuTmpInt_Click
End Sub

Private Sub Dir1_Change()
  File1.Path = Dir1.Path
End Sub

Private Sub Drive1_Change()
  Dir1.Path = Drive1.Drive
End Sub

Private Sub File1_Click()
  If Right$(Dir1.Path, 1) = "\" Then
    SourceFileName = Dir1.Path + File1.FileName
    Else
    SourceFileName = Dir1.Path + "\" + File1.FileName
  End If
  ShockwaveFlash1.Movie = SourceFileName
  lblFileName = File1.FileName
End Sub

Private Sub Arrange()
  Dim w, h As Long
  w = Form1.ScaleWidth
  h = Form1.ScaleHeight
  
  Drive1.Width = w / 3
  Dir1.Width = w / 3
  File1.Width = w / 3
  lblFileName.Width = 2 * w / 3 - 21
  ShockwaveFlash1.Width = 2 * w / 3 - 21
  
  Drive1.Left = 40
  Dir1.Left = 7
  File1.Left = 7
  lblFileName.Left = 7 + Drive1.Width + 7
  ShockwaveFlash1.Left = lblFileName.Left
    
  'Drive1.Height = 21
  Dir1.Height = w / 3 - 28
  File1.Height = h - Drive1.Height - Dir1.Height - 28
  lblFileName.Height = 21
  ShockwaveFlash1.Height = h - 21 - 21
  
  Drive1.Top = 7
  Dir1.Top = 7 + Drive1.Height + 7
  File1.Top = 7 + Drive1.Height + 7 + Dir1.Height
  lblFileName.Top = 7
  ShockwaveFlash1.Top = 7 + lblFileName.Height
  
  Drive1.Width = Drive1.Width - 30
End Sub

Private Sub File1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim FileName As String
If Button = vbRightButton Then
  If lblFileName = "" Then
    MsgBox "选择一个文件另存 ...", , "错误 !!!"
    Exit Sub
  End If
  CommonDialog1.Filter = "*.swf"
  CommonDialog1.ShowSave
  FileName = CommonDialog1.FileName
  If Right$(FileName, 4) <> ".swf" Then FileName = FileName + ".swf"
  FileCopy SourceFileName, FileName
End If
End Sub

Private Sub Form_Load()
  Form1.ScaleMode = 3 ' 像素
  Call Arrange
End Sub

Private Sub Form_Resize()
  Call Arrange
End Sub

Function iNetCache()
    Dim lngKey As Long      '句柄
    Dim lBufferSize As Long '长度
    Dim strBuffer As String '返回值
    '键值句柄
    RegOpenKey &H80000001, "Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders", lngKey
    '键值长度
    RegQueryValueEx lngKey, "Cache", 0&, lDataType, ByVal 0&, lBufferSize
    strBuffer = String(lBufferSize, " ")
    '返回键值
    RegQueryValueEx lngKey, "Cache", 0&, 0&, ByVal strBuffer, lBufferSize
    iNetCache = Left(strBuffer, lBufferSize)
    '关闭键值
    RegCloseKey lngKey
End Function
 
Private Sub mnuAbout_Click()
    MsgBox "SWF 浏览器 Ver 1.0  枕善居 http://www.mndsoft.com/blog/", vbInformation, "关于信息"
End Sub

Private Sub mnuExit_Click()
End
End Sub

Private Sub mnuTmpInt_Click()
Drive1.Drive = Left$(iNetCache, 1)
Dir1.Path = iNetCache
End Sub