用delphi写 阴历转阳历的函数

Question

用delphi如何写 阴历转阳历的函数，（注意：不是阳历转阴历），请给个实例，谢谢

Answer 1

先给一个BCB的，要改成DELPHI不难（有时间可帮你改一下）
数据网上的，可能有错
农历只能从1921-1-1 到 2020-1-29
其中r/nr：  ＝＝1 闰月 ＝＝0 一般bool i_c(int y,int m,int d,int &ny,int &nm,int &nd,int &r)    //公转农
{const int md[12] = {0,31,59,90,120,151,181,212,243,273,304,334};const int td[100] = {2635,333387,1701,1748,267701,694,2391,133423,1175,396438
,3402,3749,331177,1453,694,201326,2350,465197,3221,3402
,400202,2901,1386,267611,605,2349,137515,2709,464533,1738
,2901,330421,1242,2651,199255,1323,529706,3733,1706,398762
,2741,1206,267438,2647,1318,204070,3477,461653,1386,2413
,330077,1197,2637,268877,3365,531109,2900,2922,398042,2395
,1179,267415,2635,661067,1701,1748,398772,2742,2391,330031
,1175,1611,200010,3749,527717,1452,2742,332397,2350,3222
,268949,3402,3493,133973,1386,464219,605,2349,334123,2709
,2890,267946,2773,592565,1210,2651,395863,1323,2707,265877};
  int ds;  ds = (y - 1921) * 365 + (y - 1921) / 4 + d + md[m - 1] - 38;
  if ((ds<0) || (ds>47079))
  {
    //无法转
    return false;
  }
  if((!(y % 4)) && (m > 2))
    ds++;
  int i,j,k,n,nb;
  i=j=0;//     Memo2->Lines->Add(ds);
  while(i != 1)
  {
    if(td[j] < 4095)
k = 11;
else
     k = 12;
    n = k;
    while(n>=0)
    {
nb = td[j];
        nb>>=n;
        nb&=1;
        if (ds <= (29 + nb))
{
  i = 1;
  break;
}
        ds = ds - 29 - nb;
//        Memo2->Lines->Add(ds);
        n--;
    }
    if(i)
        break;
    j++;;
   }
   ny = 1921 + j;
   nm = k - n + 1;
   nd = ds;
   if ( nd < 0 )
   {
    //无法转
     return false;
    }
   if (k == 12)
    {
     if (nm == td[j] / 65536 + 1)
           nm = 1 - nm;
           else if (nm > td[m] / 65536 + 1)
       nm--;
}   if (nm< 1)
   {
     nm=-nm;
     r=1;
  }
    r=0;  return true;}bool c_i (int ny,int nm,int nd,int nr,int &y,int &m,int &d)   //农转公
{
   TDateTime t;
   int ty,tm,td,tr;
   t= TDateTime(ny,nm,nd);   for(int i=0;i<100;i++)
   {
      y=YearOf(t);
      m=MonthOf(t);
      d=DayOf(t);
      if  (!i_c(y,m,d,ty,tm,td,tr))          return false;  //不能转
      if ((ty==ny) && (tm==nm) && (td==nd) && (tr==nr))
          return true;
      t++;
 //     String x;
 //     x.printf("%d-%d-%d",y,m,d);
  //    Form1->Memo1->Lines->Add(x);
  }
   return false;
}

Answer 2

//delphi的
unit dateconv;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementation
uses dateutils;
{$R *.dfm}
function i_c(y:integer;m:integer;d:integer;var ny:integer;var nm:integer;var nd:integer;var r:integer):bool;    //公转农
const  md:array  [0..11] of integer= (0,31,59,90,120,151,181,212,243,273,304,334);
const td :array [0..99] of integer = (2635,333387,1701,1748,267701,694,2391,133423,1175,396438
,3402,3749,331177,1453,694,201326,2350,465197,3221,3402
,400202,2901,1386,267611,605,2349,137515,2709,464533,1738
,2901,330421,1242,2651,199255,1323,529706,3733,1706,398762
,2741,1206,267438,2647,1318,204070,3477,461653,1386,2413
,330077,1197,2637,268877,3365,531109,2900,2922,398042,2395
,1179,267415,2635,661067,1701,1748,398772,2742,2391,330031
,1175,1611,200010,3749,527717,1452,2742,332397,2350,3222
,268949,3402,3493,133973,1386,464219,605,2349,334123,2709
,2890,267946,2773,592565,1210,2651,395863,1323,2707,265877);
var
  ds:integer;
  i,j,k,n,nb:integer;
begin
  ds := (y - 1921) * 365 + (y - 1921) div 4 + d + md[m - 1] - 38;
  if ((ds <0) or (ds>47079)) then
  begin
    //无法转
    result:=false;
    exit;
  end;
  if((not (y mod 4<>0)) and (m > 2)) then
    inc(ds);
  i:=0;
  j:=0;
  while(i <> 1) do
  begin
    if(td[j] < 4095) then
      k := 11
      else
         k := 12;
    n := k;
    while(n>=0) do
    begin
       nb:= td[j];
       nb :=nb shr n;
       nb:=nb and 1;
      if (ds <= (29 + nb)) then
      begin
          i := 1;
          break;
      end;
      ds := ds - 29 - nb;
      dec(n);
    end;
    if(i<>0) then
      break;
    inc(j);
  end;
  ny := 1921 + j;
  nm := k - n + 1;
  nd := ds;
  if ( nd < 0 ) then
  begin
    //无法转
    result:= false;
    exit;
  end;
  if (k = 12) then
  begin
    if (nm = td[j] div 65536 + 1) then
          nm := 1 - nm
          else if (nm > td[m] div 65536 + 1) then
               dec(nm);
  end;  if (nm < 1) then
  begin
    nm:=-nm;
    r:=1;
  end;
  r:=0;
  result:=true;
  end;function c_i (ny:integer;nm:integer;nd:integer;nr:integer;var y:integer;var m:integer;var d:integer):bool;  //农转公
var
  t:TDateTime;
  i,ty,tm,td,tr:integer;
begin
  t:= EncodeDate(ny,nm,nd);  for   i:=0 to 100 do
  begin
      y:=YearOf(t);
      m:=MonthOf(t);
      d:=DayOf(t);
      if  (not i_c(y,m,d,ty,tm,td,tr)) then
      begin
          result:=false;
          exit;  //不能转
      end;
      if ((ty=ny) and (tm=nm) and (td=nd) and (tr=nr)) then
      begin
          result:= true;
          exit;
      end;
      t:=t+1;
  end;
  result:= false;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
  y,m,d,r:integer;
begin
   if i_c(2010,1,25,y,m,d,r) then   //求2010年1月25日的阴历
      Edit1.Text:=Format('%d-%d-%d',[y,m,d]) ;  //结果为2010－12－11
   if c_i(2010,1,1,0,y,m,d) then   //求2010年正月初一的公历
      Edit2.Text:=Format('%d-%d-%d',[y,m,d])  ;  //结果为2010－2－14
end;end.

Answer 3

饭桶大哥的控件，你用了没？CNPACK里有一个单元，专门做日历处理的，