Среда, 18.06.2025, 23:40
Приветствую Вас Гость | RSS
Меню сайта
fff
  • Индексация
  • Девочки
    Форма входа
    Категории раздела
    Теория алгоритмов [3]
    Теория алгоритмов
    Code Snippets [1]
    Code Snippets
    Все о PHP [20]
    Все о PHP
    Visual C++ [13]
    Visual C++
    WIN32 API [7]
    WIN32 API
    Delphi [72]
    Delphi
    ASP [2]
    ASP
    Java [67]
    Java
    VBScript [6]
    VBScript
    CGI [2]
    CGI
    VRML [2]
    VRML
    PERL [9]
    PERL
    HTML [4]
    HTML
    XML [10]
    XML
    Архив записей

    Статьи по Оптимизации

    ПРОГРАММИРОВАНИЕ! СОЗДАНИЕ САЙТОВ И ИХ ОПТИМИЗАЦИЯ

    Главная » Статьи » Программирование » Delphi

    Дни недели
    Дни недели
    Кто-нибудь пробовал написать функцию, возвращающую для определенной даты день недели? Моя функция как раз этим и занимается.
    unit datefunc;

    interface
    function checkdate (date : string) :boolean;
    function Date2julian (date : string) : longint;
    function Julian2date (julian : longint) : string;
    function DayOfTheWeek (date : string) :string;
    function idag : string;

    implementation
    uses

    sysutils;

    function idag () : string;
    {Получает текущую дату и возвращает ее в формате YYYYMMDD для использования
    другими функциями данного молуля.}
    var

    Year, Month, Day: Word;
    begin
    DecodeDate(Now, Year, Month, Day);
    result := IntToStr(year)+ IntToStr(Month) +IntToStr(day);
    end;

    function Date2julian (date : string) : longint;
    {Получает дату в формате YYYYMMDD.
    Если у вас другой формат,
    в первую очередь преобразуйте его.}
    var

    month,day,year:integer;
    ta,tb,tc : longint;
    begin

    month := strtoint(copy(date,5,2));
    day := strtoint(copy(date,7,2));
    year := strtoint(copy(date,1,4));
    if month > 2 then
    month := month - 3
    else
    begin
    month := month + 9;
    year := year - 1;
    end;
    ta := 146097 * (year div 100) div 4;
    tb := 1461 * (year MOD 100) div 4;
    tc := (153 * month + 2) div 5 + day + 1721119;
    result := ta + tb + tc
    end;

    function mdy2date (month, day, year : integer) : string;
    var

    y,m,d : string;
    begin

    y := '000'+inttostr(year);
    y := copy(y,length(y)-3,4);
    m := '0'+inttostr(month);
    m := copy(m,length(m)-1,2);
    d := '0'+inttostr(day);
    d := copy(d,length(d)-1,2);
    result := y+m+d;

    end;

    function Julian2date (julian : longint) : string;
    {Получает значение и возвращает дату в формате YYYYMMDD}
    var

    x,y,d,m : longint;
    month,day,year : integer;
    begin

    x := 4 * julian - 6884477;
    y := (x div 146097) * 100;
    d := (x MOD 146097) div 4;
    x := 4 * d + 3;
    y := (x div 1461) + y;
    d := (x MOD 1461) div 4 + 1;
    x := 5 * d - 3;
    m := x div 153 + 1;
    d := (x MOD 153) div 5 + 1;
    if m < 11 then
    month := m + 2
    else
    month := m - 10;
    day := d;
    year := y + m div 11;
    result := mdy2date(month, day, year);
    end;

    function checkdate (date : string) :boolean;
    {Дата должна быть в формате YYYYMMDD.}
    var

    julian : longint;
    test : string;
    begin
    {Сначала преобразовываем строку в юлианский формат даты.
    Это позволит получить необходимое значение.}
    julian := Date2julian(date);
    {Затем преобразовываем полученную величину в дату.
    Это всегда будет правильной датой. Для проверки делаем обратное преобразование.
    Результат проверки передаем как выходной параметр функции.}
    test := Julian2date(julian);

    if date = test then

    result := true
    else

    result := false;
    end;

    function DayOfTheWeek (date : string) :string;
    {Получаем дату в формате YYYYMMDD
    и возвращаем день недели.}
    var

    julian : longint;
    begin
    julian := (Date2julian(date)) MOD 7;

    case julian of
    0 : result := 'Понедельник';
    1 : result := 'Вторник';
    2 : result := 'Среда';
    3 : result := 'Четверг';
    4 : result := 'Пятница';
    5 : result := 'Суббота';
    6 : result := 'Воскресенье';
    end;
    end;

    end.

    Категория: Delphi | Добавил: Merlin (07.12.2009)
    Просмотров: 742 | Рейтинг: 0.0/0
    Всего комментариев: 0
    Имя *:
    Email *:
    Код *: