www.pudn.com > delphi-Sdk3000-ocx.zip > CapPic.pas, change:2005-05-20,size:7357b


unit CapPic; 
 
interface 
 
uses 
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
  Dialogs, StdCtrls, ExtCtrls; 
 
type 
  TformCapPic = class(TForm) 
    GroupBox1: TGroupBox; 
    checkVideo1: TCheckBox; 
    checkVideo2: TCheckBox; 
    checkVideo3: TCheckBox; 
    checkSVideo: TCheckBox; 
    checkVideo4: TCheckBox; 
    btnSelectAll: TButton; 
    GroupBox2: TGroupBox; 
    Label1: TLabel; 
    Label2: TLabel; 
    Label3: TLabel; 
    Label4: TLabel; 
    editTime: TEdit; 
    editInterval: TEdit; 
    GroupBox3: TGroupBox; 
    radioJpg: TRadioButton; 
    radioBmp: TRadioButton; 
    GroupBox4: TGroupBox; 
    editPath: TEdit; 
    btnBrowse: TButton; 
    btnStart: TButton; 
    btnExit: TButton; 
    TimerCapPic: TTimer; 
    procedure FormShow(Sender: TObject); 
    procedure btnSelectAllClick(Sender: TObject); 
    procedure btnBrowseClick(Sender: TObject); 
    procedure btnStartClick(Sender: TObject); 
    procedure TimerCapPicTimer(Sender: TObject); 
    procedure btnExitClick(Sender: TObject); 
    procedure FormCreate(Sender: TObject); 
  private 
    { Private declarations } 
  public 
    { Public declarations } 
  end; 
 
var 
  formCapPic: TformCapPic; 
 
implementation 
 
uses sdk3000, Global; 
{$R *.dfm} 
 
var 
s_bCircularSource : Array[0..4] of Boolean; // 抓哪几个通道,则哪几个通道对应为True 
s_nPersist : Integer;    // 抓图时长(秒) 
s_nCycNum : Integer;   //每几帧抓一帧 
s_bCircularSnapBmp : Boolean;   // 是否抓为BMP图像 
s_strCircularSnapDir : String;  // 抓图目录 
 
s_bContinuous : Boolean; // 是否在连续拍 
s_nSnapSource : Integer; // 要抓图的通道个数,只有单通道时才可能启动连续抓拍. 
s_nSource : Integer;     //当前要抓的通道,从0开始 
s_nSkipFrame : Integer;   //用于跳过不想抓的帧,只要抓拍前赋初值-1就行了,以后自动赋值 
s_nCircularPicCount : Integer; //当前抓的是第几张图,从1开始,我每次开抓前赋初值. 
 
procedure InitCapPicGlobal(); 
    var 
    i : Integer; 
begin 
    //循环抓拍用到的全局变量 
    s_bCircularSource[0] := True; 
    For i := 1 To 4 Do 
        s_bCircularSource[i] := False; 
 
    s_nPersist := 2; 
    s_nCycNum := 5; 
    s_bCircularSnapBmp := False; 
    s_strCircularSnapDir := 'e:\'; 
 
    s_bContinuous := False; 
    s_nSnapSource := 0; 
    s_nSource := 0; 
    s_nSkipFrame := -1; 
    s_nCircularPicCount := 1; 
end; 
 
// 捕获原始流回调 
procedure MyPrcPic(nCardID: Integer; pBuf: PByte; nWidth: Integer; nHeight: Integer; nBitCount: Integer);stdcall; 
    var 
    strFile : String; 
    vs : Integer; 
    i  : Integer; 
begin 
    // 连续抓拍,一次性就全抓完了. 
    If s_bContinuous Then 
        Exit; 
 
    // 每帧都抓,并且只抓一个通道时,才启动连续抓拍. 
    If (s_nCycNum = 1) And (s_nSnapSource = 1)Then 
    begin 
        s_bContinuous := True; 
 
        If s_bCircularSnapBmp Then 
        begin 
            strFile := s_strCircularSnapDir + 'Video' + IntToStr(s_nSource + 1) + '_Bmp'; 
            VCACapturePicture(g_nCard, PAnsiChar(strFile), IMAGE_BMP, PRect(0), 100, s_nPersist * g_nFrameRate, ToVcbool(False)); 
        end 
        Else 
        begin 
            strFile := s_strCircularSnapDir + 'Video' + IntToStr(s_nSource + 1) + '_Jpg'; 
            VCACapturePicture(g_nCard, PAnsiChar(strFile), IMAGE_JPG, PRect(0), 100, s_nPersist * g_nFrameRate, ToVcbool(False)); 
        end; 
 
        Exit; 
    end; 
 
    // 如果本帧不需要抓,则直接返回,表示跳过 
    s_nSkipFrame := (s_nSkipFrame + 1) Mod s_nCycNum; 
    If s_nSkipFrame <> 0 Then 
        Exit; 
 
    // 抓图 
    If s_bCircularSnapBmp Then 
    begin 
        strFile := s_strCircularSnapDir + 'Video' + IntToStr(s_nSource + 1) + '_Bmp' + IntToStr(s_nCircularPicCount) + '.bmp'; 
        VCACapturePicture(g_nCard, PAnsiChar(strFile), IMAGE_BMP, PRect(0), 100, 1, ToVcbool(False)); 
    end 
    Else 
    begin 
        strFile := s_strCircularSnapDir + 'Video' + IntToStr(s_nSource + 1) + '_Jpg' + IntToStr(s_nCircularPicCount) + '.jpeg'; 
        VCACapturePicture(g_nCard, PAnsiChar(strFile), IMAGE_JPG, PRect(0), 100, 1, ToVcbool(False)); 
    end; 
 
    s_nCircularPicCount := s_nCircularPicCount + 1; 
 
    // 切到下一个抓拍通道. 
    For i := (s_nSource + 1) To 10 Do 
    begin 
        vs := (i Mod 5); 
        If s_bCircularSource[vs] Then 
        begin 
            s_nSource := vs; 
            SetVs(s_nSource); 
            break; 
        end; 
    end; 
end; 
 
procedure TformCapPic.FormCreate(Sender: TObject); 
begin 
    InitCapPicGlobal(); 
end; 
 
procedure TformCapPic.FormShow(Sender: TObject); 
begin 
    //为各路是否抓拍赋值 
    checkVideo1.Checked := s_bCircularSource[0]; 
    checkVideo2.Checked := s_bCircularSource[1]; 
    checkVideo3.Checked := s_bCircularSource[2]; 
    checkVideo4.Checked := s_bCircularSource[3]; 
    checkSVideo.Checked := s_bCircularSource[4]; 
 
    editTime.Text := IntToStr(s_nPersist); 
    editInterval.Text := IntToStr(s_nCycNum); 
    radioBmp.Checked := s_bCircularSnapBmp; 
    radioJpg.Checked := (Not s_bCircularSnapBmp); 
    editPath.Text := s_strCircularSnapDir; 
end; 
 
procedure TformCapPic.btnBrowseClick(Sender: TObject); 
    var 
    strPath : String; 
begin 
    strPath := ShellShowDirs(Handle); 
    If strPath <> '' Then 
    editPath.Text := strPath; 
end; 
 
procedure TformCapPic.btnStartClick(Sender: TObject); 
    var 
    i : Integer; 
begin 
    s_bContinuous := False;     // 不连续抓拍 
    s_nSkipFrame := -1;         // 初始化为-1,则第一帧不会跳过 
    s_nSnapSource := 0;         // 要抓通道数清零 
    s_nCircularPicCount := 1;   // 图编号从1开始 
     
    // 为各路是否抓拍赋值 
    s_bCircularSource[0] := checkVideo1.Checked; 
    s_bCircularSource[1] := checkVideo2.Checked; 
    s_bCircularSource[2] := checkVideo3.Checked; 
    s_bCircularSource[3] := checkVideo4.Checked; 
    s_bCircularSource[4] := checkSVideo.Checked; 
 
    // 取得要抓的通道数 
    For i := 0 To 4 Do 
    begin 
        If s_bCircularSource[i] Then 
        begin 
            s_nSnapSource := s_nSnapSource + 1; 
        end; 
    end; 
 
    // 所有通道都不抓,直接返回 
    If (s_nSnapSource = 0) Then 
        Exit; 
 
    // 取得第一个要抓的通道,并切到该通道 
    For i := 0 To 4 Do 
    begin 
        If s_bCircularSource[i] Then 
        begin 
            s_nSource := i; 
            SetVs(s_nSource); 
            break;             
        end; 
    end; 
 
    // 更新全局变量 
    s_nCycNum := StrToInt(editInterval.Text); 
    s_bCircularSnapBmp := radioBmp.Checked; 
    s_strCircularSnapDir := editPath.Text; 
    s_nPersist := StrToInt(editTime.Text); 
 
    TimerCapPic.Interval :=  s_nPersist * 1000; 
    TimerCapPic.Enabled := True; 
 
    // 开始抓图 
    VCAEnableCapSourceStream(g_nCard, ToVcbool(True), Interlaced_Field, Addr(MyPrcPic)); 
end; 
 
procedure TformCapPic.TimerCapPicTimer(Sender: TObject); 
begin 
    TimerCapPic.Enabled := False; 
    VCAEnableCapSourceStream(g_nCard, ToVcbool(False), Interlaced_Field, Addr(MyPrcPic)); 
    SetVs(g_nCurVs); 
    ShowMessage('循环抓拍完成!'); 
end; 
 
procedure TformCapPic.btnSelectAllClick(Sender: TObject); 
begin 
    checkVideo1.Checked := True; 
    checkVideo2.Checked := True; 
    checkVideo3.Checked := True; 
    checkVideo4.Checked := True; 
    checkSVideo.Checked := True; 
end; 
 
procedure TformCapPic.btnExitClick(Sender: TObject); 
begin 
    Close(); 
end; 
 
end.