视频捕获和传输

 unit Client;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, DSPack, DirectShow9, StdCtrls, DSUtil,
  IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, jpeg, Menus, IdTCPServer;

type
  TClientForm = class(TForm)
    FilterGraph: TFilterGraph;
    Grabber: TSampleGrabber;
    Filter: TFilter;
    VideoWindow: TVideoWindow;
    VideoPanel: TPanel;
    Panel1: TPanel;
    Image: TImage;
    Button1: TButton;
    Button2: TButton;
    edtIPAddress: TEdit;
    TCPClient: TIdTCPClient;
    procedure GrabberBuffer(sender: TObject; SampleTime: Double; pBuffer: Pointer; BufferLen: Integer);
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure AboutClick(Sender: TObject);
    procedure ConnectServerClick(Sender: TObject);
    procedure DeconnectServerClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure OnSelectDevice(sender: TObject);
  end;

var
  ClientForm: TClientForm;
  SysDev: TSysDevEnum;

implementation

uses
  About, Connect;

{$R *.dfm}

procedure TClientForm.GrabberBuffer(sender: TObject; SampleTime: Double; pBuffer: Pointer; BufferLen: Integer);
var
  hr: HRESULT;
  BIHeaderPtr: PBitmapInfoHeader;
  MediaType: TAMMediaType;
  BitMapHandle: HBitmap;
  DIBPtr: Pointer;
  jpg: TJpegImage;
  memStream: TMemoryStream;
begin
  Image.Canvas.Lock;
  try
    hr := Grabber.SampleGrabber.GetConnectedMediaType(MediaType);
    if hr <> S_OK then
      Exit;
    try
      if IsEqualGUID(MediaType.majortype, MEDIATYPE_Video) then
      begin
        BIHeaderPtr := nil;
        if IsEqualGUID(MediaType.formattype, FORMAT_VideoInfo) then
          if MediaType.cbFormat = SizeOf(TVideoInfoHeader) then
            BIHeaderPtr := @(PVideoInfoHeader(MediaType.pbFormat)^.bmiHeader);
        if not Assigned(BIHeaderPtr) then
          Exit;
        BitmapHandle := CreateDIBSection(0, PBitmapInfo(BIHeaderPtr)^, DIB_RGB_COLORS, DIBPtr, 0, 0);
        if BitmapHandle <> 0 then
        begin
          if DIBPtr = nil then
            Exit;
          if BufferLen > Integer(BIHeaderPtr^.biSizeImage) then
            BufferLen := BIHeaderPtr^.biSizeImage;
          Move(pBuffer^, DIBPtr^, BufferLen);
          Image.Picture.Bitmap.Handle := BitmapHandle;
        end;
      end;
    finally
      FreeMediaType(@MediaType);
    end;

    memStream := TMemoryStream.Create;
    jpg := TJpegImage.Create;
    jpg.Assign(Image.Picture.Bitmap);
    jpg.CompressionQuality := 10;
    jpg.JPEGNeeded;
    jpg.Compress;
    jpg.SaveToStream(memStream);
    jpg.Free;

    if ClientForm.TCPClient.Connected then
    begin
      try
        ClientForm.TCPClient.WriteInteger(memStream.Size);
        ClientForm.TCPClient.WriteBuffer(memStream.Memory^, memStream.Size, True);
      except
      end;
    end;
    memStream.Free;
  finally
    Image.Canvas.Unlock;
  end;
end;

procedure TClientForm.FormCreate(Sender: TObject);
var
  i: Integer;
  Device: TMenuItem;
begin
 SysDev := TSysDevEnum.Create(CLSID_VideoInputDeviceCategory);

end;

procedure TClientForm.OnSelectDevice(sender: TObject);
begin
  FilterGraph.ClearGraph;
  FilterGraph.Active := False;
  Filter.BaseFilter.Moniker := SysDev.GetMoniker(TMenuItem(Sender).tag);
  FilterGraph.Active := True;
  with FilterGraph as ICaptureGraphBuilder2 do
    CheckDSError(RenderStream(@PIN_CATEGORY_PREVIEW, nil, Filter as IBaseFilter, Grabber as IBaseFilter, VideoWindow as IbaseFilter));
  FilterGraph.Play;
end;

procedure TClientForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  SysDev.Free;
  FilterGraph.ClearGraph;
  FilterGraph.Active := False;
  if ClientForm.TCPClient.Connected then
    ClientForm.TCPClient.Disconnect;
end;

procedure TClientForm.AboutClick(Sender: TObject);
begin
  AboutForm.Show;
end;

procedure TClientForm.ConnectServerClick(Sender: TObject);
begin
  ConnectForm.Show;
end;

procedure TClientForm.DeconnectServerClick(Sender: TObject);
begin
  if ClientForm.TCPClient.Connected then
    ClientForm.TCPClient.Disconnect;
end;

procedure TClientForm.Button1Click(Sender: TObject);
begin
  FilterGraph.ClearGraph;
  FilterGraph.Active := False;
  Filter.BaseFilter.Moniker := SysDev.GetMoniker(TMenuItem(Sender).tag);
  FilterGraph.Active := True;
  with FilterGraph as ICaptureGraphBuilder2 do
    CheckDSError(RenderStream(@PIN_CATEGORY_PREVIEW, nil, Filter as IBaseFilter, Grabber as IBaseFilter, VideoWindow as IbaseFilter));
end;

procedure TClientForm.Button2Click(Sender: TObject);

begin
  if edtIPAddress.Text <> '' then
  begin
    TCPClient.Host := edtIPAddress.Text;
    try
        if not TCPClient.Connected then
        TCPClient.Connect;
    except
      ShowMessage('连接错误！');
    end;
  end;

end;

 

end.