Перейти на 'Главную страницу' Доска объявлений
  Харьков Форум > Хобби > 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.



tosol вне форума   Ответить с цитированием   Вверх
Старый 10.03.2005, 13:13   #2
CryBaby
Неактивен

 
 
Регистрация: 23.01.2004
Сообщений: 4,275
 
kick 127.0.0.1


CryBaby вне форума   Ответить с цитированием   Вверх
Старый 10.03.2005, 17:16   #3
Witcher
  

 
Регистрация: 27.09.2004
Сообщений: 4,214
 
И что это???


__________________
La garde meurt et ne se rend pas!

Лапочка
Witcher вне форума   Ответить с цитированием   Вверх
Старый 10.03.2005, 18:00   #4
Drema
Неактивен

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


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


tosol вне форума   Ответить с цитированием   Вверх
Старый 14.03.2005, 10:20   #6
Graf
  

 
 
Регистрация: 13.08.2004
Адрес: val 13
Сообщений: 1,939
 
нах?


Graf вне форума   Ответить с цитированием   Вверх
Старый 14.03.2005, 11:01   #7
XGodeksX
Модератор

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

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

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


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


tosol вне форума   Ответить с цитированием   Вверх
Старый 14.03.2005, 14:43   #9
Drema
Неактивен

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


Drema вне форума   Ответить с цитированием   Вверх
Старый 14.03.2005, 14:54   #10
tosol
Неактивен
Автор темы
 
 
Регистрация: 8.03.2005
Адрес: Mars
Сообщений: 536
 
Прога что выше нифига не моделирует, там все постоянно.
А стоило бы. лень писать. Еще чтобы не разлетались.


tosol вне форума   Ответить с цитированием   Вверх

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

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

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

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


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


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