umonthpanel.pas

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

unit uMonthPanel;
{$R *.res}

interface

uses
  StdCtrls,SysUtils,Controls,ExtCtrls,Graphics,Grids,Classes,
  Messages,Windows,DateUtils,Menus,Buttons;

CONST
  SOLAR_TERM: Array[0..23] of string =('小寒','大寒','立春','雨水','惊蛰','春分',
    '清明','谷雨','立夏','小满','芒种','夏至','小暑',
    '大暑','立秋','处暑','白露','秋分','寒露','霜降','立冬','小雪','大雪','冬至');

  //国历节日 *表示放假日
  SUNHOLIDY: Array[0..40] of string =(
  '0101*元旦节',
  '0214 情人节',
  '0305 学雷锋纪念日',
  '0308 妇女节',
  '0312 植树节',
  '0315 消费者权益日',
  '0401 愚人节',
  '0407 世界卫生日',
  '0422 世界地球日',
  '0501*劳动节',
  '0504 青年节',
  '0508 世界红十字日',
  '0512 国际护士节',
  '0515 国际家庭日',
  '0517 国际电信日',
  '0601 国际儿童节',
  '0605 世界环境保护日',
  '0606 全国爱眼日',
  '0625 全国土地日',
  '0626 国际禁毒日',
  '0701 香港回归纪念日 中共诞辰',
  '0707 抗日战争纪念日',
  '0801 建军节',
  '0815 抗日战争胜利纪念',
  '0909 毛泽东逝世纪念',
  '0908 国际扫盲日',
  '0910 中国教师节', 
  '0927 世界旅游日',
  '0928 孔子诞辰',
  '1001*国庆节',
  '1006 老人节',
  '1009 世界邮政日',
  '1014 世界标准日',
  '1016 世界粮食日',
  '1024 联合国日',
  '1120*彝族年',
  '1112 孙中山诞辰纪念',
  '1205 国际志愿人员日',
  '1220 澳门回归纪念',
  '1225 Christmas Day',
  '1226 毛泽东诞辰纪念');

  //农历节日 *表示放假日
  MONTHHOLIDY: Array[0..10] of string =(
  '0101*春节',
  '0115 元宵节',
  '0505 端午节',
  '0624*火把节',
  '0707 七夕情人节',
  '0715 中元节',
  '0815 中秋节',
  '0909 重阳节',
  '1208 腊八节',
  '1224 小年',
  '0100 除夕');

  //某月的第几个星期几
  WEEKHOLIDY: Array[0..3] of string =(
  '0520 母亲节',
  '0630 父亲节',
  '0730 被奴役国家周',
  '1144 Thanksgiving感恩节') ;

  CHWEEKSTRING: array[0..6] of string =('星期一','星期二','星期三','星期四','星期五','星期六','星期日');
  WM_MONTHPANELRESIZE = WM_USER + 1;
  MP_MINWIDTH = 359;
  MP_MINHEIGHT = 137;
  CALENDARSPLITE = '-';
type
  {
    dsNormal:工作日，包括周末的工作日
    dsHoliday:节假日，包括周末的节假日
    dsWeekend:正常周末
  }
  TDaySign = (dsNormal,dsHoliday,dsWeekend);

  TOnDaySignChangedEvent = procedure (Sender: TObject; ChangedDate:TDate;ToSign:TDaySign) of object;
  TOnDaysSignChangedEvent = procedure (Sender: TObject; ChangeCellRange:TGridRect;ToSign:TDaySign) of object;

  TMonthPanel = class(TPanel)
  private

    FWeekendCaptionColor: TColor;
    FWeekendColor: TColor;
    FWeekendTextColor: TColor;
    FNormalColor: TColor;
    FNormalTextColor: TColor;
    FHolidayTextColor: TColor;
    FHolidayColor: TColor;
    FChineseNewYear:TDate;

    FGridPopupMenu: TPopupMenu;

    FRedrawing:Boolean;
    FDaysInMonth:Integer;

    FMonthPanelDate: TDate;
    FDaySigns : array[1..31] of TDaySign;
    FDayInfors : array[1..31] of string;
    FCellDays : array [0..6,1..6] of TDate;  //根据格子找到代表的日期
    FDayCells : array [1..31] of TGridCoord; //根据日子找到格子

    FOnDaySignChanged: TOnDaySignChangedEvent;
    FDispalyChineseDay: Boolean;
    FOnDaysSignChanged: TOnDaysSignChangedEvent;
    FGregorianCalendarFont: TFont;
    FLunarCalendarFont: TFont;
    FShowMonthChangeButton: Boolean;

    procedure ClearCellDays;
    procedure ClearDayCells;
    procedure SelfResize(Sender: TObject);
    procedure DoWM_Resize(var Msg: TMessage); message WM_MONTHPANELRESIZE;
    procedure MonthGridDrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure MonthGridMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure MonthGridDblClick(Sender: TObject);

    procedure SelectedRangeToSign(ToSign:TDaySign);
    procedure ToHolidayPopupMenuClicked(Sender: TObject);
    procedure ToNormalDayPopupMenuClicked(Sender: TObject);

    procedure ToNormalWeekEndPopupMenuClicked(Sender: TObject);

    procedure DisplayCDPopupMenuClicked(Sender: TObject);

    procedure OnPriClick(Sender: TObject);
    procedure OnNexClick(Sender: TObject);

    procedure SetMonthCaptionHeight(const Value: Integer);
    procedure SetColWidth(const Value: Integer);
    procedure SetRowHeight(const Value: Integer);
    procedure SetWeekendCaptionColor(const Value: TColor);
    procedure SetWeekendColor(const Value: TColor);
    procedure SetWeekendTextColor(const Value: TColor);
    procedure SetNormalColor(const Value: TColor);
    procedure SetNormalTextColor(const Value: TColor);
    procedure SetHolidayColor(const Value: TColor);
    procedure SetHolidayTextColor(const Value: TColor);
    function GetMonthCaptionHeight: Integer;
    function GetRowHeight: Integer;
    function GetColWidth: Integer;
    function GetMonthCaptionColor: TColor;
    procedure SetMonthCaptionColor(const Value: TColor);
    function GetMonthCaptionFont: TFont;
    procedure SetMonthCaptionFont(const Value: TFont);
    procedure SetOnCaptionDBClick(const Value: TNotifyEvent);
    function GetCaptionPopUpMenu: TPopupMenu;
    procedure SetCaptionPopUpMenu(const Value: TPopupMenu);
    function GetCaptionMouseMove: TMouseMoveEvent;
    procedure SetCaptionMouseMove(const Value: TMouseMoveEvent);
    function GetOnCaptionDBClick: TNotifyEvent;
    function GetOnCaptionMouseDown: TMouseEvent;
    function GetOnCaptionMouseUp: TMouseEvent;
    procedure SetOnCaptionMouseDown(const Value: TMouseEvent);
    procedure SetOnCaptionMouseUp(const Value: TMouseEvent);
    procedure SetMonthPanelDate(const Value: TDate);
    procedure SetDispalyChineseDay(const Value: Boolean);

    {刷新grid显示，返回最后一周在本月周数}
    function RefreshMonthGrid:Integer;
    procedure SetCalendarLunarFont(const Value: TFont);
    procedure SetGregorianCalendarFont(const Value: TFont);
    procedure SetMonthChangeButton(const Value: Boolean);
  protected
    FMonthGrid:TStringGrid;
    FMonthCaptionPanel:TPanel;
    FLeftCaption:TLabel;

    FPriMonth:TSpeedButton;
    FNexMonth:TSpeedButton;

    //根据设定的各种尺寸大小重新摆放控件的位置以及设定大小
    procedure ReDrawPanel(ResizeSelf:Boolean = True);
    procedure PreparePopMenu;
  public
    constructor Create(AOwner: TComponent);override;
    destructor Destroy;override;

    {设置当月每一天为非节假日}
    procedure ClearDaySigns;

    {清空当月每一天说明文字}
    procedure ClearDayInfors;

    procedure SetDaySign(DayIndex:Integer;DaySign:TDaySign);
    procedure SetDayInfor(DayIndex:Integer;DayInfor:string);

    function DaySigns(DayIndex:Integer) : TDaySign;
    function DayInfors(DayIndex:Integer) : string;
    function CellDay(ACellCoord:TGridCoord):TDate;  //根据格子找到代表的日期
    function DayCell(DayIndex:Integer) :TGridCoord; //根据日子找到格子

  published
    property ShowMonthChangeButton:Boolean read FShowMonthChangeButton
      write SetMonthChangeButton;

    property GregorianCalendarFont:TFont read FGregorianCalendarFont
      write SetGregorianCalendarFont;

    property LunarCalendarFont:TFont read FLunarCalendarFont
      write SetCalendarLunarFont;

    property MonthCaptionHeight:Integer read GetMonthCaptionHeight
      write SetMonthCaptionHeight default 20;

    property MonthCaptionColor:TColor read GetMonthCaptionColor
      write SetMonthCaptionColor default clBackground;

    property MonthCaptionFont:TFont read GetMonthCaptionFont
      write SetMonthCaptionFont;

    property ColWidth:Integer read GetColWidth write SetColWidth default 50;
    property RowHeight:Integer read GetRowHeight write SetRowHeight default 16;
    property WeekendCaptionColor:TColor read FWeekendCaptionColor
      write SetWeekendCaptionColor default clBlue;

    property WeekendColor:TColor read FWeekendColor
      write SetWeekendColor default clBlue;

    property WeekendTextColor:TColor read FWeekendTextColor
      write SetWeekendTextColor default clRed;

    property NormalColor:TColor read FNormalColor
      write SetNormalColor default clWindow;

    property NormalTextColor:TColor read FNormalTextColor
      write SetNormalTextColor default clWindowText;

    property HolidayColor:TColor read FHolidayColor
      write SetHolidayColor default clGreen;

    property HolidayTextColor:TColor read FHolidayTextColor
      write SetHolidayTextColor default clBlue;

    {MonthPanel所显示的年月}
    property MonthPanelDate :TDate read FMonthPanelDate Write SetMonthPanelDate;

    property OnDaySignChanged:TOnDaySignChangedEvent read FOnDaySignChanged write FOnDaySignChanged;
    property OnDaysSignChanged:TOnDaysSignChangedEvent read FOnDaysSignChanged write FOnDaysSignChanged;

    property OnCaptionDBClick: TNotifyEvent read GetOnCaptionDBClick write SetOnCaptionDBClick;
    property OnCaptionMouseMove: TMouseMoveEvent read GetCaptionMouseMove write SetCaptionMouseMove;
    property OnCaptionMouseDown: TMouseEvent read GetOnCaptionMouseDown write SetOnCaptionMouseDown;
    property OnCaptionMouseUp: TMouseEvent read GetOnCaptionMouseUp write SetOnCaptionMouseUp ;

    property CaptionPopUpMenu: TPopupMenu read GetCaptionPopUpMenu write SetCaptionPopUpMenu;

    property DispalyChineseDay:Boolean read FDispalyChineseDay write SetDispalyChineseDay;
  end;

procedure Register;

implementation

uses uMoon,StrUtils;

procedure Register;
begin
  RegisterComponents('GiSun', [TMonthPanel]);
end;

function GetFontStringSize(Font:TFont;Caption:string):Integer;
var
  SizeLabel:TLabel;
begin
  SizeLabel := Tlabel.Create(nil);
  try
    SizeLabel.Font.Assign(Font);
    SizeLabel.AutoSize := True;
    SizeLabel.Caption := Caption;
    Result := SizeLabel.Width;
  finally
    SizeLabel.Free;
  end;
end;

{ TMonthPanel }

constructor TMonthPanel.Create(AOwner: TComponent);
var
  i:Integer;
begin
  inherited;

  FShowMonthChangeButton := False;
  
  FLunarCalendarFont := TFont.Create;
  FGregorianCalendarFont := TFont.Create;

  Self.ParentCtl3D := False;
  Self.ParentFont := False;
  Self.Font.Name := '宋体';
  Self.Font.Height := -12;
  Self.Font.Charset := GB2312_CHARSET;
  
  FGregorianCalendarFont.Assign(Self.Font);
  FGregorianCalendarFont.Name := '宋体';
  FLunarCalendarFont.Assign(Self.Font);
  FLunarCalendarFont.Name := '楷体_GB2312';
  FLunarCalendarFont.Size := FGregorianCalendarFont.Size-1;

  FDispalyChineseDay := False;
  FRedrawing := False;
  FWeekendColor := clBlue;
  FHolidayTextColor := clBlue;
  FHolidayColor := clMoneyGreen;
  FNormalColor := clWindow;
  FNormalTextColor := clWindowText;

  FGridPopupMenu := TPopupMenu.Create(Self);
  FMonthGrid := TStringGrid.Create(Self);

  FMonthCaptionPanel := TPanel.Create(Self);
  FLeftCaption := TLabel.Create(Self);
  FLeftCaption.Parent := FMonthCaptionPanel;
  FLeftCaption.Align := alLeft;

  FPriMonth := TSpeedButton.Create(Self);
  FNexMonth := TSpeedButton.Create(Self);
  FPriMonth.Width := 15;
  FNexMonth.Width := 15;
  FPriMonth.Height := 15;
  FNexMonth.Height := 15;
  FPriMonth.Caption := '<';
  FNexMonth.Caption := '>';
  FPriMonth.OnClick := OnPriClick;
  FNexMonth.OnClick := OnNexClick;
  FPriMonth.Parent := FMonthCaptionPanel;
  FNexMonth.Parent := FMonthCaptionPanel;
  
  FPriMonth.Visible := False;
  FNexMonth.Visible := False;
  
  FMonthCaptionPanel.Color := clTeal;
  FMonthCaptionPanel.Alignment := taRightJustify;
  FMonthCaptionPanel.Font.Name := '宋体';
  FMonthCaptionPanel.Font.Size := -9;
  FMonthCaptionPanel.Font.Color := clYellow;
  FMonthCaptionPanel.Font.Style := FMonthCaptionPanel.Font.Style + [fsBold];
  Self.Ctl3D := False;
  FMonthGrid.Ctl3D := False;
  FMonthCaptionPanel.Ctl3D := False;

  FMonthGrid.Parent := Self;
  FMonthCaptionPanel.Parent := Self;

  FMonthGrid.FixedRows := 1;
  FMonthGrid.FixedCols := 0;
  FMonthGrid.ColCount := 7;
  FMonthGrid.RowCount := 7;

  for i := 0 to 6 do
  begin
    FMonthGrid.Cells[i,0] := CHWEEKSTRING[i];
  end;

  ClearDaySigns;
  ClearDayInfors;

  FMonthCaptionPanel.Left := 0;
  FMonthCaptionPanel.Top := 0;
  FMonthCaptionPanel.Height := 17;

  FMonthGrid.Left := 0;
  FMonthGrid.DefaultColWidth := 50;
  FMonthGrid.DefaultRowHeight := 16;
  FWeekendCaptionColor := clBlue;
  FWeekendTextColor := clRed;
  FWeekendColor := clWindow;

  ReDrawPanel;

  PreparePopMenu;

  FMonthGrid.PopupMenu := FGridPopupMenu;
  FMonthGrid.OnDrawCell := MonthGridDrawCell;
  FMonthGrid.OnMouseMove := MonthGridMouseMove;
  FMonthGrid.OnDblClick := MonthGridDblClick;

  Self.OnResize := SelfResize;

end;

destructor TMonthPanel.Destroy;
begin

  FPriMonth.Free;
  FNexMonth.Free;