有没有办法突出显示TCalendar中的单元格？ [英] is there a way to highlight cell/s in a TCalendar?

问题描述

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

I know there's a way to highlight a cell in a TStringGrid. I could use that, but inputting the dates and days and months would be a big issue unless you know how to do that.

推荐答案

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

Yes, this is easy if you only make a small modification to the control's source code. Specifically, we need to add a small amount of code to its DrawCell method.

最初，这是

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;

快速尝试此操作的最简单方法是使用中介层：

The easiest way to quickly try this is to use an interposer class:

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

  TForm1 = class(TForm)
    ...

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

Now you only need to supply an array of dates to highlight:

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及更高版本）中，

or, in new Delphi versions (XE7 and later),

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

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

Don't forget to add DateUtils to the uses clause.

（我为瑞典的日名表示歉意。）

(I apologise for the Swedish day names.)

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

Needless to say, you can paint highlighted cells in any way you like; making the font bold is only one possibility. If instead you want to highlight a cell by drawing a benzene ring in its top-right corner, that's fine too.

您将要使用新代码创建一个新控件。在这种情况下，日期数组将成为成员。它可能具有与setter关联的属性，该属性也会使控件无效。此外，您可以添加公共 HighlightDate（const ADate：TDate）和 StopHighlightDate（const ADate：TDate）公用程序在此数组中添加和删除日期（并使控件无效）。

You will want to create a new control with the new code. In this, the date array would be a member. It could have an associated property with a setter that also invalidates the control. In addition, you could add public HighlightDate(const ADate: TDate) and StopHighlightDate(const ADate: TDate) procedures that add and remove dates from this array (and invalidate the control).

根据请求（请参见注释），这是如何更改突出显示的单元格的背景色：

On request (see comments), here is how to change the background colour of highlighted cells:

{ 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;

这篇关于有没有办法突出显示TCalendar中的单元格？的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！