unit2.~pas

个人通讯录信息管理系统

unit Unit2;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Grids, DBGrids, DB, ADODB, Menus, StdCtrls, Buttons;

type
  Tfmlxr = class(TForm)
    DataSource1: TDataSource;
    DBGrid1: TDBGrid;
    ADOTable1: TADOTable;
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    xingjian: TMenuItem;
    xiugai: TMenuItem;
    shanchu: TMenuItem;
    N5: TMenuItem;
    anxingmingchaxun: TMenuItem;
    anIDchaxun: TMenuItem;
    anchushengriqichaxun: TMenuItem;
    BitBtn1: TBitBtn;
    N8: TMenuItem;
    anIDpaixu: TMenuItem;
    anxingmingpaixu: TMenuItem;
    anzuIDpaixu: TMenuItem;
    anchushengriqipaixu: TMenuItem;
    anxingbiepaixu: TMenuItem;
    lianxi: TMenuItem;
    PopupMenu1: TPopupMenu;
    N13: TMenuItem;
    N14: TMenuItem;
    N15: TMenuItem;
    N16: TMenuItem;
    N17: TMenuItem;
    N18: TMenuItem;
    N19: TMenuItem;
    ID4: TMenuItem;
    N20: TMenuItem;
    ID5: TMenuItem;
    N21: TMenuItem;
    ID6: TMenuItem;
    N22: TMenuItem;
    N23: TMenuItem;
    chakanlianxilishi: TMenuItem;
    N2: TMenuItem;
    chakanlianxifangshi: TMenuItem;
    N3: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure xingjianClick(Sender: TObject);
    procedure xiugaiClick(Sender: TObject);
    procedure shanchuClick(Sender: TObject);
    procedure anxingmingchaxunClick(Sender: TObject);
    procedure anIDchaxunClick(Sender: TObject);
    procedure anchushengriqichaxunClick(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure anxingmingpaixuClick(Sender: TObject);
    procedure anIDpaixuClick(Sender: TObject);
    procedure anzuIDpaixuClick(Sender: TObject);
    procedure anchushengriqipaixuClick(Sender: TObject);
    procedure anxingbiepaixuClick(Sender: TObject);
    procedure lianxiClick(Sender: TObject);
    procedure chakanlianxilishiClick(Sender: TObject);
    procedure chakanlianxifangshiClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  fmlxr: Tfmlxr;
  isadd:boolean=true;

implementation
uses unit1,unit3,unit4, Unit11, Unit10, Unit6;

{$R *.dfm}

function isdate(str:string):boolean;
var
  strmonth,strday,stryear:string;
  testisdate:boolean;
begin
  isdate:=true;
  testisdate:=true;
  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
    isdate:=false;
    //testisdate:=false;
    exit;
  end; //此行代码以后确保日期格式类似2000-01-01

  strmonth:=copy(str,6,2);   //测试月份是否合法
  if (strtoint(strmonth)>12) or (strtoint(strmonth)<1) then
  begin
    isdate:=false;
    testisdate:=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
    begin
      isdate:=false;
      testisdate:=false;
    end;
  4,6,9,11:
    if (strtoint(strday)>30) or (strtoint(strday)<1) then
    begin
      isdate:=false;
      testisdate:=false;
    end;
  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
      begin
        isdate:=false;
        testisdate:=false;
      end;
    else
      if (strtoint(strday)>28) or (strtoint(strday)<1) then
      begin
        isdate:=false;
        testisdate:=false;
      end;
  end;


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


procedure Tfmlxr.FormCreate(Sender: TObject);
begin
  adotable1.Connection:=fmmain.ADOConnection1;
  adotable1.TableName:='联系人表';
  adotable1.Open;

end;

procedure Tfmlxr.xingjianClick(Sender: TObject);
begin

  //清空
  fmlxraddormodify.edit3.Text:='';
  fmlxraddormodify.edit2.text:='';
  fmlxraddormodify.edit4.Text:='';
  fmlxraddormodify.edit1.Text:='';
  fmlxraddormodify.combobox2.ItemIndex:=-1;
  fmlxraddormodify.edit6.Text:='';

  isadd:=true;
  fmlxraddormodify.Caption:='新增联系人';
  fmlxraddormodify.ActiveControl:=fmlxraddormodify.edit3;
  fmlxraddormodify.ShowModal;
end;

procedure Tfmlxr.xiugaiClick(Sender: TObject);
begin
  if adotable1.RecordCount=0 then
  begin
    showmessage('没有选中的记录！');
    exit;
  end;

  fmlxraddormodify.edit3.Text:=adotable1.fieldbyname('contactid').AsString;
  fmlxraddormodify.edit2.text:=adotable1.fieldbyname('contactname').AsString;
  fmlxraddormodify.edit4.Text:=adotable1.fieldbyname('groupid').AsString;
  fmlxraddormodify.edit1.Text:=adotable1.fieldbyname('birthday').AsString;
  if adotable1.fieldbyname('sex').AsString='男' then
  begin
    fmlxraddormodify.combobox2.ItemIndex:=0;
  end
  else
  begin
    if adotable1.fieldbyname('sex').AsString='女' then
    begin
      fmlxraddormodify.combobox2.ItemIndex:=1;
    end
    else
    begin
      fmlxraddormodify.combobox2.ItemIndex:=-1;
    end;
  end;
  fmlxraddormodify.edit6.Text:=adotable1.fieldbyname('homeaddress').AsString;

  isadd:=false;
  fmlxraddormodify.Caption:='修改联系人';
  fmlxraddormodify.ActiveControl:=fmlxraddormodify.edit3;
  fmlxraddormodify.showmodal;
end;

procedure Tfmlxr.shanchuClick(Sender: TObject);
begin
  if adotable1.RecordCount=0 then
  begin
    showmessage('没有选中的记录！');
    exit;
  end;
  if messagedlg('删除此项记录将会同时删除相关表中的相关记录，确定要删除吗？',mtwarning,[mbyes,mbno],0)=mryes then
  begin
    adotable1.Delete;
  end;
end;

procedure Tfmlxr.anxingmingchaxunClick(Sender: TObject);
var
  xingming:string;
begin

  xingming:='';
  xingming:=inputbox('姓名输入','','');
  if xingming='' then   //如果取消操作
    exit;
  if length(xingming)>10 then
  begin
    showmessage('姓名长度不能超过10！');
    exit;
  end;

  if not adotable1.Locate('contactname',xingming,[])then
    showmessage('没有找到相关记录！');
end;

procedure Tfmlxr.anIDchaxunClick(Sender: TObject);
var
  id:string;
begin
  
  id:='';
  id:=inputbox('ID输入','','');
  if id='' then        //如果取消操作
    exit;
  if length(id)<>6 then
  begin
    showmessage('ID长度应为6！');
    exit;
  end;
  if not adotable1.Locate('contactid',id,[]) then
    showmessage('没有找到相关记录！');
end;

procedure Tfmlxr.anchushengriqichaxunClick(Sender: TObject);
var
  str:string;
begin

  str:='';
  str:=inputbox('出生日期输入','','');
  if str='' then  //如果取消操作
    exit;
  
  if not isdate(str) then
  begin
    showmessage('日期格式不正确，请确保日期格式为年月日（如2000-09-30）');
    //n7click;
  end
  else
  begin
    if not adotable1.Locate('birthday',strtodate(str),[]) then  //有可能出错，但试了一下没有出错
    begin
      showmessage('没有找到相关记录！');
    end;
  end;
end;


procedure Tfmlxr.BitBtn1Click(Sender: TObject);
begin
  fmlxr.Close;
end;

procedure Tfmlxr.anxingmingpaixuClick(Sender: TObject);
begin
	adotable1.Sort:='contactname';
end;

procedure Tfmlxr.anIDpaixuClick(Sender: TObject);
begin
  adotable1.Sort:='contactid';
end;

procedure Tfmlxr.anzuIDpaixuClick(Sender: TObject);
begin
	adotable1.Sort:='groupid';
end;

procedure Tfmlxr.anchushengriqipaixuClick(Sender: TObject);
begin
	adotable1.Sort:='birthday';
end;

procedure Tfmlxr.anxingbiepaixuClick(Sender: TObject);
begin
	adotable1.Sort:='sex';
end;

procedure Tfmlxr.lianxiClick(Sender: TObject);
var
  year,month,day:word;
  stryear,strmonth,strday:string;
begin
  if adotable1.RecordCount=0 then
  begin
    showmessage('没有选中的记录！');
    exit;
  end;

  fmjxlx.edit1.Text:=fmlxr.ADOTable1.fieldbyname('contactid').AsString;
  fmjxlx.edit2.Text:='';
  fmjxlx.Edit1.Enabled:=false;
  fmjxlx.Edit2.Enabled:=true;

  decodedate(date,year,month,day);
  stryear:=inttostr(year);
  strmonth:=inttostr(month);
  strday:=inttostr(day);

  if month<10 then
    strmonth:='0'+strmonth;
  if day<10 then
    strday:='0'+strday;

  fmjxlx.edit3.Text:=stryear+'-'+strmonth+'-'+strday;

  fmjxlx.edit4.Text:='';

  fmjxlx.ShowModal;
end;

procedure Tfmlxr.chakanlianxilishiClick(Sender: TObject);
begin
  if adotable1.RecordCount=0 then
  begin
    showmessage('没有选中的记录！');
    exit;
  end;
  
  fmlxls.ADOTable1.Filter:='contactid='+fmlxr.ADOTable1.fieldbyname('contactid').AsString;
  fmlxls.ADOTable1.Filtered:=true;
  fmlxls.ShowModal;
end;

procedure Tfmlxr.chakanlianxifangshiClick(Sender: TObject);
begin
  if adotable1.RecordCount=0 then
  begin
    showmessage('没有选中的记录！');
    exit;
  end;
  
  fmlxfs.ADOTable1.Filter:='contactid='+fmlxr.ADOTable1.fieldbyname('contactid').AsString;
  fmlxfs.ADOTable1.filtered:=true;
  fmlxfs.ShowModal;
end;

end.