"Bjarke Walling Petersen" <bwp@bwp.dk> skrev i en meddelelse
news:9eilol$12as$1@news.cybercity.dk...
> Allan R. <warlock@ostenfeld.dk> skrev i en
> news:9ei6vd$ceo$1@eising.k-net.dk...
> > Martin: Hvor i "egenskaber"?? Man kan konvertere...men ikke noget
> > relevant...
> > Så problemet er da ikke løst?!?
Nu er det løst (vil jeg mene) ... jeg fandt noget kode, der kan gøre det:
http://www.vbsquare.com/tips/tip451.html
Jeg har selv lavet det en del bedre (så det f.eks. også kan gemme i .wav).
Prøv at oprette en form og sæt 4 knapper samt en timer ind på den. Skriv
følgende kode (eller kopier det ind):
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 mciGetErrorString Lib "winmm.dll" _
Alias "mciGetErrorStringA" _
(ByVal dwError As Long, _
ByVal lpstrBuffer As String, _
ByVal uLength As Long) As Long
Const navn = "lydoptagelse"
Dim starttid As Single
Dim tid As String
Dim gemt As Boolean
Private Sub Command1_Click()
If gemt = False Then
If vbYes <> MsgBox("Du har ikke gemt optagelsen. " & _
"Vil du optage en ny alligevel?", _
vbYesNo + vbQuestion, "Lydoptager") Then Exit Sub
End If
gemt = False
Command1.Enabled = False
Command2.Enabled = True
Command3.Enabled = False
Command4.Enabled = False
starttid = Timer
Timer1.Enabled = True
CloseSound
DoMciCall "open new type waveaudio alias " & navn
DoMciCall "set " & navn & _
" time format ms bitspersample 8 samplespersec 11025"
DoMciCall "record " & navn
End Sub
Private Sub Command2_Click()
Dim sluttid As Single
Command1.Enabled = True
Command2.Enabled = False
Command3.Enabled = True
Command4.Enabled = True
Timer1.Enabled = False
DoMciCall "stop " & navn
sluttid = Timer - starttid
tid = "(" & CStr(Int(sluttid * 100) / 100) & "sek)"
Me.Caption = "> Stoppet " & tid
Command3.SetFocus
End Sub
Private Sub Command3_Click()
Command1.Enabled = False
Command2.Enabled = False
Command3.Enabled = False
Command4.Enabled = False
Me.Caption = "> Afspiller " & tid
DoMciCall "stop " & navn
DoMciCall "play " & navn & " from 1 wait"
Me.Caption = "> Stoppet " & tid
Command1.Enabled = True
Command3.Enabled = True
Command4.Enabled = True
Command3.SetFocus
End Sub
Private Sub Command4_Click()
On Error GoTo fejl
Dim filnavn As String
igen:
filnavn = InputBox("Skriv filnavnet:", "Gem som...", _
"C:\Windows\Skrivebord\Lydoptagelse.wav")
If filnavn = "" Then Exit Sub
Open filnavn For Output As #1
Print #1, ""
Close #1
DoMciCall "save " & navn & " " & filnavn
GoTo slut
fejl:
If Err = 76 Then
MsgBox "Ugyldigt filnavn!", vbOKOnly + vbCritical, _
"Lydoptager - Fejl"
Resume igen
Else
Error Err
End If
slut:
gemt = True
End Sub
Private Sub Form_Load()
gemt = True
Timer1.Enabled = False
Timer1.Interval = 100
Command1.Caption = "Optag"
Command1.Enabled = True
Command2.Caption = "Stop"
Command2.Enabled = False
Command3.Caption = "Afspil"
Command3.Enabled = False
Command4.Caption = "Gem som"
Command4.Enabled = False
Me.Caption = "Lydoptager"
' Kun for udseendets skyld:
Command1.Width = 900
Command1.Height = 360
Command1.Left = 120
Command1.Top = 120
Command2.Width = 900
Command2.Height = 360
Command2.Left = 1140
Command2.Top = 120
Command3.Width = 900
Command3.Height = 360
Command3.Left = 2160
Command3.Top = 120
Command4.Width = 900
Command4.Height = 360
Command4.Left = 3180
Command4.Top = 120
Me.Width = 4320
Me.Height = 990
End Sub
Private Sub DoMciCall(ByRef SendString As String)
Dim Res As Long
Dim ResX As Integer
Dim ReturnString As String * 1024
Dim ErrorString As String * 1024
Res = mciSendString(SendString, ReturnString, 1024, 0)
If Res <> 0 Then
ResX = mciGetErrorString(Res, ErrorString, 1024)
MsgBox ErrorString & vbCrLf & vbCrLf _
& "Programmet afsluttes.", vbOKOnly + vbCritical, _
"Lydoptager - Fejl"
End
End If
SendString = ReturnString
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If gemt = False Then
If vbYes = MsgBox("Optagelsen er ikke gemt. Vil du gemme den nu?", _
vbYesNo + vbQuestion, "Lydoptager") Then
Command4_Click
End If
End If
CloseSound
End Sub
Private Sub Timer1_Timer()
Me.Caption = "> Optager (" & CStr(Int((Timer - starttid) * 100) / 100) _
& "sek)"
End Sub
Private Sub CloseSound()
Dim Res As Long
Dim ReturnString As String * 1024
Res = mciSendString("close " & navn, ReturnString, 1024, 0)
End Sub
> Nej... Jeg fandt ud af at ved at konvertere til forskellige formater, fik
> man lov
> til at optage i 47,5 sekund i stedet for 60 sekunder, hvilket ikke var så
> sjovt...
>
> > og Bjark: vil du ikke sige til når du har fundet ud af det?
>
> Det skal jeg nok...
Her er det!
- Bjarke Walling Petersen
> > "Martin - Zeus" <martin.molle@get2net.dk> skrev i en meddelelse
> > news:4dTO6.341$W45.11425@news.get2net.dk...
> > > Prøv at gå ind i Indstillinger eller egenskaber osv..
> > > Jeg har også selv engang skulle bruge mere en 60 sek. Hvor jeg gik ind
> og
> > > pillede i egenskaber eller noget lign... Jeg kan ikke huske hvordan,
men
> > det
> > > kan lade sig gøre
> > > "Bjarke Walling Petersen" <bwp@bwp.dk> skrev i en meddelelse
> > > news:9eg6q7$11lg$1@news.cybercity.dk...
> > > > Jeg skal bruge et lille program hvis eneste formål er at optage lyd
og
> > > gemme
> > > > det som en .wav-fil... hvorfor så ikke bruge Lydoptager i Tilbehør,
vil
> > > > nogen sige... men det går ikke. For den stopper nemlig med at optage
> > efter
> > > > 60 sekunder og det må den ikke. Allerhelst skal programmet gemme
lyden
> > > > direkte på harddisken, mens der optages, så computerens hukommelse
> ikke
> > > > betyder noget for i hvor lang tid den kan optage.
> > > > Derfor tænkte jeg om man ikke kunne lave den selv i VB, men jeg
synes
> > ikke
> > > > rigtig jeg har den fornødne ekspertise lige på det område...
> > > >
> > > > Er der nogen der kan hjælpe?
> > > >
> > > > - Bjarke Walling Petersen