// var Sal,Mah,Rooz:Word; begin
// SolarDecodeDate(Date,Sal,Mah,Rooz);
// StatusBar1.Panels[1].Text:=RozName+' '+IntToStr(Sal)+'/'+IntToStr(Mah)+'/'+IntToStr(Rooz);
// Edit2.Text:=IntToStr(Sal-1300)+'/'+IntToStr(Mah)+'/'+IntToStr(Rooz);
unit SolarUnit;
interface
uses SysUtils;
type
TDateKind = (dkSolar, dkGregorian);
function IsLeapYear(DateKind: TDateKind; Year: Word): Boolean;
function IsDateValid(DateKind: TDateKind; Year, Month, Day: Word): Boolean;
function DateOfDay(DateKind: TDateKind; Days, Year: Word; var Month, Day: Word): Boolean;
function GregorianToSolar(var Year, Month, Day: Word): Boolean;
function SolarToGregorian(var Year, Month, Day: Word): Boolean;
function DaysOfMonth(DateKind: TDateKind; Year, Month: Word): Word;
function DaysToDate(DateKind: TDateKind; Year, Month, Day: Word): Word;
procedure SolarDecodeDate(Date: TDateTime; var Year, Month, Day: Word);
function SolarEncodeDate(Year, Month, Day: Word): TDateTime;
implementation
uses DataEntry, DataMadule, Functoins;
const
LeapMonth: array[TDateKind] of Byte =
(12 {Esfand}, 2 {February});
DaysOfMonths: array[TDateKind, 1..12] of Byte = (
( 31, 31, 31, 31, 31, 31, 30, 30, 30, 30, 30, 29 )
{ Far, Ord, Kho, Tir, Mor, Sha, Meh, Aba, Aza, Day, Bah,^Esf },
( 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 )
{ Jan,^Feb, Mar, Apr, May, Jun, Jul, Aug, Sep, Oct, Nov, Dec });
DaysToMonth: array[TDateKind, 1..13] of Word = (
( 0, 31, 62, 93, 124, 155, 186, 216, 246, 276, 306, 336, 365 )
{ Far, Ord, Kho, Tir, Mor, Sha, Meh, Aba, Aza, Day, Bah,^Esf, *** },
( 0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, 365 )
{ Jan,^Feb, Mar, Apr, May, Jun, Jul, Aug, Sep, Oct, Nov, Dec, *** });
function IsLeapYear(DateKind: TDateKind; Year: Word): Boolean;
begin
if DateKind = dkSolar then
Result := ((((LongInt(Year) + 38) * 31) mod 128) <= 30)
else
Result := ((Year mod 4) = 0) and (((Year mod 100) <> 0) or ((Year mod 400) = 0));
end;
function DaysOfMonth(DateKind: TDateKind; Year, Month: Word): Word;
begin
if (Year <> 0) and (Month in [1..12]) then
begin
Result := DaysOfMonths[DateKind, Month];
if (Month = LeapMonth[DateKind]) and IsLeapYear(DateKind, Year) then
Inc(Result);
end
else
Result := 0;
end;
function IsDateValid(DateKind: TDateKind; Year, Month, Day: Word): Boolean;
begin
Result := (Year <> 0) and (Month >= 1) and (Month <= 12) and
(Day >= 1) and (Day <= DaysOfMonth(DateKind, Year, Month));
end;
function DaysToDate(DateKind: TDateKind; Year, Month, Day: Word): Word;
begin
if IsDateValid(DateKind, Year, Month, Day) then
begin
Result := DaysToMonth[DateKind, Month] + Day;
if (Month > LeapMonth[DateKind]) and IsLeapYear(DateKind, Year) then
Inc(Result);
end
else
Result := 0;
end;
function DateOfDay(DateKind: TDateKind; Days, Year: Word; var Month, Day: Word): Boolean;
var
LeapDay, m: Integer;
begin
LeapDay := 0;
Month := 0;
Day := 0;
for m := 2 to 13 do
begin
if (m > LeapMonth[DateKind]) and IsLeapYear(DateKind, Year) then
LeapDay := 1;
if Days <= (DaysToMonth[DateKind, m] + LeapDay) then
begin
Month := m - 1;
if Month <= LeapMonth[DateKind] then LeapDay := 0;
Day := Days - (DaysToMonth[DateKind, Month] + LeapDay);
Break;
end;
end;
Result := IsDateValid(DateKind, Year, Month, Day);
end;
function GregorianToSolar(var Year, Month, Day: Word): Boolean;
var
LeapDay, Days: Integer;
PrevGregorianLeap: Boolean;
begin
if IsDateValid(dkGregorian, Year, Month, Day) then
begin
PrevGregorianLeap := IsLeapYear(dkGregorian, Year-1);
Days := DaysToDate(dkGregorian, Year, Month, Day);
Dec(Year, 622);
if IsLeapYear(dkSolar, Year) then
LeapDay := 1
else
LeapDay := 0;
if PrevGregorianLeap and (LeapDay = 1) then
Inc(Days, 287)
else
Inc(Days, 286);
if Days > (365 + LeapDay) then
begin
Inc(Year);
Dec(Days, 365 + LeapDay);
end;
Result := DateOfDay(dkSolar, Days, Year, Month, Day);
end
else
Result := False;
end;
function SolarToGregorian(var Year, Month, Day: Word): Boolean;
var
LeapDay, Days: Integer;
PrevSolarLeap: Boolean;
begin
if IsDateValid(dkSolar, Year, Month, Day) then
begin
PrevSolarLeap := IsLeapYear(dkSolar, Year-1);
Days := DaysToDate(dkSolar, Year, Month, Day);
Inc(Year, 621);
if IsLeapYear(dkGregorian, Year) then
LeapDay := 1
else
LeapDay := 0;
if PrevSolarLeap and (LeapDay = 1) then
Inc(Days, 80)
else
Inc(Days, 79);
if Days > (365 + LeapDay) then
begin
Inc(Year);
Dec(Days, 365 + LeapDay);
end;
Result := DateOfDay(dkGregorian, Days, Year, Month, Day);
end
else
Result := False;
end;
function SolarEncodeDate(Year, Month, Day: Word): TDateTime;
begin
if SolarToGregorian(Year, Month, Day) then
Result := EncodeDate(Year, Month, Day)
else
Result := 0;
end;
procedure SolarDecodeDate(Date: TDateTime; var Year, Month, Day: Word);
begin
DecodeDate(Date, Year, Month, Day);
GregorianToSolar(Year, Month, Day);
end;
end.
تبدیل تاریخ میلادی به هجری شمسی
قوانین ایجاد تاپیک در تالار
پاسخ با نقل قول