mainform.pas

求是科技出版的《Delphi串口通信工程开发实例导航》所有的源代码。是一本很好的书。拿出来与大家共享。

unit MainForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Menus,  ExtCtrls,inifiles, StdCtrls, ComCtrls, Buttons,mmsystem,
  Abcbar, Abcpanel, Spin, MPlayer, Abcexctl, Grids, DBGrids, Db, ADODB,
  OleCtrls, MSCommLib_TLB, Video;

type
  TMain = class(TForm)
    mmuMain: TMainMenu;
    mmiFile: TMenuItem;
    mmiExit: TMenuItem;
    mmiVideoOption: TMenuItem;
    mmiDriverSelect: TMenuItem;
    N1: TMenuItem;
    mmiVideoSource: TMenuItem;
    mmiVideoFormat: TMenuItem;
    mmiVideoCompession: TMenuItem;
    StatusBar1: TStatusBar;
    Timer1: TTimer;
    SaveDialog1: TSaveDialog;
    mmiCaptureParameter: TMenuItem;
    N2: TMenuItem;
    mmiAbout: TMenuItem;
    Panel1: TPanel;
    Panel2: TPanel;
    pnlCapBase: TPanel;
    pnlCap: TPanel;
    Panel6: TPanel;
    mpMain: TMediaPlayer;
    N3: TMenuItem;
    mmiClearDataBase: TMenuItem;
    mmiConfig: TMenuItem;
    tmrControl: TTimer;
    bbnLeft: TPageControl;
    abpCurrentOption: TTabSheet;
    Panel3: TPanel;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    fps: TLabel;
    chxRealMonitor: TCheckBox;
    chxOverlay: TCheckBox;
    chxScale: TCheckBox;
    chxProp: TCheckBox;
    sdtRate: TSpinEdit;
    GroupBox4: TGroupBox;
    BtStartStop: TBitBtn;
    BtnPara: TBitBtn;
    edtFile: TEdit;
    chxDefaultName: TCheckBox;
    abpHistory: TTabSheet;
    lvEvent: TListView;
    mscMain: TMSComm;
    VideoCap1: TVideoCap;
    procedure mmiDriverSelectClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Video1Status(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure chxRealMonitorClick(Sender: TObject);
    procedure chxOverlayClick(Sender: TObject);
    procedure mmiVideoFormatClick(Sender: TObject);
    procedure mmiVideoSourceClick(Sender: TObject);
    procedure mmiVideoCompessionClick(Sender: TObject);
    procedure chxScaleClick(Sender: TObject);
    procedure chxPropClick(Sender: TObject);
    procedure Video1StatusCallback(Sender: TObject; nID: Integer;
      status: String);
    procedure BtStartStopClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure edtFileDblClick(Sender: TObject);
    procedure mmiCaptureParameterClick(Sender: TObject);
    procedure mmiExitClick(Sender: TObject);
    procedure mmiAboutClick(Sender: TObject);
    procedure lvEventSelectItem(Sender: TObject; Item: TListItem;
      Selected: Boolean);
    procedure lvEventDblClick(Sender: TObject);
    procedure abbLeftChange(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure chxDefaultNameClick(Sender: TObject);
    procedure mmiAlertClick(Sender: TObject);
    procedure sdtRateChange(Sender: TObject);
    procedure mmiClearDataBaseClick(Sender: TObject);
    procedure mmiConfigClick(Sender: TObject);
    procedure tmrControlTimer(Sender: TObject);
    procedure bbnLeftChanging(Sender: TObject; var AllowChange: Boolean);
  private

   FTime: TDateTime;  //最后一次的开始捕捉时间
   //有关硬件控制的参数
   FAlert: boolean;    //是否报警
   FSpeaker: boolean;  //蜂鸣器
   FShortMsg: boolean;  //是否发送短消息
   FCenterNo: string;  //短信中心 
   //文件名编号
   FAviNum: integer;
   //
   CapTime : double;

   procedure updateBtn(stat:Boolean);
   function WriteDB(ATime: TDateTime;AFileName: string): integer;
   function GetDefaultAviName(): string;
   function GetAviDir(): string;
   function FIntToStr(AInt: Integer): string;
   procedure AdjustCapWindow();
   procedure ClearCapWindow();
    { Private-Deklarationen}
  public
    { Public-Deklarationen}
  end;

var
  Main: TMain;

implementation

uses
    CommonUnit,
    MonitorDM,
    AlertForm, DriverSelectForm, ParamForm, AboutForm;

{$R *.DFM}

//选择驱动器
procedure TMain.mmiDriverSelectClick(Sender: TObject);
var
    DrvList:TStrings;
begin
    frmDriverSelect:=TfrmDriverSelect.Create(Self);
    try
        //调用自己的成员函数GetDriverList
        drvList:= GetDriverList;
        frmDriverSelect.Combobox1.Items:= drvList;

        VideoCap1.DriverOpen:= false;
        //将Combox.ItemIndex 初始化为当前的驱动器
        frmDriverSelect.ComboBox1.Itemindex:= VideoCap1.DriverIndex;
        if frmDriverSelect.ShowModal = mrOK then
        begin
            videoCap1.DriverIndex:= frmDriverSelect.combobox1.ItemIndex;
        end;

        VideoCap1.DriverOpen:= true;
        frmDriverSelect.Free;
    finally
        //释放TStrings资源
        drvList.Clear;
        drvList.Free;
    end;
end;

procedure TMain.FormCreate(Sender: TObject);
var
    ini:TInifile;
begin
    //初始化成员变量
    FAviNum := -2; //不可能的数值

    //读取默认的驱动器
    ini:= TInifile.Create('vcap.ini');
    VideoCap1.Driverindex:=ini.readInteger('Driver','index',-1);
    //读取成员变量
    FAlert := ini.ReadBool('Device','AlertLight',True);
    FSpeaker := ini.ReadBool('Device','AlertSpeaker',True);
    FShortMsg := ini.ReadBool('Device','ShotMsg',True);
    FCenterNo := ini.ReadString('Device','CenterNo','[phone]');
    ini.free;
    //如果需要发送消息
    if FShortMsg then
    begin
        if SetCenter(mscMain,FCenterNo) < 0 then
        begin
            ShowMessage('设置短消息服务中心错误，服务中心号码使用默认值！');
        end;
        if SetTextMode(mscMain) < 0 then
        begin
            ShowMessage('设置短消息格式错误，使用默认的短信格式！');
        end;
    end;
    //填充默认的捕捉avi文件名
    edtFile.Text := GetDefaultAviName();

    //＝＝＝＝＝＝＝刷新listview＝＝＝＝＝＝＝＝
    try
        abbLeftChange(nil);
    except

    end;

    tmrControl.Enabled := True;
end;

procedure TMain.FormDestroy(Sender: TObject);
var
    ini:TInifile;
begin
    ini:= TInifile.Create('vcap.ini');
    //写入驱动器编号
    ini.writeInteger('Driver','index',videoCap1.Driverindex);
    //读取成员变量
    ini.WriteBool('Device','AlertLight',FAlert);
    ini.WriteBool('Device','AlertSpeaker',FSpeaker);
    //释放ini文件
    ini.free;
end;


procedure TMain.Video1Status(Sender: TObject);
begin
    if VideoCap1.DriverIndex= -1 then
    begin
        chxRealMonitor.Enabled  := false;     //不能实时的监视
        mmiVideoCompession.Enabled:= false;  //不能设置视频压缩
    end
    else begin
        chxRealMonitor.Enabled := true;       //能实时的监视
        mmiVideoCompession.enabled:= true;   //能设置视频压缩
    end;

    sdtRate.Value:= VideoCap1.PreviewRate;     //采集频率
    chxRealMonitor.Checked:=VideoCap1.VideoPreview;  //实时监控
    //覆盖模式
    chxOverlay.Enabled:= VideoCap1.HasVideoOverlay;
    chxOverlay.Checked:=VideoCap1.VideoOverlay;
    //视频格式
    mmiVideoFormat.enabled:= VideoCap1.HasDlgFormat;
    //视频源
    mmiVideoSource.Enabled:= VideoCap1.HasDlgSource;
end;

procedure TMain.FormShow(Sender: TObject);
begin
    //打开驱动设备
    VideoCap1.DriverOpen:=True;
end;

//实时监控复选框
procedure TMain.chxRealMonitorClick(Sender: TObject);
begin
    VideoCap1.VideoPreview:=chxRealMonitor.Checked;
end;

//覆盖模式复选框
procedure TMain.chxOverlayClick(Sender: TObject);
begin
    VideoCap1.VideoOverlay:=chxOverlay.Checked;
end;

procedure TMain.mmiVideoFormatClick(Sender: TObject);
begin
    //显示采集格式对话框
    VideoCap1.DlgVFormat;
    AdjustCapWindow();
end;

procedure TMain.mmiVideoSourceClick(Sender: TObject);
begin
    //显示视频源对话框
    VideoCap1.DlgVSource;
end;


procedure TMain.mmiVideoCompessionClick(Sender: TObject);
begin
    //显示视频压缩对话框
    videoCap1.DlgVCompression;
end;

procedure TMain.chxScaleClick(Sender: TObject);
begin
    //和控件窗口等大
    videoCap1.PreviewScaleToWindow:=chxScale.Checked;
end;

procedure TMain.chxPropClick(Sender: TObject);
begin
    //保持长宽比例
    AdjustCapWindow();
end;

procedure TMain.Video1StatusCallback(Sender: TObject; nID: Integer;
  status: String);
begin
    //设置回调函数,显示步骤状态
    StatusBar1.Panels[0].Text:= status;
end;

procedure TMain.BtStartStopClick(Sender: TObject);
var
    mFileName: string;
begin
    //如果异常情况已经发生
    if VideoCap1.CapInProgess then
    begin
        //停止视频捕捉
        VideoCap1.StopCapture ;
        CapTime := 0;
        //保存数据到数据库
        WriteDB(FTime,VideoCap1.VideoFileName);
        //更新用户界面
        edtFile.Text := GetDefaultAviName();
        UpdateBtn(false);
    end
    else begin
        //异常情况发生时间
        FTime := Now();
        VideoCap1.VideoFileName:= GetAviDir() + '\' + edtFile.Text;
        //开始捕捉视频
        VideoCap1.StartCapture;
        Timer1.Enabled:= True;
        //更新用户界面
        UpdateBtn(true);
    end;
end;

procedure TMain.UpdateBtn(stat:boolean);
begin
    if stat then
    begin
        BtStartStop.caption:= '停止捕捉';
        btStartStop.Font.Color:= clRed;
    end
    else begin
      BtStartStop.caption:= '开始捕捉';
      btStartStop.Font.Color:= clGreen;
      Timer1.Enabled:= false;        //停止计时器
    end;
end;

procedure TMain.Timer1Timer(Sender: TObject);
begin
    //实时的显示
    UpdateBtn(VideoCap1.CapInProgess);
end;


procedure TMain.edtFileDblClick(Sender: TObject);
begin
    //用户使用自定义的文件名
    SaveDialog1.Filter:='Avi-Files (*.avi)|*.avi';
    SaveDialog1.FileName:= Edtfile.text;
    if saveDialog1.Execute then
        edtFile.text:= saveDialog1.FileName;
end;