unitmain.~pas

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

~PAS
1,203
字号
    NStartGet1.Enabled := False;
    NStartMoniter1.Enabled := True;
    NStopMoniter1.Enabled := False;
    pnlShowRecoderMessageA.Caption := '摄像头A已关闭'; //在主窗体上显示系统目前的状态
    tmrFlash1.Enabled := False; //控制报警闪烁的计时器不使能;
    Shape1.Brush.Color := clBtnFace;
  end;
end;



//btnStopMoniter2按下时,打开2#摄像头,对现场进行实时监控,处理方法和前面相同;

procedure TFormMain.btnStopMoniter2Click(Sender: TObject);
begin
  OCMon2 := not OCMon2; //修改按钮标志
  if OCMon2 then
  begin
    btnStartGet2.Enabled := True;
    btnStopMoniter2.Caption := '关闭监控'; //按钮显示内容的修改
    videocap2.DriverIndex := 0; //打开2#摄像头,开始监控;
    VideoCap2.DriverOpen := True;
    VideoCap2.VideoPreview := True;
    VideoCap2.visible := True;
    NStartGet2.Enabled := True;
    NStartMoniter2.Enabled := False;
    NStopMoniter2.Enabled := True;
    pnlShowRecoderMessageB.Caption := '摄像头B已打开'; //在主窗体上显示系统目前的状态
  end
  else
  begin //停止监控的处理和1#摄像头的相同前面
    btnStartGet2.Enabled := False;
    btnStartGet2.Caption := '开始录像';
    SSRec2 := False;
    NStartGet2.Enabled := False;
    btnStopMoniter2.Caption := '打开监控'; //按钮显示内容的修改
    VideoCap2.DriverOpen := False; //关闭1#摄像头,停止监控
    VideoCap2.VideoPreview := False;
    VideoCap2.visible := False;
    NStartMoniter2.Enabled := True;
    NStopMoniter2.Enabled := False;
    pnlShowRecoderMessageB.Caption := '摄像头B已关闭';
    tmrFlash2.Enabled := False;
    Shape2.Brush.Color := clBtnFace;
  end;
end;


procedure TFormMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if VideoCap1.DriverOpen then VideoCap1.DriverOpen := False;
  if VideoCap2.DriverOpen then VideoCap2.DriverOpen := False;
  Comm1.StopComm;
end;


procedure TFormMain.NRecClick(Sender: TObject);
begin
  DMMain.tblEvent.Open;
  FormRec.tmrRefresh.Enabled := True;
  FormRec.show;
end;


procedure TFormMain.NStartMoniter1Click(Sender: TObject);
begin
  btnStopMoniter1.Click;
end;

procedure TFormMain.NStartMoniter2Click(Sender: TObject);
begin
  btnStopMoniter2.Click;
end;

procedure TFormMain.NStopMoniter1Click(Sender: TObject);
begin
  btnStopMoniter1.Click;
end;

procedure TFormMain.NStopMoniter2Click(Sender: TObject);
begin
  btnStopMoniter2.Click;
end;

procedure TFormMain.N4Click(Sender: TObject);
begin
  Application.MessageBox('本程序设计者为:冯红霞' + #13#10 +
    '任何人可以使用!', '关于', MB_OK + MB_ICONINFORMATION);
end;

procedure TFormMain.N3Click(Sender: TObject);
begin
  Application.MessageBox('本程序可以同时监控两个地点的情况或者单独监控任意一处的情况!' +
    #13#10 + '(可通过“设置”-“监控方式”选择)' + #13#10 + #13#10 + '监控可由传感装置传来的信号启动!', '帮助', MB_OK +
    MB_ICONINFORMATION);
end;

procedure TFormMain.BtnAMClick(Sender: TObject);
begin
  if not (VideoCap1.DriverOpen and VideoCap2.DriverOpen) then
  begin
    Application.MessageBox('必须先打开摄像头才能选择“智能监控”方式!', '警告',
      MB_OK + MB_ICONWARNING);
    Exit;
  end;

  if SSRec1 or SSRec2 then
  begin
    Application.MessageBox('必须先停止摄像头录像才能选择“智能监控”方式!', '警告',
      MB_OK + MB_ICONWARNING);
    Exit;
  end;


  if AOrM = 1 then
  begin
    BtnAM.Caption := '改为人工监控';
    btnClearDB.Visible := False;
    btnStopMoniter1.Enabled := False;
    btnStopMoniter2.Enabled := False;
    NStartMoniter1.Enabled := False;
    NStartMoniter2.Enabled := False;
    ComputerMode.Click;
    AOrM := 2;
  end
  else begin
    StopRecordA;
    StopRecordB;
    BtnAM.Caption := '改为智能监控';
    btnClearDB.Visible := True;
    btnStopMoniter1.Enabled := True;
    btnStopMoniter2.Enabled := True;
    ManMode.Click;
    AOrM := 1;
  end;
end;

procedure TFormMain.Comm1ReceiveData(Sender: TObject; Buffer: Pointer;
  BufferLength: Word);
type IArr = ^Integer;
var RevP: array[1..2048] of byte;
  i: Integer;
begin
  BufferLength := 4; //设定的数据为4位
  SetLength(CommRevStr, BufferLength);
  Move(IArr(Buffer)^, RevP, BufferLength);
  for i := 0 to BufferLength do {// Iterate} begin
    CommRevStr[i] := WideChar(RevP[i]);
  end; // for
end;

procedure TFormMain.tmrRevStrTimer(Sender: TObject);
begin
  case AOrM of
    1: begin //选择人工模式
        begin
          if CommRevStr = '1010' then
            if AlarmOn.Checked then
            begin
              Image1.Visible := True;
              Image2.Visible := True;
            end;
          if CommRevStr = '1001' then
            if AlarmOn.Checked then
            begin
              Image1.Visible := True;
              Image2.Visible := False;
            end;
          if CommRevStr = '0110' then
            if AlarmOn.Checked then
            begin
              Image1.Visible := False;
              Image2.Visible := True;
            end;
          if CommRevStr = '0101' then
          begin
            Image1.Visible := False;
            Image2.Visible := False;
          end;
        end;
        if AlarmOff.Checked then
        begin
          Image1.Visible := False;
          Image2.Visible := False;
        end;
      end;
    2: begin //选择智能模式
        if CommRevStr = '1010' then
        begin
          if CommRevStrChanged then
          begin
            ChangeNumberA;
            ChangeNumberB;
          end;
          StartRecordA;
          StartRecordB;
        end;
        if CommRevStr = '1001' then
        begin
          if CommRevStrChanged then
          begin
            ChangeNumberA;
          end;
          StartRecordA;
          StopRecordB;
        end;
        if CommRevStr = '0110' then
        begin
          if CommRevStrChanged then
          begin
            ChangeNumberB;
          end;
          StopRecordA;
          StartRecordB;
        end;
        if CommRevStr = '0101' then
        begin
          StopRecordA;
          StopRecordB;
        end;
      end;
  end;
end;


procedure TFormMain.NOpenAvi1Click(Sender: TObject);
begin
  dlgOpen1.InitialDir := GetAviDir(1);
  dlgOpen1.Execute;
end;

procedure TFormMain.NOpenAvi2Click(Sender: TObject);
begin
  dlgOpen1.InitialDir := GetAviDir(2);
  dlgOpen1.Execute;
end;

procedure TFormMain.btnClearDBClick(Sender: TObject);
var
  i, j: Integer;
begin
  if SSRec1 or SSRec2 then
  begin
    Application.MessageBox('正在录像中,不能清空数据库!', '出错', MB_OK +
      MB_ICONSTOP);
    Exit;
  end
  else if MessageBox(0, '是否要真的清空数据库,清空的数据不能再恢复!', '提示', MB_OKCANCEL +
    MB_ICONINFORMATION) = IDOK then
  begin
    try
      DMMain.tblEvent.First;
      while not DMMain.tblEvent.Eof do
      begin
        DMMain.tblEvent.Delete;
      end;
    except // 捕获异常,不处理
    end;

    for i := 1 to nn1 do //先删除文件
    begin
      DeleteFile(GetAviDir(1) + '\' + FIntToStr(IntToStr(i)) + '.avi');
    end;
    for j := 1 to nn2 do
    begin
      DeleteFile(GetAviDir(2) + '\' + FIntToStr(IntToStr(j)) + '.avi');
    end;

    RmDir('Avi1'); //删除视频文件夹
    RmDir('Avi2');

    MkDir('Avi1'); //重建文件夹
    MkDir('Avi2');

    AssignFile(f1, '.\Inf\n1.txt'); //修改记录文件值
    Rewrite(f1);
    Writeln(f1, '0');
    CloseFile(f1);
    AssignFile(f2, '.\Inf\n2.txt');
    Rewrite(f2);
    Writeln(f2, '0');
    CloseFile(f2);
    nn1 := 0; //为重新计数做准备
    nn2 := 0;
  end;
end;


//对于长时间监控录像,自动按30″分段记录

procedure TFormMain.tmrDelayAuto1Timer(Sender: TObject);
begin
  VideoCap1.StopCapture; //定时时间到,停止录像
  tmrDelayAuto1.Enabled := False; //关闭定时器,为下次准备
  if not CommRevStrChanged then
  begin
    nn1 := nn1 + 1; //文件存盘编号自动加1;
    strn1 := inttostr(nn1); //将文件存盘编号变成字符串;
    AssignFile(f1, '.\Inf\n1.txt'); //在Inf文件夹中创建n1.txt,记录n1值;
    Rewrite(f1);
    Writeln(f1, IntToStr(nn1));
    CloseFile(f1);
    CommRevStrBak:='0000';
  end;
end;



procedure TFormMain.tmrDelayAuto2Timer(Sender: TObject);
begin
  VideoCap2.StopCapture;
  tmrDelayAuto2.Enabled := False;
  if not CommRevStrChanged then
  begin
    nn2 := nn2 + 1; //文件存盘编号自动加1;
    strn2 := IntToStr(nn2); //将文件存盘编号变成字符串;
    AssignFile(f2, '.\Inf\n2.txt'); //在Inf文件夹中创建n1.txt,记录n1值;
    Rewrite(f2);
    Writeln(f2, IntToStr(nn2));
    CloseFile(f2);
    CommRevStrBak:='0000';
  end;
end;


procedure TFormMain.tmrDelayMan1Timer(Sender: TObject);
begin
  tmrFlash1.Enabled := False;
  Shape1.Brush.Color := clBtnFace;
  tmrDelayMan1.Enabled := False;
  btnStartGet1.Click;
  if MessageBox(0, '连续录制时间过长,已经自动停止!' + #13#10 +
    '需要继续录制,请按"确定"按钮!' + #13#10 +
    '不需要继续录制,请按"取消"按钮!', '提示', MB_OKCANCEL +
    MB_ICONINFORMATION) = IDOK then
  begin
    btnStartGet1.Click;
  end
  else
  begin
    //  按取消,不做处理
  end;
end;

procedure TFormMain.tmrDelayMan2Timer(Sender: TObject);
begin
  tmrFlash2.Enabled := False;
  Shape2.Brush.Color := clBtnFace;
  tmrDelayMan2.Enabled := False;
  btnStartGet2.Click;
  if MessageBox(0, '连续录制时间过长,已经自动停止!' + #13#10 +
    '需要继续录制,请按"确定"按钮!' + #13#10 +
    '不需要继续录制,请按"取消"按钮!', '提示', MB_OKCANCEL +
    MB_ICONINFORMATION) = IDOK then
  begin
    btnStartGet2.Click;
  end
  else
  begin
    //  按取消,不做处理
  end;
end;

procedure TFormMain.tmrFlash1Timer(Sender: TObject);
begin
  Flash1; //启动录像闪烁效果
end;

procedure TFormMain.tmrFlash2Timer(Sender: TObject);
begin
  Flash2;
end;


procedure TFormMain.Choise10sClick(Sender: TObject);
begin
  tmrDelayAuto1.Interval := 10000; //设定录像时间间隔
  tmrDelayAuto2.Interval := 10000;
end;

procedure TFormMain.Choise20sClick(Sender: TObject);
begin
  tmrDelayAuto1.Interval := 20000;
  tmrDelayAuto2.Interval := 20000;
end;

procedure TFormMain.Choise30sClick(Sender: TObject);
begin
  tmrDelayAuto1.Interval := 30000;
  tmrDelayAuto2.Interval := 30000;
end;

procedure TFormMain.Choise60sClick(Sender: TObject);
begin
  tmrDelayAuto1.Interval := 60000;
  tmrDelayAuto2.Interval := 70000;
end;

end.

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?