Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Media";
Текущий архив: 2003.11.27;
Скачать: [xml.tar.bz2];

Вниз

AVI   Найти похожие ветки 

 
Spawn   (2003-08-03 10:15) [0]


var
Form1: TForm1;
Save:PAVISTREAM;
newf:PAVIFILE;
BitMap:TBitMap;
StreamInfo:PAVIStreamInfo;

implementation

{$R *.dfm}

function InitAviLib():Boolean;
begin
try
Result:=True;
AVIFileInit;
except
Result:=False;
end;
end;

function CreateAVIFIle(FileName:PAnsiChar;bmInfo:PBITMAPINFOHEADER):Boolean;
var
size:LongInt;
begin
Result:=True;
AVIFileOpen(newf,FileName,OF_WRITE or OF_CREATE,nil);
try
GetMem(StreamInfo,SizeOf(TAVIStreamInfo));
StreamInfo.fccType:=streamtypeVIDEO;
StreamInfo.dwScale:=1;
StreamInfo.dwRate:=5;
SetRect(StreamInfo.rectFrame,0,0,bmInfo.biWidth,bmInfo.biHeight);
AVIFileCreateStream(newf,Save,StreamInfo^);
AVIStreamSetFormat(Save,0,bmInfo,SizeOf(BITMAPINFOHEADER));
AVIFileRelease(newf);
except
FreeMem(StreamInfo);
Result:=False;
end;
end;

function InsertFrame(CurrentFrame:integer;Frame:PByte;bmInfo:PBITMAPINFOHEADER):Boolean;
var
Size:LongInt;
begin
try
Result:=True;
Size:=bmInfo.biWidth*bmInfo.biHeight*3;
AVIStreamWrite(Save,CurrentFrame+AVIStreamStart(save),1,Frame,Size,AVIIF_KEYFRAME,nil,nil);
except
Result:=False;
end;
end;

procedure CloseAVIFile();
begin
AVIStreamRelease(save);
AVIFileRelease(newf);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
bmInfoHeader:PBitMapInfoHeader;
Wnd:HWND;
DC:HDC;
Rect:TRect;
begin
Wnd:=FindWindow(WindowClassName,nil);
if Wnd<>0 then
if InitAVILib then
begin
try
DC:=GetDC(Wnd);
GetWindowRect(Wnd,Rect);
BitBlt(BitMap.Canvas.Handle, 1, 1, Rect.Right-Rect.Left,
Rect.Bottom-Rect.Top, DC, 0, 0, SRCCOPY);
GetMem(bmInfoHeader,SizeOf(BITMAPINFOHEADER));
ZeroMemory(bmInfoHeader,SizeOf(BITMAPINFOHEADER));
bmInfoHeader.biSize:=SizeOf(BITMAPINFOHEADER);
bmInfoHeader.biWidth:=Rect.Right-Rect.Left;
bmInfoHeader.biHeight:=Rect.Bottom-Rect.Top;
bmInfoHeader.biPlanes:=1;
bmInfoHeader.biBitCount:=16;
bmInfoHeader.biCompression:=BI_RGB;
CreateAVIFile("c:\test.avi",bmInfoHeader);
{Пытаюсь записать хотя бы один фрейм для теста}
InsertFrame(1,PBYTE({Что использовать в качестве байтов картинки?}),bmInfoHeader);
finally
ReleaseDC(Wnd,DC);
( bmInfoHeader)

var
Form1: TForm1;
Save:PAVISTREAM;
newf:PAVIFILE;
BitMap:TBitMap;
StreamInfo:PAVIStreamInfo;

implementation

{$R *.dfm}

function InitAviLib():Boolean;
begin
try
Result:=True;
AVIFileInit;
except
Result:=False;
end;
end;

function CreateAVIFIle(FileName:PAnsiChar;bmInfo:PBITMAPINFOHEADER):Boolean;
var
size:LongInt;
begin
Result:=True;
AVIFileOpen(newf,FileName,OF_WRITE or OF_CREATE,nil);
try
GetMem(StreamInfo,SizeOf(TAVIStreamInfo));
StreamInfo.fccType:=streamtypeVIDEO;
StreamInfo.dwScale:=1;
StreamInfo.dwRate:=5;
SetRect(StreamInfo.rectFrame,0,0,bmInfo.biWidth,bmInfo.biHeight);
AVIFileCreateStream(newf,Save,StreamInfo^);
AVIStreamSetFormat(Save,0,bmInfo,SizeOf(BITMAPINFOHEADER));
AVIFileRelease(newf);
except
FreeMem(StreamInfo);
Result:=False;
end;
end;

function InsertFrame(CurrentFrame:integer;Frame:PByte;bmInfo:PBITMAPINFOHEADER):Boolean;
var
Size:LongInt;
begin
try
Result:=True;
Size:=bmInfo.biWidth*bmInfo.biHeight*3;
AVIStreamWrite(Save,CurrentFrame+AVIStreamStart(save),1,Frame,Size,AVIIF_KEYFRAME,nil,nil);
except
Result:=False;
end;
end;

procedure CloseAVIFile();
begin
AVIStreamRelease(save);
AVIFileRelease(newf);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
bmInfoHeader:PBitMapInfoHeader;
Wnd:HWND;
DC:HDC;
Rect:TRect;
begin
Wnd:=FindWindow(WindowClassName,nil);
if Wnd<>0 then
if InitAVILib then
begin
try
DC:=GetDC(Wnd);
GetWindowRect(Wnd,Rect);
BitBlt(BitMap.Canvas.Handle, 1, 1, Rect.Right-Rect.Left,
Rect.Bottom-Rect.Top, DC, 0, 0, SRCCOPY);
GetMem(bmInfoHeader,SizeOf(BITMAPINFOHEADER));
ZeroMemory(bmInfoHeader,SizeOf(BITMAPINFOHEADER));
bmInfoHeader.biSize:=SizeOf(BITMAPINFOHEADER);
bmInfoHeader.biWidth:=Rect.Right-Rect.Left;
bmInfoHeader.biHeight:=Rect.Bottom-Rect.Top;
bmInfoHeader.biPlanes:=1;
bmInfoHeader.biBitCount:=16;
bmInfoHeader.biCompression:=BI_RGB;
CreateAVIFile("c:\test.avi",bmInfoHeader);
{Пытаюсь записать хотя бы один фрейм для теста}
InsertFrame(1,PBYTE({Что использовать в качестве байтов картинки?}),bmInfoHeader);
finally
ReleaseDC(Wnd,DC);
FreeMem(bmInfoHeader);
end;
end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
CloseAviFile;
end;

initialization
BitMap:=TBitMap.Create;

finalization
FreeAndNil(BitMap);
if StreamInfo<>nil then FreeMem(StreamInfo)

end.


Что использовать в качестве массива байтов картинки? И еще одно наблюдение - при создании avi-файла и попытке его запуска MediaPlayer говорит что он некорректный. Буду благодарен всем кто даст хоть какие либо ответы на данный вопрос.


 
Spawn   (2003-08-03 15:59) [1]

Все я уже разобрался, только вот лаги жуткие от BitBlt. Есть ли возможность произвести более быстрое копирование изображения? Пока посмотрю QuickPixels.



Страницы: 1 вся ветка

Форум: "Media";
Текущий архив: 2003.11.27;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.46 MB
Время: 0.008 c
8-90009
GILforever
2003-08-02 02:26
2003.11.27
Многообъектная печатаемая поверхность


1-89903
limk
2003-11-14 17:28
2003.11.27
memo


8-90004
Schumofil
2003-07-30 20:12
2003.11.27
Как конвертировать GIF в BMP?


3-89731
гость
2003-11-09 22:44
2003.11.27
SQL+Excel


3-89744
WK
2003-11-08 06:34
2003.11.27
Запрос





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский