| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Передача видео и звука с помощью Indy [D7]

Страницы:   < 1 2 3 4 5 6 7 8 9 10 >

3asys ©   (2011-11-26 15:48:00) 

На клиенте получаю видео и звук с web-камеры (с встроенным микрофоном) с помощью DirectShow.
Нужно передать их серверу для рассылки другим клиентам.
Видео и звук с Web-камеры получаю стандартным способом, описанным в примерах к DSPack, - примерно так:

var
 multiplexer: IBaseFilter;
 Writer: IFileSinkFilter;
 PinList: TPinList;
 i: integer;
begin
with MainForm do
begin
 CaptureGraph.Active := true;
 if AudioSourceFilter.FilterGraph <> nil then
 begin
   PinList := TPinList.Create(AudioSourceFilter as IBaseFilter);
   i := 0;
   while i < PinList.Count do
     if PinList.PinInfo[i].dir = PINDIR_OUTPUT then
       begin
         if AudioFormats.ItemIndex <> -1 then
           with (PinList.Items[i] as IAMStreamConfig) do
             SetFormat(AudioMediaTypes.Items[AudioFormats.ItemIndex].AMMediaType^);
         PinList.Delete(i);
       end else inc(i);
   if InputLines.ItemIndex <> -1 then
     with (PinList.Items[InputLines.ItemIndex] as IAMAudioInputMixer) do
       put_Enable(true);
   PinList.Free;
 end;

 if VideoSourceFilter.FilterGraph <> nil then
 begin
   PinList := TPinList.Create(VideoSourceFilter as IBaseFilter);
   if VideoFormats.ItemIndex <> -1 then
     with (PinList.First as IAMStreamConfig) do
       SetFormat(VideoMediaTypes.Items[VideoFormats.ItemIndex].AMMediaType^);
   PinList.Free;
 end;

 with CaptureGraph as IcaptureGraphBuilder2 do
 begin
   // set the output filename
   SetOutputFileName(MEDIASUBTYPE_Avi, PWideChar(CapFile), multiplexer, Writer);

   if VideoSourceFilter.BaseFilter.DataLength > 0 then
     RenderStream(@PIN_CATEGORY_PREVIEW, nil, VideoSourceFilter as IBaseFilter,
       nil , form1.VideoWindow as IBaseFilter);

   if VideoSourceFilter.FilterGraph <> nil then
     RenderStream(@PIN_CATEGORY_CAPTURE, nil, VideoSourceFilter as IBaseFilter,
       nil, multiplexer as IBaseFilter);

   if AudioSourceFilter.FilterGraph <> nil then
   begin

     RenderStream(nil, nil, AudioSourceFilter as IBaseFilter,
       nil, multiplexer as IBaseFilter);
   end;
 end;
 CaptureGraph.Play;

В RenderStream получаем потоки, но как их передать через IdTCPClient, IdTCPServer я сообразить не могу.
Как это сделать?

---

3asys   (2012-01-15 12:41:00) [1]

> DVM ©  
Сделал передачу Handle:
Передаю в ветвь hanle:

procedure TfVideoClient.CreateNewUserTranslation(Host : String; Port : Integer; UserName : String);
var
 NewClntTransl : TfVideoClient;
 Handle : HWND;
 b : TBitmap;
begin
 NewClntTransl:=TfVideoClient.Create(fVideoClient);
 NewClntTransl.Host:=Host;
 NewClntTransl.Port := Port;
 NewClntTransl.Caption:=UserName;
 NewClntTransl.Show;
 Handle:=NewClntTransl.Handle;
 VideoThread := THTTPInputThread.Create(Host, Port, VideoPath, UserName, Password, Handle);
 AudioThread := THTTPInputThread.Create(Host, Port, AudioPath, UserName, Password, Handle);
end;

Из ветви передаю в WndProc hanle в WParam:

SendMessage(FHandle, FSendNewFrameMessage, FHandle, Longint(FrameData));

В WndProc обрабатываю:

procedure TfVideoClient.WndProc(var Msg: TMessage);
var
 FrameData: PFrameData;
 jpeg : TJPEGImage;
 b : TBitmap;
 h : HWND;
begin
 if Msg.Msg = FSendNewFrameMessage then
 begin
   FrameData := PFrameData(Msg.Lparam);
   h:=Msg.WParam;
   VideoStream.Clear;
   VideoStream.WriteBuffer(FrameData^.FrameData^, FrameData^.FrameDataLen);

   jpeg:=TJPEGImage.Create;
   VideoStream.Position:=0;
   jpeg.LoadFromStream(VideoStream);
   b:=TBitmap.Create;
   b.Assign(jpeg);
   TForm(FindControl(h)).Width:=b.Width;
   TForm(FindControl(h)).Height:=b.Height;
   TForm(FindControl(h)).Canvas.Draw(0,0,b);

   jpeg.Free;
   b.Free;
 end
 else
   inherited;
end;


Вроде все работает.
Но хотелось бы более красиво - как Вы предлагали.
Как это сделать?

---

3asys   (2012-01-09 11:58:00) [2]

> DVM ©
Добрый день,
в процедуре

// Ñîçäàíèå îêíà è çàïóñê âèäåî-àóäèî òðàíñëÿöèè ïîëüçîâàòåëÿ:
procedure TfVideoClient.CreateNewUserTranslation(Host : String; Port : Integer; UserName : String);
var
 NewClntTransl : TfVideoClient;
 Handle : HWND;
 b : TBitmap;
begin
 NewClntTransl:=TfVideoClient.Create(fVideoClient);
 NewClntTransl.Host:=Host;
 NewClntTransl.Port := Port;
 NewClntTransl.Caption:=UserName;
 NewClntTransl.Show;
 b:=TBitmap.Create;
 Handle:=NewClntTransl.Handle;
 VideoThread := THTTPInputThread.Create(Host, Port, VideoPath, UserName, Password, Handle);
 AudioThread := THTTPInputThread.Create(Host, Port, AudioPath, UserName, Password, Handle);
end;

я создаю экземпляр клиента и его собственные видео и аудио потоки (VideoThread, AudioThread).
Далее эти потоки обрабатываются THTTPInputThread. В ходе обработки видеопотока создается

SendMessage(FHandle, FSendNewFrameMessage, 0, Longint(FrameData));

которая передает картинку форме с handle = FHandle
Далее в обработчике

procedure TfVideoClient.WndProc(var Msg: TMessage);
var
 FrameData: PFrameData;
 jpeg : TJPEGImage;
 b : TBitmap;
begin
 if Msg.Msg = FSendNewFrameMessage then
 begin
   // Çàãðóçêà äàííûõ â ïîòîê, âûãðóçêà îòòóäà èõ â Jpeg
   // äåêîäèðîâàíèå è îòðèñîâêà
   FrameData := PFrameData(Msg.Lparam);
   VideoStream.Clear;
   VideoStream.WriteBuffer(FrameData^.FrameData^, FrameData^.FrameDataLen);

   jpeg:=TJPEGImage.Create;
   VideoStream.Position:=0;
   jpeg.LoadFromStream(VideoStream);
   b:=TBitmap.Create;
   b.Assign(jpeg);
   // Ïîäãîíêà ðàçìåðà ôîðìû ïîä ðàçìåð èçîáðàæåíèÿ:
   fVideoClient.Width:=b.Width;
   fVideoClient.Height:=b.Height;
   // Âûâîä êàðòèíêè íà êàíâó:
   fVideoClient.Canvas.Draw(0,0,b);

   jpeg.Free;
   b.Free;
 end
 else
   inherited;
end;

Надо бы вместо fVideoClient указать форму с FHandle, но как это сделать ?
пробовал FindWindow (по имени окна), но как на ней обновить bitmap? (и как при создании привязать bitmap к форме?)

---

DVM   (2012-01-09 00:47:00) [3]

> Тогда, как передать именно созданную форму в процедуру рисования?

переделать надо, завтра объясню как

---

3asys   (2012-01-09 00:46:00) [4]

Спасибоб, сейчас попробую написать.

---

3asys   (2012-01-09 00:44:00) [5]

их должно быть по числу участников конференции - у каждого -свое окно в котором транслируется видео этого участника.
Смотрите, в отмеченном Вами куске действительно стоит форма клиента, а не та, которую я создаю в run-time. НО - создаю я форму в одной процедуре (CreateNewUserTranslation), а рисую на ней в другой (WndProc).
Тогда, как передать именно созданную форму в процедуру рисования?

---

DVM   (2012-01-09 00:43:00) [6]

Че то ты как то не так сделал. Надо было бы сделать отдельный класс-компонент наследник TWinControl например и его экземпляры создавать на форме, у каждого такого класса должен быть свой поток поставляющий данные для отрисовки и свой постоянно живущий в нем TBitmap который потоком обновляется, этот же TBitmap должен отрисовываться по WM_PAINT на окне этого компонента.

Ладно завтра разберемся. Это весьма все просто.

---

DVM   (2012-01-09 00:39:00) [7]

> 3asys ©   (09.01.12 00:28) [179]

Их много что ли одновременно одинаковых?

---

3asys   (2012-01-09 00:30:00) [8]

у нее тот handle , который задается Thread при инициировании [172] (Создание окна и запуск видеотрансляции)

---

3asys   (2012-01-09 00:28:00) [9]

это форма клиента

---

DVM   (2012-01-09 00:23:00) [10]

> Данные какие-то по SendMessage приходят, картинка bitmap
> создается, но не отрисовывается.

раз создается, значит отрисовывается не там, где должен

fVideoClient.Canvas.Draw(0,0,b);

вот здесь fVideoClient - это что?

---

3asys   (2012-01-08 23:40:00) [11]

Данные какие-то по SendMessage приходят, картинка bitmap создается, но не отрисовывается.
В упор ничего не вижу. Больше 10 раз всю цепочку просмотрел - и не вижу, где может быть ошибка, хотя конечно есть, только где? :)

---

3asys   (2012-01-08 16:25:00) [12]

Unit работы с потоком практически не менялся (только добавил Handle в конструктор.
Handle фориы которой отправляет сообщение SendMessage совпадает с Handle формы, которая выводится (в методе OnShow клиента пишу Caption:=IntToStr(Handle);) :)
Вожусь с этим третий день :(
Что еще можно сделать?

---

3asys   (2012-01-08 16:19:00) [13]

function InetAddr(const AHost: AnsiString): DWORD;
var
PHost: PAnsiChar;
HostEnt: PHostEnt;
begin
if AHost = '' then
  result := DWORD($FFFFFFFF)
else
  begin
    PHost := PAnsiChar(AHost);
    Result := inet_addr(PHost);
    if Result = DWORD($FFFFFFFF) then
      begin
        HostEnt := GetHostByName(PHost);
        if HostEnt nil then
          Result := DWORD(pointer(HostEnt^.h_addr^)^);
      end;
  end;
end;

function THTTPInputThread.Init: integer;
begin
FBuffer.Empty;
ZeroMemory(@FAddr, SizeOf(FAddr));
FAddr.sin_family := PF_INET;
FRequest := 'GET ' + FPath + ' HTTP/1.1' + CRLF +
            'Host: ' + FHost + ':' + inttostr(FPort) + CRLF +
            'User-Agent: Mozilla/5.0' + CRLF +
            'Accept: */*' + CRLF +
            'Keep-Alive: 300'  + CRLF +
            'Connection: keep-alive';
FRequest := FRequest + CRLF + 'Authorization: Basic ' + EncodeString(FUserName + ':' + FPassword);
FRequest := FRequest + CRLF + CRLF;
FAddr.sin_addr.s_addr := InetAddr(AnsiString(FHost));
FAddr.sin_port := htons(FPort);
FTimeout.tv_sec := 20;
FTimeout.tv_usec := 0;
FSock := -1;
Result := 0;
end;

//------------------------------------------------------------------------------

function THTTPInputThread.SendRequest(ASock: integer; ARequest: String): integer;
var
ReturnCode: integer;
Req: AnsiString;
begin
Req := AnsiString(ARequest);
ReturnCode := send(ASock, Req[1], Length(Req), 0);
if ReturnCode = SOCKET_ERROR then
  begin
    Result := -1;
    SocketDisconnect();
  end
else
  begin
    Result := 0;
  end;
end;

//------------------------------------------------------------------------------

function THTTPInputThread.ReadData(ABuffer: TBuffer; BytesExpected: integer): integer;
const
MaxLen = 262144;
var
TotalBytesToRead, Found, TotalBytesRead, BytesToRead, BytesRead: integer;
Rfds: TFDSet;
TempBuff: array [0..Pred(MaxLen)] of AnsiChar;
begin
FD_ZERO(Rfds);
FD_SET(FSock, Rfds);
Found := select(FSock, @Rfds, nil, nil, @FTimeout);
if Found = 0 then
  begin
    // Select timed out
    Result := -1;
    exit;
  end
else
  if Found = SOCKET_ERROR then
    begin
      // Select error
      Result := -1;
      exit;
    end;
TotalBytesToRead := 0;
if BytesExpected 0 then
  begin
    TotalBytesToRead := BytesExpected;
  end
else
  begin
    if ioctlsocket(FSock, FIONREAD, TotalBytesToRead) = SOCKET_ERROR then
      begin
        // Cannot ioctl()
        Result := -1;
        exit;
      end;
    if TotalBytesToRead = 0  then
      begin
        SocketDisconnect();
        Result := 0;
        exit;
      end;
  end;
TotalBytesRead := 0;
repeat
  if TotalBytesToRead > MaxLen then
    BytesToRead := MaxLen
  else
  BytesToRead := TotalBytesToRead;
  ZeroMemory(@TempBuff[0], MaxLen);
  BytesRead := recv(FSock, TempBuff, BytesToRead, 0);
  if BytesRead = SOCKET_ERROR then
    begin
      // Read error
      SocketDisconnect();
      Result := -1;
      exit;
    end
  else
    if BytesRead = 0 then
      begin
        SocketDisconnect();
        Result := 0;
        exit;
      end
    else
      begin
        // Åñëè áóôåð ñòàë ñëèøêîì áîëüøîé
        if ABuffer.Size >= 2097152 then
          begin
            SocketDisconnect();
            Result := -1;
            exit;
          end;
        ABuffer.Append(@TempBuff[0], BytesRead);
        TotalBytesRead := TotalBytesRead + BytesRead;
        TotalBytesToRead := TotalBytesToRead - BytesRead;

      end;
until TotalBytesToRead

---

3asys   (2012-01-08 16:19:00) [14]

//------------------------------------------------------------------------------

function THTTPInputThread.GetResponse(): integer;
var
StartPtr, EndPtr: PAnsiChar;
BufferLen, Offset: integer;
GotStartMarker: Boolean;
begin
// ÎÁÐÀÁÎÒÊÀ ÀÓÄÈÎ - ÏÎÒÎÊÀ:
If FPath = '/GetAudio' Then
begin
result := -1;
Offset := 0;
GotStartMarker := False;
while (not Terminated) do
  begin
    if (not GotStartMarker) and (FBuffer.Size > 2) then
      begin
        StartPtr := MemStr2(FBuffer.Head, StartJpegMarker, FBuffer.Size);
        if StartPtr nil then
          begin
            FBuffer.Consume(StartPtr - FBuffer.Head);
            GotStartMarker := true;
          end
        else
          FBuffer.Empty;
      end;
    if GotStartMarker and (FBuffer.Size > 2) then
      begin
        EndPtr := MemStr2(FBuffer.Head + Offset, EndJpegMarker, FBuffer.Size - Offset);
        if EndPtr nil then
          begin
            Result := EndPtr - FBuffer.Head + 2;
         //   waveOutWrite(0, Addr(soundTest), FContentLength);
        //    playsound(buf.Memory, 0, SND_MEMORY  or SND_ASYNC); // ÂÎÑÏÐÎÈÇÂÎÄÈÌ ÇÂÓÊ
            result := -1;// ×ÒÎÁÛ ÍÅ ÎÁÐÀÁÀÒÛÂÀËÎÑ&# 220; SendMessage

            exit;
          end
        else
          Offset := FBuffer.Size - 2;
      end;
    BufferLen := ReadData(FBuffer, 0);
    if BufferLen < 0 then
      begin
        result := -1;
        exit;
      end;
  end;
end
else If FPath = '/GetVideo' Then // ÎÁÐÀÁÎÒÊÀ ÂÈÄÅÎ - ÏÎÒÎÊÀ:
begin
result := -1;
Offset := 0;
GotStartMarker := False;
while (not Terminated) do
  begin
    if (not GotStartMarker) and (FBuffer.Size > 2) then
      begin
        StartPtr := MemStr2(FBuffer.Head, StartJpegMarker, FBuffer.Size);
        if StartPtr nil then
          begin
            FBuffer.Consume(StartPtr - FBuffer.Head);
            GotStartMarker := true;
          end
        else
          FBuffer.Empty;
      end;
    if GotStartMarker and (FBuffer.Size > 2) then
      begin
        EndPtr := MemStr2(FBuffer.Head + Offset, EndJpegMarker, FBuffer.Size - Offset);
        if EndPtr nil then
          begin
            Result := EndPtr - FBuffer.Head + 2;
            exit;
          end
        else
          Offset := FBuffer.Size - 2;
      end;
    BufferLen := ReadData(FBuffer, 0);
    if BufferLen < 0 then
      begin
        result := -1;
        exit;
      end;
  end;
end
else
 result:=-1;

end;

//------------------------------------------------------------------------------
type

TFrameData = record
  FrameData: PAnsiChar;
  FrameDataLen: integer;
end;
PFrameData = ^TFrameData;

procedure THTTPInputThread.Execute;
var
FrameData: PFrameData;
Wsa: TWSADATA;
begin
WSAStartUp($0101, Wsa);
try
  while not Terminated do
    try
      Init;
      FSock := SocketConnect();
      if FSock -1 then
        try
          if SendRequest(FSock, FRequest) 0 then exit;
          repeat
            FContentLength := GetResponse;
            if FContentLength > 0 then
              begin
                FrameData := New(PFrameData);
                try
                  FrameData^.FrameData := FBuffer.Extract(FContentLength);
                  FrameData^.FrameDataLen := FContentLength;
                  // Передаем указатель на данные форме клиента:
                  SendMessage(FHandle, FSendNewFrameMessage, 0, Longint(FrameData));
                finally
                  Dispose(FrameData);
                end;
              end;
          until Terminated or (FContentLength = -1);
        finally
          SocketDisconnect;
        end
      else sleep(500);
    except
      sleep(500);
    end;
finally
   WSACleanUp;
end;
end;

end.

И, наконец, отрисовка на форме:

procedure TfVideoClient.WndProc(var Msg: TMessage);
var
 FrameData: PFrameData;
 jpeg : TJPEGImage;
 b : TBitmap;
begin
 if Msg.Msg = FSendNewFrameMessage then
 begin
   FrameData := PFrameData(Msg.Lparam);
   VideoStream.Clear;
   VideoStream.WriteBuffer(FrameData^.FrameData^, FrameData^.FrameDataLen);

   jpeg:=TJPEGImage.Create;
   VideoStream.Position:=0;
   jpeg.LoadFromStream(VideoStream);
   b:=TBitmap.Create;
   b.Assign(jpeg);
   // Подгонка размера формы под размер изображения:
   fVideoClient.Width:=b.Width;
   fVideoClient.Height:=b.Height;
   // Вывод картинки на канву:
   fVideoClient.Canvas.Draw(0,0,b);

   jpeg.Free;
   b.Free;
 end
 else
   inherited;
end;


---

3asys   (2012-01-08 16:17:00) [15]

Теперь работа потока (полный текст unit-а:

unit uClientFunctions;

interface

uses
Windows, Messages, Sysutils, Classes, SyncObjs, Winsock, EncdDecd, mmsystem,

uBuffer;

const
CR = #13;
LF = #10;
CRLF = #13#10;
StartJpegMarker = #255#216;
EndJpegMarker = #255#217;
HttpResponseHeaderDelimiter = '$%#&$';

type

THTTPInputThread = class(TThread)
private
  FHost: String;
  FPort: integer;
  FPath: String;
  FUsername: String;
  FPassword: String;
  FHandle: HWND;
  FSock: integer;
  FAddr: TSockAddr;
  FTimeout: TTimeVal;
  FBuffer: TBuffer;
  FRequest: String;
  FContentLength: integer;
  function SocketConnect: integer;
  function Init: integer;
  function SendRequest(ASock: integer; ARequest: String): integer;
  function ReadData(ABuffer: TBuffer; BytesExpected: integer): integer;
  function GetResponse: integer;
  function SocketDisconnect: integer;
protected
  procedure Execute; override;
public
  constructor Create(AHost: string; APort: integer; APath: string; AUserName: string; APassword: string; AHendle : HWND);
  destructor Destroy;  override;
end;

var
FSendNewFrameMessage: Cardinal; // Äëÿ Win32API

implementation

uses uVideoClient;

function MemStr2(const S, N: PAnsiChar; const Limit: Cardinal): PAnsiChar;
var
I: Cardinal;
pB1, pB2: PAnsiChar;
begin
result := nil;
if (s = nil) or (n = nil) then exit;
if limit < 2 then exit;
pB1 := S; pB2 := N;
for I := 0 to Limit - 2 do
  if (pB1^ = pB2^) and ((pB1 + 1)^ = (pB2 + 1)^) then
    begin
      result := pB1;
      exit;
    end
  else
    inc(pB1);
end;

//------------------------------------------------------------------------------

constructor THTTPInputThread.Create(AHost: string; APort: integer;
                                  APath: string; AUserName: string; APassword: string; AHendle : HWND);
begin
inherited Create(true);
FHost := AHost;
FPort := APort;
FPath := APath;
FUserName := AUserName;
FPassword := APassword;
FHandle := AHendle;
FBuffer := TBuffer.Create(0);
Resume;
FSendNewFrameMessage := RegisterWindowMessage('WM_NEW_FRAME');
end;

//------------------------------------------------------------------------------

destructor THTTPInputThread.Destroy;
begin
FBuffer.Free;
inherited Destroy;
end;

//------------------------------------------------------------------------------

function THTTPInputThread.SocketConnect: integer;
var
NoBlock: integer;
Wfd, EFd: TFDSet;
TimeVal: TTimeVal;
begin

Result := socket(AF_INET, SOCK_STREAM, 0);
if Result = INVALID_SOCKET then
  begin
    Result := -1;
    exit;
  end;

NoBlock := 1;
if ioctlsocket(Result, FIONBIO, NoBlock) = SOCKET_ERROR then
  begin
    CloseSocket(Result);
    Result := -1;
    exit;
  end;

if Connect(Result, FAddr, SizeOf(FAddr)) = SOCKET_ERROR then
  begin  
    if WSAGetLastError =  WSAEWOULDBLOCK then
      begin
        while not Terminated do
          begin
            FD_ZERO(wfd);
            FD_SET(result, wfd);

            FD_ZERO(efd);
            FD_SET(result, efd);

            TimeVal.tv_sec := 0;
            TimeVal.tv_usec := 100;

            case select(0, nil, @wfd, @efd, @TimeVal) of
              0: sleep(50);
              1: if FD_ISSET(Result, wfd) then
                   break
                 else
                   if FD_ISSET(Result, efd) then
                     begin  
                       NoBlock := 0;
                       ioctlsocket(Result, FIONBIO, NoBlock);
                       CloseSocket(Result);
                       Result := -1;
                       exit;
                     end;
              SOCKET_ERROR:
                begin
                  NoBlock := 0;
                  ioctlsocket(Result, FIONBIO, NoBlock);
                  CloseSocket(Result);
                  Result := -1;
                  exit
                end;
            end;
          end;
       end
     else
       begin
         NoBlock := 0;
         ioctlsocket(Result, FIONBIO, NoBlock);
         CloseSocket(Result);
         Result := -1;
       end;
  end;

// Âîçâðàò â áëîêèðóþùèé ðåæèì
NoBlock := 0;
if ioctlsocket(Result, FIONBIO, NoBlock) = SOCKET_ERROR then
  begin
    CloseSocket(Result);
    Result := -1;
  end;
end;

//------------------------------------------------------------------------------

function THTTPInputThread.SocketDisconnect(): integer;
begin
if FSock -1 then
  begin
    ShutDown(FSock, SD_BOTH);
    CloseSocket(FSock);
    FSock := -1;
  end;
Result := 0;
end;

//------------------------------------------------------------------------------

---

3asys   (2012-01-08 16:14:00) [16]

Переписал. Теперь SendMessage передает окну с нужным handle, но трансляция не происходит :(  Что здесь может быть?
На всякий случай привожу полный код:
Запуск показа видеотрансляции:

procedure TfMain.N2Click(Sender: TObject);
var
 host, username : String;
 port : Integer;
begin
 host:=dmData.sp_UserList.Fields.fieldByName('user_ip').AsString;
 port:=Port_Video;
 username:=dmData.sp_UserList.Fields.fieldByName('user_name').AsString;
 fVideoClient.CreateNewUserTranslation(host, port, username);
end;

Создание окна и запуск видеотрансляции

procedure TfVideoClient.CreateNewUserTranslation(Host : String; Port : Integer; UserName : String);
var
 NewClntTransl : TfVideoClient;
begin
 NewClntTransl:=TfVideoClient.Create(fVideoClient);
 NewClntTransl.Host:=Host;
 NewClntTransl.Port := Port;
 NewClntTransl.Caption:=UserName;
 VideoThread := THTTPInputThread.Create(Host, Port, VideoPath, UserName, Password, NewClntTransl.Handle);
 AudioThread := THTTPInputThread.Create(Host, Port, AudioPath, UserName, Password, NewClntTransl.Handle);
 NewClntTransl.Show;
end;


---

DVM   (2012-01-08 15:37:00) [17]

> Как, если это так, передать Handle?

в конструктор потока, там где то выше вроде даже было так в коде

---

3asys   (2012-01-08 14:28:00) [18]

> DVM ©  

> 1) Отладчиком посмотри, на строку
>
> VideoThread := THTTPInputThread.Create(Host, Port, VideoPath,
>  UserName, Password);
>
> ты попадаешь вообще?

Да, строка инициализируется нормально, все параметры правильные.

> 2) Какому окну шлются сообщения о приходе новых кадров?
>
> Т.е. как THTTPInputThread узнает куда ему слать сообщения?
>

Кажется Вы правы, сообщения отправляются SendMessage:

SendMessage(fVideoClient.Handle, FSendNewFrameMessage, 0, Longint(FrameData));

т.е. идут к fVideoClient, а, по идее, должны отправляться NewClntTransl, который создается в run-time.
Код приема сообщения формы fVideoClient полностью отрабатывается.Весь цикл проходится до самого конца, но картинка не появляется.
Действительно в этой строчке ошибка?
Как, если это так, передать Handle?

---

DVM   (2012-01-08 12:35:00) [19]

> 3asys ©   (07.01.12 16:20) [168]

1) Отладчиком посмотри, на строку

VideoThread := THTTPInputThread.Create(Host, Port, VideoPath, UserName, Password);

ты попадаешь вообще?

2) Какому окну шлются сообщения о приходе новых кадров?

Т.е. как THTTPInputThread узнает куда ему слать сообщения?

---

3asys   (2012-01-07 16:20:00) [20]

> DVM ©
Добрый день,
не могли бы Вы подсказать:
создаю экземпляр клиента видеотрансляции:

procedure CreateNewUserTranslation(Host : String; Port : Integer; UserName : String);
var
 NewClntTransl : TfVideoClient;
begin
 NewClntTransl:=TfVideoClient.Create(fVideoClient);
 NewClntTransl.Host:=Host;
 NewClntTransl.Port := Port;
 NewClntTransl.Caption:=UserName;
 NewClntTransl.Show;
 NewClntTransl.StartTranslation(NewClntTransl);
end;

где StartTranslation(NewClntTransl)

procedure TfVideoClient.StartTranslation(Sender: TObject);
begin
 VideoThread := THTTPInputThread.Create(Host, Port, VideoPath, UserName, Password);
 AudioThread := THTTPInputThread.Create(Host, Port, AudioPath, UserName, Password);
end;

а дальше все, как в Вашем примере.
Форма создается, а трансляция не начинается. При этом, если вызываю StartTranslation напрямую (без создания формы), то все отлично работает.
Поскольку Вы единственный, кроме меня, кто представляет код клиента, не могли бы Вы подсказать, как следует создавать экземпляр клиента для получения на этом экземпляре трансляции?

---

Страницы:   < 1 2 3 4 5 6 7 8 9 10 >

Наверх