ک کردن تاریخ

[منتظر283]

چه طور می توان چک کرد که تاریخی که وارد میشود به طور صحیح وارد شود

[mzjahromi]

خوب باید چک کنی دیگه؟
اگه تاریخت میلادی باشه با StrToDate و Try Except البته این یکی از راههاشه.
اگر هم تاریخت شمسیه؟؟؟؟ من که خودم با برنامه نویسی چکش می کنم

[babak869]

سلام
میشه اون نمونه برنامه نویسیت رو اینجا بذاری؟
ممنونم

[mzjahromi]

البته این کد فقط وقتی بدرد می خوره که همه روشهاتون مثل من باشه.در هر حال من کد روو می ذارم امیدوارم بدردتون بخوره


function TMB.StrToDate(Sender: tobject):longint;
var
i,j:integer;
s1,s2,s3,s:string[5];
flag:boolean;
begin
s1:='';s2:='';s3:='';
j:=20;
if tedit(sender).text<>'' then flag:=true else flag:=false;
if flag then
begin
for i:=1 to 10 do
if tedit(sender).text[i]<>'/' then
s1:=s1+tedit(sender).text[i]
else
begin j:=i;break;end;

for i:=j+1 to 12 do
if tedit(sender).text[i]<>'/' then
s2:=s2+tedit(sender).text[i]
else
begin j:=i;break end;

for i:=j+1 to 14 do
if tedit(sender).text[i]<>'' then
s3:=s3+tedit(sender).text[i]
else
begin j:=i; break; end;
if s1='' then s1:='0';
if s2='' then s2:='0';
if s3='' then s3:='0';
if(StrToInt1(s3)>60) or (StrToInt1(S3)>StrToInt1(S1))then
begin s:=s1;s1:=s3;s3:=s; end;
if (StrTOInt1(S1)<=100)Then
S1:=IntTOStr(StrToInt1(S1)+1300)
Else if(StrTOInt1(S1)<=1000)Then
S1:=IntTOStr(StrToInt1(S1)+1000)
end;
tedit(sender).text:=s1+'/'+s2+'/'+s3;
if flag then
if (j>11)or(s1='')or(s2='')or(s3='') then flag:=false
else if (StrToInt1(s1)<1300)or(StrToInt1(s2)>12)or(StrToInt1(s3)>31)
then flag:=false
else if(StrToInt1(s2)>6)and (StrToInt1(s3)>30)then flag:=false;
if not flag then
begin
showmessage('&Ecirc;&Ccedil;&Ntilde;&iacute;&Icirc;'+' '+s1+'/'+s2+'/'+s3+' '+'&Ccedil;&Ograve; &Ecirc;&Ccedil;&Ntilde;&iacute;&Icirc;&aring;&Ccedil;&iacute; &atilde;&Igrave;&Ccedil;&Ograve; &aring;&Igrave;&Ntilde;&iacute; &Ocirc;&atilde;&Oacute;&iacute; &auml;&atilde;&iacute; &Egrave;&Ccedil;&Ocirc;&Iuml;');//invalid date
strtodate:=0;
end
else
strtodate:=(StrToInt1(s1)*10000)+(StrToInt1(s2)*10 0)+StrToInt1(s3);
TEdit(Sender).Text:=DateToStr1((StrToInt1(s1)*1000 0)+(StrToInt1(s2)*100)+StrToInt1(s3));
// if tedit(sender).text='//' then
// tedit(sender).text:='';
end;

[FirstLine]

Function Check_Date(Str_Date:String):Boolean;
Var
Str_Temp:String;
Int_Temp:integer;
Begin
Str_Date := Compress_String(Str_Date, False);
if Not (Length(Str_Date) = 10) then begin Check_Date:=False;Abort; end;

for Int_Temp:=1 to 10 do
begin
str_temp:=Copy(str_Date,int_Temp,1);
if Pos(Str_Temp,'0123456789/')<1 then begin Check_Date:=False;Abort; end;
end;

if ( (Copy(Str_date,5,1)='/') And (Copy(Str_date,8,1)='/')) Then
begin
Str_Temp := Copy(Str_Date,1,4);
if NOT ((StrToInt(Str_Temp)>1000) AND (StrToInt(Str_Temp)<3000)) then begin Check_Date:=False;Abort; end;

Str_Temp := Copy(Str_Date,6,2);
if NOT ((StrToInt(Str_Temp)>0) AND (StrToInt(Str_Temp)<13)) then begin Check_Date:=False;Abort; end;

Str_Temp := Copy(Str_Date,9,2);
if NOT ((StrToInt(Str_Temp)>0) AND (StrToInt(Str_Temp)<32)) then begin Check_Date:=False;Abort; end;
Check_Date:=True;
end else begin
if ( (Copy(Str_date,3,1)='/') And (Copy(Str_date,6,1)='/')) Then
begin
Str_Temp := Copy(Str_Date,7,4);
if NOT ((StrToInt(Str_Temp)>1000) AND (StrToInt(Str_Temp)<3000)) then begin Check_Date:=False;Abort; end;

Str_Temp := Copy(Str_Date,4,2);
if NOT ((StrToInt(Str_Temp)>0) AND (StrToInt(Str_Temp)<13)) then begin Check_Date:=False;Abort; end;

Str_Temp := Copy(Str_Date,1,2);
if NOT ((StrToInt(Str_Temp)>0) AND (StrToInt(Str_Temp)<32)) then begin Check_Date:=False;Abort; end;
Check_Date:=True;
end else begin
Check_Date:=False;Abort;
end;
end;

End;

[oghab]

سلام
با آرزوی موفقیت برای همگی!
من برای دریافت تاریخ از maskedit استفاده می کنم و editmask آن به صورت زیر است:


!9999/99/99;1;_

و برای چک کردن این تاریخ (البته شمسی) از این تابع استفاده می کنم


Function mask_tarikh(str:string):boolean;
var
b:boolean;
x:integer;
s:string;
begin
b:=true;
if b and (str=' / / ') then
begin
b:=false;
ShowMessage('تاریخ مشخص نشده است');
end;
x:=pos(' ',str );
if b then
if x>0 then
begin
b:=false;
showmessage('تاریخ صحیح نمی باشد');
end;
if b then
begin
s:=str;
s:=copy(s,6,2);
x:=strtoint(s);
if (x >12) or (x<1) then
begin
ShowMessage('ماه تاریخ صحیح نمی باشد');
b:=false;
end;

if x>6 then
begin
s:=str;
s:=copy(s,9,2);
x:=strtoint(s);
if (x>30) or (x<1) then
begin
ShowMessage('روز تاریخ صحیح نمی باشد');
b:=false;
end;
end;
if b then
begin
s:=str;
s:=copy(s,9,2);
x:=strtoint(s);
if (x >31) or (x<1) then
begin
b:=false;
ShowMessage('روز تاریخ صحیح نمی باشد');
end;
end;
end;
mask_tarikh:=b;
end;

و هر جایی که لازم باشه چک کنم تاریخ وارد شده صحیح است یا نه1 به این صورت تابع را فراخوانی می کنم:


b1:=mask_tarikh(maskedit2.Text );
if b1=false then
maskedit2.SetFocus;

و b1 از نوع boolean است!

[babak869]

دست همگی درد نکنه عالی بود
مرسی

[Developer Programmer]

یک موردی در مورد تاریخ شمسی هست که دوستان فراموش می کنن
و اون اینه که مثلا در سال کبیسه برای اسفند ماه ، روز 30 نوشته بشه! یا مثلا برای ماهی که 30 روز بیشتر نداره ، 31 تایپ بشه


(* Afshin_Z@Yahoo.Com
http://AfshinZavar.50megs.com
*)

(*Warnning: Code isn't optimized!*)

Function CheckDate(Field:String):Byte;
var
CurYear,CurMonth,CurDay:Variant; {today !}
Year,Month,Day:Variant;
M,D:String; {Holds Month and Day of Field}
T,Z:String; {used for date of Field }
T1,T2:Byte; {used to find locations of '/' in Field}
begin
T:=Trim(Field) ;
{location of first '/'}
T1:=Pos('/',T );
{Substring after the first '/'}
Z:=Copy(T , T1+1 ,Length(T)-t1);
{location of sencond '/' in substring Z}
T2:=Pos('/',Z);

If (T1=0) or (Length(T)<>10) or (T2=0) then
begin
Application.MessageBox('Correct format of date is YYYY/MM/DD','',MB_IconInformation);
Result:=1;
Abort;
end;

T2:=T2+T1; (* location of second '/' in whole of date string*)
Year:=Trim(Copy( T, 1 , T1-1 ));
Month:=Trim(Copy( T, T1+1 , (T2-T1)-1 ));
Day:=Trim(Copy( T, T2+1, Length(T)-T2));

(*
Tfardate is a perfect Milady2Shamsi date convertion component
developed by SalarSoft
*)
{current YEAR of system}
CurYear:= Tfardate.farYearOf(TFarDate.MiladyToShamsi(Now));
{current MONTH of system}
CurMonth:=Tfardate.farMonthOf(TFarDate.MiladyToSha msi(Now));
{current DAY of system}
CurDay:= Tfardate.farDayOf(TFarDate.MiladyToShamsi(Now));

If CurYear>1300 Then Dec(CurYear,1300);

{we have two '/' in date string, but ther is no day,month or year value!}
If (Year='') Or (Month='') Or (Day='') Then
begin
Application.MessageBox('Correct format of date is YYYY/MM/DD','',MB_IconInformation);
Result:=1;
end
Else
begin
M:=Month; {We'll use this 2 variables later}
D:=Day;
StrToInt(Year);
StrToInt(Month);
StrToInt(Day);

If Year>1300 Then Year:=(Year-1300);
If (Day<1) or (Day>31) then
begin
Application.MessageBox('Day must be between 1 and 31','',MB_IconInformation);
Result:=1;
Abort;
end;
If (Month<1) or (Month>12) then
begin
Application.MessageBox('Month must be between 1 and 12','',MB_IconInformation);
Result:=1;
Abort;
end;
If (Year < 0) or (Year>99) Then
begin
Application.MessageBox('Year must be between 1300 and 1399','',MB_IconInformation);
Result:=1;
Abort;
end;
If (Month>=1) And (Month<=6) Then
If ( Day<1 ) Or ( Day>31 ) Then
begin
Application.MessageBox('Maximum day value for Farvardin upto Shahrivar is 31','',MB_IconInformation);
Result:=1;
Abort;
end;
If (Month>=7) And (Month<=12) Then
If ( Day<1 ) Or ( Day>30 ) Then
begin
Application.MessageBox('Maximum day value for Mehr upto Esfand is 30','',MB_IconInformation);
Result:=1;
Abort;
end;
If (Month=12) Then
If (Year mod 4 = 0) And ((Year mod 100 <> 0) or (Year mod 400 = 0)) Then // Leap Year
If ( Day<1 ) Or ( Day >29 ) Then
begin
Application.MessageBox('maximum day value for Esfand in a leap year is 29','',MB_IconInformation);
Result:=1;
Abort;
end;
end;
Result:=0;

end;

خوش باشین

[babak869]

با سلام
آقای افشین میشه یه مثال از کدی که نوشتی بزنی یا اینکه این فانکشن رو چطور استفاده کنیم؟
متشکرم

[MiRHaDi]

سلام
این که مشکلی نداره خوب !
برای ماههای 1 تا 5 31 روزه برای 6 تا 11 30 روزه برای 12 هم اگر کبیسه باشه 30 نباشه 29 ! بقیش هم که مشخصه ! حالا کبیسه هست یا نه رو معمولا اینجا چک نمیکنند و همون 30 رو قبول میکنند چون توی 90% الگوریتمهای تبدیل فارسی (بیش از 90%) کبیسه ها درست حساب نمیشود
بای

[Developer Programmer]

آقای افشین میشه یه مثال از کدی که نوشتی بزنی یا اینکه این فانکشن رو چطور استفاده کنیم؟

سلام
همونطور که از تعریف تابع معلومه ، باید تاریخی از نوع رشته، (با طول 10 کراکتر) رو به تابع بدید ؛ تابع در صورت درست بودن مقدار صفر و در صورت غلط بودن مقدار یک رو بر میگردونه
اگه خواستین از TFarDate استفاده کنید با سالار SalarSoft تماس بگیرید(عضو همین سایت) ، وگرنه که می بایست با کامپوننت خودتون تاریخ شمسی جاری سیستم رو به CurYear پاس بدهید.


چون توی 90% الگوریتمهای تبدیل فارسی (بیش از 90%) کبیسه ها درست حساب نمیشود



If (Year mod 4 = 0) And ((Year mod 100 <> 0) or (Year mod 400 = 0)) Then

[babak869]

با سلام
من منظورم اینه که مثلا برای چک کردن تلریخ در رویداد OnExit یه EditBox چطور این فانکشن رو فراخوانی کنم؟

[Developer Programmer]

من منظورم اینه که مثلا برای چک کردن تاریخ در رویداد OnExit یه EditBox چطور این فانکشن رو فراخوانی کنم؟




if CheckDate(edit1.text)=0 then showmessage('Ok');

[MiRHaDi]

سلام
افشین جان کد شما کبیسه میلادی رو حساب میکنه !
من گفتم تو الگوریتمهای شمسی !
قربونت برم
بای

[Developer Programmer]

هادی جان ، مطمئنی؟ من تست کردم ها !
فدات

[babak869]

آقای افشین سلام
دستت درد نکنه.ممنون از راهنماییت.
موفق باشی

[MiRHaDi]

سلام
بله عزیزم مطمئنم
و متاسفانه گفتم اکثر قریب به اتفاق برنامه هایی هم که میبینید برای تبدیل تاریخ تو کبیسه های شمسی مشکل دارند ! سیستم شمسی خیلی پیچیده تر از اینهاست ! دوره چهل و چند هزار ساله داره !
این مال تاریخ قمری هست با دوره 400 ساله !
بگذریم ! همینقدر بدونیم که درست نیست برای اینجا کافیه ! اگر خواستید Iranian Calendar رو سرچ کنید تو اینترنت توضیحاتش هست
بای

[SalarSoft]

یه مسئله که دوستان فراموش کردن اینه که نوع سیستم تاریخ در ویندوز های مختلف متفاوته.
اگه بخوایم که به صورت استاندارد با استفاده از تابع موجود در TFarDate.farStrToDate استفاده کنیم باید این مئله رو هم رعایت کنیم.
برای مثال در ویندوز های عربی که فارسی شده اند(me و98) ممکن است تاریخ با قالب " روز ماه سال" مورد قبول باشد ولی در ویندوز xp به صورت "سال ماه روز" پذیرفته بشه!

اگه وقت کردم بیشتر توضیح خواهم داد!


و متاسفانه گفتم اکثر قریب به اتفاق برنامه هایی هم که میبینید برای تبدیل تاریخ تو کبیسه های شمسی مشکل دارند
این ایزار این مشکلو نداره:
http://salarsoft.somee.com/downloads/free/farsidate.zip