unit10.pas

个人通讯录管理系统。管理个人的通讯用的

unit Unit10;

interface

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

type
  Tfmlxls = class(TForm)
    ADOTable1: TADOTable;
    DataSource1: TDataSource;
    DBGrid1: TDBGrid;
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    shanchu: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    anlianxirenIDchaxun: TMenuItem;
    anlianxifangshichaxun: TMenuItem;
    anlianxiriqichaxun: TMenuItem;
    anlianxirenIDpaixu: TMenuItem;
    anlianxifangshipaixu: TMenuItem;
    anlianxiriqipaixu: TMenuItem;
    N7: TMenuItem;
    yitianshaixuan: TMenuItem;
    santianshaixuan: TMenuItem;
    yigexingqishaixuan: TMenuItem;
    yigeyueshaixuan: TMenuItem;
    yinianshaixuan: TMenuItem;
    bannianshaixuan: TMenuItem;
    sannianshaixuan: TMenuItem;
    PopupMenu1: TPopupMenu;
    N15: TMenuItem;
    N16: TMenuItem;
    N17: TMenuItem;
    N18: TMenuItem;
    ID5: TMenuItem;
    ID6: TMenuItem;
    N19: TMenuItem;
    ID7: TMenuItem;
    ID8: TMenuItem;
    N20: TMenuItem;
    N21: TMenuItem;
    N22: TMenuItem;
    N23: TMenuItem;
    N24: TMenuItem;
    bann1: TMenuItem;
    N25: TMenuItem;
    N26: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure shanchuClick(Sender: TObject);
    procedure anlianxirenIDchaxunClick(Sender: TObject);
    procedure anlianxifangshichaxunClick(Sender: TObject);
    procedure anlianxiriqichaxunClick(Sender: TObject);
    procedure anlianxirenIDpaixuClick(Sender: TObject);
    procedure anlianxifangshipaixuClick(Sender: TObject);
    procedure anlianxiriqipaixuClick(Sender: TObject);
    procedure yitianshaixuanClick(Sender: TObject);
    procedure santianshaixuanClick(Sender: TObject);
    procedure yigexingqishaixuanClick(Sender: TObject);
    procedure yigeyueshaixuanClick(Sender: TObject);
    procedure bannianshaixuanClick(Sender: TObject);
    procedure yinianshaixuanClick(Sender: TObject);
    procedure sannianshaixuanClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  fmlxls: Tfmlxls;

implementation

uses Unit1,unit2, Unit12;

{$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 Tfmlxls.FormCreate(Sender: TObject);
begin
  adotable1.Connection:=fmmain.ADOConnection1;
  adotable1.TableName:='联系历史表';
  adotable1.Open;
end;

procedure Tfmlxls.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 Tfmlxls.anlianxirenIDchaxunClick(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 Tfmlxls.anlianxifangshichaxunClick(Sender: TObject);
var
  id:string;
begin

  id:='';
  id:=inputbox('ID输入','','');
  if id='' then        //如果取消操作
    exit;
  if length(id)<>2 then
  begin
    showmessage('ID长度应为2！');
    exit;
  end;

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

procedure Tfmlxls.anlianxiriqichaxunClick(Sender: TObject);
var
  str:string;
begin

  str:='';
  str:=inputbox('联系日期输入','','');
  if str='' then  //如果取消操作
    exit;

  if not isdate(str) then
  begin
    showmessage('日期格式不正确，请确保日期格式为年月日（如2000-12-31）');
  end
  else
  begin
    if not adotable1.Locate('contactdate',strtodate(str),[]) then  //有可能出错，但试了一下没有出错
    begin
      showmessage('没有找到相关记录！');
    end;
  end;
end;

procedure Tfmlxls.anlianxirenIDpaixuClick(Sender: TObject);
begin
  adotable1.Sort:='contactid';
end;

procedure Tfmlxls.anlianxifangshipaixuClick(Sender: TObject);
begin
  adotable1.Sort:='groupid';
end;

procedure Tfmlxls.anlianxiriqipaixuClick(Sender: TObject);
begin
  adotable1.Sort:='contactdate';
end;

procedure Tfmlxls.yitianshaixuanClick(Sender: TObject);
var
  newdate:tdatetime;    //必须是tdatetime类型，不可以是tdate类型
begin
  newdate:=date;
  with fmtj.ADOQuery1 do
  begin
    close;
    sql.Clear;
    sql.Add('select * from 联系历史表 where contactdate between :thatday and :today order by contactdate DESC');
    Parameters.ParamByName('thatday').Value:=newdate;
    Parameters.ParamByName('today').Value:=date;
    prepared:=true;
    open;
  end;
  fmtj.Caption:='筛选结果';
  fmtj.ShowModal;
end;

procedure Tfmlxls.santianshaixuanClick(Sender: TObject);
var
  newdate:tdatetime;
begin
  newdate:=date-2;
  with fmtj.ADOQuery1 do
  begin
    close;
    sql.Clear;
    sql.Add('select * from 联系历史表 where contactdate between :thatday and :today order by contactdate DESC');
    Parameters.ParamByName('thatday').Value:=newdate;
    Parameters.ParamByName('today').Value:=date;
    prepared:=true;
    open;
  end;
  fmtj.Caption:='筛选结果';
  fmtj.ShowModal;
end;

procedure Tfmlxls.yigexingqishaixuanClick(Sender: TObject);
var
  newdate:tdatetime;
begin
  newdate:=date-6;
  with fmtj.ADOQuery1 do
  begin
    close;
    sql.Clear;
    sql.Add('select * from 联系历史表 where contactdate between :thatday and :today order by contactdate DESC');
    Parameters.ParamByName('thatday').Value:=newdate;
    Parameters.ParamByName('today').Value:=date;
    prepared:=true;
    open;
  end;
  fmtj.Caption:='筛选结果';
  fmtj.ShowModal;
end;

procedure Tfmlxls.yigeyueshaixuanClick(Sender: TObject);
var
  newdate:tdatetime;
begin
  newdate:=date-29;
  with fmtj.ADOQuery1 do
  begin
    close;
    sql.Clear;
    sql.Add('select * from 联系历史表 where contactdate between :thatday and :today order by contactdate DESC');
    Parameters.ParamByName('thatday').Value:=newdate;
    Parameters.ParamByName('today').Value:=date;
    prepared:=true;
    open;
  end;
  fmtj.Caption:='筛选结果';
  fmtj.ShowModal;
end;

procedure Tfmlxls.bannianshaixuanClick(Sender: TObject);
var
  newdate:tdatetime;
begin
  newdate:=date-179;
  with fmtj.ADOQuery1 do
  begin
    close;
    sql.Clear;
    sql.Add('select * from 联系历史表 where contactdate between :thatday and :today order by contactdate DESC');
    Parameters.ParamByName('thatday').Value:=newdate;
    Parameters.ParamByName('today').Value:=date;
    prepared:=true;
    open;
  end;
  fmtj.Caption:='筛选结果';
  fmtj.ShowModal;
end;

procedure Tfmlxls.yinianshaixuanClick(Sender: TObject);
var
  newdate:tdatetime;
begin
  newdate:=date-364;
  with fmtj.ADOQuery1 do
  begin
    close;
    sql.Clear;
    sql.Add('select * from 联系历史表 where contactdate between :thatday and :today order by contactdate DESC');
    Parameters.ParamByName('thatday').Value:=newdate;
    Parameters.ParamByName('today').Value:=date;
    prepared:=true;
    open;
  end;
  fmtj.Caption:='筛选结果';
  fmtj.ShowModal;
end;

procedure Tfmlxls.sannianshaixuanClick(Sender: TObject);
var
  newdate:tdatetime;
begin
  newdate:=date-1094;
  with fmtj.ADOQuery1 do
  begin
    close;
    sql.Clear;
    sql.Add('select * from 联系历史表 where contactdate between :thatday and :today order by contactdate DESC');
    Parameters.ParamByName('thatday').Value:=newdate;
    Parameters.ParamByName('today').Value:=date;
    prepared:=true;
    open;
  end;
  fmtj.Caption:='筛选结果';
  fmtj.ShowModal;
end;

end.