problem with hijri calender

hi,
in our country we used different calender in some case the date will be
something like "30/02/1420" and this will generate erorr i make some function to convert system date to needed date but some date will generate the erorr like above one .
how i can fix this problem ?
iam useing Delphi5
abualiAsked:
Who is Participating?
 
kifahConnect With a Mentor Commented:
Just copy all the code from this, then paste it.... done....

I am really surprise from programmers like abuali, which they have some informatio, and they do not give it untill the get more then it worth.... why like this function, it should be with each moslem programmers, really abuali it is shame that we still think in this way, at least we are the moslems programmers, we should help each other (or you forget the hadith), and this code I can give it free to any one in the world, and it is public free...

Thanks to addeb rantawy who made most of this code........



unit hijri;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Grids, DB, DBCtrls;

type
  THijriDateEdit = class(TStringGrid)
  private
    FDateText: String;
    FOnChange: TNotifyEvent;
    FOnDayError: TNotifyEvent;
    FOnMonthError: TNotifyEvent;
    FOnYearError: TNotifyEvent;
    //
    function ValidValue: Boolean;
    procedure SetDateText(Value: String);
    function GetDateText: String;
  protected
    procedure Change; virtual;
    procedure DayError;
    procedure MonthError;
    procedure YearError;
    procedure DoExit; override;
    procedure KeyPress(var Key: Char); override;
    function SelectCell(ACol, ARow: Longint): Boolean; override;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property DateText: String read GetDateText write SetDateText;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    property OnDayError: TNotifyEvent read FOnDayError write FOnDayError;
    property OnMonthError: TNotifyEvent read FOnMonthError write FOnMonthError;
    property OnYearError: TNotifyEvent read FOnYearError write FOnYearError;
  end;

  THijriDBDateEdit = class(THijriDateEdit)
  private
    FReadOnly: Boolean;
//    FUpdating: Boolean;
    FDataLink: TFieldDataLink;
    //
    function GetDataField: string;
    function GetDataSource: TDataSource;
    procedure SetDataField(const Value: string);
    procedure SetDataSource(Value: TDataSource);
    procedure DataChange(Sender: TObject);
    procedure UpdateData(Sender: TObject);
    //
    procedure CMExit(var Message: TWMNoParams); message CM_EXIT;
    //
  protected
    function SelectCell(ACol, ARow: Longint): Boolean; override;
    procedure Change; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property ReadOnly: Boolean read FReadOnly write FReadOnly default False;
    property DataField: string read GetDataField write SetDataField;
    property DataSource: TDataSource read GetDataSource write SetDataSource;
  end;

procedure Register;

implementation

uses
  StdCtrls, Math; // for ScrollBars

// <utility functions>
function MonthDays(Month: Byte; Year: Word): Byte;
var
  Loop: Byte;
  DaysArray: array[1..12] of Byte;

begin
  for Loop:= 1 to 12 do DaysArray[Loop]:= 29 + (Loop mod 2);
  //
  if ((Year mod 30) in [2, 5, 8, 10, 13, 16, 19, 21, 24, 27, 29]) then
    inc(DaysArray[12]);
  //
  Result:= DaysArray[Month];
end;

procedure StrToDMY(StrDate: String; var Day: Byte; var Month: Byte; var Year: Word);
var
  p: Byte;

begin
  p:= pos('/', StrDate);
  Day:= StrToInt(copy(StrDate, 1, p-1));
  Delete(StrDate, 1, p);
  p:= pos('/', StrDate);
  Month:= StrToInt(copy(StrDate, 1, p-1));
  Delete(StrDate, 1, p);
  Year:= StrToInt(StrDate);
end;

function GregToHijri(Date: TDateTime): String;
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 := StrPas(HigriText);
end;

function HijriToGreg(Date: String): TDateTime;
var
  D, M: Byte;
  Y: Word;
  //
  Leap: Byte;
  Year, Multiples: Word;
  Month, Day, dif, Count: Extended;
  DateCheck: String;

begin
  StrToDMY(Date, D, M, Y);
  //
  dif := (Round(((Y - 1) * 12 + M - 1) * 29.530587962963 + 1948437.7759375 + D - 0.5) + 0.5) - 1721059.5;
  Year := 0;
  Leap := 1;
  Count := 0;
  //
  if (dif <= 0) then
  begin
    Year := 1;
    Leap := 0;
  end;

  Multiples:= Floor(Abs(dif / 365.2425) / 400) * 400;
  inc(Year, Multiples);
  Count := Count + (Multiples * 365.2425);

  while (Abs(dif) >= Count + 365 + Leap) do
  begin
    inc(Year);
    Count := Count + (365 + Leap);
    Leap:= Floor(Floor(Year/4)/(Year/4)) -
           Floor(Floor(Year/100)/(Year/100)) + Floor(Floor(Year/400)/(Year/400));
  end;

  if dif <> 0 then
    Year := Round(Year * dif / Abs(dif))
  else
    Year := 0;

  Day := dif - Count + 1;

  if (Day < (60 + Leap)) then
  begin
    Day := Day + 365;
    Year := Year - 1;
  end
  else
    Day := Day - Leap;

  Month := Floor((Day + 63) / 30.6001) - 1;
  Day := Day - (Floor((Month + 1) * 30.6001) - 63);

  if (Month > 12) then
  begin
    Month := Month - 12;
    Year := Year + 1;
  end;
  //
  Result:= EncodeDate(Year, Round(Month), Round(Day));
  // reverse check!
  DateCheck:= GregToHijri(Result);
  // MS conversion starts at 1/1/1601
  if Result > StrToDate('1/1/1601') then
  begin
    if DateCheck <> Format('%d/%d/%d', [D, M, Y]) then
      Result:= Result - 1;
  end;
end;
// </utility functions>

{ THijriDateEdit }
constructor THijriDateEdit.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  BidiMode:= bdRightToLeft;
  ColCount:= 5;
  DefaultRowHeight:= 19;
  FixedCols:= 0;
  FixedRows:= 0;
  Height:= 21;
  Options:= [goEditing,goAlwaysShowEditor];
  RowCount:= 1;
  Width:= 94;
  ScrollBars:= ssNone;
  ColWidths[0]:= 18;
  ColWidths[1]:= 12;
  Cells[1, 0]:= '/';
  ColWidths[2]:= 18;
  ColWidths[3]:= 12;
  Cells[3, 0]:= '/';
  ColWidths[4]:= 30;
  //
  FDateText:= GregToHijri(Date);
end;

procedure THijriDateEdit.Change;
begin
  if Assigned(FOnChange) then FOnChange(Self);
end;

procedure THijriDateEdit.DayError;
begin
 if Assigned(FOnDayError) then FOnDayError(Self);
end;

procedure THijriDateEdit.MonthError;
begin
 if Assigned(FOnMonthError) then FOnMonthError(Self);
end;

procedure THijriDateEdit.YearError;
begin
 if Assigned(FOnYearError) then FOnYearError(Self);
end;

function THijriDateEdit.ValidValue: Boolean;
var
  Day, Month, Year: Word;

begin
  Result:= False;
  //
  Day:= StrToInt(Cells[0, 0]);
  //
  if (Col= 0) and not(Day in [1..30]) then
  begin
    DayError;
    SetFocus;
    Exit;
  end;
  //
  Month:= StrToInt(Cells[2, 0]);
  //
  if (Col= 2) and not(Month in [1..12]) then
  begin
    MonthError;
    SetFocus;
    Exit;
  end;
  //
  Year:= StrToInt(Cells[4, 0]);
  // MS conversion starts at 1/1/1601 AC = 26/6/1009 Hijri
  if Year < 1010 then
  begin
    YearError;
    SetFocus;
    Exit;
  end;
  //
  if Day > MonthDays(Month, Year) then
  begin
    MonthError;
    SetFocus;
    Exit;
  end;
  //
  Result:= true;
end;

procedure THijriDateEdit.DoExit;
begin
  ValidValue;
  inherited DoExit;
end;

procedure THijriDateEdit.KeyPress(var Key: Char);
begin
  if not(Key in ['0'..'9', '/']) then
  begin
    Key:= #0;
    Exit;
  end;
  //
  if (Key = '/') and (Col = 4) then
  begin
    Key:= #0;
    Exit;
  end;
  //
  if Col in [1, 3] then
  begin
    Col:= Col + 1;
    Key:= #0;
    Exit;
  end;
  //
  if (Key= '/') and (Col <> 4) then
  begin
    Col:= Col + 2;
    Key:= #0;
    Exit;
  end;
  // length OK?!
  case Col of
    0,
    2: if (Length(Cells[Col, 0])= 2) and (InplaceEditor.SelLength= 0) then
       begin
         Key:= #0;
         Exit;
       end;
    4: if (Length(Cells[4, 0])= 4) and (InplaceEditor.SelLength= 0) then
       begin
         Key:= #0;
         Exit;
       end;
  end;
  //
  Change;
  inherited KeyPress(Key);
end;

function THijriDateEdit.SelectCell(ACol, ARow: Longint): Boolean;
begin
  Result:= ValidValue;
end;

procedure THijriDateEdit.SetDateText(Value: String);
var
  Day, Month: Byte;
  Year: Word;

begin
  if (Value = '') or (Value = '//') then Exit;
  //
  StrToDMY(Value, Day, Month, Year);
  //
  Cells[0, 0]:= IntToStr(Day);
  Cells[2, 0]:= IntToStr(Month);
  Cells[4, 0]:= IntToStr(Year);
  //
  Refresh;
end;

function THijriDateEdit.GetDateText: String;
begin
  Result:= Format('%s/%s/%s', [Cells[0, 0], Cells[2, 0], Cells[4, 0]]);
end;

{ THijriDBDateEdit }
constructor THijriDBDateEdit.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FReadOnly:= False;
  FDataLink:= TFieldDataLink.Create;
  FDataLink.OnDataChange:= DataChange;
  FDataLink.OnUpdateData:= UpdateData;
end;

destructor THijriDBDateEdit.Destroy;
begin
  FDataLink.OnDataChange:= nil;
  FDataLink.OnUpdateData:= nil;
  FDataLink.Free;
  inherited Destroy;
end;

function THijriDBDateEdit.SelectCell(ACol, ARow: Longint): Boolean;
begin
 if FReadOnly then
   Result:= False
 else
   Result:= inherited SelectCell(ACol, ARow);
end;

procedure THijriDBDateEdit.Change;
begin
  if (goEditing in Options) and not(FReadOnly) then
  begin
    FDataLink.Edit;
    FDataLink.Modified;
  end;
  //
  inherited Change;
end;

function THijriDBDateEdit.GetDataField: string;
begin
  Result:= FDataLink.FieldName;
end;

function THijriDBDateEdit.GetDataSource: TDataSource;
begin
  Result:= FDataLink.DataSource;
end;

procedure THijriDBDateEdit.SetDataField(const Value: string);
begin
  FDataLink.FieldName:= Value;
end;

procedure THijriDBDateEdit.SetDataSource(Value: TDataSource);
begin
  FDataLink.DataSource:= Value;
end;

procedure THijriDBDateEdit.DataChange(Sender: TObject);
begin
 if FDataLink.Field= nil then
   DateText:= ''
 else
   DateText:= GregToHijri(FDataLink.Field.AsDateTime);
end;

procedure THijriDBDateEdit.UpdateData(Sender: TObject);
begin
  FDataLink.Field.AsDateTime:= HijriToGreg(DateText);
end;

procedure THijriDBDateEdit.CMExit(var Message: TWMNoParams);
begin
  try
    FDataLink.UpdateRecord;
  except
    on Exception do SetFocus;
  end;
  //
  inherited;
end;

procedure Register;
begin
  RegisterComponents('Adeeb', [THijriDateEdit, THijriDBDateEdit]);
end;

end.
0
 
MotazCommented:
Do not use StrToDateTime or EncodeDate with higri date, instead you have to write your own functions that convert higri calendar to gregorian date.

If you want to use this dates without any calculation, for example you want only to display it, you can use string data type instead of TDateTime or time staps, and so on.

Motaz

http://homepages.go.com/~azzoz/azzoz.html
0
 
men xinCEOCommented:
I use this code,no problem.

var a,b:tdate;

a:=EncodeDate(1420,12,12);
b:=a-1;


menxin
0
 
abualiAuthor Commented:
Adjusted points to 150
0
 
MotazCommented:
Hi Abu Ali how are you, did you solve your problem, if not, please give me more details about your application which you want it to use hijri dates.

Motaz
0
All Courses

From novice to tech pro — start learning today.