كامپونت تقويم فارسي در دلفي 7

لطفا يك كامپونت براي نمايش تقويم فارسي همانند تقويم كامپونت دلفي 7 ولي شمسي بيان داريد
در صورت امكان ايميل بزنيد
تابع مبدل ميلادي به شمسي نه بلكه بصورت مدل كه داخل فرم قرار بدهم
مثلا در برنامه به صورت منو اپراتور بتواند مشخص كند كه چند ماه ديگه روز 16 چند شنبه مي باشد

سلام .سورسش هست ولی من کامپوننت براش ندیدم که رایگان باشه /فارسی هست یک پک کامل با datepicker که 7000 تومان هست

با تشكر
از كجا وبا چه نامي قابل تهيه ميباشد

سلام امیر جان عزیزم شما یک بار این سوال را مطرح کرده اید با دادن یک تایپک اضافه جواب بدست نمی آید که هیچ بلکه تایپک الکی درست می کنید
دوستانه گفتم ناراحت نشی
ممنون

ممنون از راهنمائيت
ولي من به جواب نرسيدم
ديگه در اين مورد سئوال نمي كنم

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

به من ایمیل بزنید تا براتون بفرستم.

با تشكر از دوستان
يک کامپونت دوستان ازسال کردندد و مشکل من بر طرف شد

اين يک تابع است
Function MiladyToShamsi(DTime:tdateTime):tdateTime;
var
YearEqual:array[0..2,0..2] of integer;
AddOneDay,AddFarDay:boolean;
AddTodays:byte;
Farday:byte;
ThisDay:word;
ThisMonth:word;
ThisYear:word;
YearDif1:Integer;
YearDif2:Integer;
TestRange1,testRange2,
FarsiRange1,FarsiRange2,P:Integer;
CurM,CurD:string;
sYear,sMonth,sDay:Variant;
Counter:Integer;
CurDay,CurMonth,CurYear:word;
Begin
CurM:='';
CurD:='';
YearEqual[1,1]:=1997;
YearEqual[1,2]:=1998;
YearEqual[2,1]:=1376;
YearEqual[2,2]:=1377;
DecodeDate(DTime,thisyear,thismonth,thisday);
YearDif1:=ThisYear-1997;
YearDif2:=ThisYear-1998;
Testrange1:=1996-(100*4);
Testrange2:=1996+(100*4);
FarsiRange1:=1375-(100*4);
FarsiRange2:=1375+(100*4);
AddOneDay:=false;
//Rem------------------------------
Counter:=TestRange1;
while TestRange2>=Counter do begin /////////////////////////
If thisYear=counter then begin
AddOneDay:=true;
break;
end;
If counter=TestRange2 then break;
counter:=counter+4
end;//while

If AddOneDay then
addtodays:=1
Else
AddTodays:=0;
//Rem---------------------------------/////////////////
If (((ThisMonth = 3) and (thisday<(20+AddtoDays)))
or ( ThisMonth<3)) then
YearDif1:=yearDif1-1;
//Rem------------
If (((thisYear mod 2)<>0) and
(((thismonth=3) and (thisday>(20-addTodays)))
or (thisMonth>4))) then
CurYear:=yearEqual[2,1]+YearDif1
else begin
CurYear:=YearEqual[2,1]+YearDif2;
Counter:=FarsiRange1;
while counter>FarsiRange2 do begin /////////////////////////
If CurYear=Counter then begin
AddFarDay:=true;
break;
end;
end;//while

If AddFarDay then
FarDay:=1 else Farday:=0;

If (((thismonth=3) and (thisday>20-(addToDays)+FarDay)) or (thismonth>3) ) then
CurYear:=CurYear+1;
end; //First If

If AddtoDays=1 then FarDay:=0;
//Rem---------------------------------
Case thismonth of
1:Begin
If thisday<(21-Farday) then begin
CurMonth:=10;
CurDay:=(ThisDay+10)+FarDay;
end else begin
CurMonth:=11;
CurDay:=(ThisDay-20)+FarDay;
end;
end;

2:Begin
If thisday<(20-Farday) then begin
CurMonth:=11;
CurDay:=(ThisDay+11)+FarDay;
end else begin
CurMonth:=12;
CurDay:=(ThisDay-19)+FarDay;
end;
End;

3:Begin
If thisday<(21-AddToDays) then begin
CurMonth:=12;
CurDay:=(ThisDay+9)+AddToDays+FarDay;
end else begin
CurMonth:=1;
CurDay:=(ThisDay-20)+AddToDays;
end;
End;

4:Begin
If thisday<(21-AddToDays) then begin
CurMonth:=1;
CurDay:=(ThisDay+11)+AddToDays;
end else begin
CurMonth:=2;
CurDay:=(ThisDay-20)+AddToDays;
end;
End;

5:Begin
If thisday<(22-AddToDays) then begin
CurMonth:=2;
CurDay:=(ThisDay+10)+AddToDays;
end else begin
CurMonth:=3;
CurDay:=(ThisDay-21)+AddToDays;
end;
End;

6:Begin
If thisday<(22-AddToDays) then begin
CurMonth:=3;
CurDay:=(ThisDay+10)+AddToDays;
end else begin
CurMonth:=4;
CurDay:=(ThisDay-21)+AddToDays;
end;
End;

7:Begin
If thisday<(23-AddToDays) then begin
CurMonth:=4;
CurDay:=(ThisDay+9)+AddToDays;
end else begin
CurMonth:=5;
CurDay:=(ThisDay-22)+AddToDays;
end;
End;

8:Begin
If thisday<(23-AddToDays) then begin
CurMonth:=5;
CurDay:=(ThisDay+9)+AddToDays;
end else begin
CurMonth:=6;
CurDay:=(ThisDay-22)+AddToDays;
end;
End;

9:Begin
If thisday<(23-AddToDays) then begin
CurMonth:=6;
CurDay:=(ThisDay+9)+AddToDays;
end else begin
CurMonth:=7;
CurDay:=(ThisDay-22)+AddToDays;
end;
End;

10:Begin
If thisday<(23-AddToDays) then begin
CurMonth:=7;
CurDay:=(ThisDay+8)+AddToDays;
end else begin
CurMonth:=8;
CurDay:=(ThisDay-22)+AddToDays;
end;
End;

11:Begin
If thisday<(22-AddToDays) then begin
CurMonth:=8;
CurDay:=(ThisDay+9)+AddToDays;
end else begin
CurMonth:=9;
CurDay:=(ThisDay-21)+AddToDays;
end;
End;

12:Begin
If thisday<(22-AddToDays) then begin
CurMonth:=9;
CurDay:=(ThisDay+9)+AddToDays;
end else begin
CurMonth:=10;
CurDay:=(ThisDay-21)+AddToDays;
end;
End;

end;//case
//Rem-----------------
CurM:=Trim(IntTostr(CurMonth));
CurD:=Trim(IntTostr(CurDay));
//Rem-----------------
If CurMonth<10 then
CurM:='0'+Trim(IntToStr(CurMonth));
If CurDay<10 then
CurD:='0'+Trim(IntTostr(CurDay));

Result:=EncodeDate(CurYear,CurMonth,CurDay);

end;
مثلا در فرم کريت بنويس:
label1.caption:=datetimetostr(MiladyToShamsi(date) );

موفق باشي
[ برای مشاهده لینک ، با نام کاربری خود وارد شوید یا ثبت نام کنید ]
مجتبي رضائي از برازجان

اقا اين كه ارور ميده؟

سلام

اقا تو رو خدا راهنمايي كنين

اين برنامه براي من تاريخ 1899 رو نشون ميده

تاريخ سيستم هم رو عوض ميكنم تغييري نميكنه

ممنون

آقايون و خانمها سلام
من يه مشكل خيلي حاد برام پيش اومده . براي يه برنامه نياز دارم كه تاريخ ميلادي رو به تاريخ هجري قمري تبديل كنم ولي چون تاريخ اين عربها حساب كتاب درستي نداره به مشكل بر ميخورم مثلا براي امسال جواب ميده ولي وقتي تو ماههاي بعدي تاريخ عربها رو دستكاري مي كنند ديگه جواب نمبده .اگه نظري داريد راهنمائيم بكنيد خيلي ممنون ميشم.

من تو وبلاگم يه تقويم فارسي خوشكل مثل مال خود دلفي گذاشتم ميتونيد ببينيد
در ضمن كامپو ننت هاي جالي ديگري هم براي دانلود گذاشتم حتماَ ببينيد
مثل كامپوننت
َAlarm
Analouge clock
و...
[ برای مشاهده لینک ، با نام کاربری خود وارد شوید یا ثبت نام کنید ]

آقا قادر دستت درد نكنه انصافا كامپوننتت حرف نداشت من كه خيلي حال كردم ولي اگه يه چيزي براي تبديل تاريخ شمسي يا ميلادي به قمري بدي كه ديگه مارو با اين اخلاق ورزشكاريت له و لورده مي كني
مرسي

بابا اين كه ارور ميده[quote]

سلام

اقا يكي ما رو براي اين مشكل راهنمايي كنه تو رو خدا


[ برای مشاهده لینک ، با نام کاربری خود وارد شوید یا ثبت نام کنید ]

[ برای مشاهده لینک ، با نام کاربری خود وارد شوید یا ثبت نام کنید ]

اقايون خيلي ضروريه منتظرم