maindata.~pas

来自「用Delphi编写的户籍管理系统」· ~PAS 代码 · 共 316 行

unit MainData;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  DB, DBTables, ADODB;

type
  TDataHJZL = class(TDataModule)
    ADOCnHJGL: TADOConnection;
    ADOTableHZ: TADOTable;
    ADOTableCY: TADOTable;
    DSHZ: TDataSource;
    DSCY: TDataSource;
    ADOTableHZBH: TAutoIncField;
    ADOTableHZXM: TWideStringField;
    ADOTableHZXB: TWideStringField;
    ADOTableHZMZ: TWideStringField;
    ADOTableHZWH: TWideStringField;
    ADOTableHZCSNY: TDateTimeField;
    ADOTableHZSFZ: TWideStringField;
    ADOTableHZGZDW: TWideStringField;
    ADOTableHZDH: TWideStringField;
    ADOTableHZRS: TSmallintField;
    ADOTableHZFCZ: TWideStringField;
    ADOTableHZZD: TWideStringField;
    ADOTableHZFH: TWideStringField;
    ADOTableHZJTH: TBooleanField;
    ADOTableCYBH: TIntegerField;
    ADOTableCYXM: TWideStringField;
    ADOTableCYGX: TWideStringField;
    ADOTableCYXB: TWideStringField;
    ADOTableCYMZ: TWideStringField;
    ADOTableCYWH: TWideStringField;
    ADOTableCYCSNY: TDateTimeField;
    ADOTableCYSFZ: TWideStringField;
    ADOTableCYGZDW: TWideStringField;
    ADOTableCYLX: TWideStringField;
    ADOTableHZBZ: TMemoField;
    ADOQueryTMP: TADOQuery;
    DSTMP: TDataSource;
    DSBH: TDataSource;
    ADOTableBH: TADOTable;
    ADOTableBHnextbh: TIntegerField;
    ADOTableXMPY: TADOTable;
    DSXMPY: TDataSource;
    ADOTableXMPYbh: TIntegerField;
    ADOTableXMPYxm: TWideStringField;
    ADOTableXMPYpy: TWideStringField;
    ADOTableXMPYwb: TWideStringField;
    ADOTableXMPYhz: TBooleanField;
    ADOTableHZSG: TWideStringField;
    ADOTableHZNL: TIntegerField;
    ADOTableCYNL: TIntegerField;
    ADOCommandTMP: TADOCommand;
    ADOTableHZXX: TWideStringField;
    ADOTableCYXX: TWideStringField;
    ADOTableHZYH: TWideStringField;
    procedure ADOTableHZBeforeDelete(DataSet: TDataSet);
    procedure ADOTableHZBeforeInsert(DataSet: TDataSet);
    procedure ADOTableHZNewRecord(DataSet: TDataSet);
    procedure ADOTableCYBeforeDelete(DataSet: TDataSet);
    procedure ADOTableHZAfterPost(DataSet: TDataSet);
    procedure ADOTableHZCSNYValidate(Sender: TField);
    procedure ADOTableCYAfterPost(DataSet: TDataSet);
    procedure ADOTableCYNewRecord(DataSet: TDataSet);
    procedure ADOTableHZCalcFields(DataSet: TDataSet);
    procedure ADOTableCYCalcFields(DataSet: TDataSet);
    procedure ADOTableCYCSNYValidate(Sender: TField);
    procedure ADOTableHZRSValidate(Sender: TField);
    procedure ADOTableHZSFZValidate(Sender: TField);
    procedure DSHZDataChange(Sender: TObject; Field: TField);
    procedure ADOTableHZPostError(DataSet: TDataSet; E: EDatabaseError;
      var Action: TDataAction);
    procedure ADOTableCYPostError(DataSet: TDataSet; E: EDatabaseError;
      var Action: TDataAction);

  private
    { Private declarations }
  public
    { Public declarations }
  end;
  function Confirm(Msg: string): Boolean;  //信息确认
var
  DataHJZL: TDataHJZL;
  IsAddNewHZ:Boolean;   //记录新增标记
  IsAddNewCY:Boolean;


implementation
uses Func,Main,HJZL_Edit;
{$R *.dfm}
const
  DatasetStates: array[TDataSetState] of string =
    ('Not active', 'Browsing', 'Editing', 'Inserting',
    '', '', '', '', '','', '', '', '');   //13个，一个都不能少


function Confirm(Msg: string): Boolean;
begin
  Result := MessageDlg(Msg, mtConfirmation, mbYesNoCancel, 0) = mrYes;
end;


procedure TDataHJZL.ADOTableHZBeforeDelete(DataSet: TDataSet);
var
 msg:string;
begin
  msg:='如果删除户主，与该户主相关的所有资料将被全部删除！';
  msg:=msg+#13#10+#13#10+' 确定要删除['+AdoTableHZXM.Value+']吗？' ;

  If (Application.MessageBox(pchar(MSG),'删除确认',MB_OKCANCEL+MB_ICONQUESTION)=2)
  then SysUtils.Abort
            //if not Confirm(msg) then Abort
  else Begin  //删除XMPY表相关记录，成员表因已与户主表相关联，可不处理
    With ADOTableXMPY DO
      begin
       DisableControls ;   //解除组件绑定，加快执行速度
       try
         While Locate('BH',ADOTableHZBH.Value,[]) do DELETE;
       finally
         EnableControls;
       end;
      end;
  end;
end;

procedure TDataHJZL.ADOTableHZBeforeInsert(DataSet: TDataSet);
begin
  if AdotableHZ.State in dsEditModes then
  begin
    if Confirm('正在编辑记录，保存修改后新增记录吗?') then
      ADOTableHZ.Post
    else
      Abort;
  end;
end;

procedure TDataHJZL.ADOTableHZNewRecord(DataSet: TDataSet);
begin
 IsAddNewHZ:=True;//设定增加记录标记，存盘后复位
 with ADOTableBH do
  begin
    Open;
    AdoTableHZBH.Value := ADOTableBHnextbh.Value; //户主新编号
    Close;
  end;
//设定初始值
 ADOTableHZJTH.Value:=True;
 AdoTableHZXB.Value:='男';
 AdoTableHZMZ.Value:='汉族';
 AdoTableHZCSNY.Value:=Date-30*365 ;
 AdoTableHZWH.Value:='高中';
 AdoTableHZRS.Value:=1;
end;

procedure TDataHJZL.ADOTableCYBeforeDelete(DataSet: TDataSet);
var
 msg:string;
begin


  msg:=' 确定要删除家庭成员['+AdoTableCYXM.Value+']吗？' ;
  if not Confirm(msg) then Abort  ;
end;

procedure TDataHJZL.ADOTableHZAfterPost(DataSet: TDataSet);
begin

  IF AdoTableCY.State in dsEditModes  THEN
    AdoTableCY.Post; //成员数据存盘

IF IsAddNewHZ THEN BEGIN //新增户主时在XMPY表中增加相应记录
   //SQL操纵语句 不能应用于表
   WITH AdoTableXMPY DO
     BEGIN
      Open;
      Append;
      FieldByName('BH').AsInteger:= ADOTableHZBH.Value;
      FieldByName('xm').AsString:= ADOTableHZXM.Value;
      FieldByName('py').AsString:= GetPY(ADOTableHZXM.Value);
      FieldByName('hz').AsBoolean:=True;
      Post;
     END;


   // 户主编号递增1
   with ADOTableBH do
    begin
     try
      Open;
      Edit;
      ADOTableBHnextbh.Value := ADOTableBHnextbh.Value + 1; //设定下一编号
      Post;
     finally
      Close;
      //showmessage('编号已增加');
     end;
   end;//with ADOTableBH do

   IsAddNewHZ:=False;       //增加标记复位
END;//IF IsAddNewHZ THEN BEGIN

end;

procedure TDataHJZL.ADOTableHZCSNYValidate(Sender: TField);
begin
  If ADOTableHZCSNY.Value>Date-20*365 Then
   Raise Exception.Create('户主的年龄不能小于20岁！');
end;

procedure TDataHJZL.ADOTableCYAfterPost(DataSet: TDataSet);
begin
   if IsAddNewCY THEN BEGIN //成员新增时在XMPY表中增加相应记录
     WITH AdoTableXMPY DO
      BEGIN
       Append;
       FieldByName('BH').AsInteger:= ADOTableCYBH.Value;
       FieldByName('xm').AsString:= ADOTableCYXM.Value;
       FieldByName('py').AsString:= GetPY(ADOTableCYXM.Value);
       FieldByName('hz').AsBoolean:=False;
       Post;
      END;
    IsAddNewCY:=False;//恢复新增标记
   END; //IF
END;

procedure TDataHJZL.ADOTableCYNewRecord(DataSet: TDataSet);
begin
  IsAddNewCY:=True;  //新增标记为真,存盘完成后复位
//设定初始值
 AdoTableCYXB.Value:='男';
 AdoTableCYMZ.Value:='汉族';
 AdoTableCYCSNY.Value:=Date-20*365 ;
 AdoTableCYWH.Value:='高中';

end;

procedure TDataHJZL.ADOTableHZCalcFields(DataSet: TDataSet);
var
  dCSNY: TDateTime;
  Year, Month, Day: Word;
  Year2, Month2, Day2: Word;
begin
  dCSNY:=ADOTableHZCSNY.Value;
   DecodeDate(date,year,month,day);
   DecodeDate(dCSNY,year2,month2,day2);
  if NOT datahjzl.ADOTableHZCSNY.IsNull then
   ADOTableHZNL.Value:=year-year2; //计算户主年龄
end;

procedure TDataHJZL.ADOTableCYCalcFields(DataSet: TDataSet);
var
  dCSNY: TDateTime;
  Year, Month, Day: Word;
  Year2, Month2, Day2: Word;
begin
  dCSNY:=ADOTableCYCSNY.Value;
   DecodeDate(date,year,month,day); //分解时间,要先定义变量
   DecodeDate(dCSNY,year2,month2,day2);
   if NOT datahjzl.ADOTableCYCSNY.IsNull then
   ADOTableCYNL.Value:=year-year2; //计算成员年龄
end;

procedure TDataHJZL.ADOTableCYCSNYValidate(Sender: TField);
begin
  If ADOTableCYCSNY.Value>=Date Then
   Raise Exception.Create('当前家庭成员的出生年月不能是当前日期或未来的日期！');
end;

procedure TDataHJZL.ADOTableHZRSValidate(Sender: TField);
begin
   If ADOTableHZRS.Value>10 Then
   Raise Exception.Create('家庭成员过多！');
end;

procedure TDataHJZL.ADOTableHZSFZValidate(Sender: TField);
var L:Integer;
begin
  L:=Length(ADOTableHZSFZ.Value);
  IF L<>15 THEN
     if  L<>18 THEN
       Raise Exception.Create('身份证号码的长度只能是15位或18位数字！');


end;

procedure TDataHJZL.DSHZDataChange(Sender: TObject; Field: TField);
begin

 { FrmMain.StatusBar1.Panels[0].Text:=
   Format('当前数据表：%S   记录总数：%d  当前记录号: %d   当前状态:%S]',
      [DataHJZL.AdoTableHZ.TableName,DataHJZL.AdoTableHZ.RecordCount,
      DataHJZL.AdoTableHZ.RecNo, AdoTableHZ.State);
      }

end;

procedure TDataHJZL.ADOTableHZPostError(DataSet: TDataSet;
  E: EDatabaseError; var Action: TDataAction);
begin
  Raise Exception.Create('户主表中的姓名、性别、住户页号等不能空白，请检查是否已输入？'
     +#13+#13+'如果不是，可能是其它错误，请仔细检查！'
     +#13+#13+'再不能存盘，你可取消所作的修改！') ;
end;

procedure TDataHJZL.ADOTableCYPostError(DataSet: TDataSet;
  E: EDatabaseError; var Action: TDataAction);
begin
  Raise Exception.Create('家庭成员表中的姓名、关系、性别等不能空白，请检查是否已输入？'
     +#13+#13+'如果不是，可能是其它错误，请仔细检查！或取消修改') ;
end;

end.