Delphi控件源码

开发平台：
Delphi

AVSetFrm.pas：源码内容
							unit AVSetFrm;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, Buttons, Videocap, MMObj, MMSlider, MMMixCtl,
  MMDIBCv, MMLevel,DSUtil,DirectShow9, MMDevice, MMMixer, MMHook, MMDesign,
  MMDSPObj, MMWavOut, MMWave, MMConect, MMWavIn, MMRingBf,MMSystem,Registry;
type
  TAVSetForm = class(TForm)
    Image1: TImage;
    Bevel1: TBevel;
    BTPrev: TBitBtn;
    BTNext: TBitBtn;
    BTCancel: TBitBtn;
    Notebook1: TNotebook;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    CBCamera: TComboBox;
    Label8: TLabel;
    Panel1: TPanel;
    VideoCap: TVideoCap;
    Label9: TLabel;
    Label10: TLabel;
    Label11: TLabel;
    Label12: TLabel;
    Label13: TLabel;
    Label14: TLabel;
    Label15: TLabel;
    CBMic: TComboBox;
    CBSpeaker: TComboBox;
    Label16: TLabel;
    Label17: TLabel;
    BTTestSpeaker: TButton;
    GroupBox1: TGroupBox;
    MMMixerSlider1: TMMMixerSlider;
    Label18: TLabel;
    Label19: TLabel;
    GroupBox2: TGroupBox;
    MMMixerSlider2: TMMMixerSlider;
    MMLevel: TMMLevel;
    Label20: TLabel;
    Label21: TLabel;
    Label22: TLabel;
    MMDesigner1: TMMDesigner;
    MMWaveFile: TMMWaveFile;
    MMWaveOut: TMMWaveOut;
    MMConnector1: TMMConnector;
    MMDevice: TMMMixerDevice;
    MMAudioLine3: TMMAudioLine;
    MMAudioLine1: TMMAudioLine;
    MMVolumeControl2: TMMVolumeControl;
    MMAudioLine2: TMMAudioLine;
    MMVolumeControl1: TMMVolumeControl;
    MMWaveIn: TMMWaveIn;
    MMRingBuffer1: TMMRingBuffer;
    MMWaveOut1: TMMWaveOut;
    procedure BTNextClick(Sender: TObject);
    procedure BTPrevClick(Sender: TObject);
    procedure BTCancelClick(Sender: TObject);
    procedure BTTestSpeakerClick(Sender: TObject);
    procedure MMWaveOutStart(Sender: TObject);
    procedure MMWaveOutStop(Sender: TObject);
    procedure MMWaveInBufferReady(Sender: TObject; lpWaveHdr: PWaveHdr);
  private
    procedure CheckBTState;
  public
    { Public declarations }
  end;
var
  AVSetForm: TAVSetForm;
implementation
uses
  RealMessengerUnit;
  
{$R *.dfm}
procedure TAVSetForm.CheckBTState;
var
  SysDev: TSysDevEnum;
  iLoop:Integer;
begin
  BTPrev.Enabled:=NoteBook1.PageIndex>0;
  BTNext.Enabled:=NoteBook1.PageIndex<NoteBook1.Pages.Count-1;
  case NoteBook1.PageIndex of
    1:begin
        if VideoCap.DriverOpen then
        begin
          VideoCap.VideoPreview:=False;
          VideoCap.StopCapture;
        end;
        SysDev:= TSysDevEnum.Create(CLSID_VideoInputDeviceCategory);
        if SysDev.CountFilters=0 then
        begin
          MessageBox(Handle,'没有在您的机器上检测到任何视频捕获设备！','提示',MB_ICONINFORMATION);
          NoteBook1.PageIndex:=3;
          CheckBTState;
          exit;
        end;
        CBCamera.Clear;
        for iLoop:=0 to SysDev.CountFilters-1 do
        begin
          CBCamera.Items.Add(SysDev.Filters[iLoop].FriendlyName);
        end;
        CBCamera.ItemIndex:=0;
        SysDev.Free;        
      end;
    2:begin
        VideoCap.DriverIndex:=CBCamera.ItemIndex;
        VideoCap.VideoPreview:=True;
        FillBitmapStruc;
        VideoCap.SetBitmapInfo(@FInInfo,SizeOf(BITMAPINFO));
        VideoCap.StartCapture;
      end;
    3:begin
        if VideoCap.DriverOpen then
        begin
          VideoCap.VideoPreview:=False;
          VideoCap.StopCapture;
        end;
      end;
    4:begin
        try
          MMWaveOut.Stop;
          MMWaveOut.Close;
        except
        end;
        if MMDevice.DeviceCount=0 then
        begin
          MessageBox(Handle,'没有在您的机器上检测到任何声音设备！','提示',MB_ICONINFORMATION);
          NoteBook1.PageIndex:=7;
          CheckBTState;
          exit;
        end;
        MMDevice.GetDeviceList(CBMic.Items,True);
        MMDevice.GetDeviceList(CBSpeaker.Items,True);
        CBMic.ItemIndex:=0;
        CBSpeaker.ItemIndex:=0;
      end;
    5:begin
        try
          MMWaveIn.Stop;
          MMWaveIn.Close;
        except
        end;
        MMDevice.DeviceID:=CBSpeaker.ItemIndex;
        MMWaveOut.DeviceID:=CBSpeaker.ItemIndex;
        MMWaveIn.DeviceID:=CBMic.ItemIndex;
      end;
    6:begin
        try
          MMWaveOut.Stop;
          MMWaveOut.Close;
        except
        end;
        BTNext.Caption:='下一步(&N)';
        MMDevice.DeviceID:=CBMic.ItemIndex;
        MMWaveOut1.DeviceID:=CBSpeaker.ItemIndex;
        MMWaveIn.DeviceID:=CBMic.ItemIndex;
        MMWaveIn.Start;
        MMWaveOut1.PWaveFormat:=MMWaveIn.PWaveFormat;
        MMWaveOut1.Start;
      end;
    7:begin
        try
          MMWaveIn.Stop;
          MMWaveIn.Close;
        except
        end;
        BTNext.Caption:='完成';
        BTNext.Enabled:=True;
      end;
  end;
end;
procedure TAVSetForm.BTNextClick(Sender: TObject);
var
  TempReg:TRegistry;
begin
  if NoteBook1.PageIndex=7 then
  begin
    TempReg:=TRegistry.Create;
    try
      TempReg.RootKey:=HKEY_LOCAL_MACHINE;
      if TempReg.OpenKey(AppKey+'AV', True) then
      begin
        if (CBCamera.ItemIndex>=0) and (CBCamera.ItemIndex<CBCamera.Items.Count) then TempReg.WriteInteger('VideoDevice',CBCamera.ItemIndex);
        if (CBMic.ItemIndex>=0) and (CBMic.ItemIndex<CBMic.Items.Count) then TempReg.WriteInteger('MicDevice',CBMic.ItemIndex);
        if (CBSpeaker.ItemIndex>=0) and (CBSpeaker.ItemIndex<CBSpeaker.Items.Count) then TempReg.WriteInteger('SpeakerDevice',CBSpeaker.ItemIndex);
      end;
    finally
      TempReg.Free;
    end;
    Close;
  end
  else
  begin
    NoteBook1.PageIndex:=NoteBook1.PageIndex+1;
    CheckBTState;
  end;
end;
procedure TAVSetForm.BTPrevClick(Sender: TObject);
begin
  NoteBook1.PageIndex:=NoteBook1.PageIndex-1;
  CheckBTState;
end;
procedure TAVSetForm.BTCancelClick(Sender: TObject);
begin
  Close;
end;
procedure TAVSetForm.BTTestSpeakerClick(Sender: TObject);
begin
  if BTTestSpeaker.Caption='停止(&S)' then
  begin
    MMWaveOut.Stop;
  end
  else
  begin
    MMWaveFile.LoadFromFile(ResPath+'/Sound/TestSnd.wav');
    MMWaveOut.Start;
  end;
end;
procedure TAVSetForm.MMWaveOutStart(Sender: TObject);
begin
    BTTestSpeaker.Caption:='停止(&S)';
end;
procedure TAVSetForm.MMWaveOutStop(Sender: TObject);
begin
    BTTestSpeaker.Caption:='单击测试扬声器(&T)';
end;
procedure TAVSetForm.MMWaveInBufferReady(Sender: TObject;
  lpWaveHdr: PWaveHdr);
begin
  MMRingBuffer1.PutBuffer(lpWaveHdr.lpData,lpWaveHdr.dwBufferLength,lpWaveHdr.dwUser,lpWaveHdr.dwFlags);
end;
end.

						