Hijri date

function Floor(const X: Single): Integer;
begin
  Result := Trunc(X);
  if Frac(X) < 0 then
    Dec(Result);
end;
  
function Ceil(const X: Single): Integer;
begin
  Result := Trunc(X);
  if Frac(X) > 0 then
    Inc(Result);
end;
  
function IntPart(Num : real) : integer;
begin 
  if Num < -0.0000001 then 
     Result := Ceil(Num - 0.0000001) 
  else 
  Result := Floor(Num + 0.0000001); 
end; 

 

function Gre2Hijri(var D, M, Y : word): string; 
var 
jd, l, n, j : integer; 
begin 
  if ((Y > 1582) or ((Y = 582) and (M > 10)) or ((Y = 1582) and (M = 10) and (D>14))) then 
  begin 
    jd := IntPart((1461 * (Y + 4800 + IntPart((M - 14)/12)))/4) + IntPart((367 * (M - 2 - 12 * (IntPart((M - 14)/12))))/12) - IntPart((3 * (IntPart((Y + 4900 + IntPart((M - 14)/12))/100)))/4) + D - 32075; 
  end 
  else 
  begin 
    jd := 367 * Y - IntPart((7 * (Y + 5001 + IntPart((M - 9)/7)))/4) + IntPart((275 * M)/9) + D + 1729777; 
  end; 

  l := jd -1948440 + 10632; 
  n := IntPart((l - 1)/10631); 
  l := l - 10631 * n + 354; 

  j := (IntPart((10985 - l)/5316)) * (IntPart((50 * l)/17719)) + (IntPart(l/5670)) * (IntPart((43 * l)/15238)); 

  l := l - (IntPart((30 - j)/15)) * (IntPart((17719 * j)/50)) - (IntPart(j/16)) * (IntPart((15238 * j)/43)) + 29; 

  m := IntPart((24 * l)/709); 
  d := l - IntPart((709 * m)/24); 
  y := 30 * n + j - 30; 

  Result := IntToStr(d)+'/'+IntToStr(m)+'/'+IntToStr(y);                                                                                                                        
end;   

procedure lbDateOnAfterData(Sender: TfrxComponent);
var
       D, M, Y: word;
       dt: TDateTime;                                      
begin
       if ValidFloat(TfrxMemoView(Sender).Value) then
       begin                   
               dt := StrToFloat(lbDate.Value);                                                       
               DecodeDate(dt, Y, M, D);
               TfrxMemoView(Sender).Text := Gre2Hijri(D, M,Y);                                      
       end;                 
end;

begin

end.