كيف يمكن تحويل التاريخ

السلام عليكم

هذا كود كتبته أيام زمان بالباسكال .. قد يكون مفيدا ، وتحتاج تحويل الإجراء إلى دالة والإعلان عن المتغيرات DD,MM,YY :

  {Range ..

  Greg. 30/04/1900..28/02/2100

  Hejri 01/01/1318..19/12/1523}



  {------------------------------------------}

  Function GMDays(M:Byte):Integer;

  Const Gms=30.6;

  Begin

    M := M Mod 12;

    If M>2 Then

      GMDays := Round((M-2)*Gms)+60

    Else

      GMDays := Round(M*Gms)-Trunc(M/2);

  End;

  {------------------------------------------}

  Procedure HtoG(D,M:Byte; Y:Integer; Var DD,MM:Byte; Var YY:Integer);

  Const Hys=354.3667; Gys=365.25;

  Var   DM:Integer; DY,Days:LongInt; Cut:Byte;

  Begin

    DY := Round((Y-1291) * Hys);

    DM := Round((M-1) * 29.51);

    Days := DY+DM+D-9814;



    YY := Int(Days/Gys);

    If Int(YY*Gys) > Days-1 Then YY := YY-1;

    Days := Days-Int(YY*Gys);

    YY := YY+1901;

    Cut := 0; If (Days>59) And (YY Mod 4<>0) Then Cut := 1;

    MM := Int((Days+Cut-1)/30); If MM>11 Then MM := 11;

    If GMDays(MM)-Cut > (Days-1) Then MM := MM-1;

    DD := Days-(GMDays(MM)-Cut); MM := MM+1;

  End;

  {------------------------------------------}

تحياتي .

شكرا جزيلا لك أخي أبو هادي (f)(f)

وانا احتاج الي تحويل التاريخ الميلادي الي هجري:D

السلام عليكم

  {------------------------------------------}

  Function Int(Num:Real):LongInt;

  Begin

    If Num<0 Then Num := Num-1; Int := Trunc(Num);

  End;

  {------------------------------------------}

  Procedure GtoH(D,M:Byte; Y:Integer; Var DD,MM:Byte; Var YY:Integer; Var WD:Byte);

  Const Hys=354.3667; Gys=365.25;

  Var   DM:Integer; DY,Days:LongInt;

  Begin

    DY := Int((Y-1901)*Gys);

    DM := GMDays(M-1); If (M>2) And (Y Mod 4<>0) Then DM := DM-1;

    Days := DY+DM+D+9814;



    If (Days>82557) Or (Days<9569) Then Exit;

    WD := (Days+2) Mod 7;



    YY := Int(Days/Hys);

    If Round(YY*Hys) > Days-1 Then YY := YY-1;

    Days := Days-Round(YY*Hys);

    YY := YY+1291;

    MM := Int((Days-1)/29.5); If MM>11 Then MM := 11;

    If Round(MM*29.51) > (Days-1) Then MM := MM-1;

    DD := Days-Round(MM*29.51); MM := MM+1;

  End;

  {------------------------------------------}

تحياتي .

السلام عليكم

وهذا كود للتحقق من صحة الإدخال Validation .

Var

  D ,M :Byte; Y :Integer; WD:Byte;

  DD,MM:Byte; YY:Integer;

  D2,M2:Byte; Y2:Integer;

  {------------------------------------------}

  Procedure Beep;

  Begin

    Sound(1000); Delay(300); NoSound;

  End;

  {------------------------------------------}



Begin

  ClrScr;

  While True Do Begin

    ReStart;

    If(M<0) Or (M>12) Then Begin Beep; Continue End;



   If (Y>=1318) And (Y<=1523) Then Begin

     HtoG(D ,M ,Y ,DD,MM,YY   );

     GtoH(DD,MM,YY,D2,M2,Y2,WD);

     If (D<>D2) Or (M<>M2) Or (Y<>Y2) Then

       Begin Beep; Continue End;

     PrintDate(DD,MM,YY,D,M,Y,WD); Continue

   End;



   If (Y>=1900) And (Y<=2100) Then Begin

     GtoH(D ,M ,Y ,DD,MM,YY,WD);

     HtoG(DD,MM,YY,D2,M2,Y2   );

     If (D<>D2) Or (M<>M2) Or (Y<>Y2) Then

       Begin Beep; Continue End;

     PrintDate(D,M,Y,DD,MM,YY,WD); Continue

   End;



   Beep; Continue

  End;

End.

تحياتي .

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

السلام عليكم

أخي لقد حولت الإجراء إلى دالة نصية ، مع ملاحظة أن هناك 3 دوال أخرى مطلوبة في دالة التحويل .

  Function myStr(V:Real):String;

  Var N_:String; Len,Code:Integer; K:Byte;

  Begin

    Str(V:0:12,N_);

    While Copy(N_,Length(N_),1) ='0' Do Delete(N_,Length(N_),1);

    If Copy(N_,Length(N_),1) = '.' Then Delete(N_,Length(N_),1);

    myStr := N_;

  End;

  {------------------------------------------}

  Function Int(Num:Real):LongInt;

  Begin

    If Num<0 Then Num := Num-1; Int := Trunc(Num);

  End;

  {------------------------------------------}

  Function GMDays(M:Byte):Integer;

  Const Gms=30.6;

  Begin

    M := M Mod 12;

    If M>2 Then

      GMDays := Round((M-2)*Gms)+60

    Else

      GMDays := Round(M*Gms)-Trunc(M/2);

  End;

  {------------------------------------------}

  Function HtoG(D,M:Byte; Y:Integer):String;

  Const Hys=354.3667; Gys=365.25;

  Var   DM:Integer; DY,Days:LongInt; Cut:Byte;

        DD,MM:Byte; YY:Integer;

  Begin

    DY := Round((Y-1291) * Hys);

    DM := Round((M-1) * 29.51);

    Days := DY+DM+D-9814;



    YY := Int(Days/Gys);

    If Int(YY*Gys) > Days-1 Then YY := YY-1;

    Days := Days-Int(YY*Gys);

    YY := YY+1901;

    Cut := 0; If (Days>59) And (YY Mod 4<>0) Then Cut := 1;

    MM := Int((Days+Cut-1)/30); If MM>11 Then MM := 11;

    If GMDays(MM)-Cut > (Days-1) Then MM := MM-1;

    DD := Days-(GMDays(MM)-Cut); MM := MM+1;

    HtoG := myStr(DD)+'/'+myStr(MM)+'/'+myStr(YY);

  End;

  {------------------------------------------}

تحياتي .

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

الله يعطيك العافية أخي أبو هادي

أخوكم الأقصى

الله يعطيكم العافية يا شباب

ما قصرتوا

لكن لتتم الفائدة ، هل لدى أحدكم معادلات مواقيت الصلاة أيضاً؟

مع الشكر

السلام عليكم

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

http://www.arabteam2000.com/ib/index.php?s...view=getnewpost

تحياتي .