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

end;

function Date2julian(date : string) : longint;

{Получает дату в формате YYYYMMDD.

Если у вас другой формат, в первую очередь преобразуйте его.}

var

month, day, year:integer;

ta, tb, tc : longint;

begin

month:= strtoint(copy(date,5,2));

day:= strtoint(copy(date,7,2));

year:= strtoint(copy(date,1,4));

if month > 2 then month:= month – 3

else begin

month:= month + 9;

year:= year – 1;

end;

ta:= 146097 * (year div 100) div 4;

tb:= 1461 * (year MOD 100) div 4;

tc:= (153 * month + 2) div 5 + day + 1721119;

result:= ta + tb + tc

end;

function mdy2date(month, day, year : integer): string;

var

y, m, d : string;

begin

y:= '000'+inttostr(year);

y:= copy(y,length(y)-3,4);

m:= '0'+inttostr(month);

m:= copy(m,length(m)-1,2);

d:= '0'+inttostr(day);

d:= copy(d,length(d)-1,2);

result:= y+m+d;

end;

function Julian2date(julian : longint): string;

{Получает значение и возвращает дату в формате YYYYMMDD}

var

x,y,d,m : longint;

month,day,year : integer;

begin

x:= 4 * julian – 6884477;

y:= (x div 146097) * 100;

d:= (x MOD 146097) div 4;

x:= 4 * d + 3;

y:= (x div 1461) + y;

d:= (x MOD 1461) div 4 + 1;

x:= 5 * d – 3;

m:= x div 153 + 1;

d:= (x MOD 153) div 5 + 1;

if m < 11 then month:= m + 2

else month:= m – 10;

day:= d;

year:= y + m div 11;

result:= mdy2date(month, day, year);

end;

function checkdate(date : string): boolean;

{Дата должна быть в формате YYYYMMDD.}

var

julian: longint;

test: string;

begin

{Сначала преобразовываем строку в юлианский формат даты.

Это позволит получить необходимое значение.}

julian:= Date2julian(date);

{Затем преобразовываем полученную величину в дату.

Это всегда будет правильной датой. Для проверки делаем обратное преобразование.

Результат проверки передаем как выходной параметр функции.}

test:= Julian2date(julian);

if date = test then result:= true

else result:= false;

end;

function DayOfTheWeek(date : string): string;

{Получаем дату в формате YYYYMMDD и возвращаем день недели.}

var

julian: longint;

begin

julian:= (Date2julian(date)) MOD 7;

case julian of

0: result:= 'Понедельник';

1: result := 'Вторник';

2: result:= 'Среда';

3: result:= 'Четверг';

4: result:= 'Пятница';

5: result:= 'Суббота';

6: result:= 'Воскресенье';

end;

end;

end.

У меня есть неотложная задача: в настоящее время я разрабатываю проект, где я должен проверять достоверность введенных дат с применением маски __/__/____, например 12/12/1997.

Некоторое время назад я делал простой шифратор/дешифратор дат, проверяющий достоверность даты. Код приведен ниже.

function CheckDateFormat(SDate: string): string;

var

IDateChar: string;

x,y: integer;

begin

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, которую я написал перед этим на 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 и вычисляющий восход-заход солнца и восход-заход луны. Может кто-нибудь сможет перенести это на Pascal?

(в случае чего сообщите мне по адресу st_evil@mail.ru)

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)

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

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