Советы по Delphi. Версия 1.4.3 от 1.1.2001 - [2]

function  currency2str (value: double): string;
 const hundreds: array [0..9] of string = ('',' сто',' двести',' триста',' четыреста',' пятьсот',' шестьсот',' семьсот',' восемьсот',' девятьсот');
 tens: array [0..9] of string = ('','',' двадцать',' тридцать',' сорок',' пятьдесят',' шестьдесят',' семьдесят',' восемьдесят',' девяносто');
 ones: array [0..19] of string = ('','','',' три',' четыре',' пять',' шесть',' семь',' восемь',' девять',' десять',' одиннадцать',' двенадцать',' тринадцать',' четырнадцать',' пятнадцать',' шестнадцать',' семнадцать',' восемнадцать',' девятнадцать');
 razryad: array [0..6] of string = ('',' тысяч',' миллион',' миллиард',' триллион',' квадриллион',' квинтиллион');
 var s: string; i: integer; val: int64;

 function shortnum(s: string; raz: integer): string;
 begin
  Result:=hundreds[StrToInt(s[1])];
  if strtoint(s)=0 then exit;
  if s[2]<>'1' then begin
   Result:=Result+tens[StrToInt(s[2])];
   case strtoint(s[3]) of
   1: if raz=1 then result:=result+' одна' else result:=result+' один';
   2: if raz=1 then result:=result+' две' else result:=result+' два';
   else result:=result+ones[strtoint(s[3])];
   end;
   Result:=Result+razryad[raz];
   case strtoint(s[3]) of
   0,5,6,7,8,9: if raz>1 then result:=result+'ов';
   1: if raz=1 then result:=result+'а';
   2,3,4: if raz=1 then result:=result+'и' else if raz>1 then result:=result+'а';
   end;
  end else begin
   Result:=Result+ones[StrToInt(Copy(s,2,2))];
   Result:=Result+razryad[raz];
   if raz>1 then result:=result+'ов';
  end;
 end;

begin
 val:=Trunc(value);
 if val=0 then begin result:='ноль'; exit; end;
 s:=IntToStr(val); Result:=''; i:=0;
 while length(s)>0 do begin
  Result:=shortNum(Copy('00'+s,Length('00'+s)-2,3),i)+Result;
  if length(s)>3 then s:=copy(s,1,length(s)-3) else s:='';
  inc(i);
 end;
 s:=IntToStr(Trunc((value-val)*100+0.5));
 Result:=Result+' руб. '+s+' коп.';
end;

Даты

Добавление даты и времени в компонент Memo

Delphi 1

{ Следующий код вставляет значение даты/времени в memo-поле. }
Var
 s : string;
begin
 s :=  DateToStr( Date ) + ' ' + TimeToStr( Time ) + '  :';
 Memo1.Lines.Insert(0, s);
 Memo1.SetFocus;
 Memo1.SelStart := Length(s);
 Memo1.SelLength := 0;

Вычисление даты Пасхи II

Delphi 1

function easter (year: integer): tdatetime;
{----------------------------------------------------------------}
{ Вычисляет и возвращает день Пасхи определенного года.          }
{ Идея принадлежит Mark Lussier, AppVision <[email protected]>.  }
{ Скорректировано для предотвращения переполнения целых, если по }
{ ошибке передан год с числом 6554 или более.                    }
{----------------------------------------------------------------}
var
 nMonth, nDay, nMoon, nEpact, nSunday,
 nGold, nCent, nCorx, nCorz: Integer;
begin
 { Номер Золотого Года в 19-летнем Metonic-цикле: }
 nGold := (Year mod 19) + 1;
 { Вычисляем столетие: }
 nCent := (Year div 100) + 1;
 { Количество лет, в течение которых отслеживаются високосные года… }
 { для синхронизации с движением солнца: }
 nCorx := (3 * nCent) div 4 – 12;
 { Специальная коррекция для синхронизации Пасхи с орбитой луны: }
 nCorz := (8 * nCent + 5) div 25 – 5;
 { Находим воскресенье: }
 nSunday := (Longint(5) * Year) div 4 – ncorx – 10;
 { ^ Предохраняем переполнение года за отметку 6554}
 { Устанавливаем Epact – определяем момент полной луны: }
 nEpact := (11 * nGold + 20 + nCorz – nCorx) mod 30;
 if nepact < 0 then nEpact := nEpact + 30;
 if ((nepact = 25) and (ngold > 11)) or (nepact = 24) then nEpact := nEpact + 1;
 { Ищем полную луну: }
 nMoon := 44 – nEpact;
 if nmoon < 21 then nMoon := nMoon + 30;
 { Позиционируем на воскресенье: }
 nMoon := nMoon + 7 – ((nSunday + nMoon) mod 7);
 if nmoon >l 31 then
 begin
  nMonth := 4;
  nDay := nMoon – 31;
 end
 else
 begin
  nMonth := 3;
  nDay := nMoon;
 end;
 Easter := EncodeDate(Year, nMonth, nDay);
end; {easter}

Преобразование даты в количество секунд

Delphi 1

EncodeDate возвращает объект TDateTime, который просто является double-числом. Для получения количества миллисекунд с даты 1/1/0001, умножьте результат на 86400000.0 Но чтобы избежать переполнения, лучше пользоваться более поздней датой.

Преобразование даты в неделю

Delphi 1

procedure TForm1.Button1Click(Sender: TObject);
var  frstDay,toDay : TDateTime; week : Integer;
begin
 frstDay := StrToDate('1/1/96');
 toDay := StrToDate(Edit1.Text);
 week := Trunc((toDay - frstDay) / 7) + 1;
 Label1.Caption := IntToStr(week);
end;

Преобразование даты

Delphi 1

procedure TForm1.Button1Click(Sender: TObject);
var
 st,formatsave : string;
 DT : TDateTime;
begin
 st := Edit1.text; // '1996-06-03 00.00.00'
 formatsave := ShortDateFormat;
 ShortDateFormat := 'yyyy.mm.dd hh.mm.ss';
 while pos ('-', st) > 0 do st [pos ('-', st)] := '.';
 DT := StrToDateTime(st);
 ShortDateFormat := formatsave;
 Label1.Caption := DateTimeToStr(DT);
end;

Преобразование даты — добавление столетия

Delphi 1

LongDate := FormatDateTime('ddmmyyyy', StrToDate(ShortDate));

Данный код преобразует дату, переданную в формате, определенном в виде короткой даты в Панели Управления (типа DD/MM/YY) в формат, заданный в строке Format (в нашем примере DDMMYYYY).