Jump to content
asdqweasd

التأكد من صحة النتائج

Recommended Posts

هل الأوقات صحيحة:

المنطقة: سوريا-ادلب

خطوط الطول :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+B)*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

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now

×