SwissEphemeris.vba - Declarations of the Swiss Ephemeris fu…

/vba/SwissEphemeris.vba

https://github.com/rplantiko/campanus · Visual Basic · 1249 lines · 1022 code · 168 blank · 59 comment · 0 complexity · 87af81a57e0cf5b807b4da7dbfe91e0a MD5 · raw file

Attribute VB_Name = "SwissEphemeris"
Option Explicit

Private jd_ut_act As Double
Private lat_act As Double
Private lon_act As Double
Private h(13) As Double
Private ascmc(10) As Double
Private ephe_path_set As Boolean
Public Const Deg2Arc As Double = 1.74532925199433E-02
Public Const Campanus As Long = 67  ' = ASCII-Code für "C"
' -------------------------------------------------------
' Declarations of the Swiss Ephemeris functions
' as VB functions (from http://www.astro.com/swisseph/swephprg.htm)
' -------------------------------------------------------

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 Function swe_set_topo Lib "swedll32.dll" _
        Alias "_swe_set_topo@24" ( _
          ByVal geolon As Double, _
          ByVal geolat As Double, _
          ByVal altitude As Double _
        ) As Long

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 _
        )

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, _
          ByRef serr As String _
        ) As Long

' values for gregflag in swe_julday() and swe_revjul()
Public Const SE_JUL_CAL As Integer = 0
Public Const SE_GREG_CAL As Integer = 1

' planet and body numbers (parameter ipl) for swe_calc()
Public Const SE_ECL_NUT As Integer = -1
Public Const SE_SUN As Integer = 0
Public Const SE_MOON As Integer = 1
Public Const SE_MERCURY As Integer = 2
Public Const SE_VENUS As Integer = 3
Public Const SE_MARS As Integer = 4
Public Const SE_JUPITER As Integer = 5
Public Const SE_SATURN As Integer = 6
Public Const SE_URANUS As Integer = 7
Public Const SE_NEPTUNE As Integer = 8
Public Const SE_PLUTO   As Integer = 9
Public Const SE_MEAN_NODE As Integer = 10
Public Const SE_TRUE_NODE As Integer = 11
Public Const SE_MEAN_APOG As Integer = 12
Public Const SE_OSCU_APOG As Integer = 13
Public Const SE_EARTH     As Integer = 14
Public Const SE_CHIRON    As Integer = 15
Public Const SE_PHOLUS    As Integer = 16
Public Const SE_CERES     As Integer = 17
Public Const SE_PALLAS    As Integer = 18
Public Const SE_JUNO      As Integer = 19
Public Const SE_VESTA     As Integer = 20

Public Const SE_NPLANETS  As Integer = 21
Public Const SE_AST_OFFSET  As Integer = 10000

' Hamburger or Uranian ficticious "planets"
Public Const SE_FICT_OFFSET As Integer = 40
Public Const SE_FICT_MAX  As Integer = 999 'maximum number for ficticious planets
                                     'if taken from file seorbel.txt
Public Const SE_NFICT_ELEM  As Integer = 15 'number of built-in ficticious planets
Public Const SE_CUPIDO As Integer = 40
Public Const SE_HADES As Integer = 41
Public Const SE_ZEUS As Integer = 42
Public Const SE_KRONOS As Integer = 43
Public Const SE_APOLLON As Integer = 44
Public Const SE_ADMETOS As Integer = 45
Public Const SE_VULKANUS As Integer = 46
Public Const SE_POSEIDON As Integer = 47
' other ficticious bodies
Public Const SE_ISIS As Integer = 48
Public Const SE_NIBIRU As Integer = 49
Public Const SE_HARRINGTON As Integer = 50
Public Const SE_NEPTUNE_LEVERRIER As Integer = 51
Public Const SE_NEPTUNE_ADAMS As Integer = 52
Public Const SE_PLUTO_LOWELL As Integer = 53
Public Const SE_PLUTO_PICKERING As Integer = 54

' points returned by swe_houses() and swe_houses_armc()
' in array ascmc(0...10)
Public Const SE_ASC       As Integer = 0
Public Const SE_MC        As Integer = 1
Public Const SE_ARMC      As Integer = 2
Public Const SE_VERTEX    As Integer = 3
Public Const SE_EQUASC    As Integer = 4  ' "equatorial ascendant"
Public Const SE_NASCMC    As Integer = 5  ' number of such points

' iflag values for swe_calc()/swe_calc_ut() and
' swe_fixstar()/swe_fixstar_ut()
Public Const SEFLG_JPLEPH As Long = 1
Public Const SEFLG_SWIEPH As Long = 2
Public Const SEFLG_MOSEPH As Long = 4
Public Const SEFLG_SPEED As Long = 256
Public Const SEFLG_HELCTR As Long = 8
Public Const SEFLG_TRUEPOS As Long = 16
Public Const SEFLG_J2000 As Long = 32
Public Const SEFLG_NONUT As Long = 64
Public Const SEFLG_NOGDEFL As Long = 512
Public Const SEFLG_NOABERR As Long = 1024
Public Const SEFLG_EQUATORIAL As Long = 2048
Public Const SEFLG_XYZ As Long = 4096
Public Const SEFLG_RADIANS As Long = 8192
Public Const SEFLG_BARYCTR As Long = 16384
Public Const SEFLG_TOPOCTR As Long = 32768
Public Const SEFLG_SIDEREAL As Long = 65536

'eclipse codes
Public Const SE_ECL_CENTRAL As Long = 1
Public Const SE_ECL_NONCENTRAL As Long = 2
Public Const SE_ECL_TOTAL As Long = 4
Public Const SE_ECL_ANNULAR As Long = 8
Public Const SE_ECL_PARTIAL As Long = 16
Public Const SE_ECL_ANNULAR_TOTAL As Long = 32
Public Const SE_ECL_PENUMBRAL As Long = 64
Public Const SE_ECL_VISIBLE As Long = 128
Public Const SE_ECL_MAX_VISIBLE As Long = 256
Public Const SE_ECL_1ST_VISIBLE As Long = 512
Public Const SE_ECL_2ND_VISIBLE As Long = 1024
Public Const SE_ECL_3RD_VISIBLE As Long = 2048
Public Const SE_ECL_4TH_VISIBLE As Long = 4096

'sidereal modes, for swe_set_sid_mode()
Public Const SE_SIDM_FAGAN_BRADLEY    As Long = 0
Public Const SE_SIDM_LAHIRI           As Long = 1
Public Const SE_SIDM_DELUCE           As Long = 2
Public Const SE_SIDM_RAMAN            As Long = 3
Public Const SE_SIDM_USHASHASHI       As Long = 4
Public Const SE_SIDM_KRISHNAMURTI     As Long = 5
Public Const SE_SIDM_DJWHAL_KHUL      As Long = 6
Public Const SE_SIDM_YUKTESHWAR       As Long = 7
Public Const SE_SIDM_JN_BHASIN        As Long = 8
Public Const SE_SIDM_BABYL_KUGLER1    As Long = 9
Public Const SE_SIDM_BABYL_KUGLER2   As Long = 10
Public Const SE_SIDM_BABYL_KUGLER3   As Long = 11
Public Const SE_SIDM_BABYL_HUBER     As Long = 12
Public Const SE_SIDM_BABYL_ETPSC     As Long = 13
Public Const SE_SIDM_ALDEBARAN_15TAU As Long = 14
Public Const SE_SIDM_HIPPARCHOS      As Long = 15
Public Const SE_SIDM_SASSANIAN       As Long = 16
Public Const SE_SIDM_GALCENT_0SAG    As Long = 17
Public Const SE_SIDM_J2000           As Long = 18
Public Const SE_SIDM_J1900           As Long = 19
Public Const SE_SIDM_B1950           As Long = 20
Public Const SE_SIDM_USER            As Long = 255

Public Const SE_NSIDM_PREDEF         As Long = 21

Public Const SE_SIDBITS              As Long = 256
'for projection onto ecliptic of t0
Public Const SE_SIDBIT_ECL_T0        As Long = 256
'for projection onto solar system plane
Public Const SE_SIDBIT_SSY_PLANE     As Long = 512

' modes for planetary nodes/apsides, swe_nod_aps(), swe_nod_aps_ut()
Public Const SE_NODBIT_MEAN        As Long = 1
Public Const SE_NODBIT_OSCU        As Long = 2
Public Const SE_NODBIT_OSCU_BAR    As Long = 3
Public Const SE_NODBIT_FOPOINT     As Long = 256

' indices for swe_rise_trans()
Public Const SE_CALC_RISE      As Long = 1
Public Const SE_CALC_SET       As Long = 2
Public Const SE_CALC_MTRANSIT      As Long = 4
Public Const SE_CALC_ITRANSIT      As Long = 8

' bits for data conversion with swe_azalt() and swe_azalt_rev()
Public Const SE_ECL2HOR        As Long = 0
Public Const SE_EQU2HOR        As Long = 1
Public Const SE_HOR2ECL        As Long = 0
Public Const SE_HOR2EQU        As Long = 1

' for swe_refrac()
Public Const SE_TRUE_TO_APP        As Long = 0
Public Const SE_APP_TO_TRUE        As Long = 1


' ------------------------------------------------------------------
' The rest of this module contains functions and data
' based on the Swiss Ephemeris
' related with calendar computations
' ------------------------------------------------------------------

' Short Names for signs
Const sknam As String = "ARTAGECNLEVILISCSACPAQPS"
Dim cuspName As Variant

  
Public Function DegMin(x As Double) As String
  Dim y As Double
  Dim suffix As String
  Dim mins As Integer
  Dim degs As Integer
  
  y = (x / 360 - Int(x / 360)) * 360
  suffix = Mid(sknam, 1 + 2 * Int(y / 30), 2)
  y = y - 30 * Int(y / 30)
  
  degs = Int(y)
  If degs < 10 Then
    DegMin = " " & degs
  Else
    DegMin = degs
  End If
  y = (y - degs) * 60
  mins = Int(y)
  If mins < 10 Then
    DegMin = DegMin & "° " & mins
  Else
    DegMin = DegMin & "°" & mins
  End If
  
  DegMin = DegMin & "'" & suffix

End Function

Public Function Dms(x As Double, Optional dmsType As Long = 0) As String
  
  Dim y As Double, l As Double, degs As Integer, _
      mins As Integer, secs As Integer, _
      suffix As String
  
  
  y = (x / 360 - Int(x / 360)) * 360
  suffix = getSuffix(Int(y / 30), dmsType)
  y = y - 30 * Int(y / 30)
  l = y
  degs = Int(y)
  If degs < 10 Then
    Dms = " " & degs
  Else
    Dms = degs
  End If
  y = (y - degs) * 60
  mins = Int(y)
  If mins < 10 Then
    Dms = Dms & "° " & mins
  Else
    Dms = Dms & "°" & mins
  End If
  y = (y - mins) * 60
  If y > 59 And l > 29.983333 Then
    secs = 59
  Else
    secs = Int(y + 0.5)
  End If
  If secs < 10 Then
    Dms = Dms & "' " & secs
  Else
    Dms = Dms & "'" & secs
  End If
  
  Dms = Dms & """ " & suffix

End Function
Function getSuffix(i As Long, Optional dmsType As Long = 0) As String
  Select Case dmsType
    Case 0
      getSuffix = Mid(sknam, 1 + 2 * i, 2)
    Case 1
      If IsEmpty(cuspName) Then
        cuspName = Array("I", "II", "III", "IV", "V", "VI", "VII", "VIII", "IX", "X", "XI", "XII")
      End If
      getSuffix = cuspName(i)
  End Select
End Function
Public Function Dms360(x As Double) As String
  
  Dim y As Double, degs As Integer, _
      mins As Integer, secs As Integer
  
  y = x + 0.5 / 3600
  y = (y / 360 - Int(y / 360)) * 360
  degs = Int(y)
  If degs >= 100 Then
    Dms360 = degs
  Else
    If degs >= 10 Then
      Dms360 = " " & degs
    Else
      Dms360 = "  " & degs
    End If
  End If
  y = (y - degs) * 60
  mins = Int(y)
  If mins < 10 Then
    Dms360 = Dms360 & "° " & mins
  Else
    Dms360 = Dms360 & "°" & mins
  End If
  y = (y - mins) * 60
  secs = Int(y)
  If secs < 10 Then
    Dms360 = Dms360 & "' " & secs
  Else
    Dms360 = Dms360 & "'" & secs
  End If
  
  Dms360 = Dms360 & """"

End Function
Public Function Deg(x As Double) As Double
  Dim s, y, grade, minuten, sekunden
  s = Sgn(x)
  y = x * s + 0.0000000001
  grade = Int(y)
  minuten = Int((y - grade) * 100)
  sekunden = Int((y * 100 - Int(y * 100)) * 100000) / 1000
  Deg = s * (grade + minuten / 60 + sekunden / 3600)
End Function
Public Function Hms(x As Double, Optional round As Boolean = True) As String
  Dim y, degs, mins, secs
  If round Then y = x + 0.5 / 3600 Else y = x
  y = (y / 24 - Int(y / 24)) * 24
  degs = Int(y)
  If degs < 10 Then
    Hms = " " & degs
  Else
    Hms = degs
  End If
  y = (y - degs) * 60
  mins = Int(y)
  If mins < 10 Then
    Hms = Hms & "h " & mins
  Else
    Hms = Hms & "h" & mins
  End If
  y = (y - mins) * 60
  secs = Int(y)
  If secs < 10 Then
    Hms = Hms & "m " & secs
  Else
    Hms = Hms & "m" & secs
  End If
  
  Hms = Hms & "s "

End Function
Public Function ArcDiff(x As Double, y As Double)
  ArcDiff = x - y - Int((x - y) / 360 + 0.5) * 360
End Function
Public Function AbsArcDiff(x As Double, y As Double)
  AbsArcDiff = x - y - Int((x - y) / 360 + 0.5) * 360
  If AbsArcDiff < 0 Then AbsArcDiff = -AbsArcDiff
End Function

Public Function Mod360(x As Double) As Double
  Mod360 = x - Int(x / 360) * 360
End Function
Public Function Asn(x As Double) As Double
  Asn = Atn(x / Sqr(-x * x + 1))
End Function

' Reset the length of a zero-terminated string
' Necessary for communication with Swiss Ephemeris
Public Function trim0(c$) As String
  Dim i As Integer
  i = InStr(c$, Chr$(0))
  If i > 0 Then
    trim0 = Left(c$, i - 1)
  End If
End Function

Public Function JulianDayNumber(dateString As String, time As Double)

  Dim x As Variant, gregflag As Long
  
  x = Split(dateString, ".")
  
  If UBound(x) <> 2 Then
    JulianDayNumber = 0
    Exit Function
  End If
  
  If Right$(x(2), 1) = "j" Then
    gregflag = SE_JUL_CAL
    x(2) = Left$(x(2), Len(x(2)) - 1)
  Else
    If Right$(x(2), 1) = "g" Then
      gregflag = SE_GREG_CAL
      x(2) = Left$(x(2), Len(x(2)) - 1)
    Else
' Default rule for determination of calendar flag:
' Take Julian calendar before 15.10.1582
      If x(2) < 1582 Or ( _
         x(2) = 1582 And ( _
           x(1) < 10 Or _
           x(1) = 10 And x(0) < 15) _
           ) _
      Then
        gregflag = SE_JUL_CAL
      Else
        gregflag = SE_GREG_CAL
      End If
    End If
  End If
      
  JulianDayNumber = swe_julday(x(2), x(1), x(0), time, gregflag)

End Function

Public Function calendarDate(jd As Double, Optional iCalFlag As Long = -1) As String

   Dim day As Long, month As Long, year As Long
   Dim hour As Double

   Dim calflag
   
   If iCalFlag > -1 Then
     calflag = iCalFlag
   Else
     If jd < 2299171 Then
       calflag = SE_JUL_CAL
     Else
       calflag = SE_GREG_CAL
     End If
   End If
   
   Call swe_revjul(jd, calflag, year, month, day, hour)

   calendarDate = day & "." & month & "." & year

End Function

' Compute Julian Day Number in Ephemeris Time from calendar date in UT
Public Function jd_from_date_ut(caldate As String, ut As String) As Double
Dim x As Variant

Dim t As Double

If caldate = "" Then
  jd_from_date_ut = 0
  Exit Function
End If

t = time_to_double(ut)

' Compute Day number from date string and time as double
jd_from_date_ut = JulianDayNumber(caldate, t)

If jd_from_date_ut <> 0 Then
' Correct with Delta T
  jd_from_date_ut = jd_from_date_ut + swe_deltat(jd_from_date_ut)
End If

End Function

' Parse a time string with hours, minutes and seconds into a double number representing the hours
Public Function time_to_double(time As String) As Double

Dim y As Variant, z As Variant, z1 As Variant
Dim h As Long, m As Long, s As Long

If time = "" Then
  time_to_double = 0
  Exit Function
End If

y = Split(time, "h")
h = y(0)
If y(1) = "" Then
  m = 0
  s = 0
Else
  z = Split(y(1), "m")
  m = z(0)
  If UBound(z) = 0 Then
    s = 0
  ElseIf z(1) = "" Then
    s = 0
  Else
    z1 = Split(z(1), "s")
    s = z1(0)
  End If
End If

time_to_double = h + m / 60 + s / 3600

End Function

Function time_from_jd(jd As Double) As String
  time_from_jd = Hms((jd + 0.5 - Int(jd + 0.5)) * 24)
End Function

Function time_from_jd_no_round(jd As Double) As String
  time_from_jd_no_round = Hms((jd + 0.5 - Int(jd + 0.5)) * 24, False)
End Function

Function ut_from_jd(jd_et As Double) As String
  ut_from_jd = time_from_jd(jd_et - swe_deltat(jd_et))
End Function