KP ephemeris Program
=====================
*****************************************************
တြက္ခ်က္မယ္
**************************************************
Private Sub showEph()
'-----------------------------------------------------------------
Dim isTruEph As Boolean
Dim geoTrue() As String
geoTrue() = hp_ReadDatFile(App.Path + "\Sett\geotrue.dat", "_")
isTruEph = CBool(geoTrue(1))
'-----------------------------------------------------------------
Dim dayS As Integer
Dim monthS As Integer
Dim yearS As Integer
dayS = CInt(cmbDayS.Text)
monthS = CInt(cmbMonthS.Text)
yearS = CInt(cmbYearS.Text)
' Dim gmtDiff As Double 'GMT differance as double value
' gmtDiff = CDbl(cmbTzHH.Text) + (CDbl(cmbTzMM.Text) / 60#)
' If cmbTzPM.Text = "-" Then gmtDiff = gmtDiff * (-1#)
Dim julDateGMT As Double 'Raw julian day according to the birth data (first day of month)
julDateGMT = swe_julday(yearS, monthS, dayS, 0#, 1)
' Dim julDateUT As Double 'Corrected julian date
' julDateUT = julDateGMT - (gmtDiff / 24#)
'-----------------------------------------------------------------
Dim dayE As Integer
Dim monthE As Integer
Dim yearE As Integer
dayE = CInt(cmbDayE.Text)
monthE = CInt(cmbMonthE.Text)
yearE = CInt(cmbYearE.Text)
Dim julDateGMTend As Double 'Raw julian day according to the birth data (first day of month)
julDateGMTend = swe_julday(yearE, monthE, dayE, 0#, 1)
' Dim julDateUTend As Double 'Corrected julian date
' julDateUTend = julDateGMTend - (gmtDiff / 24#)
'--------------------
RTEph.SelIndent = 100
RTEph.Text = vbNullString
'--------------------
' NEW KP AYANAMSA
Dim newKPAyanEph As Double
newKPAyanEph = kp_NKPA(julDateGMT)
'--------------------
RTEph.SelText = vbNewLine
RTEph.SelText = "KP New Astro - Nirayana Planetary Positions" + vbNewLine
RTEph.SelText = vbNewLine
RTEph.SelText = "From : " + cmbDayS.Text + " / " + cmbMonthS.Text + " / " + cmbYearS.Text + " To : " + cmbDayE.Text + " / " + cmbMonthE.Text + " / " + cmbYearE.Text + " At 00:00 H GMT or 5:30 H Indian Standard Time" + vbNewLine
RTEph.SelText = vbNewLine
RTEph.SelText = "New KP Ayanamsha : " + hp_FormalDegSh(newKPAyanEph) + " ( " + cmbDayS.Text + " / " + cmbMonthS.Text + " / " + cmbYearS.Text + " )" + vbNewLine
RTEph.SelText = vbNewLine
RTEph.SelText = "Date" + Space(16) + pNameEph(0) + Space(15) + pNameEph(1) + Space(14) + pNameEph(2) + Space(15) + pNameEph(3) + Space(14) + pNameEph(4) + Space(15) + pNameEph(5) + Space(15) + pNameEph(6) + Space(15) + pNameEph(7) + Space(15) + pNameEph(9) + Space(15) + pNameEph(10) + vbNewLine
RTEph.SelText = String(171, "-") + vbNewLine
'--------------------
Dim curDate As String
'Dim sidTime As Double
'Planetary Position
Dim pPos_(11) As Double
Dim isRe_(11) As Double
Dim pReVal As Long
Dim pDetails(5) As Double
Dim errReturn As String
If (julDateGMTend - julDateGMT > 731) Then
MsgBox "Maximum difference must be less than 730 days.", vbCritical, "Too Long"
Exit Sub
End If
While (julDateGMT <= julDateGMTend + 0.01)
newKPAyanEph = kp_NKPA(julDateGMT)
'Sun (Ravi) 0
pReVal = swe_calc_ut(julDateGMT, 0, 256, pDetails(0), errReturn)
pPos_(0) = hp_Rnd0To360v(pDetails(0) - newKPAyanEph) 'NKPA** Correction
isRe_(0) = pDetails(3)
'Moon (Chandra) 1
pReVal = swe_calc_ut(julDateGMT, 1, 256, pDetails(0), errReturn)
pPos_(1) = hp_Rnd0To360v(pDetails(0) - newKPAyanEph) 'NKPA** Correction
isRe_(1) = pDetails(3)
'Mars (Kuja) 2
pReVal = swe_calc_ut(julDateGMT, 4, 256, pDetails(0), errReturn)
pPos_(2) = hp_Rnd0To360v(pDetails(0) - newKPAyanEph) 'NKPA** Correction
isRe_(2) = pDetails(3)
'Mercury (Budha) 3
pReVal = swe_calc_ut(julDateGMT, 2, 256, pDetails(0), errReturn)
pPos_(3) = hp_Rnd0To360v(pDetails(0) - newKPAyanEph) 'NKPA** Correction
isRe_(3) = pDetails(3)
'Jupiter (Guru) 4
pReVal = swe_calc_ut(julDateGMT, 5, 256, pDetails(0), errReturn)
pPos_(4) = hp_Rnd0To360v(pDetails(0) - newKPAyanEph) 'NKPA** Correction
isRe_(4) = pDetails(3)
'Venus (Sukra) 5
pReVal = swe_calc_ut(julDateGMT, 3, 256, pDetails(0), errReturn)
pPos_(5) = hp_Rnd0To360v(pDetails(0) - newKPAyanEph) 'NKPA** Correction
isRe_(5) = pDetails(3)
'Saturn (Sani) 6
pReVal = swe_calc_ut(julDateGMT, 6, 256, pDetails(0), errReturn)
pPos_(6) = hp_Rnd0To360v(pDetails(0) - newKPAyanEph) 'NKPA** Correction
isRe_(6) = pDetails(3)
'Asc.Node (Rahu) 7
If isTruEph = False Then 'Mean Node
pReVal = swe_calc_ut(julDateGMT, 10, 256, pDetails(0), errReturn)
pPos_(7) = hp_Rnd0To360v(pDetails(0) - newKPAyanEph) 'NKPA** Correction
isRe_(7) = pDetails(3) * (-1)
Else 'True Node
pReVal = swe_calc_ut(julDateGMT, 11, 256, pDetails(0), errReturn)
pPos_(7) = hp_Rnd0To360v(pDetails(0) - newKPAyanEph) 'NKPA** Correction
isRe_(7) = pDetails(3) * (-1)
End If
'Dec.Node (Kethu) 8
pPos_(8) = pPos_(7) + 180# 'Not Needed NKPA** Correction
If pPos_(8) >= 360# Then pPos_(8) = pPos_(8) - 360#
isRe_(8) = 10#
'Uranus 9
pReVal = swe_calc_ut(julDateGMT, 7, 256, pDetails(0), errReturn)
pPos_(9) = hp_Rnd0To360v(pDetails(0) - newKPAyanEph) 'NKPA** Correction
isRe_(9) = pDetails(3)
'Neptune 10
pReVal = swe_calc_ut(julDateGMT, 8, 256, pDetails(0), errReturn)
pPos_(10) = hp_Rnd0To360v(pDetails(0) - newKPAyanEph) 'NKPA** Correction
isRe_(10) = pDetails(3)
Dim y1 As Long, m1 As Long, d1 As Long, h1 As Double
Call swe_revjul(julDateGMT, 1, y1, m1, d1, h1)
curDate = Format(Int(d1), "00") + "-" + Format(m1, "00") + "-" + Format(y1, "0000")
'sidTime = swe_sidtime(julDateGMT)
'" " + hp_FormalTimeSh(sidTime) + "
RTEph.SelText = curDate + " " + hp_FormalDegSh(pPos_(0)) + pt_Refun(isRe_(0)) + hp_FormalDegSh(pPos_(1)) + pt_Refun(isRe_(1)) + hp_FormalDegSh(pPos_(2)) + pt_Refun(isRe_(2)) + hp_FormalDegSh(pPos_(3)) + pt_Refun(isRe_(3)) + hp_FormalDegSh(pPos_(4)) + pt_Refun(isRe_(4)) + hp_FormalDegSh(pPos_(5)) + pt_Refun(isRe_(5)) + hp_FormalDegSh(pPos_(6)) + pt_Refun(isRe_(6)) + hp_FormalDegSh(pPos_(7)) + pt_Refun(isRe_(7)) + hp_FormalDegSh(pPos_(9)) + pt_Refun(isRe_(9)) + hp_FormalDegSh(pPos_(10)) + pt_Refun(isRe_(10)) + vbNewLine
julDateGMT = julDateGMT + 1#
Wend
End Sub
***********************************************************************************
ေမာ္ဂ်ဴး (swedll32.dll) ကို ေခၚတင္ဖို႔။ (swedll32.dll) ဖိုင္က ဖုိလ္ဒါတစ္ခုထဲမွာ ရွိရပါမယ္။
***************************************************************************
'================================================================
' Description..: Krishnamurti (KP) Astrology Software
' Software.....: KP New Astro
' Date.........: 05/12/2010
' Version......: 1.0.xx beta
' Language.....: Visual Basic 6.0 Ent - SP 6
' Tested.......: Windows XP Professional - SP 3
' Copyright....: (C) 2009-2010 JSW
' E-Mail.......: kpnewastro@gmail.com
' Web..........: http://www.kpnewastro.blogspot.com
'================================================================
' Released under GNU general public license (version 2 or later)
'================================================================
'================================================================
' Visit http://www.astro.com for Swiss Ephemeris
'================================================================
Option Explicit
'For XP Style
Private Type tagInitCommonControlsEx
lngSize As Long
lngICC As Long
End Type
Private Declare Function InitCommonControlsEx Lib "COMCTL32.DLL" (iccex As tagInitCommonControlsEx) As Boolean
Private Const ICC_USEREX_CLASSES = &H200
'For URL Links
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
'SWE
Public Declare Function swe_azalt Lib "swedll32.dll" _
Alias "_swe_azalt@40" ( _
ByVal tjd_ut As Double, _
ByVal calc_flag As Long, _
ByRef geopos As Double, _
ByVal atpress As Double, _
ByVal attemp As Double, _
ByRef xin As Double, _
ByRef xaz As Double _
) As Long 'geopos must be the first of three array elements
'xin must be the first of two array elements
'xaz must be the first of three array elements
Public Declare Function swe_azalt_rev Lib "swedll32.dll" _
Alias "_swe_azalt_rev@24" ( _
ByVal tjd_ut As Double, _
ByVal calc_flag As Long, _
ByRef geopos As Double, _
ByRef xin As Double, _
ByRef xout As Double _
) As Long 'geopos must be the first of three array elements
'xin must be the first of two array elements
'xout must be the first of three array elements
Public Declare Function swe_calc Lib "swedll32.dll" _
Alias "_swe_calc@24" ( _
ByVal tjd As Double, _
ByVal ipl As Long, _
ByVal iflag As Long, _
ByRef x As Double, _
ByVal serr As String _
) As Long ' x must be first of six array elements
' serr must be able to hold 256 bytes
Public Declare Function swe_calc_d Lib "swedll32.dll" _
Alias "_swe_calc_d@20" ( _
ByRef tjd As Double, _
ByVal ipl As Long, _
ByVal iflag As Long, _
ByRef x As Double, _
ByVal serr As String _
) As Long ' x must be first of six array elements
' serr must be able to hold 256 bytes
Public Declare Function swe_calc_ut Lib "swedll32.dll" _
Alias "_swe_calc_ut@24" ( _
ByVal tjd_ut As Double, _
ByVal ipl As Long, _
ByVal iflag As Long, _
ByRef x As Double, _
ByVal serr As String _
) As Long ' x must be first of six array elements
' serr must be able to hold 256 bytes
Public Declare Function swe_calc_ut_d Lib "swedll32.dll" _
Alias "_swe_calc_ut_d@20" ( _
ByRef tjd_ut As Double, _
ByVal ipl As Long, _
ByVal iflag As Long, _
ByRef x As Double, _
ByVal serr As String _
) As Long ' x must be first of six array elements
' serr must be able to hold 256 bytes
Public Declare Function swe_close Lib "swedll32.dll" _
Alias "_swe_close@0" ( _
) As Long
Public Declare Function swe_close_d Lib "swedll32.dll" _
Alias "_swe_close_d@4" ( _
ByVal ivoid As Long _
) As Long ' argument ivoid is ignored
Public Declare Sub swe_cotrans Lib "swedll32.dll" _
Alias "_swe_cotrans@16" ( _
ByRef xpo As Double, _
ByRef xpn As Double, _
ByVal eps As Double _
)
Public Declare Function swe_cotrans_d Lib "swedll32.dll" _
Alias "_swe_cotrans_d@12" ( _
ByRef xpo As Double, _
ByRef xpn As Double, _
ByRef eps As Double _
) As Long
Public Declare Sub swe_cotrans_sp Lib "swedll32.dll" _
Alias "_swe_cotrans_sp@16" ( _
ByRef xpo As Double, _
ByRef xpn As Double, _
ByVal eps As Double _
)
Public Declare Function swe_cotrans_sp_d Lib "swedll32.dll" _
Alias "_swe_cotrans_sp_d@12" ( _
ByRef xpo As Double, _
ByRef xpn As Double, _
ByRef eps As Double _
) As Long
Public Declare Sub swe_cs2degstr Lib "swedll32.dll" _
Alias "_swe_cs2degstr@8" ( _
ByVal T As Long, _
ByVal s As String _
)
Public Declare Function swe_cs2degstr_d Lib "swedll32.dll" _
Alias "_swe_cs2degstr_d@8" ( _
ByVal T As Long, _
ByVal s As String _
) As Long
Public Declare Sub swe_cs2lonlatstr Lib "swedll32.dll" _
Alias "_swe_cs2lonlatstr@16" ( _
ByVal T As Long, _
ByVal pchar As Byte, _
ByVal mchar As Byte, _
ByVal s As String _
)
Public Declare Function swe_cs2lonlatstr_d Lib "swedll32.dll" _
Alias "_swe_cs2lonlatstr_d@16" ( _
ByVal T As Long, _
ByRef pchar As Byte, _
ByRef mchar As Byte, _
ByVal s As String _
) As Long
Public Declare Sub swe_cs2timestr Lib "swedll32.dll" _
Alias "_swe_cs2timestr@16" ( _
ByVal T As Long, _
ByVal sep As Long, _
ByVal supzero As Long, _
ByVal s As String _
)
Public Declare Function swe_cs2timestr_d Lib "swedll32.dll" _
Alias "_swe_cs2timestr_d@16" ( _
ByVal T As Long, _
ByVal sep As Long, _
ByVal supzero As Long, _
ByVal s As String _
) As Long
Public Declare Function swe_csnorm Lib "swedll32.dll" _
Alias "_swe_csnorm@4" ( _
ByVal P As Long _
) As Long
Public Declare Function swe_csnorm_d Lib "swedll32.dll" _
Alias "_swe_csnorm_d@4" ( _
ByVal P As Long _
) As Long
Public Declare Function swe_csroundsec Lib "swedll32.dll" _
Alias "_swe_csroundsec@4" ( _
ByVal P As Long _
) As Long
Public Declare Function swe_csroundsec_d Lib "swedll32.dll" _
Alias "_swe_csroundsec_d@4" ( _
ByVal P As Long _
) As Long
Public Declare Function swe_d2l Lib "swedll32.dll" _
Alias "_swe_d2l@8" ( _
) As Long
Public Declare Function swe_d2l_d Lib "swedll32.dll" _
Alias "_swe_d2l_d@4" ( _
) As Long
Public Declare Function swe_date_conversion Lib "swedll32.dll" _
Alias "_swe_date_conversion@28" ( _
ByVal Year_ As Long, _
ByVal Month_ As Long, _
ByVal Day_ As Long, _
ByVal utime As Double, _
ByVal cal As Byte, _
ByRef tjd As Double _
) As Long
Public Declare Function swe_date_conversion_d Lib "swedll32.dll" _
Alias "_swe_date_conversion_d@24" ( _
ByVal Year_ As Long, _
ByVal Month_ As Long, _
ByVal Day_ As Long, _
ByRef utime As Double, _
ByRef cal As Byte, _
ByRef tjd As Double _
) As Long
Public Declare Function swe_day_of_week Lib "swedll32.dll" _
Alias "_swe_day_of_week@8" ( _
ByVal jd As Double _
) As Long
Public Declare Function swe_day_of_week_d Lib "swedll32.dll" _
Alias "_swe_day_of_week_d@4" ( _
ByRef jd As Double _
) As Long
Public Declare Function swe_degnorm Lib "swedll32.dll" _
Alias "_swe_degnorm@8" ( _
ByVal jd As Double _
) As Double
Public Declare Function swe_degnorm_d Lib "swedll32.dll" _
Alias "_swe_degnorm_d@4" ( _
ByRef jd As Double _
) As Long
Public Declare Function swe_deltat Lib "swedll32.dll" _
Alias "_swe_deltat@8" ( _
ByVal jd As Double _
) As Double
Public Declare Function swe_deltat_d Lib "swedll32.dll" _
Alias "_swe_deltat_d@8" ( _
ByRef jd As Double, _
ByRef deltat As Double _
) As Long
Public Declare Function swe_difcs2n Lib "swedll32.dll" _
Alias "_swe_difcs2n@8" ( _
ByVal p1 As Long, _
ByVal p2 As Long _
) As Long
Public Declare Function swe_difcs2n_d Lib "swedll32.dll" _
Alias "_swe_difcs2n_d@8" ( _
ByVal p1 As Long, _
ByVal p2 As Long _
) As Long
Public Declare Function swe_difcsn Lib "swedll32.dll" _
Alias "_swe_difcsn@8" ( _
ByVal p1 As Long, _
ByVal p2 As Long _
) As Long
Public Declare Function swe_difcsn_d Lib "swedll32.dll" _
Alias "_swe_difcsn_d@8" ( _
ByVal p1 As Long, _
ByVal p2 As Long _
) As Long
Public Declare Function swe_difdeg2n Lib "swedll32.dll" _
Alias "_swe_difdeg2n@16" ( _
ByVal p1 As Double, _
ByVal p2 As Double _
) As Double
Public Declare Function swe_difdeg2n_d Lib "swedll32.dll" _
Alias "_swe_difdeg2n_d@12" ( _
ByRef p1 As Double, _
ByRef p2 As Double, _
ByRef diff As Double _
) As Long
Public Declare Function swe_difdegn Lib "swedll32.dll" _
Alias "_swe_difdegn@16" ( _
ByVal p1 As Double, _
ByVal p2 As Double _
) As Long
Public Declare Function swe_difdegn_d Lib "swedll32.dll" _
Alias "_swe_difdegn_d@12" ( _
ByRef p1 As Double, _
ByRef p2 As Double, _
ByRef diff As Double _
) As Long
Public Declare Function swe_fixstar Lib "swedll32.dll" _
Alias "_swe_fixstar@24" ( _
ByVal star As String, _
ByVal tjd As Double, _
ByVal iflag As Long, _
ByRef x As Double, _
ByVal serr As String _
) As Long ' x must be first of six array elements
' serr must be able to hold 256 bytes
' star must be able to hold 40 bytes
Public Declare Function swe_fixstar_d Lib "swedll32.dll" _
Alias "_swe_fixstar_d@20" ( _
ByVal star As String, _
ByRef tjd As Double, _
ByVal iflag As Long, _
ByRef x As Double, _
ByVal serr As String _
) As Long ' x must be first of six array elements
' serr must be able to hold 256 bytes
' star must be able to hold 40 bytes
Public Declare Function swe_fixstar_ut Lib "swedll32.dll" _
Alias "_swe_fixstar_ut@24" ( _
ByVal star As String, _
ByVal tjd_ut As Double, _
ByVal iflag As Long, _
ByRef x As Double, _
ByVal serr As String _
) As Long ' x must be first of six array elements
' serr must be able to hold 256 bytes
' star must be able to hold 40 bytes
Public Declare Function swe_fixstar_ut_d Lib "swedll32.dll" _
Alias "_swe_fixstar_ut_d@20" ( _
ByVal star As String, _
ByRef tjd_ut As Double, _
ByVal iflag As Long, _
ByRef x As Double, _
ByVal serr As String _
) As Long ' x must be first of six array elements
' serr must be able to hold 256 bytes
' star must be able to hold 40 bytes
Public Declare Function swe_get_ayanamsa Lib "swedll32.dll" _
Alias "_swe_get_ayanamsa@8" ( _
ByVal tjd_et As Double _
) As Double
Public Declare Function swe_get_ayanamsa_d Lib "swedll32.dll" _
Alias "_swe_get_ayanamsa_d@8" ( _
ByRef tjd_et As Double, _
ByRef ayan As Double _
) As Long
Public Declare Function swe_get_ayanamsa_ut Lib "swedll32.dll" _
Alias "_swe_get_ayanamsa_ut@8" ( _
ByVal tjd_ut As Double _
) As Double
Public Declare Function swe_get_ayanamsa_ut_d Lib "swedll32.dll" _
Alias "_swe_get_ayanamsa_ut_d@8" ( _
ByRef tjd_ut As Double, _
ByRef ayan As Double _
) As Long
Public Declare Sub swe_get_planet_name Lib "swedll32.dll" _
Alias "_swe_get_planet_name@8" ( _
ByVal ipl As Long, _
ByVal pname As String _
)
Public Declare Function swe_get_planet_name_d Lib "swedll32.dll" _
Alias "_swe_get_planet_name_d@8" ( _
ByVal ipl As Long, _
ByVal pname As String _
) As Long
Public Declare Function swe_get_tid_acc Lib "swedll32.dll" _
Alias "_swe_get_tid_acc@0" ( _
) As Double
Public Declare Function swe_get_tid_acc_d Lib "swedll32.dll" _
Alias "_swe_get_tid_acc_d@4" ( _
ByRef x As Double _
) As Long
Public Declare Function swe_houses Lib "swedll32.dll" _
Alias "_swe_houses@36" ( _
ByVal tjd_ut As Double, _
ByVal geolat As Double, _
ByVal geolon As Double, _
ByVal ihsy As Long, _
ByRef hcusps As Double, _
ByRef ascmc As Double _
) As Long ' hcusps must be first of 13 array elements
' ascmc must be first of 10 array elements
Public Declare Function swe_houses_d Lib "swedll32.dll" _
Alias "_swe_houses_d@24" ( _
ByRef tjd_ut As Double, _
ByRef geolat As Double, _
ByRef geolon As Double, _
ByVal ihsy As Long, _
ByRef hcusps As Double, _
ByRef ascmc As Double _
) As Long ' hcusps must be first of 13 array elements
' ascmc must be first of 10 array elements
Public Declare Function swe_houses_ex Lib "swedll32.dll" _
Alias "_swe_houses_ex@40" ( _
ByVal tjd_ut As Double, _
ByVal iflag As Long, _
ByVal geolat As Double, _
ByVal geolon As Double, _
ByVal ihsy As Long, _
ByRef hcusps As Double, _
ByRef ascmc As Double _
) As Long ' hcusps must be first of 13 array elements
' ascmc must be first of 10 array elements
Public Declare Function swe_houses_ex_d Lib "swedll32.dll" _
Alias "_swe_houses_ex_d@28" ( _
ByRef tjd_ut As Double, _
ByVal iflag As Long, _
ByRef geolat As Double, _
ByRef geolon As Double, _
ByVal ihsy As Long, _
ByRef hcusps As Double, _
ByRef ascmc As Double _
) As Long ' hcusps must be first of 13 array elements
' ascmc must be first of 10 array elements
Public Declare Function swe_houses_armc Lib "swedll32.dll" _
Alias "_swe_houses_armc@36" ( _
ByVal armc As Double, _
ByVal geolat As Double, _
ByVal eps As Double, _
ByVal ihsy As Long, _
ByRef hcusps As Double, _
ByRef ascmc As Double _
) As Long ' hcusps must be first of 13 array elements
' ascmc must be first of 10 array elements
Public Declare Function swe_houses_armc_d Lib "swedll32.dll" _
Alias "_swe_houses_armc_d@24" ( _
ByRef armc As Double, _
ByRef geolat As Double, _
ByRef eps As Double, _
ByVal ihsy As Long, _
ByRef hcusps As Double, _
ByRef ascmc As Double _
) As Long ' hcusps must be first of 13 array elements
' ascmc must be first of 10 array elements
Public Declare Function swe_house_pos Lib "swedll32.dll" _
Alias "_swe_house_pos@36" ( _
ByVal armc As Double, _
ByVal geolat As Double, _
ByVal eps As Double, _
ByVal ihsy As Long, _
ByRef xpin As Double, _
ByVal serr As String _
) As Double
' xpin must be first of 2 array elements
Public Declare Function swe_house_pos_d Lib "swedll32.dll" _
Alias "_swe_house_pos_d@28" ( _
ByRef armc As Double, _
ByRef geolat As Double, _
ByRef eps As Double, _
ByVal ihsy As Long, _
ByRef xpin As Double, _
ByRef hpos As Double, _
ByVal serr As String _
) As Long
' xpin must be first of 2 array elements
Public Declare Function swe_julday Lib "swedll32.dll" _
Alias "_swe_julday@24" ( _
ByVal Year_ As Long, _
ByVal Month_ As Long, _
ByVal Day_ As Long, _
ByVal Hour_ As Double, _
ByVal gregflg As Long _
) As Double
Public Declare Function swe_julday_d Lib "swedll32.dll" _
Alias "_swe_julday_d@24" ( _
ByVal Year_ As Long, _
ByVal Month_ As Long, _
ByVal Day_ As Long, _
ByRef Hour_ As Double, _
ByVal gregflg As Long, _
ByRef tjd As Double _
) As Long
Public Declare Function swe_lun_eclipse_how Lib "swedll32.dll" _
Alias "_swe_lun_eclipse_how@24" ( _
ByVal tjd_ut As Double, _
ByVal ifl As Long, _
ByRef geopos As Double, _
ByRef attr As Double, _
ByVal serr As String _
) As Long
Public Declare Function swe_lun_eclipse_how_d Lib "swedll32.dll" _
Alias "_swe_lun_eclipse_how_d@20" ( _
ByRef tjd_ut As Double, _
ByVal ifl As Long, _
ByRef geopos As Double, _
ByRef attr As Double, _
ByVal serr As String _
) As Long
Public Declare Function swe_lun_eclipse_when Lib "swedll32.dll" _
Alias "_swe_lun_eclipse_when@28" ( _
ByVal tjd_start As Double, _
ByVal ifl As Long, _
ByVal ifltype As Long, _
ByRef tret As Double, _
ByVal backward As Long, _
ByVal serr As String _
) As Long
Public Declare Function swe_lun_eclipse_when_d Lib "swedll32.dll" _
Alias "_swe_lun_eclipse_when_d@24" ( _
ByRef tjd_start As Double, _
ByVal ifl As Long, _
ByVal ifltype As Long, _
ByRef tret As Double, _
ByVal backward As Long, _
ByVal serr As String _
) As Long
Public Declare Function swe_nod_aps Lib "swedll32.dll" _
Alias "_swe_nod_aps@40" ( _
ByVal tjd_et As Double, _
ByVal ipl As Long, _
ByVal iflag As Long, _
ByVal method As Long, _
ByRef xnasc As Double, _
ByRef xndsc As Double, _
ByRef xperi As Double, _
ByRef xaphe As Double, _
ByVal serr As String _
) As Long
Public Declare Function swe_nod_aps_ut Lib "swedll32.dll" _
Alias "_swe_nod_aps_ut@40" ( _
ByVal tjd_ut As Double, _
ByVal ipl As Long, _
ByVal iflag As Long, _
ByVal method As Long, _
ByRef xnasc As Double, _
ByRef xndsc As Double, _
ByRef xperi As Double, _
ByRef xaphe As Double, _
ByVal serr As String _
) As Long
Public Declare Function swe_pheno Lib "swedll32.dll" _
Alias "_swe_pheno@24" ( _
ByVal tjd As Double, _
ByVal ipl As Long, _
ByVal iflag As Long, _
ByRef attr As Double, _
ByVal serr As String _
) As Long
Public Declare Function swe_pheno_ut Lib "swedll32.dll" _
Alias "_swe_pheno_ut@24" ( _
ByVal tjd As Double, _
ByVal ipl As Long, _
ByVal iflag As Long, _
ByRef attr As Double, _
ByVal serr As String _
) As Long
Public Declare Function swe_pheno_d Lib "swedll32.dll" _
Alias "_swe_pheno_d@20" ( _
ByRef tjd As Double, _
ByVal ipl As Long, _
ByVal iflag As Long, _
ByRef attr As Double, _
ByVal serr As String _
) As Long
Public Declare Function swe_pheno_ut_d Lib "swedll32.dll" _
Alias "_swe_pheno_ut_d@20" ( _
ByRef tjd As Double, _
ByVal ipl As Long, _
ByVal iflag As Long, _
ByRef attr As Double, _
ByVal serr As String _
) As Long
Public Declare Function swe_refrac Lib "swedll32.dll" _
Alias "_swe_refrac@28" ( _
ByVal inalt As Double, _
ByVal atpress As Double, _
ByVal attemp As Double, _
ByVal calc_flag As Long _
) As Double
Public Declare Sub swe_revjul Lib "swedll32.dll" _
Alias "_swe_revjul@28" ( _
ByVal tjd As Double, _
ByVal gregflg As Long, _
ByRef Year_ As Long, _
ByRef Month_ As Long, _
ByRef Day_ As Long, _
ByRef Hour_ As Double _
)
Public Declare Function swe_revjul_d Lib "swedll32.dll" _
Alias "_swe_revjul_d@24" ( _
ByRef tjd As Double, _
ByVal gregflg As Long, _
ByRef Year_ As Long, _
ByRef Month_ As Long, _
ByRef Day_ As Long, _
ByRef Hour_ As Double _
) As Long
Public Declare Function swe_rise_trans Lib "swedll32.dll" _
Alias "_swe_rise_trans@52" ( _
ByVal tjd_ut As Double, _
ByVal ipl As Long, _
ByVal starName As String, _
ByVal epheflag As Long, _
ByVal rsmi As Long, _
ByRef geopos As Double, _
ByVal atpress As Double, _
ByVal attemp As Double, _
ByRef tret As Double, _
ByVal serr As String _
) As Long
Public Declare Sub swe_set_ephe_path Lib "swedll32.dll" _
Alias "_swe_set_ephe_path@4" ( _
ByVal Path As String _
)
Public Declare Function swe_set_ephe_path_d Lib "swedll32.dll" _
Alias "_swe_set_ephe_path_d@4" ( _
ByVal Path As String _
) As Long
Public Declare Sub swe_set_jpl_file Lib "swedll32.dll" _
Alias "_swe_set_jpl_file@4" ( _
ByVal file As String _
)
Public Declare Function swe_set_jpl_file_d Lib "swedll32.dll" _
Alias "_swe_set_jpl_file_d@4" ( _
ByVal file As String _
) As Long
Public Declare Function swe_set_sid_mode Lib "swedll32.dll" _
Alias "_swe_set_sid_mode@20" ( _
ByVal sid_mode As Long, _
ByVal t0 As Double, _
ByVal ayan_t0 As Double _
) As Long
Public Declare Function swe_set_sid_mode_d Lib "swedll32.dll" _
Alias "_swe_sid_mode_d@12" ( _
ByVal sid_mode As Long, _
ByRef t0 As Double, _
ByRef ayan_t0 As Double _
) As Long
Public Declare Sub swe_set_topo Lib "swedll32.dll" _
Alias "_swe_set_topo@24" ( _
ByVal geolon As Double, _
ByVal geolat As Double, _
ByVal altitude As Double _
)
Public Declare Function swe_set_topo_d Lib "swedll32.dll" _
Alias "_swe_set_topo_d@12" ( _
ByRef geolon As Double, _
ByRef geolat As Double, _
ByRef altitude As Double _
) As Long
Public Declare Sub swe_set_tid_acc Lib "swedll32.dll" _
Alias "_swe_set_tid_acc@8" ( _
ByVal x As Double _
)
Public Declare Function swe_set_tid_acc_d Lib "swedll32.dll" _
Alias "_swe_set_tid_acc_d@4" ( _
ByRef x As Double _
) As Long
Public Declare Function swe_sidtime0 Lib "swedll32.dll" _
Alias "_swe_sidtime0@24" ( _
ByVal tjd_ut As Double, _
ByVal ecl As Double, _
ByVal nut As Double _
) As Double
Public Declare Function swe_sidtime0_d Lib "swedll32.dll" _
Alias "_swe_sidtime0_d@16" ( _
ByRef tjd_ut As Double, _
ByRef ecl As Double, _
ByRef nut As Double, _
ByRef sidt As Double _
) As Long
Public Declare Function swe_sidtime Lib "swedll32.dll" _
Alias "_swe_sidtime@8" ( _
ByVal tjd_ut As Double _
) As Double
Public Declare Function swe_sidtime_d Lib "swedll32.dll" _
Alias "_swe_sidtime_d@8" ( _
ByRef tjd_ut As Double, _
ByRef sidt As Double _
) As Long
Public Declare Function swe_sol_eclipse_how Lib "swedll32.dll" _
Alias "_swe_sol_eclipse_how@24" ( _
ByVal tjd_ut As Double, _
ByVal ifl As Long, _
ByRef geopos As Double, _
ByRef attr As Double, _
ByVal serr As String _
) As Long
Public Declare Function swe_sol_eclipse_how_d Lib "swedll32.dll" _
Alias "_swe_sol_eclipse_how_d@20" ( _
ByRef tjd_ut As Double, _
ByVal ifl As Long, _
ByRef geopos As Double, _
ByRef attr As Double, _
ByVal serr As String _
) As Long
Public Declare Function swe_sol_eclipse_when_glob Lib "swedll32.dll" _
Alias "_swe_sol_eclipse_when_glob@28" ( _
ByVal tjd_start As Double, _
ByVal ifl As Long, _
ByVal ifltype As Long, _
ByRef tret As Double, _
ByVal backward As Long, _
ByVal serr As String _
) As Long
Public Declare Function swe_sol_eclipse_when_glob_d Lib "swedll32.dll" _
Alias "_swe_sol_eclipse_when_glob_d@24" ( _
ByRef tjd_start As Double, _
ByVal ifl As Long, _
ByVal ifltype As Long, _
ByRef tret As Double, _
ByVal backward As Long, _
ByVal serr As String _
) As Long
Public Declare Function swe_sol_eclipse_when_loc Lib "swedll32.dll" _
Alias "_swe_sol_eclipse_when_loc@32" ( _
ByVal tjd_start As Double, _
ByVal ifl As Long, _
ByRef tret As Double, _
ByRef attr As Double, _
ByVal backward As Long, _
ByVal serr As String _
) As Long
Public Declare Function swe_sol_eclipse_when_loc_d Lib "swedll32.dll" _
Alias "_swe_sol_eclipse_when_loc_d@28" ( _
ByRef tjd_start As Double, _
ByVal ifl As Long, _
ByRef tret As Double, _
ByRef attr As Double, _
ByVal backward As Long, _
ByVal serr As String _
) As Long
Public Declare Function swe_sol_eclipse_where Lib "swedll32.dll" _
Alias "_swe_sol_eclipse_where@24" ( _
ByVal tjd_ut As Double, _
ByVal ifl As Long, _
ByRef geopos As Double, _
ByRef attr As Double, _
ByVal serr As String _
) As Long
Public Declare Function swe_sol_eclipse_where_d Lib "swedll32.dll" _
Alias "_swe_sol_eclipse_where_d@20" ( _
ByRef tjd_ut As Double, _
ByVal ifl As Long, _
ByRef geopos As Double, _
ByRef attr As Double, _
ByVal serr As String _
) As Long
Public Declare Function swe_time_equ Lib "swedll32.dll" _
Alias "_swe_time_equ@16" ( _
ByVal tjd_ut As Double, _
ByRef e As Double, _
ByVal serr As String _
) As Long
' values for gregflag in swe_julday() and swe_revjul()
Const SE_JUL_CAL As Integer = 0
Const SE_GREG_CAL As Integer = 1
' planet and body numbers (parameter ipl) for swe_calc()
Const SE_SUN As Integer = 0
Const SE_MOON As Integer = 1
Const SE_MERCURY As Integer = 2
Const SE_VENUS As Integer = 3
Const SE_MARS As Integer = 4
Const SE_JUPITER As Integer = 5
Const SE_SATURN As Integer = 6
Const SE_URANUS As Integer = 7
Const SE_NEPTUNE As Integer = 8
Const SE_PLUTO As Integer = 9
Const SE_MEAN_NODE As Integer = 10
Const SE_TRUE_NODE As Integer = 11
Const SE_MEAN_APOG As Integer = 12
Const SE_OSCU_APOG As Integer = 13
Const SE_EARTH As Integer = 14
Const SE_CHIRON As Integer = 15
Const SE_PHOLUS As Integer = 16
Const SE_CERES As Integer = 17
Const SE_PALLAS As Integer = 18
Const SE_JUNO As Integer = 19
Const SE_VESTA As Integer = 20
Const SE_NPLANETS As Integer = 21
Const SE_AST_OFFSET As Integer = 10000
' Hamburger or Uranian ficticious "planets"
Const SE_FICT_OFFSET As Integer = 40
Const SE_FICT_MAX As Integer = 999 'maximum number for ficticious planets
'if taken from file seorbel.txt
Const SE_NFICT_ELEM As Integer = 15 'number of built-in ficticious planets
Const SE_CUPIDO As Integer = 40
Const SE_HADES As Integer = 41
Const SE_ZEUS As Integer = 42
Const SE_KRONOS As Integer = 43
Const SE_APOLLON As Integer = 44
Const SE_ADMETOS As Integer = 45
Const SE_VULKANUS As Integer = 46
Const SE_POSEIDON As Integer = 47
' other ficticious bodies
Const SE_ISIS As Integer = 48
Const SE_NIBIRU As Integer = 49
Const SE_HARRINGTON As Integer = 50
Const SE_NEPTUNE_LEVERRIER As Integer = 51
Const SE_NEPTUNE_ADAMS As Integer = 52
Const SE_PLUTO_LOWELL As Integer = 53
Const SE_PLUTO_PICKERING As Integer = 54
' points returned by swe_houses() and swe_houses_armc()
' in array ascmc(0...10)
Const SE_ASC As Integer = 0
Const SE_MC As Integer = 1
Const SE_ARMC As Integer = 2
Const SE_VERTEX As Integer = 3
Const SE_EQUASC As Integer = 4 ' "equatorial ascendant"
Const SE_NASCMC As Integer = 5 ' number of such points
' iflag values for swe_calc()/swe_calc_ut() and swe_fixstar()/swe_fixstar_ut()
Const SEFLG_JPLEPH As Long = 1
Const SEFLG_MOSEPH As Long = 4
Const SEFLG_SWIEPH As Long = 2
Const SEFLG_SPEED As Long = 256
Const SEFLG_HELCTR As Long = 8
Const SEFLG_TRUEPOS As Long = 16
Const SEFLG_J2000 As Long = 32
Const SEFLG_NONUT As Long = 64
Const SEFLG_NOGDEFL As Long = 512
Const SEFLG_NOABERR As Long = 1024
Const SEFLG_EQUATORIAL As Long = 2048
Const SEFLG_XYZ As Long = 4096
Const SEFLG_RADIANS As Long = 8192
Const SEFLG_BARYCTR As Long = 16384
Const SEFLG_TOPOCTR As Long = 32768
Const SEFLG_SIDEREAL As Long = 65536
'eclipse codes
Const SE_ECL_CENTRAL As Long = 1
Const SE_ECL_NONCENTRAL As Long = 2
Const SE_ECL_TOTAL As Long = 4
Const SE_ECL_ANNULAR As Long = 8
Const SE_ECL_PARTIAL As Long = 16
Const SE_ECL_ANNULAR_TOTAL As Long = 32
Const SE_ECL_PENUMBRAL As Long = 64
Const SE_ECL_VISIBLE As Long = 128
Const SE_ECL_MAX_VISIBLE As Long = 256
Const SE_ECL_1ST_VISIBLE As Long = 512
Const SE_ECL_2ND_VISIBLE As Long = 1024
Const SE_ECL_3RD_VISIBLE As Long = 2048
Const SE_ECL_4TH_VISIBLE As Long = 4096
'sidereal modes, for swe_set_sid_mode()
Const SE_SIDM_FAGAN_BRADLEY As Long = 0
Const SE_SIDM_LAHIRI As Long = 1
Const SE_SIDM_DELUCE As Long = 2
Const SE_SIDM_RAMAN As Long = 3
Const SE_SIDM_USHASHASHI As Long = 4
Const SE_SIDM_KRISHNAMURTI As Long = 5
Const SE_SIDM_DJWHAL_KHUL As Long = 6
Const SE_SIDM_YUKTESHWAR As Long = 7
Const SE_SIDM_JN_BHASIN As Long = 8
Const SE_SIDM_BABYL_KUGLER1 As Long = 9
Const SE_SIDM_BABYL_KUGLER2 As Long = 10
Const SE_SIDM_BABYL_KUGLER3 As Long = 11
Const SE_SIDM_BABYL_HUBER As Long = 12
Const SE_SIDM_BABYL_ETPSC As Long = 13
Const SE_SIDM_ALDEBARAN_15TAU As Long = 14
Const SE_SIDM_HIPPARCHOS As Long = 15
Const SE_SIDM_SASSANIAN As Long = 16
Const SE_SIDM_GALCENT_0SAG As Long = 17
Const SE_SIDM_J2000 As Long = 18
Const SE_SIDM_J1900 As Long = 19
Const SE_SIDM_B1950 As Long = 20
Const SE_SIDM_USER As Long = 255
Const SE_NSIDM_PREDEF As Long = 21
Const SE_SIDBITS As Long = 256
'for projection onto ecliptic of t0
Const SE_SIDBIT_ECL_T0 As Long = 256
'for projection onto solar system plane
Const SE_SIDBIT_SSY_PLANE As Long = 512
' modes for planetary nodes/apsides, swe_nod_aps(), swe_nod_aps_ut()
Const SE_NODBIT_MEAN As Long = 1
Const SE_NODBIT_OSCU As Long = 2
Const SE_NODBIT_OSCU_BAR As Long = 3
Const SE_NODBIT_FOPOINT As Long = 256
' indices for swe_rise_trans()
Const SE_CALC_RISE As Long = 1
Const SE_CALC_SET As Long = 2
Const SE_CALC_MTRANSIT As Long = 4
Const SE_CALC_ITRANSIT As Long = 8
Const SE_BIT_DISC_CENTER As Long = 256 '/* to be added to SE_CALC_RISE/SET */
'/* if rise or set of disc center is */
'/* requried */
Const SE_BIT_NO_REFRACTION As Long = 512 '/* to be added to SE_CALC_RISE/SET, */
'/* if refraction is not to be considered */
' bits for data conversion with swe_azalt() and swe_azalt_rev()
Const SE_ECL2HOR As Long = 0
Const SE_EQU2HOR As Long = 1
Const SE_HOR2ECL As Long = 0
Const SE_HOR2EQU As Long = 1
' for swe_refrac()
Const SE_TRUE_TO_APP As Long = 0
Const SE_APP_TO_TRUE As Long = 1
Public Sub Main()
'Main Sub - Applying XP Visual Style.
Dim iccex As tagInitCommonControlsEx
With iccex
.lngSize = LenB(iccex)
.lngICC = ICC_USEREX_CLASSES
End With
InitCommonControlsEx iccex
On Error GoTo 0
Load frmMain
frmMain.Show
End Sub
*********************************************************************
