www.pudn.com > delphi-Sdk3000-ocx.zip > Main.pas, change:2005-05-23,size:7784b


unit Main; 
 
interface 
 
uses 
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
  Dialogs, StdCtrls, ExtCtrls; 
 
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; 
    btnStartInHigh: TButton; 
    btnStartInLow: TButton; 
    btnStartMD: TButton; 
    Label1: TLabel; 
    comboVideoSource: TComboBox; 
    wndVideo: TPanel; 
    btnReadE2C: TButton; 
    btnWriteE2C: TButton; 
    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 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); 
    procedure btnWriteE2CClick(Sender: TObject); 
    procedure btnReadE2CClick(Sender: TObject); 
  private 
    { Private declarations } 
  public 
    { Public declarations } 
  end; 
 
var 
  formMain: TformMain; 
 
implementation 
 
uses sdk3000, Global, OsdSet, CaptureSet, ColorProperty, CapPic; 
 
var 
s_bInput : Boolean; // 用于IO 
s_bMove : Boolean;  // 用于动态检测 
 
// IO回调 
procedure MyPrcIoAlertCallBack(nCardID: Integer);stdcall; 
begin 
    If Not s_bInput Then 
    begin 
        s_bInput := True; 
        ShowMessage('IO input'); 
    end; 
end; 
 
// 动态检测回调 
procedure MyPrcCbMotionDetect(nCardID: Integer; bMove: VCBOOL; pContext: pointer);stdcall; 
begin 
    If Not s_bMove Then 
    begin 
        s_bMove := True; 
 
        ShowMessage('动态检测成功,抓拍到: ' + g_strPicturePath + 'motion.bmp'); 
        VCACapturePicture(g_nCard, PAnsiChar(g_strPicturePath + 'motion.bmp'), IMAGE_BMP, PRect(0), 100, 1, ToVcbool(False)); 
    end 
end; 
 
{$R *.dfm} 
 
procedure TformMain.FormCreate(Sender: TObject); 
begin 
 
    //全局变量初始化. 
    InitGlobalVar(); 
 
    s_bInput := False; 
    s_bMove := False; 
end; 
 
procedure TformMain.FormShow(Sender: TObject); 
begin 
    g_hWnd := wndVideo.Handle; 
    VCAInitSdk(); 
    Connect(); //连接 
end; 
 
procedure TformMain.FormClose(Sender: TObject; var Action: TCloseAction); 
begin 
    VCADisConnectDevice(g_nCard); 
    VCAUnInitSdk(); 
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 
    VCASetCurrentVideoCompressor(g_nCard, PChar(g_strCurComp)); 
     
    cur := Now(); 
    ShortDateFormat := 'yyyymmdd-hhnnss'; 
    strFile := g_strVideoPath + DateToStr(cur) + '.avi'; 
    VCASetCaptureFile(g_nCard, PChar(strFile)); 
 
    VCAStartCapture(g_nCard); 
 
    btnStartCapture.Enabled := False; 
    btnStopCapture.Enabled := True; 
end; 
 
procedure TformMain.btnStopCaptureClick(Sender: TObject); 
begin 
    VCAStopCapture(g_nCard); 
    Connect(); 
     
    btnStartCapture.Enabled := True; 
    btnStopCapture.Enabled := False; 
end; 
 
procedure TformMain.btnRunClick(Sender: TObject); 
begin 
    VCARun(g_nCard); 
    g_nPlayState := 1; 
     
    btnRun.Enabled := False; 
    btnPause.Enabled := True; 
end; 
 
procedure TformMain.btnPauseClick(Sender: TObject); 
begin 
    VCACapturePicture(g_nCard, 'C:\ocx.bmp', IMAGE_BMP, PRect(0), 100, 1, ToVcbool(False)); 
    Sleep (150); 
 
    VCACapturePicture(g_nCard, 'C:\ocx.jpg', IMAGE_JPG, PRect(0), 100, 1, ToVcbool(False)); 
    Sleep (150); 
 
    VCAPause(g_nCard); 
    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 
        VCACapturePicture(g_nCard, PAnsiCHar(strFile + '.bmp'),IMAGE_BMP, PRect(0), 100, 1, ToVcbool(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 
        VCACapturePicture(g_nCard, PAnsiCHar(strFile + '.jpg'), IMAGE_JPG, PRect(0), 100, 1, ToVcbool(False)) 
 
    Else 
        CopyFile(PAnsiCHar('C:\ocx.jpg'), PAnsiCHar(strFile + '.jpg'), False); 
end; 
 
procedure TformMain.btnCircularSnapClick(Sender: TObject); 
begin 
    formCapPic.ShowModal(); 
end; 
 
procedure TformMain.btnOutHighClick(Sender: TObject); 
begin 
    VCAIOAlertOut(g_nCard, ToVcbool(True)); 
end; 
 
procedure TformMain.btnOutLowClick(Sender: TObject); 
begin 
    VCAIOAlertOut(g_nCard, ToVcbool(False)); 
end; 
 
procedure TformMain.btnInitInClick(Sender: TObject); 
begin 
    VCAInitIOAlertIn(g_nCard, Addr(MyPrcIoAlertCallBack)); 
end; 
 
procedure TformMain.btnStartInHighClick(Sender: TObject); 
begin 
    s_bInput := False; 
    VCAStartIOAlertIn(g_nCard, ToVcbool(True)); 
end; 
 
procedure TformMain.btnStartInLowClick(Sender: TObject); 
begin 
    s_bInput := False; 
    VCAStartIOAlertIn(g_nCard, ToVcbool(False)); 
end; 
 
procedure TformMain.btnStopInClick(Sender: TObject); 
begin 
    VCAStopIOAlertIn(g_nCard); 
end; 
 
procedure TformMain.btnStartMDClick(Sender: TObject); 
    var 
    nDetectWidth : Integer; 
    nDetectHeight : Integer; 
    nDetectBlocks : Integer; 
    pAreaMap : String; 
begin 
    s_bMove := False; 
 
    nDetectWidth := g_szVidSize.cx div 16; 
    nDetectHeight := g_szVidSize.cy div 16; 
    nDetectBlocks := nDetectWidth * nDetectHeight; 
    pAreaMap := StringOfChar('0', nDetectBlocks); 
    VCAEnableMotionDetect(g_nCard, ToVcbool(True), PByte(pAreaMap), nDetectBlocks, 10, Pointer(0), Addr(MyPrcCbMotionDetect)); 
end; 
 
procedure TformMain.btnStopMDClick(Sender: TObject); 
begin 
    VCAEnableMotionDetect(g_nCard, ToVcbool(False), PByte(0), 0, 0, Pointer(0), Addr(MyPrcCbMotionDetect)); 
end; 
 
procedure TformMain.btnExitClick(Sender: TObject); 
begin 
    Close(); 
end; 
 
procedure TformMain.comboVideoSourceChange(Sender: TObject); 
begin 
    g_nCurVs := comboVideoSource.ItemIndex; 
    SetVs(g_nCurVs); 
end; 
 
procedure TformMain.btnWriteE2CClick(Sender: TObject); 
    var 
    i : Integer; 
begin 
    For i := 0 To 5 Do 
        VCAWriteE2C(0, i, Byte(48+i)); 
end; 
 
procedure TformMain.btnReadE2CClick(Sender: TObject); 
    var 
    cData : Byte; 
begin 
    VCAReadE2C(0, 1, cData);  
end; 
 
end.