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