Как изменить цвет ячейки в компоненте TCalendar в Delphi?

Мне нужно изменить цвет некоторой ячейки в компоненте TCalendar в приложении, которое будет работать на Android и iOS. Я использую Delphi Seattle 10. Есть ли способ сделать это?


person elcharlie    schedule 10.11.2015    source источник


Ответы (1)


Это работает под Delphi XE5. К сожалению, у меня нет Delphi 10, чтобы проверить код.

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:

  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, представляющей список дней месяца. Вы объявляете class helper, раскрывая его в свойстве 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;

И затем в потомке класса вы получаете контроль над этим ListBox и его элементами, используя свойство Days.

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 Существует возможность исправить способ рисования дней.

  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; 
person asd-tm    schedule 10.11.2015
comment
@elcharlie Я добавил еще один способ доступа к частной переменной FDays. - person asd-tm; 11.11.2015
comment
к сожалению, в Delphi Seattle у меня не работает, показывая мне календарь не показывает ячейки по дням :( - person elcharlie; 11.11.2015
comment
@elcharlie Уточните пожалуйста, что именно не работает. Способны ли вы получить контроль над Days.ItemByIndex(i)? Assigned(Days)=true? - person asd-tm; 11.11.2015
comment
Извините, в delphi 10 нет свойства под названием FDays в объекте TCalendar. - person elcharlie; 11.11.2015
comment
Наконец, я заставил это работать. В конце я сделал, как вы сказали в начале, с вспомогательным классом, который я не смог сделать. Большое спасибо вам за все. - person elcharlie; 11.11.2015
comment
@elcharlie Добро пожаловать, смотрите третье редактирование моего ответа. Есть еще один способ отметить дни, переопределив метод PaintChildren. Я обнаружил, что у него есть некоторые преимущества перед методом с созданием TRectangle. Вам не нужно будет добавлять дополнительный код для обработки кликов/нажатий. - person asd-tm; 11.11.2015