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


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); 
  private 
    { Private declarations } 
    m_nCurVideo: Integer; 
  public 
    { Public declarations } 
  end; 
 
var 
  formCapPic: TformCapPic; 
 
implementation 
 
uses Main, CaptureSet; 
{$R *.dfm} 
 
procedure MyPrcPic(lnCardID : Integer; pBuf : Integer; lnWidth : Integer; lnHeight : Integer; lnBiCount : Integer);stdcall; 
    var 
    strFile : String; 
    vs : Integer; 
    i  : Integer; 
begin 
    If g_bContinuous Then 
        Exit; 
 
    If (g_nCapSourceCount = 1) And (g_nCycNum = 1) Then 
    begin 
        g_bContinuous := True; 
 
        If g_bCircularSnapBmp Then 
        begin 
            strFile := g_strCircularSnapDir + 'Video' + IntToStr(g_nSource + 1) + '_Bmp'; 
            formMain.SDK30001.SaveImageToBmp(strFile, g_nPersist * 25, False); 
        end 
        Else 
        begin 
            strFile := g_strCircularSnapDir + 'Video' + IntToStr(g_nSource + 1) + '_Jpg'; 
            formMain.SDK30001.SaveImageToJpg(strFile, 100, g_nPersist * 25, False); 
        end; 
 
        Exit; 
    end; 
 
    g_nPic := (g_nPic + 1) Mod g_nCycNum; 
    If g_nPic <> 0 Then 
        Exit; 
 
    If g_bCircularSnapBmp Then 
    begin 
        strFile := g_strCircularSnapDir + 'Video' + IntToStr(g_nSource + 1) + '_Bmp' + IntToStr(g_nCircularPicCount) + '.bmp'; 
        formMain.SDK30001.SaveImageToBmp(strFile, 1, False); 
    end 
    Else 
    begin 
        strFile := g_strCircularSnapDir + 'Video' + IntToStr(g_nSource + 1) + '_Jpg' + IntToStr(g_nCircularPicCount) + '.jpeg'; 
        formMain.SDK30001.SaveImageToJpg(strFile, 100, 1, False); 
    end; 
 
    g_nCircularPicCount := g_nCircularPicCount + 1; 
 
    For i := (g_nSource + 1) To 10 Do 
    begin 
        vs := (i Mod 5); 
        If g_bCircularSource[vs] Then 
        begin 
            formMain.SDK30001.VideoSource := vs; 
            g_nSource := vs; 
            break; 
        end; 
    end; 
end; 
 
procedure TformCapPic.FormShow(Sender: TObject); 
begin 
    //为各路是否抓拍赋值 
    If g_bCircularSource[0] Then 
        checkVideo1.Checked := True; 
 
    If g_bCircularSource[1] Then 
        checkVideo2.Checked := True; 
 
    If g_bCircularSource[2] Then 
        checkVideo3.Checked := True; 
 
    If g_bCircularSource[3] Then 
        checkVideo4.Checked := True; 
 
    If g_bCircularSource[4] Then 
        checkSVideo.Checked := True; 
 
    editInterval.Text := IntToStr(g_nCycNum); 
    editPath.Text := g_strCircularSnapDir; 
    radioBmp.Checked := g_bCircularSnapBmp; 
    editTime.Text := IntToStr(g_nPersist); 
 
    g_bContinuous := False; 
    g_nCapSourceCount := 0; 
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 
 
    // 为各路是否抓拍赋值 
    g_bCircularSource[0] := checkVideo1.Checked; 
    g_bCircularSource[1] := checkVideo2.Checked; 
    g_bCircularSource[2] := checkVideo3.Checked; 
    g_bCircularSource[3] := checkVideo4.Checked; 
    g_bCircularSource[4] := checkSVideo.Checked; 
 
    // 取得第一个要抓的通道 
    For i := 0 To 4 Do 
    begin 
        If g_bCircularSource[i] Then 
        begin 
            g_nCapSourceCount := g_nCapSourceCount + 1; 
            g_nSource := i; 
            break; 
        end; 
    end; 
 
    // 所有通道都不抓,直接返回 
    If g_nCapSourceCount = 0 Then 
        Exit; 
     
    // 更新全局变量 
    g_nCycNum := StrToInt(editInterval.Text); 
    g_bCircularSnapBmp := radioBmp.Checked; 
    g_strCircularSnapDir := editPath.Text; 
    g_nPersist := StrToInt(editTime.Text); 
 
    g_nCircularPicCount := 1; 
 
    // 记录当前通道 
    m_nCurVideo := formMain.SDK30001.VideoSource; 
    formMain.SDK30001.VideoSource := g_nSource; 
    TimerCapPic.Interval :=  g_nPersist * 1000; 
    TimerCapPic.Enabled := True; 
 
    // 开始抓图 
    If Not formMain.SDK30001.EnableCapSourceStream(3, Integer(Addr(MyPrcPic))) Then 
        ShowMessage('无法启动抓拍'); 
end; 
 
procedure TformCapPic.TimerCapPicTimer(Sender: TObject); 
begin 
    TimerCapPic.Enabled := False; 
    formMain.SDK30001.DisableCapSourceStream(); 
    formMain.SDK30001.VideoSource := m_nCurVideo; 
    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.