Add(MainForm,2953706,42,56)
{
 Width=687
 Height=411
 BorderStyle=4
 Point(Handle)
 Point(onResize)
 Point(Width)
 Point(Height)
}
Add(DirectShowPlayer,14928441,490,280)
{
 Point(doFullScreen)
 Point(doClose)
 link(FileName,14890105:Value,[(496,268)(489,268)])
 link(Handle,8571405:Var1,[(503,268)(531,268)])
}
Add(Hub,14739693,308,287)
{
 OutCount=4
 link(onEvent1,14890105:doValue,[(351,293)(351,230)])
 link(onEvent2,15372529:doTimer,[(371,300)(371,286)])
 link(onEvent3,14928441:doClose,[])
 link(onEvent4,9848857:doEvent1,[(350,314)(350,384)(75,384)(75,328)])
}
Add(ChildPanel,8571405,525,224)
{
}
BEGIN_SDK
  Add(EditMulti,8590332,21,21)
  {
   VarCount=1
   Width=531
   Height=347
   link(Var1,210257:Handle,[(27,252)(41,252)])
  }
  Add(Panel,210257,35,105)
  {
   Left=11
   Top=10
   Width=410
   Height=340
   Color=-16777198
   Point(Handle)
  }
END_SDK
Add(Memory,14890105,483,224)
{
}
Add(Timer,15372529,385,280)
{
 Enable=1
 AutoStop=1
 link(onTimer,2486813:doEvent1,[])
}
Add(Hub,2486813,441,280)
{
 link(onEvent1,14928441:doPlay,[])
 link(onEvent2,14928441:doFullScreen,[(473,293)(473,300)])
}
Add(Timer,1377823,133,329)
{
 Interval=15000
 Enable=1
 AutoStop=1
 link(onTimer,9035997:doWork2,[])
}
Add(ChanelToIndex,9035997,189,322)
{
 link(onIndex,9910225:doVisible,[])
}
Add(Hub,9848857,91,322)
{
 link(onEvent1,9035997:doWork1,[])
 link(onEvent2,1377823:doTimer,[])
}
Add(Label,1115093,217,168)
{
 Left=485
 Top=155
 Width=153
 Height=33
 Font=[MS Sans Serif,18,4,255,1]
 Caption="Ждём 15 сек!"
}
Add(ListBox,9910225,238,280)
{
 Left=435
 Top=10
 Width=240
 Height=340
 Strings=#35:http://tvnoginsk.ru:8080/stream.flv|36:http://194.44.173.90:8080/stream.flv|0:|70:http://hlsstr03.svc.iptv.rt.ru/hls/CH_C06_1TVHD/variant.m3u8?version=2|46:http://93.95.99.231:1935/live/km/playlist.m3u8|
 DataType=1
 Point(doVisible)
 link(onClick,14739693:doEvent1,[])
}

unit hiDirectShowPlayer;

interface

uses Windows,Kol,Share,Debug,dshow;

type
  THIDirectShowPlayer = class(TDebug)
   private
MyGraphBuilder : IGraphBuilder;
VideoWindow : IVideoWindow;
MyMediaControl : IMediaControl;
MyMediaPosition : IMediaPosition;
BasicVideo: IBasicVideo;
MediaEvent: IMediaEvent;
ho: HWND;
    th:PThread;

    function Execute(Sender:PThread): Integer;
   public  
    _prop_Filename:string;
                
    _data_Handle:THI_Event;
    _data_FileName:THI_Event;
    _event_onEndPlay:THI_Event;

    procedure _work_doPlay(var _Data:TData; Index:word);
    procedure _work_doPosition(var _Data:TData; Index:word);
    procedure _work_doClose(var _Data:TData; Index:word);
    procedure _work_doFullScreen(var _Data:TData; Index:word);
    procedure _var_Position(var _Data:TData; Index:word);
    procedure _var_Length(var _Data:TData; Index:word);
  end;

implementation

uses ActiveX;

function THIDirectShowPlayer.Execute(Sender:PThread): Integer;
var
  evCode:LongInt;
begin
    repeat
      MediaEvent.WaitForCompletion(1000, evCode);
      if evCode = EC_COMPLETE then 
        _hi_onEvent(_event_onEndPlay);
    until Sender.Terminated or (MyGraphBuilder = nil);
    Result := 0;
end;

procedure THIDirectShowPlayer._work_doPlay;
var fn:string;
    h:cardinal;
begin
   _work_doClose(_data, 0);          
   fn := Share.ReadString(_Data, _data_FileName, _prop_Filename);
   ho := Share.ReadInteger(_Data, _data_Handle);

    CoInitialize(nil);
    
CoCreateInstance(CLSID_FilterGraph,nil,CLSCTX_INPROC_SERVER,IID_IGraphBuilder,MyGraphBuilder);

MyGraphBuilder.RenderFile(PWideChar(WideString(fn)),nil);

MyGraphBuilder.QueryInterface(IID_IVideoWindow,VideoWindow);

VideoWindow.put_Owner(ho);
VideoWindow.put_WindowStyle(WS_CHILD OR WS_CLIPSIBLINGS);

MyGraphBuilder.QueryInterface(IID_IMediaControl,MyMediaControl);
MyGraphBuilder.QueryInterface(IID_IMediaPosition,MyMediaPosition);

MyGraphBuilder.QueryInterface(IID_IBasicVideo,BasicVideo);
MyGraphBuilder.QueryInterface(IID_IMediaEvent,MediaEvent);

MyMediaControl.Run;
//MediaEvent.WaitForCompletion(INFINITE, evCode);

    if Assigned(th) then
      th.Free;
 
    th := {$ifdef F_P}NewThreadforFPC{$else}NewThread{$endif};
    th.OnExecute := Execute;
    th.Resume;
end;

procedure THIDirectShowPlayer._work_doPosition;
begin
    MyMediaPosition.put_CurrentPosition(ToReal(_Data));
end;

procedure THIDirectShowPlayer._work_doClose;
begin
    if not assigned(MyGraphBuilder) then exit;
    
    MyMediaControl.Stop;
//    MyMediaControl.Release;
//    MyMediaPosition.Release;
//    BasicVideo.Release;
//    MediaEvent.Release;
//    MyGraphBuilder.Release;
    MyGraphBuilder := nil;
    
    th.Free;
    th := nil;
end;

procedure THIDirectShowPlayer._work_doFullScreen;
var r:TRect;
    w,h:longint;
    VideoAspect,ParentAspect:real;
    NewHeight, NewWidth, NewPosLeft, NewPosTop:integer;   
begin
    GetClientRect(ho, r);
    BasicVideo.GetVideoSize(w, h);
    
    VideoAspect := h / w;
ParentAspect := r.bottom / r.right;

    NewPosTop := 0;
    NewPosLeft := 0;
if (VideoAspect > ParentAspect) then
  begin
NewHeight := r.bottom;
NewWidth := round(NewHeight / VideoAspect);
NewPosLeft := round((r.right - NewWidth) / 2);
  end
else if (VideoAspect < ParentAspect) then
  begin
NewWidth := r.right;
NewHeight := Round(NewWidth * VideoAspect);
NewPosTop := round(abs(r.bottom - NewHeight) / 2);
  end
else
  begin
NewWidth := r.right;
NewHeight := r.bottom;
  end;

    VideoWindow.SetWindowPosition(NewPosLeft, NewPosTop, NewWidth, NewHeight);
    MyMediaControl.Run;
end;

procedure THIDirectShowPlayer._var_Position;
var d:double;
begin
  MyMediaPosition.get_CurrentPosition(d);
  dtReal(_Data, d);
end;

procedure THIDirectShowPlayer._var_Length;
var d:double;
begin
  MyMediaPosition.get_Duration(d);
  dtReal(_Data, d);
end;

end.