unitmain.pas

来自「智能监控delphi源码, 操作说明 1. 在两台微机上分别运行文件夹中的可」· PAS 代码 · 共 1,203 行 · 第 1/3 页

unit UnitMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, StdCtrls, ExtCtrls, ComCtrls, Videocap, DB, ADODB,
  Buttons, SPComm;

type
  TFormMain = class(TForm)
    memu: TMainMenu;
    View: TMenuItem;
    Help: TMenuItem;
    grp1: TGroupBox;
    grp2: TGroupBox;
    btnStartGet1: TButton;
    btnStopMoniter1: TButton;
    btnStartGet2: TButton;
    btnStopMoniter2: TButton;
    stat1: TStatusBar;
    SysTime: TTimer;
    File1: TMenuItem;
    NExit1: TMenuItem;
    Edit1: TMenuItem;
    StopGet: TMenuItem;
    StartGet: TMenuItem;
    NStartGet1: TMenuItem;
    NStartGet2: TMenuItem;
    NStopGet1: TMenuItem;
    NStopGet2: TMenuItem;
    Nop4: TMenuItem;
    VideoCap1: TVideoCap;
    VideoCap2: TVideoCap;
    LvEvent: TMenuItem;
    NRec: TMenuItem;
    NOpenAvi1: TMenuItem;
    NOpenAvi2: TMenuItem;
    dlgOpen1: TOpenDialog;
    N3: TMenuItem;
    N4: TMenuItem;
    NStartMoniter: TMenuItem;
    NStopMoniter: TMenuItem;
    N7: TMenuItem;
    NStartMoniter1: TMenuItem;
    NStartMoniter2: TMenuItem;
    NStopMoniter1: TMenuItem;
    NStopMoniter2: TMenuItem;
    BtnAM: TBitBtn;
    Comm1: TComm;
    tmrRevStr: TTimer;
    pnlShowRecoderMessageA: TPanel;
    pnlShowRecoderMessageB: TPanel;
    btnClearDB: TButton;
    tmrDelayAuto1: TTimer;
    tmrDelayAuto2: TTimer;
    tmrDelayMan1: TTimer;
    tmrDelayMan2: TTimer;
    Shape1: TShape;
    Shape2: TShape;
    tmrFlash1: TTimer;
    tmrFlash2: TTimer;
    Image1: TImage;
    Image2: TImage;
    Setup: TMenuItem;
    SelectMode1: TMenuItem;
    SelectAlarm: TMenuItem;
    MoniterMode: TMenuItem;
    SetTime: TMenuItem;
    ManMode: TMenuItem;
    ComputerMode: TMenuItem;
    AlarmOn: TMenuItem;
    AlarmOff: TMenuItem;
    MoniterAll: TMenuItem;
    MoniterNo1: TMenuItem;
    MoniterNo2: TMenuItem;
    Choise10s: TMenuItem;
    Choise20s: TMenuItem;
    Choise30s: TMenuItem;
    Choise60s: TMenuItem;
    N5: TMenuItem;
    procedure btnStartGet1Click(Sender: TObject);
    procedure btnStartGet2Click(Sender: TObject);
    procedure SysTimeTimer(Sender: TObject);
    procedure NExit1Click(Sender: TObject);
    procedure AlarmOnClick(Sender: TObject);
    procedure AlarmOffClick(Sender: TObject);
    procedure NStartGet1Click(Sender: TObject);
    procedure NStopGet1Click(Sender: TObject);
    procedure NStartGet2Click(Sender: TObject);
    procedure NStopGet2Click(Sender: TObject);
    procedure MoniterAllClick(Sender: TObject);
    procedure MoniterNo1Click(Sender: TObject);
    procedure MoniterNo2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure btnStopMoniter1Click(Sender: TObject);
    procedure btnStopMoniter2Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure NRecClick(Sender: TObject);
    procedure NStartMoniter1Click(Sender: TObject);
    procedure NStartMoniter2Click(Sender: TObject);
    procedure NStopMoniter1Click(Sender: TObject);
    procedure NStopMoniter2Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure BtnAMClick(Sender: TObject);
    procedure Comm1ReceiveData(Sender: TObject; Buffer: Pointer;
      BufferLength: Word);
    procedure tmrRevStrTimer(Sender: TObject);
    procedure NOpenAvi1Click(Sender: TObject);
    procedure NOpenAvi2Click(Sender: TObject);
    procedure btnClearDBClick(Sender: TObject);
    procedure tmrDelayAuto1Timer(Sender: TObject);
    procedure tmrDelayAuto2Timer(Sender: TObject);
    procedure tmrDelayMan1Timer(Sender: TObject);
    procedure tmrDelayMan2Timer(Sender: TObject);
    procedure tmrFlash1Timer(Sender: TObject);
    procedure tmrFlash2Timer(Sender: TObject);
    procedure ManModeClick(Sender: TObject);
    procedure ComputerModeClick(Sender: TObject);
    procedure Choise10sClick(Sender: TObject);
    procedure Choise20sClick(Sender: TObject);
    procedure Choise30sClick(Sender: TObject);
    procedure Choise60sClick(Sender: TObject);

  private
    { Private declarations }


  public
    function GetAviDir(n: Integer): string; //得到Avi文件夹地址
    function GetInfDir(): string; //得到Inf文件夹地址
    function GetDataBaseDir(): string; //得到DataBase文件夹地址
    function FIntToStr(Strn: string): string; //格式化视频文件名
    function WriteDB(ATime: TDateTime; AFileName: string; AString: string): integer; //往数据库写数据
    function GetDefaultAviName: string; //视频文件名的编号
    procedure Delay(msecs: integer);
    procedure Flash1; //发生异常情况时会在主窗体上有一个报警闪烁
    procedure Flash2;
    function SaveStrChangedA: Boolean;
    function SaveStrChangedB: Boolean;
    function CommRevStrChanged: Boolean;
    procedure StartRecordA;
    procedure StopRecordA;
    procedure StartRecordB;
    procedure StopRecordB;
    procedure ChangeNumberA;
    procedure ChangeNumberB;

  end;

var
  FormMain: TFormMain;
  rec1: Boolean; //摄像头1是否摄像的标志；当rec1 =1或true时 表示摄像  当为0或false时 表示不摄像；
  rec2: Boolean; //摄像头2是否摄像的标志；当rec2 =1或true时 表示摄像  当为0或false时 表示不摄像；
  nn, nn1, nn2: Integer; //文件存盘编号；
  str, str1, str2: string; //中间变量；
  strn, strn1, strn2, strn1Bak, strn2Bak: string;
  f, f1, f2: TextFile; // 创建文件时要用的变量；
  CommRevStr, CommRevStrBak, CommRevStrBakA, CommRevStrBakB: WideString; //接收字符串
  SSRec1, OCMon1, SSRec2, OCMon2, AM: Boolean; //开始-结束录像 打开-关闭监控  手动-自动监控
  FlashN1, FlashN2: string; //报警闪烁
  DateBak, TimeBak: TDateTime;
  AOrM: Integer;

implementation

uses UnitNo1, UnitNo2, UnitDataBase, UnitFormRec;


{$R *.dfm}
//编写窗体成员函数GetAviDir，该函数的功能是得到视频文件存放的具体文件夹。
//将其写成为一个函数，以便修改和维护。代码如下：

function TFormMain.GetAviDir(n: Integer): string;
begin
  Result := '.\avi' + IntToStr(n); ;
end;


//编写窗体成员函数GetInfDir,该函数的功能是得到文本文件存放的具体文件夹。
//将其写成为一个函数，以便修改和维护。代码如下：

function TFormMain.GetInfDir: string;
begin
  Result := '.\inf';
end;


//编写窗体成员函数GetDataBaseDir,该函数的功能是得到数据库文件存放的具体文件夹。
//将其写成为一个函数，以便修改和维护。代码如下：

function TFormMain.GetDataBaseDir: string;
begin
  Result := '.\database';
end;


//编写窗体成员函数WriteDB,该函数的功能是将异常情况的相应信息写入数据库，
//该函数被函数tmrControlTimer和函数btnStartGet1Click调用 。代码如下：

function TFormmain.WriteDB(ATime: TDateTime; AFileName: string; AString: string): integer;
begin
  Result := 1;
  try
        //数据模块中的事件记录表
    with DMMain.tblEvent do
    begin
      Append();
      FieldByName('EventTime').AsDateTime := ATime;
      FieldByName('AviName').AsString := AFileName;
      FieldByName('MoniterNumber').AsString := AString;
      Post();
    end;
  except
    Result := -1;
  end;
end;

//编写窗体成员函数GetDefaultAviName,该函数实现的功能是从数据库中得到默认的
//视频文件名称，默认文件名的规则为“00000001.avi,00000002.avi,...”。

function TFormmain.GetDefaultAviName: string;
var
  mQuery: TADOQuery;
  mMaxId: integer;
  mStr: string;
begin
  mStr := 'SELECT max(Event Id) FROM eventrec';
  //动态生成Qurry控件；
  mQuery := TADOQuery.Create(nil);
  with mQuery do
  begin
    //设置连接属性；
    Connection := DMMain.conMain;
    SQL.Clear;
    SQL.Add(mStr);
    try
      Open();
      //数据库中有数据；
      if not Fields[0].IsNull then
      begin
        mMaxId := Fields[0].Value + 1;
        Result := FIntToStr(IntToStr(mMaxId)) + '.avi';
      end
      else //数据库为空；
      begin
        Result := FIntToStr(IntToStr(1)) + '.avi';
      end;
    except
      Result := '';
    end;
  end;
end;

//编写窗体成员函数FIntToStr,该函数的功能是完成整形数据到字符串的转换，
//如果整形数据不足8位，前面用零补齐

function TFormmain.FIntToStr(Strn: string): string;
begin
  while length(Strn) <= 7 do
  begin
    Strn := '0' + Strn;
  end;
  result := Strn;
end;


procedure TFormMain.Delay(msecs: Integer);
var
  FirstTickCount: LongInt;
begin
  FirstTickCount := GetTickCount;
  repeat
    Application.ProcessMessages; {allowing access to other controls etc.}
  until ((GetTickCount - FirstTickCount) >= LongInt(msecs));
end;

//完成在出现异常情况下时的报警闪烁功能

procedure TFormMain.Flash1;
begin
  if FlashN1 = '0' then
  begin
    Shape1.Brush.Color := clRed;
    FlashN1 := '1';
    Exit;
  end;
  if FlashN1 = '1' then
  begin
    Shape1.Brush.Color := clBtnFace;
    FlashN1 := '0';
    Exit;
  end;
end;

procedure TFormMain.Flash2;
begin
  if FlashN2 = '0' then
  begin
    Shape2.Brush.Color := clRed;
    FlashN2 := '1';
    Exit;
  end;
  if FlashN2 = '1' then
  begin
    Shape2.Brush.Color := clBtnFace;
    FlashN2 := '0';
    Exit;
  end;
end;


function TFormMain.CommRevStrChanged: Boolean;
begin
  if CompareStr(CommRevStr, CommRevStrBak) <> 0 then Result := True
  else Result := False;
  CommRevStrBak := CommRevStr;
end;


function TFormMain.SaveStrChangedA: Boolean;
begin
  if CompareStr(strn1, strn1Bak) <> 0 then Result := True
  else Result := False;
  strn1Bak := strn1;
end;


function TFormMain.SaveStrChangedB: Boolean;
begin
  if CompareStr(strn2, strn2Bak) <> 0 then Result := True
  else Result := False;
  strn2Bak := strn2;
end;


procedure TFormMain.ChangeNumberA;
begin
  DateBak := Date;
  TimeBak := Time;
end;


procedure TFormMain.ChangeNumberB;
begin
  DateBak := Date;
  TimeBak := Time;
end;


procedure TFormMain.StartRecordA;
begin
  if strn1 = '' then strn1 := '1';
  VideoCap1.CapTimeLimit := 0;
  VideoCap1.VideoFileName := GetAviDir(1) + '\' + FIntToStr(Strn1) + '.avi';
  VideoCap1.StartCapture;
  VideoCap1.DlgVCompression;
  if SaveStrChangedA then
  begin
    WriteDB(DateBak + TimeBak, VideoCap1.VideoFileName, '1#摄像头出现异常情况'); //将有关的信息写入数据库；
  end;
  pnlShowRecoderMessageA.Caption := '摄像头A录制中……';
  tmrFlash1.Enabled := True;
  tmrDelayAuto1.Enabled := True; //启动定时,到时自动停止录像
  if AlarmOn.Checked then Image1.Visible := True; //如果启动报警,则出现
end;

procedure TFormMain.StopRecordA;
begin
  btnStartGet1.Caption := '开始录像';
  VideoCap1.StopCapture;
  pnlShowRecoderMessageA.Caption := '摄像头A停止录制';
  tmrFlash1.Enabled := False;
  Shape1.Brush.Color := clBtnFace;
  Image1.Visible:=False;
end;

procedure TFormMain.StartRecordB;
begin
  if strn2 = '' then strn2 := '1';
  VideoCap2.CapTimeLimit := 0;
  VideoCap2.VideoFileName := GetAviDir(2) + '\' + FIntToStr(Strn2) + '.avi';
  VideoCap2.StartCapture;
  VideoCap2.DlgVCompression;
  if SaveStrChangedB then
  begin
    WriteDB(DateBak + TimeBak, VideoCap2.VideoFileName, '2#摄像头出现异常情况'); //将有关的信息写入数据库；
  end;
  pnlShowRecoderMessageB.Caption := '摄像头B录制中……';
  tmrFlash2.Enabled := True;
  tmrDelayAuto2.Enabled := True;
  if AlarmOn.Checked then Image2.Visible := True;
end;

procedure TFormMain.StopRecordB;
begin
  btnStartGet2.Caption := '开始录像';
  VideoCap2.StopCapture;
  pnlShowRecoderMessageB.Caption := '摄像头B停止录制';
  tmrFlash2.Enabled := False;