Attribute VB_Name = "Maikelson"
Option Explicit
Public Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, _
       ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
'Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Public Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'Public Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long

Public Const WM_CLOSE = &H10 '                  для PostMessage

Public Const HWND_NOTOPMOST = -2  '             для SetWindowPos
Public Const HWND_TOPMOST = -1 '    установка окна поверх других окон
Public Const SWP_NOACTIVATE = &H10
Public Const SWP_NOMOVE = &H2
Public Const SWP_NOSIZE = &H1
'                                               это константы для копирования изображений в картинках
Public Const SRCCOPY = &HCC0020 '   Точное копирование исходного изображения (получатель = источник).
Public Const SRCAND = &H8800C6  '   Логическое И двух номеров цвета ( источник And получатель).
Public Const SRCERASE = &H440328 '  Логическое And исходного изображения и двоичная инверсия получателя(получатель = источник And (Не получатель).
Public Const SRCINVERT = &H660046 ' Логическое Xor двух номеров цвета (получатель = источник Xor получатель).
Public Const SRCPAINT = &HEE0086  ' Логическое Or этих двух номеров цвета (получатель = источник Or получатель).
'Public Const NOTSRCERASE = &H1100A6
'Public Const NOTSRCCOPY = &H330008
'Public Const PATCOPY = &HF00021
'Public Const MERGECOPY = &HC000CA

'                   ЭТО ПЕРЕМЕННЫЕ ИЗ ПРОГРАММЫ Dopler5 И СЕЙЧАС НАДО ИХ ОСНОВАТЕЛЬНО ПОЧИСТИТЬ
Public An#()  '     угол между лучом зрения с источника на приемник и осью X или скоростью и осью Х
Public Alfa#, AlfaZ# '                                  вспомогательный угол и угол наклона движущегося зеркала
Public Alfa1#, Alfa2#, Alfa3#, Alfa4#, Alfa5#, AlfaISO# '  'углы наклона зеркал и скорости ИСО
Public a#, b#, c#  '      вспомогательные переменные
Public Betta# '           вспомогательный угол
Public dT#, dL#, DV# '    разность времени распространения сигнала от источника до экрана и dL (можно заменить) и диаметр луча лазера
Public dX#, dY#, DZ# '    разность координат приемника и источника
Public E# '               фиктивное время и масштаб в отчетах
Public G#, G1#, G2# '                       релятивистские множители
Public Info$, Info1$, Info2$, i&, j&, ii&, jj&, iii&, jjj&, h1# '                                           переменные и высота
Public kUgol#, kE#, kP0# '                  коэффициенты перевода из градусов в радины и из электронвольт в джоули и уменьшения шага решения
Public Kyn&, kodEnd&, kodR&, kod%(2230), kk&, kkk& '      коды да-нет и остановки и прихода сигнала и номера участков
Public kodVY%(20), kodVX1%, kodVX2%, k#   ' коды скоростей и коэффициент
Public L0#, L00# '                          исходная длина волны для расчета смещения линии
Public ML#, Mv1#, MK#  '                    масштаб линейный и частоты и коэффициент для формата данных
Public m#, m1#, m2#   '                     ширина полос и m - масса Солнца
Public MT#, MF#  '                          масштаб времени и масштабный коэффициент = 1000*MK
Public NC&, NC0&, N&, Nn&, Nk& '            номер цикла решения и номера
Public NP&, Nv#(30)  '                      номера и количество колебаний света на участках пути
Public Nv0# '                               число полос при интерференции
Public N0# '                                количество колебаний света на которое будет отставать 2-ой фронт при моделировании эффекта Доплера
Public pi#, P#, P21#(), P0#, P00#, pp%, ppp%  '   пи и плотность и шаг решения и номера участков
Public Q1#, Q2#, Q12#, Q3#, Q31#, Q32# '    различные углы
Public R0#, R# '                                                 расстояния между точкой и линией
Public T1#, T2# '                                                время распространения сигнала
Public T#, T0#   '                                               время текущее и начала движения 2-го фронта волны
Public Tn1#(4300), Tn2#(4300), Tk1#(4300), Tk2#(4300), TT#(130) 'время начала и конца фиксации сигналов условного периода и его наблюдаемое значение
Public v1#(200), v1n#(20), v1k#(30)  '                            частота света в лучах
Public Ve1#, Ve2# '                         суммарная скорость солнечных зайчиков
Public Vmax#, Vsum# '                       Vsum# суммарная энергия света на экране (можно убрать)
Public V#(2300), V12#, V21#     '           скорости лучей и скорости сближения луча и поверхности
Public v0#, v00#, v11# '                    частота передатчиков реальная и расчетная для приемника
Public Vsv#, Vs0#, Vs#, Vs1#(20), Vs2#(30) ' скорость света и скорость сигнала и скорость сигнала в среде
Public w1#, w7#, w71# '                                                ширина зеркал и длинна цилиндра и суммарная толщина стенок цилиндра
Public Xn2#(30), Yn2#(30), Xk2#(30), Yk2#(30), Xn1#(20), Yn1#(20), Xk1#(20), Yk1#(20) ' координаты источника и приемника
Public X21#(), Y21#(), X22#(), Y22#()  '                                           координаты конца луча
Public VX21#(33), VY21#(33), VX22#(33), VY22#(33), VZ21#(33), VXs#(24), VYs#(24) ' скорости 1-го и 2-го лучей для разных участков траектории
Public X#(130), Y#(130), Z#(122) '                                   координаты источника и приемника или двух зайчиков
Public Xs#(20, 29), Ys#(20, 29), Xold#(20, 22), Yold#(20, 22) '      координаты фронтов плоской волны
Public Q#(13), W#(43), O#(13), C1#(13), C2#(13), C3#(13), C4#(13) '  переменные для движения масс по 3-м координатам в методе Рунге-Кутта
Public Q1aso#, Q2aso#
Public VX1iso#, VX2iso#, VY1iso#, VY2iso#, Q1iso#, Q2iso#
Public VXiso#, VXiso3#, VYiso#, VYiso3#
Public X1aso#, X2aso#, Y1aso#, Y2aso# '
Public X1iso#, X2iso#, Y1iso#, Y2iso#

'       А ЭТО ВСЕ ИЗ ПРОГРАММЫ Solsys7 ДЛЯ 1-ой ФОРМЫ ПРОГРАММЫ Maikelson (надо будет упростить расчет, а часть кода и переменных удалить)
Public AlfaL0#(13), AlfaP0#(13), AlfaU0#(13), AlfaM0#(13)
Public Betta0#(13), Betta2000#, Betta1#
Public dUgolE#
Public HourNewDay# '                         время отсчета нового дня (от 0 или 12 часов)
Public JD#, JDut#, JD0#, JD02# ' текущее JD, JD по UT, начальное JD по UT для анимации
Public JDet1#, J1900#, J2000# '                       JD по эфемеридному времени для планет и Земли
Public IGold&, IMold&, IDold# '                       год месяц и день при предыдущем шаге
Public IGnew&, IMnew&, IDnew# '                       год месяц и день после DMY_DMY или JD_DMY
Public IDk&(3, 13), IDay# ', IGk& '                   конечный день месяца и год работы программы
Public IHour# '                                       часы для отправки в таблицы
Public Eks0#(13)
Public GeoL#(38), GeoB#(38), GMST#
Public kodDMY% '                        код используемого календаря 0- Григорианский, 1- Юлианский, 2- Египетский
Public Lae#  '                                                    астрономическая единица
Public ObsL#, ObsB#, ObsLMST#
Public Rae#(13), R0sr#(13), Rsr#(13)
Public sekS#, sekG# '                                             количество секунд в сутках и году
Public TAU#, TextHour!, TextMin!, TextSek! '                      часовой угол и текст часов, минут и секунд
Public UgolE#, UgolE0#(100) '                                     эксцентрическая аномалия конечная и промежуточная при итерациях
Public UgolV#(13), UgolU#(13) '                                   истинная аномалия и аргумент широты на 1-ой форме и 7-ой
Public UgolPA# '                                                  прецессия
Public X0#(89), Y0#(89), Z0#(29)
Public hPic&, wPic&


Public Function ArcSinus(ByVal b As Double) As Double ' функция арксинуса для расчета угла в радианах
ArcSinus = Atn(b / (1 - b * b) ^ 0.5)
End Function

Public Function ArcTangensR(ByVal dX As Double, ByVal dY As Double) As Double ' функция арктангенса для расчета угла в радианах
Alfa = pi / 2: If dY < 0 Then Alfa = 3 * pi / 2
If dX = 0 Then GoTo 180
Alfa = Atn(dY / dX)
If dX >= 0 Then GoTo 120 '              переход в 1-ю и 4-ю четверти
Alfa = Alfa + pi: GoTo 180 '            2-я и 3-я четверти (во 2-ой четверти Alfa был с минусом)
120:  If dY >= 0 Then GoTo 180 '        значит 1-я четверть
Alfa = Alfa + 2 * pi '                  4-я четверть Alfa был с минусом
180: ArcTangensR = Alfa '               возвращает значение угла в радианах
If dX = 0 And dY = 0 Then ArcTangensR = 0
End Function

Public Function DMY_JD(ByVal Day As Double, ByVal Month As Long, ByVal Year As Long) As Double
'                                               расчет юлианской даты JD по календарной дате для разных календарей
Dim d0%, m0%, g0%, i0% '                        ID, IM, IG не используем, чтобы не сбить их для таблиц EXCEL (в Solsys)
On Error GoTo 330
If kodDMY = 2 Then GoTo 70 '                    если Египетский календарь
Day = Day + HourNewDay / 24 '                   если время задано от 12 часов дня, то +0.5, т.к. формулы для Юлианского и
d0 = 0: g0 = Year: m0 = Month  '                Григорианского календарей составлены для расчета при времени заданном от 0 часов
UgolE = Year + Month / 100 + Day / 10000 '      это для сравнения с 1582 годом 10-ым месяцем 15-ым числом
If m0 < 3 Then '                                если надо анализировать февраль, то анализируем предыдущий год
g0 = g0 - 1: m0 = m0 + 12
End If '                                        добавляем 1 день в каждом 4-м (високосном) году

If kodDMY = 0 Then  ' если Григорианский календарь, то надо вычесть високосные дни каждого столетия и прибавить для каждого 4-го столетия
i0 = Fix(g0 / 100)  '                           количество прошедших столетий от начала нашей эры
If UgolE > 1582.101499 Then d0 = 2 - i0 + Fix(i0 / 4)
End If

k = Fix(365.25 * g0): If g0 < 0 Then k = Fix(365.25 * g0 - 0.75)
DMY_JD = k + Fix(30.6001 * (m0 + 1)) + Day + 1720994.5 + d0
GoTo 350
70: '                                       если Альмагест то по египетскому календарю и - 0.5 + HourNewDay / 24, если время задано от
'                                           0 часов дня, а не от 12, 'т.к. формулы составлены для расчета при времени заданном от 12 часов
DMY_JD = 1448272 + Year * 365 + (Month - 1) * 30 + Day - 0.5 + HourNewDay / 24
GoTo 350
330: MsgBox "Введите правильно дату", , "Solsys7.0": kodEnd = 1
350: End Function

Public Sub JD_DMY(JDdmg As Double) '                         перевод Юлианской даты JD в календарную
Dim JDa&, JDb&, JDc&, JDd&, JDi%, JDz&, JDaa&, JDf#
On Error GoTo 330
If kodDMY = 2 Then GoTo 150 'если Египетский календарь JD по определению задается от 12 часов, а формулы составлены для расчета при времени
JDz = Int(JDdmg + 0.5): JDf = JDdmg + 0.5 - JDz: JDa = JDz '                                                            заданном от 0 часов
If kodDMY = 1 Then GoTo 50 '                                 если Юлианский календарь
If JDz >= 2299161 Then '                                     это если дата после 4.10.1582 года по старому стилю
JDaa = Int((JDz - 1867216.25) / 36524.25) '                  11 дней
JDa = JDa + 1 + JDaa - (JDaa \ 4)
End If
50: JDb = JDa + 1524
JDc = Int((JDb - 122.1) / 365.25): JDd = Int(365.25 * JDc)
JDi = Int((JDb - JDd) / 30.6001)
IDnew = JDb - JDd - Int(30.6001 * JDi) + JDf - HourNewDay / 24 'если время от 12 часов дня
IMnew = JDi - 13: If JDi < 13.5 Then IMnew = JDi - 1
IGnew = JDc - 4715: If IMnew > 2.5 Then IGnew = JDc - 4716
GoTo 350
150: 'если Египетский календарь (Альмагест) и если время задано от 12 часов дня, то HourNewDay =0, а если от 0 часов ночи, то надо отнять
JDdmg = JDdmg + 0.5 - HourNewDay / 24 '                                                                              от JD HourNewDay =12
IGnew = Fix((JDdmg - 1448272) / 365)

IMnew = Fix((JDdmg - 1448272 - IGnew * 365) / 30) + 1
If IMnew = 13 Then IMnew = 12 '                             Fix((JDdmg - 1448272 - IGnew * 365) / 35) + 1
IDnew = JDdmg - 1448272 - IGnew * 365 - (IMnew - 1) * 30
GoTo 350
330: MsgBox "Введите правильно юлианскую дату", , "Solsys7.0": kodEnd = 1
350: End Sub

Public Function ETminusUT1() As Double
'This formula was derived from observations since AD 1650 by Spencer JONES (1939) and Gerald M.CLEMENCE (1948), officially accepted
T1 = (JD - J1900) / 36525# '                        by the International Astronomical Union in 1952 en slightly corrected in 1960.
ETminusUT1 = 24.35 + 72.32 * T1 + 29.95 * T1 * T1
End Function

Public Sub HourMin(IDay_LT As Double) '                  переводим дробную часть дня в часы, минуты и секунды
TextHour = (IDay_LT - Fix(IDay_LT)) * 24
TextMin = Fix((TextHour - Fix(TextHour)) * 60)
TextSek = Fix((TextHour - Fix(TextHour) - TextMin / 60) * 3600) ' время в часах умножаем на 3600 секунд
TextHour = Fix(TextHour)
End Sub

Public Sub RasParamJPL0() '               РАСЧЕТ ПАРАМЕТРОВ JPL ДЛЯ БАРИЦЕНТРА ЗЕМЛЯ-ЛУНА ДЛЯ СРЕДНЕЙ ЭКЛИПТИКИ J2000
Lae = 149597870691#: dT = (JD - J2000) / 36525
'Здесь приводится расчет средних элементов орбит, т.е. без периодических возмущений, по данным JPL для
'интервала с 1800 по 2050 годы, которые они приводят в таблице1 http://ssd.jpl.nasa.gov/txt/p_elem_t1.txt
       Rae(3) = 1.00000261 + 0.00000562 * dT: R0sr(3) = Rae(3) * Lae
       Eks0(3) = 0.01671123 - 0.00004392 * dT:
       Betta0(3) = (-0.00001531 - 0.01294668 * dT) / kUgol
       AlfaL0(3) = (100.46457166 + 35999.37244981 * dT) / kUgol
       AlfaP0(3) = (102.93768193 + 0.32327364 * dT) / kUgol
       AlfaU0(3) = (-5.11260389 - 0.24123856 * dT) / kUgol '    по теории JPL от -3000 до 3000
'      W0sr(3) = 35999.37245 / kUgol / 100 / sekG
End Sub

Public Sub RasKoordinat() '           расчет эклиптических ГЕЛИО центрических координат без периодических возмущений
AlfaM0(i) = FRAC2(AlfaL0(i) / 2 / pi) * 2 * pi - AlfaP0(i)
dUgolE = 1 * 10 ^ -10 '                                                   производить итерации до этой точности
If AlfaM0(i) < 0 Then AlfaM0(i) = AlfaM0(i) + 2 * pi
UgolE0(0) = AlfaM0(i)
    For j = 1 To 99
    UgolE0(j) = AlfaM0(i) + Eks0(i) * Sin(UgolE0(j - 1))
    If Abs(UgolE0(j - 1) - UgolE0(j)) > dUgolE Then GoTo 100
    UgolE = UgolE0(j): j = 100 '                                          эксцентрическая аномалия
100: Next j

UgolV(i) = 2 * Atn(Sqr((1 + Eks0(i)) / (1 - Eks0(i))) * Tan(UgolE / 2)) ' истинная аномалия
Rsr(i) = R0sr(i) * (1 - Eks0(i) * Eks0(i)) / (1 + Eks0(i) * Cos(UgolV(i)))
UgolU(i) = UgolV(i) + AlfaP0(i) - AlfaU0(i) '                             аргумент широты
X(i) = Rsr(i) * (Cos(UgolU(i)) * Cos(AlfaU0(i)) - Sin(UgolU(i)) * Sin(AlfaU0(i)) * Cos(Betta0(i)))
Y(i) = Rsr(i) * (Cos(UgolU(i)) * Sin(AlfaU0(i)) + Sin(UgolU(i)) * Cos(AlfaU0(i)) * Cos(Betta0(i)))
Z(i) = Rsr(i) * Sin(UgolU(i)) * Sin(Betta0(i))
End Sub

Public Function FRAC2(X As Double) As Double '            любой остаток положительный (в единицах)
X = X - Fix(X) '                       fix(-5.2)=-5  int(-5.2)=-6
If X < 0 Then X = X + 1
FRAC2 = X
End Function

Public Function LMST(MJD As Double) As Double '            local mean sidereal time
T2 = (MJD - Fix(MJD)) * 24: T1 = (Fix(MJD) - 51544.5) / 36525
LMST = 6.697374558 + 1.0027379093 * T2 + (8640184.812866 + (0.093104 - 0.0000062 * T1) * T1) * T1 / 3600# ' часов
End Function

Public Sub XYZ(ByVal i As Integer, A12 As Double, B12 As Double, R12 As Double) ' расчет координат по углам заданным в градусах
X(i) = R12 * Cos(B12 / kUgol) * Cos(A12 / kUgol)
Y(i) = R12 * Cos(B12 / kUgol) * Sin(A12 / kUgol)
Z(i) = R12 * Sin(B12 / kUgol) '                                                   возвращает X, Y, Z в метрах
End Sub

Public Sub AlfaBetta(ByVal k As Integer, ByVal i As Integer) 'для расчета по координатам углов где K-центр системы, а I-объект
'                                                             возвращает Alfa и Betta в градусах и Rsr в метрах
dX = X(i) - X(k): dY = Y(i) - Y(k): DZ = Z(i) - Z(k)
R0 = Sqr(dX * dX + dY * dY) '            расстояние от Земли до Солнца в плоскости X Y
Rsr(13) = Sqr(R0 * R0 + DZ * DZ) '       полное расстояние от Земли до Солнца
Alfa = 90: If dY < 0 Then Alfa = 270
If dX = 0 Then GoTo 180
Alfa = Atn(dY / dX) * kUgol '           переводим угол в градусы от 0 до 360
If dX >= 0 Then GoTo 120 '              переход в 1-ю и 4-ю четверти
Alfa = Alfa + 180: GoTo 180 '           2-я и 3-я четверти (во 2-ой четверти AlfaGR(I) был с минусом)
120: If dY >= 0 Then GoTo 180 '         значит 1-я четверть
Alfa = Alfa + 360 '                     4-я четверть AlfaGR(I) был с минусом
180: Betta = Atn(DZ / R0) * kUgol '     переводим угол в градусы (+/- 90)
End Sub

Public Sub EQUECL(T12 As Double) '       переводим в одной эпохе средние прямоугольные ЭКВаториальные координаты в ЭКЛиптические
Betta1 = (23.43929111 - (46.815 + (0.00059 - 0.001813 * T12) * T12) * T12 / 3600) / kUgol
X(37) = Y(i) * Cos(Betta1) + Z(i) * Sin(Betta1) '            Betta1 в радианах
Z(i) = Z(i) * Cos(Betta1) - Y(i) * Sin(Betta1)  '            X(i)=X(i)  по определению
Y(i) = X(37)
End Sub
