Читать «Советы по Delphi. Версия 1.0.6» онлайн - страница 13

 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

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