mainwnd.pas

Delphi用于视频处理源程序

unit mainwnd;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  video,vfw, StdCtrls, ExtCtrls, Buttons;

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;
    Label13: TLabel;
    Label1: TLabel;
    EdFrame: TEdit;
    Edfps: TEdit;
    Label3: TLabel;
    VideoCap1: TVideoCap;
    BTCompress: TBitBtn;
    Image1: TImage;
    LbFormat: TLabel;
    Label10: TLabel;
    EdUpdate: TEdit;
    Label11: TLabel;
    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);
    procedure Video1DblClick(Sender: TObject);
    procedure BTCompressClick(Sender: TObject);
    procedure EdUpdateChange(Sender: TObject);
  private
   count:integer; // Frame Counter
   BmInf:TBitmapInfo;   // InfoHeader of Bitmapformat
   oldtime,oldtime2:DWord;
   oldcount:integer;
   timerate:dWord;


    { Private-Deklarationen}
  public
    { Public-Deklarationen}
  end;

var
  Form1: TForm1;

implementation

uses DlgTreiber;

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
 if VideoCap1.HasVideoOverlay then  VideoCap1.VideoOverlay:= true
 else
   VideoCap1.Videopreview:= true;


end;



procedure TForm1.Video1VideoStream(sender: TObject; lpVhdr: PVIDEOHDR);
var fps:integer;
    t:string;
begin

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;


if lpvhdr^.dwTimeCaptured -oldtime > 1000 then // calc Framerate
 begin
  oldtime:=lpvhdr^.dwTimeCaptured;
  // calc frames per second
  fps:= count - oldcount;
  oldcount:= count;
  edfps.text:= inttostr(fps);
  EdFrame.text:= inttostr(count);
 end;

canvas.Lock;
if  lpvhdr^.dwTimeCaptured -oldtime2 > timerate then // New Image
 begin
  oldtime2:=lpvhdr^.dwTimeCaptured;
    try
    FrameToBitmap(Image1.Picture.Bitmap,lpVhdr^.lpData,bminf);
    with Image1.Picture.bitmap.canvas do
     begin
       font.Color:= clred;
       SetBkMode(handle,windows.transparent);
       t:= DateTimeToStr(now);
       Textout(10,bminf.bmiHeader.biHeight - textheight(text), t);
     end;
    Image1.Visible:= true;
    lbFormat.Visible:= false;
   except
    Image1.Visible:= false;
    lbFormat.Visible:= true;
  end;
end;
canvas.Unlock;

end;




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

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

procedure TForm1.BtStartClick(Sender: TObject);

begin
 EdUpdateChange(self);
 bmInf:= VideoCap1.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;
 oldtime:=0;
 oldtime2:=0;
 oldcount:= 0;

end;

procedure TForm1.BtStopClick(Sender: TObject);
begin
 VideoCap1.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;
 VideoCap1.DriverOpen:= false;
 dlgEinstell.ComboBox1.Itemindex:= VideoCap1.DriverIndex;
 if DlgEinstell.ShowModal = mrOK then
    begin
      videoCap1.DriverIndex:= dlgEinstell.combobox1.ItemIndex;
    end;
 VideoCap1.DriverOpen:= true;
 if VideoCap1.HasVideooverlay then  VideoCap1.VideoOverlay:= true
 else
   VideoCap1.Videopreview:= true;
 DlgEinstell.Free;
 drvList.Clear;
 drvList.Free;
end;

 

procedure TForm1.Video1DblClick(Sender: TObject);
begin
   if BtStart.Enabled Then BtStartClick(Sender) else BtStopClick(Sender);
end;

procedure TForm1.BTCompressClick(Sender: TObject);
begin
VideoCap1.DlgVCompression;

end;

procedure TForm1.EdUpdateChange(Sender: TObject);
begin
  try
   timerate:= strtoint(edUpdate.Text);
  except
    timerate:= 1000;
  end;
end;

end.