Delphi TCalendar 如何同时高亮多个不连续日期？

2026-11-04数据阿明

可以。对于 VCL 的 Vcl.Samples.Calendar.TCalendar，可以派生子类并重写 DrawCell，用独立的日期集合保存用户标记的日期。切换当前选中日期时，之前的标记仍会保留。

为什么要单独保存标记日期？

TCalendar 继承自 TCustomGrid，提供受保护的 DrawCell 绘制方法。它的 Day、Month、Year 表示日历的当前日期，不能直接保存任意多个日期的标记状态。TCalendar 官方说明、方法列表

实现时需要保存完整的年月日，并在单元格重绘时检查日期是否已标记。只改变一次 Canvas 颜色无法保存标记；窗口刷新后，需要根据保存的数据重新绘制。

派生组件并重写 DrawCell

下面的示例提供 ToggleDate 方法。第一次调用时添加标记，再次对同一日期调用时取消标记。已标记的日期以黄色背景和黑色文字显示。

日期转换使用公开的 CellText[ACol, ARow]：先读取单元格中的日号，再结合当前 Year、Month 构造完整日期。星期标题和空白单元格仍由原组件绘制。TCalendar 属性列表

新建一个单元，例如 MarkedCalendar.pas：

unit MarkedCalendar;

interface

uses
  System.SysUtils,
  System.Types,
  System.DateUtils,
  Vcl.Graphics,
  Vcl.Grids,
  Vcl.Samples.Calendar;

type
  TMarkedCalendar = class(Vcl.Samples.Calendar.TCalendar)
  private
    FMarkedDates: TArray<TDateTime>;
    function IsMarked(const ADate: TDateTime): Boolean;
  protected
    procedure DrawCell(ACol, ARow: Longint; ARect: TRect;
      AState: TGridDrawState); override;
  public
    procedure ToggleDate(const ADate: TDateTime);
  end;

implementation

function TMarkedCalendar.IsMarked(const ADate: TDateTime): Boolean;
var
  I: Integer;
begin
  for I := 0 to High(FMarkedDates) do
    if FMarkedDates[I] = DateOf(ADate) then
      Exit(True);
  Result := False;
end;

procedure TMarkedCalendar.ToggleDate(const ADate: TDateTime);
var
  I, N: Integer;
  D: TDateTime;
begin
  D := DateOf(ADate);
  N := Length(FMarkedDates);

  for I := 0 to N - 1 do
    if FMarkedDates[I] = D then
    begin
      FMarkedDates[I] := FMarkedDates[N - 1];
      SetLength(FMarkedDates, N - 1);
      Invalidate;
      Exit;
    end;

  SetLength(FMarkedDates, N + 1);
  FMarkedDates[N] := D;
  Invalidate;
end;

procedure TMarkedCalendar.DrawCell(ACol, ARow: Longint;
  ARect: TRect; AState: TGridDrawState);
var
  S: string;
  DayNumber: Integer;
  D: TDateTime;
  OldTextColor, OldBackColor: TColor;
  OldBrushStyle: TBrushStyle;
begin
  if gdFixed in AState then
  begin
    inherited;
    Exit;
  end;

  S := CellText[ACol, ARow];
  if not TryStrToInt(S, DayNumber) then
  begin
    inherited;
    Exit;
  end;

  if not TryEncodeDate(Year, Month, DayNumber, D) then
  begin
    inherited;
    Exit;
  end;

  if not IsMarked(D) then
  begin
    inherited;
    Exit;
  end;

  OldTextColor := Canvas.Font.Color;
  OldBackColor := Canvas.Brush.Color;
  OldBrushStyle := Canvas.Brush.Style;
  try
    Canvas.Font.Color := clBlack;
    Canvas.Brush.Color := clYellow;
    Canvas.Brush.Style := bsSolid;
    Canvas.FillRect(ARect);
    Canvas.TextRect(ARect,
      ARect.Left + (ARect.Right - ARect.Left - Canvas.TextWidth(S)) div 2,
      ARect.Top + (ARect.Bottom - ARect.Top - Canvas.TextHeight(S)) div 2,
      S);
  finally
    Canvas.Font.Color := OldTextColor;
    Canvas.Brush.Color := OldBackColor;
    Canvas.Brush.Style := OldBrushStyle;
  end;
end;

end.

代码在绘制后恢复画布颜色和画刷样式，避免影响后续单元格。DateOf 去掉时间部分，使同一天的不同时刻对应同一个标记。

如何让用户添加或取消标记？

可以让用户先选中日期，再点击标记按钮。在窗体单元的 uses 中加入 MarkedCalendar，并给窗体声明一个字段：

private
  FCalendar: TMarkedCalendar;

在窗体的 OnCreate 处理方法中创建组件：

procedure TForm1.FormCreate(Sender: TObject);
begin
  FCalendar := TMarkedCalendar.Create(Self);
  FCalendar.Parent := Self;
  FCalendar.SetBounds(16, 16, 280, 220);
  FCalendar.CalendarDate := Date;

  // Example: mark three non-contiguous dates.
  FCalendar.ToggleDate(Date);
  FCalendar.ToggleDate(Date + 3);
  FCalendar.ToggleDate(Date + 8);
end;

放置一个按钮，将其 OnClick 连接到下面的方法：

procedure TForm1.ButtonMarkClick(Sender: TObject);
begin
  FCalendar.ToggleDate(FCalendar.CalendarDate);
end;

用户选中日期后点击按钮，即可切换该日期的标记。组件由窗体持有，会随窗体一起释放。

使用时需要注意什么？

示例针对 VCL 的 Vcl.Samples.Calendar.TCalendar；FMX 的同名组件和 TMonthCalendar 使用不同的绘制机制。
必须实际创建 TMarkedCalendar。将现有 TCalendar 强制转换为子类，不会改变对象实际使用的绘制方法。
标记按完整日期保存，不同月份的同一个日号不会互相影响。切换月份后，只显示当前月份对应的标记。
示例中的标记颜色优先于当前选中单元格的填充颜色。如果需要明显区分当前选中日期，可以依据 gdSelected in AState 增加边框或使用另一组颜色。
需要结合应用的 VCL Style、深色主题和焦点显示检查颜色。示例未经过 Delphi 12.3 环境编译验证，接入时应以安装目录中的 Vcl.Samples.Calendar.pas 声明为准。