umonthpanel.pas

支持公历、农历及公历转农历使用公式法（不是查表法）的日历控件

  end;
end;

procedure TMonthPanel.SetDayInfor(DayIndex: Integer; DayInfor: string);
begin
  if DayIndex in [1..31] then
  begin
    FDayInfors[DayIndex] := DayInfor;
    FMonthGrid.Cells[FDayCells[DayIndex].X,FDayCells[DayIndex].Y] := IntToStr(DayIndex);

    if FCellDays[FDayCells[DayIndex].X,FDayCells[DayIndex].Y] = FChineseNewYear then
      FMonthGrid.Cells[FDayCells[DayIndex].X,FDayCells[DayIndex].Y] :=
        FMonthGrid.Cells[FDayCells[DayIndex].X,FDayCells[DayIndex].Y] + '[春节]'
    else if FDayInfors[DayIndex]<>'' then
      FMonthGrid.Cells[FDayCells[DayIndex].X,FDayCells[DayIndex].Y] :=
        FMonthGrid.Cells[FDayCells[DayIndex].X,FDayCells[DayIndex].Y] +
        CALENDARSPLITE+FDayInfors[DayIndex];
  end;
end;

procedure TMonthPanel.ClearCellDays;
var
  i,j:Integer;
begin
  for i := 0 to 6 do
  begin
    for j := 1 to 6 do
    begin
      FCellDays[i,j] := 0;
    end;
  end;
end;

procedure TMonthPanel.ClearDayCells;
var
  i:Integer;
begin
  for i := 1 to 31 do
  begin
    FDayCells[i].X := 0;
    FDayCells[i].Y := 0;
  end;


end;

procedure TMonthPanel.MonthGridMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
var
  lChineseDate:TChineseDate;
  lDate:TDate;
  i:Integer;
begin
  if FCellDays[FMonthGrid.MouseCoord(X,Y).X,FMonthGrid.MouseCoord(X,Y).Y] = 0 then
  begin
    Self.Hint := FMonthCaptionPanel.Caption;
    exit;
  end;

  lChineseDate:=ChineseDate(FCellDays[FMonthGrid.MouseCoord(X,Y).X,FMonthGrid.MouseCoord(X,Y).Y]);
  Self.Hint := CHINESESTEM[Ord(lChineseDate.yearcycle.stem)]+
               CHINESEZODIAC[Ord(lChineseDate.yearcycle.zodiac)]+'('+
               CHINESEZODIACEX[Ord(lChineseDate.yearcycle.zodiac)]+')年'+#13+
               CHINESEMONTHNAME[lChineseDate.month-1]+
               CHINESEDAYNAME[lChineseDate.day-1];

  lDate := FCellDays[FMonthGrid.MouseCoord(X,Y).X,FMonthGrid.MouseCoord(X,Y).Y];
  //公历节日
  for i := Low(SUNHOLIDY) to High(SUNHOLIDY) do
  begin
    if (StrToInt(LeftStr(SUNHOLIDY[i],2)) = MonthOf(lDate)) and
       (StrToInt(MidStr(SUNHOLIDY[i],3,2)) = DayOf(lDate)) then
    Self.Hint := Self.Hint +#13+ RightStr(SUNHOLIDY[i],Length(SUNHOLIDY[i])-4);
  end;

  //农历节日
  for i := Low(MONTHHOLIDY) to High(MONTHHOLIDY) do
  begin
    if (StrToInt(LeftStr(MONTHHOLIDY[i],2)) = lChineseDate.month) and
       (StrToInt(MidStr(MONTHHOLIDY[i],3,2)) = lChineseDate.day) then
    Self.Hint := Self.Hint +#13+ RightStr(MONTHHOLIDY[i],Length(MONTHHOLIDY[i])-4);
  end;

end;

procedure TMonthPanel.MonthGridDblClick(Sender: TObject);
var
  i,j:Integer;
  NextOrder:Integer;
  ti1,ti2:Integer;
begin
  with FMonthGrid do
  begin
    for i := Selection.Left to Selection.Right do
    begin
      for j := Selection.Top to Selection.Bottom do
      begin
        if FCellDays[i,j]<>0 then
        begin
          ti1 := Ord(FDaySigns[DayOf(FCellDays[i,j])])+1;
          ti2 := Ord(High(TDaySign)) - Ord(Low(TDaySign));

          {如果当天是周末，则在工作日、法定假日、周末间循环，
          否则只在工作日、法定假日间循环}
          if DayOfTheWeek(FCellDays[i,j]) in [6..7] then
            ti2 := ti2+1;
            
          NextOrder := ti1 Mod ti2;

          FDaySigns[DayOf(FCellDays[i,j])] := TDaySign(NextOrder);
          if Assigned(FOnDaySignChanged) then
            FOnDaySignChanged(Self,FCellDays[i,j],FDaySigns[DayOf(FCellDays[i,j])]);
        end;
      end;
    end;
  end;
  FMonthGrid.Invalidate;
end;

procedure TMonthPanel.PreparePopMenu;
var
  item:TMenuItem;
begin
  item := TMenuItem.Create(Self);
  item.Caption := '设定为法定节日(&H)';
  item.OnClick := ToHolidayPopupMenuClicked;
  FGridPopupMenu.Items.Add(Item);

  item := TMenuItem.Create(Self);
  item.Caption := '设定为工作日(&N)';
  item.OnClick := ToNormalDayPopupMenuClicked;
  FGridPopupMenu.Items.Add(Item);

  item := TMenuItem.Create(Self);
  item.Caption := '设定为普通周末(&W)';
  item.OnClick := ToNormalWeekEndPopupMenuClicked;
  FGridPopupMenu.Items.Add(Item);

  item := TMenuItem.Create(Self);
  item.Caption := '显示农历日期(&C)';
  item.OnClick := DisplayCDPopupMenuClicked;
  FGridPopupMenu.Items.Add(Item);

end;

procedure TMonthPanel.ToHolidayPopupMenuClicked(Sender: TObject);
begin
  SelectedRangeToSign(dsHoliday);
end;

procedure TMonthPanel.ToNormalDayPopupMenuClicked(Sender: TObject);
begin
  SelectedRangeToSign(dsNormal);

end;

procedure TMonthPanel.SetOnCaptionDBClick(const Value: TNotifyEvent);
begin
  FMonthCaptionPanel.OnDblClick := Value;
end;

function TMonthPanel.GetCaptionPopUpMenu: TPopupMenu;
begin
  Result := FMonthCaptionPanel.PopupMenu;
end;

procedure TMonthPanel.SetCaptionPopUpMenu(const Value: TPopupMenu);
begin
  FMonthCaptionPanel.PopupMenu := Value;
end;

function TMonthPanel.GetCaptionMouseMove: TMouseMoveEvent;
begin
  Result := FMonthCaptionPanel.OnMouseMove;
end;

procedure TMonthPanel.SetCaptionMouseMove(const Value: TMouseMoveEvent);
begin
  FMonthCaptionPanel.OnMouseMove := Value;
end;

function TMonthPanel.GetOnCaptionDBClick: TNotifyEvent;
begin
  Result := FMonthCaptionPanel.OnDblClick;
end;

function TMonthPanel.GetOnCaptionMouseDown: TMouseEvent;
begin
  Result := FMonthCaptionPanel.OnMouseDown;
end;

function TMonthPanel.GetOnCaptionMouseUp: TMouseEvent;
begin
  Result := FMonthCaptionPanel.OnMouseUp;
end;

procedure TMonthPanel.SetOnCaptionMouseDown(const Value: TMouseEvent);
begin
  FMonthCaptionPanel.OnMouseDown := Value;
end;

procedure TMonthPanel.SetOnCaptionMouseUp(const Value: TMouseEvent);
begin
  FMonthCaptionPanel.OnMouseUp := Value;
end;

procedure TMonthPanel.OnNexClick(Sender: TObject);
begin
  if MonthOf(FMonthPanelDate) = 12 then
  begin
    MonthPanelDate := EncodeDate(Yearof(FMonthPanelDate),1,1);
  end else
  begin
    MonthPanelDate := EncodeDate(Yearof(FMonthPanelDate),MonthOf(FMonthPanelDate)+1,1);
  end;
end;

procedure TMonthPanel.OnPriClick(Sender: TObject);
begin
  if MonthOf(FMonthPanelDate) = 1 then
  begin
    MonthPanelDate := EncodeDate(Yearof(FMonthPanelDate)-1,12,1);
  end else
  begin
    MonthPanelDate := EncodeDate(Yearof(FMonthPanelDate),MonthOf(FMonthPanelDate)-1,1);
  end;
end;

procedure TMonthPanel.DisplayCDPopupMenuClicked(Sender: TObject);
begin
  DispalyChineseDay := not FDispalyChineseDay;
  (Sender as TMenuItem).Checked := DispalyChineseDay;
end;

function TMonthPanel.RefreshMonthGrid:Integer;
var
  laDay:TDate;
  lDayOfTheWeek:Integer;
  lWeekOfMonth:Integer;
  i:Integer;
  lChineseDate:TChineseDate;
begin
  laDay := FMonthPanelDate;
  lWeekOfMonth := 1;
  for i := 0 to FDaysInMonth-1 do
  begin
    FMonthGrid.Cells[DayOfTheWeek(laDay)-1,lWeekOfMonth] :=
      IntToStr(i+1);

    if FDispalyChineseDay then lChineseDate:=ChineseDate(laDay);

    lDayOfTheWeek := DayOfTheWeek(laDay);

    if FChineseNewYear = laDay then
    begin
        FMonthGrid.Cells[lDayOfTheWeek-1,lWeekOfMonth] :=
         FMonthGrid.Cells[lDayOfTheWeek-1,lWeekOfMonth] +
         '[春节]';

    end else
    begin
      if FDayInfors[i+1]<>'' then
        FMonthGrid.Cells[lDayOfTheWeek-1,lWeekOfMonth] :=
         FMonthGrid.Cells[lDayOfTheWeek-1,lWeekOfMonth] +
         CALENDARSPLITE+FDayInfors[i+1]
      else if FDispalyChineseDay then
      begin
        if lChineseDate.day=1 then
          FMonthGrid.Cells[lDayOfTheWeek-1,lWeekOfMonth] :=
           FMonthGrid.Cells[lDayOfTheWeek-1,lWeekOfMonth] + CALENDARSPLITE+
           CHINESEMONTHNAME[lChineseDate.month-1]
        else
          FMonthGrid.Cells[lDayOfTheWeek-1,lWeekOfMonth] :=
           FMonthGrid.Cells[lDayOfTheWeek-1,lWeekOfMonth] + CALENDARSPLITE+
           CHINESEDAYNAME[lChineseDate.day-1];
      end;
    end;

    FCellDays[lDayOfTheWeek-1,lWeekOfMonth] := laDay;
    FDayCells[i+1].X := lDayOfTheWeek-1;
    FDayCells[i+1].Y := lWeekOfMonth;

    laDay := laDay + 1;
    if (DayOfTheWeek(laDay) = 1) and
      (MonthOf(laDay)=MonthOf(FMonthPanelDate)) then lWeekOfMonth := lWeekOfMonth + 1;
  end;
  Result := lWeekOfMonth;
end;

procedure TMonthPanel.SetDispalyChineseDay(const Value: Boolean);
begin
  if FDispalyChineseDay <> Value then
  begin
    FDispalyChineseDay := Value;
    RefreshMonthGrid;
  end;
end;

function TMonthPanel.CellDay(ACellCoord: TGridCoord): TDate;
begin
  Result := 0;
  if (ACellCoord.X in [0..6]) and (ACellCoord.Y in [1..6]) then
  begin
    Result := FCellDays[ACellCoord.X,ACellCoord.Y];
  end;
end;

function TMonthPanel.DayCell(DayIndex: Integer): TGridCoord;
var
  ErrorPoint:TGridCoord;
begin
  ErrorPoint.X := 0;
  ErrorPoint.Y := 0;
  Result := ErrorPoint;
  if DayIndex in [1..31] then
  begin
    Result := FDayCells[DayIndex];
  end;

end;

function TMonthPanel.DayInfors(DayIndex: Integer): string;
begin
  Result := '';
  if DayIndex in [1..31] then
  begin
    Result := FDayInfors[DayIndex];
  end;

end;

function TMonthPanel.DaySigns(DayIndex: Integer): TDaySign;
begin
  Result := dsNormal;
  if DayIndex in [1..31] then
  begin
    Result := FDaySigns[DayIndex];
  end;
end;

procedure TMonthPanel.ToNormalWeekEndPopupMenuClicked(Sender: TObject);
begin
  SelectedRangeToSign(dsWeekend);
end;

procedure TMonthPanel.SelectedRangeToSign(ToSign: TDaySign);
var
  i,j:Integer;
  lSelection:TGridRect;
begin
  lSelection := FMonthGrid.Selection;
  if ToSign=dsWeekend then
  begin
    if 5 in [lSelection.Left..lSelection.Right] then
      lSelection.Left := 5
    else if lSelection.Right<5 then exit;
  end;

  with FMonthGrid do
  begin
    for i := lSelection.Left to lSelection.Right do
    begin
      for j := lSelection.Top to lSelection.Bottom do
      begin
        if FCellDays[i,j]<>0 then
        begin
          if ToSign=dsWeekend then
          begin
            if DayOfTheWeek(FCellDays[i,j]) in [6..7] then
              FDaySigns[DayOf(FCellDays[i,j])] := ToSign;
          end else
            FDaySigns[DayOf(FCellDays[i,j])] := ToSign;
        end;
      end;
    end;
  end;


  if Assigned(FOnDaysSignChanged) then
  begin
    FOnDaysSignChanged(Self,lSelection,ToSign);
  end;
  FMonthGrid.Invalidate;
end;

procedure TMonthPanel.SetCalendarLunarFont(const Value: TFont);
begin
  FLunarCalendarFont.Assign(Value);
  FMonthGrid.Invalidate;
end;

procedure TMonthPanel.SetGregorianCalendarFont(const Value: TFont);
begin
  FGregorianCalendarFont.Assign(Value);
  FMonthGrid.Invalidate;
end;

procedure TMonthPanel.SetMonthChangeButton(const Value: Boolean);
begin
  FShowMonthChangeButton := Value;
  FPriMonth.Visible := Value;
  FNexMonth.Visible := Value;
end;

end.