asdqweasd 0 Report post Posted June 3, 2009 هل الأوقات صحيحة: المنطقة: سوريا-ادلب خطوط الطول :35.93 خطوط العرض:36.59 فارق التوقيت الزمني:3 التاريخ:3/6/2009 حسب رابطة العالم الإسلامي ------------------------------------ القجر:03:29:59 ص الشروق: 05:18:44 ص الظهر: 12:34:22 م العصر: 04:25:07 م المغرب: 07:50:00 م العشاء: 09:31:27 م -------------------------------------------- الكود بلغة الدلفي: unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ComCtrls; type TForm1 = class(TForm) Button1: TButton; DateTimePicker1: TDateTimePicker; DateTimePicker2: TDateTimePicker; Label1: TLabel; Label2: TLabel; Label3: TLabel; Label4: TLabel; Label5: TLabel; Label6: TLabel; procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} type TPray = Record Zuhr, Asr, Shrouk, Maghrib, Isha, Fajr: TDateTime; end; {-------------------------------------------------------------------------------} Function P(X: Extended; I: Integer): Extended; var Y :Integer; Begin Y := Abs(I); Result := 1.0; While Y > 0 do Begin While not Odd(Y) Do Begin Y := Y shr 1; X := X * X end; Dec(Y); Result := Result * X End; If I < 0 then Result := 1.0 / Result; P := Result; End; {--------------------------------} Function mySin(Num:Double):Double; Begin mySin := Sin(Num * (PI /180)); End; {--------------------------------} Function myCos(Num:Double):Double; Begin myCos := Cos(Num * (PI /180)); End; {--------------------------------} Function myTan(Num:Double):Double; Begin myTan := 0; If myCos(Num)<>0 Then myTan := mySin(Num)/myCos(Num); End; {--------------------------------} Function myMod(Num,Divisor:Double):Double; Function Int(R:Double):LongInt; Begin IF R < 0 Then R := R - 1; Int := Trunc ®; End; Begin If Divisor<>0 Then myMod := Num-Divisor*Int(Num/Divisor) Else myMod := Num; End; {-------------------------------------------------------------------------------} Function myArcTan(Num:Double; Quarter:Byte):Double; Var A:Double; Begin A := ArcTan(Num) * (180/PI); If Quarter<>0 Then If myMod(A,90)<>0 Then A := myMod(A,90) + 90* (Quarter-1) Else A := myMod(A,90) + 90* (Quarter ); myArcTan := A; End; {-------------------------------------------------------------------------------} Function myArcSin(Num:Double):Double; Var A:Double; Begin If Abs(Num)<>1 Then A := myArcTan(Num / sqrt(Abs(1-P(Num,2))),0) Else A := 0; myArcSin := A; End; {-------------------------------------------------------------------------------} Function myArcCos(Num:Double):Double; Begin If Abs(Num)>1 Then Begin myArcCos:=Num; Exit; End; If Num=-1 Then myArcCos := 4*myArcTan(1,0) Else If Num= 0 Then myArcCos := 2*myArcTan(1,0) Else If Num= 1 Then myArcCos := 0 Else myArcCos := myArcTan(-Num/ Sqrt(-Num*Num+1),0) +2*myArcTan(1,0); End; {-------------------------------------------------------------------------------} Function GetQuarter(Lng:Double):Byte; Begin Lng := myMod(Lng,360); if Lng<= 90 Then GetQuarter := 1 Else if Lng<=180 Then GetQuarter := 2 Else if Lng<=270 Then GetQuarter := 3 Else GetQuarter := 4; End; {-------------------------------------------------------------------------------} function CalcPray(Lon, Lat, Zone:Real; PrayDate:TDateTime; CalcWay, AsrType:Byte): TPray; Var D, L, M, Lambda, Obliquity, Alpha, ST, Dec, Noon, UTNoon, LocalNoon, AsrAlt, AsrArc, AsrTime, DurinalArc, SunRise, SunSet, IshaArc, IshaTime, FajrArc, FajrTime, CalcWayFajr, CalcWayIsha: Real; Year, Month, Day: Word; a,b,c,e:Real; Qrt:Byte; Begin //0 Univ. Of Islamic Scinces, Karachi //1 Islamic Society Of North America //2 Muslim World League //3 Umm Al-Qura University //4 Egytion General Authority of Survey CalcWayFajr:=-19.5; CalcWayIsha:=-17.5; Case CalcWay Of 0: Begin CalcWayFajr:=-18; CalcWayIsha:=-18 End; 1: Begin CalcWayFajr:=-15; CalcWayIsha:=-15 End; 2: Begin CalcWayFajr:=-18; CalcWayIsha:=-17 End; 3: Begin CalcWayFajr:=-19; CalcWayIsha:=-18 End; 4: Begin CalcWayFajr:=-19.5; CalcWayIsha:=-17.5 End; End; DecodeDate(PrayDate, Year, Month, Day); {--------------------------------} a := Trunc(Year)*367; b := Int((Month+9)/12); c := (Year+*7; d := Int(c/4); e := Int(Month/9*275); D := a-d+e+Day-730531.5; L := myMod(280.461+0.9856474*D,360); M := myMod(357.528+0.9856003*D,360); {--------------------------------} Lambda := L +1.915*mySIN(M)+0.02*mySIN(2*M); Obliquity := 23.439-0.0000004*D; Qrt := GetQuarter(Lambda); Alpha := myArcTan(myCos(Obliquity)*myTan(Lambda),Qrt); ST := MyMod(100.46 + 0.985647352 *D,360); Dec := myArcSin(mySin(Obliquity)*mySin(Lambda)); {--------------------------------} Noon := myMod(Alpha - ST,360); UTNoon := Noon - Lon; LocalNoon := myMod((UTNoon/15) + Zone,24); {--------------------------------} {//Shafi AsrType 0 Or /Hanafi AsrType 1} AsrAlt := 90-myArcTan((AsrType+1)+myTan(Abs(Lat-Dec)),0); AsrArc := myArcCos((mySin(AsrAlt)-mySin(Dec)*mySin(Lat)) /(myCos(Dec)*myCos(Lat))); AsrTime := LocalNoon + AsrArc/15; {--------------------------------} DurinalArc := myArcCos((mySin(-0.8333) - mySin(Dec)*mySin(Lat)) /(myCos(Dec)*myCos(Lat))); SunRise := LocalNoon - (DurinalArc/15); SunSet := LocalNoon + (DurinalArc/15); {--------------------------------} IshaArc := myArcCos((mySin(CalcWayIsha) -mySin(Dec)*mySin(Lat)) /(myCos(Dec)*myCos(Lat))); IshaTime := LocalNoon +(IshaArc /15); {--------------------------------} FajrArc := myArcCos((mySin(CalcWayFajr) -mySin(Dec)*mySin(Lat)) /(myCos(Dec)*myCos(Lat))); FajrTime := LocalNoon -(FajrArc /15); With Result Do Begin Fajr := Frac(FajrTime/24); Shrouk := Frac(SunRise/24); Zuhr := Frac(LocalNoon/24); Asr := Frac(AsrTime/24); Maghrib := Frac(SunSet/24); Isha := Frac(IshaTime/24); End; End; {--------------------------------} Share this post Link to post Share on other sites