گرفتن تاریخ سیستم و تبدیل آن به تاریخ شمسی

[spicirmkh]

سلام

چطور می شود تاریخ سیستم به تاریخ شمسی تبدیل کرد . آیا Dbisam توابع دارد که این کار را انجام دهد . در ضمنا اگر در Dbisam تاریخ 31/02/81 وارد کنیم پیغام خطا می دهد چه کنیم
با تشکر

[مهدی کرامتی]

الف- خیر. شما باید از روالهای تبدیل تاریخ که توسط تولیدکنندگان دیگر بوجود آمده است استفاده کنید. یک نمونه خوب از پیاده‌سازی روالهای تبدیل تاریخ SH Date Solutions محصول http://www.farsicomponents.com میباشد.

ب- متن پیغام خطای فوق چیست؟

[spicirmkh]

الف - مجانی این توابع نیست

ب- پیغام خطا : is not a valid date 1382/02/31

[jirjirakk]

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

[سيد مجتبي هاشمي]

سلام. دوست عزیز میتونی تو سایت یه جستجو با عنوان "کامپوننت تقویم شمسی" انجام بدی. آقای خرسندی یه تقویم خیلی جالب برای دلفی طراحی کرده که تمام توابع مورد نیاز برای کار با تاریخ رو داره. اون رو دانلود کنید و پس از خوندن فایل Help به راحتی از اون استفاده کنید. برای راحتی کارتون فایلش رو اینجا میذارم.

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

[skflower]

سلام. آقا چرا همه میان کامپوننت میذارن. هدف یادگیریه نه «استفاده از آماده ها» که!!
من یه کد داشتم. سعی میکنم بگردم پیداش کنم و براتون بذارم. البته تکراری هست فکر کنم اکثراً دیده باشیدش.

[skflower]

اینم کد آماده

متغیر های عمومی و غیره در قسمت implementation

const

shamsi:array[0..11] of Integer=(0,31,62,93,124,155,186,216,246,276,306,33 6);

miladi:array[0..11] of integer=(0,31,59,90,120,151,181,212,243,273,304,33 4);

miladicab:array[0..11] of integer=(0,31,60,91,121,152,182,213,244,274,305,33 5);

var

cabise:array[0..19] of integer;

ezafe,baghi,res,i,sals,salm,mahm,mahs,roozm,roozs, majrooz:integer;

boolcabisemi,boolcabisesh:boolean;

s,s1,s2:string;

کد برنامه:

begin
cabise[0]:=2000;
cabise[1]:=2004;
cabise[2]:=2008;
S:=DateToStr(date);
while Pos('/', S) > 0 do
S[Pos('/', S)] := '0';
salm:=(StrToInt64(s) div 1000000);
baghi:=strtoint64(s) mod 100000;
mahm:=baghi div 1000;
roozm:=(baghi mod 100);
ezafe:=0;
boolcabisemi:=false;
boolcabisesh:=false;

for i:=0 to 19 do
if salm=cabise[i] then
begin
boolcabisemi:=true;
break;
end;

if boolcabisemi then
begin
majrooz:=miladicab[mahm-1]+roozm;
res:=80-majrooz;

if res<=0 then
res:=-(res)
else res:=365-res;

for i:=11 downto 0 do
if res>=shamsi[i] then
begin
mahs:=i+1;
roozs:=res-shamsi[i];
break;
end;
end
else
begin
majrooz:=miladi[mahm-1]+roozm;
res:=80-majrooz;
if res<=0 then
res:=-(res)
else res:=365-res;
for i:=11 downto 0 do
if res>=shamsi[i] then
begin
mahs:=i+1;
roozs:=res-shamsi[i];
Break;
end;
end;
if 80-majrooz>=1 then
sals:=salm-622
else
sals:=salm-621;

i:=sals-1383;
if (i mod 4)=0 then
boolcabisesh:=true;

if (boolcabisemi) and (boolcabisesh) then
ezafe:=0
else
ezafe:=1;
if (boolcabisesh) then
ezafe:=ezafe+1;
if (boolcabisesh) and not(boolcabisemi) then
if roozs=29 then
begin
roozs:=-1;
mahs:=mahs+1;
end;
roozs:=roozs+ezafe;
if roozs<10 then
s1:='0'+IntToStr(roozs)
else
s1:=IntToStr(roozs);
if mahs<10 then
s2:='0'+IntToStr(mahs)
else
s2:=IntToStr(mahs);
s:=IntToStr(sals)+'/'+s2+'/'+s1;
datel.Caption:='امروز: '+s;
tarikh.Caption:=s;
end;
timel.Caption:='ساعت: '+FormatDateTime('hh:mm:ss',Time);
end;

البته برای نمایش نهایی باید دو لیبل به نام های datel و timel برای تاریخ شمسی و ساعت استفاده کنید. درضمن سال کبیسه رو هم نمایش میده.
موفق باشید

[skflower]

خودم بارها ازش استفاده کردم. هیچ مشکلی هم نداشته. اگه سوالی داشتید در خدمتم.

[سيد مجتبي هاشمي]

هدف یادگیریه نه لاشخوری که!!


SKflower شما اگه کمی مودبانه تر صحبت کنید بهتره. حالا چه از کد نوشته شده شما استفاده کنن یا از یه کامپوننت آماده.

[skflower]

SKflower شما اگه کمی مودبانه تر صحبت کنید بهتره. حالا چه از کد نوشته شده شما استفاده کنن یا از یه کامپوننت آماده.

mojtaba_ha2007؛ از شما و همه ی اعضای محترم بابت این حرف معذرت میخوام. نمیخوام توجیه کنم. ولی هرچی میخوام تو این انجمن چیزی یاد بگیرم همش به کامپوننت و این جور چیزای آماده برخورد میکنم.
در کل ببخشید

[padesha]

سلام
من هم با ایشون موافقم اگه میشه به جا کامپوننت کد رو بنویسین چون این جوری سواد کد زنی میره بالا .
همین که با کد ها اشنا بسیم بهتره تا کامپوننت.
البته ببخشید که اینجور میگم آقای mojtaba_ha2007 ولی شما مودبانه تر رفتار کن .

[Alaleh]

این توابع برای تبدیل تاریخ عالیه من چند ساله دارم استفاده می کنم. اما متاسفانه نمی دونم ماله کیه!


procedure Julian2Persian(Y, M, D: Word; var FY, FM, FD: Word);
const
ShamsiDays : array[1..12] of Word = (31,31,31,31,31,31,30,30,30,30,30,29) ;
MiladiDays : array[1..12] of Word = (31,28,31,30,31,30,31,31,30,31,30,31) ;
var
R : Real ;
Kabiseh,Kably : Boolean ;
DaysSum,Days : Word ;
Sal,Mah,Rooz : Word ;
I : Integer ;

begin
DaysSum := 0 ;
if Y=0 then
Y:=2000
else if Y<1900 then
Y:=1900+Y;
R:=Abs(y-1996)/4 ;
Rooz:=0;
Mah:=0;
Days:=0;

if R = Trunc(R) then Kabiseh := True
else Kabiseh := False ;
R := Abs(y-1-1996) / 4 ;
if R = Trunc(R) then Kably := True
else Kably := False ;
if m > 1 then
begin
for I := m downto 2 do
DaysSum := DaysSum + MiladiDays[I-1] ;
DaysSum := DaysSum + d;
end
else
DaysSum := DaysSum + d ;
if kabiseh and (DaysSum>=59) then Inc(DaysSum);
if (Kabiseh and(DaysSum<80))
or(not Kabiseh and (DaysSum<79))
or(not Kabiseh and Kably and (DaysSum<80))
then
Sal := y - 622
else
Sal := y - 621 ;
if Kabiseh and (DaysSum>79) then days := DaysSum - 79 ;
if Kabiseh and (DaysSum<80) then Days := DaysSum + 286 ;
if not Kabiseh and not Kably and (DaysSum>79) then Days := DaysSum - 79 ;
if not Kabiseh and not Kably and (DaysSum<80) then Days := DaysSum + 286;
if not Kabiseh and Kably and (DaysSum>79) then Days := DaysSum - 79 ;
if not Kabiseh and Kably and (DaysSum<80) then Days := DaysSum + 287;
DaysSum := Days ;
if daysSum <=186 then
begin
Mah := (DaysSum div 31) + 1 ;
Rooz := DaysSum mod 31 ;
If Rooz=0 then Rooz := 31 ;
If Rooz=31then Mah := Mah-1 ;
end;
if DaysSum > 186 then
begin
DaysSum := DaysSum - 186 ;
if DaysSum mod 30 = 0 then
Mah := (DaysSum div 30) + 6
else
Mah := (DaysSum div 30) + 7 ;
Rooz := DaysSum mod 30 ;
If Rooz=0 then Rooz := 30 ;
end;
FY:=Sal;
FD:=Rooz;
FM:=Mah;
end;

function Latin2FarsiDate(Dt: string): string;
var
temp,S : string;
Y,M,D : Word;
begin
Julian2Persian(StrToInt(Copy(Dt,1,4)),StrToInt(Cop y(Dt,6,2)),StrToInt(Copy(Dt,9,2)),Y,M,D);
S:=IntToStr(Y);
Temp:=IntToStr(M); if Length(Temp)=1 then temp:='0'+Temp; S:=S+'/'+temp+'/';
Temp:=IntToStr(D); if Length(Temp)=1 then temp:='0'+Temp; S:=S+temp;
Result:=S;
end;

[BEHESHT*]

این روش ها مناسب نیستند بهتره خوده Tdate تبدیل بشه و من یه کد اومد دستم دقیق نبود خودم دقیقش کردم آخر سر شد همین تابع تو سال های کبیسه هم به هیچ مشکلی برخورد نمی کنه خیالتون راحت باشه می تونین امتحان کنید :


function GerToPersian(tt:tdatetime):String;
var
str,y,m,d:string;
yi,mi,di,ytmp:integer;
begin
str:=formatdatetime('yyyy,mm,dd',tt);
y:=copy(str,1,4);
m:=copy(str,6,2);
d:=copy(str,9,2);
yi:=strtoint(y);
mi:=strtoint(m);
di:=strtoint(d);
if (yi mod 4=0) then
if mi>2 then
begin
tt:=tt+1;
str:=formatdatetime('yyyy,mm,dd',tt);
y:=copy(str,1,4);
m:=copy(str,6,2);
d:=copy(str,9,2);
yi:=strtoint(y);
mi:=strtoint(m);
di:=strtoint(d);
end;
if ((mi<3) or ((mi=3) and (di<21))) then
begin
yi:=yi-622;
end
else
begin
yi:=yi-621;
end;
case mi of
1:

if di<21 then
begin
mi:=10;
di:=di+10;
end
else
begin
mi:=11;
di:=di-20;
end;

2:
if di<20 then
begin
mi:=11;
di:=di+11;
end
else
begin
mi:=12;
di:=di-19;
end;
3:
if di<21 then
begin
mi:=12;
di:=di+9;
end
else
begin
mi:=1;
di:=di-20;
end;
4:
if di<21 then
begin
mi:=1;
di:=di+11;
end
else
begin
mi:=2;
di:=di-20;
end;
5:
if di<22 then
begin
mi:=mi-3;
di:=di+10;
end
else
begin
mi:=mi-2;
di:=di-21;
end;
6:
if di<22 then
begin
mi:=mi-3;
di:=di+10;
end
else
begin
mi:=mi-2;
di:=di-21;
end;
7:
if di<23 then
begin
mi:=mi-3;
di:=di+9;
end
else
begin
mi:=mi-2;
di:=di-22;
end;
8:
if di<23 then
begin
mi:=mi-3;
di:=di+9;
end
else
begin
mi:=mi-2;
di:=di-22;
end;
9:
if di<23 then
begin
mi:=mi-3;
di:=di+9;
end
else
begin
mi:=mi-2;
di:=di-22;
end;
10:
if di<23 then
begin
mi:=7;
di:=di+8;
end
else
begin
mi:=8;
di:=di-22;
end;
11:
if di<22 then
begin
mi:=mi-3;
di:=di+9;
end
else
begin
mi:=mi-2;
di:=di-21;
end;
12:
if di<22 then
begin
mi:=mi-3;
di:=di+9;
end
else
begin
mi:=mi-2;
di:=di-21;
end;
end;
ytmp := yi - 1279 ;
ytmp := ytmp mod 4 ;
if (mi = 12) and (ytmp=0 )then
begin
Inc(di);
end;
y:=inttostr(yi);
m:=inttostr(mi);
if (length(m)=1) then
m:='0'+m;
d:=inttostr(di);
if length(d)=1 then
d:='0'+d;
Result :=y+'/'+m+'/'+d ;
end;



موفق باشید دوستان

[bootshow]

چون از توابع SysUtils مثل EncodeDate استفاده شده هر تاریخی را نمیتوان قرار داد.اگر تعریف ثابت زیر را در SysUtils ببینید متوجه میشید که ماه دوم حداکثر میتواند 29 روزه باشد.اگر dbisam فقط همین تعریف را عوض میکرد مشکل حل میشد.میتونید خودتون دوباره dbisam را کامپایل کنید، فکر نکنم مشکلی بوجود بیاد.
برای حل مشکل توابع فارسی را باید بصورت رشته ای در بانک ذخیره کنید.و برای کوئری از توابع میلادی استفاده کنید.فکر کنم این بهترین راه باشه یعنی در کل دو تا فیلو تاریخ میلادی از نوع date و تاریخ شمسی از نوع رشته ای بطول 10 در بانک تعریف کنید.
MonthDays: array [Boolean] of TDayTable =
((31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31),
(31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31));