unit AVWizard;

interface

uses
  AnyQBase,
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ACMWaveIn, ACMWaveOut, ExtCtrls, StdCtrls, ComCtrls, Videocap,
  VideoDisp, RXSlider, mmsystem;

type
  TAVWizardForm = class(TAnyQBaseForm)
    ACMWaveIn1: TACMWaveIn;
    ACMWaveOut1: TACMWaveOut;
    nbWizard: TNotebook;
    Panel1: TPanel;
    Bevel1: TBevel;
    Panel2: TPanel;
    btnPrevious: TButton;
    btnNext: TButton;
    btnCancle: TButton;
    Panel3: TPanel;
    Panel4: TPanel;
    Image1: TImage;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    ComboBox1: TComboBox;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    ComboBox2: TComboBox;
    ComboBox3: TComboBox;
    PaintBox1: TPaintBox;
    RxSliderMic: TRxSlider;
    Label10: TLabel;
    Label11: TLabel;
    Button1: TButton;
    Label12: TLabel;
    Label13: TLabel;
    Label14: TLabel;
    Label15: TLabel;
    Label16: TLabel;
    PaintBox2: TPaintBox;
    RxSliderSpk: TRxSlider;
    VideoCap1: TVideoCap;
    procedure FormCreate(Sender: TObject);
    procedure btnPreviousClick(Sender: TObject);
    procedure btnNextClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure ComboBox2Change(Sender: TObject);
    procedure ComboBox3Change(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
    procedure RxSliderMicChange(Sender: TObject);
    procedure RxSliderSpkChange(Sender: TObject);
    procedure ACMWaveIn1Data(data: Pointer; size: Integer);
    procedure PaintBox1Paint(Sender: TObject);
    procedure PaintBox2Paint(Sender: TObject);
    procedure btnCancleClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    MicControlID: Cardinal;
    SpkControlID: Cardinal;
    hmx: HMixer;
    _VolChanging: Boolean;
    tmpbmp: TBitmap;

    procedure initmixer;
    procedure OpenAudio;
    procedure CloseAudio;

    procedure WMMmMixmControlChange(var Message: TMessage); message MM_MIXM_CONTROL_CHANGE;
    procedure WMMmMixmLineChange(var Message: TMessage); message MM_MIXM_LINE_CHANGE;
  public
    { Public declarations }

  end;

var
  AVWizardForm: TAVWizardForm;

procedure StartAVWizard;

implementation

uses RiserWindow, Session, math, Jabber1;

{$R *.dfm}

const
  PCMFOMAT: tWAVEFORMATEX =
  (wFormatTag: WAVE_FORMAT_PCM;
    nChannels: 1;
    nSamplesPerSec: 8000;
    nAvgBytesPerSec: 16000;
    nBlockAlign: 2;
    wBitsPerSample: 16;
    cbSize: 0;
    );

procedure pcmFindPeak(pwfx: PWaveFormatEx; pSrc: PChar; dwSrcLen: Integer;
  var PeakL, PeakR: SmallInt);
var
  SrcNumBytes, sd: Longint;
  pL, pR, sw: Smallint;
begin
  PeakL := 0;
  PeakR := 0;
  pR := 0;
  pL := 0;
  if pwfx^.wBitsperSample = 8 then
  begin
    if pwfx^.nChannels = 2 then
    begin
      SrcNumBytes := dwSrcLen and not 1;
      while (SrcNumBytes > 0) do
      begin
            { the left channel }
        sw := PByte(pSrc)^ - 128;
        if abs(sw) > pL then
        begin
          PeakL := sw;
          pL := Min(abs(sw), 127);
        end;

            { the right channel }
        sw := PByte(pSrc + 1)^ - 128;
        if abs(sw) > pR then
        begin
          PeakR := sw;
          pR := Min(abs(sw), 127);
        end;

        inc(pSrc, 2 * sizeOf(Byte));
        dec(SrcNumBytes, 2 * sizeOf(Byte));
      end;
      PeakL := PeakL + 128;
      PeakR := PeakR + 128;
    end
    else
    begin
      SrcNumBytes := dwSrcLen;
      while (SrcNumBytes > 0) do
      begin
            { we have only one channel }
        sw := PByte(pSrc)^ - 128;
        if abs(sw) > pL then
        begin
          PeakL := sw;
          pL := Min(abs(sw), 127);
        end;

        inc(pSrc, sizeOf(Byte));
        dec(SrcNumBytes, sizeOf(Byte));
      end;
      PeakL := PeakL + 128;
      PeakR := PeakL;
    end;
  end
  else
  begin
    if pwfx^.nChannels = 2 then
    begin
      SrcNumBytes := dwSrcLen and not 3;
      while (SrcNumBytes > 0) do
      begin
            { the left channel }
        sd := PSmallint(pSrc)^;
        if abs(sd) > pL then
        begin
          PeakL := sd;
          pL := Min(abs(sd), 32767);
        end;

            { the right channel }
        sd := PSmallint(pSrc + 2)^;
        if abs(sd) > pR then
        begin
          PeakR := sd;
          pR := Min(abs(sd), 32767);
        end;

        inc(pSrc, 2 * sizeOf(SmallInt));
        dec(SrcNumBytes, 2 * sizeOf(SmallInt));
      end;
    end
    else
    begin
      SrcNumBytes := dwSrcLen and not 1;
      while (SrcNumBytes > 0) do
      begin
            { we have only one channel }
        sd := PSmallint(pSrc)^;
        if abs(sd) > pL then
        begin
          PeakL := sd;
          pL := Min(abs(sd), 32767);
        end;

        inc(pSrc, sizeOf(SmallInt));
        dec(SrcNumBytes, sizeOf(SmallInt));
      end;
      PeakR := PeakL;
    end;
  end;
end;


function GetWavInDriverList: TstringList;
var
  DevCount: Integer;
  i: Integer;
  CAPS: tagWAVEINCAPSA;
begin
  Result := TstringList.Create;
  DevCount := waveInGetNumDevs();
  for i:= 0 to DevCount do
  begin
    if waveInGetDevCaps(i, @CAPS, sizeof(tagWAVEINCAPSA)) <> MMSYSERR_NOERROR then
      Continue;
    Result.Add(caps.szPname);
  end;
end;

function GetWavOutDriverList: TstringList;
var
  DevCount: Integer;
  i: Integer;
  CAPS: tagWAVEINCAPSA;
begin
  Result := TstringList.Create;
  DevCount := waveOutGetNumDevs();
  for i:= 0 to DevCount do
  begin
    if waveOutGetDevCaps(i, @CAPS, sizeof(tagWAVEINCAPSA)) <> MMSYSERR_NOERROR then
      Continue;
    Result.Add(caps.szPname);
  end;
end;

procedure StartAVWizard;
begin
  if AVWizardForm<> nil then
  begin
    ShowRiserWindow(nil,'已经打开了一个音视频向导，不允许同时打开多个个音视频向导。',ico_info);
    AVWizardForm.BringToFront;
    exit;
  end;

  AVWizardForm := TAVWizardForm.Create(Application);
  try
    AVWizardForm.ShowModal;
  finally
    AVWizardForm.Free;
    AVWizardForm := nil;
  end;
end;

procedure TAVWizardForm.FormCreate(Sender: TObject);
var
  list: TStringList;
begin
//  DoubleBuffered := True;
  List := GetDriverList;
  ComboBox1.Items.AddStrings(List);
  List.Free;
  List := GetWavInDriverList;
  ComboBox2.Items.AddStrings(List);
  List.Free;
  List := GetWavOutDriverList;
  ComboBox3.Items.AddStrings(List);
  List.Free;
  nbWizard.PageIndex := 0;

  ComboBox1.ItemIndex := 0;
  if ComboBox1.Items.Count>1 then
    ComboBox1.ItemIndex := MainSession.Prefs.getInt('CamDriver')+1
  else
    ComboBox1.Enabled := False;

  ComboBox2.ItemIndex := 0;
  if ComboBox2.Items.Count>1 then
    ComboBox2.ItemIndex := MainSession.Prefs.getInt('WavInDriver')+1
  else
    ComboBox2.Enabled := False;

  ComboBox3.ItemIndex := 0;
  if ComboBox3.Items.Count>1 then
    ComboBox3.ItemIndex := MainSession.Prefs.getInt('WavOutDriver')+1
  else
    ComboBox3.Enabled := False;
  tmpbmp := TBitmap.Create;
  tmpbmp.Width := PaintBox1.Width;
  tmpbmp.Height := PaintBox1.Height;
end;

procedure TAVWizardForm.btnPreviousClick(Sender: TObject);
begin
  if nbWizard.PageIndex>0 then
    nbWizard.PageIndex := nbWizard.PageIndex-1;

  VideoCap1.DriverOpen := False;
  VideoCap1.DriverIndex := ComboBox1.ItemIndex-1;
  mixerClose(hmx);
  CloseAudio;

  if nbWizard.PageIndex = 3 then
  begin
    if ComboBox1.ItemIndex <= 0 then
      nbWizard.PageIndex := nbWizard.PageIndex-1;
    VideoCap1.DriverOpen := true;
    VideoCap1.VideoPreview := True;
  end;

  if nbWizard.PageIndex = 2 then
  begin
    if (ComboBox2.ItemIndex <= 0) and (ComboBox3.ItemIndex <= 0) then
      nbWizard.PageIndex := nbWizard.PageIndex-1
    else
    begin
      initmixer;
      OpenAudio;
    end;
  end;

  if nbWizard.PageIndex<=0 then
    btnPrevious.Enabled := False;
end;

procedure TAVWizardForm.btnNextClick(Sender: TObject);
begin
  if nbWizard.PageIndex >= nbWizard.Pages.Count-1 then
  begin
    MainSession.Prefs.setInt('CamDriver', ComboBox1.ItemIndex-1);
    MainSession.Prefs.setInt('WavInDriver', ComboBox2.ItemIndex-1);
    MainSession.Prefs.setInt('WavOutDriver', ComboBox3.ItemIndex-1);
    Close;
  end;
  if nbWizard.PageIndex<nbWizard.Pages.Count-1 then
    nbWizard.PageIndex := nbWizard.PageIndex+1;

  VideoCap1.DriverOpen := False;
  VideoCap1.DriverIndex := ComboBox1.ItemIndex-1;
  mixerClose(hmx);
  CloseAudio;

  if nbWizard.PageIndex = 2 then
  begin
    RxSliderMic.Enabled := ComboBox2.ItemIndex > 0;
    RxSliderSpk.Enabled := ComboBox3.ItemIndex > 0;
    if (ComboBox2.ItemIndex <= 0) and (ComboBox3.ItemIndex <= 0) then
      nbWizard.PageIndex := nbWizard.PageIndex+1
    else
    begin
      initmixer;
      OpenAudio;
    end;
  end;

  if nbWizard.PageIndex = 3 then
  begin
    if ComboBox1.ItemIndex <= 0 then
      nbWizard.PageIndex := nbWizard.PageIndex+1;
    VideoCap1.DriverOpen := true;
    VideoCap1.VideoPreview := True;
  end;

  if nbWizard.PageIndex>0 then
    btnPrevious.Enabled := True;
  if nbWizard.PageIndex >= nbWizard.Pages.Count-1 then
  begin
    btnNext.Caption := '结束';
  end
  else
    btnNext.Caption := '下一步(&N) >';
end;

procedure TAVWizardForm.Button1Click(Sender: TObject);
begin
  if VideoCap1.HasDlgSource then
    VideoCap1.DlgVSource;
end;

procedure TAVWizardForm.ComboBox2Change(Sender: TObject);
begin
//
end;

procedure TAVWizardForm.ComboBox3Change(Sender: TObject);
begin
//
end;

procedure TAVWizardForm.ComboBox1Change(Sender: TObject);
begin
//
  if ComboBox1.ItemIndex>0 then
    VideoCap1.DriverIndex := ComboBox1.ItemIndex-1;
end;

procedure TAVWizardForm.initmixer;
var
  ML: TMixerLine;
  MLC: TMixerLineControls;
  P: PMixerControl;
  i, j, k: Integer;
  pp: Pchar;
  D: tMIXERCONTROLDETAILS;
  R: Cardinal;
begin
  MicControlID := 0;

  if ComboBox2.ItemIndex>0 then
  begin
    ML.cbStruct := SizeOf(TMixerLine);
    mixerGetLineInfo(ComboBox2.ItemIndex-1 , @ML, MIXER_OBJECTF_WAVEIN);
    for j := 0 to ML.cConnections - 1 do
    begin
      ml.dwSource := j;
      mixerGetLineInfo(i, @ML, MIXER_GETLINEINFOF_SOURCE);
      if ML.dwComponentType <> MIXERLINE_COMPONENTTYPE_SRC_MICROPHONE then
      begin
        continue;
      end;

      getmem(p, sizeof(TMixerControl) * Ml.cControls);
      Mlc.cbStruct := SizeOf(MLC);
      MLC.dwLineID := Ml.dwLineID;
      MLC.cbmxctrl := SizeOf(TMixerControl);
      MLC.cControls := Ml.cControls;
      MLC.pamxctrl := P;
      mixerGetLineControls(i, @MLC, MIXER_OBJECTF_WAVEIN);

      pp := Pointer(Mlc.pamxctrl);
      for k := 0 to ML.cControls - 1 do
      begin
        if PMixerControl(pp).Bounds.dwMaximum = 65535 then
        begin
          MicControlID := PMixerControl(pp).dwControlID;
          break;
        end;
        pp := pp + sizeof(TMixerControl);
      end;
      FreeMem(p);
    end;
  end;

  SPKControlID := 0;
  if ComboBox3.ItemIndex>0 then
  begin
    ML.cbStruct := SizeOf(TMixerLine);
    mixerGetLineInfo(ComboBox3.ItemIndex-1, @ML, MIXER_OBJECTF_WAVEOUT);
    for j := 0 to ML.cConnections - 1 do
    begin
      ml.dwSource := j;
      mixerGetLineInfo(i, @ML, MIXER_GETLINEINFOF_DESTINATION);
      if ML.dwComponentType <> MIXERLINE_COMPONENTTYPE_DST_SPEAKERS then
      begin
        continue;
      end;

      getmem(p, sizeof(TMixerControl) * Ml.cControls);
      Mlc.cbStruct := SizeOf(MLC);
      MLC.dwLineID := Ml.dwLineID;
      MLC.cbmxctrl := SizeOf(TMixerControl);
      MLC.cControls := Ml.cControls;
      MLC.pamxctrl := P;
      mixerGetLineControls(i, @MLC, MIXER_OBJECTF_WAVEOUT);

      pp := Pointer(Mlc.pamxctrl);
      for k := 0 to ML.cControls - 1 do
      begin
        if PMixerControl(pp).Bounds.dwMaximum = 65535 then
        begin
          SPKControlID := PMixerControl(pp).dwControlID;
          break;
        end;
        pp := pp + sizeof(TMixerControl);
      end;
      FreeMem(p);
    end;
  end;

  mixerOpen(@hmx, 0, handle, 0, CALLBACK_WINDOW or MIXER_OBJECTF_MIXER);

  FillChar(d, SizeOf(tMIXERCONTROLDETAILS), 0);
  d.cbStruct := SizeOf(tMIXERCONTROLDETAILS);
  d.dwControlID := SpkControlID;
  d.cChannels := MIXERCONTROL_CONTROLF_UNIFORM;
  d.cbDetails := sizeof(TMixerControl);
  d.paDetails := @R;
  if mixerGetControlDetails(hmx, @D, MIXER_GETCONTROLDETAILSF_VALUE) = MMSYSERR_NOERROR then
  begin
    RxSliderSpk.Value := R;
  end;

  FillChar(d, SizeOf(tMIXERCONTROLDETAILS), 0);
  d.cbStruct := SizeOf(tMIXERCONTROLDETAILS);
  d.dwControlID := MicControlID;
  d.cChannels := MIXERCONTROL_CONTROLF_UNIFORM;
  d.cbDetails := sizeof(TMixerControl);
  d.paDetails := @R;
  if mixerGetControlDetails(hmx, @D, MIXER_GETCONTROLDETAILSF_VALUE) = MMSYSERR_NOERROR then
  begin
    RxSliderMic.Value := R;
  end;
end;

procedure TAVWizardForm.WMMmMixmControlChange(var Message: TMessage);
var
  D: tMIXERCONTROLDETAILS;
  R: Cardinal;
begin
  if (Message.LParam <> 1) and (Message.LParam <> MicControlID) then
    exit;
  FillChar(d, SizeOf(tMIXERCONTROLDETAILS), 0);
  d.cbStruct := SizeOf(tMIXERCONTROLDETAILS);
  d.dwControlID := Message.LParam;
  d.cChannels := MIXERCONTROL_CONTROLF_UNIFORM;
  d.cbDetails := sizeof(TMixerControl);
  d.paDetails := @R;
  if mixerGetControlDetails(Message.WParam, @D, MIXER_GETCONTROLDETAILSF_VALUE) = MMSYSERR_NOERROR then
  begin
    _VolChanging := True;
    if Message.LParam = SpkControlID then
      RxSliderSpk.Value := R;
    if Message.LParam = MicControlID then
      RxSliderMic.Value := R;
    _VolChanging := False;
  end;
end;

procedure TAVWizardForm.WMMmMixmLineChange(var Message: TMessage);
begin

end;

procedure TAVWizardForm.RxSliderMicChange(Sender: TObject);
var
  D: tMIXERCONTROLDETAILS;
  R: Cardinal;
begin
  if _VolChanging then
    exit;
  FillChar(d, SizeOf(tMIXERCONTROLDETAILS), 0);
  d.cbStruct := SizeOf(tMIXERCONTROLDETAILS);
  d.dwControlID := MicControlID;
  d.cChannels := MIXERCONTROL_CONTROLF_UNIFORM;
  d.cbDetails := sizeof(TMixerControl);
  R := RxSliderMic.Value;
  d.paDetails := @R;
  mixerSetControlDetails(hmx, @D, MIXER_GETCONTROLDETAILSF_VALUE);
end;

procedure TAVWizardForm.RxSliderSpkChange(Sender: TObject);
var
  D: tMIXERCONTROLDETAILS;
  R: Cardinal;
begin
  if _VolChanging then
    exit;
  FillChar(d, SizeOf(tMIXERCONTROLDETAILS), 0);
  d.cbStruct := SizeOf(tMIXERCONTROLDETAILS);
  d.dwControlID := SpkControlID;
  d.cChannels := MIXERCONTROL_CONTROLF_UNIFORM;
  d.cbDetails := sizeof(TMixerControl);
  R := RxSliderSpk.Value;
  d.paDetails := @R;
  mixerSetControlDetails(hmx, @D, MIXER_GETCONTROLDETAILSF_VALUE);
end;

procedure TAVWizardForm.CloseAudio;
begin
  ACMWaveIn1.Close;
  ACMWaveOut1.Close;
end;

procedure TAVWizardForm.OpenAudio;
var
  R: TRect;
begin
  R := PaintBox1.ClientRect;
  with PaintBox1.Canvas do
  begin
    Rectangle(R);
    Brush.Color := clWhite;
    InflateRect(R,-1,-1);
    FillRect(R);
  end;

  R := PaintBox2.ClientRect;
  with PaintBox2.Canvas do
  begin
    Rectangle(R);
    Brush.Color := clWhite;
    InflateRect(R,-1,-1);
    FillRect(R);
  end;

  if ComboBox2.ItemIndex>0 then
    ACMWaveIn1.Open(@PCMFOMAT, ComboBox2.ItemIndex-1);

  if ComboBox3.ItemIndex>0 then
    ACMWaveOut1.Open(@PCMFOMAT, ComboBox3.ItemIndex-1);
end;

procedure TAVWizardForm.ACMWaveIn1Data(data: Pointer; size: Integer);
var
  PeakL, PeakR: Smallint;
  Oldtag1, Oldtag2: Integer;
begin
  pcmFindPeak(@PCMFOMAT, Data, Size, PeakL, PeakR);
  ACMWaveOut1.PlayBack(data,size);
  Oldtag1 := PaintBox1.Tag;
  Oldtag2 := PaintBox2.Tag;
  PaintBox1.Tag := ABS(PeakL);
  PaintBox2.Tag := ABS(PeakL);
  if Oldtag1 div 1024 <> PaintBox1.Tag div 1024 then
    PaintBox1.Invalidate;
  if Oldtag2 div 1024 <> PaintBox2.Tag div 1024 then
    PaintBox2.Invalidate;
end;

procedure TAVWizardForm.PaintBox1Paint(Sender: TObject);
var
  R: TRect;
  c: Integer;
begin
  R := PaintBox1.ClientRect;
  with tmpbmp.Canvas do
  begin
    Rectangle(R);
    Brush.Color := clWhite;
    InflateRect(R,-1,-1);
    FillRect(R);
    c := 0;
    Brush.Color := clGreen;
    while PaintBox1.Tag > c*128*8 do
    begin
      if (c > 18) and (c <= 25) then
        Brush.Color := clYellow;
      if c > 25 then
        Brush.Color := clRed;
      R.Left := 1+C*8;
      R.Right := (C+1)*8;
      FillRect(R);
      inc(c);
    end;
    if C<32 then
    begin
      Brush.Color := clWhite;
      R.Left := 1+C*8;
      R.Right := 32*8;
      FillRect(R);
    end;
  end;
  BitBlt(PaintBox1.Canvas.Handle,0,0,tmpbmp.width,tmpbmp.Height,tmpbmp.Canvas.Handle,0,0,SRCCOPY);
end;

procedure TAVWizardForm.PaintBox2Paint(Sender: TObject);
var
  R: TRect;
  c: Integer;
begin
  R := PaintBox2.ClientRect;
  with tmpbmp.Canvas do
  begin
    Rectangle(R);
    Brush.Color := clWhite;
    InflateRect(R,-1,-1);
    FillRect(R);
    c := 0;
    Brush.Color := clNavy;
    while PaintBox2.Tag > c*128*8 do
    begin
{      if c > 18 then
        Brush.Color := clYellow;
      if c > 25 then
        Brush.Color := clRed;{}
      R.Left := 1+C*8;
      R.Right := (C+1)*8;
      FillRect(R);
      inc(c);
    end;
  end;
  BitBlt(PaintBox2.Canvas.Handle,0,0,tmpbmp.width,tmpbmp.Height,tmpbmp.Canvas.Handle,0,0,SRCCOPY);
end;

procedure TAVWizardForm.btnCancleClick(Sender: TObject);
begin
  Close;
end;

procedure TAVWizardForm.FormDestroy(Sender: TObject);
begin
  CloseAudio;
  mixerClose(hmx);
  tmpbmp.Free;
end;

end.
