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 + -
显示快捷键?