demo2.pas

Delphi用于视频处理源程序

unit Demo2;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Video,avicap, StdCtrls, ExtCtrls, DIGPicture;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    BtStart: TButton;
    BtStop: TButton;
    Btformat: TButton;
    BtDriver: TButton;
    Panel2: TPanel;
    Label2: TLabel;
    EdWidth: TEdit;
    EdHeight: TEdit;
    Label4: TLabel;
    EdPlanes: TEdit;
    Label5: TLabel;
    EdBitCount: TEdit;
    Lbc: TLabel;
    Compression: TLabel;
    EdCompress: TEdit;
    EdSize: TEdit;
    lbimg: TLabel;
    Label6: TLabel;
    Edx: TEdit;
    Label7: TLabel;
    Edy: TEdit;
    Label8: TLabel;
    EdClrused: TEdit;
    Label9: TLabel;
    EdClrImportant: TEdit;
    Panel3: TPanel;
    Image1: TImage;
    Label10: TLabel;
    LbFormat: TLabel;
    Label13: TLabel;
    Label11: TLabel;
    Label1: TLabel;
    EdFrame: TEdit;
    VideoCap1: TVideoCap;
    procedure FormCreate(Sender: TObject);
    procedure Video1VideoStream(sender: TObject; lpVhdr: PVIDEOHDR);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure BtFormatClick(Sender: TObject);
    procedure BtStartClick(Sender: TObject);
    procedure BtStopClick(Sender: TObject);
    procedure BtDriverClick(Sender: TObject);
  private
   count:integer; // Frame Counter
   BmInf:TBitmapInfo;   // Info of Bitmapformat
    { Private-Deklarationen}
  public
    { Public-Deklarationen}
  end;

var
  Form1: TForm1;

implementation

uses DlgTreiber;

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
 Video1.Videopreview:= true;
 image1.Picture.Bitmap:= TBitmap.Create;

end;

procedure TForm1.Video1VideoStream(sender: TObject; lpVhdr: PVIDEOHDR);

begin

{TVIDEOHDR = record
    lpData:pByte;                 // pointer to locked data buffer
    dwBufferLength:DWORD;         // Length of data buffer
    dwBytesUsed:DWORD;            // Bytes actually used
    dwTimeCaptured:DWORD;         // Milliseconds from start of stream

    dwUser:DWORD;                 // for client's use
    dwFlags:DWORD;                // assorted flags (see defines)
    dwReserved: array [0..4] of DWORD;    // reserved for driver
end;
 }


inc(count);  // frame Counter
if (count mod 5 =0) then   // only every 5th Frame to Bitmap
 begin
  EdFrame.text:= inttostr(count);
  try
    FrameToBitmap(Image1.Picture.Bitmap,lpVhdr^.lpData,bminf);
    Image1.Visible:= true;
    lbFormat.Visible:= false;
    Image1.Invalidate;
  except
    Image1.Visible:= false;
    lbFormat.Visible:= true;
  end;
 end;

end;




procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Video1.StopCapture;
end;

procedure TForm1.BtFormatClick(Sender: TObject);
begin
 Video1.DlgVFormat;
end;

procedure TForm1.BtStartClick(Sender: TObject);

begin
 bmInf:= Video1.BitmapInfo;
 with bmInf.bmiHeader do
  begin
  EdWidth.Text:= inttostr( biWidth);
  EdHeight.Text:= inttostr(biHeight);
  EdPlanes.Text:= inttostr(biPlanes);
  edbitCount.Text:= inttostr(biBitCount);

  case  biCompression of
   bi_RGB:   edCompress.text:= 'bi_RGB';
   BI_RLE8:  edCompress.text:= 'bi_RLE8 ';
   BI_RLE4:  edCompress.text:= 'bi_RLE4 ';
   BI_BITFIELDS : edCompress.text:= 'bi_BITFIELDS';
  else
   edCompress.text:= 'Other:'+inttostr( biCompression );
 end;
   EdSize.text := inttostr( biSizeImage);
   Edx.text := inttostr( biXPelsPerMeter);
   Edy.text := inttostr( biyPelsPerMeter);
   Edclrused.text := inttostr( biclrused);
   Edclrimportant.text := inttostr( biclrImportant);
 end;


 VideoCap1.StartCapture;
 BtStart.Enabled:= false;
 btStop.Enabled:= true;
 btFormat.Enabled:= false;
 btDriver.Enabled:= false;
 count:= 0;

end;

procedure TForm1.BtStopClick(Sender: TObject);
begin
 Video1.StopCapture;
 BtStart.Enabled:= true;
 btStop.Enabled:= false;
 btFormat.Enabled:= true;
 btDriver.Enabled:= true;
end;

procedure TForm1.BtDriverClick(Sender: TObject);

Var DrvList:TStrings;
begin
 DlgEinstell:=TDlgEinstell.Create(Self);
 drvList:=  GetDriverList;
 dlgEinstell.Combobox1.Items:= drvList;
 Video1.DriverOpen:= false;
 dlgEinstell.ComboBox1.Itemindex:= Video1.DriverIndex;
 if DlgEinstell.ShowModal = mrOK then
    begin
      video1.DriverIndex:= dlgEinstell.combobox1.ItemIndex;
    end;
 Video1.DriverOpen:= true;
 Video1.VideoPreview:= true;
 DlgEinstell.Free;
 drvList.Clear;
 drvList.Free;
end;


end.