Воспроизведение видео bik-формате в Delphi

[Darth Emil]

Есть библиотека binkw32.dll, из пакета RAD Tools. Как используя ее можно воспроизводить видеофайлы в формате bik в Delphi?

Вариант "используй другой формат" не подходит, нужен или этот формат, или другая экзотика - необходимо чтобы видеофайлы используемые в программе нельзя было проиграть извне.

[Darhazer]

Давно не писал в Delphi, но вообще нет ничего сложного.

Сначало надо обявить тип функции, которою будем пользувать из DLLа:

procedure SomeDllFunc;stdcall;

Потом загрузить dll:

DLLHandle := LoadLibrary('Project1dll.dll');if DLLHandle <> 0 thenbegin  @SomeDllFunc:= GetProcAddress(DLLHandle, 'SomeDllFunc');

Теперь можно пользуват как обичная функция.

Наконец:

  FreeLibrary(DLLHandle);

Если нужна еще помощ, пишите :blush2:

[Darth Emil]

Вот описание функций этой библиотеки. Как мне сделать вывод видео на панель?

[Darhazer]

Мне честно говоря не совсем понятна структура BinkStruct. Насколько я понимаю, после SmackDoFrame() там будеть указатель на разкопресираной (bmp) картинке. Или возможно SmackDoFrame() возвращаеть тот указатель. Если найдеш пример на C++, могу попробувать перенаписать его на Delphi. Иначе надо поекспериментировать, а времени честно говоря нет. Да и как сказал, на Delphi давно не писал.

Кажеться мне, у их SDK не бесплатное, так что пользуват bink у вас можно только через reverse engineering (ссылка, которую прислали, тоже из кода Media Player Classic взяли информацию) да и только для личних целых :blush2:

[Darth Emil]

Darhazer: увы, пример не знаю где взять. Проблема в том что все это срочно, до четверга надо успеть :D Помоги, пожалуйста...

[Darth Emil]

Darhazer: мне хотя бы примерный исходник...

[Darhazer]

Нашел вот етот изходник:

http://code.google.com/p/keeperfx/source/b...b_fmvids.c?r=50

Так виглдятить, ви буфер (bitmap) подаете в SmackToBuffer, потом SmackDoFrame() записиваеть в буфер, и потом copy_to_screen буфера на екран.

А вы вообще с видео буферов, winapi и т.д. не VCL технологии умеете работать?

[Darth Emil]

Darhazer: увы, нет :blush2:

[Darhazer]

А какое у вас заданые?

Сразу говорю, да если было у меня все времени до четверк, не знаю смог ли сделать программу, хотя бы я игр писал и в принципе знаю с видео буфером как работать

Хм, говорите екзотика...

Очен простое решение могу вам предложить. Делаете в bmp или jpg все равно, все в один файл записиваете (если bmp легко, потому что размер известный, если нет, вписиваете размер, потом картинка, размер, картинка. Читаете из файла бинарно, и показываете на екране. Вообщем будеть чтото вроде avi, только не точно, так что другие проиграватели не смогут работать.

Другой вариант просто придубать ваш алгоритм хранения - примерно каждие 8 байта меняете местами, потом только 'дешифроваети'.

Если могу помоч еще чем нибуть пишите, но сериозно, больше 3-4 часов не успею вам отделить на етой неделе.

Простите нехорошего русского :blush2:

[(c)Labzov]

Тоже мну както нужно было видео воспроизвести в bik формате нарыл такои исходник:

Содeржание заголовочного файла:

unit binkw32;interfaceuses windows;Const BinkDll = 'Binkw32.dll';Type HBink = ^Tbink; TBink = packed recordWidth,Height,Frames  : Longword;CurrentFrame: longword;Data1  : longword; // always "1" ?FrameRate:Longword;data4  : array[0..2] of longword;Flags  : Longword; //bitflag end; TBinkRealTimeInfo = packed recordCurrentFrame:Longword;FrameRate:longword;FrameRate2:longword;ActualFrameRate:longword;MSPrFrame : longword;data1 : array[0..5] of longword;f : double;DataRate:longword; end; TBinkSummary = packed recorddata1 : array[0..127] of byte; end; HbinkBuffer = pointer;const // these might only work with certain files... BINK_OPEN_CRASH	   = $4000; // bit 15. bink crashes! please help. BINK_OPEN_REVERSECOLOR= $8000; // bit 16. red->blue blue->red BINK_OPEN_GRAYSCALE   = $F0000; // bit 17. grayscale  BINK_OPEN_CRASH2	  = $400000; // bit 23. BINK_OPEN_STREAM	  = $800000; // BinkOpen() takes a filehandle instead of							   // Pchar BINK_OPEN_CRASH3	  = $2000000; // bit 26. // Scaling flags BINK_OPEN_2xHEIGHT_DBL  = $10000000; // 28: Heightx2 doubled BINK_OPEN_2xHEIGHT_INT  = $20000000; // 29. Heightx2 interlaced BINK_OPEN_2xSIZE		= $40000000; // 30: stretches to double size(x&y) BINK_OPEN_2xWIDTH_DBL   = $30000000; // width x 2 doubled BINK_OPEN_2xSIZE_INT	= $50000000; // double size using interlace // CopyToBuffer Types. BINKSURFACE4444	 =  7; // 16bit with 4 channels. each 4 bit. BINKSURFACE565R	 =  8; // 16bit 565 reversed bitorder BINKSURFACE555R	 =  9; // 16bit 555 reversed bitorder BINKSURFACE565	  = 10; // 16bit 565. Standard for Windows Bitmaps BINKSURFACE555	  = 11; // 16bit 565 BINKSURFACE5551	 = 12; // 16bit 555+1bit alpha. Weird! BINKSURFACE16INT	= 13; // 16bit strange interleaving ?! BINKSURFACE16INTR   = 14; // ..and reversed. Who uses this ? BINKSURFACE8		= 15; // haven't tested yet. it's a guess. BINKSURFACE24	   = 17; // Normal 24bit BINKSURFACE24R	  = 18; // reversed order BINKSURFACE32	   = 19; // normal 32bit BINKSURFACE32R	  = 20; // reversed order BINKSURFACE32A	  = 21; // normal with alpha BINKSURFACE32AR	 = 22; // reversed order with alphaFunction BinkOpen(Filename:Pchar;flags:LongWord) : Hbink;overload; stdcall external binkdll name'_BinkOpen@8';Function BinkOpen(Filehandle:THandle;flags:LongWord) : Hbink;overload; stdcall external binkdll name'_BinkOpen@8';procedure BinkClose(bink:Hbink);stdcall external binkdll name'_BinkClose@4';function BinkGetError:Pchar;stdcall; external binkdll name'_BinkGetError@0';Function BinkDoFrame(Bink:Hbink):LongWord;stdcall; external binkdll name'_BinkDoFrame@4';Function BinkNextFrame(Bink:Hbink):LongWord;stdcall; external binkdll name'_BinkNextFrame@4';Function BinkGoto(Bink:HBink;target,P3:Longword):Longword;stdcall external binkdll name'_BinkGoto@12';Function BinkCopyToBuffer(Bink:HBink;pBuf:Pointer;Pitch,unknown,Xoffset,Yoffset,					  Flags:LongWord):LongWord;					  stdcall external binkdll name '_BinkCopyToBuffer@28';function BinkWait(Bink:Hbink):LongWord;stdcall external binkdll name '_BinkWait@4';Function BinkSetVideoOnOff(Bink:Hbink;TurnOn:Longword):LongWord; stdcall external binkdll name'_BinkSetVideoOnOff@8';function BinkOpenDirectSound:pointer;function _BinkOpenDirectSound(P:pointer):longword; stdcall external binkdll name'_BinkOpenDirectSound@4';function BinkOpenwaveOut:pointer;function _BinkOpenwaveOut(p:pointer):longword; stdcall external binkdll name'_BinkOpenWaveOut@4';Function BinkSetSoundSystem(SoundSystem:pointer;NotifyCallback:pointer):LongBool; stdcall external binkdll name'_BinkSetSoundSystem@8';{------------------------------------------------------------------------------- BinkSetSoundSystem() there are predefined systemfunctions that opens sound :_BinkOpenDirectSound()_BinkOpenWaveOut() Delphi's external declarations is a wrap around the function, and since BinkSetSoundSystem() takes the direct pointer to a systemfunction you must use the "macros" :BinkOpenDirectSoundBinkOpenWaveOut NotifyCallback = procedure(rsv1:pointer;Freq,Bits,Channels,						 ScaleFlag:longword;Bink:HBINK);stdcall; rsv1 is apparently = Hbink - 270b . there is a sequence of 10 longwords that steadily increases at pos 216 !?-------------------------------------------------------------------------------}Function BinkDDSurfaceType(LPDIRECTDDRAWSURFACE:Pointer):LongWord; stdcall external binkdll name'_BinkDDSurfaceType@4';Function BinkBufferOpen(wnd:LongWord;BlitType,width,height:LongWord):HBinkBuffer; stdcall external binkdll name'_BinkBufferOpen@16';Function BinkSetVolume(Bink:Hbink;Volume:LongWord):LongWord; stdcall external binkdll name'_BinkSetVolume@8';Function BinkSetSoundTrack(ArrayofID:PLongWord):LongWord; stdcall external binkdll name'_BinkSetSoundTrack@4';Function BinkGetSummary(Bink:HBink;var sum:TBinkSummary):pchar; stdcall external binkdll name'_BinkGetSummary@8';Function BinkLogoAddress:Pointer; stdcall external binkdll name'_BinkLogoAddress@0';function BinkSetPan(bink:hbink;Pan:longword):longword; stdcall external binkdll name'_BinkSetPan@8';Function BinkSetSoundOnOff(Bink:Hbink;TurnOn:LongBool):LongWord; stdcall external binkdll name'_BinkSetSoundOnOff@8';function BinkGetRealtime(Bink:Hbink;Var Info:TBinkRealTimeInfo;Flags:longword):longword; stdcall external binkdll name'_BinkGetRealtime@12';function BinkSetSimulate(SimSpeed:longword):longword; stdcall external binkdll name'_BinkSetSimulate@4';{function BinkOpenTrack(bink:hbink;ID:longword):longword; stdcall external binkdll name'_BinkOpenTrack@8';}{function BinkSetIOSize(var ioSize:longword):longword; stdcall external binkdll name'_BinkSetIOSize@4';}{function BinkSetFrameRate(Bink:HBink;FrameRate:longword):longword; stdcall external binkdll name'_BinkSetFrameRate@8';}{function RADTimerRead:longword; stdcall external binkdll name'_RADTimerRead@0';}function GetBinkVersion(vname:string='ProductVersion'):string;implementationfunction BinkOpenDirectSound:pointer;var H:Thandle;begin H := GetModuleHandle(binkdll); result:= GetProcAddress(H,'_BinkOpenDirectSound@4');end;function BinkOpenWaveOut:pointer;var H:Thandle;begin H := GetModuleHandle(binkdll); result:= GetProcAddress(H,'_BinkOpenWaveOut@4');end;{-------------------------------------------------------------------------------GetBinkVersion()Get version of the DLL.can probe for :  CompanyName  FileDescription  FileVersion  InternalName  LegalCopyright  OriginalFilename  ProductName  ProductVersion-------------------------------------------------------------------------------}function GetBinkVersion(vname:string='ProductVersion'):string;const FMTLEN = 1024;var Info, Lang : pointer; infosize,LangLen,destlen:longword; fmt,Dest:pchar; hw,lw:longword; P:pointer;begin infosize := GetFileVersionInfoSize(binkdll,hw); if infosize=0 then exit; GetMem(Info,infosize); if GetFileVersionInfo(BinkDll,0,infosize,info) then beginlang:=nil;VerQueryValue(Info,'/VarFileInfo/Translation',Lang,LangLen);if langlen<>0 then  begin	hw := Plongword(Lang)^ and $0000FFFF;	lw := Plongword(Lang)^ and $FFFF0000;  endelse  begin	lw :=$0409;	hw :=$04E4;  end;p :=  pchar(vname);GetMem(fmt,FMTLEN);asm  push [p]; push [hw]; push [lw]; // marshall 3 parametersend;wsprintf(fmt,'\StringFileInfo\%4.4x%4.4x\%s');asm  add esp, 20; // ditch 2+3 parameters (wsprintf uses cdecl)end;if VerQueryValue(Info,fmt,pointer(dest),destlen) thenbegin  result := dest;end;FreeMem(fmt,FMTLEN); end; if infosize >0 then FreeMem(info,infosize);end;end.

и собственно сам исходник bink плеера:

unit Unit1;interfaceuses mmsystem,Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs,binkw32, StdCtrls, ExtCtrls, ComCtrls,directsound, MPlayer, Menus;type TMovieThread = class(Tthread) protectedFSTream:TFileStream;Fbmp : TBitmap;Fmovie : hbink;Fcanvas:Tcanvas;Frealtimeinfo : TBinkRealTimeInfo;FGoto:boolean;FGotoframe:longword;procedure Execute; override;procedure draw;procedure Notify; publicOnNotify : procedure(bink:Hbink;Info:TBinkRealTimeInfo)of object;Constructor Create(binkFile:string;Canvas:Tcanvas;offset:Longword=0;Mode:longword=0);Procedure Play;Procedure GotoFrame(Frame:longword); end; TForm1 = class(TForm)Panel1: TPanel;PaintBox1: TPaintBox;Edit1: TEdit;PlayButton: TButton;ComboBox1: TComboBox;StatusBar1: TStatusBar;ScrollBar1: TScrollBar;Button1: TButton;TrackBar1: TTrackBar;TrackBar2: TTrackBar;Edit2: TEdit;ComboBox2: TComboBox;Button2: TButton;PopupMenu1: TPopupMenu;Colorized1: TMenuItem;procedure PlayButtonClick(Sender: TObject);procedure FormDestroy(Sender: TObject);procedure FormCreate(Sender: TObject);procedure ScrollBar1Scroll(Sender: TObject; ScrollCode: TScrollCode;  var ScrollPos: Integer);procedure Button1Click(Sender: TObject);procedure TrackBar1Change(Sender: TObject);procedure TrackBar2Change(Sender: TObject);procedure PaintBox1Click(Sender: TObject); private{ Private declarations } public{ Public declarations }mt : TMovieThread;m:hbink;ISound  : IDirectSound;procedure FillInfo(bnk:hbink);Procedure ThreadNotify(bink:Hbink;Info:TBinkRealTimeInfo); end;var Form1: TForm1; movie : Hbink; filename: string;implementationuses Types;{$R *.dfm}{-------------------------------------------------------------------------------TMovieThreadTakes a bink file and plays it!-------------------------------------------------------------------------------}constructor TMovieThread.Create;begin Fstream := TFileStream.create(Binkfile,fmOpenRead); fstream.Position:=offset; FGoto:=false; mode := mode OR BINK_OPEN_STREAM; // tell bink that we have a filehandle! Fmovie := BinkOpen(Pointer(Fstream.handle),mode); if Fmovie<>nil then beginFcanvas := Canvas;fbmp := TBitmap.create;Fbmp.Width	   := fmovie.Width;Fbmp.height	  := fmovie.height;fbmp.PixelFormat := pf32bit;fbmp.Canvas.Brush.Color:=0;fbmp.Canvas.FillRect(fbmp.Canvas.ClipRect); end else Fstream.Free; inherited create(true);end;{-------------------------------------------------------------------------------::DrawScales and blits the current frame to canvasnotice that the movie is flipped horizontally-------------------------------------------------------------------------------}procedure TMovieThread.draw;var R:Trect; i:integer;begin R.Left := Fcanvas.ClipRect.Left; R.right := Fcanvas.ClipRect.Right; R.Top := Fcanvas.ClipRect.bottom; R.Bottom := Fcanvas.ClipRect.top; Fcanvas.StretchDraw(r,fbmp);end;{-------------------------------------------------------------------------------::ExecuteEnters a loop that processes the frames of the binkfile-------------------------------------------------------------------------------}procedure TMovieThread.Execute;var B:windows.tbitmap;begin if Fmovie=nil then exit; // need this to obtain the address of the bitmap data GetObject(Fbmp.Handle,sizeof(bitmap),@b); while (not terminated)  do if FGoto then  begin BinkGoto(Fmovie,FGotoframe,1); Fgoto:=false; BinkDoFrame(Fmovie);  end else  begin// Decompress frameBinkDoFrame(Fmovie);// Copy to bufferBinkCopyToBuffer( Fmovie,b.bmBits,				  Fmovie.width*4,  // Pitch = Width*(bpp/8)				  $FFFFFFFF,	   // ??				  0,			   // x offset				  0, 		   // Y offset!				  longword(form1.ComboBox2.Items.Objects					[form1.ComboBox2.ItemIndex])	// BufferType				);// Draw the frameSynchronize(draw);// Send notificationSynchronize(Notify);// Go to next framewhile BinkWait(Fmovie)<>0 do; // busy waiting, but who cares when viewing a							  // cutscene, right?BinkNextFrame(Fmovie);  end; //Release movie  (welease Bwian!) FSTream.Free; BinkClose(Fmovie);end;procedure TMovieThread.Play;begin Resume;end;procedure TMovieThread.GotoFrame(Frame: longword);begin FGoto:=true; FGotoframe:=Frame;end;procedure TMovieThread.Notify;begin BinkGetRealtime(Fmovie,FRealTimeInfo,1); if assigned(onNotify) then OnNotify(Fmovie,FRealTimeInfo);end;{-------------------------------------------------------------------------------TFORM1 Methods :-------------------------------------------------------------------------------}procedure TForm1.FormCreate(Sender: TObject);var sound:string;begin filename:= paramstr(0)+'1.bik'; // Start sound system if BinkSetSoundSystem(binkOpenDirectSound,0) thensound:='Using dsound' else if BinkSetSoundSystem(binkOpenWaveOut,0) thensound:='Using waveout' elsesound:='No sound'; //Fill display options ComboBox1.Items.AddObject('MOVIE DEFAULT',nil); ComboBox1.Items.AddObject('BINK_OPEN_2xHEIGHT_DBL',						ptr(BINK_OPEN_2xHEIGHT_DBL)); ComboBox1.Items.AddObject('BINK_OPEN_2xHEIGHT_INT',						ptr(BINK_OPEN_2xHEIGHT_INT)); ComboBox1.Items.AddObject('BINK_OPEN_2xSIZE',						ptr(BINK_OPEN_2xSIZE)); ComboBox1.Items.AddObject('BINK_OPEN_2xWIDTH_DBL',						ptr(BINK_OPEN_2xWIDTH_DBL)); ComboBox1.Items.AddObject('BINK_OPEN_2xSIZE_INT',						ptr(BINK_OPEN_2xSIZE_INT)); ComboBox1.ItemIndex:=0; combobox2.Items.addObject('BINKSURFACE32',ptr(BINKSURFACE32) ); combobox2.Items.addObject('BINKSURFACE32R',ptr(BINKSURFACE32R) ); combobox2.Items.addObject('BINKSURFACE32A',ptr(BINKSURFACE32) ); combobox2.Items.addObject('BINKSURFACE32AR',ptr(BINKSURFACE32AR) ); ComboBox2.ItemIndex:=0; Caption := 'Delphi BinkPlayer - by Lars Peter Christiansen'; StatusBar1.Panels[0].Text:=BinkDll+' Version: '+GetBinkVersion()+' ('+sound+')';end;procedure TForm1.PlayButtonClick(Sender: TObject);var Flags:longword; s:string;begin FreeAndNil(mt);Flags:=longword(ComboBox1.Items.Objects[ComboBox1.Itemindex]); mt := TMovieThread.Create(	   edit1.text,	   PaintBox1.Canvas,	   StrToIntDef(edit2.text,0),	   Flags  ); mt.OnNotify := threadnotify; mt.Priority:=tpLower; FillInfo(mt.Fmovie); mt.Play; s := BinkGetError; if s<>'' then showmessage(s);end;procedure TForm1.FormDestroy(Sender: TObject);begin FreeAndNil(mt);end;procedure TForm1.fillinfo(bnk: hbink);begin if bnk=nil then exit; ScrollBar1.Max := bnk.Frames;end;procedure TForm1.ThreadNotify;var F:single;beginPaintBox1.Canvas.Font.Color:= clRed;PaintBox1.Canvas.Font.Style:= [fsbold];PaintBox1.ParentFont:= True;PaintBox1.Canvas.TextOut(20,10,IntToStr(info.CurrentFrame)+						   '\'+inttostr(Bink.Frames));PaintBox1.Canvas.TextOut(20,25,IntToStr(info.DataRate));PaintBox1.Canvas.TextOut(20,40,IntToStr(bink.FrameRate));if info.MSPrFrame=0 then F:=0 else F := 1000/info.MSPrFrame; PaintBox1.Canvas.TextOut(20,55,FloatToStrF(F,fffixed,7,1 )); ScrollBar1.Position := info.CurrentFrame; // frame StatusBar1.Panels[1].Text := IntToStr(info.CurrentFrame)+						   '\'+inttostr(Bink.Frames); // rate StatusBar1.Panels[2].Text := IntToStr(info.DataRate); // stored framerate StatusBar1.Panels[3].Text := IntToStr(bink.FrameRate); // computed framerate if info.MSPrFrame=0 then F:=0 else F := 1000/info.MSPrFrame; StatusBar1.Panels[4].Text := FloatToStrF(F,fffixed,7,1 );end;procedure TForm1.ScrollBar1Scroll(Sender: TObject; ScrollCode: TScrollCode; var ScrollPos: Integer);begin if (sender is TScrollbar) and (mt<>nil) then mt.GotoFrame(ScrollBar1.Position);end;procedure TForm1.Button1Click(Sender: TObject);begin FreeAndNil(mt);end;procedure TForm1.TrackBar1Change(Sender: TObject);begin BinkSetVolume(mt.Fmovie,(255-trackbar1.position)*(256));end;procedure TForm1.TrackBar2Change(Sender: TObject);begin BinkSetPan(mt.Fmovie,256*trackbar2.Position);end;procedure TForm1.PaintBox1Click(Sender: TObject);begin if mt<>nil then FreeAndNil(mt) else PlayButtonClick(self);end;end.

Сорь ! оригиналы выложить немогу тк не помню где я их раскопал!