audiovideomixing_.pas

TVideoGrabber 7.5 TVideoGrabber 7.5 TVideoGrabber 7.5

unit AudioVideoMixing_;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, VidGrab, Buttons, ComCtrls;

type
  TForm1 = class(TForm)
    Label2: TLabel;
    Label1: TLabel;
    btnPlayerOpenFile: TSpeedButton;
    btnMixPlayerOpenFile: TSpeedButton;
    Label3: TLabel;
    Label4: TLabel;
    btnSrc1Start: TButton;
    btnSrc2Start: TButton;
    cboVideoDevices1: TComboBox;
    btnSrc2Stop: TButton;
    btnSrc1Stop: TButton;
    cboVideoDevices2: TComboBox;
    btnSrc1StartRecording: TButton;
    VideoGrabberSrc1: TVideoGrabber;
    VideoGrabberSrc2: TVideoGrabber;
    btnSrc1PlayLastRecorded: TButton;
    btnSrc2Replay: TButton;
    btnSrc1Replay: TButton;
    tbrSrc1CurrentSourceLevel: TTrackBar;
    tbrSrc1ExternalSourceLevel: TTrackBar;
    chkCombined: TCheckBox;
    dlgOpen: TOpenDialog;
    procedure btnSrc1StartClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure btnSrc2StartClick(Sender: TObject);
    procedure cboVideoDevices1Change(Sender: TObject);
    procedure cboVideoDevices2Change(Sender: TObject);
    procedure btnSrc1StopClick(Sender: TObject);
    procedure btnSrc2StopClick(Sender: TObject);
    procedure VideoGrabberSrc1VideoDeviceSelected(Sender: TObject);
    procedure VideoGrabberSrc2VideoDeviceSelected(Sender: TObject);
    procedure VideoGrabberSrc2Inactive(Sender: TObject);
    procedure btnSrc1StartRecordingClick(Sender: TObject);
    procedure btnSrcPlayRecordingClick(Sender: TObject);
    procedure VideoGrabberSrc1FrameOverlayUsingDC(Sender: TObject; Dc: HDC;
      FrameNumber: Cardinal; FrameTime: Int64; FrameId: Integer);
    procedure VideoGrabberSrc2FrameOverlayUsingDC(Sender: TObject; Dc: HDC;
      FrameNumber: Cardinal; FrameTime: Int64; FrameId: Integer);
    procedure btnPlayerOpenFileClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure VideoGrabberSrc2RawAudioSample(Sender: TObject;
      pSampleBuffer: PByte; SampleBufferSize, SampleDataLength: Integer;
      FormatType: TFormatType; pFormat, pBitmapInfoHeader: Pointer;
      SampleStartTime, SampleStopTime: Int64);
    procedure btnSrc1PlayLastRecordedClick(Sender: TObject);
    procedure btnSrc1ReplayClick(Sender: TObject);
    procedure btnMixPlayerOpenFileClick(Sender: TObject);
    procedure btnSrc2ReplayClick(Sender: TObject);
    procedure tbrSrc1CurrentSourceLevelChange(Sender: TObject);
    procedure tbrSrc1ExternalSourceLevelChange(Sender: TObject);
    procedure chkCombinedClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    FFormClosing: Boolean;
    FPIPBitmap: TBitmap;
    csOverlay: TRTLCriticalSection;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

const
   OPEN_MEDIA_FILES = '*.mpg;*.mpeg;*.vro;*.avi;*.wav;*.mp3;*.asf;*.wmv;*.vob';
   OPEN_MEDIA_FILES_EXTENDED = OPEN_MEDIA_FILES + ';*.jpg;*.bmp;*.gif';

procedure AssignListToComboBox (ComboBox: TComboBox; List: String; Index: integer; MaxCount: Integer = 0);
begin
   ComboBox.Items.Text := List;
   if ComboBox.Items.Count > 0 then begin
      ComboBox.ItemIndex := Index;
   end;
   if MaxCount > 0 then begin
      while ComboBox.Items.count > MaxCount do begin
         ComboBox.Items.Delete (ComboBox.Items.Count - 1);
      end;
   end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
   FFormClosing := False;

   InitializeCriticalSection (csOverlay);

   VideoGrabberSrc1.AudioFormat := af_22050_16b_2ch; // you can choose any audio format, but it must be the same on both components
   VideoGrabberSrc1.RawAudioSampleCapture := true;

   VideoGrabberSrc2.AudioFormat := af_22050_16b_2ch; // you can choose any audio format, but it must be the same on both components
   VideoGrabberSrc2.RawAudioSampleCapture := true;

   VideoGrabberSrc1.Display_AutoSize := false;
   VideoGrabberSrc1.RecordingInNativeFormat := False;
   VideoGrabberSrc1.AudioDeviceRendering := False;
   VideoGrabberSrc1.AudioRecording := True;

   VideoGrabberSrc2.Display_AutoSize := false;
   VideoGrabberSrc2.AudioDeviceRendering := True;
   VideoGrabberSrc2.PlayerAudioRendering := True;
   VideoGrabberSrc2.PlayerRefreshPausedDisplay := False;

   VideoGrabberSrc2.PlayerAudioRendering := false;

   AssignListToComboBox (cboVideoDevices1, VideoGrabberSrc1.VideoDevices, VideoGrabberSrc1.VideoDevice);
   AssignListToComboBox (cboVideoDevices2, VideoGrabberSrc1.VideoDevices, VideoGrabberSrc1.VideoDevice);
   FPIPBitmap := nil;
end;

procedure TForm1.btnSrc1StartClick(Sender: TObject);
begin
   VideoGrabberSrc1.VideoSource := vs_VideoCaptureDevice;
   VideoGrabberSrc1.StartPreview;
end;

procedure TForm1.btnSrc1StartRecordingClick(Sender: TObject);
begin
   VideoGrabberSrc1.VideoSource := vs_VideoCaptureDevice;
   VideoGrabberSrc1.StartRecording;
end;

procedure TForm1.btnSrc1StopClick(Sender: TObject);
begin
   VideoGrabberSrc1.Stop;
end;

procedure TForm1.btnSrc1PlayLastRecordedClick(Sender: TObject);
begin
   VideoGrabberSrc1.PlayerFileName := VideoGrabberSrc1.Last_Recording_FileName;
   VideoGrabberSrc1.OpenPlayer;
end;

procedure TForm1.btnSrc1ReplayClick(Sender: TObject);
begin
   VideoGrabberSrc1.PlayerFileName := VideoGrabberSrc1.Last_Clip_Played;
   VideoGrabberSrc1.OpenPlayer;
end;

procedure TForm1.btnSrcPlayRecordingClick(Sender: TObject);
begin
   VideoGrabberSrc1.PlayerFileName := VideoGrabberSrc1.Last_Recording_FileName;
   VideoGrabberSrc1.OpenPlayer;
end;

procedure TForm1.btnSrc2StartClick(Sender: TObject);
begin
   VideoGrabberSrc2.VideoSource := vs_VideoCaptureDevice;
   VideoGrabberSrc2.StartPreview;
end;

procedure TForm1.btnSrc2StopClick(Sender: TObject);
begin
   VideoGrabberSrc2.Stop;
end;

procedure TForm1.btnSrc2ReplayClick(Sender: TObject);
begin
   VideoGrabberSrc2.PlayerFileName := VideoGrabberSrc2.Last_Clip_Played;
   VideoGrabberSrc2.OpenPlayer;
end;

procedure TForm1.btnPlayerOpenFileClick(Sender: TObject);
begin
   dlgOpen.FileName := OPEN_MEDIA_FILES_EXTENDED;
   if dlgOpen.Execute then begin
      VideoGrabberSrc2.PlayerFileName := dlgOpen.FileName;
      VideoGrabberSrc2.OpenPlayer;
   end;
end;

procedure TForm1.cboVideoDevices1Change(Sender: TObject);
begin
   VideoGrabberSrc1.VideoDevice := cboVideoDevices1.ItemIndex;
end;

procedure TForm1.btnMixPlayerOpenFileClick(Sender: TObject);
begin
   dlgOpen.FileName := OPEN_MEDIA_FILES_EXTENDED;
   if dlgOpen.Execute then begin
      VideoGrabberSrc1.PlayerFileName := dlgOpen.FileName;
      VideoGrabberSrc1.OpenPlayer;
   end;
end;

procedure TForm1.cboVideoDevices2Change(Sender: TObject);
begin
   VideoGrabberSrc2.VideoDevice := cboVideoDevices2.ItemIndex;
end;

procedure TForm1.VideoGrabberSrc1VideoDeviceSelected(Sender: TObject);
begin
   cboVideoDevices1.ItemIndex := VideoGrabberSrc1.VideoDevice;
end;

procedure TForm1.VideoGrabberSrc2VideoDeviceSelected(Sender: TObject);
begin
   cboVideoDevices2.ItemIndex := VideoGrabberSrc2.VideoDevice;
end;

procedure TForm1.VideoGrabberSrc2Inactive(Sender: TObject);
var
   Temp: TBitmap;
begin
   if assigned (FPIPBitmap) then begin
      Temp := FPIPBitmap;
      FPIPBitmap := nil;
      Temp.Free;
   end;
end;

procedure TForm1.VideoGrabberSrc1FrameOverlayUsingDC(Sender: TObject;
  Dc: HDC; FrameNumber: Cardinal; FrameTime: Int64; FrameId: Integer);
begin
   EnterCriticalSection (csOverlay);
   if assigned (FPIPBitmap) then begin
      VideoGrabberSrc1.DrawBitmapOverFrame (FPIPBitmap, 10, 10, VideoGrabberSrc1.VideoWidth shr 1, VideoGrabberSrc1.VideoHeight shr 1, false, false, clBlack, false, 0);
   end;
   LeaveCriticalSection (csOverlay);
end;

procedure TForm1.VideoGrabberSrc2FrameOverlayUsingDC(Sender: TObject;
  Dc: HDC; FrameNumber: Cardinal; FrameTime: Int64; FrameId: Integer);
var
   BitmapReceived: TBitmap;
   TempCanvas: TCanvas;
   VideoRect: TRect;
begin
   EnterCriticalSection (csOverlay);
   if assigned (FPIPBitmap) then begin
      BitmapReceived := FPIPBitmap;
   end
   else begin
      BitmapReceived := TBitmap.Create;
      BitmapReceived.Width := VideoGrabberSrc2.VideoWidth;
      BitmapReceived.Height := VideoGrabberSrc2.VideoHeight;
      FPIPBitmap := BitmapReceived;
   end;
   TempCanvas := TCanvas.Create;
   TempCanvas.Handle := Dc;
   SetRect (VideoRect, 0, 0, VideoGrabberSrc2.VideoWidth, VideoGrabberSrc2.VideoHeight);
   TempCanvas.Lock;
   BitmapReceived.Canvas.Lock;
   BitmapReceived.Canvas.CopyRect (VideoRect, TempCanvas, VideoRect);
   TempCanvas.UnLock;
   BitmapReceived.Canvas.UnLock;
   TempCanvas.Free;
   LeaveCriticalSection (csOverlay);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
   DeleteCriticalSection (csOverlay);
end;

procedure TForm1.VideoGrabberSrc2RawAudioSample(Sender: TObject;
  pSampleBuffer: PByte; SampleBufferSize, SampleDataLength: Integer;
  FormatType: TFormatType; pFormat, pBitmapInfoHeader: Pointer;
  SampleStartTime, SampleStopTime: Int64);
begin
   if not FFormClosing then begin // required because Src1 may be destroyed before Src2
      if (VideoGrabbersrc1.GraphState = gs_Running) and (VideoGrabbersrc2.GraphState = gs_Running) then begin
         VideoGrabberSrc1.MixAudioSamples (pSampleBuffer, SampleBufferSize, SampleDataLength, FormatType, pFormat, SampleStartTime, SampleStopTime);
      end;
   end;
end;

procedure TForm1.tbrSrc1CurrentSourceLevelChange(Sender: TObject);
begin
   VideoGrabberSrc1.MixAudioSamples_CurrentSourceLevel := 100 - tbrSrc1CurrentSourceLevel.Position;
   if chkCombined.Checked then begin
      tbrSrc1ExternalSourceLevel.Position := VideoGrabberSrc1.MixAudioSamples_CurrentSourceLevel;
   end;
end;

procedure TForm1.tbrSrc1ExternalSourceLevelChange(Sender: TObject);
begin
   VideoGrabberSrc1.MixAudioSamples_ExternalSourceLevel := 100 - tbrSrc1ExternalSourceLevel.Position;
   if chkCombined.Checked then begin
      tbrSrc1CurrentSourceLevel.Position := VideoGrabberSrc1.MixAudioSamples_ExternalSourceLevel;
   end;
end;

procedure TForm1.chkCombinedClick(Sender: TObject);
begin
   tbrSrc1CurrentSourceLevelChange (self);
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
   FFormClosing := True;
end;

end.