德尔福中给定年份的同一天

Question

我正在使用 Delphi 11 和新的 DateUtils 库，但我无法获取给定年份的过去同一天的日期。 我必须在 n 年前的指定日期的同一天退休。所以如果今天是星期日我必须返回n年前的同一个星期日。 我添加了用delphi编写的真实测试应用程序的完整源代码，并修复了一个错误，

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ComCtrls, system.DateUtils, system.Types;

type
  TForm1 = class(TForm)
    dtDataOggi: TDateTimePicker;
    Label1: TLabel;
    edYears: TEdit;
    bnCalcola: TButton;
    procedure bnCalcolaClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    function annobisestile(value : tDate) : integer;
  end;


var
  Form1: TForm1;

implementation

{$R *.dfm}


procedure TForm1.bnCalcolaClick(Sender: TObject);
var
   DataAppoggio : tDate;
   NumberOfYearToSubtract : integer;
   annobis : integer; // is leap year?
   annoappoggio : integer;
   giorno : boolean;
   febb28 :tDate;
   i : integer;
begin
   DataAppoggio := dtDataOggi.date;
   NumberOfYearToSubtract := strToInt(edYears.Text);
   annobis := 0;
   annoappoggio := yearOf(DataAppoggio);
   febb28 := encodedate(annoappoggio ,2,28);

  if CompareDate(febb28,DataAppoggio) = GreaterThanValue then
     Giorno := true
  else
     Giorno := false;

     DataAppoggio := IncYear(DataAppoggio, -NumberOfYearToSubtract);
     // check if adataappoggio is before feb 28  so i must add a day
     if giorno then  begin
        for I := 0 to NumberOfYearToSubtract  do begin
           //annobiststile is a custom functions that returns 1 if the given year is a leap year
           annobis := annobis + annobisestile(encodeDate(annoappoggio,01,01));
           annoappoggio := annoappoggio -1;
        end;
     end
     else begin
        for I := 0 to NumberOfYearToSubtract -1  do begin
           annobis := annobis + annobisestile(encodeDate(annoappoggio,01,01));
           annoappoggio := annoappoggio -1;
        end;
     end;
     label1.Caption  :=  incDay(DataAppoggio, NumberOfYearToSubtract+annobis).ToString;
 end;

 function TForm1.annobisestile(value: tDate): integer;
begin
   if IsInLeapYear(value) then
      result := 1
   else
      result := 0;
end;

该函数返回过去几年给定数字的确切日期，但如果今年是3年或更多，则它与相同的WeekOfTheYear不匹配。 有什么想法吗？谢谢。

Answer 1

如果您需要同一周数和同一周的同一天n年前（或以后）的日期，解决方案很简单。 System.DateUtils 单元具有所有必要的功能。

首先使用函数 YearOf()、WeekOf() 和 DayOfTheWeek() 来获取 InputYear、InputWeek 和 InputDOW（星期几）来自 InputDate。

然后使用EncodeDateWeek()函数转换InputYear + YearsToAdd、InputWeek、InputDOW 到 TDateTime；

完整的示例代码如下：

procedure TForm2.Button3Click(Sender: TObject);
var
  InputDate: TDate;
  InputYear: word;
  InputWeek: word;
  InputDOW:  word;
  YearsToAdd: integer;
  NewDate: TDate;
begin
  InputDate := dtDataOggi.date;
  InputYear := YearOf(InputDate);
  InputWeek := WeekOf(InputDate);
  InputDOW  := DayOfTheWeek(InputDate); // ISO 8601 Monday is first dow,
                                        // use DayOfWeek() for Sunday as first dow
  YearsToAdd := strToInt(edYears.Text); // use '-' in input for subtraction

  NewDate := EncodeDateWeek(InputYear + YearsToAdd, InputWeek, InputDOW);

  Memo1.Lines.Add(DateToStr(InputDate));
  Memo1.Lines.Add(DateToStr(NewDate));
end;

编辑：

您可以通过删除中间变量 InputYear、InputWeek 和 InputDOW 来缩短代码，并将调用移至 < code>YearOf(InputDate)、WeekOf(InputDate) 和 DayOfTheWeek(InputDate) 作为 EncodeDateWeek() 的参数。

procedure TForm2.Button3Click(Sender: TObject);
var
  InputDate: TDate;
  YearsToAdd: integer;
  NewDate: TDate;
begin
  InputDate := dtDataOggi.date;
  YearsToAdd := strToInt(edYears.Text); // use '-' in input for subtraction

  NewDate := EncodeDateWeek(
    YearOf(InputDate) + YearsToAdd, 
    WeekOf(InputDate), 
    DayOfTheWeek(InputDate));           // ISO 8601, monday is first dow
                                        // use DayOfWeek() for sunday as first dow
  Label1.Caption := DateToStr(NewDate);
end;

Answer 2

你把事情搞得太复杂了。您不需要function annobisestile，您可以使用以下方法替换TForm1.bnCalcolaClick。
简而言之，这会减去指定的年数，然后将日期调整为偏离原始星期几的天数。

（这是在 10.4 中完成的，它没有新的 TDateTime 助手，因此我使用 DateToStr() 而不是 .toString。）

procedure TForm1.bnCalcolaClick(Sender: TObject);
var
   DataAppoggio : tDate;
   NumberOfYearToSubtract : integer;
   DOW : Integer;
begin
   DataAppoggio := dtDataOggi.date;
   NumberOfYearToSubtract := strToInt(edYears.Text);
   DOW := DayOfWeek(DataAppoggio);

   DataAppoggio := IncYear(DataAppoggio,-NumberOfYearToSubtract);
   DataAppoggio := IncDay(DataAppoggio,DOW-DayOfWeek(DataAppoggio));
   label1.Caption  :=  DateToStr(DataAppoggio);
end;