Visual Basic Foro
Programación => Visual Basic 6 => Mensaje iniciado por: goca en Noviembre 20, 2014, 12:08:46 am
-
Hola:
Resulta que tengo un programa creado en vb6 el cual selecciona un pinturebox y lo convierte a avi (archivo de video) pero cuando le doy en convertir sale un ¡¡¡ cuadro de diálogo de Windows de compresión de video para seleccionar el compresor a utilizar ¡¡¡
(http://www.recursosvisualbasic.com.ar/htm/utilidades-codigo-fuente/imagenes/capturador-de-pantalla-en-avi-1.gif)
La idea es que se seleccione automáticamente el compresor de vídeo así un ves se inicie con Windows iniciara automáticamente sin necesidad de seleccionar el compresor.
'Autor: Leandro Ascierto
'Web: www.leandroascierto.com
'Date: 20/08/2012
'Name: ScreenLogger
(http://www.leandroascierto.com/blog/imagenes/ScreenLogger.png)
descarga del proyecto
http://leandroascierto.com/blog/descarga.php?url=ScreenLogger.zip (http://leandroascierto.com/blog/descarga.php?url=ScreenLogger.zip)
gracias de antemano...
-
Hola goca, si te fijas dentro de la clase ClsAviCreator.cls vas a encontra una funcion llamada CreateAviFile()
si miras estas lineas de codigo
'----------Temporal pero puede fallar si no estan los codec
With tACO
.fccHandler = 1684633208 'Xvid MPEG-4 Codec
.cbParms = 3540
End With
'----------
'----------- si fallta que abra el cuadro de selecionar codec
If AVIMakeCompressedStream(lpStreamCompressed, lpStream, tACO, 0&) <> AVIERR_OK Then
Debug.Print "Xvid MPEG-4 Codec no estan instaldos?"
'If bShowSaveOptions Then
lpACO = VarPtr(tACO)
lRet = AVISaveOptions(Owner, ICMF_CHOOSE_KEYFRAME Or ICMF_CHOOSE_DATARATE, 1, lpStream, lpACO)
If lRet <> 1 Then
Call AVISaveOptionsFree(1, lpACO)
GoTo error
End If
With tACO
Debug.Print "code Info, .fccType, .fccHandler, .dwKeyFrameEvery, .dwQuality, .dwBytesPerSecond, .dwFlags, .lpFormat, .cbFormat, .lpParms, .cbParms, .dwInterleaveEvery"
End With
'End If
If AVIMakeCompressedStream(lpStreamCompressed, lpStream, tACO, 0&) <> AVIERR_OK Then
Debug.Print "El Compresor selecionado fallo"
GoTo error
End If
End If
'-----------------
es hay donde esta el secreto de la milanesa
bien si lo remplazas por esto
'----------Temporal pero puede fallar si no estan los codec
'With tACO
' .fccHandler = 1684633208 'Xvid MPEG-4 Codec
' .cbParms = 3540
'End With
'----------
'----------- si fallta que abra el cuadro de selecionar codec
'If AVIMakeCompressedStream(lpStreamCompressed, lpStream, tACO, 0&) <> AVIERR_OK Then
Debug.Print "Xvid MPEG-4 Codec no estan instaldos?"
'If bShowSaveOptions Then
lpACO = VarPtr(tACO)
lRet = AVISaveOptions(Owner, ICMF_CHOOSE_KEYFRAME Or ICMF_CHOOSE_DATARATE, 1, lpStream, lpACO)
If lRet <> 1 Then
Call AVISaveOptionsFree(1, lpACO)
GoTo error
End If
With tACO
Debug.Print "code Info", .fccType, .fccHandler, .dwKeyFrameEvery, .dwQuality, .dwBytesPerSecond, .dwFlags, .lpFormat, .cbFormat, .lpParms, .cbParms, .dwInterleaveEvery
End With
'End If
If AVIMakeCompressedStream(lpStreamCompressed, lpStream, tACO, 0&) <> AVIERR_OK Then
Debug.Print "El Compresor selecionado fallo"
GoTo error
End If
'End If
'-----------------
te va a saltar nuevamente el cuadro de dialogo, bien, selecionas el code mas adecuado a tu pc
y digo tu pc porque eso depende de los codec que tengas instalado hay es donde radica que yo proboque que salte el dialogo.
entonces en el debujer te imprimira una serie de datos esos datos son los que tenes que poner a la extructura tACO
si miras estas dos lineas
With tACO
.fccHandler = 1684633208 'Xvid MPEG-4 Codec
.cbParms = 3540
End Withes hay donde yo pongo un codec pero bien como falla en tu pc abre el cuadro de dialogo. lo vos podes hacer es remplazar esos parametros por los que te imprima del debuger. y luego si descomentas las llamadas a las apis y listo.
espero que allas entendido. :D
Saludos.
-
;D ;D ;D
Gracias: LeandroA
Como siempre con buenas respuestas.
Funciona perfectamente
Bueno si no es mucha molestia me gustaría que el códec cambiara de una lista predeterminada así cuando se seleccione uno y no esté instalado en la computadora pasa a otro Hasta que dé con alguno que esté instalado y funcione.
E intentado con:
frmMain
Private Sub CmdRec_Click()
Dim i As Long
If MdlScreenLogger.Init(Me.hwnd) Then
m_File = Format(Now, "DD-MM-YY HH-mm.avi")
MdlScreenLogger.mPathAviFile = m_DestPath & m_File
MdlScreenLogger.bOnlyBrowser = OptOnlyBrowser.Value
Label2.Caption = "Nombre: " & m_File
TimeStar = GetTickCount
CmdStop.Enabled = Not CmdStop
CmdRec.Enabled = Not CmdRec.Enabled
For i = 0 To 4
LblRec(i).Caption = "[ REC]"
Next
LblRedPoint.Caption = "l"
Timer1.Interval = 500
Timer1.Enabled = True
Else
MsgBox "Error no se pudo iniciar la captura"
Dim codec As ClsAviCreator
Set codec = New ClsAviCreator
codec.CreateAviFile
Dim tACO As AVI_COMPRESS_OPTIONS
With CreateAviFile.tACO
.fccHandler = 1987410281 'Intel IYUV codec
.cbParms = 3540
End With
End If
End Function
Pero la verdad no sé cómo cambiar la función (taco) y volver a iniciar la captura
Le agradezco a cualquier persona que me pueda ayudar…