title image


Smiley Re: Media-Player Objekt aktuelle Zeit auslesen
Anleitung:





Erstelle ein neues Projekt.

Menü Projekt -> Komponenten und dort "Windows Media Player" hinzufügen

Füge Form1 ein MediaPlayer - Steuerelement (MediaPlayer1) undein Timer - Steuerelement (Timer1) hinzu.

Kopiere folgenden Code in das Formular: 

Option Explicit Private Declare Function API_GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long Private Sub Form_Click()    Dim sFile As StringOn Error GoTo Err_Sub    sFile = GetWindowsDirectory()    If Right$(sFile, 1) <> "\" Then        sFile = sFile & "\"    End If     sFile = sFile & "\Media\" '    If Len(Dir$(sFile & "Der Microsoft-Sound.wav", vbNormal)) > 0 Then        sFile = sFile & "Der Microsoft-Sound.wav"    Else        sFile = sFile & "Windows-Anmeldeklang.wav"    End If     With MediaPlayer1        .FileName = sFile        .Play    End With    Timer1.Enabled = True Exit_Sub:    Exit SubErr_Sub:    MsgBox Err.Description & vbCrLf & sFile, vbCritical    Resume Exit_SubEnd Sub'-------------------------------------------------- Private Sub Form_Load()On Error GoTo Err_Sub    With MediaPlayer1        .Visible = False        .AutoStart = False        .AutoRewind = True    End With    Timer1.Interval = 100    Timer1.Enabled = False    Me.AutoRedraw = True    Me.Cls    Me.Print    Me.Print "    Klicken Sie auf das Formular..."Exit_Sub:    Exit SubErr_Sub:    MsgBox Err.Description, vbCritical    Resume Exit_SubEnd Sub'-------------------------------------------------- Private Sub Form_Unload(Cancel As Integer)On Error Resume Next    MediaPlayer1.StopEnd Sub'-------------------------------------------------- Private Sub Timer1_Timer()On Error GoTo Err_Sub    ' Stunden, Minuten, Sekunden, Hundertstel    Dim lHr As Long, lMin As Long, lSec As Long, lHun     ' Lokaler Puffer    Dim dblPosition As Double    dblPosition = MediaPlayer1.CurrentPosition     If dblPosition < 0 Then        Timer1.Enabled = False        Exit Sub    End If     ' auf Hundertstel Sekunden runden    dblPosition = Round(dblPosition, 2)     ' Stunden abspalten    lHr = dblPosition \ 3600    dblPosition = dblPosition - 3600 * lHr     ' Minuten abspalten    lMin = dblPosition \ 60    dblPosition = dblPosition - 60 * lMin     ' Sekunden abspalten    lSec = Int(dblPosition)    dblPosition = dblPosition - lSec     ' Hundertstel errechnen    lHun = 100 * dblPosition     Me.Cls    Me.Print    Me.Print "    Klicken Sie auf das Formular..."    Me.Print "    "; Format(lHr, "00"); ":"; Format(lMin, "00"); ":"; Format(lSec, "00"); "."; Format(lHun, "00") Exit_Sub:    Exit SubErr_Sub:    MsgBox Err.Description, vbCritical    Resume Exit_SubEnd Sub'-------------------------------------------------- Private Function GetWindowsDirectory() As String    Dim sBuffer As String, iLen As Long, lResult As Long    lResult = API_GetWindowsDirectory(vbNullString, 0&)    If lResult = 0 Then        ' API-Fehler        GetWindowsDirectory = "C:\Windows"        Exit Function    End If     sBuffer = String$(lResult, vbNullChar)    lResult = API_GetWindowsDirectory(sBuffer, lResult)    If lResult = 0 Then        ' API-Fehler        GetWindowsDirectory = "C:\Windows"    Else        GetWindowsDirectory = Left$(sBuffer, lResult)    End IfEnd Function'-------------------------------------------------- Ausprobieren!




Thomas Prötzsch

geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: