www.pudn.com > delphi-Sdk3000-ocx.zip > Main.pas, change:2008-10-27,size:9426b


unit Main; 
 
interface 
 
uses 
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
  Dialogs, OleCtrls, SDK3000Lib_TLB, StdCtrls; 
 
type 
  TformMain = class(TForm) 
    btnOsdSet: TButton; 
    btnCaptureSet: TButton; 
    btnColorProperty: TButton; 
    btnInitIn: TButton; 
    btnStartCapture: TButton; 
    btnOutHigh: TButton; 
    btnExit: TButton; 
    btnStopMD: TButton; 
    btnStopIn: TButton; 
    btnStopCapture: TButton; 
    btnRun: TButton; 
    btnCircularSnap: TButton; 
    btnOutLow: TButton; 
    btnPause: TButton; 
    btnSnap: TButton; 
    btnCustomSnap: TButton; 
    btnStartInHigh: TButton; 
    btnStartInLow: TButton; 
    btnStartMD: TButton; 
    Label1: TLabel; 
    comboVideoSource: TComboBox; 
    SDK30001: TSDK3000; 
    procedure FormCreate(Sender: TObject); 
    procedure FormShow(Sender: TObject); 
    procedure FormClose(Sender: TObject; var Action: TCloseAction); 
    procedure btnOsdSetClick(Sender: TObject); 
    procedure btnCaptureSetClick(Sender: TObject); 
    procedure btnColorPropertyClick(Sender: TObject); 
    procedure btnStartCaptureClick(Sender: TObject); 
    procedure btnStopCaptureClick(Sender: TObject); 
    procedure btnRunClick(Sender: TObject); 
    procedure btnPauseClick(Sender: TObject); 
    procedure btnSnapClick(Sender: TObject); 
    procedure btnCircularSnapClick(Sender: TObject); 
    procedure btnCustomSnapClick(Sender: TObject); 
    procedure btnOutHighClick(Sender: TObject); 
    procedure btnOutLowClick(Sender: TObject); 
    procedure btnInitInClick(Sender: TObject); 
    procedure btnStartInHighClick(Sender: TObject); 
    procedure btnStartInLowClick(Sender: TObject); 
    procedure btnStopInClick(Sender: TObject); 
    procedure btnStartMDClick(Sender: TObject); 
    procedure btnStopMDClick(Sender: TObject); 
    procedure btnExitClick(Sender: TObject); 
    procedure comboVideoSourceChange(Sender: TObject); 
  private 
    { Private declarations } 
  public 
    { Public declarations } 
  end; 
 
var 
  formMain: TformMain; 
 
var 
//连接用到的全局变量 
g_bConnected : Boolean; 
g_nCapWidth : Integer; 
g_nCapHeight : Integer; 
g_nPlayState : Integer; //0:未连接 1:播放 2:暂停 3:停止 
 
//动态检测用到的全局变量 
g_bInput : Boolean; 
g_bMove : Boolean; 
 
//循环抓拍用到的全局变量 
g_nCycNum : Integer;   //每几帧抓一帧 
g_strCircularSnapDir : String; 
g_bCircularSource : Array[0..4] of Boolean; 
g_bCircularSnapBmp : Boolean; 
g_nPersist : Integer; 
g_nCapSourceCount : Integer; //要抓照的通道数量,若为1则连续拍. 
g_bContinuous : Boolean; //是否在连续拍 
 
g_nSource : Integer;    //当前要抓的通道,从0开始 
g_nPic : Integer;   //用于跳过不想抓的帧,只要开始赋初值0就行了,以后自动赋值 
g_nCircularPicCount : Integer; //当前抓的是第几张图,从1开始,每次抓前赋初值. 
 
//捕获参数设置用到的全局变量 
g_strVideoPath : String; 
g_strPicturePath : String; 
g_bBmp : Boolean; 
g_nCurComp : Integer; 
g_bRecAudio : Boolean; 
 
implementation 
 
uses OsdSet, CaptureSet, ColorProperty, CapPic; 
 
{$R *.dfm} 
 
procedure MyPrcIoAlertCallBack(lnCardID : Integer);stdcall; 
begin 
    If Not g_bInput Then 
        g_bInput := True; 
        ShowMessage('IO input'); 
end; 
 
procedure MyPrcCbMotionDetect(lnCardID : Integer; bMove : Integer; Reserved : Integer);stdcall; 
begin 
    If Not g_bMove Then 
    begin 
        g_bMove := True; 
 
        ShowMessage('动态检测成功,抓拍到: ' + g_strPicturePath + 'motion.bmp'); 
        formMain.SDK30001.SaveImageToBmp(g_strPicturePath + 'motion.bmp', 1, False) 
    end 
end; 
 
procedure TformMain.FormCreate(Sender: TObject); 
    var 
    i : Integer; 
begin 
 
    //全局变量初始化. 
    //连接用到的全局变量 
    g_bConnected := False; 
    g_nCapWidth := 720; 
    g_nCapHeight := 576; 
    g_nPlayState := 0; 
    g_bRecAudio := False; 
 
    //动态检测用到的全局变量 
    g_bInput := False; 
    g_bMove := False; 
 
    //循环抓拍用到的全局变量 
    g_nCycNum := 5; 
    g_nPic := 0; 
    g_strCircularSnapDir := 'e:\'; 
    g_nSource := 0; 
    g_nCircularPicCount := 1; 
    g_bCircularSnapBmp := False; 
    g_nPersist := 2; 
    g_nCapSourceCount := 5; 
    g_bContinuous := False; 
 
    g_bCircularSource[0] := True; 
    For i := 1 To 4 Do 
        g_bCircularSource[i] := False; 
 
    //捕获参数设置用到的全局变量 
    g_strVideoPath := 'e:\'; 
    g_strPicturePath := 'e:\'; 
    g_nCurComp := -1; 
    g_bBmp := False; 
end; 
 
procedure TformMain.FormShow(Sender: TObject); 
begin 
    //本窗体变量初始化 
    comboVideoSource.ItemIndex := 0; 
 
    //连接 
    SDK30001.Connect(0, True, g_nCapWidth, g_nCapHeight); 
 
    //全局变量更新 
    g_bConnected := True; 
    g_nPlayState := 1; 
end; 
 
procedure TformMain.FormClose(Sender: TObject; var Action: TCloseAction); 
begin 
    If g_bConnected Then 
    begin 
        SDK30001.Disconnect(); 
        g_bConnected := False; 
    end 
 
end; 
 
procedure TformMain.btnOsdSetClick(Sender: TObject); 
begin 
    formOsdSet.ShowModal(); 
end; 
 
procedure TformMain.btnCaptureSetClick(Sender: TObject); 
begin 
    formCaptureSet.ShowModal(); 
end; 
 
procedure TformMain.btnColorPropertyClick(Sender: TObject); 
begin 
    formColorProperty.ShowModal(); 
end; 
 
procedure TformMain.btnStartCaptureClick(Sender: TObject); 
    var 
    cur : TDateTime; 
    strFile : String; 
begin 
    cur := Now(); 
    ShortDateFormat := 'yyyymmdd-hhnnss'; 
    strFile := g_strVideoPath + DateToStr(cur) + '.avi'; 
    SDK30001.SetCurVideoCompressor(g_nCurComp); 
    SDK30001.StartCapture(strFile, -1); 
    btnStartCapture.Enabled := False; 
    btnStopCapture.Enabled := True; 
end; 
 
procedure TformMain.btnStopCaptureClick(Sender: TObject); 
begin 
    If Not SDK30001.StopCapture() Then 
        ShowMessage('error'); 
 
    btnStartCapture.Enabled := True; 
    btnStopCapture.Enabled := False; 
end; 
 
procedure TformMain.btnRunClick(Sender: TObject); 
begin 
    If Not SDK30001.Run() Then 
        ShowMessage('error'); 
 
    g_nPlayState := 1; 
    btnRun.Enabled := False; 
    btnPause.Enabled := True; 
end; 
 
procedure TformMain.btnPauseClick(Sender: TObject); 
begin 
    SDK30001.SaveImageToBmp('C:\ocx.bmp', 1, False); 
    Sleep (150); 
 
    SDK30001.SaveImageToJpg('C:\ocx.jpg', 100, 1, False); 
    Sleep (150); 
 
    If Not SDK30001.Pause() Then 
    begin 
        ShowMessage('error'); 
        Exit; 
    end; 
 
    g_nPlayState := 2; 
    btnRun.Enabled := True; 
    btnPause.Enabled := False; 
end; 
 
procedure TformMain.btnSnapClick(Sender: TObject); 
    var 
    cur : TDateTime; 
    strFile : String; 
begin 
    cur := Now(); 
    ShortDateFormat := 'yyyymmdd-hhnnss'; 
    strFile := g_strPicturePath + DateToStr(cur); 
    If (g_nPlayState = 1) And g_bBmp Then 
        SDK30001.SaveImageToBmp(strFile + '.bmp', 1, False) 
     
    Else If (g_nPlayState = 2) And g_bBmp Then 
        CopyFile(PAnsiCHar('C:\ocx.bmp'), PAnsiCHar(strFile + '.bmp'), False) 
 
    Else If (g_nPlayState = 1) And Not g_bBmp Then 
        SDK30001.SaveImageToJpg(strFile + '.jpg', 100, 1, False) 
 
    Else 
        CopyFile(PAnsiCHar('C:\ocx.jpg'), PAnsiCHar(strFile + '.jpg'), False); 
end; 
 
procedure TformMain.btnCircularSnapClick(Sender: TObject); 
begin 
    formCapPic.ShowModal(); 
end; 
 
procedure TformMain.btnCustomSnapClick(Sender: TObject); 
    var 
    cur : TDateTime; 
    strFile : String; 
begin 
    cur := Now(); 
    ShortDateFormat := 'yyyymmdd-hhnnss'; 
    strFile := g_strPicturePath + DateToStr(cur); 
    If (g_nPlayState = 1) And g_bBmp Then 
    begin 
        If Not SDK30001.SaveRangeToBmp(strFile + '.bmp', 0, 0, 0, 0) Then 
            ShowMessage('请选择区域'); 
    end 
 
    Else If (g_nPlayState = 1) And Not g_bBmp Then 
    begin 
        If Not SDK30001.SaveRangeToJpg(strFile + '.jpg', 100, 0, 0, 0, 0) Then 
            ShowMessage('请选择区域'); 
    end 
end; 
 
procedure TformMain.btnOutHighClick(Sender: TObject); 
begin 
    SDK30001.IOAlertOut(True); 
end; 
 
procedure TformMain.btnOutLowClick(Sender: TObject); 
begin 
    SDK30001.IOAlertOut(False); 
end; 
 
procedure TformMain.btnInitInClick(Sender: TObject); 
begin 
    g_bInput := False; 
    SDK30001.InitIOAlertIn(Integer(Addr(MyPrcIoAlertCallBack))); 
end; 
 
procedure TformMain.btnStartInHighClick(Sender: TObject); 
begin 
    SDK30001.StartIOAlertIn(True); 
end; 
 
procedure TformMain.btnStartInLowClick(Sender: TObject); 
begin 
    SDK30001.StartIOAlertIn(False); 
end; 
 
procedure TformMain.btnStopInClick(Sender: TObject); 
begin 
    SDK30001.StopIOAlertIn(); 
    g_bInput := False; 
end; 
 
procedure TformMain.btnStartMDClick(Sender: TObject); 
    var 
    nDetectWidth : Integer; 
    nDetectHeight : Integer; 
    nDetectBlocks : Integer; 
    pAreaMap : WideString; 
begin 
    nDetectWidth := g_nCapWidth div 16; 
    nDetectHeight := g_nCapHeight div 16; 
    nDetectBlocks := nDetectWidth * nDetectHeight; 
    pAreaMap := StringOfChar(WideChar(48), nDetectBlocks); 
    SDK30001.EnableMotionDetect(pAreaMap, nDetectBlocks, 10, Integer(Addr(MyPrcCbMotionDetect))); 
end; 
 
procedure TformMain.btnStopMDClick(Sender: TObject); 
begin 
    SDK30001.DisableMotionDetect(); 
end; 
 
procedure TformMain.btnExitClick(Sender: TObject); 
begin 
    Close(); 
end; 
 
procedure TformMain.comboVideoSourceChange(Sender: TObject); 
begin 
    If g_bConnected Then 
        SDK30001.VideoSource := comboVideoSource.ItemIndex; 
end; 
 
end.