Советы по Delphi. Версия 1.0.6

Озеров Валентин

 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?

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

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$="В этот день солнце не заходит"