如何在Delphi中更改TCalendar组件中的单元格颜色? [英] How to change cell color in a TCalendar Component in Delphi?

问题描述

我需要在可在Android和iOS上运行的应用程序的 TCalendar 组件中更改某些单元格的颜色.我正在使用Delphi Seattle10.有什么方法可以做到?

I need to change the colour of some cell, in a TCalendar component on an app that will work on Android and iOS. I'm Using Delphi Seattle 10. Is there any way to do it?

推荐答案

这在Delphi XE5下有效.不幸的是，我没有Delphi 10来检查代码.

This works under Delphi XE5. Unfortunateley, I do not have Delphi 10 to check the code.

type
  TMyCalendar = class(TCalendar)
  private
    FSelectedDays: set of byte;
    procedure ApplyStyle; override;
  end;

...

{ TMyCalendar }

procedure TMyCalendar.ApplyStyle;
var
  i: word;
  LB: TListBox;
begin
  inherited;
  if FSelectedDays <> [] then
  begin
    LB := TListBox(TStyleObject(Children.Items[0]).Children.Items
      [TStyleObject(Children.Items[0]).Children.Count - 1]);
    for i := 0 to LB.Count - 1 do
      if (Assigned(LB.ItemByIndex(i))) and
        (StrToInt(LB.ItemByIndex(i).Text) in FSelectedDays) then
      begin
        LB.ItemByIndex(i).StyledSettings := LB.ItemByIndex(i).StyledSettings -
          [TStyledSetting.ssStyle];
        LB.ItemByIndex(i).Font.Style := LB.ItemByIndex(i).Font.Style +
          [TFontStyle.fsBold];
        With TRectangle.Create(LB.ItemByIndex(i)) do
        begin
          Parent := LB.ItemByIndex(i);
          Align := TAlignLayout.alClient;
          Fill.Color := TAlphaColorRec.Red;
          Opacity := 0.5;
        end;
      end;
  end;
end;

然后创建TMyCalendar类的实例:

And then create an instance of TMyCalendar class:

  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    MyCalendar: TMyCalendar;
  end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  MyCalendar := TMyCalendar.Create(Self);
  MyCalendar.Parent := Self;
  MyCalendar.Position.X := 1;
  MyCalendar.Position.Y := 1;
  MyCalendar.FSelectedDays := [9, 11]; // <-set other days here and check the month
end;

已添加

还有另一种访问私有变量FDays的方法，该变量代表月份中的天数列表.您可以在属性 Days :

There is another way to get access to the private variable FDays that reperesents the list of days of the month. You declare a class helper exposing it in the property Days:

  TMyCalendarHelper = class helper for TCalendar
    function GetDays: TListBox;
    procedure SetDays(const Value: TListBox);
    property Days: TListBox read GetDays write SetDays;
  end;

...

{ TMyCalendarHelper }

function TMyCalendarHelper.GetDays: TListBox;
begin
  result := Self.FDays;
end;

procedure TMyCalendarHelper.SetDays(const Value: TListBox);
begin
  Self.FDays := Value;
end;

然后在calss后代中使用 Days 属性来控制此ListBox及其项.

And then in the calss descendant you get control over this ListBox and its items using Days property.

procedure TMyCalendar.ApplyStyle;
var
  i: word;
//  LB: TListBox;//<-you do not need it any more
begin
  inherited;
  if FSelectedDays <> [] then
  begin
//    LB := TListBox(TStyleObject(Children.Items[0]).Children.Items//<-you do not need it
//      [TStyleObject(Children.Items[0]).Children.Count - 1]);//<-you do not need it
    for i := 0 to Days.Count - 1 do
      if (Assigned(Days.ItemByIndex(i))) and
        (StrToInt(Days.ItemByIndex(i).Text) in FSelectedDays) then
      begin
        Days.ItemByIndex(i).StyledSettings := Days.ItemByIndex(i).StyledSettings -
          [TStyledSetting.ssStyle];
        Days.ItemByIndex(i).Font.Style := Days.ItemByIndex(i).Font.Style +
          [TFontStyle.fsBold];
        //Do other things you want with Days.ItemByIndex(i)

附录2 有可能改正日期的绘制方式.

APPENDED 2 There is a possibility to correct the way the days are drawn.

  TMyCalendar = class(TCalendar)
  private
    FSelectedDays: set of byte;
    procedure PaintChildren; override;
  end;
procedure TMyCalendar.PaintChildren;
var
  i: word;
  TMPC: TAlphaColor;
  R: TRectF;
begin
  inherited;
  if FSelectedDays <> [] then
  begin
    for i := 0 to Days.Count - 1 do
      if (Assigned(Days.ItemByIndex(i))) and
        (StrToInt(Days.ItemByIndex(i).Text) in FSelectedDays) then
      begin
        TMPC := Days.ItemByIndex(i).Canvas.Fill.Color;
        R := Days.ItemByIndex(i).AbsoluteRect;
        R.Inflate(Position.X, Position.Y, -Position.X, -Position.Y);
        Days.ItemByIndex(i).Canvas.BeginScene;
        Days.ItemByIndex(i).Canvas.Fill.Color := TAlphaColorRec.Red;
        Days.ItemByIndex(i).Canvas.FillRect(R, 0, 0, [], 0.5);
        Days.ItemByIndex(i).Canvas.EndScene;
        Days.ItemByIndex(i).Canvas.Fill.Color := TMPC;
      end;
  end;
end; 

这篇关于如何在Delphi中更改TCalendar组件中的单元格颜色?的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！