Харьков Форум
  Харьков Форум > Хобби > LOL

Старый 10.03.2005, 12:47   #1
tosol

 
 
Регистрация: 8.03.2005
Адрес: Mars
Сообщений: 536
 
Ржунимагу pascal rulez

unit main;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs,IniFiles,StdCtrls;

type TSun = class(TForm)
GroupBoxInput: TGroupBox;
LabelLongitude: TLabel;
EditB5: TEdit;
EditL5: TEdit;
LabelTimeZone: TLabel;
EditH: TEdit;
GroupBoxCalendar: TGroupBox;
LabelD: TLabel;
LabelM: TLabel;
LabelY: TLabel;
EditD: TEdit;
EditM: TEdit;
EditY: TEdit;
ListBox: TListBox;
LabelAtitude: TLabel;
Button1: TButton;
procedure Calendar; // Календарь
procedure GetTimeZone; // Получение часового пояса
procedure PosOfSun; // Получаем положение солнца
procedure OutInform; // Процедура вывода информации
procedure PossibleEvents(Hour: integer); // Возможные события на полученный час
procedure GetDate; //Получить значения даты
procedure GetInput; //Получить значения широты,...
procedure CreateForm(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure RunProgram(FileName:string);
procedure Button1Click(Sender: TObject);
private
function Sgn(Value: Double): integer;
public
{ Public declarations }
end;

var

Sun: TSun;
st: string;
aA, aD: array [1 .. 2] of double;
B5: integer;
L5: double;
H: integer;
Z, Z0, Z1: double;
D: double;
M, Y: integer;
A5, D5, R5: double;
J3: integer;
T, T0, TT, T3: double;
L0, L2: double;
H0, H1, H2, H7, N7, D7: double;
H3, M3: integer;
M8, W8: double;
A, B, A0, D0, A2, D1, D2, DA, DD: double;
E, F, J, S, C, P, L, G, V, U, W: double;
V0, V1, V2: double;
C0: integer;
AZ: double;
config: Tinifile;

const

P2 = Pi * 2; // 2 * Pi
DR = Pi / 180; // Радиан на градус
K1 = 15 * DR * 1.0027379;

implementation

{$R *.DFM}

function TSun.Sgn(Value: Double): integer;
begin

{if Value = 0 then} Result := 0;
if Value > 0 then Result := 1;
if Value < 0 then Result := -1;
end;

procedure TSun.Calendar;
begin

G := 1;
if Y < 1583 then G := 0;
D1 := Trunc(D);
F := D - D1 - 0.5;
J := -Trunc(7 * (Trunc((M + 9) / 12) + Y) / 4);
if G = 1 then
begin
S := Sgn(M - 9);
A := Abs(M - 9);
J3 := Trunc(Y + S * Trunc(A / 7));
J3 := -Trunc((Trunc(J3 / 100) + 1) * 3 / 4);
end;
J := J + Trunc(275 * M / 9) + D1 + G * J3;
J := J + 1721027 + 2 * G + 367 * Y;
if F >= 0 then Exit;
F := F + 1;
J := J - 1;
end;

procedure TSun.GetTimeZone;
begin

T0 := T / 36525;
S := 24110.5 + 8640184.813 * T0;
S := S + 86636.6 * Z0 + 86400 * L5;
S := S / 86400;
S := S - Trunc(S);
T0 := S * 360 * DR;
end;

procedure TSun.PosOfSun;
begin

// Фундаментальные константы
// (Van Flandern & Pulkkinen, 1979)
L := 0.779072 + 0.00273790931 * T;
G := 0.993126 + 0.0027377785 * T;
L := L - Trunc(L);
G := G - Trunc(G);
L := L * P2;
G := G * P2;
V := 0.39785 * Sin(L);
V := V - 0.01000 * Sin(L - G);
V := V + 0.00333 * Sin(L + G);
V := V - 0.00021 * TT * Sin(L);
U := 1 - 0.03349 * Cos(G);
U := U - 0.00014 * Cos(2 * L);
U := U + 0.00008 * Cos(L);
W := -0.00010 - 0.04129 * Sin(2 * L);
W := W + 0.03211 * Sin(G);
W := W + 0.00104 * Sin(2 * L - G);
W := W - 0.00035 * Sin(2 * L + G);
W := W - 0.00008 * TT * Sin(G);


// Вычисление солнечных координат
S := W / Sqrt(U - V * V);
A5 := L + ArcTan(S / Sqrt(1 - S * S));
S := V / Sqrt(U);
D5 := ArcTan(S / Sqrt(1 - S * S));
R5 := 1.00021 * Sqrt(U);
end;

procedure TSun.PossibleEvents(Hour: integer);
var num: string;
begin

st := '';
L0 := T0 + Hour * K1;
L2 := L0 + K1;
H0 := L0 - A0;
H2 := L2 - A2;
H1 := (H2 + H0) / 2; // Часовой угол,
D1 := (D2 + D0) / 2; // наклон в получасе
if Hour <= 0 then
V0 := S * Sin(D0) + C * Cos(D0) * Cos(H0) - Z;
V2 := S * Sin(D2) + C * Cos(D2) * Cos(H2) - Z;
if Sgn(V0) = Sgn(V2) then Exit;
V1 := S * Sin(D1) + C * Cos(D1) * Cos(H1) - Z;
A := 2 * V2 - 4 * V1 + 2 * V0;
B := 4 * V1 - 3 * V0 - V2;
D := B * B - 4 * A * V0;
if D < 0 then Exit;
D := Sqrt(D);
if (V0 < 0) and (V2 > 0) then st := st + 'Восход солнца в ';
if (V0 < 0) and (V2 > 0) then M8 := 1;
if (V0 > 0) and (V2 < 0) then st := st + 'Заход солнца в ';
if (V0 > 0) and (V2 < 0) then W8 := 1;
E := (-B + D) / (2 * A);
if (E > 1) or (E < 0) then E := (-B - D) / (2 * A);
T3 := Hour + E + 1 / 120; // Округление
H3 := Trunc(T3);
M3 := Trunc((T3 - H3) * 60);
Str(H3:2, num);
st := st + num + ':';
Str(M3:2, num);
st := st + num;
H7 := H0 + E * (H2 - H0);
N7 := -Cos(D1) * Sin(H7);
D7 := C * Sin(D1) - S * Cos(D1) * COS(H7);
AZ := ArcTan(N7 / D7) / DR;
if (D7 < 0) then AZ := AZ + 180;
if (AZ < 0) then AZ := AZ + 360;
if (AZ > 360) then AZ := AZ - 360;
Str(AZ:4:1, num);
st := st + ', азимут ' + num;
end;

procedure TSun.OutInform;
begin

if (M8 = 0) and (W8 = 0) then
begin
if V2 < 0 then ListBox.Items.Add('Солнце заходит весь день ');
if V2 > 0 then ListBox.Items.Add('Солнце восходит весь день ');
end
else
begin
if M8 = 0 then ListBox.Items.Add('В этот день солнце не восходит ');
if W8 = 0 then ListBox.Items.Add('В этот день солнце не заходит ');
end;
end;

procedure TSun.GetDate;
begin

D := StrToInt(EditD.text);
M := StrToInt(EditM.text);
Y := StrToInt(EditY.text);
end;

procedure TSun.GetInput;
begin

B5 := StrToInt(EditB5.Text);
L5 := StrToInt(EditL5.Text);
H := StrToInt(EditH.Text);
end;


procedure TSun.CreateForm(Sender: TObject);
var C0: integer;
begin
config := TIniFile.Create(ExtractFilePath(Application.ExeName)+'config.txt');
EditB5.text := config.ReadString('main', 'long', '0');
Editl5.text := config.ReadString('main', 'ampl', '0');
EditH.text := config.ReadString('main', 'hour', '0');
EditD.Text := FormatDateTime('d', Date);
EditM.Text := FormatDateTime('m', Date);
EditY.Text := FormatDateTime('yyyy', Date);
GetDate;
GetInput;
ListBox.Items.Add('Широта: ' + EditB5.Text +
' Долгота: ' + EditL5.Text +
' Зона: ' + EditH.Text +
' Дата: ' + EditD.Text +
'/' + EditM.Text +
'/' + EditY.Text);
L5 := L5 / 360;
Z0 := H / 24;
Calendar;
T := (J - 2451545) + F;
TT := T / 36525 + 1; // TT - столетия, начиная с 1900.0
GetTimeZone; // Получение часового пояса
T := T + Z0;
PosOfSun; // Получаем положение солнца
aA[1] := A5;
aD[1] := D5;
T := T + 1;
PosOfSun;
aA[2] := A5;
aD[2] := D5;
if aA[2] < aA[1] then aA[2] := aA[2] + P2;
Z1 := DR * 90.833; // Вычисление зенита
S := Sin(B5 * DR);
C := Cos(B5 * DR);
Z := Cos(Z1);
M8 := 0;
W8 := 0;
A0 := aA[1];
D0 := aD[1];
DA := aA[2] - aA[1];
DD := aD[2] - aD[1];
for C0 := 0 to 23 do
begin
P := (C0 + 1) / 24;
A2 := aA[1] + P * DA;
D2 := aD[1] + P * DD;
PossibleEvents(C0);
if st <> '' then ListBox.Items.Add(st);
A0 := A2;
D0 := D2;
V0 := V2;
end;
OutInform;
ListBox.Items.Add(''); // Разделяем данные
ListBox.Items.SaveToFile('DATA.TXT');
end;

procedure TSun.FormClose(Sender: TObject; var Action: TCloseAction);
begin
config := TIniFile.Create(ExtractFilePath(Application.ExeName)+'config');
config.WriteString('main', 'long', EditB5.text);
config.WriteString('main', 'ampl', Editl5.text);
config.WriteString('main', 'hour', EditH.text);
end;

procedure TSun.RunProgram(FileName:string);
var
PI:TProcessInformation;
SI:TStartupInfo;
const
dwFlagsword=CREATE_NEW_PROCESS_GROUP or CREATE_DEFAULT_ERROR_MODE;
begin
FillChar(si,sizeof(si),0);
fillchar(pi,sizeof(pi),0);
with si do
begin
cb:=sizeof(si);
dwFlags:=STARTF_USESHOWWINDOW;
wShowWindow:=SW_SHOWDEFAULT;
end;
CreateProcess(nil,PChar(FileName),nil,nil,false,dwFlags,nil,nil,SI,PI) ;
closehandle(pi.hThread);
closehandle(pi.hProcess);
end;


procedure TSun.Button1Click(Sender: TObject);
var C0: integer;
begin
config := TIniFile.Create(ExtractFilePath(Application.ExeName)+'config');
EditB5.text := config.ReadString('main', 'long', '0');
Editl5.text := config.ReadString('main', 'ampl', '0');
EditH.text := config.ReadString('main', 'hour', '0');
EditD.Text := FormatDateTime('d', Date);
EditM.Text := FormatDateTime('m', Date);
EditY.Text := FormatDateTime('yyyy', Date);
GetDate;
GetInput;
ListBox.Items.Add('Широта: ' + EditB5.Text +
' Долгота: ' + EditL5.Text +
' Зона: ' + EditH.Text +
' Дата: ' + EditD.Text +
'/' + EditM.Text +
'/' + EditY.Text);
L5 := L5 / 360;
Z0 := H / 24;
Calendar;
T := (J - 2451545) + F;
TT := T / 36525 + 1; // TT - столетия, начиная с 1900.0
GetTimeZone; // Получение часового пояса
T := T + Z0;
PosOfSun; // Получаем положение солнца
aA[1] := A5;
aD[1] := D5;
T := T + 1;
PosOfSun;
aA[2] := A5;
aD[2] := D5;
if aA[2] < aA[1] then aA[2] := aA[2] + P2;
Z1 := DR * 90.833; // Вычисление зенита
S := Sin(B5 * DR);
C := Cos(B5 * DR);
Z := Cos(Z1);
M8 := 0;
W8 := 0;
A0 := aA[1];
D0 := aD[1];
DA := aA[2] - aA[1];
DD := aD[2] - aD[1];
for C0 := 0 to 23 do
begin
P := (C0 + 1) / 24;
A2 := aA[1] + P * DA;
D2 := aD[1] + P * DD;
PossibleEvents(C0);
if st <> '' then ListBox.Items.Add(st);
A0 := A2;
D0 := D2;
V0 := V2;
end;
OutInform;
ListBox.Items.Add(''); // Разделяем данные
end;

end.



    Вверх
Старый 10.03.2005, 13:13   #2
CryBaby


 
 
Регистрация: 23.01.2004
Сообщений: 4,232
 
По умолчанию
kick 127.0.0.1


__________________
Я хороший, меня можно любить... (с) Евгений Гришковец http://www.cosgan.de/images/smilie/engel/a010.gif
    Вверх
Старый 10.03.2005, 17:16   #3
Witcher


 
Регистрация: 27.09.2004
Сообщений: 4,046
 
По умолчанию
И что это???


__________________
La garde meurt et ne se rend pas!

Лапочка
    Вверх
Старый 10.03.2005, 18:00   #4
Drema


 
 
Регистрация: 6.09.2003
Адрес: Kharkov
Сообщений: 5,394
 
По умолчанию
Может это "программа мира" ? )
(точнее кусок оной, связанный с движением небесных тел)
Остается вопрос: на каком компе эта "программа мира" работает"...


__________________
Иллюстрация общения на ХФ

Правильный гражданин Украины всегда должен отойти, если попросят, отвернуться, если потребуется, не вмешиваться, дабы ничего не вышло, не замечать ради спокойствия, не возмущаться ради стабильности.
    Вверх
Старый 12.03.2005, 18:39   #5
tosol

 
 
Регистрация: 8.03.2005
Адрес: Mars
Сообщений: 536
 
Ржунимагу
Да, есть еще те, кто хоть что-то разобрал тут.
Програмулина определяет позицию Солнца. Работаю над планетами.
А, разработать "программу мира" былоб круто , только проблема - создать AI.
Ну типа жители вселенной. Ну если буз ИИ, то думаю, на каком-нибудь пентагоновском суперкомпе пойдет реально, даже побежит


    Вверх
Старый 14.03.2005, 10:20   #6
Graf


 
 
Регистрация: 13.08.2004
Адрес: val 13
Сообщений: 1,931
 
По умолчанию
нах?


    Вверх
Старый 14.03.2005, 11:01   #7
XGodeksX
Модератор


 
 
Регистрация: 26.01.2005
Адрес: За здоровий глузд
Сообщений: 9,161
 
По умолчанию
нах? нах? нах?

Столь возвышенные проблемы на Украине поднимать бесполезно. Финансирования не хватит

А на счёт паскаля, то такуюже шнягу можно легко забацать на Си или возмём по современнее - на php. В чём тут уникальность паскаля?


__________________
Цитата:
Сообщение от Афигений
Россиянам, чтобы увидеть фашиста, далеко ходить не надо, достаточно посмотреть в зеркало, или в телевизор на Путина, нацисткая пропаганда превосходства русського мира над остальными мирами, сделала из них упоротых нацистов
https://www.youtube.com/watch?v=xL7D2CQw4kY
    Вверх
Старый 14.03.2005, 14:28   #8
tosol

 
 
Регистрация: 8.03.2005
Адрес: Mars
Сообщений: 536
 
По умолчанию
Паскаль-это язык внешнего космоса 8) Его придумали марсиане и направили на Землю, чтобы решить глобальные проблемы.


    Вверх
Старый 14.03.2005, 14:43   #9
Drema


 
 
Регистрация: 6.09.2003
Адрес: Kharkov
Сообщений: 5,394
 
По умолчанию
Я как то тоже на космическую тему писал прогу. Хотел моделировать движение планет (или просто материальных точек с массами между которыми действует сила притяжения). Хреново получалось: сначала все ок, по эллипсу летают, а потом разлетаются...


__________________
Иллюстрация общения на ХФ

Правильный гражданин Украины всегда должен отойти, если попросят, отвернуться, если потребуется, не вмешиваться, дабы ничего не вышло, не замечать ради спокойствия, не возмущаться ради стабильности.
    Вверх
Старый 14.03.2005, 14:54   #10
tosol

 
 
Регистрация: 8.03.2005
Адрес: Mars
Сообщений: 536
 
По умолчанию
Прога что выше нифига не моделирует, там все постоянно.
А стоило бы. лень писать. Еще чтобы не разлетались.


    Вверх

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск

Харьков Форум > Хобби > LOL

Быстрый переход


Часовой пояс GMT +2, время: 05:38.


Харьков Форум Powered by vBulletin® Version 3.8.7
Copyright ©2000 - 2017, Jelsoft Enterprises Ltd.