main.pas

一个很不错的代码

unit Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DSPack, DirectShow9, DSUtil, StdCtrls;

type
  IKTVReceiverCB = interface(IUnknown)
    ['{8080D522-D2D3-4536-B06B-6F0E91D89E42}']
    function StartReceive(Identifier: Integer): HRESULT; stdcall;
    function StopReceive(Identifier: Integer): HRESULT; stdcall;
  end;

  IKTVReceiver = interface(IUnKnown)
    ['{045187FB-5D03-4DA4-86C5-F4E4F8B5DD73}']
    function SetMulticastIP(MulticastIP: PChar): HRESULT; stdcall;
    function GetMulticastIP(out MulticastIP: PChar): HRESULT; stdcall;
    function GetLocalIPs(out LocalIPs: PChar): HRESULT; stdcall;
    function SetLocalIP(LocalIP: PChar): HRESULT; stdcall;
    function GetLocalIP(out LocalIP: PChar): HRESULT; stdcall;
    function SetMulticastPort(MulticastPort: Integer): HRESULT; stdcall;
    function GetMulticastPort(out MulticastPort: Integer): HRESULT; stdcall;
    function SetUserID(UserID: Integer): HRESULT; stdcall;
    function GetUserID(out UserID: Integer): HRESULT; stdcall;
    function SetActive(Active: Bool): HRESULT; stdcall;
    function GetActive(out Active: Bool): HRESULT; stdcall;
    function SetCallback(Callback: IKTVReceiverCB; Identifier: Integer): HRESULT; stdcall;
  end;

  TMainForm = class(TForm, IKTVReceiverCB)
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    VideoWindow2: TVideoWindow;
    FilterGraph2: TFilterGraph;
    Filter2: TFilter;
    Label2: TLabel;
    ComboBox2: TComboBox;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ComboBox2Change(Sender: TObject);
    procedure VideoWindow2DblClick(Sender: TObject);
  private
    { Private declarations }
    KTVReceiver: IKTVReceiver;
    function StartReceive(Identifier: Integer): HRESULT; stdcall;
    function StopReceive(Identifier: Integer): HRESULT; stdcall;
    procedure StartRecv;
    procedure StopRecv;
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.dfm}

procedure TMainForm.FormCreate(Sender: TObject);
var
  I: Integer;
  P: PChar;
begin
  FilterGraph2.ClearGraph;
  FilterGraph2.Active := True;
  Filter2.QueryInterface(IKTVReceiver, KTVReceiver);
  if KTVReceiver <> nil then
  begin
    KTVReceiver.GetLocalIPs(P);
    ComboBox2.Items.Text := P;
    KTVReceiver.GetMulticastIP(P);
    Label6.Caption := '组播IP： ' + P;
    KTVReceiver.GetLocalIP(P);
    Label7.Caption := '本机IP： ' + P;
    ComboBox2.ItemIndex := ComboBox2.Items.IndexOf(P);
    KTVReceiver.GetMulticastPort(I);
    Label8.Caption := '端  口： ' + IntToStr(I);
    KTVReceiver.SetCallback(Self, 0);
  end;
end;

procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  KTVReceiver := nil;
  FilterGraph2.ClearGraph;
  FilterGraph2.Active := False;
end;

procedure TMainForm.ComboBox2Change(Sender: TObject);
var
  P: PChar;
begin
  if KTVReceiver <> nil then
  begin
    KTVReceiver.SetLocalIP(PChar(ComboBox2.Items[ComboBox2.ItemIndex]));
    KTVReceiver.GetLocalIP(P);
    Label7.Caption := '本机IP： ' + P;
  end;
end;

function TMainForm.StartReceive(Identifier: Integer): HRESULT;
begin
  TThread.Synchronize(nil, StartRecv);
  Result := S_OK;
end;

function TMainForm.StopReceive(Identifier: Integer): HRESULT;
begin
  TThread.Synchronize(nil, StopRecv);
  Result := S_OK;
end;

procedure TMainForm.StartRecv;
begin
  (FilterGraph2 as ICaptureGraphBuilder2).RenderStream(nil, nil, Filter2 as IBaseFilter, nil, VideoWindow2 as IBaseFilter);
  FilterGraph2.Play;
end;

procedure TMainForm.StopRecv;
begin
  FilterGraph2.ClearGraph;
  VideoWindow2.FilterGraph := nil;
  VideoWindow2.FilterGraph := FilterGraph2;
end;

procedure TMainForm.VideoWindow2DblClick(Sender: TObject);
begin
  VideoWindow2.FullScreen := not VideoWindow2.FullScreen;
end;

end.