|
| |
VB & Windows API| Re: Grundlageninfos in Sachen API | |  | | Autor: renni | | Datum: 30.10.09 16:45 |
| der nächste Teil ... hätte es wohl als ZIP zur Verfügung stellen müssen ...
---
Public Sub mciStepForward()
Dim ii As Long
ii = mciCurPos + mDurationStep
If ii < mDurationMS Then
mciPlay ii
Else
mciStop
End If
End Sub
Public Sub mciStepBackward()
Dim ii As Long
ii = mciCurPos - mDurationStep
If ii > 0 Then
mciPlay ii
Else
mciPlay 0
End If
End Sub
Public Sub mciPlayFaster()
iSpeed = iSpeed + 100
If iSpeed > 2000 Then iSpeed = 2000
mciSetSpeed iSpeed
End Sub
Public Sub mciPlayNormal()
iSpeed = 1000
mciSetSpeed iSpeed
End Sub
Public Sub mciPlaySlower()
iSpeed = iSpeed - 100
If iSpeed < 0 Then iSpeed = 0
mciSetSpeed iSpeed
End Sub
Public Sub mciVolumeUp()
iVolume = iVolume + 10
If iVolume > 2000 Then iVolume = 2000
mciSetVol iVolume
End Sub
Public Sub mciVolumeNormal()
iVolume = 1000
mciSetVol iVolume
End Sub
Public Sub mciVolumeDown()
iVolume = iVolume - 100
If iVolume < 0 Then iVolume = 0
mciSetVol iVolume
mciSetVolLeft iVolume
mciSetVolRight iVolume
End Sub
Public Sub mciClose()
' Multimedia-Datei schließen
On Error Resume Next
mciSendString "close " & mAlias, 0, 0, 0
bPlaying = False
bPaused = False
End Sub
Public Sub mciStop()
' Abspielvorgang stoppen
On Error Resume Next
mciSendString "stop " & mAlias, 0, 0, 0
bPlaying = False
bPaused = False
End Sub
Public Sub mciPause()
' Pause
On Error Resume Next
mciSendString "pause " & mAlias, 0, 0, 0
bPlaying = True
bPaused = True
End Sub
Public Sub mciResume()
' Weiterspielen
On Error Resume Next
mciSendString "resume " & mAlias, 0, 0, 0
mciSendString "put " & mAlias & " destination", 0, 0, 0
bPlaying = True
bPaused = False
End Sub
Public Function mciCurPos() As Long
' Aktuelle Position ermitteln
Dim sBuffer As String * 255
On Error Resume Next
mciSendString "status " & mAlias & " position", sBuffer, Len(sBuffer), 0
mciCurPos = Val(sBuffer)
End Function
Public Function mciCurTime() As String
On Error Resume Next
mciCurTime = FormatTime(mciCurPos)
End Function
Public Function mciGetLength() As Long
' Gesamtspielzeit ermitteln
Dim sBuffer As String * 255
On Error Resume Next
mciGetLength = -1
mciSendString "status " & mAlias & " length", sBuffer, Len(sBuffer), 0
mciGetLength = Val(sBuffer)
End Function
Public Function mciGetProzent() As Integer
On Error Resume Next
mciGetProzent = (mciCurPos / mciGetLength) * 100
End Function
Public Sub mciSetProzent(ByVal Prozent As Integer)
Dim P As Long
Dim Laenge As Long
Laenge = mciGetLength() / 1000
If Laenge > 0 And Prozent >= 0 And Prozent <= 1000 Then
P = Laenge * Prozent
mciPlay P
End If
End Sub
Public Sub mciSetMute(ByVal bMute As Boolean)
' Mute ein/aus
On Error Resume Next
If bMute Then
mciSendString "set " & mAlias & " audio all off", 0, 0, 0
Else
mciSendString "set " & mAlias & " audio all on", 0, 0, 0
End If
End Sub
Public Sub mciSetVol(Optional ByVal nVolume As Long = 1000)
' Lautstärke setzen
On Error Resume Next
If nVolume < 0 Or nVolume > 2000 Then Exit Sub
mciSendString "setaudio " & mAlias & " volume to " & CStr(nVolume * 10), 0, 0, 0
iVolume = nVolume
End Sub
Public Sub mciSetVolLeft(Optional ByVal nVolume As Long = 1000)
On Error Resume Next
If nVolume < 0 Or nVolume > 2000 Then Exit Sub
mciSendString "setaudio " & mAlias & " left volume to " & CStr(nVolume * 10), 0, 0, 0
End Sub
Public Sub mciSetVolRight(Optional ByVal nVolume As Long = 1000)
On Error Resume Next
If nVolume < 0 Or nVolume > 2000 Then Exit Sub
mciSendString "setaudio " & mAlias & " right volume to " & CStr(nVolume * 10), 0, 0, 0
End Sub
Function FormatTime(ByVal lMSec As Long) As String
' Millisekunden in lesbares Zeitformat (00:00:00) umwandeln
Dim iMin As Integer
Dim iSec As Integer
Dim iHours As Integer
iSec = Int(lMSec / 1000)
iMin = Int(iSec / 60)
iHours = Int(iMin / 60)
iSec = iSec - (iMin * 60)
iMin = iMin - (iHours * 60)
FormatTime = Format$(iHours, "00") & ":" & Format$(iMin, "00") & ":" & Format$(iSec, "00")
End Function | |
 | Sie sind nicht angemeldet!
Um auf diesen Beitrag zu antworten oder neue Beiträge schreiben zu können, müssen Sie sich zunächst anmelden.
 Einloggen | Neu registrieren |
 |
|
vb@rchiv CD Vol.6 vb@rchiv  Vol.6
Geballtes Wissen aus mehr als 8 Jahren vb@rchiv!
Online-Update-Funktion
Entwickler-Vollversionen
u.v.m.Jetzt zugreifen Tipp des Monats sevWizard für VB5/6 
Professionelle Assistenten im Handumdrehen
Erstellen Sie eigene Assistenten (Wizards) im Look & Feel von Windows 2000/XP - mit allem Komfort und zwar in Windeseile :-) Weitere Infos
|
| |
|
Copyright ©2000-2025 vb@rchiv Dieter Otter
Alle Rechte vorbehalten.
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.
Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel
|
|
Sie sind aktuell nicht angemeldet.
