Delphi 生日提醒的方法《LceMeaning》

以下代码经本人在Delphi XE2 下编写并通过。

procedure TForm55.btnLoadClick(Sender: TObject);
var
  StartDate,EndDate,MBDate : TDate;
  NowYear,MBMonth,MBDay,I : Integer;
  sql : string;
begin
  SysconfigRun;
  IsStart := Sysconfig.ReadBool('RemindContent','MemberBirthday',True);
  RVar := Sysconfig.ReadString('RemindContent','BirthdayCondition','1');
  Sysconfig.Destroy;
  if IsStart then
    begin
      EndDate := IncDay(StrToDate(CNYear.GregDateToCNStr(Now)),StrToInt(RVar));
      StartDate := StrToDate(CNYear.GregDateToCNStr(Now));
      qryQuery.Close;
      qryQuery.Open;
      if qryQuery.RecordCount > 0 then
        for I := 1 to qryQuery.RecordCount do
          begin
            MBDate := qryQuery.FieldByName('Birthday1').AsDateTime;
            NowYear := YearOf(Now);
            MBMonth := MonthOf(MBDate);
            MBDay := DayOf(MBDate);
            MBDate := StrToDate(IntToStr(NowYear)+'/'+IntToStr(MBMonth)+'/'+IntToStr(MBDay));
            if (MBDate >= StartDate) and (MBDate <= EndDate) then
              begin
                sql := 'insert into MemberBirthdayReminder(CardsName1,CName1,Levels,CardsType1,sex1,Birthday1,TEL1,Email1,Add1,ActivationDate1,Validity1) values('''
                    +qryQuery.FieldByName('CardsName1').AsString
                    +''','''+qryQuery.FieldByName('CName1').AsString
                    +''','''+qryQuery.FieldByName('Levels').AsString
                    +''','''+qryQuery.FieldByName('CardsType1').AsString
                    +''','''+qryQuery.FieldByName('sex1').AsString
                    +''','''+qryQuery.FieldByName('Birthday1').AsString
                    +''','''+qryQuery.FieldByName('TEL1').AsString
                    +''','''+qryQuery.FieldByName('Email1').AsString
                    +''','''+qryQuery.FieldByName('Add1').AsString
                    +''','''+qryQuery.FieldByName('ActivationDate1').AsString
                    +''','''+qryQuery.FieldByName('Validity1').AsString
                    +''')';
                qryIn.Close;
                qryIn.SQL.Clear;
                qryIn.SQL.Add(sql);
                qryIn.ExecSQL;
              end;
            qryQuery.Next;
          end;
    end;
end;

unit CNYearP;

interface

uses sysutils,System.DateUtils;

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=('0','1','2','3','4','5','6','7','8','9','10');
  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;
    result := IntToStr(Number);
  //  wTmp := Number Mod 10;   //个位
  //  if wTmp <> 0 then
  //    result := hzNumber[wTmp];

  //  wTmp := Number Div 10;           //十位
  //  result:='1'+result;
  //  if wTmp > 1 then
  //    result := hzNumber[wTmp] + result;
  end;
var 
  cnYear,cnMonth,cnDay:word; 
  cnDate:TCNDate; 
  strLeap:string;
  varMonth : 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.