Code:

function Persia_to_Ger_date(aa: ShortString; ResultKind: Byte = 0): ShortString;

 

function TrueTo1(co: Boolean): Integer;

begin

if co then TrueTo1 := 1

else

TrueTo1 := 0;

end;

 

const

Conm_mons: array[0..11] of Byte = (31,28,31,30,31,30,31,31,30,31,30,31);

LeapYearSh: array[0..4] of Integer = (1375,1379,1383,1387,1391);

LeapYearMi: array[0..4] of Integer = (1996,2000,2004,2008,2012);

monthes: array[0..11] of ShortString = ('Jan', 'Feb', 'Mar', 'Apr',

'May', 'Jun', 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec');

type

date = record

da_day, da_mon, da_year: Integer;

end;

var

m_mons: array[0..11] of BYTE;

LastDayCountSh, LastDayCountMi: integer;

a, b: date;

sYY, sMM, sDD: ShortString;

I: Integer;

begin

for I := Low(Conm_mons) to High(Conm_mons) do

m_mons[I] := Conm_mons[I];

 

a.da_day := StrToNum(Copy(aa, DayPosInDate, DayLen));

a.da_mon := StrToNum(Copy(aa, MonthPosInDate, MonthLen));

a.da_year := StrToNum(Copy(aa, YearPosInDate, YearLen));

b.da_year := a.da_year + 621;

Inc(b.da_year, TrueTo1(((a.da_mon > 10) or ((a.da_mon = 10) and (a.da_day >= 12)))

or ((LeapYearSh[(a.da_year - 1374) div4] <> a.da_year) and

((a.da_mon = 10) and (a.da_day = 11)))));

Inc(m_mons[1], TrueTo1(LeapYearMi[(b.da_year - 1996) div4] = b.da_year));

if (a.da_mon <= 7) then LastDayCountSh := ((a.da_mon - 1) * 31 + a.da_day)

else

LastDayCountSh := (186 + (a.da_mon - 7) * 30 + a.da_day);

if (b.da_year = (a.da_year + 622)) then LastDayCountMi :=

LastDayCountSh - 286 - TrueTo1(LeapYearSh[(a.da_year - 1375) div4] = a.da_year)

else

LastDayCountMi := (LastDayCountSh + 79);

 

b.da_day := LastDayCountMi;

b.da_mon := 0;

while (LastDayCountMi > m_mons[b.da_mon]) do

begin

Dec(LastDayCountMi, m_mons[b.da_mon]);

Inc(b.da_mon);

b.da_day := LastDayCountMi;

end;

Inc(b.da_mon);

if b.da_year < 1000then sYY := sYY + '0';

if b.da_year < 100then sYY := sYY + '0';

if b.da_year < 10then sYY := sYY + '0';

sYY := sYY + IntToStr(b.da_year);

 

if b.da_mon < 10then sMM := sMM + '0';

sMM := sMM + IntToStr(b.da_mon);

 

if b.da_day < 10then sDD := sDD + '0';

sDD := sDD + IntToStr(b.da_day);

 

case ResultKind of

0: Persia_to_Ger_date := sYY + '/' + sMM + '/' + sDD;

1: Persia_to_Ger_date := sYY + ' ' + monthes[b.da_mon - 1] + ' ' + sDD;

end;

end;

 

 

Взято с сайта: https://www.swissdelphicenter

Добавить комментарий

Не использовать не нормативную лексику.

Просьба писать ваши замечания, наблюдения и все остальное,
что поможет улучшить предоставляемую информацию на этом сайте.

ВСЕ КОММЕНТАРИИ МОДЕРИРУЮТСЯ ВРУЧНУЮ, ТАК ЧТО СПАМИТЬ БЕСПОЛЕЗНО!


Защитный код
Обновить