Для вывода времени также можеш воспользоваться этим кодом.Он будет отображать время в часах, минутах и секундах.
Да но если только будет уже известна Длительность файла в секундах. А как я понял Павлу это не известно.
Я предполагаю, что ты Павел юзаешь стандартный компонент MS Multimedia Control. Тогда я предлагаю следующую процедуру нахождения времени:
- Код: Выделить всё
Option Explicit
'вводим переменные для хранения данных
Dim lng As Long
Dim s As Long
Dim m As Long
Dim h As Long
Dim s2 As String
Dim m2 As String
Dim h2 As String
Private Sub Command1_Click()
' очищаем переменные
lng = 0: s = 0: m = 0: h = 0
' указываем длину файла в секундах
' создаем функцию перевода длины в секундный формат
' MMC1 - это в примере имя твоего MS Multimedia Controls
lng = MMC1.Length
If lng = 0 Then Exit Sub
m = lng \ 60000
s = lng - 60000 * m
If 1000 - s > 0 Then s = "0"
If s > 10000 Then
s = Mid(s, 1, 2)
Else
s = Mid(s, 1, 1)
End If
h = "0"
If m > 60 Then
h = m \ 60
m = m - h * 60
End If
If s < 10 Then s2 = 0 Else s2 = ""
If m < 10 Then m2 = 0 Else m2 = ""
If h < 10 Then h2 = 0 Else h2 = ""
Text2.Text = h2 & h & ":" & m2 & m & ":" & s2 & s
Text3.Text = h2 & h & ":" & m2 & m & ":" & s2 & s
End Sub
Private Sub mediaTime_Timer() ' mediaTime - имя твоего таймера с интервалом 500
' делаем процедуру нахождения и получения позиции
' + сколько времени осталось до конца
lng = MMC1.Length - MMC1.Position
If lng = 0 Then Exit Sub
m = lng \ 60000
s = lng - 60000 * m
If 1000 - s > 0 Then s = "0"
If s > 10000 Then
s = Mid(s, 1, 2)
Else
s = Mid(s, 1, 1)
End If
h = "0"
If s + m + h = 0 Then
MMC1.Command = "stop"
MMC1.Command = "close"
mediaTime.Enabled = False
End If
If m > 60 Then
h = m \ 60
m = m - h * 60
End If
If s < 10 Then s2 = 0 Else s2 = ""
If m < 10 Then m2 = 0 Else m2 = ""
If h < 10 Then h2 = 0 Else h2 = ""
Text3.Text = h2 & h & ":" & m2 & m & ":" & s2 & s
End Sub
Данный пример приминим только к MMC, конечно же лучше всего использовать свой Компонент, или же функцию API. Если ты пользуешься не MMC а чем то другим, то скажи чем, попробую помочь.
No comments ...