RTSPネットワークカメラのストリーミング映像をビットマップとして受信して再生 ~Delphiソースコード集
RTSPやVLCメディアプレイヤーのインストール等については
https://mam-mam.net/delphi/vcl_vlc.htmlを参照してください。
1.プロジェクトの作成
[ファイル]⇒[新規作成]⇒[Windows VCL アプリケーション -Delphi] をクリックします。
TPanel×1個と、TButton×2個、TBitmap×1個を以下のように配置します。
右上ペインの[ターゲットプラットフォーム]を右クリックして[プラットフォームの追加]から「Windows 64ビット」を追加して切り替えます。
2.プロジェクトの保存
ファイル⇒すべて保存、またはすべて保存ボタンを押して、プロジェクトとユニットを保存します。
「新しいフォルダ」ボタンを押してプロジェクトの保存用フォルダを作成し、ユニットはデフォルトの「Unit1.pas」、プロジェクトはデフォルトの「project1.dproj」で保存します。
3.DLLファイル、フォルダのコピー
VLCメディアプレイヤーをインストールしたフォルダ
C:\Program Files\VideoLAN\VLC
にある
「libvlc.dll」ファイル、「libvlccore.dll」ファイル、「plugins」フォルダを、以下2つのフォルダ内に全てコピーしてください。
...\3.で作成したプロジェクトフォルダ\Win64\Debug
...\3.で作成したプロジェクトフォルダ\Win64\Release
4.ユニットの作成
「ファイル」⇒「新規作成」⇒「ユニット -Delphi」をクリックして新しいユニットを作成します。
保存ボタンを押してファイル名「UVlc2.pas」で保存します。
以下のソースコードをコピーして貼り付けます。
unit UVlc2; interface uses Winapi.Windows,System.SysUtils,dialogs, System.SyncObjs,Vcl.Graphics,System.Math; { 通常、64Bit版のVLCメディアプレイヤーをインストールするので 64Bitでコンパイルする必要がある C:\Program Files\VideoLAN\VLC にある、 「libvlc.dll」ファイル、「libvlccore.dll」ファイル、「plugins」フォルダを ...\Procect\プロジェクトフォルダ\Win64\Debug ...\Procect\プロジェクトフォルダ\Win64\Release フォルダに全てコピーしておくこと } const VOUT_MAX_PLANES = 5; LibVlc = 'libvlc.dll'; LibVlcCore = 'libvlccore.dll'; type plibvlc_instance_t = type Pointer; plibvlc_media_player_t = type Pointer; plibvlc_media_t = type Pointer; PPAnsiChar = ^PAnsiChar; PVCBPitches = ^TVCBPitches; TVCBPitches = packed array[0..VOUT_MAX_PLANES-1] of LongWord; PVCBLines = ^TVCBLines; TVCBLines = packed array[0..VOUT_MAX_PLANES-1] of LongWord; PVCBPlanes = ^TVCBPlanes; TVCBPlanes = packed array[0..VOUT_MAX_PLANES-1] of Pointer; libvlc_video_lock_cb=function( opaque : Pointer; planes : PVCBPlanes ):Pointer; cdecl; libvlc_video_unlock_cb=procedure( opaque : Pointer; picture : Pointer; planes : PVCBPlanes );cdecl; libvlc_video_display_cb=procedure( opaque : Pointer; picture : Pointer );cdecl; PVideoCbCtx = ^TVideoCbCtx; TOnVLCBitmap=procedure(ctx:PVideoCbCtx) of Object; TVideoCbCtx = record Lock :TCriticalSection; BufLen :LongWord; Buf :array[0..VOUT_MAX_PLANES - 1] of Pointer; VideoWidth :LongWord; VideoH :LongWord; PitchW :LongWord; VideoW32 :LongWord; VideoH32 :LongWord; PitchW32 :LongWord; bmp :Vcl.Graphics.TBitmap; VlcInstance:plibvlc_instance_t; Media :plibvlc_media_t; MediaPlayer: plibvlc_media_player_t; OnBitmap:TOnVLCBitmap; end; libvlc_video_format_cb_t = function ( var opaque : Pointer; chroma : PAnsiChar; var width : LongWord; var height : LongWord; pitches : PVCBPitches; lines : PVCBLines) : LongWord; cdecl; libvlc_video_cleanup_cb_t = procedure( opaque : Pointer ); cdecl; TARGB=record b,g,r,a:Byte; end; TRGB=record b,g,r:Byte; end; PRGB=^TRGB; TVLCMediaPlayer=class private fVlcDllHandle:THandle; fctx: TVideoCbCtx; function LoadVlcDLL(DllPath:String):Boolean; public Constructor Create(DllPath:String); Destructor Destroy;override; procedure SetMediaNewPath(FileName:String;OnVLCBitmap:TOnVLCBitmap);overload; procedure SetMediaNewPath(FileName:String;Handle:HWnd);overload; procedure SetMediaNewLocation(Location:String;Handle:HWnd);overload; procedure SetMediaNewLocation(Location:String;OnVLCBitmap:TOnVLCBitmap);overload; procedure PlayMedia(); procedure StopMedia(); end; function lock(opaque : Pointer; planes : PVCBPlanes) : Pointer;cdecl; procedure unlock(opaque : Pointer; picture : Pointer; planes : PVCBPlanes);cdecl; procedure display(opaque : Pointer; picture : Pointer);cdecl; function libvlc_video_format_cb(var opaque:Pointer;chroma: PAnsiChar; var width,height: LongWord; pitches: PVCBPitches; lines: PVCBLines): LongWord; cdecl; procedure libvlc_video_cleanup_cb(opaque:Pointer); cdecl; procedure SetCtx(ctx:PVideoCbCtx;width, height:LongWord); var libvlc_new:function(argc:Integer;argv:PPAnsiChar):plibvlc_instance_t;cdecl; libvlc_release:procedure(pInst:plibvlc_instance_t);cdecl; libvlc_free:procedure(); cdecl; libvlc_get_version:function(): PAnsiChar;cdecl; libvlc_media_new_location: function(pInst:plibvlc_instance_t;const psz_mrl:PAnsiChar):plibvlc_media_t;cdecl; libvlc_media_new_path: function(pInst:plibvlc_instance_t;const path:PAnsiChar):plibvlc_media_t;cdecl; libvlc_media_new_as_node: function(pInst:plibvlc_instance_t;const psz_name:PChar):plibvlc_media_t;cdecl; libvlc_media_release: procedure(pMedia:plibvlc_media_t);cdecl; libvlc_media_player_new: function (pInst:plibvlc_instance_t):plibvlc_media_player_t;cdecl; libvlc_media_player_new_from_media: function(pMedia:plibvlc_media_t):plibvlc_media_player_t;cdecl; libvlc_media_player_release: procedure(pMediaPlayer:plibvlc_media_player_t);cdecl; libvlc_media_player_set_hwnd: procedure(pMediaPlayer:plibvlc_media_player_t;hwnd:THandle);cdecl; libvlc_media_player_get_hwnd: function (pMediaPlayer:plibvlc_media_player_t):THandle; cdecl; libvlc_media_player_play: function(pMediaPlayer:plibvlc_media_player_t):Integer;cdecl; libvlc_media_player_stop: procedure(pMediaPlayer:plibvlc_media_player_t);cdecl; libvlc_media_player_is_playing: function(pMediaPlayer:plibvlc_media_player_t):Integer;cdecl; libvlc_media_player_set_pause: procedure(pMediaPlayer:plibvlc_media_player_t;do_pause:Integer);cdecl; libvlc_media_player_pause: procedure(pMediaPlayer:plibvlc_media_player_t);cdecl; libvlc_media_player_retain: procedure(pMediaPlayer:plibvlc_media_player_t);cdecl; libvlc_media_player_set_media: procedure(pMediaPlayer:plibvlc_media_player_t;pMedia:plibvlc_media_t);cdecl; libvlc_media_player_get_media: function(pMediaPlayer:plibvlc_media_player_t):plibvlc_media_t;cdecl; libvlc_audio_set_track: function(pMediaPlayer:plibvlc_media_player_t;i_track:Integer):Integer;cdecl; libvlc_video_set_callbacks: procedure( pMediaPlayer:plibvlc_media_player_t; lock : libvlc_video_lock_cb; unlock : libvlc_video_unlock_cb; display : libvlc_video_display_cb; opaque : Pointer );cdecl; libvlc_video_set_format: procedure( pMediaPlayer:plibvlc_media_player_t; croma:PAnsiChar; width:Longword; height:Longword; pitch:Longword );cdecl; libvlc_video_get_size: function( pMediaPlayer:plibvlc_media_player_t; num :LongWord;//通常は0を渡す var px,py:LongWord ):Integer;cdecl; libvlc_video_set_format_callbacks: procedure( pMediaPlayer:plibvlc_media_player_t; setup : libvlc_video_format_cb_t; cleanup : libvlc_video_cleanup_cb_t ); cdecl; implementation uses Unit1; function lock(opaque : Pointer; planes : PVCBPlanes) : Pointer; var i:Integer; ctx:PVideoCbCtx; begin result:=nil; if opaque=nil then exit; ctx:=PVideoCbCtx(opaque); ctx.Lock.Enter(); for i := 0 to VOUT_MAX_PLANES-1 do begin planes[i]:=ctx.Buf[i]; end; end; procedure unlock(opaque : Pointer; picture : Pointer; planes : PVCBPlanes); var ctx:PVideoCbCtx; begin if opaque=nil then exit; ctx:=PVideoCbCtx(opaque); ctx.Lock.Leave; end; procedure display(opaque : Pointer; picture : Pointer); var ctx:PVideoCbCtx; p:PByte; b:PByte; x,y:Integer; rgb:PRGB; begin if opaque=nil then exit; ctx:=PVideoCbCtx(opaque); if System.MonitorTryEnter(ctx.bmp) then begin if ctx.Lock.TryEnter then begin if ctx.Buf[0]<>nil then begin p:=ctx.Buf[0]; for y := 0 to ctx.VideoH-1 do begin rgb:=ctx.bmp.ScanLine[y]; b:=p; for x := 0 to ctx.VideoWidth-1 do begin rgb.b:=b^; inc(b); rgb.g:=b^; inc(b); rgb.r:=b^; inc(b); inc(b);//アルファ成分はスキップ inc(rgb); end; inc(p, ctx.PitchW32); end; end; ctx.Lock.Leave; end; System.MonitorExit(ctx.bmp); if assigned(ctx.OnBitmap) then ctx.OnBitmap(ctx); end; end; procedure libvlc_video_cleanup_cb(opaque : Pointer); cdecl; var ctx:PVideoCbCtx; begin if opaque=nil then exit; ctx:=PVideoCbCtx(opaque); libvlc_video_set_format_callbacks(ctx.MediaPlayer,nil,nil); end; function libvlc_video_format_cb(var opaque:Pointer;chroma: PAnsiChar; var width,height: LongWord; pitches: PVCBPitches; lines: PVCBLines): LongWord; cdecl; var ctx:PVideoCbCtx; begin Result := 0; if opaque=nil then exit; ctx:=PVideoCbCtx(opaque); SetCtx(ctx,width,height); Result := 1; end; { TVLCMediaPlayer } constructor TVLCMediaPlayer.Create(DllPath: String); begin fVlcDllHandle:=0; self.LoadVlcDll(DllPath); fctx.Lock:=TCriticalSection.Create; fctx.bmp:=Vcl.Graphics.TBitmap.Create; fctx.bmp.PixelFormat:=pf24bit; fctx.VlcInstance:=nil; fctx.Media:=nil; fctx.MediaPlayer:=nil; if fVlcDllHandle<>0 then begin self.fctx.VlcInstance := libvlc_new(0, nil); end; end; destructor TVLCMediaPlayer.Destroy; var i:Integer; begin if Assigned(fctx.MediaPlayer) then begin //VLCメディアプレイヤーの停止 libvlc_media_player_stop(fctx.MediaPlayer); //完全停止するまで待つ while libvlc_media_player_is_playing(fctx.MediaPlayer) = 1 do begin Sleep(100); end; libvlc_video_set_callbacks(fctx.MediaPlayer,nil,nil,nil,nil); libvlc_video_set_format_callbacks(fctx.MediaPlayer,nil,nil); //VLCメディアプレイヤーの解放 libvlc_media_player_release(fctx.MediaPlayer); fctx.MediaPlayer := nil; end; //VLCを解放 if self.fctx.VlcInstance<>nil then libvlc_release(self.fctx.VlcInstance); //DLLを解放 if fVlcDllHandle<>0 then FreeLibrary(fVlcDllHandle); fctx.Lock.Free; fctx.bmp.Free; for i := 0 to VOUT_MAX_PLANES-1 do begin if(fctx.Buf[i]<>nil)then begin FreeMem(fctx.Buf[i]); end; end; end; function TVLCMediaPlayer.LoadVlcDLL(DllPath: String):boolean; begin fVlcDllHandle:=SafeLoadLibrary(PChar(DllPath+LibVlc)); if fVlcDllHandle=0 then begin result:=false; Showmessage('libvlc.dllの読み込み失敗'); Exit; end; {$IFDEF DEBUG} OutputDebugString(PChar(inttostr(fVlcDllHandle))); {$ENDIF} //DLLから関数の読み込み libvlc_new:=GetProcAddress(fVlcDllHandle,'libvlc_new'); libvlc_release:=GetProcAddress(fVlcDllHandle,'libvlc_release'); libvlc_free:=GetProcAddress(fVlcDllHandle,'libvlc_free'); libvlc_get_version:=GetProcAddress(fVlcDllHandle,'libvlc_get_version'); libvlc_media_new_location:= GetProcAddress(fVlcDllHandle,'libvlc_media_new_location'); libvlc_media_new_path:= GetProcAddress(fVlcDllHandle,'libvlc_media_new_path'); libvlc_media_new_as_node:= GetProcAddress(fVlcDllHandle,'libvlc_media_new_as_node'); libvlc_media_release:= GetProcAddress(fVlcDllHandle,'libvlc_media_release'); //libvlc_media_new:= // GetProcAddress(VlcLibHandle,'libvlc_media_new'); libvlc_media_player_new:= GetProcAddress(fVlcDllHandle,'libvlc_media_player_new'); libvlc_media_player_new_from_media:= GetProcAddress(fVlcDllHandle,'libvlc_media_player_new_from_media'); libvlc_media_player_release:= GetProcAddress(fVlcDllHandle,'libvlc_media_player_release'); libvlc_media_player_set_hwnd:= GetProcAddress(fVlcDllHandle,'libvlc_media_player_set_hwnd'); libvlc_media_player_get_hwnd:= GetProcAddress(fVlcDllHandle,'libvlc_media_player_get_hwnd'); libvlc_media_player_play:= GetProcAddress(fVlcDllHandle,'libvlc_media_player_play'); libvlc_media_player_stop:= GetProcAddress(fVlcDllHandle,'libvlc_media_player_stop'); libvlc_media_player_is_playing:= GetProcAddress(fVlcDllHandle,'libvlc_media_player_is_playing'); libvlc_media_player_set_pause:= GetProcAddress(fVlcDllHandle,'libvlc_media_player_set_pause'); libvlc_media_player_pause:= GetProcAddress(fVlcDllHandle,'libvlc_media_player_pause'); libvlc_media_player_retain:= GetProcAddress(fVlcDllHandle,'libvlc_media_player_retain'); libvlc_media_player_set_media:= GetProcAddress(fVlcDllHandle,'libvlc_media_player_set_media'); libvlc_media_player_get_media:= GetProcAddress(fVlcDllHandle,'libvlc_media_player_get_media'); libvlc_audio_set_track:= GetProcAddress(fVlcDllHandle,'libvlc_audio_set_track'); libvlc_video_set_callbacks:= GetProcAddress(fVlcDllHandle,'libvlc_video_set_callbacks'); libvlc_video_set_format:= GetProcAddress(fVlcDllHandle,'libvlc_video_set_format'); libvlc_video_get_size:= GetProcAddress(fVlcDllHandle,'libvlc_video_get_size'); libvlc_video_set_format_callbacks:= GetProcAddress(fVlcDllHandle,'libvlc_video_set_format_callbacks'); result:=True; end; procedure TVLCMediaPlayer.PlayMedia; begin //再生する if Assigned(fctx.MediaPlayer) then libvlc_media_player_play(fctx.MediaPlayer); end; procedure TVLCMediaPlayer.SetMediaNewLocation(Location:String;OnVLCBitmap:TOnVLCBitmap); begin fctx.Media := libvlc_media_new_location( fctx.VlcInstance, PAnsiChar(UTF8Encode(Location)) ); fctx.MediaPlayer := libvlc_media_player_new_from_media(fctx.Media); libvlc_video_set_format_callbacks( fctx.MediaPlayer, libvlc_video_format_cb, libvlc_video_cleanup_cb ); libvlc_video_set_callbacks( fctx.MediaPlayer, lock, unlock, display, @fctx); //メディアを解放する libvlc_media_release(fctx.Media); fctx.OnBitmap:=OnVLCBitmap; end; procedure TVLCMediaPlayer.SetMediaNewLocation(Location:String; Handle: HWnd); begin fctx.Media := libvlc_media_new_location( fctx.VlcInstance, PAnsiChar(UTF8Encode(Location)) ); fctx.MediaPlayer := libvlc_media_player_new_from_media(fctx.Media); //メディアを解放する libvlc_media_release(fctx.Media); libvlc_media_player_set_hwnd(fctx.MediaPlayer, Handle); end; procedure TVLCMediaPlayer.SetMediaNewPath(FileName:String;OnVLCBitmap:TOnVLCBitmap); begin fctx.Media := libvlc_media_new_path( fctx.VlcInstance, PAnsiChar(UTF8Encode(FileName)) ); fctx.MediaPlayer := libvlc_media_player_new_from_media(fctx.Media); libvlc_video_set_format_callbacks( fctx.MediaPlayer, libvlc_video_format_cb, libvlc_video_cleanup_cb ); libvlc_video_set_callbacks( fctx.MediaPlayer, lock, unlock, display, @fctx); //メディアを解放する libvlc_media_release(fctx.Media); fctx.OnBitmap:=OnVLCBitmap; end; procedure TVLCMediaPlayer.SetMediaNewPath(FileName: String; Handle: HWnd); begin fctx.Media := libvlc_media_new_path( fctx.VlcInstance, PAnsiChar(UTF8Encode(FileName)) ); fctx.MediaPlayer := libvlc_media_player_new_from_media(fctx.Media); //メディアを解放する libvlc_media_release(fctx.Media); libvlc_media_player_set_hwnd(fctx.MediaPlayer, Handle); end; procedure TVLCMediaPlayer.StopMedia; begin if assigned(fctx.MediaPlayer) then begin //VLCメディアプレイヤーの停止 libvlc_media_player_stop(fctx.MediaPlayer); //完全停止するまで待つ while libvlc_media_player_is_playing(fctx.MediaPlayer) = 1 do begin Sleep(100); end; libvlc_video_set_callbacks(fctx.MediaPlayer,nil,nil,nil,nil); //VLCメディアプレイヤーの解放 libvlc_media_player_release(fctx.MediaPlayer); fctx.MediaPlayer := nil; end; end; procedure SetCtx(ctx:PVideoCbCtx;width, height:LongWord); var i:Integer; begin ctx.Lock.Enter; ctx.VideoWidth:=width; ctx.VideoH:=height; ctx.PitchW:=width*4; ctx.VideoW32:=Ceil(width/32)*32; //32の倍数に ctx.VideoH32:=Ceil(height/32)*32;//32の倍数に ctx.PitchW32:=ctx.VideoW32*4; ctx.BufLen:=ctx.VideoW32*ctx.VideoH32*4; for i := 0 to VOUT_MAX_PLANES-1 do begin if(ctx.Buf[i]<>nil)then begin FreeMem(ctx.Buf[i]); end; GetMem(ctx.Buf[i],ctx.BufLen); end; System.MonitorEnter(ctx.bmp); ctx.bmp.Width:=width; ctx.bmp.Height:=height; System.MonitorExit(ctx.bmp); ctx.Lock.Leave; libvlc_video_set_format( ctx.MediaPlayer, 'RV32', ctx.VideoWidth, ctx.VideoH, ctx.PitchW ); end; end.
5.Unit1のソースコードの記述
Unit1に切り替えて、Button1のOnClick、Button2のOnClick、Form1のOnCreate、Form1のOnDestroyイベントに以下ソースコードを入力します。
unit Unit1; interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls, UVlc2; type TForm1 = class(TForm) Panel1: TPanel; Button1: TButton; Button2: TButton; Image1: TImage; procedure Button1Click(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure Button2Click(Sender: TObject); private { Private 宣言 } VLCMediaPlayer:TVLCMediaPlayer; procedure OnBitmap(ctx:PVideoCbCtx); public { Public 宣言 } end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.Button1Click(Sender: TObject); begin //MRLはご使用のネットワークカメラに従い設定してください VLCMediaPlayer.SetMediaNewLocation( 'rtsp://ユーザー名:パスワード@IPアドレス:554/stream1, OnBitmap ); //再生する VLCMediaPlayer.PlayMedia(); end; procedure TForm1.Button2Click(Sender: TObject); begin VLCMediaPlayer.StopMedia; end; procedure TForm1.FormCreate(Sender: TObject); begin Self.DoubleBuffered:=True; Image1.Stretch:=True; Image1.Proportional:=True; VLCMediaPlayer:=TVLCMediaPlayer.Create(ExtractFilePath(Application.ExeName)); end; procedure TForm1.FormDestroy(Sender: TObject); begin VLCMediaPlayer.Free; end; procedure TForm1.OnBitmap(ctx: PVideoCbCtx); begin //オブジェクトのロック if System.MonitorTryEnter(ctx.bmp) then begin if assigned(ctx.bmp) then begin Image1.Picture.Bitmap.Assign(ctx.bmp); end; //オブジェクトのロックを開放する System.MonitorExit(ctx.bmp); end; end; end.
6.完成したアプリケーションを起動する
実行⇒実行 又はツールバーの「実行」ボタンを押して実行します。
7.ネットワークカメラに接続する
「Button1」ボタンをクリックします。
以下のウィンドウが表示(Windowsファイアーウォールのブロック)された場合は
「アクセスを許可する」ボタンを押して554ポートのオープンを許可します。
以下のようにネットワークカメラ映像がRTSPストリーミングでリアルタイムにビットマップとして表示されます。