pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

tvplanit: Refactor TVpCalendar.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8450 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2022-09-05 15:14:18 +00:00
parent eb439247e1
commit 6eda0b879b
2 changed files with 244 additions and 277 deletions
Download Patch File Download Diff File Expand all files Collapse all files

111
components/tvplanit/source/vpcalendarpainter.pas
View File

@@ -5,7 +5,7 @@ unit VpCalendarPainter;
interface
uses
SysUtils, Classes, Graphics,
SysUtils, Classes, Graphics, Controls,
VpBase, VpMisc, VpBasePainter, VpCalendar;
type
@@ -13,8 +13,6 @@ type
private
FCalendar: TVpCustomCalendar;
// local variables of the old RenderToCanvas method of TVpCalendar
// R, C: Integer;
// I: Integer;
SatCol: Integer;
SunCol: Integer;
DOW: TVpDayType;
@@ -23,6 +21,9 @@ type
lDate: TDateTime;
BevelHighlight: TColor;
BevelShadow: TColor;
ActiveDayColor: TColor;
ActiveDayBorderColor: TColor;
ActiveDayTextColor: TColor;
InactiveDayColor: TColor;
MonthYearColor: TColor;
DayNameColor: TColor;
@@ -53,7 +54,7 @@ type
implementation
uses
LCLProc, LazUtf8,
LCLProc, LCLIntf, LazUtf8,
{%H-}VpConst, VpCanvasUtils;
type
@@ -66,6 +67,9 @@ begin
FCalendar := ACalendar;
end;
{ Draws the day numbers in the calendar. Colors are used to distinguish
normal days, weekend days, event days, inactive days (= overflow from adjacent
months). }
procedure TVpCalendarPainter.DrawAllDays;
var
I, R, C: Integer;
@@ -74,7 +78,7 @@ begin
for R := 2 to 8 do
for C := 0 to 6 do begin
if ((C = SatCol) and (cdoHighlightSat in FCalendar.Options)) or
((C = SunCol) and (cdoHighlightSun in Fcalendar.Options))
((C = SunCol) and (cdoHighlightSun in FCalendar.Options))
then
RenderCanvas.Font.Color := WeekendColor
else
@@ -108,12 +112,14 @@ begin
end else
RenderCanvas.Font.Style := RenderCanvas.Font.Style - [fsBold, fsUnderline];
end;
with TVpCalendarOpener(FCalendar) do
DrawDay(R, C, I, (I < clFirst) or (I > clLast));
Inc(I);
end;
end;
{ Draws the title "month year" between the navigation buttons }
procedure TVpCalendarPainter.DrawDate;
var
R: TRect;
@@ -141,9 +147,9 @@ begin
else
S := FormatDateTime('mmm', RenderDate);
// switch to short date format if string won't fit
// Switch to short date format if string won't fit
if FCalendar.DateFormat = dfLong then
if RenderCanvas.TextWidth(S) > R.Right - R.Left then
if RenderCanvas.TextWidth(S) > WidthOf(R) then
S := FormatDateTime('mmm yyyy', RenderDate);
{$IF FPC_FULLVERSION < 30000}
@@ -159,14 +165,15 @@ end;
procedure TVpCalendarPainter.DrawDay(R, C, I: Integer; Grayed: Boolean);
var
Cl: TColor;
clr: TColor;
day: Byte;
OldIdx: Integer;
NewIdx: Integer;
S: string[10];
DrawRect: TRect;
TH: Integer;
begin
{avoid painting day number under buttons}
// Avoid painting day number under buttons
if cdoShowRevert in FCalendar.Options then
if (R = 8) and (C >= 3) then
Exit;
@@ -175,19 +182,23 @@ begin
Exit;
{convert to a string and draw it centered in its rectangle}
S := IntToStr(TVpCalendarOpener(FCalendar).clCalendar[I]);
day := TVpCalendarOpener(FCalendar).clCalendar[I];
S := IntToStr(day);
if Grayed then
RenderCanvas.Font.Color := InactiveDayColor;
RenderCanvas.Font.Color := InactiveDayColor
else
if (day = FCalendar.Day) then
RenderCanvas.Font.Color := ActiveDayTextColor;
if not Grayed or (cdoShowInactive in FCalendar.Options) then begin
NewIdx := ((R-2) * 7) + Succ(C);
with TVpCalendarOpener(FCalendar) do
OldIdx := clFirst + Pred(clDay);
if Assigned(FCalendar.OnGetHighlight) then begin
Cl := RenderCanvas.Font.Color;
FCalendar.OnGetHighlight(Self, RenderDate + NewIdx - OldIdx , Cl);
RenderCanvas.Font.Color := Cl;
clr := RenderCanvas.Font.Color;
FCalendar.OnGetHighlight(Self, RenderDate + NewIdx - OldIdx , clr);
RenderCanvas.Font.Color := clr;
end;
with TVpCalendarOpener(FCalendar) do
if Assigned(OnDrawItem) then
@@ -198,19 +209,19 @@ begin
OffsetRect(DrawRect, RealLeft, RealTop);
TH := RenderCanvas.TextHeight(S);
if TH < DrawRect.Bottom - DrawRect.Top then
DrawRect.Top := DrawRect.Top + ((DrawRect.Bottom - DrawRect.Top) - TH) div 2;
DrawRect.Top := (DrawRect.Top + DrawRect.Bottom - TH) div 2;
TPSCenteredTextOut(RenderCanvas, Angle, RenderIn, DrawRect, S);
end;
end;
end;
{ Draw the day name column labels }
procedure TVpCalendarPainter.DrawDayNames;
var
I: Integer;
S: string;
DrawRect: TRect;
begin
{draw the day name column labels}
RenderCanvas.Font.Color := DayNameColor;
I := 0;
DOW := FCalendar.WeekStarts;
@@ -262,6 +273,7 @@ begin
if DisplayOnly then begin
BevelHighlight := clBlack;
BevelShadow := clBlack;
ActiveDayColor := clBlack;
InactiveDayColor := clSilver;
MonthYearColor := clBlack;
DayNameColor := clBlack;
@@ -273,56 +285,29 @@ begin
end else begin
BevelHighlight := clBtnHighlight;
BevelShadow := clBtnShadow;
ActiveDayColor := FCalendar.Colors.ActiveDay;
ActiveDayBorderColor := FCalendar.Colors.ActiveDayBorder;
ActiveDayTextColor := FCalendar.Colors.ActiveDayText;
InactiveDayColor := FCalendar.Colors.InactiveDays;
MonthYearColor := FCalendar.Colors.MonthAndYear;
DayNameColor := FCalendar.Colors.DayNames;
LineColor := FCalendar.Font.Color;
EventDayColor := FCalendar.Colors.EventDays;
DayColor := FCalendar.Colors.Days;
RealColor := FCalendar.Color;
RealColor := FCalendar.Colors.Background;
WeekendColor := FCalendar.Colors.WeekEnd;
end;
end;
{ Draws a box around the selected day }
procedure TVpCalendarPainter.DrawFocusBox;
var
R: TRect;
S: string[10];
begin
S := IntToStr(TVpCalendarOpener(FCalendar).clDay);
{ set highlight color and font style for days with events }
RenderCanvas.Font.Style := RenderCanvas.Font.Style - [fsBold];
lBadDate := false;
if (FCalendar.DataStore <> nil) and (FCalendar.DataStore.Resource <> nil) then begin
DecodeDate(RenderDate, Y, M, D);
try
{$IFDEF VERSION6}
if not TryEncodeDate (Y, M, TVpCalendarOpener(FCalendar).clDay, lDate) then
lBadDate := true;
{$ELSE}
lDate := EncodeDate(Y, M, TVpCalendarOpener(FCalendar).clDay);
{$ENDIF}
except
lBadDate := true;
end;
if (not lBadDate) and (FCalendar.DataStore.Resource.Schedule.EventCountByDay(lDate) > 0)
then begin
RenderCanvas.Font.Style := RenderCanvas.Font.Style + [fsBold, fsUnderline];
RenderCanvas.Font.Color := EventDayColor;
end else
RenderCanvas.Font.Style := RenderCanvas.Font.Style - [fsBold, fsUnderline];
end;
R := TVpCalendarOpener(FCalendar).calGetCurrentRectangle;
R.Left := R.Left + RealLeft;
R.Top := R.Top + RealTop;
R.Right := R.Right + RealLeft;
R.Bottom := R.Bottom + RealTop;
R := FCalendar.CurrentRectangle;
OffsetRect(R, RealLeft, RealTop);
R := TPSRotateRectangle (Angle, RenderIn, R);
if not DisplayOnly then begin
{$IFNDEF LCL}
if Focused then
@@ -331,11 +316,13 @@ begin
DrawButtonFace (RenderCanvas, R, 1, bsNew, True, False, False);
{$ENDIF}
R := TVpCalendarOpener(FCalendar).calGetCurrentRectangle;
R.Left := R.Left + RealLeft;
R.Top := R.Top + RealTop;
R.Right := R.Right + RealLeft;
R.Bottom := R.Bottom + RealTop;
TPSCenteredTextOut (RenderCanvas, Angle, RenderIn, R, S);
InflateRect(R, -1, -1);
OffsetRect(R, RealLeft, RealTop);
RenderCanvas.Pen.Color := ActiveDayBorderColor;
RenderCanvas.Brush.Color := ActiveDayColor;
RenderCanvas.Pen.Width := 1;
TPSRectangle(RenderCanvas, Angle, RenderIn, R);
end;
end;
@@ -395,23 +382,25 @@ begin
RenderCanvas.Brush.Color := RealColor;
RenderCanvas.FillRect(RenderIn);
{draw the month and year at the top of the calendar}
// Draw the month and year at the top of the calendar
DrawDate;
{draw the days of the week}
// Draw the days of the week
DrawDayNames;
{draw line under day names}
// Draw line under day names
DrawLine;
{draw each day}
DrawAllDays;
// Draw each day
// DrawAllDays;
RenderCanvas.Font.Color := DayColor;
if not Assigned(FCalendar.OnDrawItem) then
if not (cdoHideActive in FCalendar.Options) then
DrawFocusBox;
DrawAllDays;
finally
RenderCanvas.Unlock;
end;