unitmain.~pa

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

unit UnitMain;

interface

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

type
  TFormMain = class(TForm)
    memu: TMainMenu;
    View: TMenuItem;
    NewFiles: TMenuItem;
    Help: TMenuItem;
    grp1: TGroupBox;
    grp2: TGroupBox;
    grp3: TGroupBox;
    btnStartGet1: TButton;
    btnStopMoniter1: TButton;
    btnStartGet2: TButton;
    btnStopMoniter2: TButton;
    btnStartGet3: TButton;
    btnStopMoniter3: TButton;
    tmr1: TTimer;
    tmr2: TTimer;
    tmr3: TTimer;
    stat1: TStatusBar;
    SysTime: TTimer;
    dlgOpen1: TOpenDialog;
    File1: TMenuItem;
    Exit1: TMenuItem;
    Nop2: TMenuItem;
    PrintSetup1: TMenuItem;
    Nop1: TMenuItem;
    SaveAs1: TMenuItem;
    Save1: TMenuItem;
    Open1: TMenuItem;
    Print1: TMenuItem;
    Close1: TMenuItem;
    Edit1: TMenuItem;
    SelectAlarm: TMenuItem;
    SelectMode: TMenuItem;
    Nop4: TMenuItem;
    ModifyPassword: TMenuItem;
    ModifyUser: TMenuItem;
    Nop3: TMenuItem;
    StopGet: TMenuItem;
    StartGet: TMenuItem;
    NStartGet1: TMenuItem;
    NStartGet2: TMenuItem;
    NStartGet3: TMenuItem;
    NStopGet1: TMenuItem;
    NStopGet2: TMenuItem;
    NStopGet3: TMenuItem;
    ManMode: TMenuItem;
    ComputerMode: TMenuItem;
    AlarmOn: TMenuItem;
    AlarmOff: TMenuItem;
    Nop5: TMenuItem;
    AllFiles: TMenuItem;
    dlgSave1: TSaveDialog;
    dlgPnt1: TPrintDialog;
    dlgFind1: TFindDialog;
    MoniterMode: TMenuItem;
    MoniterAll: TMenuItem;
    MoniterNo1: TMenuItem;
    MoniterNo2: TMenuItem;
    MoniterNo3: TMenuItem;
    VideoCap1: TVideoCap;
    VideoCap2: TVideoCap;
    VideoCap3: TVideoCap;
    N1: TMenuItem;
    LvEvent: TMenuItem;
    procedure btnStartGet1Click(Sender: TObject);
    procedure btnStartGet2Click(Sender: TObject);
    procedure btnStartGet3Click(Sender: TObject);
    procedure SysTimeTimer(Sender: TObject);
    //procedure N8Click(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
    procedure ManModeClick(Sender: TObject);
    procedure ComputerModeClick(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 NStartGet3Click(Sender: TObject);
    procedure NStopGet3Click(Sender: TObject);
    procedure Open1Click(Sender: TObject);
    procedure Save1Click(Sender: TObject);
    procedure SaveAs1Click(Sender: TObject);
    procedure MoniterAllClick(Sender: TObject);
    procedure MoniterNo1Click(Sender: TObject);
    procedure MoniterNo2Click(Sender: TObject);
    procedure MoniterNo3Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure LvEventClick(Sender: TObject);
    procedure VideoCap1Status(Sender: TObject);
   // procedure SelectDriveClick(Sender: TObject);
  private
    { Private declarations }
    function GetAviDir(): string; //得到Avi文件夹地址
    function GetInfDir(): string; //得到Inf文件夹地址
    function GetDataBaseDir(): string; //得到DataBase文件夹地址
    function FIntToStr(Strn: string): string; //格式化视频文件名
    function WriteDB(ATime: TDateTime; AFileName: string): integer; //往数据库写数据
    function GetDefaultAviName: string;
    procedure Delay(msecs: integer);


  public
    rec1: Boolean; //摄像头1是否摄像的标志；当rec1 =1或true时 表示摄像  当为0或false时 表示不摄像；
    rec2: Boolean; //摄像头2是否摄像的标志；当rec2 =1或true时 表示摄像  当为0或false时 表示不摄像；
    rec3: Boolean; //摄像头2是否摄像的标志；当rec3 =1或true时 表示摄像  当为0或false时 表示不摄像；
    n, n111, n2, n3: Integer; //文件存盘编号；
    str, str1, str2, str3: string; //中间变量；
    strn, strn1, strn2, strn3: string;
    f, f1, f2, f3: TextFile; // 创建文件时要用的变量；


  end;

var
  FormMain: TFormMain;

implementation

uses UnitNo1, UnitNo2, UnitNo3, UnitDataBase;



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

function TFormMain.GetAviDir: string;
begin
  Result := '.\avi';
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
    //数据库模块中的事件记录表；
    begin
      with DMMain.tblEvent do
      begin
        Append();
        FiledByName('EventTime').AsDateTime := ATime;
        FiledByName('AviName').AsString := AFileName;
        FiledByName('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
      begin
        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;
//var  Strn: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.btnStartGet1Click(Sender: TObject);
var
  MoniterNo: string; //记录摄像头编号的字符串信息，以方便写入数据库；
begin
//让btnStartGet1按一下显示‘停止录像 ’，再按一下显示‘开始录像’；
  tmr1.Enabled := not tmr1.Enabled;
  FormNo1.tmr1.Enabled := not FormNo1.tmr1.Enabled;
  if (tmr1.Enabled) then
  begin
    MoniterNo： = '1#摄像头有异常情况';
    rec1 := true; //置录像标志为1，表示正在录像；
    btnStartGet1.Caption := '停止录象';
    NStartGet1.Enabled := not NStartGet1.Enabled; //让菜单的NStartGet1 和 NStopGet1显示与窗口显示同步；
    NStopGet1.Enabled := not NStopGet1.Enabled;
  end
  else
  begin
    rec1 := false; //置录像标志为0，表示等待录像；
    btnStartGet1.Caption := '开始录象';
    NStartGet1.Enabled := True;
    NStopGet1.Enabled := False;
  end;
  if (MoniterNo1.Checked) then //让子窗体的按钮也和主窗体的同步；
  begin
    FormNo1.btnStartGet1.Caption := btnStartGet1.Caption;
  end;
//以下处理录制avi文件的程序；
  if rec1 then
  begin
    n1 := n1 + 1; //文件存盘编号自动加1；
    strn1 := inttostr(n1); //将文件存盘编号变成字符串；
    AssignFile(f1, '.\Inf\n1.txt'); //在Inf文件夹中创建n1.txt，记录n1值;
    Rewrite(f1);
    Writeln(f1, IntToStr(n1));
    CloseFile(f1);
    VideoCap1.CapTimeLimit := 0;
    VideoCap1.VideoFileName := GetAviDir() + '\' + FormatStr(Strn1) + '.avi';
    VideoCap1.StartCapture;
    VideoCap1.DlgVCompression;
    WriteDB(Date + Time, VideoCap1.VideoFileName, MoniterNo); //将有关的信息写入数据库；

  end;
  if not rec1 then
  begin
    VideoCap1.StopCapture;
  end;


end;


procedure TFormMain.btnStartGet2Click(Sender: TObject);
begin
//让btnStartGet2按一下显示‘停止录像 ’，再按一下显示‘开始录像’；
  tmr2.Enabled := not tmr2.Enabled;
  FormNo2.tmr1.Enabled := not FormNo2.tmr1.Enabled;
  if (tmr2.Enabled) then
  begin
    btnStartGet2.Caption := '停止录象';
    NStartGet2.Enabled := not NStartGet2.Enabled; //让菜单的NStartGet1 和 NStopGet1显示与窗口显示同步；
    NStopGet2.Enabled := not NStopGet2.Enabled;
  end
  else
  begin
    btnStartGet2.Caption := '开始录象';
    NStartGet2.Enabled := True;
    NStopGet2.Enabled := False;
  end;
  if (MoniterNo2.Checked) then //让子窗体的按钮也和主窗体的同步；
  begin
    //FormNo2.tmr1.Enabled := not FormNo1.tmr1.Enabled;
    FormNo2.btnStartGet2.Caption := btnStartGet2.Caption;
  end;
end;

procedure TFormMain.btnStartGet3Click(Sender: TObject);
begin
//让btnStartGet3按一下显示‘停止录像 ’，再按一下显示‘开始录像’；
  tmr3.Enabled := not tmr3.Enabled;
  FormNo3.tmr1.Enabled := not FormNo3.tmr1.Enabled;
  if (tmr3.Enabled) then
  begin
    btnStartGet3.Caption := '停止录象';
    NStartGet3.Enabled := not NStartGet3.Enabled; //让菜单的NStartGet1 和 NStopGet1显示与窗口显示同步；
    NStopGet3.Enabled := not NStopGet3.Enabled;
  end
  else