有没有办法突出显示日历中的单元格？

Question

我知道有一种方法可以突出显示TStringGrid 中的单元格。我可以使用它，但输入日期、日期和月份将是一个大问题，除非您知道该怎么做。

Answer 1

是的，如果您只对控件的源代码进行少量修改，这很容易。具体来说，我们需要在其DrawCell方法中添加少量代码。

最初，这是

procedure TCalendar.DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState);
var
  TheText: string;
begin
  TheText := CellText[ACol, ARow];
  with ARect, Canvas do
    TextRect(ARect, Left + (Right - Left - TextWidth(TheText)) div 2,
      Top + (Bottom - Top - TextHeight(TheText)) div 2, TheText);
end;

将其更改为：

procedure TCalendar.DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState);
var
  TheText: string;
  i: Integer;
  Day: Integer;
begin
  TheText := CellText[ACol, ARow];
  with ARect, Canvas do
  begin
    Font.Style := [];
    for i := Low(HighlightDates) to High(HighlightDates) do
      if TryStrToInt(TheText, Day) then
        if SameDate(HighlightDates[i], EncodeDate(Year, Month, Day)) then
        begin
          Font.Style := [fsBold];
          Break;
        end;
    TextRect(ARect, Left + (Right - Left - TextWidth(TheText)) div 2,
      Top + (Bottom - Top - TextHeight(TheText)) div 2, TheText);
  end;
end;

快速尝试此操作的最简单方法是使用插入器类：

type
  TCalendar = class(Vcl.Samples.Calendar.TCalendar)
    procedure DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState); override;
  end;

  TForm1 = class(TForm)
    ...

现在您只需要提供一组日期来突出显示：

var
  HighlightDates: TArray<TDate>;

procedure TForm1.FormCreate(Sender: TObject);
begin
  SetLength(HighlightDates, 3);
  HighlightDates[0] := EncodeDate(2020, 07, 10);
  HighlightDates[1] := EncodeDate(2020, 07, 20);
  HighlightDates[2] := EncodeDate(2020, 08, 10);
end;

或者，在新的 Delphi 版本（XE7 及更高版本）中，

procedure TForm1.FormCreate(Sender: TObject);
begin
  HighlightDates :=
    [
      EncodeDate(2020, 07, 10),
      EncodeDate(2020, 07, 20),
      EncodeDate(2020, 08, 10)
    ];
end;

不要忘记将DateUtils 添加到uses 子句中。

（我为瑞典的日子名称道歉。）

不用说，您可以以任何您喜欢的方式绘制突出显示的单元格；使字体加粗只是一种可能性。相反，如果您想通过在右上角绘制苯环来突出显示单元格，那也可以。

您将希望使用新代码创建一个新控件。在这种情况下，日期数组将是一个成员。它可能具有与设置器相关联的属性，该设置器也使控件无效。此外，您可以添加公共的HighlightDate(const ADate: TDate) 和StopHighlightDate(const ADate: TDate) 过程，在该数组中添加和删除日期（并使控件无效）。

更新

根据要求（参见 cmets），以下是如何更改突出显示的单元格的背景颜色：

{ TCalendar }

procedure TCalendar.DrawCell(ACol, ARow: Longint; ARect: TRect;
  AState: TGridDrawState);
var
  TheText: string;
  i: Integer;
  Day: Integer;
  OldColor: TColor;
begin
  TheText := CellText[ACol, ARow];
  with ARect, Canvas do
  begin
    OldColor := Brush.Color;
    for i := Low(HighlightDates) to High(HighlightDates) do
      if TryStrToInt(TheText, Day) then
        if SameDate(HighlightDates[i], EncodeDate(Year, Month, Day)) then
        begin
          Brush.Color := clSkyBlue;
          FillRect(ARect);
          Break;
        end;
    TextRect(ARect, Left + (Right - Left - TextWidth(TheText)) div 2,
      Top + (Bottom - Top - TextHeight(TheText)) div 2, TheText);
    Brush.Color := OldColor;
  end;
end;