تاریخ فارسی

[b_e_shamlu]

با سلام
با عرض پوزش خدمت مدیر عزیز
من یک کامپوننت داخل صفحه ( [برای مشاهده لینک ها شما باید عضو سایت باشید برای عضویت در سایت بر روی اینجا کلیک بکنید]) گذاشتم که فکر میکنم خیل به درد بخوره چرا که دارای خواص ذیل میباشد
1- دیگر نیازی نیست که تاریخ های بانکهای خود را بصورت taxt یا char و کلا بصورت کارکتری انتخاب کرد
2- تمامی کارهای که شما میخواهید بر روی تاریخ انجام دهید را بصورت راحت و بدون مشکل انجام دهید
3- میتوانید تقویم رویدادی بسازید

این هم دانلودش****** [برای مشاهده لینک ها شما باید عضو سایت باشید برای عضویت در سایت بر روی اینجا کلیک بکنید]

برای کمک باید بگویم که مثالهای خیلی جالب داخل آن وجود دارد که میتوانی از آن کمک بگیرید فقط قبل از استفاده حتما کامپوننتها را نصب کنید و مسیر سورس فوق را به دلفی اضافه کنید
************************* ************************* ************************* ***************** من اطمینان دارم که با این کامپوننت تمامی
************************* ************************* ************************* ******************* مشکلات شما در مورد تاریخ حل خواهد شد

************************* ******* اگر سوالی در خصوص این کامپوننت داشتید در خدمت هستم

[ali3d]

نقل قول از admin
اینم یک یونیت با حال واسه تاریخ فارسی به اسم* UFarsiDate

کد:

unit UFarsiDate;
{-----------------------------------------}
{ * * * * *Farsi functions unit * * * * * }
{ * * *Use this unit for persian date * * }
{ * * * * * * * * * * * * * * * * * * * * }
{ * * *Written by: Salar Khalilzadeh * * *}
{ * * * * * *Copyright © 2006 * * * * * * }
{ * * * * * * SalarSoftwares * * * * * * *}
{ * * * * * * * * * * * * * * * * * * * * }
{----Website: www.salarsoft.somee.com-----}
{----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;overload;
 * *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 = 1) and (Month = 1) and (Day *LeapMonth[DateKind]) and SolarIsLeapYear(DateKind, Year) then
 * * *LeapDay := 1;
 * *if Days =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 (thisday4))) 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 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.ShortTimeFormat)) else
 * * * * * * * *AppendFormat(Pointer(FormatSettings.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(FormatSettings.TimeAMString) else
 * * * * * * * * *AppendString(FormatSettings.TimePMString);
 * * * * * * * *Inc(Format, 3);
 * * * * * * * *Use12HourClock := TRUE;
 * * * * * * *end else
 * * * * * * *if StrLIComp(P, &quot;AAAA&quot;, 4) = 0 then
 * * * * * * *begin
 * * * * * * * *GetDate;
 * * * * * * * *AppendString(FormatSettings.LongDayNames[farDayOfTheWeek(DateTime)]);
 * * * * * * * *Inc(Format, 3);
 * * * * * * *end else
 * * * * * * *if StrLIComp(P, &quot;AAA&quot;, 3) = 0 then
 * * * * * * *begin
 * * * * * * * *GetDate;
 * * * * * * * *AppendString(FormatSettings.ShortDayNames[farDayOfTheWeek(DateTime)]);
 * * * * * * * *Inc(Format, 2);
 * * * * * * *end else
 * * * * * * *AppendChars(@Starter, 1);
 * * * * * *end;
 * * * * *&quot;C&quot;:
 * * * * * *begin
 * * * * * * *GetCount;
 * * * * * * *AppendFormat(Pointer(FormatSettings.ShortDateFormat));
 * * * * * * *GetTime;
 * * * * * * *if (Hour *0) or (Min *0) or (Sec *0) then
 * * * * * * *begin
 * * * * * * * *AppendChars(&quot; &quot;, 1);
 * * * * * * * *AppendFormat(Pointer(FormatSettings.LongTimeFormat));
 * * * * * * *end;
 * * * * * *end;
 * * * * *&quot;/&quot;:
 * * * * * *if DateSeparator *#0 then
 * * * * * * *AppendChars(@FormatSettings.DateSeparator, 1);
 * * * * *&quot;:&quot;:
 * * * * * *if TimeSeparator *#0 then
 * * * * * * *AppendChars(@FormatSettings.TimeSeparator, 1);
 * * * * *&quot;&quot;&quot;&quot;, &quot;&quot;&quot;:
 * * * * * *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 *&quot;&quot; then AppendFormat(Pointer(Format)) else AppendFormat(&quot;C&quot;);
 *SetString(Result, Buffer, BufPos);
end;


class function TFarDate.farDateToStr(dateTime:TfarDateTime):string;
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, &quot;&quot;, DateTime);
end;

class function TFarDate.farDateTimeToStr(const DateTime: TfarDateTime;
 *const FormatSettings: TFormatSettings): string;
begin
 *farDateTimeToString(Result, &quot;&quot;, DateTime, FormatSettings);
end;

class function TFarDate.farGetDateOrder(const DateFormat: string): TDateOrder;
var
 *I: Integer;
begin
 *Result := doMDY;
 *I := 1;
 *while I *0 then
 * * *Y := EraToYear(Y)
 * *else
 * *if (YearLen *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(&quot;ddd&quot;, ShortDateFormat) *0) then
 *begin * * // ignore trailing text
 * *if ShortTimeFormat[1] in [&quot;0&quot;..&quot;9&quot;] then *// stop at time digit
 * * *farScanToNumber(S, Pos)
 * *else *// stop at time prefix
 * * *repeat
 * * * *while (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



مهندس جان ببخشید یعنی این کد رو فقط داخل قسمت کدها بنویسیم و ذخیره کنیم؟
آخه من زیاد از این جور سورس ها سر در نمیارم!!!
من چند ماهی هست که کار با دلفی رو شروع کردم و تا الان چند تا برنامه ویندوز از قبیل دفترچه یادداشت ،
*دفترچه تلفن و این اواخر بخشی از نرم افزار کنترل آموزشگاه رانندگی را تکمیل کردم و اگه خدا بخواد اومدم اینجا که با دست پر برگردم .
متاسفانه اطلاعات من در مورد دلفی زیاد نیست یعنی نمیدونم دقیقا چه نرم افزار هایی رو میشه باهاش ساخت!!!!
و اینه که به راهنمایی شما بزرگواران نیاز دارم.

[admin]

سلام.
همانطوری که بالا توضیح دادم ، این یک یونیت جداگانه است و شما باید در پروژه اتون یک یونیت به نام UFarsiDate ایجاد کرده و این کدها رو با کدهای درون اون یونیت تعویض کنید.
حالا جهت استفاده در پروژه کافیه در قسمت Uses این یونیت یعنی UFarsiDate رو اضافه کنید و از توابع اون استفاده کنید.
در مورد این که گفتید چه نرم افزارهایی رو میشه باهاش ساخت ؟
باید بگم که بستگی به طراح نرم افزار داره و به نظر من هر نرم افزاری که شما اراده کنید با دلفی قابل طراحی و بهره برداری خواهد بود ...

[admin]

اینم یک یونیت با حال واسه تاریخ فارسی به اسم* UFarsiDate

کد:

[CODE]
unit UFarsiDate;
{-----------------------------------------}
{ * * * * *Farsi functions unit * * * * * }
{ * * *Use this unit for persian date * * }
{ * * * * * * * * * * * * * * * * * * * * }
{ * * *Written by: Salar Khalilzadeh * * *}
{ * * * * * *Copyright © 2006 * * * * * * }
{ * * * * * * SalarSoftwares * * * * * * *}
{ * * * * * * * * * * * * * * * * * * * * }
{----Website: www.salarsoft.somee.com-----}
{----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=
* *("فروردين","ارديبهش ت","خرداد","تير" ,"مرداد","شهريور",& quot;مهر","آبان",
* * *"آذر","دي","بهم ن","اسفند"
*farLongMonths:array [1..12] of string=
* *("فروردين","ارديبهش ت","خرداد","تير" ,"مرداد","شهريور",& quot;مهر","آبان",
* * *"آذر","دي","بهم ن","اسفند"
*farShortDays:array [1..7] of string=
* *("جمعه","شنبه",&quot ;يكشنبه","دو شنبه","سه شنبه","چهار شنبه","پنج شنبه"
*farLongDays:array [1..7] of string=
* *("جمعه","شنبه",&quot ;يكشنبه","دو شنبه","سه شنبه","چهار شنبه","پنج شنبه"


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 * * * * * * * * * * * * * * * * * * * * * * * * * * * }
{ *http://www.delphiarea.com * * * * * * * * * * * * * * * * * * * * * * * * * }
{ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{------------------------------------------------------------------------------}

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 &quot;Persian date conversion to Gregorian&quot; 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 := &quot;0&quot; + daystr ;
end
else
begin
daystr := IntToStr(Day);

end;

if Month < 10 then
begin
monthstr *:= &quot;0&quot; + 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:=&quot;&quot;;
CurD:=&quot;&quot;;
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:=&quot;0&quot;+Trim(IntToStr(CurMonth));
If CurDay<10 then
*CurD:=&quot;0&quot;+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 = &quot;%.*d&quot;;
*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 := &quot;&quot;;
* * *with SystemTime do
* * *begin
* * * *wYear *:= Year;
* * * *wMonth := Month;
* * * *wDay * := Day;
* * *end;

* * *FormatStr := &quot;gg&quot;;
* * *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 := &quot;&quot;;
* * *with SystemTime do
* * *begin
* * * *wYear *:= Year;
* * * *wMonth := Month;
* * * *wDay * := Day;
* * *end;

* * *if Count <= 2 then
* * * *FormatStr := &quot;yy&quot; // avoid Win95 bug.
* * *else
* * * *FormatStr := &quot;yyyy&quot;;

* * *if GetDateFormat(GetThreadLocale, DATE_USE_ALT_CALENDAR, @SystemTime,
* * * *PChar(FormatStr), Buffer, SizeOf(Buffer)) <> 0 then
* * *begin
* * * *Result := Buffer;
* * * *if (Count = 1) and (Result[1] = &quot;0&quot 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 := &quot;&quot;;
* * *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 := &quot;0&quot; + 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 := &quot; &quot;;
* * *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 := &quot; &quot;;
* * * * *Continue;
* * * *end;
* * * *Format := StrNextChar(Format);
* * * *Token := Starter;
* * * *if Token in [&quot;a&quot;..&quot;z&quot;] then Dec(Token, 32);
* * * *if Token in [&quot;A&quot;..&quot;Z&quot;] then
* * * *begin
* * * * *if (Token = &quot;M&quot and (LastToken = &quot;H&quot then Token := &quot;N&quot;;
* * * * *LastToken := Token;
* * * *end;
* * * *case Token of
* * * * *&quot;Y&quot;:
* * * * * *begin
* * * * * * *GetCount;
* * * * * * *GetDate;
* * * * * * *if Count <= 2 then
* * * * * * * *AppendNumber(Year mod 100, 2) else
* * * * * * * *AppendNumber(Year, 4);
* * * * * *end;
* * * * *&quot;G&quot;:
* * * * * *begin
* * * * * * *GetCount;
* * * * * * *GetDate;
* * * * * * *AppendString(ConvertEraString(Count));
* * * * * *end;
* * * * *&quot;E&quot;:
* * * * * *begin
* * * * * * *GetCount;
* * * * * * *GetDate;
* * * * * * *AppendString(ConvertYearString(Count));
* * * * * *end;
* * * * *&quot;M&quot;:
* * * * * *begin
* * * * * * *GetCount;
* * * * * * *GetDate;
* * * * * * *case Count of
* * * * * * * *1, 2: AppendNumber(Month, Count);
* * * * * * * *3: AppendString(farShortMonthNames[Month]);
* * * * * * *else
* * * * * * * *AppendString(farLongMonthNames[Month]);
* * * * * * *end;
* * * * * *end;
* * * * *&quot;D&quot;:
* * * * * *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;
* * * * *&quot;H&quot;:
* * * * * *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
* * * * * * * * *&quot;A&quot;, &quot;a&quot;:
* * * * * * * * * *if not BetweenQuotes then
* * * * * * * * * *begin
* * * * * * * * * * *if ( (StrLIComp(P, &quot;AM/PM&quot;, 5) = 0)
* * * * * * * * * * * *or (StrLIComp(P, &quot;A/P&quot;, * 3) = 0)
* * * * * * * * * * * *or (StrLIComp(P, &quot;AMPM&quot;, *4) = 0) ) then
* * * * * * * * * * * *Use12HourClock := True;
* * * * * * * * * * *Break;
* * * * * * * * * *end;
* * * * * * * * *&quot;H&quot;, &quot;h&quot;:
* * * * * * * * * *Break;
* * * * * * * * *&quot;&quot;&quot;&quot;, &quot;&quot;&quot;: 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;
* * * * *&quot;N&quot;:
* * * * * *begin
* * * * * * *GetCount;
* * * * * * *GetTime;
* * * * * * *if Count > 2 then Count := 2;
* * * * * * *AppendNumber(Min, Count);
* * * * * *end;
* * * * *&quot;S&quot;:
* * * * * *begin
* * * * * * *GetCount;
* * * * * * *GetTime;
* * * * * * *if Count > 2 then Count := 2;
* * * * * * *AppendNumber(Sec, Count);
* * * * * *end;
* * * * *&quot;T&quot;:
* * * * * *begin
* * * * * * *GetCount;
* * * * * * *if Count = 1 then
* * * * * * * *AppendFormat(Pointer(ShortTimeFormat)) else
* * * * * * * *AppendFormat(Pointer(LongTimeFormat));
* * * * * *end;
* * * * *&quot;Z&quot;:
* * * * * *begin
* * * * * * *GetCount;
* * * * * * *GetTime;
* * * * * * *if Count > 3 then Count := 3;
* * * * * * *AppendNumber(MSec, Count);
* * * * * *end;
* * * * *&quot;A&quot;:
* * * * * *begin
* * * * * * *GetTime;
* * * * * * *P := Format - 1;
* * * * * * *if StrLIComp(P, &quot;AM/PM&quot;, 5) = 0 then
* * * * * * *begin
* * * * * * * *if Hour >= 12 then Inc(P, 3);
* * * * * * * *AppendChars(P, 2);
* * * * * * * *Inc(Format, 4);
* * * * * * * *Use12HourClock := TRUE;
* * * * * * *end else
* * * * * * *if StrLIComp(P, &quot;A/P&quot;, 3) = 0 then
* * * * * * *begin
* * * * * * * *if Hour >= 12 then Inc(P, 2);
* * * * * * * *AppendChars(P, 1);
* * * * * * * *Inc(Format, 2);
* * * * * * * *Use12HourClock := TRUE;
* * * * * * *end else
* * * * * * *if StrLIComp(P, &quot;AMPM&quot;, 4) = 0 then
* * * * * * *begin
* * * * * * * *if Hour < 12 then
* * * * * * * * *AppendString(TimeAMString) else
* * * * * * * * *AppendString(TimePMString);
* * * * * * * *Inc(Format, 3);
* * * * * * * *Use12HourClock := TRUE;
* * * * * * *end else
* * * * * * *if StrLIComp(P, &quot;AAAA&quot;, 4) = 0 then
* * * * * * *begin
* * * * * * * *GetDate;
* * * * * * * *AppendString(farLongDayNames[farDayOfTheWeek(DateTime)]);
* * * * * * * *Inc(Format, 3);
* * * * * * *end else
* * * * * * *if StrLIComp(P, &quot;AAA&quot;, 3) = 0 then
* * * * * * *begin
* * * * * * * *GetDate;
* * * * * * * *AppendString(ShortDayNames[farDayOfTheWeek(DateTime)]);
* * * * * * * *Inc(Format, 2);
* * * * * * *end else
* * * * * * *AppendChars(@Starter, 1);
* * * * * *end;
* * * * *&quot;C&quot;:
* * * * * *begin
* * * * * * *GetCount;
* * * * * * *AppendFormat(Pointer(ShortDateFormat));
* * * * * * *GetTime;
* * * * * * *if (Hour <> 0) or (Min <> 0) or (Sec <> 0) then
* * * * * * *begin
* * * * * * * *AppendChars(&quot; &quot;, 1);
* * * * * * * *AppendFormat(Pointer(LongTimeFormat));
* * * * * * *end;
* * * * * *end;
* * * * *&quot;/&quot;:
* * * * * *if DateSeparator <> #0 then
* * * * * * *AppendChars(@DateSeparator, 1);
* * * * *&quot;:&quot;:
* * * * * *if TimeSeparator <> #0 then
* * * * * * *AppendChars(@TimeSeparator, 1);
* * * * *&quot;&quot;&quot;&quot;, &quot;&quot;&quot;:
* * * * * *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 <> &quot;&quot; then AppendFormat(Pointer(Format)) else AppendFormat(&quot;C&quot;
*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 = &quot;%.*d&quot;;
*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 := &quot;&quot;;
* * *with SystemTime do
* * *begin
* * * *wYear *:= Year;
* * * *wMonth := Month;
* * * *wDay * := Day;
* * *end;

* * *FormatStr := &quot;gg&quot;;
* * *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 := &quot;&quot;;
* * *with SystemTime do
* * *begin
* * * *wYear *:= Year;
* * * *wMonth := Month;
* * * *wDay * := Day;
* * *end;

* * *if Count <= 2 then
* * * *FormatStr := &quot;yy&quot; // avoid Win95 bug.
* * *else
* * * *FormatStr := &quot;yyyy&quot;;

* * *if GetDateFormat(GetThreadLocale, DATE_USE_ALT_CALENDAR, @SystemTime,
* * * *PChar(FormatStr), Buffer, SizeOf(Buffer)) <> 0 then
* * *begin
* * * *Result := Buffer;
* * * *if (Count = 1) and (Result[1] = &quot;0&quot 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 := &quot;&quot;;
* * *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 := &quot;0&quot; + 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 := &quot; &quot;;
* * *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 := &quot; &quot;;
* * * * *Continue;
* * * *end;
* * * *Format := StrNextChar(Format);
* * * *Token := Starter;
* * * *if Token in [&quot;a&quot;..&quot;z&quot;] then Dec(Token, 32);
* * * *if Token in [&quot;A&quot;..&quot;Z&quot;] then
* * * *begin
* * * * *if (Token = &quot;M&quot and (LastToken = &quot;H&quot then Token := &quot;N&quot;;
* * * * *LastToken := Token;
* * * *end;
* * * *case Token of
* * * * *&quot;Y&quot;:
* * * * * *begin
* * * * * * *GetCount;
* * * * * * *GetDate;
* * * * * * *if Count <= 2 then
* * * * * * * *AppendNumber(Year mod 100, 2) else
* * * * * * * *AppendNumber(Year, 4);
* * * * * *end;
* * * * *&quot;G&quot;:
* * * * * *begin
* * * * * * *GetCount;
* * * * * * *GetDate;
* * * * * * *AppendString(ConvertEraString(Count));
* * * * * *end;
* * * * *&quot;E&quot;:
* * * * * *begin
* * * * * * *GetCount;
* * * * * * *GetDate;
* * * * * * *AppendString(ConvertYearString(Count));
* * * * * *end;
* * * * *&quot;M&quot;:
* * * * * *begin
* * * * * * *GetCount;
* * * * * * *GetDate;
* * * * * * *case Count of
* * * * * * * *1, 2: AppendNumber(Month, Count);
* * * * * * * *3: AppendString(FormatSettings.ShortMonthNames[Month]);
* * * * * * *else
* * * * * * * *AppendString(FormatSettings.LongMonthNames[Month]);
* * * * * * *end;
* * * * * *end;
* * * * *&quot;D&quot;:
* * * * * *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;
* * * * *&quot;H&quot;:
* * * * * *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
* * * * * * * * *&quot;A&quot;, &quot;a&quot;:
* * * * * * * * * *if not BetweenQuotes then
* * * * * * * * * *begin
* * * * * * * * * * *if ( (StrLIComp(P, &quot;AM/PM&quot;, 5) = 0)
* * * * * * * * * * * *or (StrLIComp(P, &quot;A/P&quot;, * 3) = 0)
* * * * * * * * * * * *or (StrLIComp(P, &quot;AMPM&quot;, *4) = 0) ) then
* * * * * * * * * * * *Use12HourClock := True;
* * * * * * * * * * *Break;
* * * * * * * * * *end;
* * * * * * * * *&quot;H&quot;, &quot;h&quot;:
* * * * * * * * * *Break;
* * * * * * * * *&quot;&quot;&quot;&quot;, &quot;&quot;&quot;: 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;
* * * * *&quot;N&quot;:
* * * * * *begin
* * * * * * *GetCount;
* * * * * * *GetTime;
* * * * * * *if Count > 2 then Count := 2;
* * * * * * *AppendNumber(Min, Count);
* * * * * *end;
* * * * *&quot;S&quot;:
* * * * * *begin
* * * * * * *GetCount;
* * * * * * *GetTime;
* * * * * * *if Count > 2 then Count := 2;
* * * * * * *AppendNumber(Sec, Count);
* * * * * *end;
* * * * *&quot;T&quot;:
* * * * * *begin
* * * * * * *GetCount;
* * * * * * *if Count = 1 then
* * * * * * * *AppendFormat(Pointer(FormatSettings.ShortTimeFor mat)) else
* * * * * * * *AppendFormat(Pointer(FormatSettings.LongTimeForm at));
* * * * * *end;
* * * * *&quot;Z&quot;:
* * * * * *begin
* * * * * * *GetCount;
* * * * * * *GetTime;
* * * * * * *if Count > 3 then Count := 3;
* * * * * * *AppendNumber(MSec, Count);
* * * * * *end;
* * * * *&quot;A&quot;:
* * * * * *begin
* * * * * * *GetTime;
* * * * * * *P := Format - 1;
* * * * * * *if StrLIComp(P, &quot;AM/PM&quot;, 5) = 0 then
* * * * * * *begin
* * * * * * * *if Hour >= 12 then Inc(P, 3);
* * * * * * * *AppendChars(P, 2);
* * * * * * * *Inc(Format, 4);
* * * * * * * *Use12HourClock := TRUE;
* * * * * * *end else
* * * * * * *if StrLIComp(P, &quot;A/P&quot;, 3) = 0 then
* * * * * * *begin
* * * * * * * *if Hour >= 12 then Inc(P, 2);
* * * * * * * *AppendChars(P, 1);
* * * * * * * *Inc(Format, 2);
* * * * * * * *Use12HourClock := TRUE;
* * * * * * *end else
* * * * * * *if StrLIComp(P, &quot;AMPM&quot;, 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, &quot;AAAA&quot;, 4) = 0 then
* * * * * * *begin
* * * * * * * *GetDate;
* * * * * * * *AppendString(FormatSettings.LongDayNames[farDayOfTheWeek(DateTime)]);
* * * * * * * *Inc(Format, 3);
* * * * * * *end else
* * * * * * *if StrLIComp(P, &quot;AAA&quot;, 3) = 0 then
* * * * * * *begin
* * * * * * * *GetDate;
* * * * * * * *AppendString(FormatSettings.ShortDayNames[farDayOfTheWeek(DateTime)]);
* * * * * * * *Inc(Format, 2);
* * * * * * *end else
* * * * * * *AppendChars(@Starter, 1);
* * * * * *end;
* * * * *&quot;C&quot;:
* * * * * *begin
* * * * * * *GetCount;
* * * * * * *AppendFormat(Pointer(FormatSettings.ShortDateFor mat));
* * * * * * *GetTime;
* * * * * * *if (Hour <> 0) or (Min <> 0) or (Sec <> 0) then
* * * * * * *begin
* * * * * * * *AppendChars(&quot; &quot;, 1);
* * * * * * * *AppendFormat(Pointer(FormatSettings.LongTimeForm at));
* * * * * * *end;
* * * * * *end;
* * * * *&quot;/&quot;:
* * * * * *if DateSeparator <> #0 then
* * * * * * *AppendChars(@FormatSettings.DateSeparator, 1);
* * * * *&quot;:&quot;:
* * * * * *if TimeSeparator <> #0 then
* * * * * * *AppendChars(@FormatSettings.TimeSeparator, 1);
* * * * *&quot;&quot;&quot;&quot;, &quot;&quot;&quot;:
* * * * * *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 <> &quot;&quot; then AppendFormat(Pointer(Format)) else AppendFormat(&quot;C&quot;
*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, &quot;&quot;, DateTime);
end;

class function TFarDate.farDateTimeToStr(const DateTime: TfarDateTime;
*const FormatSettings: TFormatSettings): string;
begin
*farDateTimeToString(Result, &quot;&quot;, 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
* * *&quot;E&quot;: Result := doYMD;
* * *&quot;Y&quot;: Result := doYMD;
* * *&quot;M&quot;: Result := doMDY;
* * *&quot;D&quot;: 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] = &quot; &quot 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 [&quot;0&quot;..&quot;9&quot;]) and (N < 1000) do
*begin
* *N := N * 10 + (Ord(S[I]) - Ord(&quot;0&quot);
* *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 [&quot;0&quot;..&quot;9&quot;]) 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] = &quot;&quot; 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] = &quot;g&quot; then *// skip over prefix text
*begin
* *farScanToNumber(S, Pos);
* *EraName := Trim(Copy(S, 1, Pos-1));
* *EraYearOffset := farGetEraYearOffset(EraName);
*end
*else
* *if AnsiPos(&quot;e&quot;, 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(&quot;ddd&quot;, FormatSettings.ShortDateFormat) <> 0) then
*begin * * // ignore trailing text
* *if FormatSettings.ShortTimeFormat[1] in [&quot;0&quot;..&quot;9&quot;] then *// stop at time digit
* * *farScanToNumber(S, Pos)
* *else *// stop at time prefix
* * *repeat
* * * *while (Pos <= Length(S)) and (S[Pos] <> &quot; &quot 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 <> &quot;&quot and (ShortDateFormat[1] = &quot;g&quot then *// skip over prefix text
*begin
* *farScanToNumber(S, Pos);
* *EraName := Trim(Copy(S, 1, Pos-1));
* *EraYearOffset := farGetEraYearOffset(EraName);
*end
*else
* *if AnsiPos(&quot;e&quot;, 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(&quot;ddd&quot;, ShortDateFormat) <> 0) then
*begin * * // ignore trailing text
* *if ShortTimeFormat[1] in [&quot;0&quot;..&quot;9&quot;] then *// stop at time digit
* * *farScanToNumber(S, Pos)
* *else *// stop at time prefix
* * *repeat
* * * *while (Pos <= Length(S)) and (S[Pos] <> &quot; &quot 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

[ahmadi613]

با سلام
مدير محترم farsi date را به صورت function در قسمت inplamition قرار دادم اجرا نشد وايرادي داشت مبني* بر اينكه فايل farsi date يافت نمي شود مهندس جان آيا file ويا مورد ديگري كه در قسمت unit* بايد نوشته شود همراه با آن نبايد باشد و يا هر موردي كه نياز باشد با راهنمايي شما در رفع اشكال بنده اقدام بفر ماييد .من سال هاي قبل همين تقريبا موردي بود جواب داد اما در طول مدتي اشتباه حساب مي كرد نتوانستم اشكالش را رفع كنم ومدتي ديگر حذف شد وديگر لاشه اورا هم ندارم.اگر موفق بشوم كه ميلادي را بدون اشكال ياد بگيرم ممنون شما خواهم بود.موفق باشيد.

[b_itman_b]

با سلام.من از یه یونیت به نام Sdate استفاده میکنم که یه تاریخ میلادی میگیره و مقداره شمسی اون رو بر میگردونه.
خیلی راحت و بی دردسره.

[admin]

نقل قول از ahmadi613
با سلام
مدير محترم farsi date را به صورت function در قسمت inplamition قرار دادم اجرا نشد وايرادي داشت مبني* بر اينكه فايل farsi date يافت نمي شود مهندس جان آيا file ويا مورد ديگري كه در قسمت unit* بايد نوشته شود همراه با آن نبايد باشد و يا هر موردي كه نياز باشد با راهنمايي شما در رفع اشكال بنده اقدام بفر ماييد .من سال هاي قبل همين تقريبا موردي بود جواب داد اما در طول مدتي اشتباه حساب مي كرد نتوانستم اشكالش را رفع كنم ومدتي ديگر حذف شد وديگر لاشه اورا هم ندارم.اگر موفق بشوم كه ميلادي را بدون اشكال ياد بگيرم ممنون شما خواهم بود.موفق باشيد.



سلام.این یک یونیت جداگانه است و شما باید در پروژه اتون یک یونیت به نام UFarsiDate ایجاد کرده و این کدها رو با کدهای درون اون یونیت تعویض کنید.
حالا جهت استفاده در پروژه کافیه در قسمت Uses این یونیت یعنی UFarsiDate رو اضافه کنید و از توابع اون استفاده کنید.