mixedvideosources_.pas

TVideoGrabber 7.5 TVideoGrabber 7.5 TVideoGrabber 7.5

unit MixedVideoSources_;

interface

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

type
  TForm1 = class(TForm)
    VideoGrabberSrc1: TVideoGrabber;
    btnSrc1Start: TButton;
    btnSrc2Start: TButton;
    VideoGrabberSrc2: TVideoGrabber;
    cboVideoDevices1: TComboBox;
    btnSrc2Stop: TButton;
    btnSrc1Stop: TButton;
    Label2: TLabel;
    Label1: TLabel;
    cboVideoDevices2: TComboBox;
    Label3: TLabel;
    GroupBox1: TGroupBox;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    btnDestStart: TButton;
    edtMaxSwapFrameCount: TEdit;
    edtDestWidth: TEdit;
    edtDestHeight: TEdit;
    btnSizeOk: TButton;
    chkStopWhenAllDown: TCheckBox;
    btnStartRecording: TButton;
    Button2: TButton;
    edtOutputFrameRate: TEdit;
    btnFrameRateOk: TButton;
    btnPlayRecorded: TButton;
    VideoGrabberDest: TVideoGrabber;
    mmoLog: TMemo;
    procedure btnSrc1StartClick(Sender: TObject);
    procedure VideoGrabberSrcFrameCaptureCompleted(Sender: TObject;
      FrameBitmap: TBitmap; BitmapWidth, BitmapHeight: Integer;
      FrameNumber: Cardinal; FrameTime: Int64; DestType: TFrameCaptureDest;
      FileName: String; Success: Boolean; FrameId: Integer);
    procedure btnDestStartClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure btnSrc2StartClick(Sender: TObject);
    procedure btnDestStopClick(Sender: TObject);
    procedure cboVideoDevices1Change(Sender: TObject);
    procedure cboVideoDevices2Change(Sender: TObject);
    procedure btnSizeOkClick(Sender: TObject);
    procedure edtMaxSwapFrameCountChange(Sender: TObject);
    procedure btnSrc1StopClick(Sender: TObject);
    procedure btnSrc2StopClick(Sender: TObject);
    procedure VideoGrabberSrcInactive(Sender: TObject);
    procedure btnStartRecordingClick(Sender: TObject);
    procedure btnPlayRecordedClick(Sender: TObject);
    procedure btnFrameRateOkClick(Sender: TObject);
    procedure VideoGrabberSrc1VideoDeviceSelected(Sender: TObject);
    procedure VideoGrabberSrc2VideoDeviceSelected(Sender: TObject);
    procedure VideoGrabberDestLog(Sender: TObject; LogType: TLogType;
      Severity, InfoMsg: String);
    procedure VideoGrabberDestRecordingStarted(Sender: TObject;
      FileName: String);
    procedure VideoGrabberDestPlayerOpened(Sender: TObject);
    procedure VideoGrabberDestVideoFromBitmapsNextFrameNeeded(
      Sender: TObject; FirstSample: Boolean; var BitmapHandle: HBITMAP;
      var CanFreeBitmapHandle: Boolean; var BMPorJPEGFile: String;
      var EndOfData: Boolean);
  private
     FSwapFrameCount: LongInt;
     FMaxSwapFrameCount: LongInt;
     FVideoGrabbers: array[0..1] of TVideoGrabber;
     FSourceIndex: LongInt;
     FCurrentBitmap: TBitmap;
     FDestWidth: LongInt;
     FDestHeight: LongInt;
     FAllSourcesStopped: Boolean;
     FCurrentBitmapInUse: Boolean;
     procedure SwapToNextSource;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

const
   MAXSOURCES = 2;

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
   FDestWidth := 0;
   FDestHeight := 0;
   AssignListToComboBox (cboVideoDevices1, VideoGrabberSrc1.VideoDevices, VideoGrabberSrc1.VideoDevice);
   AssignListToComboBox (cboVideoDevices2, VideoGrabberSrc1.VideoDevices, VideoGrabberSrc1.VideoDevice);
   FVideoGrabbers[0] := VideoGrabberSrc1;
   FVideoGrabbers[1] := VideoGrabberSrc2;
   FSourceIndex := 0;
   FSourceIndex := 0;
   FSwapFrameCount := 0;
   FMaxSwapFrameCount := 30;
   FAllSourcesStopped := False;
   FCurrentBitmap := nil;
   FCurrentBitmapInUse := False;
end;

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

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

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

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

procedure TForm1.btnDestStartClick(Sender: TObject);
begin
   if (VideoGrabberSrc1.CurrentState = cs_Preview) or (VideoGrabberSrc2.CurrentState = cs_Preview) then begin
      VideoGrabberDest.VideoSource := vs_JPEGsOrBitmaps;
      VideoGrabberDest.StartPreview;
   end
   else begin
      ShowMessage ('at least one video source must be previewing');
   end;
end;

procedure TForm1.btnDestStopClick(Sender: TObject);
begin
   VideoGrabberDest.Stop;
end;

procedure TForm1.VideoGrabberSrcFrameCaptureCompleted(Sender: TObject;
  FrameBitmap: TBitmap; BitmapWidth, BitmapHeight: Integer;
  FrameNumber: Cardinal; FrameTime: Int64; DestType: TFrameCaptureDest;
  FileName: String; Success: Boolean; FrameId: Integer);
var
   OldBitmap, NewBitmap: TBitmap;
begin
   FAllSourcesStopped := False; // if we receive a frame this means at least one source is running
   if FVideoGrabbers[FSourceIndex] = Sender then begin
      if FVideoGrabbers[FSourceIndex].CurrentState <> cs_Down then begin
         NewBitmap := TBitmap.Create;
         NewBitmap.Assign (FrameBitmap);
         if (not FCurrentBitmapInUse) then begin
            OldBitmap := FCurrentBitmap;
            FCurrentBitmap := NewBitmap;
            if assigned (OldBitmap) then begin
               OldBitmap.Free;
            end;
         end
         else begin
            NewBitmap.Free; // the current bitmap was in use, so finally we don't pass this new one
         end;
      end;
   end;
end;

procedure TForm1.VideoGrabberDestVideoFromBitmapsNextFrameNeeded(
  Sender: TObject; FirstSample: Boolean; var BitmapHandle: HBITMAP;
  var CanFreeBitmapHandle: Boolean; var BMPorJPEGFile: String;
  var EndOfData: Boolean);
var
   NewBitmap: TBitmap;
begin
   if FirstSample then begin
      FDestWidth := StrToIntDef (edtDestWidth.Text, 320);
      FDestHeight := StrToIntDef (edtDestHeight.Text, 320);
   end;
   if assigned (FCurrentBitmap) then begin
      FCurrentBitmapInUse := True;
      NewBitmap := TBitmap.Create;
      NewBitmap.Width := FDestWidth;
      NewBitmap.Height := FDestHeight;
      NewBitmap.PixelFormat := pf24Bit;
      NewBitmap.Canvas.Lock;
      FCurrentBitmap.Canvas.Lock;
      NewBitmap.Canvas.StretchDraw (Rect (0, 0, FDestWidth, FDestHeight), FCurrentBitmap);
      NewBitmap.Canvas.UnLock;
      FCurrentBitmap.Canvas.UnLock;
      FCurrentBitmapInUse := False;
      BitmapHandle := NewBitmap.Handle;
      NewBitmap.ReleaseHandle;
      NewBitmap.Free;
      inc (FSwapFrameCount);
      if FSwapFrameCount >= FMaxSwapFrameCount then begin
         FSwapFrameCount := 0;
         SwapToNextSource;
      end;
      if FAllSourcesStopped then begin
         if chkStopWhenAllDown.Checked then begin
            EndOfData := True;
         end;
      end;
   end;
end;

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

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

procedure TForm1.btnSizeOkClick(Sender: TObject);
begin
   if VideoGrabberDest.CurrentState = cs_Preview then begin
      VideoGrabberDest.StartPreview;
   end;
end;

procedure TForm1.SwapToNextSource;
var
   CurrentSource: LongInt;
   Done: Boolean;
begin
   Done := False;
   CurrentSource := FSourceIndex;
   while not Done do begin
      inc (FSourceIndex);
      if FSourceIndex >= MAXSOURCES then begin
         FSourceIndex := 0;
      end;
      if FVideoGrabbers[FSourceIndex].CurrentState <> cs_Down then begin
         Done := True;
      end
      else begin
         if FSourceIndex = CurrentSource then begin // all sources stopped
            FAllSourcesStopped := True;
            Done := True;
         end;
      end;
   end;
end;

procedure TForm1.edtMaxSwapFrameCountChange(Sender: TObject);
begin
   FMaxSwapFrameCount := StrToIntDef (edtMaxSwapFrameCount.Text, 30);
end;

procedure TForm1.VideoGrabberSrcInactive(Sender: TObject);
begin
   SwapToNextSource;
end;

procedure TForm1.btnStartRecordingClick(Sender: TObject);
begin
   if (VideoGrabberSrc1.CurrentState = cs_Preview) or (VideoGrabberSrc2.CurrentState = cs_Preview) then begin
      VideoGrabberDest.VideoSource := vs_JPEGsOrBitmaps;
      VideoGrabberDest.StartRecording;
   end
   else begin
      ShowMessage ('at least one video source must be previewing');
   end;
end;

procedure TForm1.btnPlayRecordedClick(Sender: TObject);
begin
   VideoGrabberDest.PlayerFileName := VideoGrabberDest.Last_Recording_FileName;
   VideoGrabberDest.OpenPlayer;
end;

procedure TForm1.btnFrameRateOkClick(Sender: TObject);
begin
   VideoGrabberDest.FrameRate := StrToFloatDef (edtOutputFrameRate.Text, 30);
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.VideoGrabberDestLog(Sender: TObject; LogType: TLogType;
  Severity, InfoMsg: String);
begin
   mmoLog.Lines.Add ('[' + Severity + '] ' + InfoMsg);
end;

procedure TForm1.VideoGrabberDestRecordingStarted(Sender: TObject;
  FileName: String);
begin
   mmoLog.Lines.Add ('recording to ' + FileName);
end;

procedure TForm1.VideoGrabberDestPlayerOpened(Sender: TObject);
begin
   mmoLog.Lines.Add ('playing ' + TVideoGrabber(Sender).PlayerFileName);
end;


end.