[Delphi] 델파이 음력 양력 변환 함수

델파이로 양력을 음력으로 변환하거나, 반대로 음력을 양력으로 변환해야 하는 경우가 많은데요.

오늘은 음력과 양력을 변환하여 주는 함수를 포스팅 하여 보겠습니다.

 

오래전에 여기 저기 검색하여 찾은 함수인데,

다시 찾으려 하니 보이지가 않더군요.

 

다시 정리하여 올려 봅니다.

 

필요하신 분은 사용하여 보세요.

단, 저는 잘 사용하고 있는데 보장은 할 수 없습니다.

 

---

 

우선 상수 선언이 필요합니다.

const
  s_Year = 1881;
  e_Year = 2050;
  LunDays: array[1..6]of Integer = (353, 354, 355, 383, 384, 385);
  LunData: array[s_Year..e_Year, 1..5]of Char = (
    '5H57A', '3 55B', '2 25D', '5F95B', '2 92B', '2 A95', '5ED95', '2 B4A', '3 B55', '5C6D5',  // 1890
    '3 55B', '5G277', '2 257', '2 52B', '4FAAA', '3 E95', '2 6AA', '5DBAA', '3 AB5', '5I4BD',  // 1900
    '2 4AE', '3 A57', '4F54D', '2 D26', '3 D95', '5e655', '2 56A', '3 9AD', '5C55D', '2 4AE',  // 1910
    '5GA5B', '2 A4D', '2 D25', '5FDA9', '3 B55', '2 56A', '5CADA', '3 95D', '5H4BB', '2 49B',  // 1920
    '2 A4B', '5FB4B', '2 6A9', '2 AD4', '6EBB5', '2 2B6', '3 95B', '5C537', '2 497', '4G656',  // 1930
    '2 E4A', '3 EA5', '5f6A9', '3 5B5', '2 2B6', '5d8AE', '2 92E', '5hC8D', '2 C95', '2 D4A',  // 1940
    '5gD8A', '3 B69', '3 56D', '5e25B', '2 25D', '2 92D', '5CD2B', '2 A95', '5HD55', '2 B4A',  // 1950
    '3 B55', '5f555', '3 4DB', '2 25B', '5d857', '2 52B', '5IA9B', '2 695', '2 6AA', '5GAEA',  // 1960
    '3 AB5', '2 4B6', '5EAAE', '3 A57', '2 527', '4D726', '3 D95', '5H6B5', '2 56A', '3 9AD',  // 1970
    '5F4DD', '2 4AE', '2 A4E', '5ED4D', '2 D25', '5ID59', '2 B54', '3 D6A', '5g95A', '3 95B',  // 1980
    '2 49B', '5EA9B', '2 A4B', '5KB27', '2 6A5', '2 6D4', '6GB75', '2 2B6', '3 95B', '5F4B7',  // 1990
    '2 497', '2 64B', '4D74A', '3 EA5', '5I6D9', '3 5AD', '2 2B6', '5F96E', '2 92E', '2 C96',  // 2000
    '5EE95', '2 D4A', '3 DA5', '5C755', '2 56C', '6HABB', '2 25D', '2 92D', '5FCAB', '2 A95',  // 2010  //2009 5FCAB
    '2 B4A', '5dB4A', '3 B55', '5J55D', '2 4BA', '3 A5B', '5F557', '2 52B', '2 A95', '5EB95',  // 2020
    '2 6AA', '3 AD5', '5C6B5', '2 4B6', '5GA6E', '3 A57', '2 527', '4F6A6', '3 D93', '2 5AA',  // 2030
    '5DB6A', '3 96D', '5L4AF', '2 4AE', '2 A4D', '5gD0D', '2 D25', '2 D52', '5FDD4', '3 B6A',  // 2040
    '3 96D', '5C55B', '2 49B', '5HA57', '2 A4B', '2 B25', '5fB25', '2 6D4', '3 ADA', '5d8B6'); // 2050

 

함수 정의는 다음과 같습니다.

//
// 음력을 양력으로 변환
function Luna2Sola(

      luYear, luMonth, luDay: Word; IsLeap: Boolean;   // 전달 음력 연월일
      var soYear, soMonth, soDay: Word;  // 수신 양력 연월일
      var ErrMsg: string): Boolean;  // 오류 메시지
      
// 양력을 음력으로 변환      
function Sola2Luna(
      soYear, soMonth, soDay: Word;  // 전달 양력 연월일
      var luYear, luMonth, luDay: Word; var IsLeap, IsLarge: Boolean;  // 수신 음력 연월일
      var ErrMsg: string): Boolean;  // 오류 메시지

//
// 공용함수
function LunaHexToBin(Data: string): string;

   

// 양력을 음력으로 변환하는 함수 본분입니다.

//
// 양력을 음력으로 변환하는 함수
function Sola2Luna(
  soYear, soMonth, soDay: Word; // 전달 정보	
  var luYear, luMonth, luDay: Word; var IsLeap, IsLarge: Boolean;	// 반환 정보
  var ErrMsg: string): Boolean; // 에러메시지
var
  EnDays: Integer;

  // 서브함수
  FUNCTION CheckDays(d: Integer): Boolean;
  begin
    Result := EnDays - d > 0;
    if Result then EnDays := EnDays - d;
  end;

  // 서브함수
  PROCEDURE DoLuner(StartYear, Days: Integer);
  var
    BitStr: string;
    LeapIndex: Integer;
  begin
    Result := True;
    EnDays := EnDays - Days;
    luYear := StartYear;
    while CheckDays(LunDays[StrToInt(LunData[luYear, 1])])do
      Inc(luYear);
    BitStr := LunaHexToBin(LunData[luYear]);
    luMonth := 1;
    while CheckDays(29 + Ord(BitStr[luMonth]))do
      Inc(luMonth);
    luDay := EnDays;
    IsLarge := BitStr[luMonth] = #1;
    LeapIndex := Ord(UpCase(LunData[luYear, 2])) - 64;
    IsLeap := luMonth = LeapIndex;
    if(LeapIndex > 0)and(LeapIndex <= luMonth)then
      Dec(luMonth);
  end;

begin
  Result := False;
  try
    EnDays := Trunc(EnCodeDate(soYear, soMonth, soDay));
  except
    ErrMsg := '입력된 날자가 올바르지 않습니다.';
  end;
  if(EnDays < -6909)or(EnDays > 55194)then  // EnCodeDate(1881, 1, 30), EnCodeDate(2051, 2, 10)
    ErrMsg := '양력의 입력범위는 1881-01-30 ~ 2051-02-10 입니다.'
  else
    if EnDays > 24128 then DoLuner(1966, 24128)
                      else DoLuner(1881, -6909);
end;

 

// 음력을 양력으로 변환하는 함수 본문입니다.

//
// 음력을 양력으로 변환
function Luna2Sola(
  luYear, luMonth, luDay: Word; IsLeap: Boolean;	// 전달정보
  var soYear, soMonth, soDay: Word; 				// 반환정보
  var ErrMsg: string): Boolean;						// 반환에러메시지	
var
  LeapIndex: Integer;
  BitStr: string;

  // 서브함수
  PROCEDURE DoSolar(StartYear, Days: Integer);
  var
    I: Integer;
  begin
    Result := True;
    Days := luDay + Days;
    for I := StartYear to luYear - 1 do
      Days := Days + LunDays[StrToInt(LunData[I, 1])];
    if IsLeap or(LeapIndex > 0)and(LeapIndex <= luMonth)then
      Inc(luMonth);
    for I := 1 to luMonth - 1 do
      Days := Days + 29 + Ord(BitStr[I]);
    DeCodeDate(Days, soYear, soMonth, soDay);
  end;

begin
  Result := False;
  if(luYear < s_Year)or(luYear > e_Year)then
    ErrMsg := '음력의 입력범위는 1881년 ~ 2050년 입니다.'
  else
  begin
    BitStr := LunaHexToBin(LunData[luYear]);
    LeapIndex := Ord(UpCase(LunData[luYear, 2])) - 64;
    if (IsLeap) and (LeapIndex <> (luMonth + 1)) then
      ErrMsg := IntToStr(luYear) + '-' + IntToStr(luMonth) + '월은 윤달이 없습니다'
    else
      if LeapIndex < luMonth then
      begin
        if luDay > 29 + Ord(BitStr[luMonth+1])then
          ErrMsg := IntToStr(luYear) + '-' + IntToStr(luMonth) + '월은 ' +
            IntToStr(29 + Ord(BitStr[luMonth])) + '일 까지 입니다.'
        else
          if luYear > 1965 then DoSolar(1966, 24128)
                           else DoSolar(1881, -6909);
      end
      else begin
        if luDay > 29 + Ord(BitStr[luMonth])then
          ErrMsg := IntToStr(luYear) + '-' + IntToStr(luMonth) + '월은 ' +
            IntToStr(29 + Ord(BitStr[luMonth])) + '일 까지 입니다.'
        else
          if luYear > 1965 then DoSolar(1966, 24128)
                           else DoSolar(1881, -6909);
      end;
  end;
end;

다음은 위 두 함수에서 공용으로 사용하는 함수 본문입니다.

//
// 공용함수
function LunaHexToBin(Data: string): string;
var
  I, Hex, Temp: Integer;
begin
  SetLength(Result, 12);
  Hex := StrToInt('$' + Copy(Data, 3, 3));
  Temp := 2048;  // 10000000000  12자리 2진수 비트값
  for I := 1 to 12 do
  begin
    if Hex < Temp then
      Result[I] := #0  // 작은달
    else
    begin
      Result[I] := #1; // 큰달
      Hex := Hex - Temp;
    end;
    Temp := Temp shr 1;
  end;
  case Data[2]of
    'A'..'L' : Insert(#0, Result, Ord(Data[2]) - 64); // 윤달 작은달 삽입
    'a'..'l' : Insert(#1, Result, Ord(Data[2]) - 96); //   "  큰달    "
  end;
end;