[分享]日历控件**

alang

做日程、值班、排班之类的功能时，经常会用到日历控件，以下简单介绍TFECalendar
DisplayStyle 显示方式
CustomDayList 是自定义显示时的Caption，如果需要显示星期一，而不是Mon的话，就要用自定义显示了
CellCaptions 设置Caption的背景色、字体、对齐方式等
OnDrawCellProperties 可以自定义每一个格子的显示字符串ALabel，背景色、字体、对齐方式等
在OnClick事件中，可以调用一些函数得到当前点击单元的日期
以下是显示效果

alang

日历控件的属性
object FECalendar1: TFECalendar
  Left = 72
  Top = 120
  Width = 464
  Height = 288
  BorderStyle = bsNone
  Color = clWhite
  CellWeekDay.Alignment = taLeftJustify
  CellWeekDay.Font.Charset = GB2312_CHARSET
  CellWeekDay.Font.Color = clBlack
  CellWeekDay.Font.Height = -12
  CellWeekDay.Font.Name = #23435#20307
  CellWeekDay.Font.Style = []
  CellWeekDay.Color = clWhite
  CellWeekDay.ParentColor = True
  CellWeekDay.ParentFont = True
  CellWeekDay.ShadowColor = clGray
  CellWeekDay.ShadowDepth = 1
  CellWeekDay.CaptionStyle = csNone
  CellWeekDay.Layout = tlTop
  CellWeekEnd.Alignment = taLeftJustify
  CellWeekEnd.Font.Charset = GB2312_CHARSET
  CellWeekEnd.Font.Color = clBlack
  CellWeekEnd.Font.Height = -12
  CellWeekEnd.Font.Name = #23435#20307
  CellWeekEnd.Font.Style = []
  CellWeekEnd.Color = clWhite
  CellWeekEnd.ParentColor = True
  CellWeekEnd.ParentFont = True
  CellWeekEnd.ShadowColor = clGray
  CellWeekEnd.ShadowDepth = 1
  CellWeekEnd.CaptionStyle = csNone
  CellWeekEnd.Layout = tlTop
  CellSelected.Alignment = taLeftJustify
  CellSelected.Font.Charset = GB2312_CHARSET
  CellSelected.Font.Color = clWhite
  CellSelected.Font.Height = -12
  CellSelected.Font.Name = #23435#20307
  CellSelected.Font.Style = []
  CellSelected.Color = clNavy
  CellSelected.ParentColor = False
  CellSelected.ParentFont = False
  CellSelected.ShadowColor = clGray
  CellSelected.ShadowDepth = 1
  CellSelected.CaptionStyle = csNone
  CellSelected.Layout = tlTop
  CellNotInMonth.Alignment = taLeftJustify
  CellNotInMonth.Font.Charset = GB2312_CHARSET
  CellNotInMonth.Font.Color = clBlack
  CellNotInMonth.Font.Height = -12
  CellNotInMonth.Font.Name = #23435#20307
  CellNotInMonth.Font.Style = []
  CellNotInMonth.Color = clWhite
  CellNotInMonth.ParentColor = True
  CellNotInMonth.ParentFont = True
  CellNotInMonth.ShadowColor = clGray
  CellNotInMonth.ShadowDepth = 1
  CellNotInMonth.CaptionStyle = csNone
  CellNotInMonth.Layout = tlTop
  CellToday.Alignment = taLeftJustify
  CellToday.Font.Charset = GB2312_CHARSET
  CellToday.Font.Color = clBlack
  CellToday.Font.Height = -12
  CellToday.Font.Name = #23435#20307
  CellToday.Font.Style = []
  CellToday.Color = clWhite
  CellToday.ParentColor = True
  CellToday.ParentFont = True
  CellToday.ShadowColor = clGray
  CellToday.ShadowDepth = 1
  CellToday.CaptionStyle = csRaised
  CellToday.Layout = tlTop
  CellLines.Color = clBlack
  CellLines.Style = stSingle
  CellLines.Outline = True
  CustomDayList.Strings = (
    #26143#26399#19968
    #26143#26399#20108
    #26143#26399#19977
    #26143#26399#22235
    #26143#26399#20116
    #26143#26399#20845
    #26143#26399#26085)
  Date = 39448
  Day = 1
  DayOfWeek = Tuesday
  DrawCellItems = True
  Font.Charset = GB2312_CHARSET
  Font.Color = clBlack
  Font.Height = -12
  Font.Name = #23435#20307
  Font.Style = []
  Month = 1
  ParentColor = False
  ParentFont = False
  PrinterSettings.TitleAutoText = False
  PrinterSettings.TitleHeight = 250
  PrinterSettings.TitleAlignment = tgLeft
  PrinterSettings.TitleFont.Charset = GB2312_CHARSET
  PrinterSettings.TitleFont.Color = clWindowText
  PrinterSettings.TitleFont.Height = -21
  PrinterSettings.TitleFont.Name = 'Times New Roman'
  PrinterSettings.TitleFont.Style = []
  PrinterSettings.MarginLeft = 100
  PrinterSettings.MarginRight = 100
  PrinterSettings.MarginTop = 100
  PrinterSettings.MarginBottom = 100
  PrinterSettings.PaintBackground = False
  PrinterSettings.PaintCaptionBackground = True
  ReadOnly = True
  TabOrder = 0
  TabStop = True
  Year = 2008
  DisplayStyle = dsCustom
  CellCaptions.Alignment = taCenter
  CellCaptions.Font.Charset = GB2312_CHARSET
  CellCaptions.Font.Color = clWhite
  CellCaptions.Font.Height = -12
  CellCaptions.Font.Name = #23435#20307
  CellCaptions.Font.Style = [fsBold]
  CellCaptions.Color = clGreen
  CellCaptions.ParentColor = False
  CellCaptions.ParentFont = False
  CellCaptions.ShadowColor = clGray
  CellCaptions.ShadowDepth = 1
  CellCaptions.CaptionStyle = csNone
  CellCaptions.Layout = tlCenter
  CellCaptions.NumLetters = 30
  CellCaptions.LinesVisible = False
  CellCaptions.Visible = True
  OnClick = FECalendar1Click
  OnDrawCellProperties = FECalendar1DrawCellProperties
end

alang

为每一个格子定义显示的内容和格式等
procedure TMainForm.FECalendar1DrawCellProperties(Sender: TObject; ADate: Double; AState: TFECalCellStates; var ALabel: string; CellProperties: TFECellProperties);
begin
  CellProperties.Layout := TTextLayout.tlCenter;
  CellProperties.Alignment := TAlignment.taCenter;
  CellProperties.CaptionStyle := TFECapStyle.csNone;
  if TFECalCellState.csCaption in AState then
  else if (TFECalCellState.csNotInMonth in AState) or (TFECalCellState.csWeekEnd in AState) then
  begin
    CellProperties.Color := Graphics.clGray;
    CellProperties.Font.Color := Graphics.clBlack;
  end
  else begin
    CellProperties.Color := Graphics.clInfoBk;
    CellProperties.Font.Color := Graphics.clBlue;
  end;
  //这个ALabel就是需要显示的内容了
  if TFECalCellState.csNormal in AState then
    ALabel := SysUtils.IntToStr(DateUtils.DayOf(ADate))+'日'+#13#10+GetLabelStr(ADate);
end;

alang

点击事件中获得当前点击的日期
procedure TMainForm.FECalendar1Click(Sender: TObject);
var
  p: TPoint;
  lDate: TDateTime;
begin
  //得到当前鼠标的位置
  if not Borland.Delphi.Windows.GetCursorPos(p) then Exit;

  //把鼠标位置转换成在控件中的位置
  p := FECalendar1.ScreenToClient(p);
  //FECalendar1.GetXCol(p.X);    鼠标位置的p.x对应的列
  //FECalendar1.GetYRow(p.Y);  鼠标位置的p.y对应的行
  //FECalendar1.GetCellDate      获得对应行和列的日期，如果没有日期则返回1899-12-30
  lDate := FECalendar1.GetCellDate(FECalendar1.GetXCol(p.X), FECalendar1.GetYRow(p.Y));
  Dialogs.Showmessage(SysUtils.DateToStr(lDate));
end;

alang

用以下代码截获OnDrawCellProperties事件的结果，便于更好的理解这个事件的每一个参数
function GetStateStr(AState: TFECalCellStates): String;
begin
  Result := '';
  if TFECalCellState.csCaption in AState then
    Result := Result + ',csCaption';
  if TFECalCellState.csFocused in AState then
    Result := Result + ',csFocused';
  if TFECalCellState.csNormal in AState then
    Result := Result + ',csNormal';
  if TFECalCellState.csNotInMonth in AState then
    Result := Result + ',csNotInMonth';
  if TFECalCellState.csSelected in AState then
    Result := Result + ',csSelected';
  if TFECalCellState.csSpecial in AState then
    Result := Result + ',csSpecial';
  if TFECalCellState.csToday in AState then
    Result := Result + ',csToday';
  if TFECalCellState.csWeekEnd in AState then
    Result := Result + ',csWeekEnd';
  Result := StringUtils.Copy(Result, 2, 1000);
end;

procedure TMainForm.FECalendar1DrawCellProperties(Sender: TObject; ADate: Double; AState: TFECalCellStates; var ALabel: string; CellProperties: TFECellProperties);
begin
  AddLog(SysUtils.DateToStr(ADate)+#9+ALabel+#9+GetStateStr(AState));
end;

2008年7月22日运行的结果
运行结果
1899-12-30        星期一        csCaption
1899-12-30        星期二        csCaption
1899-12-30        星期三        csCaption
1899-12-30        星期四        csCaption
1899-12-30        星期五        csCaption
1899-12-30        星期六        csCaption
1899-12-30        星期日        csCaption
1899-12-30                csNotInMonth
1899-12-30                csNotInMonth
2008-7-1        1        csFocused,csNormal,csSelected
2008-7-2        2        csNormal
2008-7-3        3        csNormal
2008-7-4        4        csNormal
2008-7-5        5        csNormal,csWeekEnd
2008-7-6        6        csNormal,csWeekEnd
2008-7-7        7        csNormal
2008-7-8        8        csNormal
2008-7-9        9        csNormal
2008-7-10        10        csNormal
2008-7-11        11        csNormal
2008-7-12        12        csNormal,csWeekEnd
2008-7-13        13        csNormal,csWeekEnd
2008-7-14        14        csNormal
2008-7-15        15        csNormal
2008-7-16        16        csNormal
2008-7-17        17        csNormal
2008-7-18        18        csNormal
2008-7-19        19        csNormal,csWeekEnd
2008-7-20        20        csNormal,csWeekEnd
2008-7-21        21        csNormal
2008-7-22        22        csNormal,csToday
2008-7-23        23        csNormal
2008-7-24        24        csNormal
2008-7-25        25        csNormal
2008-7-26        26        csNormal,csWeekEnd
2008-7-27        27        csNormal,csWeekEnd
2008-7-28        28        csNormal
2008-7-29        29        csNormal
2008-7-30        30        csNormal
2008-7-31        31        csNormal
1899-12-30                csNotInMonth
1899-12-30                csNotInMonth
1899-12-30                csNotInMonth
1899-12-30                csNotInMonth
1899-12-30                csNotInMonth
1899-12-30                csNotInMonth
1899-12-30                csNotInMonth
1899-12-30                csNotInMonth
1899-12-30                csNotInMonth