Экспертная система Delphi.int.ru

Сообщество программистов
Общение, помощь, обмен опытом
Логин:
Пароль:
Регистрация | Забыли пароль?

Delphi.int.ru Expert

Другие разделы портала

Переход к вопросу:

#   

Статистика за сегодня:  


Лучшие эксперты

Подробнее »

Вопрос # 2 018

Раздел: Delphi » Мультимедийные приложения
/ вопрос открыт /

Доброго времени суток, уважаемые эксперты!
Вопрос такой! Хочу написать видео чат для локальной сети. Каким образом получить список видеоустройств, установленных в системе? Чтобы пользователь мог выбрать, чем ему воспользоваться в данный момент. Ну например вместо вебкамеры запустить видеопоток с ТВтюнера в канал.

Приложение:
  1. BDS2006


Nasgool Вопрос ожидает решения (принимаются ответы, доступен мини-форум)

Вопрос задал: Nasgool (статус: 2-ой класс)
Вопрос отправлен: 24 октября 2008, 03:22
Состояние вопроса: открыт, ответов: 1.

Ответ #1. Отвечает эксперт: Feniks

Здравствуйте, Nasgool!
Я нашел пример "Как получить картинку с видео источника". Он в приложении. Возможно он вас наталкнет на путь истенный. :-)
А так же советую ознакомится вот с этими статьями:
1. Получение и установка видеорежимов в Windows;
2. Работа с устройствами в Windows;
3. Интерфейсы DirectDraw и DirectDraw2;
4. Первые шаги с DirectShow. Шаг 5. DSPack (Delphi).
И собственно сам DSPack - компонент-обертка над DirectShow.

P.S. Желаю удачи.

Приложение:
  1.  
  2.  
  3.  
  4. unit Unit1;
  5.  
  6. interface
  7.  
  8. uses
  9. Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  10. Dialogs, ExtCtrls, StdCtrls;
  11.  
  12. type
  13. TForm1 = class(TForm)
  14. Panel1: TPanel;
  15. OpenVideo: TButton;
  16. CloseVideo: TButton;
  17. GrabFrame: TButton;
  18. SaveBMP: TButton;
  19. StartAVI: TButton;
  20. StopAVI: TButton;
  21. SaveDialog1: TSaveDialog;
  22. procedure FormCreate(Sender: TObject);
  23. procedure OpenVideoClick(Sender: TObject);
  24. procedure CloseVideoClick(Sender: TObject);
  25. procedure GrabFrameClick(Sender: TObject);
  26. procedure SaveBMPClick(Sender: TObject);
  27. procedure StartAVIClick(Sender: TObject);
  28. procedure StopAVIClick(Sender: TObject);
  29. private
  30. { Private declarations }
  31. hWndC : THandle;
  32. CapturingAVI : bool;
  33. public
  34. { Public declarations }
  35. end;
  36.  
  37. var
  38. Form1: TForm1;
  39.  
  40. implementation
  41.  
  42. {$R *.DFM}
  43.  
  44. const WM_CAP_START = WM_USER;
  45. const WM_CAP_STOP = WM_CAP_START + 68;
  46. const WM_CAP_DRIVER_CONNECT = WM_CAP_START + 10;
  47. const WM_CAP_DRIVER_DISCONNECT = WM_CAP_START + 11;
  48. const WM_CAP_SAVEDIB = WM_CAP_START + 25;
  49. const WM_CAP_GRAB_FRAME = WM_CAP_START + 60;
  50. const WM_CAP_SEQUENCE = WM_CAP_START + 62;
  51. const WM_CAP_FILE_SET_CAPTURE_FILEA = WM_CAP_START + 20;
  52.  
  53. function capCreateCaptureWindowA(lpszWindowName : PCHAR;
  54. dwStyle : longint;
  55. x : integer;
  56. y : integer;
  57. nWidth : integer;
  58. nHeight : integer;
  59. ParentWin : HWND;
  60. nId : integer): HWND;
  61. STDCALL EXTERNAL 'AVICAP32.DLL';
  62.  
  63. procedure TForm1.FormCreate(Sender: TObject);
  64. begin
  65. CapturingAVI := false;
  66. hWndC := 0;
  67. SaveDialog1.Options :=
  68. [ofHideReadOnly, ofNoChangeDir, ofPathMustExist]
  69. end;
  70.  
  71. procedure TForm1.OpenVideoClick(Sender: TObject);
  72. begin
  73. hWndC := capCreateCaptureWindowA('My Own Capture Window',
  74. WS_CHILD or WS_VISIBLE ,
  75. Panel1.Left,
  76. Panel1.Top,
  77. Panel1.Width,
  78. Panel1.Height,
  79. Form1.Handle,
  80. 0);
  81. if hWndC <> 0 then
  82. SendMessage(hWndC, WM_CAP_DRIVER_CONNECT, 0, 0);
  83. end;
  84.  
  85. procedure TForm1.CloseVideoClick(Sender: TObject);
  86. begin
  87. if hWndC <> 0 then begin
  88. SendMessage(hWndC, WM_CAP_DRIVER_DISCONNECT, 0, 0);
  89. hWndC := 0;
  90. end;
  91. end;
  92.  
  93. procedure TForm1.GrabFrameClick(Sender: TObject);
  94. begin
  95. if hWndC <> 0 then
  96. SendMessage(hWndC, WM_CAP_GRAB_FRAME, 0, 0);
  97. end;
  98.  
  99. procedure TForm1.SaveBMPClick(Sender: TObject);
  100. begin
  101. if hWndC <> 0 then begin
  102. SaveDialog1.DefaultExt := 'bmp';
  103. SaveDialog1.Filter := 'Bitmap files (*.bmp)|*.bmp';
  104. if SaveDialog1.Execute then
  105. SendMessage(hWndC,
  106. WM_CAP_SAVEDIB,
  107. 0,
  108. longint(pchar(SaveDialog1.FileName)));
  109. end;
  110. end;
  111.  
  112. procedure TForm1.StartAVIClick(Sender: TObject);
  113. begin
  114. if hWndC <> 0 then begin
  115. SaveDialog1.DefaultExt := 'avi';
  116. SaveDialog1.Filter := 'AVI files (*.avi)|*.avi';
  117. if SaveDialog1.Execute then begin
  118. CapturingAVI := true;
  119. SendMessage(hWndC,
  120. WM_CAP_FILE_SET_CAPTURE_FILEA,
  121. 0,
  122. Longint(pchar(SaveDialog1.FileName)));
  123. SendMessage(hWndC, WM_CAP_SEQUENCE, 0, 0);
  124. end;
  125. end;
  126. end;
  127.  
  128. procedure TForm1.StopAVIClick(Sender: TObject);
  129. begin
  130. if hWndC <> 0 then begin
  131. SendMessage(hWndC, WM_CAP_STOP, 0, 0);
  132. CapturingAVI := false;
  133. end;
  134. end;
  135.  
  136. end.


Ответ отправил: Feniks (статус: Бакалавр)
Время отправки: 24 октября 2008, 13:11


Мини-форум вопроса

Мини-форум пуст.

Чтобы оставлять сообщения в мини-форумах, Вы должны авторизироваться на сайте.
Версия движка: 2.6+ (26.01.2011)
© 2005-2025
Текущее время: 22 февраля 2025, 11:58
Выполнено за 0.02 сек.