Videó készítés delphiben

Videó készítés delphiben
2009-08-13T15:55:51+02:00
2009-08-14T11:07:31+02:00
2022-11-14T16:10:33+01:00
Konyee
Sziasztok!

A következő problémám lenne:
Van egy csomó képem egy könyvtárban amit én állítok elő. Össze kellene fűznöm egy videóba (mpg, divx...),
de nem találtam rá semmi normális megoldást.

Várom az 5leteket.
Mutasd a teljes hozzászólást!
Szia!

Próbáld ezzel a módszerrel:
(ide kattintva elérheted a példa projektfájlt is)

// [...] implementation {$R *.dfm} const // AVISaveOptions párbeszédpanel flagek ICMF_CHOOSE_KEYFRAME = 1; // KeyFrame mutatása minden dobozban ICMF_CHOOSE_DATARATE = 2; // AdatÁtvitel mutatása minden dobozban ICMF_CHOOSE_PREVIEW = 4; // kiterjesztett előnézeti párbeszédpanel mutatása ICMF_CHOOSE_ALLCOMPRESSORS = 8; // ne csak azokat mutassa amik // kezelni képesek a beviteli formátumot // vagy a beviteli adatot AVIIF_KEYFRAME = 10; type AVI_COMPRESS_OPTIONS = packed record fccType: DWORD; // stream típusa, az egyezésért fccHandler: DWORD; // tömörítő dwKeyFrameEvery: DWORD; // kulcskocka érték dwQuality: DWORD; // tömörítés minősége 0-10,000 dwBytesPerSecond: DWORD; // byte / másodperc dwFlags: DWORD; // flagek... lásd lennt lpFormat: DWORD; // mentési formátum cbFormat: DWORD; lpParms: DWORD; // tömörítési opciók cbParms: DWORD; dwInterleaveEvery: DWORD; // csak nem-video streamekhez end; AVI_STREAM_INFO = packed record fccType: DWORD; fccHandler: DWORD; dwFlags: DWORD; dwCaps: DWORD; wPriority: word; wLanguage: word; dwScale: DWORD; dwRate: DWORD; dwStart: DWORD; dwLength: DWORD; dwInitialFrames: DWORD; dwSuggestedBufferSize: DWORD; dwQuality: DWORD; dwSampleSize: DWORD; rcFrame: TRect; dwEditCount: DWORD; dwFormatChangeCount: DWORD; szName: array[0..63] of char; end; BITMAPINFOHEADER = packed record biSize: DWORD; biWidth: DWORD; biHeight: DWORD; biPlanes: word; biBitCount: word; biCompression: DWORD; biSizeImage: DWORD; biXPelsPerMeter: DWORD; biYPelsPerMeter: DWORD; biClrUsed: DWORD; biClrImportant: DWORD; end; BITMAPFILEHEADER = packed record bfType: word; //"varázs süti (cookie)" - "BM"-nek kell lennie bfSize: integer; bfReserved1: word; bfReserved2: word; bfOffBits: integer; end; // Külső DLL deklarációk function AVISaveOptions(Hwnd: DWORD; uiFlags: DWORD; nStreams: DWORD; pPavi: Pointer; plpOptions: Pointer): boolean; stdcall; external 'avifil32.dll'; function AVIFileCreateStream(pFile: DWORD; pPavi: Pointer; pSi: Pointer): integer; stdcall; external 'avifil32.dll'; function AVIFileOpen(pPfile: Pointer; szFile: PChar; uMode: DWORD; clSid: DWORD): integer; stdcall; external 'avifil32.dll'; function AVIMakeCompressedStream(psCompressed: Pointer; psSource: DWORD; lpOptions: Pointer; pclsidHandler: DWORD): integer; stdcall; external 'avifil32.dll'; function AVIStreamSetFormat(pAvi: DWORD; lPos: DWORD; lpGormat: Pointer; cbFormat: DWORD): integer; stdcall; external 'avifil32.dll'; function AVIStreamWrite(pAvi: DWORD; lStart: DWORD; lSamples: DWORD; lBuffer: Pointer; cBuffer: DWORD; dwFlags: DWORD; plSampWritten: DWORD; plBytesWritten: DWORD): integer; stdcall; external 'avifil32.dll'; function AVISaveOptionsFree(nStreams: DWORD; ppOptions: Pointer): integer; stdcall; external 'avifil32.dll'; function AVIFileRelease(pFile: DWORD): integer; stdcall; external 'avifil32.dll'; procedure AVIFileInit; stdcall; external 'avifil32.dll'; procedure AVIFileExit; stdcall; external 'avifil32.dll'; function AVIStreamRelease(pAvi: DWORD): integer; stdcall; external 'avifil32.dll'; function mmioStringToFOURCCA(sz: PChar; uFlags: DWORD): integer; stdcall; external 'winmm.dll'; // ============================================================================ // Fő funkció, AVI fájlok készítése BMP fájllistából // ============================================================================ procedure CreateAVI(const FileName: string; IList: TStrings; FramesPerSec: integer = 10); var Opts: AVI_COMPRESS_OPTIONS; pOpts: Pointer; pFile, ps, psCompressed: DWORD; strhdr: AVI_STREAM_INFO; i: integer; BFile: file; m_Bih: BITMAPINFOHEADER; m_Bfh: BITMAPFILEHEADER; m_MemBits: packed array of byte; m_MemBitMapInfo: packed array of byte; begin DeleteFile(FileName); Fillchar(Opts, SizeOf(Opts), 0); FillChar(strhdr, SizeOf(strhdr), 0); Opts.fccHandler := 541215044; // Teljes kockák tömörítetlenül AVIFileInit; pfile := 0; pOpts := @Opts; if AVIFileOpen(@pFile, PChar(FileName), OF_WRITE or OF_CREATE, 0) = 0 then begin // Bitmap tulajdonságainak meghatározása a lista [0]-ás számú eleméből AssignFile(BFile, IList[0]); Reset(BFile, 1); BlockRead(BFile, m_Bfh, SizeOf(m_Bfh)); BlockRead(BFile, m_Bih, SizeOf(m_Bih)); SetLength(m_MemBitMapInfo, m_bfh.bfOffBits - 14); SetLength(m_MemBits, m_Bih.biSizeImage); Seek(BFile, SizeOf(m_Bfh)); BlockRead(BFile, m_MemBitMapInfo[0], length(m_MemBitMapInfo)); CloseFile(BFile); strhdr.fccType := mmioStringToFOURCCA('vids', 0); // stream típusa videó strhdr.fccHandler := 0; // def AVI kezelő strhdr.dwScale := 1; strhdr.dwRate := FramesPerSec; // fps 1 - 30 strhdr.dwSuggestedBufferSize := m_Bih.biSizeImage; // 1 képkocka mérete SetRect(strhdr.rcFrame, 0, 0, m_Bih.biWidth, m_Bih.biHeight); if AVIFileCreateStream(pFile, @ps, @strhdr) = 0 then begin // ha szeretnéd a felhasználó által választott opciókat elérni, hívd a következő sort // (de úgy tűnik csak az "Összes képkocka tömörítetlen" opciót szereti) // AVISaveOptions(Application.Handle, // ICMF_CHOOSE_KEYFRAME or ICMF_CHOOSE_DATARATE, // 1,@ps,@pOpts); // AVISaveOptionsFree(1,@pOpts); if AVIMakeCompressedStream(@psCompressed, ps, @opts, 0) = 0 then begin if AVIStreamSetFormat(psCompressed, 0, @m_memBitmapInfo[0], length(m_MemBitMapInfo)) = 0 then begin for i := 0 to IList.Count - 1 do begin AssignFile(BFile, IList[i]); Reset(BFile, 1); Seek(BFile, m_bfh.bfOffBits); BlockRead(BFile, m_MemBits[0], m_Bih.biSizeImage); Seek(BFile, SizeOf(m_Bfh)); BlockRead(BFile, m_MemBitMapInfo[0], length(m_MemBitMapInfo)); CloseFile(BFile); if AVIStreamWrite(psCompressed, i, 1, @m_MemBits[0], m_Bih.biSizeImage, AVIIF_KEYFRAME, 0, 0) <> 0 then begin ShowMessage('Error during Write AVI File'); break; end; end; end; end; end; AVIStreamRelease(ps); AVIStreamRelease(psCompressed); AVIFileRelease(pFile); end; AVIFileExit; m_MemBitMapInfo := nil; m_memBits := nil; end; procedure TForm1.Button1Click(Sender: TObject); begin // AVI fájl elkészítése CreateAVI(ExtractFileDir(Application.ExeName)+'\'+'teszt.avi', ListBox1.Items, 10); end; procedure TForm1.FormActivate(Sender: TObject); begin // Pár alapértelmezett kép betöltése ListBox1.Items.Add(ExtractFileDir(Application.ExeName)+'\'+'1.bmp'); ListBox1.Items.Add(ExtractFileDir(Application.ExeName)+'\'+'2.bmp'); ListBox1.Items.Add(ExtractFileDir(Application.ExeName)+'\'+'3.bmp'); end; procedure TForm1.Button2Click(Sender: TObject); begin // Fájlválasztás If OpenDialog1.Execute then ListBox1.Items.Add(OpenDialog1.FileName); end;

Tesztelve, működik.
Az egyetlen probléma, hogy csak azonos felbontású BMP képfájlokkal boldogul a kód, de a megjegyzések alapján szerintem elboldogulsz rajta, hogy merrefelé kell belenyúlni.
Mutasd a teljes hozzászólást!

Tetszett amit olvastál? Szeretnél a jövőben is értesülni a hasonló érdekességekről?
abcd