توابع تبدیل تاریخ با دقت 5000 سال تست شده با تقویم رسمی ایران http://www.time.ir

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

اول از همه این رو در یک یونیت بگذارید:

const

   SolarDayOfWeek: array [0..6] of string = ('شنيه', 

  'يک شنبه', 

  'دوشنبه', 

  'سه شنبه', 

  'چهارشنبه', 

  'پنج شنبه', 

  'جمعه');

  GregorianDayOfWeek: array [0..6] of string = ('Saturday', 'Sunday', 'Monday', 'Tuesday', 'Wednesday', 'Thursday', 'Friday');



  INVALID_SOLAR_DATE = '1300/01/01';

  INVALID_GREGORIAN_DATE = '1921/03/21';



var

  FormatSetting: TFormatSettings;



type

  TDateBase = (dbSolar, dbGregorian);

function JalCal(JY: Integer; var GY: Integer; var March: integer): boolean;

const

  breaks: Array[1..20] of Integer = (-61, 9, 38, 199, 426, 686, 756, 818,

                                     1111, 1181, 1210, 1635, 2060, 2097,

                                     2192, 2262, 2324, 2394, 2456, 3178);

var

  leapJ, jp, jm, jump, N: Integer;

  j: Integer;

  leap, leapG: Integer;

begin

  GY := JY +621;

  leapJ := -14;

  jp := breaks[1];

  if (JY < jp) or (JY >= breaks[20]) then

    begin

    writeln('error');

    exit;

    end;



  for j := 2 to 20 do

    begin

    jm := breaks[j];

    jump := jm -jp;

    if Jy < jm then

      Break;

    leapJ := leapJ +jump div 33 * 8 +(jump mod 33) div 4;

    jp := jm;

    end;



  N := Jy -jp;

  leapJ := leapJ +N div 33 * 8 +((N mod 33) +3) div 4;

  if(jump mod 33 = 4) and (jump -N = 4)then

    leapJ := leapJ +1;



  leapG := Gy div 4 -(Gy div 100 +1) * 3 div 4 -150;

  March := 20 +leapJ -leapG;

  if (jump -N < 6) then

    N := N -jump +(jump +4) div 33 * 33;

  leap := ((N +1) mod 33 -1) mod 4;

  if leap = -1 then

    leap := 4;



  Result := leap = 0;

end;

initialization

  GetLocaleFormatSettings(LOCALE_SYSTEM_DEFAULT, FormatSetting);

  FormatSetting.ShortTimeFormat := 'HH:MM:SS';

  FormatSetting.ShortDateFormat := 'YYYY/MM/DD';

 // FormatSetting.DecimalSeparator := DECIMAL_DELIMITER;//

 // FormatSetting.ThousandSeparator := THOUSAND_DELIMITER;//

-------------------------------------------------------------------------------------------------------

تبدیل تاریخ شمسی به میلادی:

function Date_SolarToGregorian(SolarDate: string; CanZero: boolean = false): string;

var

  SYear, SMonth, SDay: integer;

  GYear, GMonth, GDay: integer;

  SIsLeap, GIsLeap: boolean;

  GDate: TDate;

begin

  if CanZero and Date_IsZeroValidDate(SolarDate, dbSolar) then

    begin

    Result := '0000/00/00';

    Exit;

    end;



  if (SolarDate <= INVALID_SOLAR_DATE) or (SolarDate > '3000/12/30') or (length(SolarDate) <> 10) then

    begin

    Result := INVALID_GREGORIAN_DATE;

//    MessageBeep(0);

    exit;

    end;



  if not Date_IsValidDate(SolarDate, dbSolar) then

    begin

    Result := INVALID_GREGORIAN_DATE;

//    MessageBeep(0);

    exit;

    end;



  SYear := StrToInt(Copy(SolarDate, 1, 4));

  SMonth := StrToInt(Copy(SolarDate, 6, 2));

  SDay := StrToInt(Copy(SolarDate, 9, 2));



  SIsLeap := JalCal(SYear, GYear, GDay);



  GMonth := 3;

  GIsLeap := SysUtils.IsLeapYear(GYear);

  GDate := StrToDate(RightStr('000' + IntToStr(GYear), 4) + '/' + RightStr('0' + IntToStr(GMonth), 2) + '/' + RightStr('0' + IntToStr(GDay), 2), FormatSetting);

  GDate := GDate +Date_DaysOfYear(SolarDate, dbSolar) -1;

  Result := DateToStr(GDate, FormatSetting);

end;

تبدیل معکوس با استفاده از ریشه یابی باینری (اینجا) :

function MinimalMoveDateSolar(Dt: string; Step: integer): string;

var

  SYear, SMonth, SDay: integer;

  GYear, GDay: integer;

  DPX: integer;

begin

  SYear := StrToInt(Copy(Dt, 1, 4));

  SMonth := StrToInt(Copy(Dt, 6, 2));

  SDay := StrToInt(Copy(Dt, 9, 2));



  repeat

    DPX := Date_DaysPerYear(SYear, dbSolar);

    if Step < DPX then

      break;

    dec(Step, DPX);

    inc(SYear);

  until false;



  repeat

    DPX := Date_DaysPerMonth(SYear, SMonth, dbSolar);

    if Step < DPX then

      break;

    dec(Step, DPX);

    inc(SMonth);

    if SMonth > 12 then

      begin

      SMonth := 1;

      inc(SYear);

      end;

  until false;



  inc(SDay, Step);

  if SDay > Date_DaysPerMonth(SYear, SMonth, dbSolar) then

    begin

    SDay := 1;

    inc(SMonth);

    if SMonth > 12 then

      begin

      SMonth := 1;

      inc(SYear);

      end;

    end;



  Result := RightStr('000' + IntToStr(SYear), 4) + '/' + RightStr('0' + IntToStr(SMonth), 2) + '/' + RightStr('0' + IntToStr(SDay), 2);

end;



function Date_GregorianToSolar(GregorianDate: string): string;

var

  S, S1, S2: string;

  G, G1, G2: string;

  LoopCounter: integer;

begin

  if (GregorianDate <= INVALID_GREGORIAN_DATE) or (GregorianDate > '3622/03/20') or (length(GregorianDate) <> 10) then

    begin

    Result := INVALID_SOLAR_DATE;

//    MessageBeep(0);

    exit;

    end;



  if not Date_IsValidDate(GregorianDate, dbGregorian) then

    begin

    Result := INVALID_SOLAR_DATE;

//    MessageBeep(0);

    exit;

    end;



  S1 := IntToStr(StrToInt(Copy(GregorianDate, 1, 4)) -622) + '/01/01';

  S2 := IntToStr(StrToInt(Copy(GregorianDate, 1, 4)) -621) + '/12/29';



  G1 := Date_SolarToGregorian(S1);

  G2 := Date_SolarToGregorian(S2);



  while G1 > GregorianDate do

    begin

    S1 := Date_MoveDate(S1, -100, dbSolar);

    G1 := Date_SolarToGregorian(S1);

    end;



  while G2 < GregorianDate do

    begin

    S2 := Date_MoveDate(S2, 100, dbSolar);

    G2 := Date_SolarToGregorian(S2);

    end;



  LoopCounter := 0;



  if G1 = GregorianDate then

    Result := S1



  else if G2 = GregorianDate then

    Result := S2



  else

    begin



    repeat

      S := MinimalMoveDateSolar(S1, round(Date_DaysBetween(S1 ,S2, dbSolar) / 2));

      G := Date_SolarToGregorian(S);



      if G = GregorianDate then

        begin

        Result := S;

        break;

        end



      else if G > GregorianDate then

        S2 := S



      else if G < GregorianDate then

        S1 := S;



      inc(LoopCounter);

    until LoopCounter >= 13;



    if LoopCounter >= 13 then

      begin

      Result := INVALID_GREGORIAN_DATE;

//      MessageBeep(0);

      end

    else

      Result := S;



    end;

end;

توابع دیگر:

function Date_DaysOfYear(Dt: string; DateBase: TDateBase): integer;

var

   SMonth, SDay: integer;

begin

  if DateBase = dbSolar then

    begin

    SMonth := StrToInt(Copy(Dt, 6, 2));

    SDay := StrToInt(Copy(Dt, 9, 2));



    case SMonth of

      1: Result := SDay;

      2: Result := SDay +31;

      3: Result := SDay +62;

      4: Result := SDay +93;

      5: Result := SDay +124;

      6: Result := SDay +155;

      7: Result := SDay +186;

      8: Result := SDay +216;

      9: Result := SDay +246;

     10: Result := SDay +276;

     11: Result := SDay +306;

     12: Result := SDay +336;

    end;

    end



  else

    Result := DayOfTheYear(StrToDate(Dt, FormatSetting));

end;

function Date_DaysPerYear(Y: integer; DateBase: TDateBase): integer;

begin

  Result := DaysPerYear[Date_IsLeapYear(Y, DateBase)];

end;

function Date_DaysPerMonth(Y, M: integer; DateBase: TDateBase): integer;

begin

  if DateBase = dbSolar then

    case M of

      1..6: Result := 31;

      7..11: Result := 30;

      12: Result := IfThen(Date_IsLeapYear(Y, dbSolar), 30, 29);

    end



  else

    Result := MonthDays[(M = 2) and SysUtils.IsLeapYear(Y), M];

end;

function Date_DaysBetween(Dt1, Dt2: string; DateBase: TDateBase): integer;

var

  SYear1: integer;

  SYear2: integer;

  i, Day: integer;

  X1, X2: integer;

begin

  if DateBase = dbSolar then

    begin

    SYear1 := StrToInt(Copy(Dt1, 1, 4));

    SYear2 := StrToInt(Copy(Dt2, 1, 4));



    Day := 0;

    for i := SYear1 +1 to SYear2 -1 do

      Day := Day +Date_DaysPerYear(i, dbSolar);



    X1 := Date_DaysOfYear(Dt1, dbSolar);

    X2 := Date_DaysOfYear(Dt2, dbSolar);

    Result := Day + X2 -X1 +IfThen(SYear1 = SYear2, 0, Date_DaysPerYear(SYear1, dbSolar));

    end



  else

    Result := DaysBetween(StrToDate(Dt1, FormatSetting), StrToDate(Dt2, FormatSetting));

end;

function Date_IsLeapYear(Y: integer; DateBase: TDateBase): boolean;

var

  DD, YY: integer;

begin

  if DateBase = dbSolar then

    Result := JalCal(Y, YY, DD)

  else

    Result := SysUtils.IsLeapYear(Y);

end;

function Date_MoveDate(Dt: string; Step: integer; DateBase: TDateBase): string;

var

  D: TDate;

begin

  if DateBase = dbSolar then

    Dt := Date_SolarToGregorian(Dt);



  D := StrToDate(Dt, FormatSetting) +Step;

  Dt := DateToStr(D, FormatSetting);



  if DateBase = dbSolar then

    Dt := Date_GregorianToSolar(Dt);



  Result := Dt;

end;

function Date_DifDate(Dt1, Dt2: string; DateBase: TDateBase): integer;

begin

  if DateBase = dbSolar then

    begin

    Dt1 := Date_SolarToGregorian(Dt1);

    Dt2 := Date_SolarToGregorian(Dt2);

    end;



  Result := DaysBetween(StrToDate(Dt1, FormatSetting), StrToDate(Dt2, FormatSetting));

end;

function Date_IsValidDate(Dt: string; DateBase: TDateBase): boolean;

var

  DD, MM, YY: integer;

begin

  if length(Dt) <> 10 then

    begin

    Result := false;

    exit;

    end;



  DD := StrToInt(Copy(Dt, 9, 2));

  MM := StrToInt(Copy(Dt, 6, 2));

  YY := StrToInt(Copy(Dt, 1, 4));



  if DateBase = dbSolar then

    Result := (MM in [1..12])

              and (

                   (MM in [1..6]) and (DD in [1..31]))

                   or

                   ((MM in [7..11]) and (DD in [1..30]))

                   or

                   ((MM = 12) and (DD in [1..IfThen(Date_IsLeapYear(YY, dbSolar), 30, 29)])

                   )



  else

    Result := IsValidDate(YY, MM, DD);

end;

function Date_IsZeroValidDate(Dt: string; DateBase: TDateBase): boolean;

var

  DD, MM, YY: integer;

begin

  if length(Dt) <> 10 then

    begin

    Result := false;

    exit;

    end;



  DD := StrToInt(Copy(Dt, 9, 2));

  MM := StrToInt(Copy(Dt, 6, 2));

  YY := StrToInt(Copy(Dt, 1, 4));



  if DateBase = dbSolar then

    Result := ((DD = 0) and (MM in [0..12]))

              or

              ((MM = 0) and (DD in [0..31]))

              or

              ((YY = 0) and (DD in [0..31]) and (MM in [0..12]))



  else

    Result := false;

end;

function Date_FirstDayOfYear(Year: integer): string;

begin

  result := IntToStr(Year) + '/01/01';

end;

function Date_LastDayOfYear(Year: integer; DateBase: TDateBase): string;

begin

  if Date_IsLeapYear(Year, DateBase) then

    Result := IntToStr(Year) + '/12/30'

  else

    Result := IntToStr(Year) + '/12/29';

end;

function Date_CurrentDate(DateBase: TDateBase = dbSolar): string;

begin

  if DateBase = dbSolar then

    Result := Date_GregorianToSolar(DateToStr(Date, FormatSetting))

  else

    Result := DateToStr(Date, FormatSetting);

end;

function Date_DateToString(Dt: TDateTime; DateBase: TDateBase): string;

begin

  if DateBase = dbSolar then

    Result := Date_GregorianToSolar(DateToStr(Dt, FormatSetting))

  else

    Result := DateToStr(Dt, FormatSetting);

end;

function Date_StringToDate(Dt: string; DateBase: TDateBase): TDateTime;

begin

  if DateBase = dbSolar then

    Result := StrToDate(Date_SolarToGregorian(Dt), FormatSetting)

  else

    Result := StrToDate(Dt, FormatSetting);

end;

دوستان من این توابع رو از یونیتی که نوشته بودم و 12000 خط داره کپی کردم. ممکنه بعضی جاهاش رو یادم رفته باشه.
اگر جایی ارور داد بگید تا بگذارم.

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

سلام
کدام یک از تابع بالا تاریخ شمسی را برمی گرداند

پیدا کردم Date_GregorianToSolar
در ضمن پست بالا بصورت یونیت ضمیمه نمودم

نقل قول:

---

نوشته شده توسط fahimi

پیدا کردم Date_GregorianToSolar
در ضمن پست بالا بصورت یونیت ضمیمه نمودم

---

با سلام و تشکر
لطفا طريقه فراخواني هر کدام از تاريخها را بر روي کپشن يک ليبل بنويسيد.
ممنون:تشویق:

فایل یونیت یکمی اصلاح شد.
طریقه فراخوانیش خیلی ساده هست. شما کجاش مشکل داری؟ بگو توضیح بدم.

نقل قول:

---

نوشته شده توسط You-See

فایل یونیت یکمی اصلاح شد.
طریقه فراخوانیش خیلی ساده هست. شما کجاش مشکل داری؟ بگو توضیح بدم.

---

سلام
طريقه فراخواني تاريخ شمسي(Date_GregorianToSolar) را پيدا نمودم، اما بقيه توابع را نمي دانم چه هستند و چگونه فراخواني ميشوند.منجمله اگر بخواهيم تاريخ شمسي به صورت حروف باشد ، بايد چه تابعي را فراخواني کنيم يا تاريخ قمري ...؟:متعجب:

ما همین جوریش هم باید بشینیم تا ببینیم ماه رو دیدن یا نه تا روزه بگیریم یا نه،
هیچ تاریخ قمری ای دقیق نیست. تنها باید گذشته اون رو در دیتابیس گشت.
در خصوص فارسی شدن، این توابع رو اضافه کنید:

function Date_SolarMonthName(Month: integer): string;

begin

  case Month of

    1: Result := 'فروردین';

    2: Result := 'اردیبهشت';

    3: Result := 'خرداد';

    4: Result := 'تیر';

    5: Result := 'مرداد';

    6: Result := 'شهریور';

    7: Result := 'مهر';

    8: Result := 'آبان';

    9: Result := 'آذر';

   10: Result := 'دی';

   11: Result := 'بهمن';

   12: Result := 'اسفند';

  end;

end;



function Date_SolarFullName(Dt: string): string;

var

  YY, MM, DD: string;

begin

  DD := Copy(Dt, 9, 2);

  MM := Copy(Dt, 6, 2);

  YY := Copy(Dt, 1, 4);



  Result := DD + ' ' + Date_SolarMonthName(StrToInt(MM)) + ' ' + YY;

end;

مهم بیس داستانه، بقیش به راحتی توسعه پذیره.

نقل قول:

---

نوشته شده توسط You-See

ما همین جوریش هم باید بشینیم تا ببینیم ماه رو دیدن یا نه تا روزه بگیریم یا نه،
هیچ تاریخ قمری ای دقیق نیست. تنها باید گذشته اون رو در دیتابیس گشت.
در خصوص فارسی شدن، این توابع رو اضافه کنید:

function Date_SolarMonthName(Month: integer): string;

begin

  case Month of

    1: Result := 'فروردین';

    2: Result := 'اردیبهشت';

    3: Result := 'خرداد';

    4: Result := 'تیر';

    5: Result := 'مرداد';

    6: Result := 'شهریور';

    7: Result := 'مهر';

    8: Result := 'آبان';

    9: Result := 'آذر';

   10: Result := 'دی';

   11: Result := 'بهمن';

   12: Result := 'اسفند';

  end;

end;



function Date_SolarFullName(Dt: string): string;

var

  YY, MM, DD: string;

begin

  DD := Copy(Dt, 9, 2);

  MM := Copy(Dt, 6, 2);

  YY := Copy(Dt, 1, 4);



  Result := DD + ' ' + Date_SolarMonthName(StrToInt(MM)) + ' ' + YY;

end;

مهم بیس داستانه، بقیش به راحتی توسعه پذیره.

---

سلام دوست عزيز
به فکر ما مبتدي ها هم باش.من اين کد را کجا بگذارم و چگونه آنرا فراخواني کنم تا تاريخ شمسي را به صورت حروف به من برگرداند.:متعجب: من مي خواهم تاريخ اينگونه نوشته شود.
براي مثال: بيست و پنجم ، خرداد ، هزار و سيصد و نود و دو
يا مثلا: بيست و پنجم ، خرداد ، 1392
قبلا چندين بار در جاهاي مختلف درخواست کردم ولي همه به اين طرف و آن طرف پاس داده اند و به غير از يک کد که با سالهاي کبيسه مشکل دارد ، چيزي گيرم نيامد.

   ShowMessage(Date_SolarFullName('1392/02/02'));

سلام دوست عزيز خوبي؟
ممنونم از توابعي كه گذاشتين
حالا مي شه بگين با كدوم يكي از اين توابع ميشه يك عدد را با تاريخ شمسي كم يا جمع كرد؟؟واضحتر توضيح بدين
يا در صورت امكان يه نمونه برنامه در اين خصوص بذارين
با تشكر
منتطرتون هستم
خيلي واجبه دوست عزيز

سلام مهندس - من همچنان منتظر پاسختون هستمYou-Seeمهندس - ممنون مي شم سريعتر راهنماييم كنيد

توابع بالا رو که بخونین همه چیز واضحه.
برای مثال افزودن یک عدد به تاریخ شمسی:

NewDate := Date_MoveDate('1392/04/25', 5, dbSolar);

مهندس من زياد با دلفي كار نكردم ميشه زحمت بكشيد و برام يه نمونه برنامه بدين ؟؟؟
نگاه كردم اما چيزي متوجه نشدم .
ميشه زودتر بدين ؟؟

دوست عزیز شما شروع کن هر جا گیر کردی کمک می کنیم.
دستوری که گذاشتم به حدی واضحه که نیازی به توضیح نداره.
بسم الله.. استارت بزن سوال داشتی بپرس.

من تمام توابع رو تو قسمت كد نويسي فرمم اضافه كردم اما ارور داد
نتونستم استفاده كنم
ميشه لطف كنيد يه نمونه برنامه كوچولو در اختيارم بذاريد؟؟؟
خيلي لازم دارم

با سلام و تشکر از زحماتی که کشیدین
من یونیتی رو که شما زحمتش رو کشیده بودین رو به پروژه ام اضافه کردم ولی این پیغام ها رو دریافت کردم

[C++‎ Error] AU.cpp(8): E2209 Unable to open include file 'U30DateUnit.hpp'

 

[C++‎ Error] AU.cpp(61): E2268 Call to undefined function 'Date_SolarFullName'

#pragma hdrstop
#include "AU.h"
#include "B.hpp"
#include "U30DateUnit.hpp"
با توجه با اینکه این یونیت هم به فرم اصلی اضافه شده
لطفا راهنمایی بفرمائید

سلام.
فکر می کنم که در قسمت Interface اعلان این تابع رو نگذاشتید.
اگر همچنان مشکل داشتید نمونه سورس رو ضمیمه کنید نگاه کنم.

دوست عزيز من همچنان منتظر راهنمايي هاي شما هستم

من تو بیلدر اینرو اضافه کردم

یکمی زحمت بدید به خودتون،
آقا/خانم عشق 89 :
شما نه می گی ارورت چیه نه اصلا کدی گذاشتی، این که نمی شه.

آقا/خانم الی 994 :
جواب شما که ارتباطی به حرف من نداشت. سورس نذاشتید!

به هر حال این نمونه برنامه کوچیک رو براتون می گذارم. امیدوارم راتون بندازه.
موفق باشید.

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

عزیز من، گفتم که سورس بدید.
از طرفی نمونه برنامه هم گذاشتم.
با سی پلاس پلاس برنامه دادید واسه تست یونیت دلفی؟!
این فایلیه که توش ایناست:

//---------------------------------------------------------------------------



#include <vcl.h>

#pragma hdrstop

//---------------------------------------------------------------------------

USEFORM("D:\Example\AU.cpp", Form1);

//---------------------------------------------------------------------------

WINAPI WinMain(HINSTANCE, HINSTANCE, LPSTR, int)

{

        try

        {

                 Application->Initialize();

                 Application->CreateForm(__classid(TForm1), &Form1);

                 Application->Run();

        }

        catch (Exception &exception)

        {

                 Application->ShowException(&exception);

        }

        catch (...)

        {

                 try

                 {

                         throw Exception("");

                 }

                 catch (Exception &exception)

                 {

                         Application->ShowException(&exception);

                 }

        }

        return 0;

}

//---------------------------------------------------------------------------

من چی این رو باید ببینم؟
دوست عزیز شما مبانی برنامه نویسی رو فکر می کنم زیاد بلد نیستی، پیشنهاد من اینه که اول یک کتاب از مبانی پیدا کنی و چند تا برنامه کوچیک با دلفی بنویسی، بعد در خدمتیم.
موفق باشی.

من اولش هم بهتون گفتم که برنامه من توی سی بیلدر هستش.
آقا/خانم الی 994 :
جواب شما که ارتباطی به حرف من نداشت. سورس نذاشتید!

این جواب رو به من دادین . ماشالله مجال حرف زدن که به آدم نمیدین
من کمکی که ازتون خواستم این بود که یونیتتون تو سی بیلدر ارور میده همین بود جرمم

در پست شماره 16 اشاره ای به این موضوع نشد.
در پست 19 هم گفتید در بیلدر اضافه کردم.
شما می تونید در نوت پد هم برنامه نویسی کنید. من که نمی دونم در بیلدر می شه دلفی کد زد و کامپایل کرد یا نه (تا جایی که یادمه می شه!)
بنابراین شما باید زبان مورد استفاده رو می گفتید.
برای این که از این توابع در زبان خودتون استفاده کنید باید یک نفر زحمت DLL کردن این توابع رو براتون بکشه.
موفق باشید.

سلام

نقل قول:

---

برای این که از این توابع در زبان خودتون استفاده کنید باید یک نفر زحمت DLL کردن این توابع رو براتون بکشه.

---

نیازی به این کار نیست. C++‎‎ Builder توانایی Compile و استفاده از یونیت های دلفی را دارد. :کف: من یک پروژه نمونه را در C++‎‎ Builder ایجاد کرده ام که می تواند از یونیت U30DateUnit.pas استفاده کند. این پروژه نمونه با C++‎‎ Builder XE4 تست شده است که آنرا ضمیمه کرده ام. انجام این کار حتی در نسخ فسیل شده C++‎‎ Builder هم امکان پذیر است. در ضمن بنده قبلاً ویدئویی را در خصوص استفاده از یونیتهای دلفی در BCB ایجاد کرده ام که فیلم آن در آدرس زیر قرار دارد:
http://www.irstu.com/?p=8490
موفق باشید...

من این تابع را نوشتم که خیلی سریع و دقیق تاریخ میلادی را به شمسی تبدیل می کند

function MiladiToShamsi(N:tdate):string;



const

 W : array[1..7] of widestring = ('یکشنبه','دوشنبه','سه شنبه','چهارشنبه','پنجشنبه','ج�  �عه','شنبه');

 Mon : array[1..12] of widestring = ('فروردین', 'اردیبهشت', 'خرداد', 'تیر', 'مرداد', 'شهریور', 'مهر', 'آبان', 'آذر', 'دی', 'بهمن', 'اسفند');

 var

 days,Y,D,M:integer;

 begin



  days:= DaysBetween(N,EncodeDate(1900,1,1));

   days :=days + 2112;

    Y := 1273;

    M := 0;

    D := 0;



    Y := Y + Trunc(days / 12053) * 33;

    days := days mod 12053;



    Y := Y + Trunc(days / 1461) * 4;

    days := days mod 1461;



    if (days = 1460)then

    begin

        Y := Y + 3;

        days := 365;

    end

    else

    begin

  Y := Y + Trunc(days / 365);

    days := days mod 365;

  end;







    if (days < 186)then

    begin

        M := Trunc(days / 31) + 1;

        D := days mod 31 + 1;

    end

    else

    begin

        M := Trunc((days - 186) / 30) + 7;

        D := (days - 186) mod 30 + 1;

    end;

  result:= inttostr(Y)+' ' + Mon[M] + ' ' + Inttostr(D)+ ' ' + W[DayOfWeek(N)];

 end;

طریقه استفاده:

Label1.caption:=MiladiToShamsi(date);

این قطعه کد در بازه زمانی کوتاه معقول به نظر می رسه.
بنا به دلایلی که در استفاده از کامپوننت شمسی میلادی استفاده کردم، اولین روز شمسی رو 01/01/1300 قرار دادم.
از همین تاریخ شروع می کنیم به مقایسه:

2256/03/20	MiladiToShamsi = 1634/12/30	Date_GregorianToSolar = 1635/01/01

ta

2257/03/20	MiladiToShamsi = 1635/12/29	Date_GregorianToSolar = 1635/12/30



2289/03/20	MiladiToShamsi = 1667/12/30	Date_GregorianToSolar = 1668/01/01

ta

2290/03/20	MiladiToShamsi = 1668/12/29	Date_GregorianToSolar = 1668/12/30



2322/03/21	MiladiToShamsi = 1700/12/30	Date_GregorianToSolar = 1701/01/01

ta

2323/03/21	MiladiToShamsi = 1701/12/29	Date_GregorianToSolar = 1701/12/30



2355/03/21	MiladiToShamsi = 1733/12/30	Date_GregorianToSolar = 1734/01/01

همون طور که می بینید در تاریخ های بالا (و تمام تاریخ های بین اون، و ایضا تاریخ های دیگه ای که دیگه ادامه ندادم) خروجی برنامه شما با برنامه من فرق داره.
تاریخ های بالا در سایت www.time.ir تست شد و خروجی برنامه شما اشتباه و خروجی برنامه من درست بود.

همون طور که گفتم در بازه قبل از 1634/12/30 شمسی برنامه شما درست کار می کنه. ولی بعد از این تاریخ اشتباهات شروع می شه..

سلام

باتشکر از یوسی جان و با اجازه ایشون

اول اینکه تغییراتی که برای اجرا توی فری پاسکال ( + لازاروس ) لازمه رو انجام دادم و دومم یه مثال با دلفی و لازاروس اضافه کردم . امیدوارم که مورد استفاده قرار بگیره .


موفق باشید

با سلام خدمت اساتید محترم
میخواهم با عبارت زیر تاریخ فرضا امروز را در یک متغیر قرار داده و از یک فیلد که در آن تاریخ میباشد کسر نمایم و نتیجه را که قطعا تعداد روزهای متفاوتی میباشد در فیلدی دیگری وارد نمایم . ولی عبارت نوشته شده دچار خطای سینتکس میشود . چرا؟

   strEmroz:=Date_CurrentDate(dbSolar);

  cmdUpdateRozMondeh.CommandText:='UPDATE tblTazmin SET RozMondeh='+

               Date_DaysBetween(+'TarikhPayan',strEmroz,dbSolar) +

              ' WHERE (NoaZmanat = 0) AND (VazTazmin = 0) OR (VazTazmin = 1);

شما نمی تونی از توابع دلفی در اس کیو ال استفاده کنی.

Date_DaysBetween(+'TarikhPayan',strEmroz,dbSolar)

اینجا شما داری رشته رو مقایسه می کنی.
قبلش باید بریزی در یک متغیر، بعد با توابع دلفی حساب کتاب کنید، بعدش که Date_DaysBetween مقدارش رو داد، ازش استفاده کنید.

با سلام،
به نظرم این یونیت یک ایراد اساسی داره و اون هم در تبدیلات تاریخ هست. در سیستم میشه تنظیمات تاریخ رو طوری عوض کرد که مثلاً به جای / در تاریخها از - و یا کاراکترهای دیگه استفاده بشه و یا اینکه جای روز و ماه و سال رو جابجه کنیم و ... .توی این یونیت برای تبدیلات تاریخ رو به صورت رشته میگیره که کار پردازش رو به شدت سخت میکنه و گاهی غیر ممکن میکنه و فکر می کنم استفاده از این روش اصلاً کار درستی نباشه. به نظر من هرجایی که کار تبدیل تاریخ (از میلادی به شمسی و یا هر مدل دیگری) انجام میشه ورودی تابع باید از نوع TDateTime و امثالهم باشه و نه از نوع رشته. :متفکر:

ورودی و خروجی برای سادگی رشته گرفته شده. خیلی از مواقع در دیتابیس ها و البته گزارشات دسترسی به نوع استاندارد وجود نداره. البته اگر هم داشته باشه برای تبدیل به شمسی باز باید روز و ماه و سالش در بیاد. کار با رشته ساده تره، اما می تونستیم مثلا با نوع Word هم کار کنیم. اساس کار یک سری تبدیلات بر اساس اعداده، ورودی و خروجی چندان اهمیتی نداره، تو سرعت هم به چشم نمیاد :چشمک:

نقل قول:

---

نوشته شده توسط You-See

ورودی و خروجی برای سادگی رشته گرفته شده. خیلی از مواقع در دیتابیس ها و البته گزارشات دسترسی به نوع استاندارد وجود نداره. البته اگر هم داشته باشه برای تبدیل به شمسی باز باید روز و ماه و سالش در بیاد. کار با رشته ساده تره، اما می تونستیم مثلا با نوع Word هم کار کنیم. اساس کار یک سری تبدیلات بر اساس اعداده، ورودی و خروجی چندان اهمیتی نداره، تو سرعت هم به چشم نمیاد :چشمک:

---

توضیح دادی، رفاقتمون سر جاش ولی از اونجایی که توی مسائل فنی خیلی جدی هستم توضیحاتت نتونست من رو قانع کنه. :قلب:چون شرایط مختلفی وجود داره حداقل برای تبدیل میلادی به شمسی ورودی باید به صورت TDateTime باشه و بجای استفاده از پردازش رشته برای بدست آوردن ماه، سال، و روز باید حتماً و حتماً از توابع داخل یونیت DateUtils که شامل توابع YearOf و MonthOf و DayOf هست استفاده بشه و استفاده از کد به کار رفته زیر اصلاً درست نیست:

function Date_IsValidDate(Dt: string; DateBase: TDateBase): boolean;var

  DD, MM, YY: integer;

begin

  if length(Dt) <> 10 then

    begin

    Result := false;

    exit;

    end;





  DD := StrToInt(Copy(Dt, 9, 2));

  MM := StrToInt(Copy(Dt, 6, 2));

  YY := StrToInt(Copy(Dt, 1, 4));





  // ...

end;

در حالت کلی برای انجام این تبدیلات استفاده از پردازش رشته و استفاده از تابع Copy و نظایر آن اشتباه ترین کار ممکن است. مثلاً در کد بالا فرض کن که تاریخ به صورت 2012/6/1 باشه و پشت ماه و روز عدد 0 نباشه. خوب حالا چه مشکلی به وجود میاد؟! :متفکر: درسته در بالا طول 10 چک شده ولی چرا موقعی که صفر پشت ماه یا روز نوشته نشه تابع نباید درست کار کنه؟ واقعاً چرا؟

این یونیت یک یونیت قدیمی برای یکی از کامپوننت هام هست. در اون جا هم کنترل های لازم همگی انجام شده و کاربر نمی تونه خارج از قواعد چیزی بزنه، سرسختیت همیشه برام مهم و ارزشمند بوده و هست. بعضی از کدهایی که به نظر بی مورد یا عجیب میاد، در اصل کات شده ی کد اصلی من بود. بعضی جاها مثلا چک شده تا صفر بودن تاریخ (!!) بررسی بشه، دلیلش هم چیزی بود که بیان کردم.
کد به طور صحیح کار می کنه، و می شه ازش استفاده کرد، اما بهینه نیست. مخصوصا در استفاده از تبدیل معکوس با استفاده از روش ریشه یابی دودویی.
خیلی خوبه که گیر بدی، باعث افزایش دقت من هم می شه.
اصلا یکی از موارد دیگه ای که باید در این کد رعایت بشه، FormatSetting هست.
مواردی که گوشزد کردی، به جاست.
مهم ترین دلیلی که این یونیت اینجا گذاشته شد، بحث آموزشی قضیه هست، و مهم تر از اون این که مشکل همیشگی با تاریخ های کبیسه حل بشه. باقی توابع و ورودی ها همگی قابل بازنویسی هستند.
از این که می بینم کدهای من توسط عزیزان حرفه ای تر از من بررسی می شه و نقطه نظراتشون رو می گن، باعث خوشحالی منه.
کارت در اومد، باید کدی رو که از نظر خودت درسته، یا از اون بهتر، اصلاح شده یونیت من رو بگذاری اینجا :لبخند:
خوبت بشه!

نقل قول:

---

از این که می بینم کدهای من توسط عزیزان حرفه ای تر از من بررسی می شه و نقطه نظراتشون رو می گن، باعث خوشحالی منه.

---

امیدوارم که منظورت من نبوده باشم. شما خودت استاد ما هستی. :قلب:

نقل قول:

---

اصلا یکی از موارد دیگه ای که باید در این کد رعایت بشه، FormatSetting هست.

---

کاستی های مختلفی داره. مثلاً موقعی که یک تاریخ رو به صورت رشته به تابع میدیم کاربر حتماً در پارامتر دیگری از همون تابع باید فرمت تاریخ رو وارد کنه و ... .

نقل قول:

---

کارت در اومد، باید کدی رو که از نظر خودت درسته، یا از اون بهتر، اصلاح شده یونیت من رو بگذاری اینجا

:لبخند:

خوبت بشه!

---

باشه، این پروژه که دارم روش کار می کنم تموم شد این یونیت رو تا جایی که سوادم برسه اصلاح میکنم. :لبخند:

نقل قول:

---

مثلاً موقعی که یک تاریخ رو به صورت رشته به تابع میدیم کاربر حتماً در پارامتر دیگری از همون تابع باید فرمت تاریخ رو وارد کنه

---

این کاستی نیست، اتفاقا قدرته، کاربر می تونه با یک تابع هم کارای شمسی کنه هم میلادی، به طور مثال انتقال تاریخ به چند رو بعد / قبل، شمسی با میلادی فرق داره. از طرفی پیش فرض داره به این معنی که برنامه نویس هیچی هم نداد، نداد.

منتظر کدت هستم، بالاخره دو تا مغز دو تا فکر دارند که مسلما از یک فکر بهتره.
:چشمک:

سلام
آقا این یونیت رو چطور میشه تبدیلش کرد به یه تقویم .مثل Calender خود دلفی .ویا دیگر کامپوننتها

سلام. من این کار رو قبلا ها برای شرکتی که توش کار می کردم کرده بودم، باید کامپوننت براش بنویسی و توابع رو در اون بگنجونی، یک دموی خیلی خلاصه روی دلفی هفت ازش دارم که براتون می گذارم.

باتشکرازشما.
فکر میکنم اشتباه شده .چون این فیلم آموزش اینتراوبه.اگه امکان داره دموی کامپوننت رو یه باردیگه آپلودکنید.
باتشکر

لینک ها تصحیح شد.