[英]How to change cell color in a TCalendar Component in Delphi?
I need to change the colour of some cell, in a TCalendar
component on an app that will work on Android and iOS. 我需要在适用于Android和iOS的应用程序上的TCalendar
组件中更改某些单元格的颜色。 I'm Using Delphi Seattle 10. Is there any way to do it? 我正在使用Delphi Seattle 10.有没有办法做到这一点?
This works under Delphi XE5. 这适用于Delphi XE5。 Unfortunateley, I do not have Delphi 10 to check the code. 不幸的是,我没有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;
And then create an instance of TMyCalendar class: 然后创建一个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;
APPENDED 附加
There is another way to get access to the private variable FDays that reperesents the list of days of the month. 还有另一种方法可以访问私有变量FDays,它可以重复出现该月的日期列表。 You declare a class helper
exposing it in the property Days
: 您声明一个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;
And then in the calss descendant you get control over this ListBox and its items using Days
property. 然后在calss后代中,您可以使用Days
属性控制此ListBox及其项目。
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)
APPENDED 2 There is a possibility to correct the way the days are drawn. 附录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;
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.