delphi 中给定年份的同一天

same dayofweek for a given year in delphi

我将 Delphi 11 与新的 DateUtils 库一起使用,但在给定的年数内,我无法获得过去同一天的日期。 我必须在 n 年前的给定日期的同一天返回。所以如果今天是星期天,我必须 return 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;

这个功能 return 过去几年中给定数字的确切日期,但如果今年是 3 或更多,它与相同的 WeekOfTheYear 不匹配。 任何的想法?谢谢。

你把事情搞得太复杂了。你不需要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;

如果您需要同一周同一周n的日期,解决方案很简单年前(或之后)。 System.DateUtils 单元具有所有必要的功能。

首先使用函数YearOf()WeekOf()DayOfTheWeek()得到InputYearInputWeekInputDOW(day-of-week ) 来自 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;

编辑:

您可以通过删除中间变量 InputYearInputWeekInputDOW 来缩短代码,并将调用移至 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;