التاريخ الهجري

السلام عليكم ورحمة الله وبركاتة

function GregToHijri(Date: TDateTime): tdatetime;

var

GregDate: TSystemTime;

HigriText: array[0..127] of Char; {For Hijra date}

begin

DateTimeToSystemTime(Date, GregDate);

GetDateFormat(0, DATE_USE_ALT_CALENDAR, @GregDate, 'dd/MM/yyyy', HigriText, 128);

Result := strtodate(StrPas(HigriText));

end;

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

هذه الفنكشن تعطيها التاريخ الحالى او أى تاريخ ميلادى يحولة ألى هجري

اخي الكريم لم يعمل الكود الا بعد ان قمت تغيير اللغة من لوحة التحكم وهذا غير منطقي ، لاني لوغيرت اللغة فلا حاجة لي بالكود السابق اكتب فقط الكود التالي

procedure TForm1.Button1Click(Sender: TObject);

var d:string;

begin

d:=DateTimeToStr('dd/mm/yyyy', now);

ShowMessage(d);

end;

كما قلت لو كانت اللغة عربية

فهل لديك فكرة

السلام عليكم...

أعتقد أن الدالة صحيحة مع بعض التعديل (السبب هو أن StrToDate ستعتبر أن التاريخ المطلوب هو التاريخ الميلادي):

1. غير نوع الدالة من TDateTime إلى string

2. غير السطر الأخير في الدالة إلى هذا الشكل:

Result := StrPas(HigriText);

لاحظ أنه في هذه الحالة ستعيد الدالة التاريخ الهجري كـ string و ليس كـ TDateTime.

نرجو الاستفادة و السلام.

السلام عليكم

وجدت هذا الرابط ربما يفيدك

http://www.bukisa.com/articles/81917_hijri-date-converter-delphi-source-code

بالتوفيق

اخي الكريم وجدت الحل وذالك بتغيير في الكود في اول بارميتر من 0 الى 1

GetDateFormat(1, DATE_USE_ALT_CALENDAR, @GregDate, 'dd/MM/yyyy', HigriText, 128);

وبالتلي سوف ترجع الدالة بالتاريخ الهجري في حالة كان لغة المستخدم الانجليزية

ولكن تقبى مشكلة واحدة وهي يجب ان يكون التاريخ المرسل الى الدالة وهو في صيغة نفس صيغة التاريخ في الجاهز

يعني لو ارسلت التاريخ بالشكل التالي

dd/mm/yyyy

وكان صيغة تاريخ الجاهز

mm/dd/yyyy

فسوف يحدث خطأ وبالتالي يجب ان ادخل على لوحة التحكم واغير شكل التاريخ

undertaker_2 كتب:

هل هناك اداة او كود للتحويل من التاريخ الميلادي الى التاريخ الهجري

وكذلك ساعة عقارب هل هناك اداة لها علما ان بحثت طوليا وجدت برنامج ولكني لم استطع الاستفادة فهل لديكم البرنامج في المرفقات

ممكن ايضاح المطلوب هل ترغب سلسلة اظهار التاريخ الهجري ببرنامجك اضافة الى الميلادي او ماذا تريد رغبتي مساعدتك

شكرا لك اخي الكريم , اريد فقط اضافة التاريخ الهجري الى برنامجي

undertaker_2 كتب:

شكرا لك اخي الكريم , اريد فقط اضافة التاريخ الهجري الى برنامجي

هذا ما اريد استيضاحه منك واليك هذا الفانكشن تضعه بمقدمة برنامجك وتضعه في متغير تقرأه كل الفورمات التي تليه

وعند رغبتك تضعه في مقدمة كل فورم فلا مانع وهذا افضل لأن بعض البرامج تعمل على مدار السنه ولا تقفل ولهذا يوضع في كل فورم افضل

عند FORM SHOW او TIMRE1

ضع فورمات التاريخ الهجري وانقله في المتغير السابق (mydatH)انا وضعته سترنق وانت ضعه كما تريد تاريخ او سترنق

كما يلي:

أو تضيف على الفورمات هـ

اتمن ان يكون ردي مفيد

هذه معدلات لتحويل من التاريخ الهجري إلى الميلادي والعكس:

الدالتين الرئيسيتين هما HijriToGregorian و GregorianToHijri.

unit Unit1;

interface
uses SysUtils;
type
TYMD = record
  Year: integer;
  Month: integer;
  Day: integer;
end;



function HijriToGregorian(hijri: TYMD): TYMD;
function GregorianToHijri(Ggr: TYMD): TYMD;

implementation


  //  convert from Date representation (d/m/y) to Julian Day
  //  Result is Julian day (7.1)
function DateToJulianDay(_date:TDateTime; After:Boolean = true): Extended ;
var
 a,b: integer;
 y,m,d: word;
begin
  DecodeDate(_date,y,m,d);
  if m <= 2 then begin y:= y-1; m:= m + 12; end;
  b:=0;
  if After then
    begin
       a:= trunc(y/100);
       b:= 2- a + trunc(a/4);
    end;
  result:= trunc(365.25 * (y+ 4716)) + trunc (30.6001 * (m +1)) + d + b - 1524.5;
end;


  //  convert from Julian Day to Date representation (D,M,Y)
  // (ref. page 63 of Astronomical Algorithms, Jean meaus)
function JulianDayToDate(JD: Extended): TDateTime;
var
 a,b,c,e,k,z: integer;
 d,m,y: integer;
 _Time:extended;
begin
  Jd:= jd + 0.5;
  z:= trunc(jd);
  _time:= Frac(jd);
  if z < 2299161 then a:=z else
    begin
       k:= trunc((z-1867216.25)/36524.25);
       a:= z + 1 + k - trunc(k/4);
    end;
  b:= a+1524;
  c:= trunc((b-122.1)/365.25);
  d:= trunc(365.25*c);
  e:= trunc((b-d)/30.6001);

  d:= b-d-trunc(30.6001 *e) ;             //  day number
  if e>=14 then m:= e-13 else m:= e-1;    //  Month number
  if m>2 then y:= c-4716 else y:= c-4715; //  year number
  Result:= EncodeDate(y,m,d);
  if Result<0 then Result:= Result - _time else Result:= Result + _time  ;
end;

function JDToHijir(JD: extended): TYMD;
var
  L,N,J:integer;
begin
  L := Trunc(JD) - 1948440 + 10632;
  N := Trunc((L - 1) / 10631);
  L := L - 10631 * N + 354;

  J := Trunc((10985 - L) / 5316) * Trunc((50 * L) / 17719)
      + Trunc(L / 5670) * Trunc((43 * L) / 15238);

  L := L - Trunc((30 - J) / 15) * Trunc((17719 * J) / 50)
      - Trunc(J / 16) * Trunc((15238 * J) / 43) + 29;

  result.Month := Trunc((24 * L) / 709);
  Result.Day := L - Trunc((709 * result.Month) / 24);
  Result.Year := Trunc(30 * N + J - 30);
end;

function HijirToJD(hijri: TYMD): extended;
begin
   result := (11 * hijri.Year + 3) / 30
            + 354 * hijri.Year
            + 30 * hijri.Month
            - (hijri.Month - 1) / 2
            + hijri.Day + 1948440 - 385;
end;

function HijriToGregorian(hijri: TYMD): TYMD;
var
  Year,Month,Day: word;
begin
  DecodeDate(JulianDayToDate(HijirToJD(hijri)),Year,Month,Day);
  Result.Year:= Year;
  Result.Month:= Month;
  Result.Day:=Day;
end;

function GregorianToHijri(Ggr: TYMD): TYMD;
begin
  Result:= JDToHijir(DateToJulianDay(EncodeDate(Ggr.year,Ggr.Month,Ggr.Day)));
end;
end.

هذا مثال ممتاز لعرض تاريخ اليوم كاملاً بتقويم الميلادي والهجري:

const

TDayNames: array[1..7] of WideString =
  (
    'الاحد',
    'الاثنين',
    'الثلاثاء',
    'الاربعاء',
    'الخميس',
    'الجمعة',
    'السبت'
  );

  //   The arabic Hijri Month Names
  THijriMonthNames: array[1..12] of WideString =
    ('محرّم',
    'صفر',
    'ربيع الأول',
    'ربيع الثاني',
    'جمادى الأولى',
    'جمادى الآخرة',
    'رجب',
    'شعبان',
    'رمضان',
    'شوال',
    'ذو القعدة',
    'ذو الحجة'
  );
//   The arabic Gregorien Month Names in the north of africa

  TGregorienMonthNames_AF : array[1..12] of WideString =
    (
    'يناير',
    'فبراير',
    'مارس',
    'ابريل',
    'مايو',
    'يونيو',
    'يوليوز',
    'غشت',
    'شتنبر',
    'اكتوبر',
    'نونبر',
    'دجنبر'
    );
//   The arabic Gregorien Month Names in the meddel east
  TGregorienMonthNames_ME : array[1..12] of WideString =
    (
    'كانون الثاني',
    'شباط',
    'آذار',
    'نيسان',
    'أيار',
    'حزيران',
    'تموز',
    'آب',
    'أيلول',
    'تشرين الأول',
    'تشرين الثاني',
    'كانون الأول'
    );





function GetLongDateStrHijri_Miladi: string;
var
  Year, Month, Day: word;
  ggr,hijri: TYMD;
begin
  DecodeDate(now, Year, Month, Day);
  ggr.Year:= Year;
  ggr.Month:= Month;
  ggr.Day:= Day;
  hijri:= GregorianToHijri(ggr);
  result :=
        TDayNames[DayOfWeek(now)]+ ' ' +
        IntToStr(ggr.Day)+ ' ' +
        TGregorienMonthNames_AF[ggr.Month]+'/'+
TGregorienMonthNames_ME[ggr.Month]+ ' ' +
        IntToStr(ggr.Year) + ' '+
        'الموافق ل ' +
        IntToStr(hijri.Day)+ ' ' +
        THijriMonthNames[hijri.Month]+ ' ' +
        IntToStr(hijri.Year);
end;

أما إذا كنت تريد الإستفادة من التقويم الذي توفره mswindows عليك بقراءة هذا المقال:

http://www.microsoft.com/middleeast/msdn/ArabicCalendar.aspx

اخي الكريم شكرا لك ولكن هناك تعديل بسيط في الكود وهو بدل من 0 نجعلها 1 وذالك لكي يعطني التاريخ الهجري في حالة كانت واجهة المستخدم انجليزية

الشئ الاخر هو دالة تعطني اليوم بدل من الكود الطويل

mydatH := GetHijra(Date,'dddd dd/MMMM/yyyy هـ')

Higrii.rar

هناك حل افضل من كل ذلك و هو موجود في الـ Framework

لمكنكم مشاهدة الحل بالتفصيل في المضوع التالي ...

/index.php?showtopic=228162&st=0&p=1132380&fromsearch=1entry1132380