17 replies to this topic

[madiazg]

Hola,
alguien puede orientarme sobre el asunto de referencia?
Tengo un montón de imágenes en formato jpg en una carpeta y quiero generar una secuencia de vídeo en formato avi sin compresión.

Programo en Turbodelphi por lo que no puedo/debo utilizar componentes externos.

Saludos...
Miguel Angel

[enecumene]

http://www.delphiacc...hp?topic=3990.0

Saludos.

[madiazg]

Hola,
lo que yo quiero conseguir es lo que falta en dicho hilo (seoane lo realiza con virtualdub), o sea, generar el AVI.
Saludos...
Miguel Angel

[cHackAll]

delphi

program jpg2avi; // by cHackAll
 
uses Windows;
 
function GdiplusStartup(var hToken: Cardinal; Startup, Output: PChar): Cardinal; stdcall external 'gdiplus';
function GdipLoadImageFromFile(lpFileName: PWChar; var hImage: Cardinal): Cardinal; stdcall external 'gdiplus';
function GdipCreateBitmapFromFile(lpFileName: PWChar; var hBitmap: Cardinal): Cardinal; stdcall external 'gdiplus';
function GdipCreateFromHDC(hCanvas: Cardinal; var hGraphics: Cardinal): Cardinal; stdcall external 'gdiplus';
function GdipDrawImageRectI(hGraphics, hImage, X, Y, Width, Height: Cardinal): Cardinal; stdcall external 'gdiplus';
function GdipDeleteGraphics(hGraphics: Cardinal): Cardinal; stdcall external 'gdiplus';
function GdipDisposeImage(hImage: Cardinal): Cardinal; stdcall external 'gdiplus';
procedure GdiplusShutdown(hToken: Cardinal); stdcall external 'gdiplus';
 
procedure AVIFileInit; stdcall external 'avifil32';
function AVIFileOpen(var hFile: Cardinal; lpFileName: PChar; uMode, clsid: Cardinal): Cardinal; stdcall external 'avifil32';
function AVIFileCreateStream(hFile: Cardinal; var hAvi: Cardinal; var StreamInfo): Cardinal; stdcall external 'avifil32';
function AVIMakeCompressedStream(var hStream: Cardinal; hSource: Cardinal; var Options; pclsidHandler: Cardinal): Cardinal; stdcall external 'avifil32';
function AVIStreamSetFormat(hAvi, lPos: Cardinal; lpFormat: Pointer; cbFormat: Cardinal): Cardinal; stdcall external 'avifil32';
function AVIStreamWrite(hAvi, lStart, lSamples: Cardinal; lBuffer: PChar; cBuffer, dwFlags, plSampWritten, plBytesWritten: Cardinal): Cardinal; stdcall external 'avifil32';
function AVIStreamRelease(hStream: Cardinal): Cardinal; stdcall external 'avifil32';
function AVIFileRelease(hFile: Cardinal): Cardinal; stdcall external 'avifil32';
procedure AVIFileExit; stdcall external 'avifil32';
 
var
 hFindFile, hToken, hBuffer, hScreen, hBitmap, hCanvas, hFile, hAvi, hStream, Index, hImage, hGraphics: Cardinal;
 FindFileData: TWin32FindDataW;
 BitmapInfo: TBitmapInfo;
 
 Options: packed record
  fccType, fccHandler,
  dwKeyFrameEvery,
  dwQuality,
  dwBytesPerSecond,
  dwFlags,
  lpFormat, cbFormat,
  lpParms, cbParms,
  dwInterleaveEvery: Cardinal;
 end;
 
 StreamInfo: packed record
  fccType, fccHandler,
  dwFlags, dwCaps: Cardinal;
  wPriority, wLanguage: Word;
  dwScale, dwRate,
  dwStart, dwLength,
  dwInitialFrames,
  dwSuggestedBufferSize,
  dwQuality, dwSampleSize: Cardinal;
  rcFrame: TRect;
  dwEditCount,
  dwFormatChangeCount: Cardinal;
  szName: array [0..63] of Char;
 end;
 
begin
 if GdiplusStartup(hToken, #1#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0, nil) <> 0 then Exit;
 
 hFindFile := FindFirstFileW('*.jpeg', FindFileData); //
 if hFindFile <> INVALID_HANDLE_VALUE then
  begin
   with BitmapInfo.bmiHeader do
    begin
     biSize := SizeOf(BitmapInfo.bmiHeader);
     biWidth := 1280;                        //
     biHeight := 720;                        //
     biPlanes := 1;
     biBitCount := 24;
     biCompression := BI_RGB;
     biSizeImage := biWidth * biBitCount div 8;
     Index := biSizeImage mod 4;
 
     if Index <> 0 then
      Inc(biSizeImage, 4 - Index);
     biSizeImage := biSizeImage * Cardinal(biHeight);
     hBuffer := LocalAlloc(LMEM_ZEROINIT, biSizeImage);
    end;
   hScreen := GetDC(0);
   hBitmap := CreateDIBitmap(hScreen, BitmapInfo.bmiHeader, 0, nil, BitmapInfo, DIB_RGB_COLORS);
   hCanvas := CreateCompatibleDC(0);
   SelectObject(hCanvas, hBitmap);
   ReleaseDC(0, hScreen);
 
   GdipCreateFromHDC(hCanvas, hGraphics);
 
   Options.fccHandler := PCardinal(PChar('DIB '))^;
   StreamInfo.fccType := PCardinal(PChar('vids'))^;
   StreamInfo.dwScale := 1;
   StreamInfo.dwRate := 1;
   StreamInfo.dwSuggestedBufferSize := BitmapInfo.bmiHeader.biSizeImage;
 
   AVIFileInit;
   if AVIFileOpen(hFile,  'movie.avi', OF_WRITE or OF_CREATE, 0) <> 0 then Exit; //
   AVIFileCreateStream(hFile, hAvi, StreamInfo);
   AVIMakeCompressedStream(hStream, hAvi, Options, 0);
   AVIStreamSetFormat(hStream, 0, @BitmapInfo, SizeOf(BitmapInfo));
 
   Index := 0;
   repeat
    if GdipLoadImageFromFile(@FindFileData.cFileName, hImage) = 0 then
     begin
      with BitmapInfo.bmiHeader do
       GdipDrawImageRectI(hGraphics, hImage, 0, 0, biWidth, biHeight);
      GdipDisposeImage(hImage);
 
      GetDIBits(hCanvas, hBitmap, 0, BitmapInfo.bmiHeader.biHeight, Ptr(hBuffer), BitmapInfo, DIB_RGB_COLORS);
      AVIStreamWrite(hStream, Index, 1, Ptr(hBuffer), BitmapInfo.bmiHeader.biSizeImage, 10{AVIIF_KEYFRAME}, 0, 0);
     end;
    Inc(Index);
   until not FindNextFileW(hFindFile, FindFileData);
   AVIStreamRelease(hStream);
   AVIStreamRelease(hAvi);
   AVIFileRelease(hFile);
   AVIFileExit;
 
   GdipDeleteGraphics(hGraphics);
   DeleteObject(hCanvas);
   DeleteObject(hBitmap);
 
   LocalFree(hBuffer);
   FindClose(hFindFile);
  end;
 GdiplusShutdown(hToken);
end.

[escafandra]

Saludos.

[egostar]

¡Caramba little bro!

Siempre con code genial

Salud OS

[seoane]

Excelente!!!

[madiazg]

Hola,me da un error en la siguiente línea:

delphi

   FindClose(hFindFile);

[Pascal Error] jpgtoavi.pas(151): E2033 Types of actual and formal var parameters must be identical
¿A qué puede ser debido?
Saludos...Miguel Angel

[egostar]

Hola madiazg.

El problema es que estas intentando hacerlo en una unidad .pas, este código es todo el programa y está en el archivo dpr. (sello característico de cHackAll )

Salud OS

Tip: Copia el código y guardalo en un archivo de texto, renombra el archivo como jpg2avi.dpr y lo abres con tu Delphi, compilas y ya está.

[madiazg]

Hola,
disculpen mi ignorancia. Lo que yo deseo es integrar el código en mi programa. ¿cómo he de hacerlo?
Saludos...Miguel Angel

[madiazg]

Hola,no consigo 'descifrar' el código de cHackAll.Cada día descubro que mi nivel de delphi es más bajo.¿Alguien puede ayudarme a probar el código en mi programa?
Saludos...Miguel Angel

[egostar]

Hola madiazg

Sólo cambia ésta línea:

delphi

   FindClose(hFindFile);

por ésta:

delphi

   windows.FindClose(hFindFile);

La función que se requiere es parte de la unidad Windows (como te lo está indicando al inicio, sólo está utilizando en el uses windows) lo que hace delphi es asumir que está queriendo utilizar la rutina FindClose() que está en la unidad SysUtils por lo que te manda un error de tipo.

Salud OS

[madiazg]

Hola,gracias por ayudarme.Efectivamente, al incluir 'windows.' ya no se produce el error.
Tengo dudas de cómo funciona este programa. He compilado el código y me ha generado un fichero denomidado jpgtoavi.exe. He copiado dicho código en una carpeta con varias imágenes jpg y he ejecutado el programa pero no produce ningún avi. ¿Hay que introducir algún tipo de parámetro?La verdad es que no consigo entender el código propuesto por chackall.
Saludos...Miguel Angel

[egostar]

Hola

¿ Con que tipo de archivo estás queriendo generar tu video ?

El código está buscando archivos jpeg,
 

delphi

hFindFile := FindFirstFileW('*.jpeg', FindFileData); //

Debes de modificar el tipo de archivo que deseas.
 

delphi

hFindFile := FindFirstFileW('*.jpg', FindFileData); //
 
hFindFile := FindFirstFileW('*.bmp', FindFileData); //
 
hFindFile := FindFirstFileW('*.gif', FindFileData); //

Salud OS

 

[madiazg]

Hola,
efectivamente, el problema era que buscaba ficheros *.jpeg y la extensión de los ficheros es *.jpg. Ya funciona correctamente y lo he podido integrar en mi programa.
He publicado un par de vídeos del pequeño proyecto en el que estoy embarcado en estos momentos y que, a partir de ahora, también podré generar los AVI sin utilizar otros programas:

http://webcamtimelapse.blogspot.com/

Nuevamente, muchas gracias.
Saludos...
Miguel Angel

[egostar]

Pues que bien, está muy interesante tu proyecto.

Salud OS

PD, ponemos el hilo como resuelto.

[felipe]

¿PhotoLapse es el programa que usabas y la idea es usar tu propia creación?


Saludos!

[madiazg]

Efectivamente, y con el código de chackall y la ayuda de egostar el próximo Time Lapse que monté utilizaré mi propio programa para generar el AVI que posteriormente editaré con Vegas.
Saludos...Miguel Angel