Sie sind aktuell nicht angemeldet.

Funktionen: Einloggen  |  Neu registrieren  |  Suchen

Re: Fehler meldung!
Autor: Malte
Datum: 01.04.03 21:40
Private Const INVALID_HANDLE_VALUE = -1 Public Function SetShortPathName(LongPathName As String) As String Dim sBuffer As String Dim pLen As Long sBuffer = Space$(1024) 'Buffersize (pLen) + 1 Debug.Print Len(sBuffer); " sBuffer..." pLen = GetShortPathName(LongPathName, sBuffer, Len(sBuffer)) SetShortPathName = Left$(sBuffer, pLen) End Function Public Function FileExist(ByVal Filename As String) As Boolean Dim fd As WIN32_FIND_DATA Dim lRet As Long lRet = FindFirstFile(Filename, fd) FileExist = lRet <> INVALID_HANDLE_VALUE Call FindClose(lRet) End Function Private Sub ExtractMidifile(Filename As String) Dim bExtractData() As Byte If Dir$(Filename) <> "" Then Kill Filename fno = FreeFile Open Filename For Binary As #fno bExtractData = LoadResData(1001, "CUSTOM") Put #fno, , bExtractData Close #fno ' Filename = SetShortPathName(Filename) Debug.Print Filename If FileExist(Filename) Then Dim sBuffer As String Dim lRet As Long Dim sSend As String sSend = "open sequencer!" & Filename & " alias midi" sBuffer = Space$(255) lRet = mciSendString(sSend, sBuffer, 255, 0&) Debug.Print lRet If lRet Then Call MsgBox(TranslateMCIErr(lRet), vbCritical, "Error...") Err.Clear Exit Sub Else Call mciSendString("play midi", sBuffer, 255, 0&) Command1.Enabled = lRet End If 'mciError Else Call MsgBox("File not found...", vbCritical, "Error...") Exit Sub End If 'FileExist End Sub Private Function TranslateMCIErr(ByVal errCode As Long) As String Dim blErrCode As Boolean Dim sBuffer As String sBuffer = Space(255) blErrCode = mciGetErrorString(errCode, sBuffer, Len(sBuffer)) Debug.Print blErrCode ' If blErrCode Then sBuffer = Left$(sBuffer, InStr(sBuffer, Chr$(0)) - 1) TranslateMCIErr = "Err Number : [ " & errCode & " ]" & vbCrLf & _ sBuffer Else Const ERR_NOTKNOWN = "Error code is not known..." TranslateMCIErr = "Err Number : [ " & errCode & " ]" & vbCrLf & _ ERR_NOTKNOWN End If End Function Public Sub StoppMidifile() Dim sBuffer As String Dim lRet As Long sBuffer = Space$(255) 'Fehlerbehandlung...? lRet = mciSendString("stop midi", sBuffer, 255, 0&) lRet = mciSendString("close midi", sBuffer, 255, 0&) Debug.Print lRet End Sub Private Sub Command1_Click() Dim sPath As String sPath = App.Path If Right(sPath, 1) <> "\" Then spaht = sPath & "\" Call ExtractMidifile(sPath & "test_resource.mid") End Sub Private Sub Command2_Click() Call StoppMidifile If Command1.Enabled <> Command2.Enabled Then Command1.Enabled = True End If End Sub Private Sub Command3_Click() Call Form_Unload(True) End Sub Option Explicit Private cData As Collection Private nIndex As Integer Private Sub Command4_Click() With cData nIndex = nIndex + 1 If nIndex > .Count Then Exit Sub Text1.Text = .Item(nIndex) End With End Sub Option Explicit Private Sub Form_Load() Command1.Caption = "&Play" Command2.Caption = "&Stop" Dim sPath As String sPath = App.Path If Right(sPath, 1) <> "" Then spaht = sPath & "" Call ExtractMidifile(sPath & "test_resource.mid") Exit Sub ' Text, der in der Textbox angezeigt werden soll Set cData = New Collection cData.Add "Hallo" cData.Add "mir" cData.Add "geht" cData.Add "es" cData.Add "gut" nIndex = 0 End Sub Private Sub Form_Unload(Cancel As Integer) Call StoppMidifile End End SubWas habe ich jetzt falsch gemacht??? ich möchte eingentlich nur das eine mid im Hintergrund läuft und das ich den Text wechseln kann aber beides habe ich noch nicht hingekriegt! THX

Fehler meldung!	86	Malte	01.04.03 20:05
Re: Fehler meldung!	245	unbekannt	01.04.03 20:23
Re: Fehler meldung!	45	Malte	01.04.03 21:40
Re: Fehler meldung!	44	Malte	01.04.03 21:40
Re: Fehler meldung!	31	Malte	02.04.03 17:45

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

Funktionen:  Zum Thema  |  Gesamtübersicht

Suchen