sql_qassem
شنبه 15 تیر 1387, 10:46 صبح
خودم يونيت SolarUtl رو تكميل كردم و دو تابع ساده به اون اضافه كردم
{------------------------------------------------------------------------------}
{ }
{ SolarUtl - Solar Date Utility Functions }
{ Copyright(C) 1995-2003 Kambiz R. Khojasteh, all rights reserved. }
{ }
{ kambiz@delphiarea.com }
{ http://www.delphiarea.com }
{ }
{ This unit is provided "AS IS" without any warranty of any kind, either }
{ express or implied. The entire risk as to the quality and performance }
{ of the functions provided in this unit are with you. The author is NOT }
{ liable for any DAMAGES resulting from the use and misuse of the unit, }
{ especially he is NOT liable for DAMAGES that were caused BY ANY VERSION }
{ WHICH HAS NOT BEEN PROGRAMMED BY THE AUTHOR HIMSELF. }
{ }
{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ F U N C T I O N R E F E R E N C E }
{------------------------------------------------------------------------------}
{ }
{ TDateKind = (dkSolar, dkGregorian); }
{ }
{ This data type is the type of the first parameter of those functions, }
{ which can work on both of Solar and Gregorian dates to identify the }
{ desire calender system. }
{ }
{------------------------------------------------------------------------------}
{ }
{ function IsLeapYear(DateKind: TDateKind; Year: Word): Boolean; }
{ }
{ Returns true when the specified Year is a leap year (Kabiseh). }
{ }
{ Example: }
{ }
{ if IsLeapYear(dkSolar, 1375) then }
{ ShowMessage('1375 is leap year'); }
{ }
{------------------------------------------------------------------------------}
{ }
{ function DaysOfMonth(DateKind: TDateKind; Year, Month: Word): Word; }
{ }
{ Returns the number of days in the specified month. If the given date }
{ is not valid, it returns zero. }
{ }
{ Example: }
{ }
{ if DaysOfMonth(dkSolar, 1375, 12) = 30 then }
{ ShowMessage('Esfand 1375 has 30 days, so it is leap year'); }
{ }
{------------------------------------------------------------------------------}
{ }
{ fnction IsDateValid(DateKind: TDateKind; Year, Month, Day: Word): Boolean; }
{ }
{ Returns true if the specified date is a valid date. }
{ }
{ Example: }
{ }
{ if IsDateValid((dkSolar, 1375, 12, 30) then }
{ ShowMessage('30 Esfand 1375 is valid, so it is leap year'); }
{ }
{------------------------------------------------------------------------------}
{ }
{ DaysToDate(DateKind: TDateKind; Year, Month, Day: Word): Word; }
{ }
{ Returns the number of days since the first day of the year until the }
{ specified date. If the given date is not valid, it returns zero. }
{ }
{ Example: }
{ }
{ ShowMessage(Format('1349/2/8 is the %dth day of 1349', }
{ [DaysToDate(dkSolar, 1349, 2, 8)])); }
{ }
{------------------------------------------------------------------------------}
{ }
{ function DateOfDay(DateKind: TDateKind; Days, Year: Word; }
{ var Month, Day: Word): Boolean; }
{ }
{ }
{ Gives the number of days since the first day of the specified year and }
{ sets the Month and Day parameter to the proper values. If the date is a }
{ valid date, the function returns true, otherwise false will be returned. }
{ }
{ Example: }
{ }
{ DateOfDay(dkSolar, 39, 1349, Month, Day); }
{ ShowMessage(Format('39th day of 1349 is 1349/%d/%d', [Month, Day])); }
{ }
{------------------------------------------------------------------------------}
{ }
{ function GregorianToSolar(var Year, Month, Day: Word): Boolean; }
{ }
{ Converts the passed components of the Gregorian date to the appropriate }
{ Solar values. In case of any error, it returns false. }
{ }
{ Example: }
{ }
{ Year := 1970; }
{ Month := 4; }
{ Day := 28; }
{ GregorianToSolar(Year, Month, Day); }
{ ShowMessage(Format('1970/4/28 Gregorian = %d/%d/%d Solar', }
{ [Year, Month, Day])); }
{ }
{------------------------------------------------------------------------------}
{ }
{ function SolarToGregorian(var Year, Month, Day: Word): Boolean; }
{ }
{ Converts the passed components of the Solar date to the appropriate }
{ Gregorian values. In case of any error, it returns false. }
{ }
{ Example: }
{ }
{ Year := 1349; }
{ Month := 2; }
{ Day := 8; }
{ GregorianToSolar(Year, Month, Day); }
{ ShowMessage(Format('1349/2/8 Solar = %d/%d/%d Gregorian', }
{ [Year, Month, Day])); }
{ }
{------------------------------------------------------------------------------}
{ }
{ function SolarEncodeDate(Year, Month, Day: Word): TDateTime; }
{ }
{ Returns a TDateTime type as Gregorian for a specified Year, Month, and }
{ Day as Solar. If the specified solar date does not indicate a valid date, }
{ the return value is zero. }
{ }
{ Example: }
{ }
{ ShowMessage(DateToStr(SolarEncodeDate(1349, 2, 8))); }
{ }
{------------------------------------------------------------------------------}
{ }
{ procedure SolarDecodeDate(Date: TDateTime; var Year, Month, Day: Word); }
{ }
{ Breaks the passed Date as Gregorian into the appropriate Year, Month, and }
{ Day values as Solar. }
{ }
{ Example: }
{ }
{ SolarDecodeDate(Date, Year, Month, Day); }
{ ShowMessage(Format('Today is %d/%d/%d', [Year, Month, Day])); }
{ }
{------------------------------------------------------------------------------}
unit SolarUtl;
interface
uses SYSUtils, StrUtils;
type
TDateKind = (dkSolar, dkGregorian);
{87-04-15 add by SQL }
//تبديل تاريخ شمسي به ميلادي
function ShamsiToMiladi(Date:String):String;
//تبديل تاريخ ميلادي به شمسي
function MiladitoShamsi(Date:String):String;
{87-04-15 add by SQL }
//آيا سال كبيسه است يا نه
function IsLeapYear(DateKind: TDateKind; Year: Word): Boolean;
//روزهاي ماه
function DaysOfMonth(DateKind: TDateKind; Year, Month: Word): Word;
//آيا تاريخ صحيح است
function IsDateValid(DateKind: TDateKind; Year, Month, Day: Word): Boolean;
//تبديل رشته به تاريخ
function StrToDateEx(DateKind: TDateKind; sDate : string;var Year, Month, Day: Word): Boolean;
//تبديل تاريخ به رشته
function DateToStrEx(DateKind: TDateKind; Year, Month, Day: Word): string;
//تبديل سال ميلادي به شمسي با نتيجه رشته اي
function GregorianToSolarStr(Date: TDateTime): string;
//معتبر كردن تاريخ
procedure ValidateDate(DateKind: TDateKind;var Year, Month, Day: Word);
//تعداد روزهاي گذشته سال
function DaysToDate(DateKind: TDateKind; Year, Month, Day: Word): Word;
//تعداد روزهاي باقيمانده سال
function DaysToEndOfYear(DateKind: TDateKind; Year, Month, Day: Word): Word;
//تعداد روزها و سال را گرفته و ماه و روز مربوطه را مي دهد
function DateOfDay(DateKind: TDateKind; Days, Year: Word; var Month, Day: Word): Boolean;
//شماره روز هفته
function DayOfWeekEx(DateKind: TDateKind; Year: Word; Month, Day: Word): Word;
//افزودن به تاريخ
Procedure IncDate(DateKind: TDateKind;var Year, Month, Day: Word; AYears, AMonths, ADays: Smallint);overload;
function IncDate(DateKind: TDateKind; sDate: string; AYears, AMonths, ADays: Smallint):string;overload;
//تبديل تاريخ ميلادي به شمسي بصورت مجزا
function GregorianToSolar(var Year, Month, Day: Word): Boolean;
//تبديل تاريخ شمسي به ميلادي
function SolarToGregorian(var Year, Month, Day: Word): Boolean;
//تبديل تاريخ ميلادي به شمسي
function SolarEncodeDate(Year, Month, Day: Word): TDateTime;
//تبديل تاريخ ميلادي به شمسي
procedure SolarDecodeDate(Date: TDateTime; var Year, Month, Day: Word);
//تبديل تاريخ ميلادي به شمسي
procedure SolarDecodeDateStr(Date: TDateTime; var Year, Month, Day: String);
//مقدار عددي تاريخ شمسي
function SolarDateToInt(Year, Month, Day: Word): Integer;overload;
//مقدار عددي تاريخ شمسي
function SolarDateToInt(SolarStrDate: String): Integer;overload;
//برگرداندن عدد به تاريخ شمسي
function IntToSolarDate(SolarIntDate: Integer): String;
//تعداد روزهاي بين دو تاريخ شمسي
function SolarDaysBetween(const SolarNow, SolarThen: String): Integer;
//برگرداندن المانهاي تاريخ شمسي بصورت صحيح
function SolarDateElemans(SolarDate: String; var Year, Month, Day: Word): Boolean;
//آيا تاريخ شمسي صحيح است؟
function IsValidSolarDate(SolarDate: String): Boolean;
//آيا رشته داده شده فقط شامل عدد است؟
function IsIntNumber (S:String):Boolean;
implementation
uses DateUtils, Math;
const
// day of week sunday=1 ,...
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 >= 1) and (Year <= 9999) and (Month >= 1) and (Month <= 12) and
(Day >= 1) and (Day <= DaysOfMonth(DateKind, Year, Month));
end;
function StrToDateEx(DateKind: TDateKind; sDate : string;var Year, Month, Day: Word): Boolean;
begin
Result := False;
if SolarDateElemans(sDate, Year, Month, Day) then
Result := True;
end;
procedure ValidateDate(DateKind: TDateKind;var Year, Month, Day: Word);
begin
if (Year < 1) then Year := 1;
if (Year > 9999) then Year := 1;
if (Month < 1) then Month := 1;
if (Month > 12) then Month := 12;
if (Day < 1) then Day := 1;
if (Day > DaysOfMonth(DateKind, Year, Month)) then 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 DaysToEndOfYear(DateKind: TDateKind; Year, Month, Day: Word): Word;
begin
Result := IfThen(IsLeapYear(dkSolar, Year), 366, 365) -
DaysToDate(dkSolar, Year, Month, Day);
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;
function DayOfWeekEx(DateKind: TDateKind; Year: Word; Month, Day: Word): Word;
begin
if DateKind = dkSolar then
begin
SolarToGregorian(Year, Month, Day);
Result := DateTimeToTimeStamp(EncodeDate(Year, Month, Day)).Date mod 7 + 1
end
else
Result := DateTimeToTimeStamp(now).Date mod 7 + 1
end;
procedure SolarDecodeDateStr(Date: TDateTime; var Year, Month, Day: String);
var
Y, M, D: Word;
begin
SolarDecodeDate(Date, Y, M, D);
Year := IntToStr(Y);
Month := IntToStr(M);
Day := IntToStr(D);
end;
/// same as call 3 functions incday incmonth and incyear.
/// AYears, AMonths, ADays : are independent
Procedure IncDate(DateKind: TDateKind;var Year, Month, Day: Word; AYears, AMonths, ADays: SmallInt);
var
YY,MM,DD : Smallint;
begin
DD := DaysToDate(DateKind,Year,Month,Day) + ADays;
YY := Year;
while DD > 366 Do
begin
Dec(DD,365);
if IsLeapYear(dkSolar ,YY) then Dec(DD);
Inc(YY);
end;
if (DD = 366) and not IsLeapYear(dkSolar ,YY) then
begin
DD := 1;
Inc(YY);
end;
while DD <= 0 Do
begin
Dec(YY);
Inc(DD,365);
if IsLeapYear(dkSolar ,YY) then Inc(DD);
end;
DateOfDay(DateKind,DD,YY,Month,Day);
MM := Month+AMonths;
if MM > 12 then
begin
Inc(YY,MM Div 12);
MM := ((MM-1) mod 12)+1;
end;
if MM <= 0 then
begin
MM := -MM;
Dec(YY,(MM Div 12)+1);
MM := 12 - (MM mod 12);
end;
Month := MM;
YY := YY + AYears;
if YY > 0 then
Year := YY
else
Year := 0;
end;
function IncDate(DateKind: TDateKind; sDate: string; AYears, AMonths, ADays: SmallInt):string;
var
yy,mm,dd : Word;
begin
if StrToDateEx(DateKind,sDate,YY,MM,DD) then
begin
IncDate(DateKind,YY,MM,DD,AYears,AMonths,ADays);
Result := DateToStrEx(DateKind,yy,mm,dd);
end
else
begin
Result := '';
end
end;
function DateToStrEx(DateKind: TDateKind; Year, Month, Day: Word): string;
begin
Result := '';
if IsDateValid(DateKind, Year, Month, Day) then
begin
Result := IfThen(Year<1000,'0') + IfThen(Year<100,'0') +
IfThen(Year<10,'0') + IntToStr(Year) + DateSeparator + IfThen(Month<10,'0') +
IntToStr(Month) + DateSeparator + IfThen(Day<10,'0') + IntToStr(Day);
end;
end;
function GregorianToSolarStr(Date: TDateTime): string;
var
Y, M, D : Word;
begin
DecodeDate(Date, Y, M, D);
GregorianToSolar(Y, M, D);
Result := DateToStrEx(dkSolar, Y, M, D);
end;
function SolarDateToInt(Year, Month, Day: Word): Integer;
var
CurrYear: Word;
PastYear, i: Integer;
begin
Result := -1;
CurrYear := DaysToDate(dkSolar, Year, Month, Day);
PastYear := 0;
for i := 1 to Year - 1 do
PastYear := PastYear + IfThen(IsLeapYear(dkSolar, i), 366, 365);
if CurrYear <> 0 then
Result := PastYear + CurrYear;
end;
function SolarDateToInt(SolarStrDate: String): Integer;
var
Year, Month, Day: Word;
begin
Result := -1;
if StrToDateEx(dkSolar, SolarStrDate, Year, Month, Day) then
Result := SolarDateToInt(Year, Month, Day);
end;
function IntToSolarDate(SolarIntDate: Integer): String;
var
Year, Month, Day: Integer;
sYear, sMonth, sDay: String;
begin
Result := '';
if (SolarIntDate < 1) then Exit;
Year := 1;
while SolarIntDate > IfThen(IsLeapYear(dkSolar, Year), 366, 365) do
begin
SolarIntDate := SolarIntDate - IfThen(IsLeapYear(dkSolar, Year), 366, 365);
Year := Year + 1;
end;
Month := 1;
while SolarIntDate > DaysOfMonth(dkSolar, Year, Month) do
begin
SolarIntDate := SolarIntDate - DaysOfMonth(dkSolar, Year, Month);
Month := Month + 1;
end;
Day := SolarIntDate;
sYear := IntToStr(Year);
if Month < 10 then sMonth := '0' + IntToStr(Month) else sMonth := IntToStr(Month);
if Day < 10 then sDay := '0' + IntToStr(Day) else sMonth := IntToStr(Day);
Result := sYear + DateSeparator + sMonth + DateSeparator + sDay;
end;
function SolarDaysBetween(const SolarNow, SolarThen: String): Integer;
var
ANow, AThen: Integer;
begin
Result := -1;
ANow := SolarDateToInt(SolarNow);
AThen := SolarDateToInt(SolarThen);
if (ANow and AThen) <> -1 then
if ANow < AThen then
Result := AThen - ANow
else
Result := ANow - AThen;
end;
function SolarDateElemans(SolarDate: String; var Year, Month, Day: Word): Boolean;
var
sYear, sMonth, sDay: String;
i, NumSeprator: Integer;
begin
NumSeprator := 0;
Result := False;
for i := 1 to Length(SolarDate) do
if SolarDate[i] = DateSeparator then NumSeprator := NumSeprator + 1
else if not IsIntNumber(SolarDate[i]) then Exit;
if NumSeprator <> 2 then Exit;
for i := 1 to Pos(DateSeparator, SolarDate) -1 do
begin
sYear := sYear + SolarDate[1];
SolarDate := copy(SolarDate, 2, Length(SolarDate));
end;
SolarDate := copy(SolarDate, 2, Length(SolarDate));
for i := 1 to Pos(DateSeparator, SolarDate) - 1 do
begin
sMonth := sMonth + SolarDate[1];
SolarDate := copy(SolarDate, 2, Length(SolarDate));
end;
SolarDate := copy(SolarDate, 2, Length(SolarDate));
sDay := SolarDate;
Year := StrToInt(sYear);
Month := StrToInt(sMonth);
Day := StrToInt(sDay);
if IsDateValid(dkSolar, Year, Month, Day) then
Result := True;
end;
function IsValidSolarDate(SolarDate: String): Boolean;
var
Year, Month, Day: Word;
begin
Result := False;
if SolarDateElemans(SolarDate, Year, Month, Day) then
Result := True;
end;
Function IsIntNumber (S:String):Boolean;
Var
Loop:Integer;
Cons:String;
Begin
S := Trim(S);
Result := False;
if S = '' then Exit;
Cons := '1234567890';
Result := True;
for Loop := 1 to Length(S) do
if Pos(S[Loop], Cons) <= 0 then Result := False;
End;
{87-04-15 add by SQL }
function ShamsiToMiladi(Date:String):String;
var year,month,day :word;
t:string;
begin
year := strtoint(date[1]+date[2]+date[3]+date[4]);
month := strtoint(date[6]+date[7]);
day := strtoint(date[9]+date[10]);
SolarToGregorian(Year, Month, Day);
t := inttostr(year)+'/';
if month<10 then
t := t+'0'+inttostr(month)+'/'
else
t := t+inttostr(month)+'/';
if day<10 then
t := t+'0'+inttostr(day)
else
t := t +inttostr(day);
ShamsiToMiladi := t;
end;
function MiladitoShamsi(Date:String):String;
var year,month,day :word;
t: string;
begin
year := strtoint(date[1]+date[2]+date[3]+date[4]);
month := strtoint(date[6]+date[7]);
day := strtoint(date[9]+date[10]);
GregorianToSolar(Year, Month, Day);
t := inttostr(year)+'/';
if month<10 then
t := t+'0'+inttostr(month)+'/'
else
t := t+inttostr(month)+'/';
if day<10 then
t := t+'0'+inttostr(day)
else
t := t+inttostr(day);
MiladiToShamsi := t;
end;
{87-04-15 add by SQL }
end.
vBulletin® v4.2.5, Copyright ©2000-1403, Jelsoft Enterprises Ltd.