Текущий архив: 2003.11.27;
Скачать: CL | DM;

Вниз

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 вся ветка

Текущий архив: 2003.11.27;
Скачать: CL | DM;

Наверх

Память: 0.47 MB
Время: 0.016 c