unit main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, DSPack, DSUtil, DirectShow9, ComCtrls, ExtCtrls,
Buttons;
type
TMainForm =
class(TForm)
CaptureGraph: TFilterGraph;
VideoWindow: TVideoWindow;
VideoCapFilters: TListBox;
VideoSourceFilter: TFilter;
StartButton: TButton;
StatusBar: TStatusBar;
Timer: TTimer;
StopButton: TButton;
AudioCapFilters: TListBox;
AudioSourceFilter: TFilter;
Label1: TLabel;
VideoFormats: TListBox;
AudioFormats: TListBox;
Label3: TLabel;
InputLines: TComboBox;
Image: TImage;
SpeedButton1: TSpeedButton;
SampleGrabber1: TSampleGrabber;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure VideoCapFiltersClick(Sender: TObject);
procedure StartButtonClick(Sender: TObject);
procedure StopButtonClick(Sender: TObject);
procedure AudioCapFiltersClick(Sender: TObject);
procedure VideoWindowMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure SpeedButton1Click(Sender: TObject);
procedure SampleGrabber1Buffer(sender: TObject; SampleTime: Double;
pBuffer: Pointer; BufferLen: Integer);
private
{ Private declarations }
public
{ Public declarations }
end;
var
MainForm: TMainForm;
CapEnum: TSysDevEnum;
VideoMediaTypes, AudioMediaTypes: TEnumMediaType;
implementation
{$R *.dfm}
procedure TMainForm.FormCreate(Sender: TObject);
var i: integer;
begin
CapEnum := TSysDevEnum.Create(CLSID_VideoInputDeviceCategory);
for i := 0
to CapEnum.CountFilters - 1
do
VideoCapFilters.Items.Add(CapEnum.Filters[i].FriendlyName);
CapEnum.SelectGUIDCategory(CLSID_AudioInputDeviceCategory);
for i := 0
to CapEnum.CountFilters - 1
do
AudioCapFilters.Items.Add(CapEnum.Filters[i].FriendlyName);
VideoMediaTypes := TEnumMediaType.Create;
AudioMediaTypes := TEnumMediaType.Create;
end;
// Fenster schließen
procedure TMainForm.FormDestroy(Sender: TObject);
begin
CapEnum.Free;
VideoMediaTypes.Free;
AudioMediaTypes.Free;
end;
// Select the video Source
procedure TMainForm.VideoCapFiltersClick(Sender: TObject);
var
PinList: TPinList;
i: integer;
begin
CapEnum.SelectGUIDCategory(CLSID_VideoInputDeviceCategory);
if VideoCapFilters.ItemIndex <> -1
then
begin
VideoSourceFilter.BaseFilter.Moniker := CapEnum.GetMoniker(VideoCapFilters.ItemIndex);
VideoSourceFilter.FilterGraph := CaptureGraph;
CaptureGraph.Active := true;
PinList := TPinList.Create(VideoSourceFilter
as IBaseFilter);
VideoFormats.Clear;
VideoMediaTypes.Assign(PinList.First);
for i := 0
to VideoMediaTypes.Count - 1
do
VideoFormats.Items.Add(VideoMediaTypes.MediaDescription[i]);
CaptureGraph.Active := false;
PinList.Free;
StartButton.Enabled := true;
end;
end;
// Select the audio Source
procedure TMainForm.AudioCapFiltersClick(Sender: TObject);
var
PinList: TPinList;
i, LineIndex: integer;
ABool: LongBool;
begin
CapEnum.SelectGUIDCategory(CLSID_AudioInputDeviceCategory);
if AudioCapFilters.ItemIndex <> -1
then
begin
AudioSourceFilter.BaseFilter.Moniker := CapEnum.GetMoniker(AudioCapFilters.ItemIndex);
AudioSourceFilter.FilterGraph := CaptureGraph;
CaptureGraph.Active := true;
PinList := TPinList.Create(AudioSourceFilter
as IBaseFilter);
AudioFormats.Clear;
i := 0;
while i < PinList.Count
do
if PinList.PinInfo[i].dir = PINDIR_OUTPUT
then
begin
AudioMediaTypes.Assign(PinList.Items[i]);
PinList.Delete(i);
end else inc(i);
for i := 0
to AudioMediaTypes.Count - 1
do
begin
AudioFormats.Items.Add(AudioMediaTypes.MediaDescription[i]);
end;
CaptureGraph.Active := false;
InputLines.Clear;
LineIndex := -1;
for i := 0
to PinList.Count - 1
do
begin
InputLines.Items.Add(PinList.PinInfo[i].achName);
with (PinList.Items[i]
as IAMAudioInputMixer)
do get_Enable(ABool);
if ABool
then LineIndex := i;
end;
InputLines.ItemIndex := LineIndex;
PinList.Free;
StartButton.Enabled := true;
end;
end;
// Start Capture
procedure TMainForm.StartButtonClick(Sender: TObject);
var
multiplexer: IBaseFilter;
Writer: IFileSinkFilter;
PinList: TPinList;
i: integer;
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;
// configure output Video media type
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
if VideoSourceFilter.BaseFilter.DataLength > 0
then
RenderStream(@PIN_CATEGORY_PREVIEW,
nil, VideoSourceFilter
as IBaseFilter,
nil , VideoWindow
as IBaseFilter);
end;
CaptureGraph.Play;
StopButton.Enabled := true;
StartButton.Enabled := false;
AudioFormats.Enabled := false;
AudioCapFilters.Enabled := false;
VideoFormats.Enabled := false;
VideoCapFilters.Enabled := false;
Timer.Enabled := true;
end;
// Stop Capture
procedure TMainForm.StopButtonClick(Sender: TObject);
begin
Timer.Enabled := false;
StopButton.Enabled := false;
StartButton.Enabled := true;
CaptureGraph.Stop;
CaptureGraph.Active := False;
AudioFormats.Enabled := true;
AudioCapFilters.Enabled := true;
VideoFormats.Enabled := true;
VideoCapFilters.Enabled := true;
end;
// Drag and Drop aktivieren
procedure TMainForm.VideoWindowMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
videowindow.BeginDrag(true);
end;
// test: aufs canvas von TVideoWindow zugreifen
procedure SaveCanvas(SaveCanvas: TCanvas; FileName:
string);
var
Bmp: TBitmap;
MyRect: TRect;
begin
Bmp:= TBitmap.Create;
try
MyRect := SaveCanvas.ClipRect;
Bmp.Width := MyRect.Right - MyRect.Left;
Bmp.Height := MyRect.Bottom - MyRect.Top;
Bmp.Canvas.CopyRect(MyRect, SaveCanvas, MyRect);
Bmp.SaveToFile(FileName);
finally
FreeAndNil(Bmp);
end;
end;
// Bild holen
procedure TMainForm.SpeedButton1Click(Sender: TObject);
begin
SampleGrabber1.GetBitmap(Image.Picture.Bitmap);
end;
// Wenn holen, dann speichern
procedure TMainForm.SampleGrabber1Buffer(sender: TObject;
SampleTime: Double; pBuffer: Pointer; BufferLen: Integer);
begin
Image.Canvas.Lock;
// to avoid flickering
try
SampleGrabber1.GetBitmap(Image.Picture.Bitmap, pBuffer, BufferLen);
Image.Picture.Bitmap.SaveToFile('
c:\testbitmap.bmp');
finally
Image.Canvas.Unlock;
end;
end;
// Ende Gelände
end.