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