main.pas 1.8 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778
  1. unit main;
  2. interface
  3. uses
  4. Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  5. Dialogs, DSUtil, StdCtrls, DSPack, DirectShow9, Menus, ExtCtrls;
  6. type
  7. TVideoForm = class(TForm)
  8. FilterGraph: TFilterGraph;
  9. MainMenu1: TMainMenu;
  10. Devices: TMenuItem;
  11. OpenDialog: TOpenDialog;
  12. Filter: TFilter;
  13. ASFWriter: TASFWriter;
  14. VideoWindow: TVideoWindow;
  15. procedure FormCreate(Sender: TObject);
  16. procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  17. private
  18. { Déclarations privées }
  19. public
  20. { Déclarations publiques }
  21. procedure OnSelectDevice(sender: TObject);
  22. end;
  23. var
  24. VideoForm: TVideoForm;
  25. SysDev: TSysDevEnum;
  26. implementation
  27. uses Math;
  28. {$R *.dfm}
  29. procedure TVideoForm.FormCreate(Sender: TObject);
  30. var
  31. i: integer;
  32. Device: TMenuItem;
  33. begin
  34. SysDev:= TSysDevEnum.Create(CLSID_VideoInputDeviceCategory);
  35. if SysDev.CountFilters > 0 then
  36. for i := 0 to SysDev.CountFilters - 1 do
  37. begin
  38. Device := TMenuItem.Create(Devices);
  39. Device.Caption := SysDev.Filters[i].FriendlyName;
  40. Device.Tag := i;
  41. Device.OnClick := OnSelectDevice;
  42. Devices.Add(Device);
  43. end;
  44. end;
  45. procedure TVideoForm.OnSelectDevice(sender: TObject);
  46. begin
  47. FilterGraph.ClearGraph;
  48. FilterGraph.Active := false;
  49. Filter.BaseFilter.Moniker := SysDev.GetMoniker(TMenuItem(Sender).tag);
  50. FilterGraph.Active := true;
  51. with FilterGraph as ICaptureGraphBuilder2 do
  52. begin
  53. CheckDSError(RenderStream(@PIN_CATEGORY_CAPTURE , nil, Filter as IBaseFilter, nil, ASFWriter as IbaseFilter));
  54. CheckDSError(RenderStream(@PIN_CATEGORY_PREVIEW , nil, Filter as IBaseFilter, nil, VideoWindow as IbaseFilter));
  55. end;
  56. FilterGraph.Play;
  57. end;
  58. procedure TVideoForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  59. begin
  60. SysDev.Free;
  61. FilterGraph.ClearGraph;
  62. FilterGraph.Active := false;
  63. end;
  64. end.