1. Jalankan
Delphi.
2. Tambahkan
komponen ListBox1 , ListBox2 , ListBox3 , ListBox4 , ComboBox1
, FilterGraph1 , VideoWindow1 , SaveDialog1 ,
Filter1 , Timer1 , StatusBar1 , Button1 , Button2 , dan
Button3 pada Form1.
3. Atur
properti berbagai komponen di atas, sebagai :
5. Klik
2x pada Form1, lalu tuliskan
procedure TForm1.FormCreate(Sender: TObject);
var i: integer;
begin
CapEnum := TSysDevEnum.Create(CLSID_VideoInputDeviceCategory);
for i := 0 to CapEnum.CountFilters - 1 do
ListBox1.Items.Add(CapEnum.Filters[i].FriendlyName);
CapEnum.SelectGUIDCategory(CLSID_AudioInputDeviceCategory);
for i := 0 to CapEnum.CountFilters - 1 do
ListBox3.Items.Add(CapEnum.Filters[i].FriendlyName);
VideoMediaTypes := TEnumMediaType.Create;
AudioMediaTypes := TEnumMediaType.Create;
end;
6. Klik
2x pada ListBox1, lalu tuliskan kode berikut :
procedure TForm1.ListBox1Click(Sender: TObject);
var
PinList: TPinList;
i: integer;
begin
CapEnum.SelectGUIDCategory(CLSID_VideoInputDeviceCategory);
if ListBox1.ItemIndex <> -1 then
begin
Filter1.BaseFilter.Moniker :=
CapEnum.GetMoniker(ListBox1.ItemIndex);
Filter1.FilterGraph := FilterGraph1;
FilterGraph1.Active := true;
PinList := TPinList.Create(Filter1 as IBaseFilter);
ListBox2.Clear;
VideoMediaTypes.Assign(PinList.First);
for i := 0 to VideoMediaTypes.Count - 1 do
ListBox2.Items.Add(VideoMediaTypes.MediaDescription[i]);
FilterGraph1.Active := false;
PinList.Free;
Button1.Enabled := true;
end;
end;
7. Klik
2x pada ListBox3, lalu tuliskan kode berikut :
procedure TForm1.ListBox3Click(Sender: TObject);
var
PinList: TPinList;
i, LineIndex: integer;
ABool: LongBool;
begin
CapEnum.SelectGUIDCategory(CLSID_AudioInputDeviceCategory);
if ListBox3.ItemIndex <> -1 then
begin
Filter2.BaseFilter.Moniker :=
CapEnum.GetMoniker(ListBox3.ItemIndex);
Filter2.FilterGraph := FilterGraph1;
FilterGraph1.Active := true;
PinList := TPinList.Create(Filter2 as IBaseFilter);
ListBox4.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
ListBox4.Items.Add(AudioMediaTypes.MediaDescription[i]);
end;
FilterGraph1.Active := false;
ComboBox1.Clear;
LineIndex := -1;
for i := 0 to PinList.Count - 1 do
begin
ComboBox1.Items.Add(PinList.PinInfo[i].achName);
with (PinList.Items[i] as
IAMAudioInputMixer) do
get_Enable(ABool);
if ABool then LineIndex := i;
end;
ComboBox1.ItemIndex := LineIndex;
PinList.Free;
Button1.Enabled := true;
end;
end;
8. Klik 2x pada Button1, lalu tuliskan kode berikut :
procedure TForm1.Button1Click(Sender: TObject);
begin
if SaveDialog1.Execute then
begin
CapFile := SaveDialog1.FileName;
end;
end;
9. Klik
2x pada Button2, lalu tuliskan kode berikut :
procedure TForm1.Button2Click(Sender: TObject);
var
multiplexer: IBaseFilter;
Writer: IFileSinkFilter;
PinList: TPinList;
i: integer;
begin
FilterGraph1.Active := true;
if Filter2.FilterGraph <> nil then
begin
PinList := TPinList.Create(Filter2 as IBaseFilter);
i := 0;
while i < PinList.Count do
if PinList.PinInfo[i].dir = PINDIR_OUTPUT
then
begin
if
ListBox4.ItemIndex <> -1 then
with
(PinList.Items[i] as IAMStreamConfig) do
SetFormat(AudioMediaTypes.Items[ListBox4.ItemIndex].AMMediaType^);
PinList.Delete(i);
end else inc(i);
if ComboBox1.ItemIndex <> -1 then
with (PinList.Items[ComboBox1.ItemIndex] as
IAMAudioInputMixer) do
put_Enable(true);
PinList.Free;
end;
if Filter1.FilterGraph <> nil then
begin
PinList := TPinList.Create(Filter1 as IBaseFilter);
if ListBox2.ItemIndex <> -1 then
with (PinList.First as IAMStreamConfig) do
SetFormat(VideoMediaTypes.Items[ListBox2.ItemIndex].AMMediaType^);
PinList.Free;
end;
with FilterGraph1 as IcaptureGraphBuilder2 do
begin
SetOutputFileName(MEDIASUBTYPE_Avi, PWideChar(CapFile),
multiplexer, Writer);
if Filter1.BaseFilter.DataLength > 0 then
RenderStream(@PIN_CATEGORY_PREVIEW, nil, Filter1 as
IBaseFilter, nil , VideoWindow1 as IBaseFilter);
if Filter1.FilterGraph <> nil then
RenderStream(@PIN_CATEGORY_CAPTURE, nil, Filter1 as
IBaseFilter, nil, multiplexer as IBaseFilter);
if Filter2.FilterGraph <> nil then
begin
RenderStream(nil, nil, Filter2
as IBaseFilter,
nil, multiplexer as
IBaseFilter);
end;
end;
FilterGraph1.Play;
Button3.Enabled := true;
Button2.Enabled := false;
ListBox4.Enabled := false;
ListBox3.Enabled := false;
ListBox2.Enabled := false;
ListBox1.Enabled := false;
Timer1.Enabled := true;
end;
10. Klik
2x pada Button3, lalu tuliskan kode berikut :
procedure TForm1.Button3Click(Sender: TObject);
begin
Timer1.Enabled := false;
Button3.Enabled := false;
Button2.Enabled := true;
FilterGraph1.Stop;
FilterGraph1.Active := False;
ListBox4.Enabled := true;
ListBox3.Enabled := true;
ListBox2.Enabled := true;
ListBox1.Enabled := true;
end;
11. Klik
2x pada Timer1, lalu tuliskan kode berikut :
procedure TForm1.Timer1Timer(Sender: TObject);
var
position: int64;
Hour, Min, Sec, MSec: Word;
const MiliSecInOneDay = 86400000;
begin
if FilterGraph1.Active then
begin
with FilterGraph1 as IMediaSeeking do
GetCurrentPosition(position);
DecodeTime(position div 10000 / MiliSecInOneDay, Hour,
Min, Sec, MSec);
StatusBar1.SimpleText :=
Format('%d:%d:%d:%d',[Hour, Min, Sec, MSec]);
end;
end;
12. Klik
1x pada Form1, klik tab Events dalam Object Inspector, lalu
klik 2x pada sel di sebelah item OnDestroy, dan tuliskan kode
berikut :
procedure TForm1.FormDestroy(Sender: TObject);
begin
CapEnum.Free;
VideoMediaTypes.Free;
AudioMediaTypes.Free;
end;
