mglr.pas

实现门卫值班时的一些简单功能

unit mglr;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, Mask, DBCtrls, Grids, DBGrids, ComCtrls, Buttons,
  DBTables, Db;

type
  Tmglrfrm = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    DBEdit2: TDBEdit;
    Label3: TLabel;
    DBEdit3: TDBEdit;
    Label4: TLabel;
    DBEdit4: TDBEdit;
    Label7: TLabel;
    DBEdit7: TDBEdit;
    Label8: TLabel;
    DBEdit8: TDBEdit;
    StatusBar1: TStatusBar;
    DBGrid1: TDBGrid;
    BitBtn1: TBitBtn;
    BitBtn3: TBitBtn;
    BitBtn2: TBitBtn;
    Query1: TQuery;
    BitBtn4: TBitBtn;
    DataSource1: TDataSource;
    DBEdit1: TDBEdit;
    Label5: TLabel;
    Query1BDEDesigner: TStringField;
    Query1BDEDesigner2: TStringField;
    Query1BDEDesigner3: TStringField;
    Query1BDEDesigner4: TStringField;
    Query1BDEDesigner5: TStringField;
    Query1BDEDesigner6: TStringField;
    Query1BDEDesigner7: TStringField;
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure DBEdit7DblClick(Sender: TObject);
    procedure DBEdit8DblClick(Sender: TObject);
    procedure DBEdit7KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure DBEdit8KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure DBEdit7KeyPress(Sender: TObject; var Key: Char);
    procedure DBEdit8KeyPress(Sender: TObject; var Key: Char);
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
    procedure BitBtn4Click(Sender: TObject);
  private
    procedure loadqiche;       //刷新用
    { Private declarations }
  public
    { Public declarations }
  end;

var
  mglrfrm: Tmglrfrm;

implementation

{$R *.DFM}
procedure Tmglrfrm.loadqiche;
var
 datestr:string;
 sqlstr:string;
 reccount:string;
begin
   shortdateFormat:='YYYY.MM.DD';     //确定日期格式
   LongDateFormat:='YYYY.MM.DD';
   DateSeparator:='.';
   datestr:=datetostr(date);          //当前日期
   sqlstr:='select * from 车辆管理综合信息 ';
   sqlstr:=sqlstr+' where ((日期='+''''+datestr+''''+') AND (车号 is not NULL) AND (发车时间 is NULL) ';
   sqlstr:=sqlstr+'  or  (发车时间 is not NULL)AND (回场时间 is NULL)) order by 车号';
   query1.Close;
   query1.sql.Clear ;
   query1.SQL.Text :=sqlstr;
   query1.Open;       //显示今天允许出车和目前出车未归的车辆情况
   reccount:=inttostr(query1.RecordCount);
   if query1.RecordCount<>0 then
      StatusBar1.Panels[0].Text :='当前获准进出大门车辆的记录有'+ reccount +'条。'
   else
      StatusBar1.Panels[0].Text :='暂无获准进出大门车辆的记录。';
end;

procedure Tmglrfrm.FormCreate(Sender: TObject);
begin
    shortdateFormat:='YYYY.MM.DD';     //确定日期格式
    LongDateFormat:='YYYY.MM.DD';
    DateSeparator:='.';
end;

procedure Tmglrfrm.FormShow(Sender: TObject);
begin
  loadqiche;       //调用loadqiche过程
end;

procedure Tmglrfrm.DBEdit7DblClick(Sender: TObject);
var
  datestr:string;
  query:tquery;
  sqlstr:string;
begin            //填写发车时间
 if (query1.RecordCount>0)and(DBEdit7.Text ='') then
    begin
     query:=tquery.Create (self);
     query.DatabaseName :=query1.DatabaseName ;
     query.sql.Clear ;
     sqlstr:='select 车号 from 车辆管理综合信息 where (发车时间 is not NULL) AND (回场时间 is NULL) AND (车号='+''''+DBEdit3.Text+''')';
     query.SQL.Text :=sqlstr;
     query.Open;
     if query.RecordCount<>0 then     //此车已出
        begin
          showmessage('此车外出未归，暂不能再次出车！');
          exit;
        end
        else
        begin
          query1.Edit;      //填发车时间
          datestr:=datetimetostr(now);    //当前日期和时间
          query1.FieldByName('发车时间').asstring:=datestr;
          if query1.FieldByName('用车时间').asstring='' then
             query1.FieldByName('用车时间').asstring:=timetostr(time);
        end;
     query.Free;
    end
    else
    begin
      if DBEdit7.Text <>'' then    //已填发车时间
         begin
         showmessage('此车已出！');
         exit;
         end
      else      //查询结果为0
         begin
         showmessage('无车可出！');
         exit;
         end
    end;
end;

procedure Tmglrfrm.DBEdit8DblClick(Sender: TObject);
var
 datestr:string;
begin
 if DBEdit7.Text <>'' then    //已填发车时间
    begin      //填回场时间
      query1.edit;
      datestr:=datetimetostr(now);   //当前日期和时间
      query1.FieldByName('回场时间').asstring:=datestr;
    end
    else        //未填发车时间
    begin
     showmessage('此车未出！');
     exit;
    end;
end;

procedure Tmglrfrm.DBEdit7KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin      //输入格式检查
   key:=0; //不允许人工输入
end;

procedure Tmglrfrm.DBEdit8KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin      //输入格式检查
   key:=0; //不允许人工输入
end;

procedure Tmglrfrm.DBEdit7KeyPress(Sender: TObject; var Key: Char);
begin      //输入格式检查
   key:=#0;//不允许人工输入
end;

procedure Tmglrfrm.DBEdit8KeyPress(Sender: TObject; var Key: Char);
begin      //输入格式检查
   key:=#0;//不允许人工输入
end;

procedure Tmglrfrm.BitBtn1Click(Sender: TObject);
begin      //保存
 if (DBEdit7.Text='')and(DBEdit8.Text='') then
     begin
     showmessage('时间未填，不予保存！');
     exit;
     end;
  if Application.MessageBox('您确定要保存这条出车记录吗？','确定吗？',
      MB_OKCANCEL + MB_DEFBUTTON1) = IDOK then
  begin
     query1.edit;
     with query1 do
        begin
             Database.StartTransaction;
        try
             ApplyUpdates; {try to write the updates to the database};
             Database.Commit; {on success, commit the changes};
        except
             Database.Rollback; {on failure, undo the changes};
             raise; {raise the exception to prevent a call to CommitUpdates!}
        end;
             CommitUpdates; {on success, clear the cache}
    end;
  
  end;
end;

procedure Tmglrfrm.BitBtn2Click(Sender: TObject);
begin       //取消
   query1.CancelUpdates ;
end;

procedure Tmglrfrm.BitBtn3Click(Sender: TObject);
begin       //退出
  query1.CancelUpdates ;
  close;
end;

procedure Tmglrfrm.BitBtn4Click(Sender: TObject);
begin      //刷新
   loadqiche;     //调用loadqiche过程
end;

end.