frmmain.pas

**智能监视系统*** 程序运行时需要视频捕捉设备

    SaveDialog1.Filter:='Avi-Files (*.avi)|*.avi';
    SaveDialog1.FileName:= Edtfile.text;
    if saveDialog1.Execute then
        edtFile.text:= saveDialog1.FileName;
end;

procedure TMain.mmiCaptureParameterClick(Sender: TObject);
begin
    try
        DlgVpara:=TDlgVPara.Create(Self);
        DlgVPara.ShowModal;
    finally
        Dlgvpara.Free;
    end;
end;

procedure TMain.mmiExitClick(Sender: TObject);
begin
    Close;
end;

procedure TMain.mmiAboutClick(Sender: TObject);
begin
    try
        AboutDlg:= TAboutDlg.Create(self);
        AboutDlg.ShowModal;
    finally
        AboutDlg.Free;
    end;
end;


function TMain.WriteDB(ATime: TDateTime; AFileName: string): integer;
begin
    Result := 1;
    try
        with DMMain.tblEvent do
        begin
            Append();
            FieldByName('time').AsDateTime := ATime;
            FieldByName('avi_path').AsString := AFileName;
            Post();
        end;
    except
        Result := -1;
    end;
end;

function TMain.GetDefaultAviName: string;
var
    mQuery: TADOQuery;
    mMaxId: integer;
    mStr: string;
begin
    mStr := 'SELECT max(event_id) FROM eventrec';
    mQuery := TADOQuery.Create(nil);
    with mQuery do
    begin
        Connection := DMMain.cnnMain;
        SQL.Clear;
        SQL.Add(mStr);
        try
            Open();
            if not Fields[0].IsNull  then
            begin
               mMaxId := Fields[0].Value + 1;
               Result := FIntToStr(mMaxId)+ '.avi';
            end
            else begin
                Result := FIntToStr(1) + '.avi';
            end;
        except
            Result := '';
        end;
    end;
end;

function TMain.FIntToStr(AInt: Integer): string;
var
    mLen: integer;
    i: integer;
begin
    Result := IntToStr(AInt);
    mLen := Length(Result);
    for i:=1 to 8-mLen do
    begin
        Result := '0' + Result;
    end;
end;

function TMain.GetAviDir: string;
begin
    Result := '.\avi';
end;

procedure TMain.lvEventSelectItem(Sender: TObject; Item: TListItem;
  Selected: Boolean);
begin
    //单击发生的事件
    try
        //mpMain.Stop;
        mpMain.FileName := Item.SubItems[1];
        mpMain.Open;
    except
        on EMCIDeviceError do
        begin
            ShowMessage('记录文件找不到，可能文件已被删除或移走！');
        end;
    end;
    //trbAvi.Max := mpMain.Length ;
    //trbAvi.Position := 0;

end;

procedure TMain.lvEventDblClick(Sender: TObject);
var
    mListItem: TListItem;
begin
    mListItem := lvEvent.Selected ;
    if mListItem = nil then Exit;
    //mpMain.Stop;
    Self.ClearCapWindow;
    mpMain.FileName := mListItem.SubItems[1];
    mpMain.Open;
    mpMain.Play;
end;

procedure TMain.abbLeftChange(Sender: TObject);
var
    mListItem: TListItem;
    mDateTime: TDateTime;
begin
    //选择历史记录
    if bbnLeft.ActivePage = abpHistory then
    begin
        if DMMain.tblEvent.Active = false then
        begin
            DMMain.tblEvent.Open ;
        end
        else begin
            DMMain.tblEvent.Refresh();
        end;
        lvEvent.Items.Clear;
        with DMMain.tblEvent do
        begin
            First;
            while not EOF do
            begin
                mListItem := lvEvent.Items.Add();
                mListItem.Caption := Fields[0].AsString ;
                mDateTime := Fields[1].AsDateTime ;
                mListItem.SubItems.Add(DateTimeToStr(mDateTime));
                mListItem.SubItems.Add(Fields[2].AsString);
                Next;
            end;
            First;
        end;
    end;
    //选择了当前选项
    if bbnLeft.ActivePage = abpCurrentOption then
    begin
        try
            mpMain.Stop;
            VideoCap1.Repaint();
        except
            // to do nothing about this exception.
        end;
    end;
end;

procedure TMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
    try
        with DMMain do
        begin
            //关闭资源
            tblEvent.Close;
            cnnMain.Close;
        end;
    except
    end;
end;

procedure TMain.chxDefaultNameClick(Sender: TObject);
begin
    edtFile.Enabled := not chxDefaultName.Checked;
end;

procedure TMain.sdtRateChange(Sender: TObject);
begin
    try
        //设置监视频率
        VideoCap1.PreviewRate := sdtRate.Value ;
    except
        //to do nothing
    end;

end;

procedure TMain.AdjustCapWindow;
begin
    //调整步骤窗体，使之和实际图象大小匹配
    if chxProp.Checked then
    begin
        //每一边各留三个象素
        pnlCap.Width := VideoCap1.CapWidth + 3*2;
        pnlCap.Height := VideoCap1.CapHeight + 3*2;
        pnlCap.Left := (pnlCapBase.Width - pnlCap.Width) div 2;
        pnlCap.Top := (pnlCapBase.Height - pnlCap.Height) div 2;
    end
    else begin
        //使用默认值
        pnlCap.Width := 225;
        pnlCap.Height := 225;
        pnlCap.Left := (pnlCapBase.Width - pnlCap.Width) div 2;
        pnlCap.Top := (pnlCapBase.Height - pnlCap.Height) div 2;
    end;
end;


procedure TMain.ClearCapWindow;
begin
    //刷新用户界面
    VideoCap1.Repaint;
end;

procedure TMain.mmiClearDataBaseClick(Sender: TObject);
begin
    if MessageDlg('是否要真的清空数据库，清空的数据不能再恢复！',
        mtConfirmation,mbOKCancel,0) = mrOk then
    begin
        try
            DMMain.tblEvent.First;
            while not DMMain.tblEvent.Eof do
            begin
                DMMain.tblEvent.Delete;
            end;
        except
            //
        end;

    end;
end;

procedure TMain.mmiConfigClick(Sender: TObject);
begin
    frmAlertConfig.ShowModal();
end;

procedure TMain.tmrControlTimer(Sender: TObject);
var
    mKind:smallint;
    mPhone: string;
begin
    //下位机报告有异常情况
    if IsAbnormal(mscMain) = 1 then
    begin
        //正在捕捉视频－先前有异常情况发生
        if VideoCap1.CapInProgess then
        begin
            //捕捉视频计时器清零
            CapTime := 0;
        end
        //当前没有异常发生
        else begin
            //取得异常情况发生时间
            FTime := Now();
            VideoCap1.VideoFileName:= GetAviDir() + '\' + edtFile.Text;
            //开始捕捉视频
            VideoCap1.StartCapture;
            //=============检查是否需要报警或亮警报灯============
            if (not FAlert and not FSpeaker) then mKind := 0;
            if (FAlert and not FSpeaker) then mKind := 1;
            if (not FAlert and FSpeaker) then mKind := 2;
            if (FAlert and FSpeaker) then mKind := 3;
            if mKind > 0 then
            begin
                //向下位机发出硬件控制信息
                HardControl(mscMain,mKind);
            end;

            if FShortMsg then
            begin
                //向名单中列出的人员发送短信
                with DMMain.tblRecPerson do
                begin
                    First;
                    while not Eof do
                    begin
                        mPhone := FieldByName('phone_no').AsString;
                        SendShortMsg(mscMain,mPhone,'AutoMonitor: ' + DateTimeToStr(FTime) + ' abnormal!!');
                        Next;
                    end;
                end;
            end;

            Timer1.Enabled:= True;
            UpdateBtn(true);
        end;
    end
    //下微机报告没有异常情况发生
    else begin
         if VideoCap1.CapInProgess then
         begin
             //视频捕捉计时器计时
             CapTime := CapTime + (tmrControl.Interval/1000);
             //异常情况发生后，记录20秒
             if CapTime >= 20 then
             begin
                 VideoCap1.StopCapture();
                 CapTime := 0;
                 //
                 WriteDB(FTime,VideoCap1.VideoFileName);
                 edtFile.Text := GetDefaultAviName();
                 UpdateBtn(false);
             end;
         end;
    end;

end;

procedure TMain.bbnLeftChanging(Sender: TObject; var AllowChange: Boolean);
begin
    chxRealMonitor.Checked := False;
    VideoCap1.VideoPreview := False;
end;

procedure TMain.mmiAlertClick(Sender: TObject);
begin
    //
end;

end.