Валентин Озеров - Советы по Delphi. Версия 1.4.3 от 1.1.2001
n : integer; { количество транзакций в массиве }
rate : double; { оценочный процент за истекший период }
atbegin : boolean) : double; { true, если транзакция была в начале периода,false если в конце }
var
i: integer;
factor: double;
begin
factor := (1 + rate / 100.0);
result := 0;
for i := n - 1 downto 0 do result := (result + cashflows[n]) / factor;
if atbegin then result := result * factor;
end;
Конвертирование даты
Delphi 1
TheDateField.AsString := TheDateString;
TheDateString := TheDateField.AsString;
это делает преобразование подобно DateToStr и StrToDate. Аналогично:
TheDateField.AsDateTime := StrToDate(TheDateString);
TheDateString := DateToStr(TheDateField.AsDateTime);
Число текущей недели
Delphi 1
Здесь включены 2 вспомогательные функции, необходимые для работы вашей функции. Одна проверяет високосный год, другая возвращает число дней месяца (с проверкой високосного года), третья, ту, что вы хотели, возвращает текущую неделю года.
{***************************************************************************}
function kcIsLeapYear(nYear: Integer): Boolean;
begin
Result := (nYear mod 4 = 0) and ((nYear mod 100 <> 0) or (nYear mod400 = 0));
end;
{***************************************************************************}
function kcMonthDays(nMonth, nYear: Integer): Integer;
const
DaysPerMonth: array[1..12] of Integer = (31, 28, 31, 30, 31, 30, 31,31, 30, 31, 30, 31);
begin
Result := DaysPerMonth[nMonth];
if (nMonth = 2) and kcIsLeapYear(nYear) then Inc(Result);
end;
{***************************************************************************}
function kcWeekOfYear(dDate: TDateTime): Integer;
var
X, nDayCount: Integer;nMonth, nDay, nYear: Word;
begin
nDayCount := 0;
deCodeDate(dDate, nYear, nMonth, nDay);
For X := 1 to (nMonth - 1) do nDayCount := nDayCount + kcMonthDays(X, nYear);
nDayCount := nDayCount + nDay;
Result := ((nDayCount div 7) + 1);
end;
Разница во времени
Delphi 1
…я не знаю, когда вы выполняете TimeTaken… Вы делали какую-нибудь паузу перед запуском TimeTaken после выполнения SetTimeStart? Если не делали, то удивительно, что tt=Now… Я пробовал ваш код с несколькими незначительными изменениями… и я всегда получал разницу между Now и TimeStart. Но я объявляю tt как TDateTime, а не как Double, и использую событие OnTimer для запуска процедуры TimeTaken. Вы можете проверить это, запустив пример, приведенный ниже.
{*******************************************************************
ФАЙЛ : TIMEEX.PAS
ПРИМЕЧАНИЕ : Создайте форму, содержащую 1 TTimer и 6 TLabel. Установите событие OnTimer у TTimer на TForm.Timer1.Timer
********************************************************************}
unit Time;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,Forms, Dialogs, ExtCtrls, StdCtrls;
type
TForm1 = class(TForm)
Timer1: TTimer;
Label1: TLabel; {Caption : 'Старт :'}
Label2: TLabel;
Label3: TLabel; {Caption : 'Время : '}
Label4: TLabel;
Label5: TLabel; {Caption : 'Истекшее время:'}
Label6: TLabel;
procedure FormCreate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private { Private declarations }
TimeStart : TDateTime;
public { Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
begin
TimeStart := Now;
Label2.Caption := TimeToStr(Now);
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
tt : TDateTime;
begin
Label4.Caption := TimeToStr(Now);
tt:= Now - TimeStart;
Label6.Caption:= TimeToStr(tt);
end;
end.
Проблема со временем
Delphi 1
…я нашел Time24Hour в файлах помощи, как вы и советовали. Но…
вот код для EncodeTime в SysUtils.Pas file:
function DoEncodeTime(Hour, Min, Sec, MSec: Word; var Time: TDateTime): Boolean;
begin
Result := False;
if (Hour < 24) and (Min < 60) and (Sec < 60) and (MSec < 1000) then begin
Time := (LongMul(Hour * 60 + Min, 60000) + Sec * 1000 + MSec) / MSecsPerDay;
Result := True;
end;
end;
function EncodeTime(Hour, Min, Sec, MSec: Word): TDateTime;
begin
if not DoEncodeTime(Hour, Min, Sec, MSec, Result) then ConvertError(LoadStr(STimeEncodeError));
end;
Как вы можете видеть, проверка Time24Hour присутствует. Я думал в Browser все будет также. Ничего подобного! Я уж грешным делом подумал, что Time24Hour объявили устаревшим, исключили из поддержки, выбросили частично из кода, но забыли почистить файл помощи. Вы так не думаете?
Переменная времени
Delphi 1
Используйте переменную типа TDateTime.
procedure TForm1.XXXXXXXClick(Sender: TObject);
var StartTime, EndTime, ElapsedTime :TDateTime;
begin
StartTime := Now;
{Здесь поместите свой код}
EndTime := Now;
ElapsedTime := EndTime - StartTime;
Label1.Caption := TimeToStr(ElapsedTime);
end;
{теперь все это в памяти, но в нашем случае это хорошее место. }
var
before,after,elapsed : TDateTime;
Ehour, Emin, Esec, Emsec : WORD;
…
before := now;
some_process();
after := now;
elapsed := after - before;
decodetime(elapsed, Ehour, Emin, Esec, Emsec);
теперь Ehour:Emin:Esec.Emsec будет содержать истекшее время.
Это то, что я хотел. fStartWhen содержит дату/время начала процесса. (fStartWhen := NOW). OneSecond — константа, определенная как 1/24/3600. (Да, эта программа может выполняться для нескольких дней. Но даже самый быстрый P5 может не справиться с большим количеством данных!)
PROCEDURE TformDBLoad.UpdateTime;
VAR Delta: TDateTime
BEGIN
fLastUpdate := NOW
IF ABS(fStartWhen - fLastUpdate ) < OneSecond THEN EXIT
Delta := fLastUpdate - fStartWhendoElapsedTime.Caption := FORMAT('%1. дней из %s', [INT(Delta),FORMATDATETIME('hh:nn:ss', FRAC(Delta))])
END;
Математика
Как научить Delphi делать правильное округление дробных чисел?
Nomadic советует:
Целая коллекция способов -
Для решения этой проблемы мною написана функция, которую можно модифицировать для всех случаев. Смысл заключается в том, что рассматривается строка. После этого все проблемы с округлением снялись.
Function RoundStr(Zn:Real;kol_zn:Integer):Real;
{Zn-значение; Kol_Zn-Кол-во знаков после запятой}
Var
snl,s,s0,s1,s2:String;
n,n1:Real;
nn,i:Integer;
begin
s:=FloatToStr(Zn);
if (Pos(',',s)>0) and (Zn>0) and (Length(Copy(s,Pos(',',s)+1,length(s)))>kol_zn) then begin
s0 := Copy(s,1,Pos(',',s)+kol_zn-1);
s1 := Copy(s,1,Pos(',',s)+kol_zn+2);
s2 := Copy(s1,Pos(',',s1)+kol_zn,Length(s1));
n := StrToInt(s2)/100;nn := Round(n);
if nn >= 10 then begin
snl := '0,';
For i := 1 to kol_zn - 1 do snl := snl + '0';
snl := snl+'1';
n1 := StrToFloat(Copy(s,1,Pos(',',s)+kol_zn))+StrToFloat(snl);
s := FloatToStr(n1);
if Pos(',',s) > 0 then s1 := Copy(s,1,Pos(',',s)+kol_zn);
end else s1 := s0 + IntToStr(nn);
if s1[Length(s1)]=',' then s1 := s1 + '0';
Result := StrToFloat(s1);
end else Result := Zn;
end;
Все-таки работа со строками здесь излишество -
function RoundEx( X: Double; Precision : Integer ): Double;
{Precision : 1 - до целых, 10 - до десятых, 100 - до сотых...}
var
ScaledFractPart, Temp : Double;
begin
ScaledFractPart := Frac(X)*Precision;
Temp := Frac(ScaledFractPart);
ScaledFractPart := Int(ScaledFractPart);
if Temp >= 0.5 then ScaledFractPart := ScaledFractPart + 1;
if Temp <= -0.5 then ScaledFractPart := ScaledFractPart - 1;