轉貼萬年曆 <原始碼> { $HDR$} {**********************************************************************} { Unit archived using Team Coherence } { Team Coherence is Copyright 2001 by Quality Software Components } { } { For further information / comments, visit our WEB site at } { http://www.TeamCoherence.com } {**********************************************************************} {} { $Log: 10065: CAL.pas { { Rev 1.0 2001/12/24 下午 05:53:06 levi Version: 2.0.0.0 } { { Rev 1.0 2001/12/24 下午 05:53:06 levi { 為函數集 為改版後目前為1.2.0.1 } {* =================================Blue Fox================================= *} {* 單 元 名 稱：cal {* 建 檔 日 期：2001/1/24 {* 檔 案 製 作：彭宏傑 {* =================================Blue Fox================================= *} {* 附 屬 檔 案： {* 說 明&用 途：取得或轉換國曆與農曆合而為一之月曆 {* {* 參 考 資 料： {* {* 更 新 說 明： {* {* =================================Blue Fox================================= *} {* 不要覺得註解長，註解是給以後的你或別人看的，請保持註解的完整性 *} {* =======================================================================2.0 *} {* 注解說明： *} {* 1. 在程式敘述中加入注解 格式為 *} {* // @ 程式師, 修改日期,工作模式, 修改描述 *} {* 例如 // @levi,01/12/21,Add,取得日期。 *} {* 而工作模式有 Add,A 為新增敘述 ; *} {* Edit,E 為修改舊有敘述; *} {* Make,M 為刪除但不能將敘述刪除而是改變為注解; *} {* O 為其它不在上面的模式; *} {* 2. 在宣告程序的後方必加入本程序的功能說明用 // 為注解符號。 *} {* ========================================================================== *} //以下為舊說明 { 國曆與農曆合而為一之月曆. (不用Delpi 3.0 中文應用組件) (範圍 : 民國一年至民國一百年) 新增 Property : LYear : 農曆之民國年份 LMonth : 農曆之月份(負數為閏月) LDay : 農曆之天數 LYearName : 農曆之六十甲子名稱(readonly) 作者: 彭宏傑 E-Mail : rexpeng@ms1.hinet.net 此版本為 FreeWare, 可自由散播, 但儘量保持其完整性, 如有Bug請E-Mail給我, 如您要更改也請E-Mail一份給我. OK! :) } unit cal; interface uses Classes, Controls, Messages, Windows, Forms, Graphics, StdCtrls, Grids, SysUtils, Lunar; type TDayOfWeek = 0..6; TRexCalendar = class(TCustomGrid) private FDate: TDateTime; FMonthOffset: Integer; FOnChange: TNotifyEvent; FReadOnly: Boolean; FStartOfWeek: TDayOfWeek; FUpdating: Boolean; FUseCurrentDate: Boolean; FLYear: integer; FLMonth: Integer; FLDay: Integer; FLYearName : String; function GetCellText(ACol, ARow: Integer): string; function GetDateElement(Index: Integer): Integer; procedure SetCalendarDate(Value: TDateTime); procedure SetDateElement(Index: Integer; Value: Integer); procedure SetStartOfWeek(Value: TDayOfWeek); procedure SetUseCurrentDate(Value: Boolean); procedure SetLDay(Value : Integer); function GetLDay: Integer; procedure SetLMonth(Value: Integer); function GetLMonth : Integer; procedure SetLYear(Value: Integer); function GetLYear : Integer; function StoreCalendarDate: Boolean; function GetLYearName : string; function GToL(y, m , d: integer) : string; protected procedure Change; dynamic; procedure ChangeMonth(Delta: Integer); procedure Click; override; function DaysPerMonth(AYear, AMonth: Integer): Integer; virtual; function DaysThisMonth: Integer; virtual; procedure DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState); override; function IsLeapYear(AYear: Integer): Boolean; virtual; function SelectCell(ACol, ARow: Longint): Boolean; override; procedure WMSize(var Message: TWMSize); message WM_SIZE; public constructor Create(AOwner: TComponent); override; property CalendarDate: TDateTime read FDate write SetCalendarDate stored StoreCalendarDate; property CellText[ACol, ARow: Integer]: string read GetCellText; procedure NextMonth; procedure NextYear; procedure PrevMonth; procedure PrevYear; procedure UpdateCalendar; virtual; published property Align; property BorderStyle; property Color; property Ctl3D; property Day: Integer index 3 read GetDateElement write SetDateElement stored False; property LDay: integer read GetLDay write SetLDay; property LYearName : string read GetLYearName; property Enabled; property Font; property GridLineWidth; property Month: Integer index 2 read GetDateElement write SetDateElement stored False; property LMonth: Integer read GetLMonth write SetLMonth; property ParentColor; property ParentFont; property ParentShowHint; property PopupMenu; property ReadOnly: Boolean read FReadOnly write FReadOnly default False; property ShowHint; property StartOfWeek: TDayOfWeek read FStartOfWeek write SetStartOfWeek; property TabOrder; property TabStop; property UseCurrentDate: Boolean read FUseCurrentDate write SetUseCurrentDate default True; property Visible; property Year: Integer index 1 read GetDateElement write SetDateElement stored False; property LYear: integer read GetLYear write SetLYear; property OnClick; property OnChange: TNotifyEvent read FOnChange write FOnChange; property OnDblClick; property OnDragDrop; property OnDragOver; property OnEndDrag; property OnEnter; property OnExit; property OnKeyDown; property OnKeyPress; property OnKeyUp; property OnStartDrag; end; procedure Register; implementation constructor TRexCalendar.Create(AOwner: TComponent); var AYear, AMonth, ADay : Word; //daterec : Tdaterec; begin inherited Create(AOwner); { defaults } FUseCurrentDate := True; FixedCols := 0; FixedRows := 1; ColCount := 7; RowCount := 7; ScrollBars := ssNone; Options := Options - [goRangeSelect] [goDrawFocusSelected]; Font.Name := '細明體'; Font.Size := 12; FDate := Date; decodedate(FDate, AYear, AMonth, ADay); {daterec.GregYear := AYear; daterec.wMonth := AMonth; daterec.wDay := ADay; if GregorianToLunarDate(@daterec) then begin FLYear := LunarYearName(daterec.LunarYear); FLMonth := daterec.wMonth; FLDay := daterec.wDay; end;} Solar2Lunar(AYear-1911, AMonth, ADay, FLYear, FLMonth, FLDay); UpdateCalendar; end; procedure TRexCalendar.Change; begin if Assigned(FOnChange) then FOnChange(Self); end; function CutStr(const str : string) : integer; var i : integer; begin for i := 1 to length(str) do if str[i] > #127 then break; result := i; end; procedure TRexCalendar.Click; var TheCellText: string; P: integer; begin inherited Click; TheCellText := CellText[Col, Row]; P := CutStr(TheCellText); TheCellText := Copy(TheCellText, 1, P-1); if TheCellText <> '' then Day := StrToInt(TheCellText); end; function TRexCalendar.IsLeapYear(AYear: Integer): Boolean; begin Result := (AYear mod 4 = 0) and ((AYear mod 100 <> 0) or (AYear mod 400 = 0)); end; function TRexCalendar.DaysPerMonth(AYear, AMonth: Integer): Integer; const DaysInMonth: array[1..12] of Integer = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31); begin Result := DaysInMonth[AMonth]; if (AMonth = 2) and IsLeapYear(AYear) then Inc(Result); { leap-year Feb is special } end; function TRexCalendar.DaysThisMonth: Integer; begin Result := DaysPerMonth(Year, Month); end; procedure TRexCalendar.DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState); var LText: string; TheText: string; P, fs : integer; cl : TColor; begin TheText := CellText[ACol, ARow]; if ARow <> 0 then begin P := CutStr(TheText); LText := copy(Thetext, P, Length(TheText)-P 1); TheText := Copy(TheText, 1, P-1); end; cl := Canvas.Font.Color; if ACol = ((7-FStartOfWeek) mod 7) then Canvas.Font.Color := clRed else Canvas.Font.Color := cl; with ARect, Canvas do begin if ARow = 0 then begin TextRect(ARect, Left (Right - Left - TextWidth(TheText)) div 2, Top (Bottom - Top - TextHeight(TheText)) div 2, TheText); end else begin fs := Font.Size; TextOut(Left 2, Top 2, TheText); Font.Size := fs div 2; TextOut(Right-TextWidth(LText)-2, Bottom-TextHeight(LText)-2, LText); Font.Size := fs; end; end; end; function TRexCalendar.GToL(y, m, d : integer): string; const LDayName : array[1..30] of string = ('初一', '初二', '初三', '初四', '初五', '初六', '初七', '初八', '初九', '初十', '十一', '十二', '十三', '十四', '十五', '十六', '十七', '十八', '十九', '二十', '廿一', '廿二', '廿三', '廿四', '廿五', '廿六', '廿七', '廿八', '廿九', '三十'); LMonthName : array[1..12] of string = ('正月', '二月', '三月', '四月', '五月', '六月', '七月', '八月', '九月', '十月', '十一月', '十二月'); var //daterec : TDaterec; ly, lm, ld : integer; begin //daterec.GregYear := y; //daterec.wMonth := m; //daterec.wDay := d; Solar2Lunar(y-1911, m, d, ly, lm, ld); //if GregorianToLunarDate(@daterec) then begin if ld = 1 then begin if lm < 0 then result := '閏'; result := result LMonthName[abs(lm)] end else result := LDayName[ld]; //end; end; function TRexCalendar.GetCellText(ACol, ARow: Integer): string; var DayNum: Integer; begin if ARow = 0 then { day names at tops of columns } Result := ShortDayNames[(StartOfWeek ACol) mod 7 1] else begin DayNum := FMonthOffset ACol (ARow - 1) * 7; if (DayNum < 1) or (DayNum > DaysThisMonth) then Result := '' else Result := IntToStr(DayNum) GToL(year, month, DayNum); end; end; function TRexCalendar.SelectCell(ACol, ARow: Longint): Boolean; begin if ((not FUpdating) and FReadOnly) or (CellText[ACol, ARow] = '') then Result := False else Result := inherited SelectCell(ACol, ARow); end; {function DaysPerLunarMonth(GYear, LYear, AMonth: Integer): Integer; var daterec: TDateRec; begin daterec.GregYear := GYear; daterec.LunarYear := LYear; daterec.wMonth := AMonth; daterec.wDay := 0; Result := DaysInLunarMonth(@daterec); end;} function TRexCalendar.GetLYearName : string; begin result := YearName(FLYear); end; procedure TRexCalendar.SetLDay(Value: integer); var //daterec : Tdaterec; sy, sm, sd : integer; begin if Value > DaysPerLunarMonth(FLyear, FLMonth) then exit else FLDay := Value; //FDate := EncodeLunarDate(Year, LunarYearNameToNumeric(FLYear), FLMonth, FLDay); {daterec.GregYear := Year; daterec.LunarYear := LunarYearNameToNumeric(FLYear); daterec.wMonth := FLMonth; daterec.wDay := FLDay; if LunarToGregorianDate(@daterec) then FDate := EncodeDate(daterec.GregYear, daterec.wMonth, daterec.wDay); } Lunar2Solar(FLYear, FLMonth, FLDay, SY, SM, SD); FDate := StrToDate(Format('%.4d/%.2d/%.2d', [sy 1911, sm, sd])); UpdateCalendar; Change; end; function TRexCalendar.GetLDay: integer; var //daterec : Tdaterec; AYear, AMonth, ADay : Word; begin DecodeDate(FDate, AYear, AMonth, ADay); //DecodeLunarDate(FDate, LY, LM, LD); {daterec.GregYear := AYear; daterec.wMonth := AMonth; daterec.wDay := ADay; if GregorianToLunarDate(@daterec) then begin result := daterec.wDay; FLYear := LunarYearName(daterec.LunarYear); end;} Solar2Lunar(AYear-1911, AMonth, ADay, FLYear, FLMonth, FLDay); result := FLDay; end; procedure TRexCalendar.SetLMonth(Value: Integer); var //daterec : Tdaterec; sy, sm, sd : integer; begin if Value > 12 then exit else FLMonth := Value; //FDate := EncodeLunarDate(Year, LunarYearNameToNumeric(FLYear), FLMonth, FLDay); {daterec.GregYear := Year; daterec.LunarYear := LunarYearNameToNumeric(FLYear); daterec.wMonth := FLMonth; daterec.wDay := FLDay; if LunarToGregorianDate(@daterec) then FDate := EncodeDate(daterec.GregYear, daterec.wMonth, daterec.wDay);} Lunar2Solar(FLYear, FLMonth, FLDay, SY, SM, SD); FDate := StrToDate(Format('%.4d/%.2d/%.2d', [sy 1911, sm, sd])); UpdateCalendar; Change; end; function TRexCalendar.GetLMonth: Integer; var //daterec : Tdaterec; AYear, AMonth, ADay : Word; begin DecodeDate(FDate, AYear, AMonth, ADay); //DecodeLunarDate(FDate, LY, LM, LD); {daterec.GregYear := AYear; daterec.wMonth := AMonth; daterec.wDay := ADay; if GregorianToLunarDate(@daterec) then begin result := daterec.wMonth; FLYear := LunarYearName(daterec.LunarYear); end;} Solar2Lunar(AYear-1911, AMonth, ADay, FLYear, FLMonth, FLDay); result := FLMonth; end; procedure TRexCalendar.SetLYear(Value: Integer); var //daterec : Tdaterec; sy, sm, sd : integer; begin if (Value > 100) and (Value < 1) then exit else FLYear := Value; //FDate := EncodeLunarDate(Year, LunarYearNameToNumeric(FLYear), FLMonth, FLDay); {daterec.GregYear := Year; daterec.LunarYear := LunarYearNameToNumeric(FLYear); daterec.wMonth := FLMonth; daterec.wDay := FLDay; if LunarToGregorianDate(@daterec) then FDate := EncodeDate(daterec.GregYear, daterec.wMonth, daterec.wDay);} Lunar2Solar(FLYear, FLMonth, FLDay, SY, SM, SD); FDate := StrToDate(Format('%.4d/%.2d/%.2d', [sy 1911, sm, sd])); UpdateCalendar; Change; end; function TRexCalendar.GetLYear: Integer; var //daterec : Tdaterec; AYear, AMonth, ADay : Word; begin DecodeDate(FDate, AYear, AMonth, ADay); //DecodeLunarDate(FDate, LY, LM, LD); {daterec.GregYear := AYear; daterec.wMonth := AMonth; daterec.wDay := ADay; if GregorianToLunarDate(@daterec) then begin result := daterec.wMonth; FLYear := LunarYearName(daterec.LunarYear); end;} Solar2Lunar(AYear-1911, AMonth, ADay, FLYear, FLMonth, FLDay); result := FLYear; end; procedure TRexCalendar.SetCalendarDate(Value: TDateTime); var AYear, AMonth, ADay : Word; //daterec : TDateRec; begin FDate := Value; DecodeDate(FDate, AYear, AMonth, ADay); {daterec.GregYear := AYear; daterec.wMonth := AMonth; daterec.wDay := ADay; if GregorianToLunarDate(@daterec) then begin FLYear := LunarYearName(daterec.LunarYear); FLMonth := daterec.wMonth; FLDay := daterec.wDay; end;} Solar2Lunar(AYear-1911, AMonth, ADay, FLYear, FLMonth, FLDay); UpdateCalendar; Change; end; function TRexCalendar.StoreCalendarDate: Boolean; begin Result := not FUseCurrentDate; end; function TRexCalendar.GetDateElement(Index: Integer): Integer; var AYear, AMonth, ADay: Word; begin DecodeDate(FDate, AYear, AMonth, ADay); case Index of 1: Result := AYear; 2: Result := AMonth; 3: Result := ADay; else Result := -1; end; end; procedure TRexCalendar.SetDateElement(Index: Integer; Value: Integer); var AYear, AMonth, ADay: Word; begin if Value > 0 then begin DecodeDate(FDate, AYear, AMonth, ADay); case Index of 1: if AYear <> Value then AYear := Value else Exit; 2: if (Value <= 12) and (Value <> AMonth) then AMonth := Value else Exit; 3: if (Value <= DaysThisMonth) and (Value <> ADay) then ADay := Value else Exit; else Exit; end; FDate := EncodeDate(AYear, AMonth, ADay); FUseCurrentDate := False; UpdateCalendar; Change; end; end; procedure TRexCalendar.SetStartOfWeek(Value: TDayOfWeek); begin if Value <> FStartOfWeek then begin FStartOfWeek := Value; UpdateCalendar; end; end; procedure TRexCalendar.SetUseCurrentDate(Value: Boolean); begin if Value <> FUseCurrentDate then begin FUseCurrentDate := Value; if Value then begin FDate := Date; { use the current date, then } UpdateCalendar; end; end; end; { Given a value of 1 or -1, moves to Next or Prev month accordingly } procedure TRexCalendar.ChangeMonth(Delta: Integer); var AYear, AMonth, ADay: Word; NewDate: TDateTime; CurDay: Integer; begin DecodeDate(FDate, AYear, AMonth, ADay); CurDay := ADay; if Delta > 0 then ADay := DaysPerMonth(AYear, AMonth) else ADay := 1; NewDate := EncodeDate(AYear, AMonth, ADay); NewDate := NewDate Delta; DecodeDate(NewDate, AYear, AMonth, ADay); if DaysPerMonth(AYear, AMonth) > CurDay then ADay := CurDay else ADay := DaysPerMonth(AYear, AMonth); CalendarDate := EncodeDate(AYear, AMonth, ADay); end; procedure TRexCalendar.PrevMonth; begin ChangeMonth(-1); end; procedure TRexCalendar.NextMonth; begin ChangeMonth(1); end; procedure TRexCalendar.NextYear; begin if IsLeapYear(Year) and (Month = 2) and (Day = 29) then Day := 28; Year := Year 1; end; procedure TRexCalendar.PrevYear; begin if IsLeapYear(Year) and (Month = 2) and (Day = 29) then Day := 28; Year := Year - 1; end; procedure TRexCalendar.UpdateCalendar; var AYear, AMonth, ADay: Word; FirstDate: TDateTime; begin FUpdating := True; try DecodeDate(FDate, AYear, AMonth, ADay); FirstDate := EncodeDate(AYear, AMonth, 1); FMonthOffset := 2 - ((DayOfWeek(FirstDate) - StartOfWeek 7) mod 7); { day of week for 1st of month } if FMonthOffset = 2 then FMonthOffset := -5; MoveColRow((ADay - FMonthOffset) mod 7, (ADay - FMonthOffset) div 7 1, False, False); Invalidate; finally FUpdating := False; end; end; procedure TRexCalendar.WMSize(var Message: TWMSize); var GridLines: Integer; begin GridLines := 6 * GridLineWidth; DefaultColWidth := (Message.Width - GridLines) div 7; DefaultRowHeight := (Message.Height - GridLines) div 7; end; procedure Register; begin RegisterComponents('中文專用', [TRexCalendar]); end; end. ================================ {* =================================Blue Fox================================= *} {* 單 元 名 稱：Lunar {* 建 檔 日 期：2001/12/21 加入說明檔頭 {* 檔 案 製 作：Levi {* =================================Blue Fox================================= *} {* 附 屬 檔 案： {* 說 明&用 途：國曆與農曆互相轉換的相關函數集 {* {* 參 考 資 料： {* {* 更 新 說 明： {* 01/12/15 1.準備增加關節氣，干支，生肖 {* 2.在程式中因作者使用常數給值的方式在D6中是不可以的此BUG要找時間處理 {* {* =================================Blue Fox================================= *} {* 不要覺得註解長，註解是給以後的你或別人看的，請保持註解的完整性 *} {* =======================================================================2.0 *} {* 注解說明： *} {* 1. 在程式敘述中加入注解 格式為 *} {* // @ 程式師, 修改日期,工作模式, 修改描述 *} {* 例如 // @levi,01/12/21,Add,取得日期。 *} {* 而工作模式有 Add,A 為新增敘述 ; *} {* Edit,E 為修改舊有敘述; *} {* Make,M 為刪除但不能將敘述刪除而是改變為注解; *} {* O 為其它不在上面的模式; *} {* 2. 在宣告程序的後方必加入本程序的功能說明用 // 為注解符號。 *} {* ========================================================================== *} //以下為舊說明 { 這是一個國曆與農曆互相轉的Unit. 其中年份皆用民國年份, 請自行轉換 (西元年-1911 = 民國年). *************************************************************************** *國農曆對映表之說明 : * *************************************************************************** * 前二數字 = 閏月月份, 如果為 13 則沒有閏月 * * 第三至第六數字 = 12 個月之大小月之2進位碼->10進位 * * 例如: * * 101010101010 = 2730 * * 1 : 代表大月(30天) 0 : 代表小月(29天) ==> 1月大2月小3月大..... * * 第七位數字為閏月天數 * * 0 : 沒有閏月之天數 * * 1 : 閏月為小月(29天) * * 2 : 閏月為大月(30天) * * 最後2位數字代表陽曆之1月1日與陰曆之1月1日相差天數 * *************************************************************************** 這對映表只有民國一年至民國一百年, 如不敷您的使用請按照上述之方式自行增加. 這個程式沒有判斷您所輸入之年,月,日是否正確, 請自行判斷. 如果轉換出來之農曆的月份是閏月則傳給您的值是***負數*** 如果農曆要轉換國曆如果是閏月請輸入***負數*** 此版本為FreeWare Version : 0.1 您可以自行修改, 但最好可以將修改過之程式Mail一份給我. 如果您要用於商業用途, 請mail給我告知您的用途及原因. 作者 : 彭宏傑 E-Mail : rexpeng@ms1.hinet.net } unit Lunar; interface uses SysUtils; //國曆轉農曆(民國年, 月, 日, var 農曆年, 農曆月, 農曆日) procedure Solar2Lunar(SYear, SMonth, SDay: Integer; var LYear, LMonth, LDay: Integer); //農曆轉國曆(農曆年, 農曆月, 農曆日, var 民國年, 月, 日) procedure Lunar2Solar(LYear, LMonth, LDay: Integer; var SYear, SMonth, SDay: Integer); //輸入農曆年份換算六十甲子名稱 function YearName(LYear: integer): string; //得知農曆之月份天數 function DaysPerLunarMonth(LYear, LMonth: Integer): Integer; implementation const SMDay: array[1..12] of integer = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31); c1: array[1..10] of string[2] = ('甲', '乙', '丙', '丁', '戊', '己', '庚', '辛', '壬', '癸'); c2: array[1..12] of string[2] = ('子', '丑', '寅', '卯', '辰', '巳', '午', '未', '申', '酉', '戌', '亥'); // Magic String : LongLife: array[1..100] of string[9] = ( '132637048', '133365036', '053365225', '132900044', '131386034', '022778122', //6 '132395041', '071175231', '131175050', '132635038', '052891127', '131701046', //12 '131748035', '042741223', '130694043', '132391032', '021327122', '131175040', //18 '061623129', '133402047', '133402036', '051769125', '131453044', '130694034', //24 '032158223', '132350041', '073213230', '133221049', '133402038', '063466226', //30 '132901045', '131130035', '042651224', '130605043', '132349032', '023371121', //36 '132709040', '072901128', '131738047', '132901036', '051333226', '131210044', //42 '132651033', '031111223', '131323042', '082714130', '133733048', '131706038', //48 '062794127', '132741045', '131206035', '042734124', '132647043', '131318032', //54 '033878120', '133477039', '071461129', '131386047', '132413036', '051245126', //60 '131197045', '132637033', '043405122', '133365041', '083413130', '132900048', //66 '132922037', '062394227', '132395046', '131179035', '042711124', '132635043', //72 '102855132', '131701050', '131748039', '062804128', '132742047', '132359036', //78 '051199126', '131175045', '131611034', '031866122', '133749040', '081717130', //84 '131452049', '132742037', '052413127', '132350046', '133222035', '043477123', //90 '133402042', '133493031', '021877121', '131386039', '072747128', '130605048', //96 '132349037', '053243125', '132709044', '132890033'); var LMDay: array[1..13] of integer; InterMonth, InterMonthDays, SLRangeDay: integer; function IsLeapYear(AYear: Integer): Boolean; begin Result := (AYear mod 4 = 0) and ((AYear mod 100 <> 0) or (AYear mod 400 = 0)); end; function YearName(LYear: integer): string; var x, y, ya: integer; begin ya := LYear; if ya < 1 then ya := ya 1; if ya < 12 then ya := ya 60; x := (ya 8 - ((ya 7) div 10) * 10); y := (ya - ((ya - 1) div 12) * 12); result := c1[x] c2[y]; end; procedure CovertLunarMonth(magicno: integer); var i, size, m: integer; begin m := magicno; for i := 12 downto 1 do begin size := m mod 2; if size = 0 then LMDay[i] := 29 else LMDay[i] := 30; m := m div 2; end; end; procedure ProcessMagicStr(yy: integer); var magicstr: string; dsize, LunarMonth: integer; begin magicstr := LongLife[yy]; InterMonth := StrToInt(Copy(magicstr, 1, 2)); LunarMonth := StrToInt(copy(magicstr, 3, 4)); CovertLunarMonth(LunarMonth); dsize := StrToInt(Copy(magicstr, 7, 1)); case dsize of 0: InterMonthDays := 0; 1: InterMonthDays := 29; 2: InterMonthDays := 30; end; SLRangeDay := StrToInt(Copy(Magicstr, 8, 2)); end; function DaysPerLunarMonth(LYear, LMonth: Integer): Integer; begin ProcessMagicStr(LYear); if LMonth < 0 then Result := InterMonthDays else Result := LMDay[LMonth]; end; procedure Solar2Lunar(SYear, SMonth, SDay: integer; var LYear, LMonth, LDay: integer); var i, day: integer; begin day := 0; if isLeapYear(SYear 1911) then //判斷是否為閏年 011205 levi C SMDay[2] := 29; ProcessMagicStr(SYear); if SMonth = 1 then day := SDay else begin for i := 1 to SMonth - 1 do day := day SMDay[i]; day := day SDay; end; if day <= SLRangeDay then begin day := day - SLRangeDay; processmagicstr(SYear - 1); for i := 12 downto 1 do begin day := day LMDay[i]; if day > 0 then break; end; LYear := SYear - 1; LMonth := i; LDay := day; end else begin day := day - SLRangeDay; for i := 1 to InterMonth - 1 do begin day := day - LMDay[i]; if day <= 0 then break; end; if day <= 0 then begin LYear := SYear; LMonth := i; LDay := day LMDay[i]; end else begin day := day - LMDay[InterMonth]; if day <= 0 then begin LYear := SYear; LMonth := InterMonth; LDay := day LMDay[InterMonth]; end else begin LMDay[InterMonth] := InterMonthDays; for i := InterMonth to 12 do begin day := day - LMDay[i]; if day <= 0 then break; end; if i = InterMonth then LMonth := 0 - InterMonth else LMonth := i; LYear := SYear; LDay := day LMDay[i]; end; end; end; end; procedure Lunar2Solar(LYear, LMonth, LDay: integer; var SYear, SMonth, SDay: integer); var i, day: integer; begin day := 0; SYear := LYear; if isLeapYear(SYear 1911) then //判斷是否為閏年 011205 levi C SMDay[2] := 29; processmagicstr(SYear); if LMonth < 0 then day := LMDay[InterMonth]; if LMonth <> 1 then for i := 1 to LMonth - 1 do day := day LMDay[i]; day := day LDay SLRangeDay; if (InterMonth <> 13) and (InterMonth < LMonth) then day := day InterMonthDays; for i := 1 to 12 do begin day := day - SMDay[i]; if day <= 0 then break; end; if day > 0 then begin SYear := SYear 1; if isLeapYear(SYear 1911) then //判斷是否為閏年 011205 levi C SMDay[2] := 29; for i := 1 to 12 do begin day := day - SMDay[i]; if day <= 0 then break; end; end; //i := i - 1; day := day SMDay[i]; //if i = 0 then begin // i := 12; // SYear := SYear - 1; // day := day 31; //end;// else //day := day SMDay[i]; SMonth := i; SDay := day; end; end. 發表人 - banson1716 於 2003/02/18 18:53:18