Валентин Озеров - Советы по Delphi. Версия 1.0.6 Страница 6

 IDateChar:='.,\/';

 for y:=1 to length(IDateChar) do begin

  x:= pos(IDateChar[y],SDate);

  while x>0 do begin

   Delete(SDate,x,1);

   Insert('-',SDate,x);

   x:= pos(IDateChar[y],SDate);

  end;

 end;

 CheckDateFormat:= SDate;

end;

function DateEncode(SDate:string):longint;

var

 year, month, day: longint;

 wy, wm, wd: longint;

 Dummy: TDateTime;

 Check: integer;

begin

 DateEncode:= -1;

 SDate:= CheckDateFormat(SDate);

 Val(Copy(SDate,1,pos('-',SDate)-1),day,check);

 Delete(Sdate,1,pos('-',SDate));

 Val(Copy(SDate,1,pos('-',SDate)-1),month,check);

 Delete(SDate,1,pos('-',SDate));

 Val(SDate,year,check);

 wy:= year;

 wm:= month;

 wd:= day;

 try

  Dummy:= EncodeDate(wy,wm,wd);

 except

  year:= 0;

  month:= 0;

  day:= 0;

 end;

 DateEncode:= (year*10000)+(month*100)+day;

end;

Функция DateSer

Привет, я хочу в качестве совета поделиться функцией DateSer, которую я написал перед этим на VB. Данная функция весьма полезна но, к сожалению, ее нет в Delphi. Применяется она так:

DecodeDate(Date,y,m,d);

NewDate:= DateSer(y-4,m+254,d+1234);

или приблизительно так….

function DateSer(y,m,d: Integer): TDateTime;

const

 mj: array[1..12] of integer=(31,28,31,30,31,30,31,31,30,31,30,31);

var

 add: Integer;

begin

 while (true) do begin

  y:=y+(m-1) div 12;

  m:= (m-1) mod 12 +1;

  if m<=0 then begin

   Inc(m,12);

   Dec(y);

  end;

  if ((y mod 4 = 0) and ((y mod 100<>0) or (y mod 400=0))) and (m=2) then add:=1 //дополнительный день в феврале

  else add:=0;

  if (d>0) and (d<=(mj[m]+add)) then break;

  if d>0 then begin Dec(d,mj[m]+add); Inc(m); end

  else begin Inc(d,mj[m]+add); Dec(m); end;

  end;

 Result:=EncodeDate(y,m,d);

end;

Разное

Ханойская башня

"Ханойская башня" построена на очень простом алгоритме. Здесь я привожу этот алгоритм, который Вы сможете без труда воспроизвести.

type

 THanoiBin = 0..2;

 THanoiLevel = 0..9;

procedure MoveDisc(FromPin, ToPin : THanoiPin; Level : THanoiLevel);

//  Это Вы должны сделать сами. Переместите один диск с одного штырька на другой.

//  Диск окажется наверху (естественно, выше него дисков не будет)

Вы можете каким угодно образом перемещать диски 3-х пирамид. 3 пирамиды – наиболее простая разновидность алгоритма. Таким образом процедура переноса диска (MoveDisc) аналогична операции переноса диска на верхний уровень (MoveTopDisc): переместить диск наверх с одного штырька (FromPin) на другой штырек (ToPin) и передать указатель на штырек-приемник (MoveTower) вместе с уровнем расположения перемещенного диска. Другое решение заключается в использовании трех массивов [THanoiLevel] логического типа. В этом случае триггер "Истина (True)" означает наличие на пирамиде диска с размером, соответствующим порядковому номеру элемента массива THanoiLevel.

procedure MoveTower(FromPin, ToPin : THanoiPin; Level : THanoiLevel);

begin

 if HanoiLevel <= High(THanoiLevel) then begin

  MoveTower(FromPin, 3 – FromPin – ToPin, Level + 1);

  MoveDisc(FromPin, ToPin, Level);

  MoveTower(3 – FromPin – ToPin, ToPin, Level + 1);

 end;

end;

Чтобы переместить пирамиду целиком, вы должны вызвать процедуру MoveTower следующим образом:

MoveTower(0, 1, Low(THanoiLevel));

Алгоритм (уравнение) для определения восхода/захода солнца и луны (BASIC)

Я нашел алгоритм, написанный на BASIC и вычисляющий восход-заход солнца и восход-заход луны. Может кто-нибудь сможет перенести это на Pascal?

(в случае чего сообщите мне по адресу [email protected])

10 ' Восход-заход солнца

20 GOSUB 300

30 INPUT "Долгота (град)";B5,L5

40 INPUT "Часовая зона (час)";H

50 L5=L5/360: Z0=H/24

60 GOSUB 1170: T=(J-2451545)+F

70 TT=T/36525+1: ' TT = столетия,

80 ' начиная с 1900.0

90 GOSUB 410: T=T+Z0

100 '

110 ' Получаем положение солнца

120 GOSUB 910: A(1)=A5: D(1)=D5

130 T=T+1

140 GOSUB 910: A(2)=A5: D(2)=D5

150 IF A(2)<A(1) THEN A(2)=A(2)+P2

160 Z1=DR*90.833: ' Вычисление зенита

170 S=SIN(B5*DR): C=COS(B5*DR)

180 Z=COS(Z1): M8=0: W8=0: PRINT

190 A0=A(1): D0=D(1)

200 DA=A(2)-A(1): DD=D(2)-D(1)

210 FOR C0=0 TO 23

220 P=(C0+1)/24

230 A2=A(1)+P*DA: D2=D(1)+P*DD

240 GOSUB 490

250 A0=A2: D0=D2: V0=V2

260 NEXT

270 GOSUB 820: ' Вывод информации?

280 END

290 '

300 ' Константы

310 DIM A(2),D(2)

320 P1=3.14159265: P2=2*P1

330 DR=P1/180: K1=15*DR*1.0027379

340 S$="Заход солнца в "

350 R$="Восход солнца в "

360 M1$="В этот день солнце не восходит"

370 M2$="В этот день солнце не заходит"

380 M3$="Солнце заходит весь день"

390 M4$="Солнце восходит весь день"

400 RETURN

410 ' Получение часового пояса

420 T0=T/36525

430 S=24110.5+8640184.813*T0

440 S=S+86636.6*Z0+86400*L5

450 S=S/86400: S=S-INT(S)

460 T0=S*360*DR

470 RETURN

480 '

490 ' Просматриваем возможные события на полученный час

500 L0=T0+C0*K1: L2=L0+K1

510 H0=L0-A0: H2=L2-A2

520 H1=(H2+H0)/2: ' Часовой угол,

530 D1=(D2+D0)/2: ' наклон в

540 ' получасе

550 IF C0>0 THEN 570

560 V0=S*SIN(D0)+C*COS(D0)*COS(H0)-Z

570 V2=S*SIN(D2)+C*COS(D2)*COS(H2)-Z

580 IF SGN(V0)=SGN(V2) THEN 800

590 V1=S*SIN(D1)+C*COS(D1)*COS(H1)-Z

600 A=2*V2-4*V1+2*V0: B=4*V1-3*V0-V2

610 D=B*B-4*A*V0: IF D<0 THEN 800

620 D=SQR(D)

630 IF V0<0 AND V2>0 THEN PRINT R$;

640 IF V0<0 AND V2>0 THEN M8=1

650 IF V0>0 AND V2<0 THEN PRINT S$;

660 IF V0>0 AND V2<0 THEN W8=1

670 E=(-B+D)/(2*A)

680 IF E>1 OR E<0 THEN E=(-B-D)/(2*A)

690 T3=C0+E+1/120: ' Округление

700 H3=INT(T3): M3=INT((T3-H3)*60)

710 PRINT USING "##:##";H3;M3;

720 H7=H0+E*(H2-H0)

730 N7=-COS(D1)*SIN(H7)

740 D7=C*SIN(D1)-S*COS(D1)*COS(H7)

750 AZ=ATN(N7/D7)/DR

760 IF D7<0 THEN AZ=AZ+180

770 IF AZ<0 THEN AZ=AZ+360

780 IF AZ>360 THEN AZ=AZ-360

790 PRINT USING ", азимут ###.#";AZ

800 RETURN

810 '

820 ' Процедура вывода информации

830 IF M8=0 AND W8=0 THEN 870

840 IF M8=0 THEN PRINT M1$

850 IF W8=0 THEN PRINT M2$

860 GOTO 890

870 IF V2<0 THEN PRINT M3$

880 IF V2>0 THEN PRINT M4$

890 RETURN

900 '

910 ' Фундаментальные константы

920 ' (Van Flandern &

930 ' Pulkkinen, 1979)

940 L=.779072+.00273790931*T

950 G=.993126+.0027377785*T

960 L=L-INT(L): G=G-INT(G)

970 L=L*P2: G=G*P2

980 V=.39785*SIN(L)

990 V=V-.01000*SIN(L-G)

1000 V=V+.00333*SIN(L+G)

1010 V=V-.00021*TT*SIN(L)

1020 U=1-.03349*COS(G)

1030 U=U-.00014*COS(2*L)

1040 U=U+.00008*COS(L)

1050 W=-.00010-.04129*SIN(2*L)

1060 W=W+.03211*SIN(G)

1070 W=W+.00104*SIN(2*L-G)

1080 W=W-.00035*SIN(2*L+G)

1090 W=W-.00008*TT*SIN(G)

1100 '

1110 ' Вычисление солнечных координат

1120 S=W/SQR(U-V*V)

1130 A5=L+ATN(S/SQR(1-S*S))

1140 S=V/SQR(U):D5=ATN(S/SQR(1-S*S))

1150 R5=1.00021*SQR(U)

1160 RETURN

1165 '

1170 ' Календарь –> JD

1180 INPUT "Год, Месяц, День";Y,M,D

1190 G=1: IF Y<1583 THEN G=0

1200 D1=INT(D): F=D-D1-.5

1210 J=-INT(7*(INT((M+9)/12)+Y)/4)

1220 IF G=0 THEN 1260

1230 S=SGN(M-9): A=ABS(M-9)

1240 J3=INT(Y+S*INT(A/7))

1250 J3=-INT((INT(J3/100)+1)*3/4)

1260 J=J+INT(275*M/9)+D1+G*J3

1270 J=J+1721027+2*G+367*Y

1280 IF F>=0 THEN 1300

1290 F=F+1: J=J-1

1300 RETURN

1310 '

1320 ' Программа вычисляет время восхода и захода

1330 ' солнца по дате (с точностью до минуты) в пределах

1340 ' нескольких текущих столетий. Производит корректировку, если географическая

1350 ' точка находится в арктичиском или антарктическом регионе, где заход или восход солнца

1360 ' на текущую дату может не состояться. Вводимые данные: положительная северная широта и

1370 ' отрицательная западная долгота. Часовой пояс указывается относительно Гринвича

1380 ' (например, 5 для EST и 4 для EDT). Алгоритм обсуждался в

1390 ' "Sky & Telescope" за август 1994, страница 84.

Автоматический формат даты в компоненте Edit

PROCEDURE TForm1.Edit1Exit(Sender: TObject);

BEGIN

 IF Edit1.Text<>'' THEN BEGIN

  TRY

    StrToDate(Edit1.Text);

   EXCEPT

    Edit1.SetFocus;