?? 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.ActiveControl:=fmjxlx.Edit2;
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.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -