Thông báo

Bài: 16/08/2003 lúc 4:42AM | IP Logged Báo cáo chủ đề Quote heo1980

Chúng ta sẽ xây dựng một Class để điều khiển các tập tin định dạng theo MPEG. Bạn có thể thao các tác vụ cơ bản và các thuộc tính của tập tin MPEG bằng Class này.
Private Declare Function mciGetErrorString Lib ''winmm.dll'' Alias ''mciGetErrorStringA'' (ByVal dwError As Long, ByVal lpstrBuffer As String, ByVal uLength As Long) As Long
Private Declare Function GetShortPathName Lib ''kernel32'' Alias ''GetShortPathNameA'' (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
Private Declare Function mciSendString Lib ''winmm.dll'' Alias ''mciSendStringA'' (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long

Const m_def_FileName = ''''
Dim m_FileName As String

'MappingInfo=UserControl,UserControl,-1,Enabled
Public Property Get Enabled() As Boolean
Enabled = UserControl.Enabled
End Property

Public Property Let Enabled(ByVal New_Enabled As Boolean)
UserControl.Enabled() = New_Enabled
PropertyChanged ''Enabled''
End Property

'MemberInfo=13,0,0,
Public Property Get FileName() As String
FileName = m_FileName
End Property

Public Property Let FileName(ByVal New_FileName As String)
m_FileName = New_FileName
PropertyChanged ''FileName''
End Property

'Khởi động các thuộc tính của đối tượng
Private Sub UserControl_InitProperties()
m_FileName = m_def_FileName
End Sub

'Đọc thuộc tínnh đã lưu giữ
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
UserControl.Enabled = PropBag.ReadProperty(''Enabled'', True)
m_FileName = PropBag.ReadProperty(''FileName'', m_def_FileName)
End Sub

Private Sub UserControl_Terminate()
mmStop
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
Call PropBag.WriteProperty(''Enabled'', UserControl.Enabled, True)
Call PropBag.WriteProperty(''FileName'', m_FileName, m_def_FileName)
End Sub

Public Function IsPlaying() As Boolean
Static s As String * 30
mciSendString ''status MPEGPlay mode'', s, Len(s), 0
IsPlaying = (Mid$(s, 1, 7) = ''playing'')
End Function

Public Function mmPlay()
Dim cmdToDo As String * 255
Dim dwReturn As Long
Dim ret As String * 128

Dim tmp As String * 255
Dim lenShort As Long
Dim ShortPathAndFie As String

If Dir(FileName) = '''' Then
mmOpen = ''Error with input file''
Exit Function
End If
lenShort = GetShortPathName(FileName, tmp, 255)
ShortPathAndFie = Left$(tmp, lenShort)
glo_hWnd = hWnd
cmdToDo = ''open '' & ShortPathAndFie & '' type MPEGVideo Alias MPEGPlay Parent '' & UserControl.hWnd & '' Style 1073741824''
dwReturn = mciSendString(cmdToDo, 0&, 0&, 0&)

If dwReturn <> 0 Then 'not success
mciGetErrorString dwReturn, ret, 128
mmOpen = ret
MsgBox ret, vbCritical
Exit Function
End If

mmPlay = ''Success''
mciSendString ''play MPEGPlay'', 0, 0, 0
End Function

Public Function mmPause()
mciSendString ''pause MPEGPlay'', 0, 0, 0
End Function

Public Function mmStop() As String
mciSendString ''stop MPEGPlay'', 0, 0, 0
mciSendString ''close MPEGPlay'', 0, 0, 0
End Function

Public Function PositionInSec()
Static s As String * 30
mciSendString ''set MPEGPlay time format milliseconds'', 0, 0, 0
mciSendString ''status MPEGPlay position'', s, Len(s), 0
PositionInSec = Round(Mid$(s, 1, Len(s)) / 1000)
End Function

Public Function Position()
Static s As String * 30
mciSendString ''set MPEGPlay time format milliseconds'', 0, 0, 0
mciSendString ''status MPEGPlay position'', s, Len(s), 0
sec = Round(Mid$(s, 1, Len(s)) / 1000)
If sec < 60 Then Position = ''0:'' & Format(sec, ''00'')
If sec > 59 Then
mins = Int(sec / 60)
sec = sec - (mins * 60)
Position = Format(mins, ''00'') & '':'' & Format(sec, ''00'')
End If
End Function

Public Function LengthInSec()
Static s As String * 30
mciSendString ''set MPEGPlay time format milliseconds'', 0, 0, 0
mciSendString ''status MPEGPlay length'', s, Len(s), 0
LengthInSec = Round(Val(Mid$(s, 1, Len(s))) / 1000) 'Round(CInt(Mid$(s, 1, Len(s))) / 1000)
End Function

Public Function Length()
Static s As String * 30
mciSendString ''set MPEGPlay time format milliseconds'', 0, 0, 0
mciSendString ''status MPEGPlay length'', s, Len(s), 0
sec = Round(Val(Mid$(s, 1, Len(s))) / 1000) 'Round(CInt(Mid$(s, 1, Len(s))) / 1000)
If sec < 60 Then Length = ''0:'' & Format(sec, ''00'')
If sec > 59 Then
mins = Int(sec / 60)
sec = sec - (mins * 60)
Length = Format(mins, ''00'') & '':'' & Format(sec, ''00'')
End If
End Function

Public Function About()
frmCtlAbout.Show vbModal, Me
End Function

Public Function SeekTo(Second)
mciSendString ''set MPEGPlay time format milliseconds'', 0, 0, 0
If IsPlaying = True Then mciSendString ''play MPEGPlay from '' & Second, 0, 0, 0
If IsPlaying = False Then mciSendString ''seek MPEGPlay to '' & Second, 0, 0, 0
End Function

Very informative piont !






___________________________________
Maple Story Mesos
heyplayer
hiige