小妹求救:高分或现金买公历转农历的DELPHI源代码

在delphiboy.com上有Delphi的源代码

可以实现
unit CNYear; interface
uses sysutils;
type TCNDate = Cardinal;
function DecodeGregToCNDate(dtGreg:TDateTime):TCNDate;
function GetGregDateFromCN(cnYear,cnMonth,cnDay:word;bLeap:Boolean=False):TDateTime;
function GregDateToCNStr(dtGreg:TDateTime):String;
function isCNLeap(cnDate:TCNDate):boolean;
implementation
const cstDateOrg:Integer=32900; //公历1990-01-27的TDateTime表示对应农历1990-01-01
const cstCNYearOrg=1990;
const cstCNTable:array[cstCNYearOrg..cstCNYearOrg + 60] of WORD=(       //   unsigned 16-bit
24402, 3730, 3366, 13614, 2647, 35542, 858, 1749,           //1997
23401, 1865, 1683, 19099, 1323, 2651, 10926, 1386,           //2005
32213, 2980, 2889, 23891, 2709, 1325, 17757, 2741,           //2013
39850, 1490, 3493, 61098, 3402, 3221, 19102, 1366,           //2021
2773, 10970, 1746, 26469, 1829, 1611, 22103, 3243,           //2029
1370, 13678, 2902, 48978, 2898, 2853, 60715, 2635,           //2037
1195, 21179, 1453, 2922, 11690, 3474, 32421, 3365,           //2045
2645, 55901, 1206, 1461, 14038);                                                       //2050
//建表方法：
// 0101 111101010010     高四位是闰月位置,后12位表示大小月,大月30天,小月29天,
//闰月一般算小月,但是有三个特例2017/06,2036/06,2047/05
//对于特例则高四位的闰月位置表示法中的最高为设置为1 特殊处理用wLeapNormal变量
// //2017/06 28330->61098 2036/06 27947->60715 2047/05 23133->55901 //如果希望用汇编,这里有一条信息:农历不会滞后公历2个月.
//将公历转换为农历
//返回:12位年份+4位月份+5位日期
function DecodeGregToCNDate(dtGreg:TDateTime):TCNDate;
var
  iDayLeave:Integer;
  wYear,wMonth,wDay:WORD;
  i,j:integer;
  wBigSmallDist,wLeap,wCount,wLeapShift:WORD;
label OK;
begin
  result := 0;
  iDayLeave := Trunc(dtGreg) - cstDateOrg;
  DecodeDate(IncMonth(dtGreg,-1),wYear,wMonth,wDay);
  if (iDayLeave < 0) or (iDayLeave > 22295 )then Exit;
              //Raise Exception.Create('目前只能算1990-01-27以后的');
              //Raise Exception.Create('目前只能算2051-02-11以前的');
  for i:=Low(cstCNTable)   to High(cstCNTable) do begin
      wBigSmallDist := cstCNTable[i];
      wLeap := wBigSmallDist shr 12;
      if wLeap > 12 then begin
          wLeap := wLeap and 7;
          wLeapShift := 1;
      end else
          wLeapShift := 0;
      for j:=1 to 12 do begin
          wCount:=(wBigSmallDist and 1) + 29;
          if j=wLeap then wCount := wCount - wLeapShift;
          if iDayLeave < wCount   then begin
              Result := (i shl 9) + (j shl 5) + iDayLeave + 1;
              Exit;
          end;
          iDayLeave := iDayLeave - wCount;
          if j=wLeap then begin
              wCount:=29 + wLeapShift;
              if iDayLeave < wCount   then begin
                  Result := (i shl 9) + (j shl 5) + iDayLeave + 1 + (1 shl 21);
                  Exit;
              end;
              iDayLeave := iDayLeave - wCount;
          end;
          wBigSmallDist := wBigSmallDist shr 1;
      end;
  end;
//返回值:
// 1位闰月标志 + 12位年份+4位月份+5位日期             (共22位)
end;
function isCNLeap(cnDate:TCNDate):boolean;
begin
  result := (cnDate and $200000) <> 0;
end;
function GetGregDateFromCN(cnYear,cnMonth,cnDay:word;bLeap:Boolean=False):TDateTime;
var
  i,j:integer;
  DayCount:integer;
  wBigSmallDist,wLeap,wLeapShift:WORD;
begin
  // 0101 010010101111     高四位是闰月位置,后12位表示大小月,大月30天,小月29天,
  DayCount := 0;
  if (cnYear < 1990) or (cnYear >2050) then begin
      Result := 0;
      Exit;
  end;
  for i:= cstCNYearOrg to cnYear-1 do begin
        wBigSmallDist := cstCNTable[i];
        if (wBIgSmallDist and $F000) <> 0 then DayCount := DayCount + 29;
        DayCount := DayCount + 12 * 29;
        for j:= 1 to 12 do begin
            DayCount := DayCount + wBigSmallDist and 1;
            wBigSmallDist := wBigSmallDist shr 1;
        end;
  end;
  wBigSmallDist := cstCNTable[cnYear];
  wLeap := wBigSmallDist shr 12;
  if wLeap > 12 then begin
      wLeap := wLeap and 7;
      wLeapShift := 1;                       //大月在闰月.
  end else
      wLeapShift := 0;
  for j:= 1 to cnMonth-1 do begin
      DayCount:=DayCount + (wBigSmallDist and 1) + 29;
      if j=wLeap then DayCount := DayCount + 29;
      wBigSmallDist := wBigSmallDist shr 1;
  end;
  if bLeap and (cnMonth = wLeap)   then   //是要闰月的吗?
      DayCount := DayCount + 30 - wLeapShift;
  result := cstDateOrg + DayCount + cnDay - 1;
end; //将日期显示成农历字符串.
function GregDateToCNStr(dtGreg:TDateTime):String;
const hzNumber:array[0..10] of string=('零','一','二','三','四','五','六','七','八','九','十');
function ConvertYMD(Number:Word;YMD:Word):string;
var
  wTmp:word;
begin
  result := '';
  if YMD = 1 then begin //年份
      while Number > 0 do begin
          result := hzNumber[Number Mod 10] + result;
          Number := Number DIV 10;
      end;
      Exit;
  end;
  if Number<=10 then begin   //可只用1位
      if YMD = 2 then //月份
          result := hzNumber[Number]
      else                       //天
          result := '初' + hzNumber[Number];
      Exit;
  end;
  wTmp := Number Mod 10;   //个位
  if wTmp <> 0 then result := hzNumber[wTmp];
  wTmp := Number Div 10;           //十位
  result:='十'+result;
  if wTmp > 1 then   result := hzNumber[wTmp] + result;
end;
var
  cnYear,cnMonth,cnDay:word;
  cnDate:TCNDate;
  strLeap:string;
begin
  cnDate:= DecodeGregToCNDate(dtGreg);
  if cnDate = 0 then begin
      result := '输入越界';
      Exit;
  end;
  cnDay := cnDate and $1F;
  cnMonth := (cnDate shr 5) and $F;
  cnYear := (cnDate shr 9) and $FFF;
  //测试第22位,为1表示闰月
  if isCNLeap(cnDate) then strLeap:='(闰)' else   strLeap := '';
  result := '农历' + ConvertYMD(cnYear,1) + '年' + ConvertYMD(cnMonth,2) + '月'
                + strLeap + ConvertYMD(cnDay,3) ;
end;
end. 你用以下进行测试
procedure TForm1.Button1Click(Sender: TObject);
var
  dtGreg : TDateTime;
begin
  dtGreg := strtodatetime('1997-01-08');
  edit2.Text := GregDateToCNStr(dtGreg);
end;

Delphi开发者资源交流社区里有：http://www.developres.com

去Delphi开发室
http://www.zg169.net/~randolph/cncalc.zipCnCalcdar（带源码）一个能显示农历的日历元件，有效时间区间为1901年至2050年，农历数据来源于UCDOS
6.0中UCT.COM，共600字节。附赠一个UCDOS下打印带农历的日历的程序及其C++源码。32bit深度历险也有一个:
http://vcl.vclxx.com
全部免费控件->中文环境
REXCAL.ZIP 国历与农历合而为一的月历，并提供农历与西洋历的转换单元.

控件：文件一：
unit DateCn;interfaceuses Windows, SysUtils, Controls;const
  //农历月份数据，每年4字节，从1901年开始，共150年
  //数据来源：UCDOS 6.0 UCT.COM
  //分析整理：Copyright (c) 1996-1998, Randolph
  //数据解析：
  //如果第一字节的bit7为1，则该年1月1日位于农历12月，否则位于11月
  //第一字节去除bit7为该年1月1日的农历日期
  //         第二字节                 第三字节
  //bit:     7  6  5  4  3  2  1  0   7  6  5  4  3  2  1  0
  //农历月份:16 15 14 13 12 11 10 9   8  7  6  5  4  3  2  1
  //农历月份指的是从该年1月1日的农历月份算起的顺序号
  //农历月份对应的bit为1则该月为30日，否则为29日
  //第四字节为闰月月份
  CnData: array[0..599] of Byte = (
    $0b,$52,$ba,$00,$16,$a9,$5d,$00,$83,$a9,$37,$05,$0e,$74,$9b,$00,
    $1a,$b6,$55,$00,$87,$b5,$55,$04,$11,$55,$aa,$00,$1c,$a6,$b5,$00,
    $8a,$a5,$75,$02,$14,$52,$ba,$00,$81,$52,$6e,$06,$0d,$e9,$37,$00,
    $18,$74,$97,$00,$86,$ea,$96,$05,$10,$6d,$55,$00,$1a,$35,$aa,$00,
    $88,$4b,$6a,$02,$13,$a5,$6d,$00,$1e,$d2,$6e,$07,$0b,$d2,$5e,$00,
    $17,$e9,$2e,$00,$84,$d9,$2d,$05,$0f,$da,$95,$00,$19,$5b,$52,$00,
    $87,$56,$d4,$04,$11,$4a,$da,$00,$1c,$a5,$5d,$00,$89,$a4,$bd,$02,
    $15,$d2,$5d,$00,$82,$b2,$5b,$06,$0d,$b5,$2b,$00,$18,$ba,$95,$00,
    $86,$b6,$a5,$05,$10,$56,$b4,$00,$1a,$4a,$da,$00,$87,$49,$ba,$03,
    $13,$a4,$bb,$00,$1e,$b2,$5b,$07,$0b,$72,$57,$00,$16,$75,$2b,$00,
    $84,$6d,$2a,$06,$0f,$ad,$55,$00,$19,$55,$aa,$00,$86,$55,$6c,$04,
    $12,$c9,$76,$00,$1c,$64,$b7,$00,$8a,$e4,$ae,$02,$15,$ea,$56,$00,
    $83,$da,$55,$07,$0d,$5b,$2a,$00,$18,$ad,$55,$00,$85,$aa,$d5,$05,
    $10,$53,$6a,$00,$1b,$a9,$6d,$00,$88,$a9,$5d,$03,$13,$d4,$ae,$00,
    $81,$d4,$ab,$08,$0c,$ba,$55,$00,$16,$5a,$aa,$00,$83,$56,$aa,$06,
    $0f,$aa,$d5,$00,$19,$52,$da,$00,$86,$52,$ba,$04,$11,$a9,$5d,$00,
    $1d,$d4,$9b,$00,$8a,$74,$9b,$03,$15,$b6,$55,$00,$82,$ad,$55,$07,
    $0d,$55,$aa,$00,$18,$a5,$b5,$00,$85,$a5,$75,$05,$0f,$52,$b6,$00,
    $1b,$69,$37,$00,$89,$e9,$37,$04,$13,$74,$97,$00,$81,$ea,$96,$08,
    $0c,$6d,$52,$00,$16,$2d,$aa,$00,$83,$4b,$6a,$06,$0e,$a5,$6d,$00,
    $1a,$d2,$6e,$00,$87,$d2,$5e,$04,$12,$e9,$2e,$00,$1d,$ec,$96,$0a,
    $0b,$da,$95,$00,$15,$5b,$52,$00,$82,$56,$d2,$06,$0c,$2a,$da,$00,
    $18,$a4,$dd,$00,$85,$a4,$bd,$05,$10,$d2,$5d,$00,$1b,$d9,$2d,$00,
    $89,$b5,$2b,$03,$14,$ba,$95,$00,$81,$b5,$95,$08,$0b,$56,$b2,$00,
    $16,$2a,$da,$00,$83,$49,$b6,$05,$0e,$64,$bb,$00,$19,$b2,$5b,$00,
    $87,$6a,$57,$04,$12,$75,$2b,$00,$1d,$b6,$95,$00,$8a,$ad,$55,$02,
    $15,$55,$aa,$00,$82,$55,$6c,$07,$0d,$c9,$76,$00,$17,$64,$b7,$00,
    $86,$e4,$ae,$05,$11,$ea,$56,$00,$1b,$6d,$2a,$00,$88,$5a,$aa,$04,
    $14,$ad,$55,$00,$81,$aa,$d5,$09,$0b,$52,$ea,$00,$16,$a9,$6d,$00,
    $84,$a9,$5d,$06,$0f,$d4,$ae,$00,$1a,$ea,$4d,$00,$87,$ba,$55,$04,
    $12,$5a,$aa,$00,$1d,$ab,$55,$00,$8a,$a6,$d5,$02,$14,$52,$da,$00,
    $82,$52,$ba,$06,$0d,$a9,$3b,$00,$18,$b4,$9b,$00,$85,$74,$9b,$05,
    $11,$b5,$4d,$00,$1c,$d6,$a9,$00,$88,$35,$aa,$03,$13,$a5,$b5,$00,
    $81,$a5,$75,$0b,$0b,$52,$b6,$00,$16,$69,$37,$00,$84,$e9,$2f,$06,
    $10,$f4,$97,$00,$1a,$75,$4b,$00,$87,$6d,$52,$05,$11,$2d,$69,$00,
    $1d,$95,$b5,$00,$8a,$a5,$6d,$02,$15,$d2,$6e,$00,$82,$d2,$5e,$07,
    $0e,$e9,$2e,$00,$19,$ea,$96,$00,$86,$da,$95,$05,$10,$5b,$4a,$00,
    $1c,$ab,$69,$00,$88,$2a,$d8,$03);  function CnMonthOfDate(Date: TDate): String;//指定日期的农历月
  function CnDayOfDate(Date: TDate): String;//指定日期的农历日
  function CnDateOfDateStr(Date: TDate): String;//指定日期的农历日期implementation//日期是该年的第几天，1月1日为第一天
function DaysNumberOfDate(Date: TDate): Integer;
var
  DaysNumber: Integer;
  I: Integer;
  yyyy, mm, dd: Word;
begin
  DecodeDate(Date, yyyy, mm, dd);
  DaysNumber := 0;
  for I := 1 to mm - 1 do
    Inc(DaysNumber, MonthDays[IsLeapYear(yyyy), I]);
  Inc(DaysNumber, dd);
  Result := DaysNumber;
end;//日期的农历日期，返回农历格式：月份*100 + 日，负数为闰月
//超出范围则返回0
function CnDateOfDate(Date: TDate): Integer;
var
  CnMonth, CnMonthDays: array[0..15] of Integer;
  CnBeginDay, LeapMonth: Integer;
  yyyy, mm, dd: Word;
  Bytes: array[0..3] of Byte;
  I: Integer;
  CnMonthData: Word;
  DaysCount, CnDaysCount, ResultMonth, ResultDay: Integer;
begin
  DecodeDate(Date, yyyy, mm, dd);
  if (yyyy < 1901) or (yyyy > 2050) then
  begin
    Result := 0;
    Exit;
  end;
  Bytes[0] := CnData[(yyyy - 1901) * 4];
  Bytes[1] := CnData[(yyyy - 1901) * 4 + 1];
  Bytes[2] := CnData[(yyyy - 1901) * 4 + 2];
  Bytes[3] := CnData[(yyyy - 1901) * 4 + 3];
  if (Bytes[0] and $80) <> 0 then CnMonth[0] := 12
  else CnMonth[0] := 11;
  CnBeginDay := (Bytes[0] and $7f);
  CnMonthData := Bytes[1];
  CnMonthData := CnMonthData shl 8;
  CnMonthData := CnMonthData or Bytes[2];
  LeapMonth := Bytes[3];  for I := 15 downto 0 do
  begin
    CnMonthDays[15 - I] := 29;
    if ((1 shl I) and CnMonthData) <> 0 then
      Inc(CnMonthDays[15 - I]);
    if CnMonth[15 - I] = LeapMonth then
      CnMonth[15 - I + 1] := - LeapMonth
    else
    begin
      if CnMonth[15 - I] < 0 then //上月为闰月
        CnMonth[15 - I + 1] := - CnMonth[15 - I] + 1
      else CnMonth[15 - I + 1] := CnMonth[15 - I] + 1;
      if CnMonth[15 - I + 1] > 12 then CnMonth[15 - I + 1] := 1;
    end;
  end;  DaysCount := DaysNumberOfDate(Date) - 1;
  if DaysCount <= (CnMonthDays[0] - CnBeginDay) then
  begin
    if (yyyy > 1901) and
      (CnDateOfDate(EncodeDate(yyyy - 1, 12, 31)) < 0) then
      ResultMonth := - CnMonth[0]
    else ResultMonth := CnMonth[0];
    ResultDay := CnBeginDay + DaysCount;
  end
  else
  begin
    CnDaysCount := CnMonthDays[0] - CnBeginDay;
    I := 1;
    while (CnDaysCount < DaysCount) and
      (CnDaysCount + CnMonthDays[I] < DaysCount) do
    begin
      Inc(CnDaysCount, CnMonthDays[I]);
      Inc(I);
    end;
    ResultMonth := CnMonth[I];
    ResultDay := DaysCount - CnDaysCount;
  end;
  if ResultMonth > 0 then
    Result := ResultMonth * 100 + ResultDay
  else Result := ResultMonth * 100 - ResultDay
end;function CnMonthOfDate(Date: TDate): String;
const
  CnMonthStr: array[1..12] of String = (
    '一', '二', '三', '四', '五', '六', '七', '八', '九', '十',
    '冬', '蜡');
var
  Month: Integer;
begin
  Month := CnDateOfDate(Date) div 100;
  if Month < 0 then Result := '闰' + CnMonthStr[-Month]
  else Result := CnMonthStr[Month] + '月';
end;function CnDayOfDate(Date: TDate): String;
const
  CnDayStr: array[1..30] of String = (
    '初一', '初二', '初三', '初四', '初五',
    '初六', '初七', '初八', '初九', '初十',
    '十一', '十二', '十三', '十四', '十五',
    '十六', '十七', '十八', '十九', '二十',
    '廿一', '廿二', '廿三', '廿四', '廿五',
    '廿六', '廿七', '廿八', '廿九', '三十');
var
  Day: Integer;
begin
  Day := Abs(CnDateOfDate(Date)) mod 100;
  Result := CnDayStr[Day];
end;function CnDateOfDateStr(Date: TDate): String;
begin
  Result := CnMonthOfDate(Date) + CnDayOfDate(Date);
end;end.

文件二：
unit CnCalendar;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Grids, Calendar;type
  TCnCalendar = class(TCalendar)
  private
    { Private declarations }
  protected
    { Protected declarations }
    procedure DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState); override;
  public
    { Public declarations }
  published
    { Published declarations }
  end;  procedure Register;implementationuses DateCn;procedure TCnCalendar.DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState);
var
  TheText: string;
  TheDate: TDate;
begin
  TheText := CellText[ACol, ARow];
  if (TheText <> '') and (ARow > 0) and
    (Year >= 1901) and (Year <= 2050) then
  begin
    TheDate := EncodeDate(Year, Month, StrToInt(TheText));
    if CnDayOfDate(TheDate) = '初一' then
      TheText := TheText + CnMonthOfDate (TheDate)
    else TheText := TheText + CnDayOfDate (TheDate);
  end;
  with ARect, Canvas do
    TextRect(ARect, Left + (Right - Left - TextWidth(TheText)) div 2,
      Top + (Bottom - Top - TextHeight(TheText)) div 2, TheText);
end;procedure Register;
begin
  RegisterComponents('Randolph', [TCnCalendar]);
end;end.

发到你的信箱中，自己看。有详细说明，Delphi 6项目文件，编译好的可执行文件。

oracle_lover(数据库情人) :你好。只有你真正看懂了我的说明。而且做得全对，我真的感谢你.你在我的邮箱里说不要钱，那好吧，那我就把分数给你可惜这张贴只有20分。如果你觉得分数少了点，我可以再想办法。
我还是要感谢楼上所有的朋友给我的支持，虽然他们尽力了，可惜小妹刚学DELPHI，还看不懂。所以小妹不能给分了，加之分数太小，实在对不起啦。只能说声谢谢了。

调试易

小妹求救:高分或现金买公历转农历的DELPHI源代码

解决方案 »