نقل قول:
Private lgs()
Private lats()
Private Type Behzad
XX As Double
YY As Double
End Type
Const PI As Double = 3.14159265358979
Private Sub Init()
End Sub
Public Sub ProcessALL(m As Double, d As Double, lg As Double, lat As Double, AzanSOb As String, Toloe As String, AzanZohr As String, Ghoroob As String, Maghreb As String)
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
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)
AzanSOb = 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)
Toloe = hms(t2)
'
' zr=Zohr
'
ep = sun(m, d, 12, lg)
ep = sun(m, d, ep.XX, lg)
zr = ep.XX
AzanZohr = 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)
Ghoroob = 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)
Maghreb = hms(t4)
End Sub
Public Sub coord(citiIndex As Long, X As Double, Y As Double)
X = FrmMain.Combo1.List(citiIndex)
Y = FrmMain.Combo2.List(citiIndex)
End Sub
Private Sub Class_Initialize()
Call Init
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) * Sqr((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
hms = s
End Function
Private Function sind(X)
sind = Sin(PI / 180 * X)
End Function
Private Function cosd(X)
cosd = Cos(PI / 180 * X)
End Function
Private Function tand(X)
tand = Tan(PI / 180 * X)
End Function
Private Function atand(X)
atand = Atn(X) * 180 / PI
End Function
Private Function asind(X As Double)
asind = ASin(X) * 180 / PI
End Function
Private Function acosd(X As Double)
acosd = 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 = Atn(X / Sqr(-X * X + 1.01))
End Function
Private Function ACos(X As Double) As Double
ACos = Atn(-X / Sqr(-X * X + 1.01)) + 2 * Atn(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 = Atn(Y / X)
End If
Else
If Y = 0 Then
ATan2 = PI
Else
ATan2 = (PI - Atn(Abs(Y) / Abs(X))) * Sgn(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
