unit11.pas

个人通讯录信息管理系统 很好用的

unit Unit11;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons;

type
  Tfmjxlx = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    Label5: TLabel;
    procedure Edit2KeyPress(Sender: TObject; var Key: Char);
    procedure Edit2Exit(Sender: TObject);
    procedure Edit3KeyPress(Sender: TObject; var Key: Char);
    procedure Edit3Exit(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  fmjxlx: Tfmjxlx;

implementation

uses Unit2, Unit10, Unit6, Unit3;

{$R *.dfm}

procedure Tfmjxlx.Edit2KeyPress(Sender: TObject; var Key: Char);
begin
  if not ( ((ord(key)>=48) and (ord(key)<=57)) or (ord(key)=8)) then
  begin
    key:=#16;
    exit;
  end;
end;

procedure Tfmjxlx.Edit2Exit(Sender: TObject);
begin
  if edit2.Text='' then        //文本框为空可以退出
    exit;

  if length(edit2.Text)<>2 then
  begin
    showmessage('联系方式组ID为两位数字！');
    edit2.SetFocus;
    exit;
  end;
end;

procedure Tfmjxlx.Edit3KeyPress(Sender: TObject; var Key: Char);
begin
  if not ( ((ord(key)>=48) and (ord(key)<=57)) or (ord(key)=45) or (ord(key)=8)) then
  begin
    key:=#16;
    exit;
  end;
end;

procedure Tfmjxlx.Edit3Exit(Sender: TObject);
var
  str,stryear,strmonth,strday:string;
  isdate:boolean;
begin
  if edit3.Text='' then       //文本框为空可以退出
    exit;

  isdate:=true;
  str:=fmjxlx.edit3.Text;

  if (length(str)<>10) or (copy(str,1,1)='-') or (copy(str,2,1)='-') or (copy(str,3,1)='-') or (copy(str,4,1)='-') or (copy(str,5,1)<>'-') or (copy(str,6,1)='-') or (copy(str,7,1)='-') or (copy(str,8,1)<>'-') or (copy(str,9,1)='-') or (copy(str,10,1)='-') then
  begin
    showmessage('格式出错！');
    edit3.SetFocus;
    exit;
  end; //此行代码以后确保日期格式类似2000-01-01

  strmonth:=copy(str,6,2);   //测试月份是否合法
  if (strtoint(strmonth)>12) or (strtoint(strmonth)<1) then
  begin
    isdate:=false;
  end;

  stryear:=copy(str,1,4);
  strday:=copy(str,9,2);     //测试日是否合法
  case strtoint(strmonth) of
  1,3,5,7,8,10,12:
    if (strtoint(strday)>31) or (strtoint(strday)<1) then
      isdate:=false;
  4,6,9,11:
    if (strtoint(strday)>30) or (strtoint(strday)<1) then
      isdate:=false;
  2:
    if (strtoint(stryear) mod 400=0) or ((strtoint(stryear) mod 4=0) and (strtoint(stryear) mod 100<>0))then
      if (strtoint(strday)>29) or (strtoint(strday)<1) then
        isdate:=false;
    else
      if (strtoint(strday)>28) or (strtoint(strday)<1) then
        isdate:=false;
  end;

  if isdate then         //是否大于今日
  begin
    if encodedate(strtoint(stryear),strtoint(strmonth),strtoint(strday))>date then
      isdate:=false;
  end;

  if not isdate then
  begin
    showmessage('日期不合法，正确格式为月日年！');
    edit3.SetFocus;
  end;
end;


procedure Tfmjxlx.BitBtn1Click(Sender: TObject);
begin
  if edit2.Text=''then
  begin
    showmessage('联系方式组ID不能为空！');
    edit2.SetFocus;
    exit;
  end;

  if edit3.Text=''then
  begin
    showmessage('联系日期不能为空！');
    edit3.SetFocus;
    exit;
  end;

  fmlxfs.ADOTable1.Filtered:=false;
  if not fmlxfs.ADOTable1.Locate('contactid;groupid',vararrayof([fmjxlx.Edit1.Text,fmjxlx.Edit2.Text]),[]) then
  begin
    showmessage('联系方式表中无此种联系方式！');
    fmjxlx.Edit2.SetFocus;
    exit;
  end
  else
  begin
    fmlxls.ADOTable1.Append;
    fmlxls.ADOTable1.FieldByName('contactid').AsString:=edit1.Text;
    fmlxls.ADOTable1.FieldByName('groupid').AsString:=edit2.Text;
    fmlxls.ADOTable1.FieldByName('contactdate').AsString:=edit3.Text;
    if edit4.Text<>'' then
      fmlxls.ADOTable1.FieldByName('memo').AsString:=edit4.Text;
    fmlxls.ADOTable1.Post;

    //写入或更新联系人表的shouldcontactdate字段
    fmlxr.ADOTable1.Locate('contactid',edit1.Text,[]);
    fmlxrz.ADOTable1.Locate('groupid',fmlxr.ADOTable1.fieldbyname('groupid').AsString,[]);
    if (fmlxr.ADOTable1.FieldByName('shouldcontactdate').AsString='') or ((fmlxr.ADOTable1.FieldByName('shouldcontactdate').AsString<>'') and (fmlxr.ADOTable1.FieldByName('shouldcontactdate').AsDateTime<strtodate(edit3.Text)+fmlxrz.ADOTable1.fieldbyname('interval').AsInteger)) then
    begin
    	fmlxr.ADOTable1.Edit;
    	fmlxr.ADOTable1.FieldByName('shouldcontactdate').AsDatetime:=strtodate(edit3.Text)+fmlxrz.ADOTable1.fieldbyname('interval').AsInteger;
    	fmlxr.ADOTable1.Post;
    	fmlxr.ADOTable1.Close;
    	fmlxr.ADOTable1.Open;
    end;

    showmessage('已成功插入联系历史表！');
    fmjxlx.Close;
  end;
  fmlxfs.ADOTable1.Filtered:=true;


end;

procedure Tfmjxlx.BitBtn2Click(Sender: TObject);
begin
  fmjxlx.Close;
end;

end.