اینم یک یونیت با حال واسه تاریخ فارسی به اسم* UFarsiDate
کد:
[CODE]
unit UFarsiDate;
{-----------------------------------------}
{ * * * * *Farsi functions unit * * * * * }
{ * * *Use this unit for persian date * * }
{ * * * * * * * * * * * * * * * * * * * * }
{ * * *Written by: Salar Khalilzadeh * * *}
{ * * * * * *Copyright © 2006 * * * * * * }
{ * * * * * * SalarSoftwares * * * * * * *}
{ * * * * * * * * * * * * * * * * * * * * }
{----Website: <span style="font-family: trebuchet ms"><font size="3"><font color="Indigo"><b><font color="red">[فقط اعضاء انجمن قادر به مشاهده لینکها و عکسها می باشند <a href="/reg_iran.php" target="_blank">برای عضویت در سایت کلیک کنید</a>]</font></b></font></font></span>}
{----E-mail: SalarSoftwares@gmail.com-----}
{ * * * *Last update: 2006/05/08 * * * * *}
{-----------------------------------------}
{-----------------------------------------
Updates:
1-Persian date to Milady date conversion supported.
2-Support persian dates and strings
3-Support time included in TDateTime
4-Support Old version of Delphi
-----------------------------------------}
{IMPORTANT: TfarDateTime = TDateTime}
{Important note:
You never need to create TFarDate class.
Only add TFarDate string before functions.
Always use first: (FarEncodeDate or MiladyToShamsi or
* * * * * * * * *MiladyToShamsiInt or MiladyToShamsiStr or
* * * * * * * * *farStrToDate or farStrToDateDef )
after them use other functions.
}
interface
uses windows,sysutils,SysConst,math,DateUtils;
{$IFDEF VER140}
*{$DEFINE OldDelphi}
{$ENDIF}
{$IFDEF VER130}
*{$DEFINE OldDelphi}
{$ENDIF}
{$IFDEF VER120}
*{$DEFINE OldDelphi}
{$ENDIF}
const
*FarMonthDays: array [Boolean] of TDayTable =
* *((31, 31, 31, 31, 31, 31, 30, 30, 30, 30, 30, 29),
* * (31, 31, 31, 31, 31, 31, 30, 30, 30, 30, 30, 30));
const
*EngMonthDays: array [Boolean] of TDayTable =
* *((31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31),
* * (31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31));
const
*farEngToFarDays:array[1..7] of word=(7,1,2,3,4,5,6) * *;
*farShortMonths:array [1..12] of string=
* *("فروردين","ارديبهشت","خرداد ","تير","مرداد","شهريور","مهر"," بان",
* * *"آذر","دي","بهمن","اسفند");
*farLongMonths:array [1..12] of string=
* *("فروردين","ارديبهشت","خرداد ","تير","مرداد","شهريور","مهر"," بان",
* * *"آذر","دي","بهمن","اسفند");
*farShortDays:array [1..7] of string=
* *("جمعه","شنبه","يكشنبه","دو شنبه","سه شنبه","چهار شنبه","پنج شنبه");
*farLongDays:array [1..7] of string=
* *("جمعه","شنبه","يكشنبه","دو شنبه","سه شنبه","چهار شنبه","پنج شنبه");
const
*DaysPerWeek = 7;
*WeeksPerFortnight = 2;
*MonthsPerYear = 12;
*YearsPerDecade = 10;
*YearsPerCentury = 100;
*YearsPerMillennium = 1000;
*DayMonday = 1;
*DayTuesday = 2;
*DayWednesday = 3;
*DayThursday = 4;
*DayFriday = 5;
*DaySaturday = 6;
*DaySunday = 7;
var
*farShortMonthNames: array[1..12] of string;
*farLongMonthNames: array[1..12] of string;
*farShortDayNames: array[1..7] of string;
*farLongDayNames: array[1..7] of string;
type
*TDateOrder = (doMDY, doDMY, doYMD);
*TfarDateTime=TDateTime;
type
*TDateKind = (dkSolar, dkGregorian);
*
{$IfDef OldDelphi}
type
*TFormatSettings = record
* *CurrencyFormat: Byte;
* *NegCurrFormat: Byte;
* *ThousandSeparator: Char;
* *DecimalSeparator: Char;
* *CurrencyDecimals: Byte;
* *DateSeparator: Char;
* *TimeSeparator: Char;
* *ListSeparator: Char;
* *CurrencyString: string;
* *ShortDateFormat: string;
* *LongDateFormat: string;
* *TimeAMString: string;
* *TimePMString: string;
* *ShortTimeFormat: string;
* *LongTimeFormat: string;
* *ShortMonthNames: array[1..12] of string;
* *LongMonthNames: array[1..12] of string;
* *ShortDayNames: array[1..7] of string;
* *LongDayNames: array[1..7] of string;
* *TwoDigitYearCenturyWindow: Word;
*end;
Const
*{ Units of time }
*HoursPerDay * = 24;
*MinsPerHour * = 60;
*SecsPerMin * *= 60;
*MSecsPerSec * = 1000;
*MinsPerDay * *= HoursPerDay * MinsPerHour;
*SecsPerDay * *= MinsPerDay * SecsPerMin;
*MSecsPerDay * = SecsPerDay * MSecsPerSec;
{$EndIf}
type
*TFarDate=class
*Private
* *class function farIsLeapYear(Year: Word): Boolean;
* *//class procedure farDivMod(Dividend: Integer; Divisor: Word;
* *// *var Result, Remainder: Word);
* *class function FarDecodeDateFully(const DateTime: TDateTime; var Year, Month, Day, DOW: Word): Boolean;
* *class function farGetDateOrder(const DateFormat: string): TDateOrder;
* *class function farGetEraYearOffset(const Name: string): Integer;
* *class procedure farScanBlanks(const S: string; var Pos: Integer);
* *class function farScanChar(const S: string; var Pos: Integer; Ch: Char): Boolean;
* *class function farScanDate(const S: string; var Pos: Integer;
* * *var Date: TDateTime): Boolean; overload;
* *class function farScanDate(const S: string; var Pos: Integer; var Date: TDateTime;
* * *const FormatSettings: TFormatSettings): Boolean; overload;
* *class function farScanNumber(const S: string; var Pos: Integer;
* * *var Number: Word; var CharCount: Byte): Boolean;
* *class procedure farScanToNumber(const S: string; var Pos: Integer);
* *class function farTryEncodeDate(Year, Month, Day: Word; out Date: TDateTime): Boolean;
* *class function farTryStrToDate(const S: string; out Value: TDateTime): Boolean;overload;
* *class function farTryStrToDate(const S: string; out Value: TDateTime;
* * *const FormatSettings: TFormatSettings): Boolean;overload;
* *class procedure farDateTimeToString(var Result: string; const Format: string;
* * *DateTime: TDateTime);overload;
* *class procedure farDateTimeToString(var Result: string; const Format: string;
* * *DateTime: TDateTime; const FormatSettings: TFormatSettings);overload;
* *//class procedure farDateTimeToStringFarsi(var Result: string;
* *// *const Format: string; DateTime: TDateTime);
* *class function farTryEncodeDateTime(const AYear, AMonth, ADay, AHour, AMinute, ASecond,
* * *AMilliSecond: Word; out AValue: TDateTime): Boolean;
* *class procedure farDivMod(Dividend: Integer; Divisor: Word;
* * *var Result, Remainder: Word);
* *class function farTryEncodeTime(Hour, Min, Sec, MSec: Word; out Time: TDateTime): Boolean;
* *class function farDateOfDay(DateKind: TDateKind; Days, Year: Word;
* * *var Month, Day: Word): Boolean;
* *class function farDaysOfMonth(DateKind: TDateKind; Year,
* * *Month: Word): Word;
* *class function farDaysToDate(DateKind: TDateKind; Year, Month,
* * *Day: Word): Word;
* *class function farIsDateValid(DateKind: TDateKind; Year, Month,
* * *Day: Word): Boolean;
* *class function SolarIsLeapYear(DateKind: TDateKind;
* * *Year: Word): Boolean;
*public
* *class function farEncodeDate(const Year, Month, Day: Word): TfarDateTime;
* *class procedure farDecodeDate(const DateTime: TfarDateTime; var Year, Month, Day: Word);
* *class procedure farDecodeDateTime(const AValue: TfarDateTime; out AYear, AMonth, ADay,
* * * * * *AHour, AMinute, ASecond, AMilliSecond: Word);
* *class function farEncodeDateTime(const AYear, AMonth, ADay, AHour, AMinute, ASecond,
* * *AMilliSecond: Word): TfarDateTime;
* *class Function MiladyToShamsi(const DTime:tdateTime):TfarDateTime;
* *class Function MiladyToShamsistr(const DTime:tdateTime):String;
* *class Function MiladyToShamsiInt( const DTime:tdateTime;var Year,Month,Day:word):TfarDateTime;
* *class Function ShamsiToMilady(const DateTime: TfarDateTime): TDateTime;
* *class function farDateToStr(dateTime:TfarDateTime):string;overloa d;
* *class function farDateToStr(const DateTime: TfarDateTime;
* * *const FormatSettings: TFormatSettings): string;overload;
* *class function farDateTimeToStr(const DateTime: TfarDateTime): string;overload;
* *class function farDateTimeToStr(const DateTime: TfarDateTime;
* * *const FormatSettings: TFormatSettings): string;overload;
* *class function farFormatDateTime(const Format: string; DateTime: TfarDateTime): string;overload;
* *class function farFormatDateTime(const Format: string; DateTime: TfarDateTime;
* * *const FormatSettings: TFormatSettings): string;overload;
* *class function farStrToDateDef(const S: string; const Default: TfarDateTime): TfarDateTime;overload;
* *class function farStrToDateDef(const S: string; const Default: TfarDateTime;
* * *const FormatSettings: TFormatSettings): TfarDateTime;overload;
* *class function farStrToDate(const S: string): TfarDateTime;overload;
* *class function farStrToDate(const S: string;
* * *const FormatSettings: TFormatSettings): TfarDateTime;overload;
* *class function farYearOf(const AValue: TfarDateTime): Word;
* *class function farMonthOf(const AValue: TfarDateTime): Word;
* *class function farWeekOf(const AValue: TfarDateTime): Word; * * * * * * * * * * * {ISO 8601}
* *class function farDayOf(const AValue: TfarDateTime): Word;
* *class function farDayOfTheWeek(const AValue: TfarDateTime): Word;
* *class function farDayString(const AValue: TfarDateTime): string;
* *class function farMonthString(const AValue: TfarDateTime): string;
* *{-------------------------}
* *class function farWeekOfTheYear(const AValue: TfarDateTime): Word; overload; * * *{ISO 8601}
* *class function farWeekOfTheYear(const AValue: TfarDateTime; * * * * * * * * * * * {ISO 8601}
* * *var AYear: Word): Word; overload;
* *{ Encode/decode functions that work with week of year and day of week }
* *class procedure farDecodeDateWeek(const AValue: TfarDateTime; out AYear, * * * * *{ISO 8601}
* * *AWeekOfYear, ADayOfWeek: Word);
*end;
{ Pick-a-field functions }
function AddWeek(const AValue: TDateTime;
*const ANumberOfWeeks: Integer): TDateTime;
function AddDay(const AValue: TDateTime;
*const ANumberOfDays: Integer): TDateTime;
function AddHour(const AValue: TDateTime;
*const ANumberOfHours: Int64): TDateTime;
function AddMinute(const AValue: TDateTime;
*const ANumberOfMinutes: Int64): TDateTime;
function AddSecond(const AValue: TDateTime;
*const ANumberOfSeconds: Int64): TDateTime;
function AddMilliSecond(const AValue: TDateTime;
*const ANumberOfMilliSeconds: Int64): TDateTime;
implementation
function AddWeek(const AValue: TDateTime;
*const ANumberOfWeeks: Integer): TDateTime;
begin
*Result := AValue + ANumberOfWeeks * DaysPerWeek;
end;
function AddDay(const AValue: TDateTime;
*const ANumberOfDays: Integer): TDateTime;
begin
*Result := AValue + ANumberOfDays;
end;
function AddHour(const AValue: TDateTime;
*const ANumberOfHours: Int64): TDateTime;
begin
*Result := ((AValue * HoursPerDay) + ANumberOfHours) / HoursPerDay;
end;
function AddMinute(const AValue: TDateTime;
*const ANumberOfMinutes: Int64): TDateTime;
begin
*Result := ((AValue * MinsPerDay) + ANumberOfMinutes) / MinsPerDay;
end;
function AddSecond(const AValue: TDateTime;
*const ANumberOfSeconds: Int64): TDateTime;
begin
*Result := ((AValue * SecsPerDay) + ANumberOfSeconds) / SecsPerDay;
end;
function AddMilliSecond(const AValue: TDateTime;
*const ANumberOfMilliSeconds: Int64): TDateTime;
begin
*Result := ((AValue * MSecsPerDay) + ANumberOfMilliSeconds) / MSecsPerDay;
end;
class function TFarDate.farIsLeapYear(Year: Word): Boolean;
begin
*Result := (Year mod 4 = 0) and ((Year mod 100 <> 0) or (Year mod 400 = 0));
end;
{procedure farDivMod(Dividend: Integer; Divisor: Word;
*var Result, Remainder: Word);
asm
* * * *PUSH * *EBX
* * * *MOV * * EBX,EDX
* * * *MOV * * EDX,EAX
* * * *SHR * * EDX,16
* * * *DIV * * BX
* * * *MOV * * EBX,Remainder
* * * *MOV * * [ECX],AX
* * * *MOV * * [EBX],DX
* * * *POP * * EBX
end;}
class procedure TFarDate.farDivMod(Dividend: Integer; Divisor: Word;
*var Result, Remainder: Word);
begin
Result:= *Dividend div *Divisor;
Remainder:=Dividend-(Result * Divisor);
end;
class function TFarDate.farTryEncodeDate(Year, Month, Day: Word; out Date: TDateTime): Boolean;
var
*I: Integer;
*DayTable: PDayTable;
begin
*Result := False;
*DayTable := @farMonthDays[farIsLeapYear(Year)];
*if (Year >= 1) and (Year <= 9999) and (Month >= 1) and (Month <= 12) and
* *(Day >= 1) and (Day <= DayTable^[Month]) then
*begin
* *for I := 1 to Month - 1 do Inc(Day, DayTable^[I]);
* *I := Year - 1;
* *Date := int(I * 365 + I div 4 - I div 100 + I div 400 + Day - DateDelta);
* *Result := True;
*end;
end;
class function TFarDate.FarEncodeDate(const Year, Month, Day: Word): TfarDateTime;
begin
*if not FarTryEncodeDate(Year, Month, Day, Result) then
* *raise EConvertError.CreateRes(@SDateEncodeError);
end;
class function TFarDate.FarDecodeDateFully(const DateTime: TfarDateTime; var Year, Month, Day, DOW: Word): Boolean;
const
*D1 = 365;
*D4 = D1 * 4 + 1;
*D100 = D4 * 25 - 1;
*D400 = D100 * 4 + 1;
var
*Y, M, D, I: Word;
*T: Integer;
*DayTable: PDayTable;
begin
*T := DateTimeToTimeStamp(int(DateTime)).Date;
*if T <= 0 then
*begin
* *Year := 0;
* *Month := 0;
* *Day := 0;
* *DOW := 0;
* *Result := False;
*end else
*begin
* *DOW := T mod 7 + 1;
* *DOW:=farEngToFarDays[DOW];//=============Additional
* *Dec(T);
* *Y := 1;
* *while T >= D400 do
* *begin
* * *Dec(T, D400);
* * *Inc(Y, 400);
* *end;
* *farDivMod(T, D100, I, D);
* *if I = 4 then
* *begin
* * *Dec(I);
* * *Inc(D, D100);
* *end;
* *Inc(Y, I * 100);
* *farDivMod(D, D4, I, D);
* *Inc(Y, I * 4);
* *farDivMod(D, D1, I, D);
* *if I = 4 then
* *begin
* * *Dec(I);
* * *Inc(D, D1);
* *end;
* *Inc(Y, I);
* *Result := IsLeapYear(Y);
* *DayTable := @farMonthDays[Result];
* *M := 1;
* *while True do
* *begin
* * *I := DayTable^[M];
* * *if D < I then Break;
* * *Dec(D, I);
* * *Inc(M);
* *end;
* *Year := Y;
* *Month := M;
* *Day := D + 1;
*end;
end;
class procedure TFarDate.FarDecodeDate(const DateTime: TfarDateTime; var Year, Month, Day: Word);
var
*Dummy: Word;
begin
*FarDecodeDateFully(int(DateTime), Year, Month, Day, Dummy);
end;
{------------------------------------------------------------------------------}
{ *Persian date conversion to Gregorian has written by Kambiz R. * * * * * * * }
{ *I just match & correct it with this functions! * * * * * * * * * * * * * * *}
{------------------------------------------------------------------------------}
{ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ *SolarUtl - Solar Date Utility Functions * * * * * * * * * * * * * * * * * * }
{ *Copyright(C) 1995-2003 Kambiz R. Khojasteh, all rights reserved. * * * * * *}
{ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ *kambiz@delphiarea.com * * * * * * * * * * * * * * * * * * * * * * * * * * * }
{ *<span style="font-family: trebuchet ms"><font size="3"><font color="Indigo"><b><font color="red">[فقط اعضاء انجمن قادر به مشاهده لینکها و عکسها می باشند <a href="/reg_iran.php" target="_blank">برای عضویت در سایت کلیک کنید</a>]</font></b></font></font></span> * * * * * * * * * * * * * * * * * * * * * * * * * }
{ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{------------------------------------------------------------------------------}
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, *** });
class Function TFarDate.SolarIsLeapYear(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;
class Function TFarDate.farDaysOfMonth(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 SolarIsLeapYear(DateKind, Year) then
* * *Inc(Result);
*end
*else
* *Result := 0;
end;
class Function TFarDate.farIsDateValid(DateKind: TDateKind; Year, Month, Day: Word): Boolean;
begin
*Result := (Year <> 0) and (Month >= 1) and (Month <= 12) and
* * * * * *(Day >= 1) and (Day <= farDaysOfMonth(DateKind, Year, Month));
end;
class Function TFarDate.farDaysToDate(DateKind: TDateKind; Year, Month, Day: Word): Word;
begin
*if farIsDateValid(DateKind, Year, Month, Day) then
*begin
* *Result := DaysToMonth[DateKind, Month] + Day;
* *if (Month > LeapMonth[DateKind]) and SolarIsLeapYear(DateKind, Year) then
* * *Inc(Result);
*end
*else
* *Result := 0;
end;
class Function TFarDate.farDateOfDay(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 SolarIsLeapYear(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 := farIsDateValid(DateKind, Year, Month, Day);
end;
class Function TFarDate.ShamsiToMilady(const DateTime: TfarDateTime): TDateTime;
var
*LeapDay, Days: Integer;
*PrevSolarLeap ,problem : Boolean;
*Year, Month, Day,H,M,S,MS:Word;
begin
*self.farDecodeDateTime(DateTime,Year, Month, Day,H,M,S,MS);
*if farIsDateValid(dkSolar, Year, Month, Day) then
*begin
* *PrevSolarLeap := SolarIsLeapYear(dkSolar, Year-1);
* *Days := farDaysToDate(dkSolar, Year, Month, Day);
* *Inc(Year, 621);
* *if SolarIsLeapYear(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;
* *problem :=not farDateOfDay(dkGregorian, Days, Year, Month, Day);
*end
*else
* *problem := true;
*if(problem)then
* *raise Exception.Create(SInvalidDate);
*Result:=EncodeDateTime(Year, Month, Day,H,M,S,MS); * *
end;
{------------------------------------------------------------------------------}
{ *END OF "Persian date conversion to Gregorian" FUNCTIONS * * * * * * * * * * }
{------------------------------------------------------------------------------}
class Function TFarDate.MiladyToShamsiInt(const DTime:tdateTime;var Year,Month,Day:word):TfarDateTime;
begin
Result:=MiladyToShamsi(int(DTime));
FarDecodeDate(Result,Year,Month,Day);
end;
class Function TFarDate.MiladyToShamsiStr(const DTime:tdateTime):String;
var Year,Month,Day:word;
daystr ,monthstr : string;
begin
FarDecodeDate(MiladyToShamsi(int(DTime)),Year,Mont h,Day);
daystr := IntToStr(Day);
monthstr:= IntToStr(Month);
If Day < 10 then
begin
daystr := "0" + daystr ;
end
else
begin
daystr := IntToStr(Day);
end;
if Month < 10 then
begin
monthstr *:= "0" + monthstr ;
end
else
begin
monthstr := IntToStr(Month);
end;
Result:=inttostr(Year)+DateSeparator+ monthstr +DateSeparator+ daystr;
end;
class Function TFarDate.MiladyToShamsi(const DTime:tdateTime):TfarDateTime;
var
*YearEqual:array[0..2,0..2] of integer;
*AddOneDay,AddFarDay:boolean;
*AddTodays:byte;
*Farday:byte;
*ThisDay:word;
*ThisMonth:word;
*ThisYear:word;
*YearDif1:Integer;
*YearDif2:Integer;
*TestRange1,testRange2,
*FarsiRange1,FarsiRange2,P:Integer;
*CurM,CurD:string;
*sYear,sMonth,sDay:Variant;
*Counter:Integer;
*CurDay,CurMonth,CurYear:word;
*hour,min,sec,msec:word;
Begin
CurM:="";
CurD:="";
YearEqual[1,1]:=1997;
YearEqual[1,2]:=1998;
YearEqual[2,1]:=1376;
YearEqual[2,2]:=1377;
DecodeDate(int(DTime),thisyear,thismonth,thisday);
DecodeTime(DTime,hour,min,sec,msec);
YearDif1:=ThisYear-1997;
YearDif2:=ThisYear-1998;
Testrange1:=1996-(100*4);
Testrange2:=1996+(100*4);
FarsiRange1:=1375-(100*4);
FarsiRange2:=1375+(100*4);
AddOneDay:=false;
//Rem------------------------------
Counter:=TestRange1;
while TestRange2>=Counter do begin /////////////////////////
*If thisYear=counter then begin
* *AddOneDay:=true;
* *break;
*end;
*If counter=TestRange2 then break;
*counter:=counter+4
end;//while
If AddOneDay then
*addtodays:=1
Else
*AddTodays:=0;
//Rem---------------------------------/////////////////
If (((ThisMonth = 3) and (thisday<(20+AddtoDays)))
* *or ( ThisMonth<3)) then
*YearDif1:=yearDif1-1;
//Rem------------
If *(((thisYear mod 2)<>0) and
* *(((thismonth=3) and (thisday>(20-addTodays)))
* *or (thisMonth>4))) then
*CurYear:=yearEqual[2,1]+YearDif1
else begin
*CurYear:=YearEqual[2,1]+YearDif2;
*Counter:=FarsiRange1;
*while counter>FarsiRange2 do begin /////////////////////////
* *If CurYear=Counter then begin
* * *AddFarDay:=true;
* * *break;
* *end;
*If FarsiRange2>=Counter then break;
*counter:=counter+4
*end;//while
*If AddFarDay then
* *FarDay:=1 *else * Farday:=0;
*If (((thismonth=3) and (thisday>20-(addToDays)+FarDay)) or *(thismonth>3) ) then
* *CurYear:=CurYear+1;
end; //First If
If AddtoDays=1 then FarDay:=0;
//Rem---------------------------------
Case thismonth of
*1:Begin
* * *If thisday<(21-Farday) then begin
* * * *CurMonth:=10;
* * * *CurDay:=(ThisDay+10)+FarDay;
* * *end else begin
* * * *CurMonth:=11;
* * * *CurDay:=(ThisDay-20)+FarDay;
* * *end;
* *end;
*2:Begin
* * *If thisday<(20-Farday) then begin
* * * *CurMonth:=11;
* * * *CurDay:=(ThisDay+11)+FarDay;
* * *end else begin
* * * *CurMonth:=12;
* * * *CurDay:=(ThisDay-19)+FarDay;
* * *end;
* *End;
*3:Begin
* * *If thisday<(21-AddToDays) then begin
* * * *CurMonth:=12;
* * * *CurDay:=(ThisDay+9)+AddToDays+FarDay;
* * *end else begin
* * * *CurMonth:=1;
* * * *CurDay:=(ThisDay-20)+AddToDays;
* * *end;
* *End;
*4:Begin
* * *If thisday<(21-AddToDays) then begin
* * * *CurMonth:=1;
* * * *CurDay:=(ThisDay+11)+AddToDays;
* * *end else begin
* * * *CurMonth:=2;
* * * *CurDay:=(ThisDay-20)+AddToDays;
* * *end;
* *End;
*5:Begin
* * *If thisday<(22-AddToDays) then begin
* * * *CurMonth:=2;
* * * *CurDay:=(ThisDay+10)+AddToDays;
* * *end else begin
* * * *CurMonth:=3;
* * * *CurDay:=(ThisDay-21)+AddToDays;
* * *end;
* *End;
*6:Begin
* * *If thisday<(22-AddToDays) then begin
* * * *CurMonth:=3;
* * * *CurDay:=(ThisDay+10)+AddToDays;
* * *end else begin
* * * *CurMonth:=4;
* * * *CurDay:=(ThisDay-21)+AddToDays;
* * *end;
* *End;
*7:Begin
* * *If thisday<(23-AddToDays) then begin
* * * *CurMonth:=4;
* * * *CurDay:=(ThisDay+9)+AddToDays;
* * *end else begin
* * * *CurMonth:=5;
* * * *CurDay:=(ThisDay-22)+AddToDays;
* * *end;
* *End;
*8:Begin
* * *If thisday<(23-AddToDays) then begin
* * * *CurMonth:=5;
* * * *CurDay:=(ThisDay+9)+AddToDays;
* * *end else begin
* * * *CurMonth:=6;
* * * *CurDay:=(ThisDay-22)+AddToDays;
* * *end;
* *End;
*9:Begin
* * *If thisday<(23-AddToDays) then begin
* * * *CurMonth:=6;
* * * *CurDay:=(ThisDay+9)+AddToDays;
* * *end else begin
* * * *CurMonth:=7;
* * * *CurDay:=(ThisDay-22)+AddToDays;
* * *end;
* *End;
10:Begin
* * *If thisday<(23-AddToDays) then begin
* * * *CurMonth:=7;
* * * *CurDay:=(ThisDay+8)+AddToDays;
* * *end else begin
* * * *CurMonth:=8;
* * * *CurDay:=(ThisDay-22)+AddToDays;
* * *end;
* *End;
11:Begin
* * *If thisday<(22-AddToDays) then begin
* * * *CurMonth:=8;
* * * *CurDay:=(ThisDay+9)+AddToDays;
* * *end else begin
* * * *CurMonth:=9;
* * * *CurDay:=(ThisDay-21)+AddToDays;
* * *end;
* *End;
12:Begin
* * *If thisday<(22-AddToDays) then begin
* * * *CurMonth:=9;
* * * *CurDay:=(ThisDay+9)+AddToDays;
* * *end else begin
* * * *CurMonth:=10;
* * * *CurDay:=(ThisDay-21)+AddToDays;
* * *end;
* *End;
end;//case
//Rem-----------------
CurM:=Trim(IntTostr(CurMonth));
CurD:=Trim(IntTostr(CurDay));
//Rem-----------------
If CurMonth<10 then
*CurM:="0"+Trim(IntToStr(CurMonth));
If CurDay<10 then
*CurD:="0"+Trim(IntTostr(CurDay));
Result:=farEncodeDateTime(CurYear,CurMonth,CurDay, hour,min,sec,msec);
//Result:=farEncodeDate(CurYear,CurMonth,CurDay);
//Result:=int(Result)+EncodeTime(hour,min,sec,msec)) ;
end;
class procedure TFarDate.farDateTimeToString(var Result: string; const Format: string;
*DateTime: TDateTime);
var
*BufPos, AppendLevel: Integer;
*Buffer: array[0..255] of Char;
*procedure AppendChars(P: PChar; Count: Integer);
*var
* *N: Integer;
*begin
* *N := SizeOf(Buffer) - BufPos;
* *if N > Count then N := Count;
* *if N <> 0 then Move(P[0], Buffer[BufPos], N);
* *Inc(BufPos, N);
*end;
*procedure AppendString(const S: string);
*begin
* *AppendChars(Pointer(S), Length(S));
*end;
*procedure AppendNumber(Number, Digits: Integer);
*const
* *Format: array[0..3] of Char = "%.*d";
*var
* *NumBuf: array[0..15] of Char;
*begin
* *AppendChars(NumBuf, FormatBuf(NumBuf, SizeOf(NumBuf), Format,
* * *SizeOf(Format), [Digits, Number]));
*end;
*procedure AppendFormat(Format: PChar);
*var
* *Starter, Token, LastToken: Char;
* *DateDecoded, TimeDecoded, Use12HourClock,
* *BetweenQuotes: Boolean;
* *P: PChar;
* *Count: Integer;
* *Year, Month, Day, Hour, Min, Sec, MSec, H: Word;
* *procedure GetCount;
* *var
* * *P: PChar;
* *begin
* * *P := Format;
* * *while Format^ = Starter do Inc(Format);
* * *Count := Format - P + 1;
* *end;
* *procedure GetDate;
* *begin
* * *if not DateDecoded then
* * *begin
* * * *farDecodeDate(DateTime, Year, Month, Day);
* * * *DateDecoded := True;
* * *end;
* *end;
* *procedure GetTime;
* *begin
* * *if not TimeDecoded then
* * *begin
* * * *DecodeTime(DateTime, Hour, Min, Sec, MSec);
* * * *TimeDecoded := True;
* * *end;
* *end;
{$IFDEF MSWINDOWS}
* *function ConvertEraString(const Count: Integer) : string;
* *var
* * *FormatStr: string;
* * *SystemTime: TSystemTime;
* * *Buffer: array[Byte] of Char;
* * *P: PChar;
* *begin
* * *Result := "";
* * *with SystemTime do
* * *begin
* * * *wYear *:= Year;
* * * *wMonth := Month;
* * * *wDay * := Day;
* * *end;
* * *FormatStr := "gg";
* * *if GetDateFormat(GetThreadLocale, DATE_USE_ALT_CALENDAR, @SystemTime,
* * * *PChar(FormatStr), Buffer, SizeOf(Buffer)) <> 0 then
* * *begin
* * * *Result := Buffer;
* * * *if Count = 1 then
* * * *begin
* * * * *case SysLocale.PriLangID of
* * * * * *LANG_JAPANESE:
* * * * * * *Result := Copy(Result, 1, CharToBytelen(Result, 1));
* * * * * *LANG_CHINESE:
* * * * * * *if (SysLocale.SubLangID = SUBLANG_CHINESE_TRADITIONAL)
* * * * * * * *and (ByteToCharLen(Result, Length(Result)) = 4) then
* * * * * * *begin
* * * * * * * *P := Buffer + CharToByteIndex(Result, 3) - 1;
* * * * * * * *SetString(Result, P, CharToByteLen(P, 2));
* * * * * * *end;
* * * * *end;
* * * *end;
* * *end;
* *end;
* *function ConvertYearString(const Count: Integer): string;
* *var
* * *FormatStr: string;
* * *SystemTime: TSystemTime;
* * *Buffer: array[Byte] of Char;
* *begin
* * *Result := "";
* * *with SystemTime do
* * *begin
* * * *wYear *:= Year;
* * * *wMonth := Month;
* * * *wDay * := Day;
* * *end;
* * *if Count <= 2 then
* * * *FormatStr := "yy" // avoid Win95 bug.
* * *else
* * * *FormatStr := "yyyy";
* * *if GetDateFormat(GetThreadLocale, DATE_USE_ALT_CALENDAR, @SystemTime,
* * * *PChar(FormatStr), Buffer, SizeOf(Buffer)) <> 0 then
* * *begin
* * * *Result := Buffer;
* * * *if (Count = 1) and (Result[1] = "0") then
* * * * *Result := Copy(Result, 2, Length(Result)-1);
* * *end;
* *end;
{$ENDIF}
{$IFDEF LINUX}
* *function FindEra(Date: Integer): Byte;
* *var
* * *I : Byte;
* *begin
* * *Result := 0;
* * *for I := 1 to EraCount do
* * *begin
* * * *if (EraRanges[I].StartDate <= Date) and
* * * * *(EraRanges[I].EndDate >= Date) then
* * * *begin
* * * * *Result := I;
* * * * *Exit;
* * * *end;
* * *end;
* *end;
* *function ConvertEraString(const Count: Integer) : String;
* *var
* * *I : Byte;
* *begin
* * *Result := "";
* * *I := FindEra(Trunc(DateTime));
* * *if I > 0 then
* * * *Result := EraNames[I];
* *end;
* *function ConvertYearString(const Count: Integer) : String;
* *var
* * *I : Byte;
* * *S : string;
* *begin
* * *I := FindEra(Trunc(DateTime));
* * *if I > 0 then
* * * *S := IntToStr(Year - EraYearOffsets[I])
* * *else
* * * *S := IntToStr(Year);
* * *while Length(S) < Count do
* * * *S := "0" + S;
* * *if Length(S) > Count then
* * * *S := Copy(S, Length(S) - (Count - 1), Count);
* * *Result := S;
* *end;
{$ENDIF}
*begin
* *if (Format <> nil) and (AppendLevel < 2) then
* *begin
* * *Inc(AppendLevel);
* * *LastToken := " ";
* * *DateDecoded := False;
* * *TimeDecoded := False;
* * *Use12HourClock := False;
* * *while Format^ <> #0 do
* * *begin
* * * *Starter := Format^;
* * * *if Starter in LeadBytes then
* * * *begin
* * * * *AppendChars(Format, StrCharLength(Format));
* * * * *Format := StrNextChar(Format);
* * * * *LastToken := " ";
* * * * *Continue;
* * * *end;
* * * *Format := StrNextChar(Format);
* * * *Token := Starter;
* * * *if Token in ["a".."z"] then Dec(Token, 32);
* * * *if Token in ["A".."Z"] then
* * * *begin
* * * * *if (Token = "M") and (LastToken = "H") then Token := "N";
* * * * *LastToken := Token;
* * * *end;
* * * *case Token of
* * * * *"Y":
* * * * * *begin
* * * * * * *GetCount;
* * * * * * *GetDate;
* * * * * * *if Count <= 2 then
* * * * * * * *AppendNumber(Year mod 100, 2) else
* * * * * * * *AppendNumber(Year, 4);
* * * * * *end;
* * * * *"G":
* * * * * *begin
* * * * * * *GetCount;
* * * * * * *GetDate;
* * * * * * *AppendString(ConvertEraString(Count));
* * * * * *end;
* * * * *"E":
* * * * * *begin
* * * * * * *GetCount;
* * * * * * *GetDate;
* * * * * * *AppendString(ConvertYearString(Count));
* * * * * *end;
* * * * *"M":
* * * * * *begin
* * * * * * *GetCount;
* * * * * * *GetDate;
* * * * * * *case Count of
* * * * * * * *1, 2: AppendNumber(Month, Count);
* * * * * * * *3: AppendString(farShortMonthNames[Month]);
* * * * * * *else
* * * * * * * *AppendString(farLongMonthNames[Month]);
* * * * * * *end;
* * * * * *end;
* * * * *"D":
* * * * * *begin
* * * * * * *GetCount;
* * * * * * *case Count of
* * * * * * * *1, 2:
* * * * * * * * *begin
* * * * * * * * * *GetDate;
* * * * * * * * * *AppendNumber(Day, Count);
* * * * * * * * *end;
* * * * * * * *3: AppendString(farShortDayNames[farDayOfTheWeek(DateTime)]);
* * * * * * * *4: AppendString(farLongDayNames[farDayOfTheWeek(DateTime)]);
* * * * * * * *5: AppendFormat(Pointer(ShortDateFormat));
* * * * * * *else
* * * * * * * *AppendFormat(Pointer(LongDateFormat));
* * * * * * *end;
* * * * * *end;
* * * * *"H":
* * * * * *begin
* * * * * * *GetCount;
* * * * * * *GetTime;
* * * * * * *BetweenQuotes := False;
* * * * * * *P := Format;
* * * * * * *while P^ <> #0 do
* * * * * * *begin
* * * * * * * *if P^ in LeadBytes then
* * * * * * * *begin
* * * * * * * * *P := StrNextChar(P);
* * * * * * * * *Continue;
* * * * * * * *end;
* * * * * * * *case P^ of
* * * * * * * * *"A", "a":
* * * * * * * * * *if not BetweenQuotes then
* * * * * * * * * *begin
* * * * * * * * * * *if ( (StrLIComp(P, "AM/PM", 5) = 0)
* * * * * * * * * * * *or (StrLIComp(P, "A/P", * 3) = 0)
* * * * * * * * * * * *or (StrLIComp(P, "AMPM", *4) = 0) ) then
* * * * * * * * * * * *Use12HourClock := True;
* * * * * * * * * * *Break;
* * * * * * * * * *end;
* * * * * * * * *"H", "h":
* * * * * * * * * *Break;
* * * * * * * * *"""", """: BetweenQuotes := not BetweenQuotes;
* * * * * * * *end;
* * * * * * * *Inc(P);
* * * * * * *end;
* * * * * * *H := Hour;
* * * * * * *if Use12HourClock then
* * * * * * * *if H = 0 then H := 12 else if H > 12 then Dec(H, 12);
* * * * * * *if Count > 2 then Count := 2;
* * * * * * *AppendNumber(H, Count);
* * * * * *end;
* * * * *"N":
* * * * * *begin
* * * * * * *GetCount;
* * * * * * *GetTime;
* * * * * * *if Count > 2 then Count := 2;
* * * * * * *AppendNumber(Min, Count);
* * * * * *end;
* * * * *"S":
* * * * * *begin
* * * * * * *GetCount;
* * * * * * *GetTime;
* * * * * * *if Count > 2 then Count := 2;
* * * * * * *AppendNumber(Sec, Count);
* * * * * *end;
* * * * *"T":
* * * * * *begin
* * * * * * *GetCount;
* * * * * * *if Count = 1 then
* * * * * * * *AppendFormat(Pointer(ShortTimeFormat)) else
* * * * * * * *AppendFormat(Pointer(LongTimeFormat));
* * * * * *end;
* * * * *"Z":
* * * * * *begin
* * * * * * *GetCount;
* * * * * * *GetTime;
* * * * * * *if Count > 3 then Count := 3;
* * * * * * *AppendNumber(MSec, Count);
* * * * * *end;
* * * * *"A":
* * * * * *begin
* * * * * * *GetTime;
* * * * * * *P := Format - 1;
* * * * * * *if StrLIComp(P, "AM/PM", 5) = 0 then
* * * * * * *begin
* * * * * * * *if Hour >= 12 then Inc(P, 3);
* * * * * * * *AppendChars(P, 2);
* * * * * * * *Inc(Format, 4);
* * * * * * * *Use12HourClock := TRUE;
* * * * * * *end else
* * * * * * *if StrLIComp(P, "A/P", 3) = 0 then
* * * * * * *begin
* * * * * * * *if Hour >= 12 then Inc(P, 2);
* * * * * * * *AppendChars(P, 1);
* * * * * * * *Inc(Format, 2);
* * * * * * * *Use12HourClock := TRUE;
* * * * * * *end else
* * * * * * *if StrLIComp(P, "AMPM", 4) = 0 then
* * * * * * *begin
* * * * * * * *if Hour < 12 then
* * * * * * * * *AppendString(TimeAMString) else
* * * * * * * * *AppendString(TimePMString);
* * * * * * * *Inc(Format, 3);
* * * * * * * *Use12HourClock := TRUE;
* * * * * * *end else
* * * * * * *if StrLIComp(P, "AAAA", 4) = 0 then
* * * * * * *begin
* * * * * * * *GetDate;
* * * * * * * *AppendString(farLongDayNames[farDayOfTheWeek(DateTime)]);
* * * * * * * *Inc(Format, 3);
* * * * * * *end else
* * * * * * *if StrLIComp(P, "AAA", 3) = 0 then
* * * * * * *begin
* * * * * * * *GetDate;
* * * * * * * *AppendString(ShortDayNames[farDayOfTheWeek(DateTime)]);
* * * * * * * *Inc(Format, 2);
* * * * * * *end else
* * * * * * *AppendChars(@Starter, 1);
* * * * * *end;
* * * * *"C":
* * * * * *begin
* * * * * * *GetCount;
* * * * * * *AppendFormat(Pointer(ShortDateFormat));
* * * * * * *GetTime;
* * * * * * *if (Hour <> 0) or (Min <> 0) or (Sec <> 0) then
* * * * * * *begin
* * * * * * * *AppendChars(" ", 1);
* * * * * * * *AppendFormat(Pointer(LongTimeFormat));
* * * * * * *end;
* * * * * *end;
* * * * *"/":
* * * * * *if DateSeparator <> #0 then
* * * * * * *AppendChars(@DateSeparator, 1);
* * * * *":":
* * * * * *if TimeSeparator <> #0 then
* * * * * * *AppendChars(@TimeSeparator, 1);
* * * * *"""", """:
* * * * * *begin
* * * * * * *P := Format;
* * * * * * *while (Format^ <> #0) and (Format^ <> Starter) do
* * * * * * *begin
* * * * * * * *if Format^ in LeadBytes then
* * * * * * * * *Format := StrNextChar(Format)
* * * * * * * *else
* * * * * * * * *Inc(Format);
* * * * * * *end;
* * * * * * *AppendChars(P, Format - P);
* * * * * * *if Format^ <> #0 then Inc(Format);
* * * * * *end;
* * * *else
* * * * *AppendChars(@Starter, 1);
* * * *end;
* * *end;
* * *Dec(AppendLevel);
* *end;
*end;
begin
*BufPos := 0;
*AppendLevel := 0;
*if Format <> "" then AppendFormat(Pointer(Format)) else AppendFormat("C");
*SetString(Result, Buffer, BufPos);
end;
class procedure TFarDate.farDateTimeToString(var Result: string; const Format: string;
*DateTime: TDateTime; const FormatSettings: TFormatSettings);
var
*BufPos, AppendLevel: Integer;
*Buffer: array[0..255] of Char;
*procedure AppendChars(P: PChar; Count: Integer);
*var
* *N: Integer;
*begin
* *N := SizeOf(Buffer) - BufPos;
* *if N > Count then N := Count;
* *if N <> 0 then Move(P[0], Buffer[BufPos], N);
* *Inc(BufPos, N);
*end;
*procedure AppendString(const S: string);
*begin
* *AppendChars(Pointer(S), Length(S));
*end;
*procedure AppendNumber(Number, Digits: Integer);
*const
* *Format: array[0..3] of Char = "%.*d";
*var
* *NumBuf: array[0..15] of Char;
*begin
* *AppendChars(NumBuf, FormatBuf(NumBuf, SizeOf(NumBuf), Format,
* * *SizeOf(Format), [Digits, Number]));
*end;
*procedure AppendFormat(Format: PChar);
*var
* *Starter, Token, LastToken: Char;
* *DateDecoded, TimeDecoded, Use12HourClock,
* *BetweenQuotes: Boolean;
* *P: PChar;
* *Count: Integer;
* *Year, Month, Day, Hour, Min, Sec, MSec, H: Word;
* *procedure GetCount;
* *var
* * *P: PChar;
* *begin
* * *P := Format;
* * *while Format^ = Starter do Inc(Format);
* * *Count := Format - P + 1;
* *end;
* *procedure GetDate;
* *begin
* * *if not DateDecoded then
* * *begin
* * * *farDecodeDate(DateTime, Year, Month, Day);
* * * *DateDecoded := True;
* * *end;
* *end;
* *procedure GetTime;
* *begin
* * *if not TimeDecoded then
* * *begin
* * * *DecodeTime(DateTime, Hour, Min, Sec, MSec);
* * * *TimeDecoded := True;
* * *end;
* *end;
{$IFDEF MSWINDOWS}
* *function ConvertEraString(const Count: Integer) : string;
* *var
* * *FormatStr: string;
* * *SystemTime: TSystemTime;
* * *Buffer: array[Byte] of Char;
* * *P: PChar;
* *begin
* * *Result := "";
* * *with SystemTime do
* * *begin
* * * *wYear *:= Year;
* * * *wMonth := Month;
* * * *wDay * := Day;
* * *end;
* * *FormatStr := "gg";
* * *if GetDateFormat(GetThreadLocale, DATE_USE_ALT_CALENDAR, @SystemTime,
* * * *PChar(FormatStr), Buffer, SizeOf(Buffer)) <> 0 then
* * *begin
* * * *Result := Buffer;
* * * *if Count = 1 then
* * * *begin
* * * * *case SysLocale.PriLangID of
* * * * * *LANG_JAPANESE:
* * * * * * *Result := Copy(Result, 1, CharToBytelen(Result, 1));
* * * * * *LANG_CHINESE:
* * * * * * *if (SysLocale.SubLangID = SUBLANG_CHINESE_TRADITIONAL)
* * * * * * * *and (ByteToCharLen(Result, Length(Result)) = 4) then
* * * * * * *begin
* * * * * * * *P := Buffer + CharToByteIndex(Result, 3) - 1;
* * * * * * * *SetString(Result, P, CharToByteLen(P, 2));
* * * * * * *end;
* * * * *end;
* * * *end;
* * *end;
* *end;
* *function ConvertYearString(const Count: Integer): string;
* *var
* * *FormatStr: string;
* * *SystemTime: TSystemTime;
* * *Buffer: array[Byte] of Char;
* *begin
* * *Result := "";
* * *with SystemTime do
* * *begin
* * * *wYear *:= Year;
* * * *wMonth := Month;
* * * *wDay * := Day;
* * *end;
* * *if Count <= 2 then
* * * *FormatStr := "yy" // avoid Win95 bug.
* * *else
* * * *FormatStr := "yyyy";
* * *if GetDateFormat(GetThreadLocale, DATE_USE_ALT_CALENDAR, @SystemTime,
* * * *PChar(FormatStr), Buffer, SizeOf(Buffer)) <> 0 then
* * *begin
* * * *Result := Buffer;
* * * *if (Count = 1) and (Result[1] = "0") then
* * * * *Result := Copy(Result, 2, Length(Result)-1);
* * *end;
* *end;
{$ENDIF}
{$IFDEF LINUX}
* *function FindEra(Date: Integer): Byte;
* *var
* * *I : Byte;
* *begin
* * *Result := 0;
* * *for I := 1 to EraCount do
* * *begin
* * * *if (EraRanges[I].StartDate <= Date) and
* * * * *(EraRanges[I].EndDate >= Date) then
* * * *begin
* * * * *Result := I;
* * * * *Exit;
* * * *end;
* * *end;
* *end;
* *function ConvertEraString(const Count: Integer) : String;
* *var
* * *I : Byte;
* *begin
* * *Result := "";
* * *I := FindEra(Trunc(DateTime));
* * *if I > 0 then
* * * *Result := EraNames[I];
* *end;
* *function ConvertYearString(const Count: Integer) : String;
* *var
* * *I : Byte;
* * *S : string;
* *begin
* * *I := FindEra(Trunc(DateTime));
* * *if I > 0 then
* * * *S := IntToStr(Year - EraYearOffsets[I])
* * *else
* * * *S := IntToStr(Year);
* * *while Length(S) < Count do
* * * *S := "0" + S;
* * *if Length(S) > Count then
* * * *S := Copy(S, Length(S) - (Count - 1), Count);
* * *Result := S;
* *end;
{$ENDIF}
*begin
* *if (Format <> nil) and (AppendLevel < 2) then
* *begin
* * *Inc(AppendLevel);
* * *LastToken := " ";
* * *DateDecoded := False;
* * *TimeDecoded := False;
* * *Use12HourClock := False;
* * *while Format^ <> #0 do
* * *begin
* * * *Starter := Format^;
* * * *if Starter in LeadBytes then
* * * *begin
* * * * *AppendChars(Format, StrCharLength(Format));
* * * * *Format := StrNextChar(Format);
* * * * *LastToken := " ";
* * * * *Continue;
* * * *end;
* * * *Format := StrNextChar(Format);
* * * *Token := Starter;
* * * *if Token in ["a".."z"] then Dec(Token, 32);
* * * *if Token in ["A".."Z"] then
* * * *begin
* * * * *if (Token = "M") and (LastToken = "H") then Token := "N";
* * * * *LastToken := Token;
* * * *end;
* * * *case Token of
* * * * *"Y":
* * * * * *begin
* * * * * * *GetCount;
* * * * * * *GetDate;
* * * * * * *if Count <= 2 then
* * * * * * * *AppendNumber(Year mod 100, 2) else
* * * * * * * *AppendNumber(Year, 4);
* * * * * *end;
* * * * *"G":
* * * * * *begin
* * * * * * *GetCount;
* * * * * * *GetDate;
* * * * * * *AppendString(ConvertEraString(Count));
* * * * * *end;
* * * * *"E":
* * * * * *begin
* * * * * * *GetCount;
* * * * * * *GetDate;
* * * * * * *AppendString(ConvertYearString(Count));
* * * * * *end;
* * * * *"M":
* * * * * *begin
* * * * * * *GetCount;
* * * * * * *GetDate;
* * * * * * *case Count of
* * * * * * * *1, 2: AppendNumber(Month, Count);
* * * * * * * *3: AppendString(FormatSettings.ShortMonthNames[Month]);
* * * * * * *else
* * * * * * * *AppendString(FormatSettings.LongMonthNames[Month]);
* * * * * * *end;
* * * * * *end;
* * * * *"D":
* * * * * *begin
* * * * * * *GetCount;
* * * * * * *case Count of
* * * * * * * *1, 2:
* * * * * * * * *begin
* * * * * * * * * *GetDate;
* * * * * * * * * *AppendNumber(Day, Count);
* * * * * * * * *end;
* * * * * * * *3: AppendString(FormatSettings.ShortDayNames[farDayOfTheWeek(DateTime)]);
* * * * * * * *4: AppendString(FormatSettings.LongDayNames[farDayOfTheWeek(DateTime)]);
* * * * * * * *5: AppendFormat(Pointer(FormatSettings.ShortDateForma t));
* * * * * * *else
* * * * * * * *AppendFormat(Pointer(FormatSettings.LongDateForm at));
* * * * * * *end;
* * * * * *end;
* * * * *"H":
* * * * * *begin
* * * * * * *GetCount;
* * * * * * *GetTime;
* * * * * * *BetweenQuotes := False;
* * * * * * *P := Format;
* * * * * * *while P^ <> #0 do
* * * * * * *begin
* * * * * * * *if P^ in LeadBytes then
* * * * * * * *begin
* * * * * * * * *P := StrNextChar(P);
* * * * * * * * *Continue;
* * * * * * * *end;
* * * * * * * *case P^ of
* * * * * * * * *"A", "a":
* * * * * * * * * *if not BetweenQuotes then
* * * * * * * * * *begin
* * * * * * * * * * *if ( (StrLIComp(P, "AM/PM", 5) = 0)
* * * * * * * * * * * *or (StrLIComp(P, "A/P", * 3) = 0)
* * * * * * * * * * * *or (StrLIComp(P, "AMPM", *4) = 0) ) then
* * * * * * * * * * * *Use12HourClock := True;
* * * * * * * * * * *Break;
* * * * * * * * * *end;
* * * * * * * * *"H", "h":
* * * * * * * * * *Break;
* * * * * * * * *"""", """: BetweenQuotes := not BetweenQuotes;
* * * * * * * *end;
* * * * * * * *Inc(P);
* * * * * * *end;
* * * * * * *H := Hour;
* * * * * * *if Use12HourClock then
* * * * * * * *if H = 0 then H := 12 else if H > 12 then Dec(H, 12);
* * * * * * *if Count > 2 then Count := 2;
* * * * * * *AppendNumber(H, Count);
* * * * * *end;
* * * * *"N":
* * * * * *begin
* * * * * * *GetCount;
* * * * * * *GetTime;
* * * * * * *if Count > 2 then Count := 2;
* * * * * * *AppendNumber(Min, Count);
* * * * * *end;
* * * * *"S":
* * * * * *begin
* * * * * * *GetCount;
* * * * * * *GetTime;
* * * * * * *if Count > 2 then Count := 2;
* * * * * * *AppendNumber(Sec, Count);
* * * * * *end;
* * * * *"T":
* * * * * *begin
* * * * * * *GetCount;
* * * * * * *if Count = 1 then
* * * * * * * *AppendFormat(Pointer(FormatSettings.ShortTimeFor mat)) else
* * * * * * * *AppendFormat(Pointer(FormatSettings.LongTimeForm at));
* * * * * *end;
* * * * *"Z":
* * * * * *begin
* * * * * * *GetCount;
* * * * * * *GetTime;
* * * * * * *if Count > 3 then Count := 3;
* * * * * * *AppendNumber(MSec, Count);
* * * * * *end;
* * * * *"A":
* * * * * *begin
* * * * * * *GetTime;
* * * * * * *P := Format - 1;
* * * * * * *if StrLIComp(P, "AM/PM", 5) = 0 then
* * * * * * *begin
* * * * * * * *if Hour >= 12 then Inc(P, 3);
* * * * * * * *AppendChars(P, 2);
* * * * * * * *Inc(Format, 4);
* * * * * * * *Use12HourClock := TRUE;
* * * * * * *end else
* * * * * * *if StrLIComp(P, "A/P", 3) = 0 then
* * * * * * *begin
* * * * * * * *if Hour >= 12 then Inc(P, 2);
* * * * * * * *AppendChars(P, 1);
* * * * * * * *Inc(Format, 2);
* * * * * * * *Use12HourClock := TRUE;
* * * * * * *end else
* * * * * * *if StrLIComp(P, "AMPM", 4) = 0 then
* * * * * * *begin
* * * * * * * *if Hour < 12 then
* * * * * * * * *AppendString(FormatSettings.TimeAMString) else
* * * * * * * * *AppendString(FormatSettings.TimePMString);
* * * * * * * *Inc(Format, 3);
* * * * * * * *Use12HourClock := TRUE;
* * * * * * *end else
* * * * * * *if StrLIComp(P, "AAAA", 4) = 0 then
* * * * * * *begin
* * * * * * * *GetDate;
* * * * * * * *AppendString(FormatSettings.LongDayNames[farDayOfTheWeek(DateTime)]);
* * * * * * * *Inc(Format, 3);
* * * * * * *end else
* * * * * * *if StrLIComp(P, "AAA", 3) = 0 then
* * * * * * *begin
* * * * * * * *GetDate;
* * * * * * * *AppendString(FormatSettings.ShortDayNames[farDayOfTheWeek(DateTime)]);
* * * * * * * *Inc(Format, 2);
* * * * * * *end else
* * * * * * *AppendChars(@Starter, 1);
* * * * * *end;
* * * * *"C":
* * * * * *begin
* * * * * * *GetCount;
* * * * * * *AppendFormat(Pointer(FormatSettings.ShortDateFor mat));
* * * * * * *GetTime;
* * * * * * *if (Hour <> 0) or (Min <> 0) or (Sec <> 0) then
* * * * * * *begin
* * * * * * * *AppendChars(" ", 1);
* * * * * * * *AppendFormat(Pointer(FormatSettings.LongTimeForm at));
* * * * * * *end;
* * * * * *end;
* * * * *"/":
* * * * * *if DateSeparator <> #0 then
* * * * * * *AppendChars(@FormatSettings.DateSeparator, 1);
* * * * *":":
* * * * * *if TimeSeparator <> #0 then
* * * * * * *AppendChars(@FormatSettings.TimeSeparator, 1);
* * * * *"""", """:
* * * * * *begin
* * * * * * *P := Format;
* * * * * * *while (Format^ <> #0) and (Format^ <> Starter) do
* * * * * * *begin
* * * * * * * *if Format^ in LeadBytes then
* * * * * * * * *Format := StrNextChar(Format)
* * * * * * * *else
* * * * * * * * *Inc(Format);
* * * * * * *end;
* * * * * * *AppendChars(P, Format - P);
* * * * * * *if Format^ <> #0 then Inc(Format);
* * * * * *end;
* * * *else
* * * * *AppendChars(@Starter, 1);
* * * *end;
* * *end;
* * *Dec(AppendLevel);
* *end;
*end;
begin
*BufPos := 0;
*AppendLevel := 0;
*if Format <> "" then AppendFormat(Pointer(Format)) else AppendFormat("C");
*SetString(Result, Buffer, BufPos);
end;
class function TFarDate.farDateToStr(dateTime:TfarDateTime):strin g;
begin
farDateTimeToString(Result, ShortDateFormat, DateTime);
end;
class function TFarDate.farDateToStr(const DateTime: TfarDateTime;
*const FormatSettings: TFormatSettings): string;
begin
*farDateTimeToString(Result, FormatSettings.ShortDateFormat, DateTime,
* *FormatSettings);
end;
class function TFarDate.farFormatDateTime(const Format: string; DateTime: TfarDateTime): string;
begin
*farDateTimeToString(Result, Format, DateTime);
end;
class function TFarDate.farFormatDateTime(const Format: string; DateTime: TfarDateTime;
*const FormatSettings: TFormatSettings): string;
begin
*farDateTimeToString(Result, Format, DateTime, FormatSettings);
end;
class function TFarDate.farDateTimeToStr(const DateTime: TfarDateTime): string;
begin
*farDateTimeToString(Result, "", DateTime);
end;
class function TFarDate.farDateTimeToStr(const DateTime: TfarDateTime;
*const FormatSettings: TFormatSettings): string;
begin
*farDateTimeToString(Result, "", DateTime, FormatSettings);
end;
class function TFarDate.farGetDateOrder(const DateFormat: string): TDateOrder;
var
*I: Integer;
begin
*Result := doMDY;
*I := 1;
*while I <= Length(DateFormat) do
*begin
* *case Chr(Ord(DateFormat[I]) and $DF) of
* * *"E": Result := doYMD;
* * *"Y": Result := doYMD;
* * *"M": Result := doMDY;
* * *"D": Result := doDMY;
* *else
* * *Inc(I);
* * *Continue;
* *end;
* *Exit;
*end;
*Result := doMDY;
end;
class procedure TFarDate.farScanBlanks(const S: string; var Pos: Integer);
var
*I: Integer;
begin
*I := Pos;
*while (I <= Length(S)) and (S[I] = " ") do Inc(I);
*Pos := I;
end;
class function TFarDate.farScanNumber(const S: string; var Pos: Integer;
*var Number: Word; var CharCount: Byte): Boolean;
var
*I: Integer;
*N: Word;
begin
*Result := False;
*CharCount := 0;
*farScanBlanks(S, Pos);
*I := Pos;
*N := 0;
*while (I <= Length(S)) and (S[I] in ["0".."9"]) and (N < 1000) do
*begin
* *N := N * 10 + (Ord(S[I]) - Ord("0"));
* *Inc(I);
*end;
*if I > Pos then
*begin
* *CharCount := I - Pos;
* *Pos := I;
* *Number := N;
* *Result := True;
*end;
end;
class procedure TFarDate.farScanToNumber(const S: string; var Pos: Integer);
begin
*while (Pos <= Length(S)) and not (S[Pos] in ["0".."9"]) do
*begin
* *if S[Pos] in LeadBytes then
* * *Pos := NextCharIndex(S, Pos)
* *else
* * *Inc(Pos);
*end;
end;
class function TFarDate.farGetEraYearOffset(const Name: string): Integer;
var
*I: Integer;
begin
*Result := 0;
*for I := Low(EraNames) to High(EraNames) do
*begin
* *if EraNames[I] = "" then Break;
* *if AnsiStrPos(PChar(EraNames[I]), PChar(Name)) <> nil then
* *begin
* * *Result := EraYearOffsets[I];
* * *Exit;
* *end;
*end;
end;
class function TFarDate.farScanChar(const S: string; var Pos: Integer; Ch: Char): Boolean;
begin
*Result := False;
*farScanBlanks(S, Pos);
*if (Pos <= Length(S)) and (S[Pos] = Ch) then
*begin
* *Inc(Pos);
* *Result := True;
*end;
end;
class function TFarDate.farScanDate(const S: string; var Pos: Integer; var Date: TDateTime;
*const FormatSettings: TFormatSettings): Boolean;
var
*DateOrder: TDateOrder;
*N1, N2, N3, Y, M, D: Word;
*L1, L2, L3, YearLen: Byte;
*CenturyBase: Integer;
*EraName : string;
*EraYearOffset: Integer;
*function EraToYear(Year: Integer): Integer;
*begin
{$IFDEF MSWINDOWS}
* *if SysLocale.PriLangID = LANG_KOREAN then
* *begin
* * *if Year <= 99 then
* * * *Inc(Year, (CurrentYear + Abs(EraYearOffset)) div 100 * 100);
* * *if EraYearOffset > 0 then
* * * *EraYearOffset := -EraYearOffset;
* *end
* *else
* * *Dec(EraYearOffset);
{$ENDIF}
* *Result := Year + EraYearOffset;
*end;
begin
*Y := 0;
*M := 0;
*D := 0;
*YearLen := 0;
*Result := False;
*DateOrder := farGetDateOrder(FormatSettings.ShortDateFormat);
*EraYearOffset := 0;
*if FormatSettings.ShortDateFormat[1] = "g" then *// skip over prefix text
*begin
* *farScanToNumber(S, Pos);
* *EraName := Trim(Copy(S, 1, Pos-1));
* *EraYearOffset := farGetEraYearOffset(EraName);
*end
*else
* *if AnsiPos("e", FormatSettings.ShortDateFormat) > 0 then
* * *EraYearOffset := EraYearOffsets[1];
*if not (farScanNumber(S, Pos, N1, L1) and farScanChar(S, Pos, FormatSettings.DateSeparator) and
* *farScanNumber(S, Pos, N2, L2)) then Exit;
*if farScanChar(S, Pos, FormatSettings.DateSeparator) then
*begin
* *if not farScanNumber(S, Pos, N3, L3) then Exit;
* *case DateOrder of
* * *doMDY: begin Y := N3; YearLen := L3; M := N1; D := N2; end;
* * *doDMY: begin Y := N3; YearLen := L3; M := N2; D := N1; end;
* * *doYMD: begin Y := N1; YearLen := L1; M := N2; D := N3; end;
* *end;
* *if EraYearOffset > 0 then
* * *Y := EraToYear(Y)
* *else
* *if (YearLen <= 2) then
* *begin
* * *CenturyBase := CurrentYear - FormatSettings.TwoDigitYearCenturyWindow;
* * *Inc(Y, CenturyBase div 100 * 100);
* * *if (FormatSettings.TwoDigitYearCenturyWindow > 0) and (Y < CenturyBase) then
* * * *Inc(Y, 100);
* *end;
*end else
*begin
* *Y := CurrentYear;
* *if DateOrder = doDMY then
* *begin
* * *D := N1; M := N2;
* *end else
* *begin
* * *M := N1; D := N2;
* *end;
*end;
*farScanChar(S, Pos, FormatSettings.DateSeparator);
*farScanBlanks(S, Pos);
*if SysLocale.FarEast and (System.Pos("ddd", FormatSettings.ShortDateFormat) <> 0) then
*begin * * // ignore trailing text
* *if FormatSettings.ShortTimeFormat[1] in ["0".."9"] then *// stop at time digit
* * *farScanToNumber(S, Pos)
* *else *// stop at time prefix
* * *repeat
* * * *while (Pos <= Length(S)) and (S[Pos] <> " ") do Inc(Pos);
* * * *farScanBlanks(S, Pos);
* * *until (Pos > Length(S)) or
* * * *(AnsiCompareText(FormatSettings.TimeAMString,
* * * * Copy(S, Pos, Length(FormatSettings.TimeAMString))) = 0) or
* * * *(AnsiCompareText(FormatSettings.TimePMString,
* * * * Copy(S, Pos, Length(FormatSettings.TimePMString))) = 0);
*end;
*Result := farTryEncodeDate(Y, M, D, Date);
end;
class function TFarDate.farScanDate(const S: string; var Pos: Integer;
*var Date: TDateTime): Boolean;
var
*DateOrder: TDateOrder;
*N1, N2, N3, Y, M, D: Word;
*L1, L2, L3, YearLen: Byte;
*CenturyBase: Integer;
*EraName : string;
*EraYearOffset: Integer;
*function EraToYear(Year: Integer): Integer;
*begin
{$IFDEF MSWINDOWS}
* *if SysLocale.PriLangID = LANG_KOREAN then
* *begin
* * *if Year <= 99 then
* * * *Inc(Year, (CurrentYear + Abs(EraYearOffset)) div 100 * 100);
* * *if EraYearOffset > 0 then
* * * *EraYearOffset := -EraYearOffset;
* *end
* *else
* * *Dec(EraYearOffset);
{$ENDIF}
* *Result := Year + EraYearOffset;
*end;
begin
*Y := 0;
*M := 0;
*D := 0;
*YearLen := 0;
*Result := False;
*DateOrder := farGetDateOrder(ShortDateFormat);
*EraYearOffset := 0;
*if (ShortDateFormat <> "") and (ShortDateFormat[1] = "g") then *// skip over prefix text
*begin
* *farScanToNumber(S, Pos);
* *EraName := Trim(Copy(S, 1, Pos-1));
* *EraYearOffset := farGetEraYearOffset(EraName);
*end
*else
* *if AnsiPos("e", ShortDateFormat) > 0 then
* * *EraYearOffset := EraYearOffsets[1];
*if not (farScanNumber(S, Pos, N1, L1) and farScanChar(S, Pos, DateSeparator) and
* *farScanNumber(S, Pos, N2, L2)) then Exit;
*if farScanChar(S, Pos, DateSeparator) then
*begin
* *if not farScanNumber(S, Pos, N3, L3) then Exit;
* *case DateOrder of
* * *doMDY: begin Y := N3; YearLen := L3; M := N1; D := N2; end;
* * *doDMY: begin Y := N3; YearLen := L3; M := N2; D := N1; end;
* * *doYMD: begin Y := N1; YearLen := L1; M := N2; D := N3; end;
* *end;
* *if EraYearOffset > 0 then
* * *Y := EraToYear(Y)
* *else
* *if (YearLen <= 2) then
* *begin
* * *CenturyBase := CurrentYear - TwoDigitYearCenturyWindow;
* * *Inc(Y, CenturyBase div 100 * 100);
* * *if (TwoDigitYearCenturyWindow > 0) and (Y < CenturyBase) then
* * * *Inc(Y, 100);
* *end;
*end else
*begin
* *Y := CurrentYear;
* *if DateOrder = doDMY then
* *begin
* * *D := N1; M := N2;
* *end else
* *begin
* * *M := N1; D := N2;
* *end;
*end;
*farScanChar(S, Pos, DateSeparator);
*farScanBlanks(S, Pos);
*if SysLocale.FarEast and (System.Pos("ddd", ShortDateFormat) <> 0) then
*begin * * // ignore trailing text
* *if ShortTimeFormat[1] in ["0".."9"] then *// stop at time digit
* * *farScanToNumber(S, Pos)
* *else *// stop at time prefix
* * *repeat
* * * *while (Pos <= Length(S)) and (S[Pos] <> " ") do Inc(Pos);
* * * *farScanBlanks(S, Pos);
* * *until (Pos > Length(S)) or
* * * *(AnsiCompareText(TimeAMString, Copy(S, Pos, Length(TimeAMString))) = 0) or
* * * *(AnsiCompareText(TimePMString, Copy(S, Pos, Length(TimePMString))) = 0);
*end;
*Result := farTryEncodeDate(Y, M, D, Date);
end;
class function TFarDate.farTryStrToDate(const S: string; out Value: TDateTime): Boolean;
var
*Pos: Integer;
begin
*Pos := 1;
*Result := farScanDate(S, Pos, Value) and (Pos > Length(S));
end;
class function TFarDate.farTryStrToDate(const S: string; out Value: TDateTime;
*const FormatSettings: TFormatSettings): Boolean;
var
*Pos: Integer;
begin
*Pos := 1;
*Result := farScanDate(S, Pos, Value, FormatSettings) and (Pos > Length(S));
end;
class function TFarDate.farStrToDate(const S: string): TfarDateTime;
begin
*if not farTryStrToDate(S, Result) then
* *raise EConvertError.Createfmt(SInvalidDate,[S]);
end;
class function TFarDate.farStrToDate(const S: string;
*const FormatSettings: TFormatSettings): TfarDateTime;
begin
*if not farTryStrToDate(S, Result, FormatSettings) then
* *raise EConvertError.Createfmt(SInvalidDate,[S]);
end;
class function TFarDate.farStrToDateDef(const S: string; const Default: TfarDateTime): TfarDateTime;
begin
*if not farTryStrToDate(S, Result) then
* *Result := Default;
end;
class function TFarDate.farStrToDateDef(const S: string; const Default: TfarDateTime;
*const FormatSettings: TFormatSettings): TfarDateTime;
begin
*if not farTryStrToDate(S, Result, FormatSettings) then
* *Result := Default;
end;
{----AValue is Shamsi date-----}
class function TFarDate.farYearOf(const AValue: TDateTime): Word;
var
*LMonth, LDay: Word;
begin
*TFarDate.FarDecodeDate(AValue, Result, LMonth, LDay);
end;
{----AValue is Shamsi date-----}
class function TFarDate.farMonthOf(const AValue: TDateTime): Word;
var
*LYear, LDay: Word;
begin
*TFarDate.FarDecodeDate(AValue, LYear, Result, LDay);
end;
{----AValue is Shamsi date-----}
class function TFarDate.farWeekOf(const AValue: TDateTime): Word; * * * * * * * * * * * {ISO 8601}
begin
*Result := farWeekOfTheYear(AValue);
end;
{----AValue is Shamsi date-----}
class function TFarDate.farDayOf(const AValue: TfarDateTime): Word;
var
*LYear, LMonth: Word;
begin
*TFarDate.FarDecodeDate(AValue, LYear, LMonth, Result);
end;
class function TFarDate.farWeekOfTheYear(const AValue: TfarDateTime): Word;
var
*LYear, LDOW: Word;
begin
*farDecodeDateWeek(AValue, LYear, Result, LDOW);
end;
class function TFarDate.farWeekOfTheYear(const AValue: TfarDateTime; var AYear: Word): Word;
var
*LDOW: Word;
begin
*farDecodeDateWeek(AValue, AYear, Result, LDOW);
end;
class function