CodeItBetter Programming Another VB Programming Blog

How to create Formless multimedia control software

Posted on January 4, 2009
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
'MultiMedia - How to create Formless multimedia control software
'Formless multimedia control software. It is used to adjust the speed of playing.

'First take common dialog ActiveX control and rename is as DLG. And add 12
'command buttons on the form and rename the command buttons name as the program
'used name and also rename the form name. Other informations as given in
'comments.

'Media Player (MPlayer)
'
'About:
'This program play media file with user selection speed and also explain how to
'create an irregular form. This program give best result only on 800x600
'resolution.
'
'API Functions :
'GetShortPathName() - is used to get sortestpath of long path
'mciSendString()    - is used for multimedia operations.
'CreateEllipticRgn  - is used to select particular region
'CombineRgn()       - is used to combine selected regions
'SetWindowRgn()     - is used to display selected regions of form
'
'User defined Functions :
'CurrentPos     : is used to get current position of media playing state
'MediaLength    : is used to get length of media
'IsValidState   : is used to find the media file is on open state or not
'MediaStatus    : is used to find media status (playing,paused,stopped,recording,...)
'ShortPath      : is used to get shortest path of long path

Option Explicit
 
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
Private Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, _
    ByVal Y2 As Long) As Long
Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, _
    ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, _
    ByVal bRedraw As Boolean) As Long
 
Dim speed As Long    'To control the speed of playing

'To conver the long path to short path
Function ShortPath(sPath As String) As String
    Dim ShortPathName As String
    If Right$(sPath, 1) <> "\" Then
        sPath = sPath & "\"
    End If
    ShortPathName = Space$(255)
    GetShortPathName sPath, ShortPathName, Len(ShortPathName)
    ShortPath = Left$(ShortPathName, Len(Trim$(ShortPathName)) - 2)
End Function
 
'To find the length of the media
Function MediaLength() As Long
    Dim sLength As String * 255, lNullChar As Long
    mciSendString "status mmfile length", sLength, 255, 0
    'To find the null character position
    lNullChar = InStr(sLength, Chr$(0))
    'Return the length of the media
    MediaLength = CLng(Val(Left$(sLength, lNullChar - 1)))
End Function
 
'To find the current position of the media
Function CurrentPos() As Long
    Dim lNullChar As Long, sCurPos As String * 255
    mciSendString "status mmfile position", sCurPos, 255, 0
    lNullChar = InStr(sCurPos, Chr$(0))
    CurrentPos = CLng(Val(Left$(sCurPos, lNullChar - 1)))
End Function
 
'To find the status of the video
Function MediaStatus() As String
    Dim lNullChar As Integer, sStatus As String * 255
    mciSendString "status mmfile mode", sStatus, 255, 0
    lNullChar = InStr(sStatus, Chr$(0))
    MediaStatus = UCase$(Left$(sStatus, lNullChar - 1))
End Function
 
'To find valid state for stop or close
Function IsValidState() As Boolean
    If MediaStatus = "PLAYING" Or MediaStatus = "PAUSED" Or MediaStatus = "STOPPED" Then
        IsValidState = True
    Else
        IsValidState = False
    End If
End Function
 
Private Sub cmdAbout_Click()
    If MediaStatus = "PLAYING" Then
        cmdPause_Click
        cmdPlay_Click
    End If
End Sub
 
Private Sub cmdBackward_Click()
    Dim MStatus As String, lPos As Long
    MStatus = MediaStatus
    'To move 5 percent of media length towards back
    lPos = CInt(CurrentPos - (MediaLength * 0.05))
    If IsValidState Then
        If lPos > 0 Then
            mciSendString "seek mmfile to " & lPos, "", 0, 0
            If MStatus = "PLAYING" Then
                cmdPlay_Click
            End If
        End If
    End If
End Sub
 
Private Sub cmdClose_Click()
    If MediaStatus = "PLAYING" Or MediaStatus = "PAUSED" Or MediaStatus = "STOPPED" Then
        mciSendString "close mmfile", "", 0, 0
    End If
End Sub
 
Private Sub cmdDecreaseSpeed_Click()
    If speed - 50 >= 100 Then
        speed = speed - 50
        mciSendString "set mmfile speed " & speed, "", 0, 0
    End If
End Sub
 
Private Sub cmdExit_Click()
    If MediaStatus = "PLAYING" Or MediaStatus = "PAUSED" Then
        cmdClose_Click
    End If
    Unload Me
End Sub
 
Private Sub cmdFastBackward_Click()
    If IsValidState Then
        mciSendString "seek mmfile to start", "", 0, 0
        mciSendString "play mmfile from 1 to 2", "", 0, 0
    End If
End Sub
 
Private Sub cmdFastForward_Click()
    If IsValidState Then
        mciSendString "seek mmfile to end", "", 0, 0
    End If
End Sub
 
Private Sub cmdForward_Click()
    Dim MStatus As String, lPos As Long
    MStatus = MediaStatus
    'To move 5 percent of media lenght toward forward
    lPos = CLng(CurrentPos + (MediaLength * 0.05))
    If IsValidState Then
        If lPos < MediaLength Then
            mciSendString "seek mmfile to " & lPos, "", 0, 0
            If MStatus = "PLAYING" Then
                cmdPlay_Click
            End If
        End If
    End If
End Sub
 
Private Sub cmdIncreaseSpeed_Click()
    If speed + 50 <= 2000 Then
        speed = speed + 50
        mciSendString "set mmfile speed " & speed, "", 0, 0
    End If
End Sub
 
Private Sub cmdOpen_Click()
    Dim Extension As String, LastFile As String
    LastFile = DLG.FileName
    DLG.FileName = ""
    DLG.Filter = "All Media Files   (*.wav;*.mid;*.mp3;*.mp2;*.dat;*.mpg;*.avi;*.mov)|*.wav;*.mid;*.mp3;*.mp2;" & _
        "*.dat;*.mpg;*.avi;*.mov|Wav Files     (*.wav)|*.wav|Mp3 Files     (*.mp3)|*.mp3|MP2 Files     (*.mp2)" & _
        "|*.mp2|MPG Files     (*.mpg)|*.mpg|AVI Files     (*.avi)|*.avi}|MOV Files    (*.mov)|*.mov|VCD Files " & _
        "    (*.dat)|*.dat|All Files     (*.*)|*.*"
    DLG.DialogTitle = "Select Media file"
    If MediaStatus = "STOPPED" Or MediaStatus = "PLAYING" Or MediaStatus = "PAUSED" Then
        cmdClose_Click
    End If
    DLG.ShowOpen
    If DLG.FileName <> "" Then
        mciSendString "open " + ShortPath(DLG.FileName) + " alias mmfile", "", 0, 0
        Extension = UCase$(Right$(ShortPath(DLG.FileName), 3))
        If Extension = "DAT" Or Extension = "MPG" Or Extension = "MOV" Or Extension = "AVI" Or Extension = "MP2" Then
            mciSendString "put mmfile window at 0 0 800 480", "", 0, 0
        End If
        speed = 1000
    Else
        DLG.FileName = LastFile
    End If
End Sub
 
Private Sub cmdPause_Click()
    If MediaStatus = "PLAYING" Then
        mciSendString "pause mmfile", "", 0, 0
    End If
End Sub
 
Private Sub cmdPlay_Click()
    If MediaStatus = "STOPPED" Then
        mciSendString "play mmfile", "", 0, 0
    ElseIf MediaStatus = "PAUSED" Then
        mciSendString "resume mmfile", "", 0, 0
    End If
End Sub
 
'To set the elliptical form
Private Sub Form_Load()
    speed = 1000    'Normal speed
    Dim rgn2 As Long, rgn1 As Long
    rgn2 = CreateEllipticRgn(20, 20, 460, 70)   'First elliptical region
    rgn1 = CreateEllipticRgn(130, 77, 348, 100)    'Second elliptical region
    CombineRgn rgn2, rgn2, rgn1, 2              'Combine first and second elliptical region
    SetWindowRgn Me.hWnd, rgn2, True            'Display the region
End Sub
Comments (0) Trackbacks (0)

No comments yet.


Leave a comment


 

No trackbacks yet.