برنامه قمری ( ببخشید قبلی را چون حذف کرده بودم دوباره پرسیدم )

[nsco_nsco]

سلام دوستان
دیدم انگار دوستان اون یکی تاپینگ رو به خاطر نامش نگاه نمی کردن عوضش کردم که شاید یکی بیاد و یاریمون کنه .ببینید دوستان این یک برنامه آماده هست که البته می خواستیم در فایل اگزه نمایشش بدیم که ارور گرفته ممنون می شم اصلاش کنید با تشکر .



unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,StrUtils, ExtCtrls, ComCtrls, ShellAnimations, TabNotBk,
HTTPApp, ColorGrd, Keyboard, Math;

type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }


end;


var
Form1: TForm1;


implementation
{$R *.dfm}




procedure TForm1.Button1Click(Sender: TObject);
var
THijriDate : record ;

HijriDate: integer;
HijriMonth: integer;
HijriYear: integer;
JulianDate: integer;
HijriDay: string;
begin
function IntPart(Num : real) : integer;
function WeekDay(Wdn : integer) : string;
function Gre2Hijri(var D, M, Y : word): THijriDate;
function HijriMonths(Mth : integer) : string;
function IntPart(Num : real) : integer;
begin
if Num < -0.0000001 then
Result := Ceil(Num - 0.0000001)
else
Result := Floor(Num + 0.0000001);
end;

function WeekDay(Wdn : integer) : string;
begin
case Wdn of
0: Result := 'Al-Ithnayn';
1: Result := 'Ath-Thalatha';
2: Result := 'Al-Arba`a';
3: Result := 'Al-Khamis';
4: Result := 'Al-Jum`a';
5: Result := 'As-Sabt';
6: Result := 'Al-Ahad';
end;
end;

function Gre2Hijri(var D, M, Y : word): THijriDate;
var
jd, l, n, j : integer;
begin
if ((Y > 1582) or ((Y = 582) and (M > 10))
or ((Y = 1582) and (M = 10) and (D>14))) then
begin
jd := IntPart((1461 * (Y + 4800 +
IntPart((M - 14)/12)))/4) +
IntPart((367 * (M - 2 - 12 *
(IntPart((M - 14)/12))))/12) -
IntPart((3 * (IntPart((Y + 4900 +
IntPart((M - 14)/12))/100)))/4) + D - 32075;
end
else
begin
jd := 367 * Y - IntPart((7 * (Y + 5001 +
IntPart((M - 9)/7)))/4) + IntPart((275 * M)/9)
+ D + 1729777;
end;

l := jd -1948440 + 10632;
n := IntPart((l - 1)/10631);
l := l - 10631 * n + 354;

j := (IntPart((10985 - l)/5316)) *
(IntPart((50 * l)/17719)) + (IntPart(l/5670)) *
(IntPart((43 * l)/15238));

l := l - (IntPart((30 - j)/15)) *
(IntPart((17719 * j)/50)) - (IntPart(j/16)) *
(IntPart((15238 * j)/43)) + 29;

m := IntPart((24 * l)/709);
d := l - IntPart((709 * m)/24);
y := 30 * n + j - 30;

Result.HijriDate := d;
Result.HijriMonth := m;
Result.HijriYear := y;
Result.JulianDate := jd;
Result.HijriDay := WeekDay(jd mod 7);

end;

function HijriMonths(Mth : integer) : string;
begin
case Mth of
1: Result := 'Muharram';
2: Result := 'Safar';
3: Result := 'Rabi'' al-awwal';
4: Result := 'Rabi'' al-thani';
5: Result := 'Jumada al-awwal';
6: Result := 'Jumada al-thani';
7: Result := 'Rajab';
8: Result := 'Sha''ban';
9: Result := 'Ramadan';
10: Result := 'Shawwal';
11: Result := 'Dhu al-Qi''dah';
12: Result := 'Dhu al-Hijjah';
end;
end;
end;

end.



البته بگم اقا محسن گفته بودن var رو بردارم درست میشه اما باز ارور می داد ببینید مثالشون رو :



function Gre2Hijri(var D, M, Y : word): THijriDate;




procedure TForm1.Button1Click(Sender: TObject);
var hdate:Thijridate;
begin
hdate:=Gre2Hijri(14,1,2011);
edit1.Text:=inttostr(hdate.HijriDate)+' '+
inttostr(hdate.HijriMonth)+' '+
inttostr(hdate.HijriYear);
end;


لطفا حتما این برنامه رو نگاه کنید چون خیلی بدرد بخور هست و مورد استفاده خیلی ها هست بهتر اینه که اگر کسی ازتون پرسید بگید بلد نیستم مثلا شما برنامه نویس هستیدا

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


راستی لینک برنامه ای که برای این تقویم ساختم این هست می تونید دانلود (http://s1.picofile.com/file/6287559354/code.zip.html) کنید :

[ashoori]

وقتی در تعریف تابعی شما ورودی اون رو با var تعریف میکنی یعنی باید به اون یه متغییر پاس بدی نه یک عدد، بنابراین او varها رو حذف کن و از تابع موردنظر با پاس دادن اعداد مربوطه استفاده کن




function Gre2Hijri(var D, M, Y : word): THijriDate;

function Gre2Hijri(var D, M, Y : word): THijriDate;
var
jd, l, n, j : integer;
begin
if ((Y > 1582) or ((Y = 582) and (M > 10))

[nsco_nsco]

سلام دوستان
من این ارور ها رو حذف کردم و باز ارور میده البته پاس دادن رو متوجه نمی شم اگر ممکنه بیشتر توضیح بدید و اگر باز ممکنه برنامه رو اصلاح کنید و همین جا قرار بدید با تشکر فراوان:خجالت::تشویق:

[ashoori]

این کد که نوشتم برای من که کار می کنه!!!


unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,StrUtils, ExtCtrls, ComCtrls, TabNotBk,
HTTPApp, ColorGrd, Math;

type
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
procedure Button1Click(Sender: TObject);

private
{ Private declarations }
public
{ Public declarations }
end;

type
THijriDate = record
HijriDate: integer;
HijriMonth: integer;
HijriYear: integer;
JulianDate: integer;
HijriDay: string;
end;

function IntPart(Num : real) : integer;
function WeekDay(Wdn : integer) : string;
function Gre2Hijri( D, M, Y : word): THijriDate;
function HijriMonths(Mth : integer) : string;

var
Form1: TForm1;


implementation
{$R *.dfm}

function IntPart(Num : real) : integer;
begin
if Num < -0.0000001 then
Result := Ceil(Num - 0.0000001)
else
Result := Floor(Num + 0.0000001);
end;

function WeekDay(Wdn : integer) : string;
begin
case Wdn of
0: Result := 'Al-Ithnayn';
1: Result := 'Ath-Thalatha';
2: Result := 'Al-Arba`a';
3: Result := 'Al-Khamis';
4: Result := 'Al-Jum`a';
5: Result := 'As-Sabt';
6: Result := 'Al-Ahad';
end;
end;

function Gre2Hijri( D, M, Y : word): THijriDate;
var
jd, l, n, j : integer;
begin
if ((Y > 1582) or ((Y = 582) and (M > 10))
or ((Y = 1582) and (M = 10) and (D>14))) then
begin
jd := IntPart((1461 * (Y + 4800 +
IntPart((M - 14)/12)))/4) +
IntPart((367 * (M - 2 - 12 *
(IntPart((M - 14)/12))))/12) -
IntPart((3 * (IntPart((Y + 4900 +
IntPart((M - 14)/12))/100)))/4) + D - 32075;
end
else
begin
jd := 367 * Y - IntPart((7 * (Y + 5001 +
IntPart((M - 9)/7)))/4) + IntPart((275 * M)/9)
+ D + 1729777;
end;

l := jd -1948440 + 10632;
n := IntPart((l - 1)/10631);
l := l - 10631 * n + 354;

j := (IntPart((10985 - l)/5316)) *
(IntPart((50 * l)/17719)) + (IntPart(l/5670)) *
(IntPart((43 * l)/15238));

l := l - (IntPart((30 - j)/15)) *
(IntPart((17719 * j)/50)) - (IntPart(j/16)) *
(IntPart((15238 * j)/43)) + 29;

m := IntPart((24 * l)/709);
d := l - IntPart((709 * m)/24);
y := 30 * n + j - 30;

Result.HijriDate := d;
Result.HijriMonth := m;
Result.HijriYear := y;
Result.JulianDate := jd;
Result.HijriDay := WeekDay(jd mod 7);
end;

function HijriMonths(Mth : integer) : string;
begin
case Mth of
1: Result := 'Muharram';
2: Result := 'Safar';
3: Result := 'Rabi'' al-awwal';
4: Result := 'Rabi'' al-thani';
5: Result := 'Jumada al-awwal';
6: Result := 'Jumada al-thani';
7: Result := 'Rajab';
8: Result := 'Sha''ban';
9: Result := 'Ramadan';
10: Result := 'Shawwal';
11: Result := 'Dhu al-Qi''dah';
12: Result := 'Dhu al-Hijjah';
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var hdate:Thijridate;
begin
hdate:=Gre2Hijri(14,1,2011);
edit1.Text:=inttostr(hdate.HijriDate)+' '+
inttostr(hdate.HijriMonth)+' '+
inttostr(hdate.HijriYear);
end;
end.

[nsco_nsco]

سلام دوستان
ممنون دوست من که سریع جواب می دی اگر ممکنه ای دی یاهوت رو بده
در ضمن من این رو فایل اگزه هر کاری خواستم بکنم ارور داد اگر ممکنه فایل پیوست رو دانلود کن و ببین با تشکر :خجالت:

[nsco_nsco]

باز سلام
دوست من با فایل که دادید درست شد میشه بگید مشکلش کجا بود و یک چیز دیگر سال و ماه رو به خوبی نمایش میده اما رو ز رو اشتباه نشان میدهد با 7 یا 8 روز اختلاف می شه درستش کنید با تشکر :قلب::لبخندساده:

[ashoori]

چه خطایی میگیره!؟

[nsco_nsco]

سلام
ببینید این تاریخی که می دهد 8 ماه 2 نمایش می دهد در صورتی که العان 15 ماه 2 هست اگر ممکنه این مشکل را حل کنید و در ضمن اگر ممکنه از این کد کلید توضیح بدید با تشکر ویژه:


procedure TForm1.Button1Click(Sender: TObject);
var hdate:Thijridate;
begin
hdate:=Gre2Hijri(14,1,2011);
edit1.Text:=inttostr(hdate.HijriDate)+' '+
inttostr(hdate.HijriMonth)+' '+
inttostr(hdate.HijriYear);
end;




:تشویق::چشمک:

[ashoori]

شما تاریخ 2011-1-20 رو اگه درست به تابع مربوطه بدید اون هم جواب درست بهتون میده اختلافش هم با تقویم ما یک روز هست ولی با کشورهای عربی همسانه!

[nsco_nsco]

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

راستی به خاطر یک روز اخطلافش اگر بخوام در تقویم فارسی نمایش بدهم باید یک روز اضافه کنم ؟
اگر این چنین هست ممنون می شم بگید دستورش چی هست با تشکر :قلب:

[ashoori]

با این حساب بفرمایید اصلا دلفی کار نکردید!!!:متفکر:

[nsco_nsco]

سلام
چرا کار کردم اما چند مشکل داشتم که حل شد اما یک مشکل دارم اگر ممکنه پاسخ دهید ای دی شما اگر ممکنه بدید


label1.caption :=DateToStr(Now );

این دستور نمایش تاریخ سیستم که میلادی هست می باشد چطور می تونم این رو برابر این دستور کنم :


hdate:=Gre2Hijri(20,1,2011);


و اگر ممکنه بگید تنها بگید چطوری یکی به تاریخ اضاه کنم ممنون . و با تشکر بسیار :قلب:

[ashoori]

اول باید یونیت DateUtils را در uses برنامه اضافه کنید
برای بدست آوردن روز dayof(now);
برای بدست آوردن ماه MonthOf(now);
و برای بدست آوردن سال yearof(now);
استفاده کن..

[ashoori]

hdate:=Gre2Hijri(dayof(now),MonthOf(now),yearof(no w));

[ashoori]

یک روز به تاریخ امروز اضافه میکنه:


var today:TDateTime;
begin
today:=incday(now,1);
hdate:=Gre2Hijri(dayof(today),MonthOf(today),yearo f(today));

[nsco_nsco]

ببخشیدباز در این تاپینگ سوال می پرسم

دوست عزیزم ashoori این برنامه تصحیح شدش رو بهم داد ولی نمی دونم چطوری اون رو در یک فایل دی ال ال به کار ببرم و از این خروجی بگیرم فایل اگزش رو دوباره قرار می دم ممنون میشم تصحیش کنید تا بتونم از فانکشنش استفاده کنم می خوام Result کنم ممنون .



unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,StrUtils, ExtCtrls, ComCtrls, TabNotBk,
HTTPApp, ColorGrd,DateUtils, Math;

type
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
Edit2: TEdit;
Label1: TLabel;
procedure Button1Click(Sender: TObject);

private
{ Private declarations }
public
{ Public declarations }
end;

type
THijriDate = record
HijriDate: integer;
HijriMonth: integer;
HijriYear: integer;
JulianDate: integer;
HijriDay: string;
end;

function IntPart(Num : real) : integer;
//function WeekDay(Wdn : integer) : string;
function Gre2Hijri( D, M, Y : word): THijriDate;


var
Form1: TForm1;


implementation
{$R *.dfm}

function IntPart(Num : real) : integer;
begin
if Num < -0.0000001 then
Result := Ceil(Num - 0.0000001)
else
Result := Floor(Num + 0.0000001);
end;



function Gre2Hijri( D, M, Y : word): THijriDate;
var
jd, l, n, j : integer;
begin
if ((Y > 1582) or ((Y = 582) and (M > 10))
or ((Y = 1582) and (M = 10) and (D>14))) then
begin
jd := IntPart((1461 * (Y + 4800 +
IntPart((M - 14)/12)))/4) +
IntPart((367 * (M - 2 - 12 *
(IntPart((M - 14)/12))))/12) -
IntPart((3 * (IntPart((Y + 4900 +
IntPart((M - 14)/12))/100)))/4) + D - 32075;
end
else
begin
jd := 367 * Y - IntPart((7 * (Y + 5001 +
IntPart((M - 9)/7)))/4) + IntPart((275 * M)/9)
+ D + 1729777;
end;

l := jd -1948440 + 10632;
n := IntPart((l - 1)/10631);
l := l - 10631 * n + 354;

j := (IntPart((10985 - l)/5316)) *
(IntPart((50 * l)/17719)) + (IntPart(l/5670)) *
(IntPart((43 * l)/15238));

l := l - (IntPart((30 - j)/15)) *
(IntPart((17719 * j)/50)) - (IntPart(j/16)) *
(IntPart((15238 * j)/43)) + 29;

m := IntPart((24 * l)/709);
d := l - IntPart((709 * m)/24);
y := 30 * n + j - 30;

Result.HijriDate := d;
Result.HijriMonth := m;
Result.HijriYear := y;
Result.JulianDate := jd;
//Result.HijriDay := WeekDay(jd mod 7);
end;



procedure TForm1.Button1Click(Sender: TObject);
var
s1:string;
hdate:Thijridate;
begin
label1.caption :=DateToStr(Now );
//hdate:=Gre2Hijri(20,1,2011);
hdate:=Gre2Hijri(dayof(now),MonthOf(now),yearof(no w));

edit1.Text:=inttostr(hdate.HijriDate)+' '+

inttostr(hdate.HijriMonth)+' '+
inttostr(hdate.HijriYear);

end;
end.





با تشکر از همه دوستان :قلب: