Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Получить номер недели по дате

Оформил: DeeCo
Автор: http://www.swissdelphicenter.ch

var
   FirstWeekDay: Integer = 2;
   { Wochentag, mit dem die Woche beginnt 
   (siehe Delphi-Wochentage) 
   2 : Montag (nach DIN 1355) }
   FirstWeekDate: Integer = 4;
   { 1 : Beginnt am ersten Januar 
    4 : Erste-4 Tage-Woche (nach DIN 1355) 
    7 : Erste volle Woche }

   { liefert das Datum des ersten Tages der Woche }
   { get date of first day of week}
 function WeekToDate(AWeek, AYear: Integer): TDateTime;
 begin
   Result := EncodeDate(AYear, 1, FirstWeekDate);
   Result := Result + (AWeek - 1) * 7 - ((DayOfWeek(Result) + (7 - FirstWeekDay)) mod 7);
 end;

 { liefert die Wochennummer und das Jahr, zu dem die Woche gehort }
 { get weeknumber and year of the given week number}
 procedure DateToWeek(ADate: TDateTime; var AWeek, AYear: Word);
 var
   Month, Day: Word;
 begin
   ADate := ADate - ((DayOfWeek(ADate) - FirstWeekDay + 7) mod 7) + 7 - FirstWeekDate;
   DecodeDate(ADate, AYear, Month, Day);
   AWeek := (Trunc(ADate - EncodeDate(AYear, 1, 1)) div 7) + 1;
 end;


 {Week to date example}
 procedure TForm1.Button1Click(Sender: TObject);
 begin
   ShowMessage(FormatDateTime('dd.mm.yyyy', WeekToDate(51, 2000)));
 end;

 {Date to week example}
 procedure TForm1.Button2Click(Sender: TObject);
 var
   week, year: Word;
 begin
   DateToWeek(now, week, year);
   ShowMessage(IntToStr(week));
   ShowMessage(IntToStr(year));
 end;
Проект Delphi World © Выпуск 2002 - 2024
Автор проекта: USU Software
Вы можете выкупить этот проект.