سلام
آقا من بعد از کلی جستجو تو اینترنت وقتی که دیگه کلا نا امید بودم این کد رو برای محاسبه اوقات شرعی به زبان ویبی پیدا کردم و با یکم دستکاری برای دات نت قابل استفاده،
اما مشکل اینجاست که این کد نسبت به سایت www.Owghat.com در بعضی موارد 1 تا 2 دقیقه اختلاف داره که البته زیاد مهم نیست ولی اگر حل بشه خیلی بهتره
و مشکل دوم اینه که
اذان صبح: دارد
طلوع خورشید: دارد
اذان ظهر: دارد
اذان عصر: ندارد
غروب خورشید: دارد
اذان مغرب: دارد
نیمه شب شرعی: ندارد
اینا رو چی کار کنم؟
کلی تو همین فروم گشتم ولی یا چیز به درد بخوری نبود یا همه لینک ها خراب شده بود
من هم نمیتونم محاسبه کنم و خودم برای الگوریتم بنویسم
دیگه اگر لطف کنید ممنون میشم
یا حق
-------
کد:
Module Owghat
Private lgs() = {0, 49.7, 48.3, 45.07, 51.64, 48.68, 46.42, 57.33, 56.29, 50.84, 59.21, 46.28, 51.41, 48.34, 49.59, 60.86, 48.5, 53.06, 53.39, 47, 50.86, 52.52, 50, 50.88, 57.06, 47.09, 54.44, 59.58, 48.52, 51.59, 54.35}
Private lats() = {0, 34.09, 38.25, 37.55, 32.68, 31.32, 33.64, 37.47, 27.19, 28.97, 32.86, 38.08, 35.7, 33.46, 37.28, 29.5, 36.68, 36.57, 35.58, 35.31, 32.33, 29.62, 36.28, 34.64, 30.29, 34.34, 36.84, 36.31, 34.8, 30.67, 31.89}
Private Structure Behzad
Dim XX As Double
Dim YY As Double
End Structure
Structure TimeFormat
Dim Hour_ As Double
Dim Minute_ As Double
End Structure
Structure RetTimeStr
Dim Azan_Hobh As [String]
Dim Tolooe_Khorshid As [String]
Dim Azane_Zohr As [String]
Dim Ghoroobe_Khoeshid As [String]
Dim Azan_Maghreb As [String]
End Structure
Structure RetTime
Dim Azan_Hobh As TimeFormat
Dim Tolooe_Khorshid As TimeFormat
Dim Azane_Zohr As TimeFormat
Dim Ghoroobe_Khoeshid As TimeFormat
Dim Azan_Maghreb As TimeFormat
Dim StringVersion As RetTimeStr
End Structure
Const PI As Double = 3.14159265358979
Function ProcessALL(m As Double, d As Double, lg As Double, lat As Double) As RetTime
'Latitude, Longitude
Dim ep As Behzad, zr As Double, delta As Double, ha As Double
Dim t1 As Double, t2 As Double, t3 As Double, t4 As Double
Dim Result As RetTime
m = m + 1
d = d + 1
ep = sun(m, d, 4, lg)
zr = ep.XX
delta = ep.YY
ha = loc2hor(108, delta, lat)
t1 = rRound(zr - ha, 24)
ep = sun(m, d, t1, lg)
zr = ep.XX
delta = ep.YY
ha = loc2hor(108, delta, lat)
t1 = rRound(zr - ha, 24)
Result.Azan_Hobh = hms2(t1)
Result.StringVersion.Azan_Hobh = hms(t1)
'
' t2= Sun rise
'
ep = sun(m, d, 6, lg)
zr = ep.XX
delta = ep.YY
ha = loc2hor(90.833, delta, lat)
t2 = rRound(zr - ha, 24)
ep = sun(m, d, t2, lg)
zr = ep.XX
delta = ep.YY
ha = loc2hor(90.833, delta, lat)
t2 = rRound(zr - ha, 24)
Result.Tolooe_Khorshid = hms2(t2)
Result.StringVersion.Tolooe_Khorshid = hms(t2)
'
' zr=Zohr
'
ep = sun(m, d, 12, lg)
ep = sun(m, d, ep.XX, lg)
zr = ep.XX
Result.Azane_Zohr = hms2(zr)
Result.StringVersion.Azane_Zohr = hms(zr)
'
' t2= Sun set
'
ep = sun(m, d, 18, lg)
zr = ep.XX
delta = ep.YY
ha = loc2hor(90.833, delta, lat)
t3 = rRound(zr + ha, 24)
ep = sun(m, d, t3, lg)
zr = ep.XX
delta = ep.YY
ha = loc2hor(90.833, delta, lat)
t3 = rRound(zr + ha, 24)
Result.Ghoroobe_Khoeshid = hms2(t3)
Result.StringVersion.Ghoroobe_Khoeshid = hms(t3)
'
' t2= Maghreb
'
ep = sun(m, d, 18.5, lg)
zr = ep.XX
delta = ep.YY
ha = loc2hor(94.3, delta, lat)
t4 = rRound(zr + ha, 24)
ep = sun(m, d, t4, lg)
zr = ep.XX
delta = ep.YY
ha = loc2hor(94.3, delta, lat)
t4 = rRound(zr + ha, 24)
Result.Azan_Maghreb = hms2(t4)
Result.StringVersion.Azan_Maghreb = hms(t4)
Return Result
End Function
Public Sub coord(citiIndex As Long, X As Double, Y As Double)
If citiIndex = 0 Then
X = 0
Y = 0
Else
X = lgs(citiIndex)
Y = lats(citiIndex)
End If
End Sub
Private Function sun(m As Double, ByVal d As Double, h As Double, lg As Double) As Behzad
Dim mm As Double, l As Double, lst As Double, e As Double, omega As Double, ep As Double, ed As Double, u As Double
Dim v As Double, theta As Double, delta As Double, alpha As Double, ha As Double, zr As Double
Dim i As Long
If m < 7 Then
d = 31 * (m - 1) + d + h / 24
Else
d = 6 + 30 * (m - 1) + d + h / 24
End If
mm = 74.2023 + 0.98560026 * d
l = -2.75043 + 0.98564735 * d
lst = 8.3162159 + 0.065709824 * Floor(d) + 1.00273791 * 24 * mod2(d, 1) + lg / 15
e = 0.0167065
omega = 4.85131 - 0.052954 * d
ep = 23.4384717 + 0.00256 * cosd(omega)
ed = 180 / PI * e
u = mm
For i = 1 To 4
u = u - (u - ed * sind(u) - mm) / (1 - e * cosd(u))
Next
v = 2 * atand(tand(u / 2) * Math.Sqrt((1 + e) / (1 - e)))
theta = l + v - mm - 0.00569 - 0.00479 * sind(omega)
delta = asind(sind(ep) * sind(theta))
'
alpha = 180 / PI * ATan2(cosd(theta), cosd(ep) * sind(theta))
'
If alpha >= 360 Then alpha = alpha - 360
ha = lst - alpha / 15
zr = rRound(h - ha, 24)
sun.XX = zr
sun.YY = delta
End Function
Private Function loc2hor(z As Double, d As Double, p As Double)
loc2hor = acosd((cosd(z) - sind(d) * sind(p)) / cosd(d) / cosd(p)) / 15
End Function
Private Function rRound(X As Double, a As Double)
Dim tmp As Double
tmp = mod2(X, a)
If tmp < 0 Then tmp = tmp + a
rRound = tmp
End Function
Private Function hms(X As Double) As String
Dim h As Double, mp As Double, m As Double, ss As Double
Dim s As String
X = Floor(3600 * X)
h = Floor(X / 3600)
mp = X - 3600 * h
m = Floor(mp / 60)
ss = Floor(mp - 60 * m)
If h < 10 Then s = "0" Else s = ""
s = s & h & ":"
If m < 10 Then s = s & "0"
s = s & m & ":"
If ss < 10 Then s = s & "0"
s = s & ss
Return s
End Function
Private Function hms2(X As Double) As TimeFormat
Dim h As Double, mp As Double, m As Double, ss As Double
Dim s As String, Result As TimeFormat
X = Floor(3600 * X)
h = Floor(X / 3600)
mp = X - 3600 * h
m = Floor(mp / 60)
ss = Floor(mp - 60 * m)
Result.Hour_ = h
Result.Minute_ = m
Return Result
End Function
Private Function sind(X)
sind = Math.Sin(PI / 180 * X)
End Function
Private Function cosd(X)
cosd = Math.Cos(PI / 180 * X)
End Function
Private Function tand(X)
tand = Math.Tan(PI / 180 * X)
End Function
Private Function atand(X)
atand = Math.Atan(X) * 180 / PI
End Function
Private Function asind(X As Double)
asind = Math.Asin(X) * 180 / PI
End Function
Private Function acosd(X As Double)
acosd = Math.Acos(X) * 180 / PI
End Function
Private Function Floor(X As Double) As Long
Floor = Int(X)
End Function
Private Function ASin(X As Double) As Double
ASin = Math.Atan(X / Math.Sqrt(-X * X + 1.01))
End Function
Private Function ACos(X As Double) As Double
ACos = Math.Atan(-X / Math.Sqrt(-X * X + 1.01)) + 2 * Math.Atan(1)
End Function
Private Function ATan2(ByVal X As Double, ByVal Y As Double) As Double
On Error Resume Next
If X = 0 Then
If Y = 0 Then
ATan2 = 1 / 0
ElseIf Y > 0 Then
ATan2 = PI / 2
Else
ATan2 = -PI / 2
End If
ElseIf X > 0 Then
If Y = 0 Then
ATan2 = 0
Else
ATan2 = Math.Atan(Y / X)
End If
Else
If Y = 0 Then
ATan2 = PI
Else
ATan2 = (PI - Math.Atan(Math.Abs(Y) / Math.Abs(X))) * Math.Sign(Y)
End If
End If
End Function
Private Function mod2(a As Double, b As Double) As Double
mod2 = a - (b * Int(a / b))
End Function
End Module
پاسخ با نقل قول
. چون یک زمانی خیلی دنبال پیدا کردن این موضوع بودم یک مقدار اطلاعات دارم گفتم در اختیار بگذارم. سوالی بود در خدمتیم.
نوشته شده توسط zahedi121
