Советы по Delphi. Версия 1.0.6 - [8]

 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

Привет, я хочу в качестве совета поделиться функцией 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)
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: ' Часовой угол,