“英语学习播放器2010”的开发过程

这个软件的开发，源于我学外语的时候，遇到的困难：

1：学外语，最大的问题是什么？是听力！但是常规的磁带、mp3、电影都有个问题，要想反反复复听某一句，不好定位。

2：练听力，有磁带，mp3，电影，那个最好？是电影！复读机可以不断重复，但是又不是影像的，不容易坚持。
我当年看电影《功夫熊猫》（中英双语）的时候，有些句子很快，使用暴风影音播放的时候，不断拉动进度条，因为一句话说得快的时候，就是几秒钟的功夫，在一个几十分钟的电影里，不容易定位，所以就开发了这个工具。

先介绍一下功能：

“打开”：打开英语电影，如“功夫熊猫.rmvb”（也可以右键选中“功夫熊猫.rmvb”，点“英语学习播放器2010”）

“清空”：删除“播放列表”全部的时间段
“删除”：删除“播放列表”当前的时间段
“播放”：循环播放“播放列表”当前的时间段

“向前”：倒退3秒播放
“向后”：快进3秒播放
“右键”：将“英语学习播放器”加到右键菜单

如播放英语电影至第5至8秒:
1：“开始”输入5
2：“结束”输入8
3：点“循环”，循环播放5-8秒内容
4：点“继续”，不循环播放了
5：点“保存”，将“5，8”保存至ini文件，下次播放时，可以自动播放这个时间段，无需重新输入这个时间段，对英语电影部分听不清楚的地方，尤其有用

下面是VB6源代码：

Option Explicit
Option Base 1

Dim T1 As Date
Dim VScroll1Value As Long
Dim nFileNo As Long
Dim strFileName As String
Dim strFileNameini As String
Dim i As Long
Dim Combo3_Text As String
Dim bCombo3 As Boolean
Dim strpath As String

Const HKEY_CLASSES_ROOT = &H80000000
Const ERROR_SUCCESS = 0&
Const REG_SZ = 1
Const SW_SHOW = 5
Private Declare Function GetCommandLine Lib "kernel32" Alias "GetCommandLineA" () As String
Private Declare Function GetCurrentTime Lib "kernel32" Alias "GetTickCount" () As Long
Private Declare Function OSRegCreateKey Lib "Advapi32" Alias "RegCreateKeyA" (ByVal hKey As Long,ByVal lpszSubKey As String,phkResult As Long) As Long
Private Declare Function OSRegSetValueEx Lib "Advapi32" Alias "RegSetValueExA" (ByVal hKey As Long,ByVal lpszValueName As String,ByVal dwReserved As Long,ByVal fdwType As Long,lpbData As Any,ByVal cbData As Long) As Long
Private Declare Function ShellExecute Lib "Shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long,ByVal lpOperation As String,ByVal lpFile As String,ByVal lpParameters As String,ByVal lpDirectory As String,ByVal nShowCmd As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Sub cmdPlay_Click() '播放
Dim tmpPos1 As Long
tmpPos1 = InStr(1,Combo3.Text,",")
If tmpPos1 > 1 Then
Text1.Text = Left(Combo3.Text,tmpPos1 - 1)
Text2.Text = Mid(Combo3.Text,tmpPos1 + 1)
Call Command6_Click
End If
'MsgBox Combo3.Text
End Sub

Private Sub cmdSave_Click()
Dim tmpStr1 As String
Dim tmpStr2 As String

bCombo3 = False
If Not IsNumeric(Trim(Text1.Text)) Or Not IsNumeric(Trim(Text2.Text)) Then
Exit Sub
End If

For i = 0 To Combo3.ListCount - 1
Combo3.ListIndex = i
If Combo3.Text = Trim(Text1.Text) & "," & Trim(Text2.Text) Then
Exit Sub
End If
Next
'Combo3.AddItem Trim(Text1.Text) & "," & Trim(Text2.Text)
tmpStr1 = Space(6 - Len(Trim(Text1.Text))) + Trim(Text1.Text)
tmpStr2 = Space(6 - Len(Trim(Text2.Text))) + Trim(Text2.Text)
Combo4.AddItem Replace(tmpStr1 + "," + tmpStr2," ","0")

Timer2.Enabled = True

End Sub

Private Sub Combo1_Click()
' MsgBox Combo1.Text

End Sub

Private Sub Combo3_Click()
If Not bCombo3 Then Exit Sub
'MsgBox "Combo3_Click"
If Combo3_Text <> Combo3.Text Then
Call cmdPlay_Click
End If
bCombo3 = False
End Sub

Private Sub Combo3_DropDown()
'MsgBox "Combo3_DropDown"
bCombo3 = True
Combo3_Text = Combo3.Text
'MsgBox "Combo3_DropDown"
End Sub

Private Sub Command1_Click() '向前
'WindowsMediaPlayer1.Controls
'WindowsMediaPlayer1.Controls.currentPosition = CDate(Text1.Text) - CDate(Text2.Text) '
WindowsMediaPlayer1.Controls.currentPosition = WindowsMediaPlayer1.Controls.currentPosition - Val(Combo1.Text)
End Sub

Private Sub Command10_Click()

If Text3.Visible Then
Text3.Text = ""
Timer3.Enabled = False
Text3.Visible = False

Else
Timer3.Enabled = True
Text3.Visible = True
End If
End Sub

Private Sub Command2_Click() '向后
WindowsMediaPlayer1.Controls.currentPosition = WindowsMediaPlayer1.Controls.currentPosition + Val(Combo2.Text)

End Sub

Private Sub Command3_Click()
CommonDialog1.Filter = "所有文件 (*.*)|*.*|rmvb(*.rmvb)|*.rmvb|rm(*.rm)|*.rm|wmv(*.wmv)|*.wmv|avi(*.avi)|*.avi|mp3(*.mp3)|*.mp3|asf(*.asf)|*.asf"

'指定缺省过滤器。
CommonDialog1.FilterIndex = 1
'显示“打开”对话框。
CommonDialog1.ShowOpen
'调用打开文件的过程。
'MsgBox CommonDialog1.FileName & vbCrLf & strFileName

If strFileName = CommonDialog1.FileName Then '防止打开现在播放中的电影
Exit Sub
End If
strFileName = CommonDialog1.FileName
'Me.Caption = strFileName
Call GetININame
End Sub

Private Sub Command4_Click()
Timer1.Enabled = False
'Text1.Text = "开始"
'Text2.Text = "结尾"
End Sub

Private Sub Command5_Click() '清空
If MsgBox("真的要删除播放列表？",vbCritical,"提示") = vbOK Then
Combo3.Clear
'Call SaveCombo3
End If
End Sub

Private Sub Command6_Click()
'If Command6.Caption = "循环" Then
' Command6.Caption = "不循环"
'Timer1.Enabled = False
'Text1.Text = "开始"
'Text2.Text = "结尾"
'ElseIf Command6.Caption = "不循环" Then
'Command6.Caption = "循环"
If Trim(Text1.Text) = "" And Trim(Text2.Text) = "" Or Trim(Text1.Text) = "0" And Trim(Text2.Text) = "0" Then
Text1.Text = "0"
Text2.Text = WindowsMediaPlayer1.currentMedia.duration - 0.3
End If
WindowsMediaPlayer1.Controls.currentPosition = Val(Text1.Text)
Timer1.Enabled = True
WindowsMediaPlayer1.Controls.play
'Text1.Text = "Click here to get the time for starting play"
'Text2.Text = "Click here to get the time for endding play"

'End If
End Sub

Private Sub xzPaiXu(a() As Double,sheng As Boolean)
'a为需要排序的数组，sheng为True则为升序排列，为False，则为降序排列。
Dim i As Integer,j As Integer
Dim temp As Double
Dim m As Integer
For i = LBound(a) To UBound(a) - 1 '进行数组大小-1轮比较
m = i '在第i轮比较时，假定第
'i个元素为最值元素
For j = i + 1 To UBound(a) '在剩下的元素中找出最
'值元素的下标并记录在m中
If sheng Then '若为升序，则m记录最小元素
'下标,否则记录最大元素下标
If a(j) < a(m) Then m = j
Else
If a(j) > a(m) Then m = j
End If
Next j '将最值元素与第i个元素交换
temp = a(i)
a(i) = a(m)
a(m) = temp
Next i
End Sub
'调用该过程示例:
'
Private Sub Command7_Click0()
'Text3.Text = ""
Dim b(6) As Double
b(1) = 8
b(2) = 6
b(3) = 6
b(4) = 3
b(5) = 2
b(6) = 7
'Call xzPaiXu(b,True)
Call Quicksort(b,1,6)
For i = 1 To UBound(b)

' Text3.Text = Text3.Text & b(i) & vbCrLf
Next
End Sub

Sub Quicksort(List() As Double,min As Integer,max As Integer)
Dim med_value As Long
Dim hi As Integer
Dim lo As Integer
Dim i As Integer

' If the list has no more than 1 element,it's sorted.
If min >= max Then Exit Sub

' Pick a dividing item.
i = Int((max - min + 1) * Rnd + min)
med_value = List(i)

' Swap it to the front so we can find it easily.
List(i) = List(min)

' Move the items smaller than this into the left
' half of the list. Move the others into the right.
lo = min
hi = max
Do
' Look down from hi for a value < med_value.
Do While List(hi) >= med_value
hi = hi - 1
If hi <= lo Then Exit Do
Loop
If hi <= lo Then
List(lo) = med_value
Exit Do
End If

' Swap the lo and hi values.
List(lo) = List(hi)

' Look up from lo for a value >= med_value.
lo = lo + 1
Do While List(lo) < med_value
lo = lo + 1
If lo >= hi Then Exit Do
Loop
If lo >= hi Then
lo = hi
List(hi) = med_value
Exit Do
End If

' Swap the lo and hi values.
List(hi) = List(lo)
Loop

' Sort the two sublists
Quicksort List(),min,lo - 1
Quicksort List(),lo + 1,max
End Sub

Private Sub Command7_Click()
Call RegMedia
End Sub

Private Sub Command9_Click() '删除
Dim tmpStr As String
Dim tmpStr1 As String
Dim tmpStr2 As String

Dim Combo3_ListIndex As Long
Dim tmpPos1 As Long
Dim tmpPos2 As Long

Combo3_ListIndex = Combo3.ListIndex

If Combo3_ListIndex > -1 And Combo3_ListIndex < Combo3.ListCount Then
tmpStr = Trim(Combo3.Text)
tmpPos1 = InStr(1,tmpStr,")
If tmpPos1 > 0 Then
tmpStr1 = Left(tmpStr,tmpPos1 - 1)
tmpStr2 = Mid(tmpStr,tmpPos1 + 1)
tmpStr1 = Space(6 - Len(tmpStr1)) + tmpStr1
tmpStr2 = Space(6 - Len(tmpStr2)) + tmpStr2
tmpStr = Replace(tmpStr1 + ","0")
For i = 0 To Combo4.ListCount - 1
Combo4.ListIndex = i
If Combo4.Text = tmpStr Then
Combo4.RemoveItem (i)
Exit For
End If
Next


Combo3.RemoveItem (Combo3.ListIndex)
End If
End If
If Combo3_ListIndex > (Combo3.ListCount - 1) Then
Combo3.ListIndex = Combo3.ListCount - 1
Else
Combo3.ListIndex = Combo3_ListIndex
End If

'写入到ini文件
Call SaveCombo3

End Sub

Private Sub Form_Load()

Combo3_Text = ""
Combo4.Visible = False
Text1.Text = "开始"
Text2.Text = "结尾"

T1 = Now()

Dim tmpCommand As String
'tmpStr = GetCommandLine()
strFileName = Command '这个就是使得exe可以打开一个媒体文件
'MsgBox strFileName
'If strFileName <> "" Then
If Trim(strFileName) = "" Then Exit Sub

'去除文件名两边的双引号（如果存在的话）
If (Left$(strFileName,1) = """") And (Right$(strFileName,1) = """") Then
strFileName = Mid$(strFileName,2,Len(strFileName) - 2)
End If
WindowsMediaPlayer1.URL = strFileName
WindowsMediaPlayer1.Controls.play

Timer1.Enabled = False
Call GetCombo1

Text3.ForeColor = vbRed

strFileName = Command$()
'MsgBox strFileName ': End
'Me.Caption = strFileName
If strFileName <> "" Then
Call GetININame
End If
End Sub

Private Sub Form_Resize()

'FormResize
' Command1.Height = Me.Height - 500
' Command1.Width = Me.Width
WindowsMediaPlayer1.Left = 0
WindowsMediaPlayer1.Top = 0
WindowsMediaPlayer1.Height = Me.Height - 450
WindowsMediaPlayer1.Width = Me.Width
Frame1.Top = WindowsMediaPlayer1.Height - (Frame1.Height + 80)
Frame1.Left = Me.Width - (Frame1.Width + 200)

Text3.Top = Frame1.Top - Text3.Height - 300
Text3.Left = WindowsMediaPlayer1.Left + WindowsMediaPlayer1.Width - Text3.Width - 200

End Sub

Private Sub Text1_Click()
Text1.Text = Int(WindowsMediaPlayer1.Controls.currentPosition)
End Sub
Private Sub Text2_Click()
Text2.Text = Int(WindowsMediaPlayer1.Controls.currentPosition)
End Sub
Private Sub Timer1_Timer()
'Text1.Text = WindowsMediaPlayer1.Controls.currentPositionString
'Text1.Text = WindowsMediaPlayer1.Controls.currentPosition
If Val(Trim(Text2.Text)) = 0 Then Exit Sub
If Val(Trim(Text1.Text)) > Val(Trim(Text2.Text)) Then Exit Sub

If WindowsMediaPlayer1.Controls.currentPosition > Val(Text2.Text) Then
WindowsMediaPlayer1.Controls.stop
WindowsMediaPlayer1.Controls.currentPosition = Val(Text1.Text)
WindowsMediaPlayer1.Controls.play
End If
End Sub

Private Sub VScroll1_Change()
'If Val(Text2.Text) - 'VScroll1.Value > 0 Then

'If 'VScroll1.Value = 0 Then
' 'VScroll1.Value = 1
' VScroll1Value = 'VScroll1.Value
'End If Val(Text2.Text) - VScroll1Value +
'Text2.Text = 'VScroll1.Value
' Text2.Text = 'VScroll1.Value
'End If
End Sub

Private Sub GetCombo1()
Combo1.AddItem "3"
Combo1.AddItem "5"
Combo1.AddItem "8"
Combo1.AddItem "10"
Combo1.AddItem "15"
Combo1.AddItem "20"
Combo1.AddItem "25"
Combo1.AddItem "30"
Combo1.AddItem "35"
Combo1.AddItem "40"
Combo1.AddItem "45"
Combo1.AddItem "50"
Combo1.AddItem "55"
Combo1.AddItem "60"
Combo1.ListIndex = 0

Combo2.AddItem "3"
Combo2.AddItem "5"
Combo2.AddItem "8"
Combo2.AddItem "10"
Combo2.AddItem "15"
Combo2.AddItem "20"
Combo2.AddItem "25"
Combo2.AddItem "30"
Combo2.AddItem "35"
Combo2.AddItem "40"
Combo2.AddItem "45"
Combo2.AddItem "50"
Combo2.AddItem "55"
Combo2.AddItem "60"
Combo2.ListIndex = 0
End Sub

Private Sub FormResize()
'Me.MaxButton.Click
WindowsMediaPlayer1.Top = Form1.Top
WindowsMediaPlayer1.Left = Me.Left
WindowsMediaPlayer1.Height = Me.Height - 500
WindowsMediaPlayer1.Width = Me.Width

Command1.Top = WindowsMediaPlayer1.Height - 500
Command1.Left = WindowsMediaPlayer1.Width - 5500

Command2.Top = Command1.Top
Command2.Left = Command1.Left + Command1.Width + 100

Command3.Top = Command1.Top
Command3.Left = Command1.Left - Command3.Width - 100

Combo1.Top = Command1.Top + 80
Combo1.Left = Command1.Left + 500

Combo2.Top = Command2.Top + 80
Combo2.Left = Command2.Left + 500
End Sub

Private Sub GetCombo300()
Dim tmpStr As String
Dim tmpPos1 As Long
nFileNo = FreeFile
Open strFileNameini For Input As #nFileNo
Do While Not EOF(nFileNo)
Line Input #nFileNo,tmpStr
If Len(Trim(tmpStr)) > 2 Then
tmpPos1 = InStr(1,")
If tmpPos1 > 1 Then
If IsNumeric(Left(tmpStr,tmpPos1 - 1)) Then
If IsNumeric(Mid(tmpStr,tmpPos1 + 1)) Then
Combo3.AddItem Trim(Replace(tmpStr,"))
End If
End If
End If
End If
DoEvents
Loop
Close #nFileNo
If Combo3.ListCount > 0 Then
Combo3.ListIndex = 0
End If
End Sub
Private Sub GetCombo3()
Dim tmpStr As String
Dim tmpStr1 As String
Dim tmpStr2 As String

Dim tmpPos1 As Long
Dim tmpPos2 As Long
Timer2.Enabled = False
If Combo4.ListCount > 0 Then
Combo3.Clear
Combo3.Refresh
For i = 0 To Combo4.ListCount - 1
'i = 0

Combo4.ListIndex = i
tmpStr = Trim(Combo4.Text)
'MsgBox tmpStr
tmpPos1 = InStr(1,")
'MsgBox tmpPos1
If tmpPos1 > 0 Then
tmpStr1 = Trim(Str(Val(Left(tmpStr,tmpPos1 - 1))))
tmpStr2 = Trim(Str(Val(Mid(tmpStr,tmpPos1 + 1))))
'Combo5.AddItem tmpStr1 + "," + tmpStr2
Combo3.AddItem tmpStr1 + "," + tmpStr2
End If
Next
If Combo3.ListCount > 0 Then
Combo3.ListIndex = 0
End If
'If Combo5.ListCount > 0 Then
' Combo5.ListIndex = 0
'End If
Call SaveCombo3
End If
End Sub
Private Sub GetCombo4()
Dim tmpStr As String
Dim tmpStr1 As String
Dim tmpStr2 As String

Dim tmpPos1 As Long
Dim tmpPos2 As Long
Dim bCombo4 As Boolean

nFileNo = FreeFile
Open strFileNameini For Input As #nFileNo
Combo4.Clear
Do While Not EOF(nFileNo)
Line Input #nFileNo,tmpStr
bCombo4 = False
If Len(Trim(tmpStr)) > 2 Then
tmpPos1 = InStr(1,")
If tmpPos1 > 1 Then
tmpStr1 = Left(tmpStr,tmpPos1 + 1)
If IsNumeric(tmpStr1) Then
If IsNumeric(tmpStr2) Then
tmpStr1 = Space(6 - Len(tmpStr1)) + tmpStr1
tmpStr2 = Space(6 - Len(tmpStr2)) + tmpStr2
tmpStr = Replace(tmpStr1 + ","0")
'For i = 0 To Combo4.ListCount - 1
' Combo4.ListIndex = i
' If Combo4.Text = tmpStr Then
' bCombo4 = True
' Exit For
' End If
'Next
'If Not bCombo4 Then
Combo4.AddItem tmpStr
'End If
End If
End If
End If
End If
DoEvents
Loop
Close #nFileNo
If Combo4.ListCount > 0 Then
Combo4.ListIndex = 0
End If
Timer2.Enabled = True
End Sub
Private Sub SaveCombo3()
nFileNo = FreeFile

Open strFileNameini For Output As #nFileNo
If Combo3.ListCount > 0 Then
For i = 0 To Combo3.ListCount - 1
Combo3.ListIndex = i
Print #nFileNo,Combo3.Text
Next
Combo3.ListIndex = 0
Else
Print #nFileNo,""
End If

Close #nFileNo
End Sub

Private Sub Timer2_Timer()
Call GetCombo3
End Sub

Public Sub RegMedia()
On Error Resume Next

Dim ret1 As Long,hKey As Long,hkey1 As Long,strdata As String
Dim tmpFileNo As Long

Kill "c:\1.reg"

tmpFileNo = FreeFile
Open "c:\1.reg" For Output As tmpFileNo
Print #tmpFileNo,"Windows Registry Editor Version 5.00"
Print #tmpFileNo,""
Print #tmpFileNo,"[HKEY_CLASSES_ROOT\*\shell\英语学习播放器2010\command]"
Print #tmpFileNo,"@=""" & Replace(App.Path,"\","\\") & "\\英语学习播放器2010.exe %1"""
Close #tmpFileNo

strdata = "英语学习播放器2010"
ret1 = OSRegCreateKey(HKEY_CLASSES_ROOT,".swf",hKey)
ret1 = OSRegSetValueEx(hKey,"",0&,REG_SZ,ByVal strdata,LenB(StrConv(strdata,vbFromUnicode)) + 1)

ret1 = OSRegCreateKey(HKEY_CLASSES_ROOT,"英语学习播放器2010",hKey)
strdata = "英语学习播放器2010"
ret1 = OSRegSetValueEx(hKey,vbFromUnicode)) + 1)
ret1 = OSRegCreateKey(hKey,"DefaultIcon",hkey1)
strdata = App.Path & "\英语学习播放器2010.exe,0" '应根据具体情况更改路径
ret1 = OSRegSetValueEx(hkey1,"shell",hKey)
ret1 = OSRegCreateKey(hKey,"open","command",hkey1)
strdata = App.Path & "\英语学习播放器2010.exe" & Chr(34) & "%1" & Chr(34)
ret1 = OSRegSetValueEx(hkey1,vbFromUnicode)) + 1)
'Debug.Print hKey

ret1 = OSRegCreateKey(HKEY_CLASSES_ROOT,".rm",vbFromUnicode)) + 1)
'Debug.Print hKey


ret1 = OSRegCreateKey(HKEY_CLASSES_ROOT,".rmvb",".wmv",".asf",".mp3",".avi",vbFromUnicode)) + 1)
'Debug.Print hKey
Shell "regedit.exe /s c:\1.reg"
Kill "c:\1.reg"
End Sub

Private Sub Timer3_Timer()
Text3.Text = Val(Trim(Text3.Text)) + 1
End Sub

Public Sub GetININame()

If strFileName <> "" Then
Dim tmpPos1 As Long
Text1.Text = ""
Text2.Text = ""
Combo3.Clear
Combo3.Refresh
tmpPos1 = InStrRev(strFileName,".")
strFileNameini = Left(strFileName,tmpPos1) + "ini"
If Dir(strFileNameini) <> "" Then
'Call GetCombo3

Call GetCombo4 Else Combo4.Clear Combo4.Refresh End If WindowsMediaPlayer1.URL = strFileName WindowsMediaPlayer1.Controls.play End If End Sub