pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity
Files
master
lazarus-ccr/components/tvplanit/source/vpmonthviewpainter.pas

871 lines
28 KiB
ObjectPascal
Raw Permalink Blame History

{$I vp.inc}
unit VpMonthViewPainter;
interface
uses
SysUtils, LCLType, LCLIntf, Types, Classes, Graphics,
VpConst, VPBase, VpData, VpMonthView, VpBasePainter;
type
TVpMonthViewPainter = class(TVpBasePainter)
private
FMonthView: TVpMonthView;
FDisplayDate: TDateTime;
FScaledMonthMargin: Integer;
FScaledDaysMargin: Integer;
// local parameters of the old TVpMonthView method
DisplayMonth: Word;
RealColor: TColor;
BevelHighlight: TColor;
BevelShadow: TColor;
BevelDarkShadow: TColor;
BevelFace: TColor;
DayHeadAttrColor: TColor;
HeadAttrColor: TColor;
RealLineColor: TColor;
RealOffDayColor: TColor;
RealSelDayColor: TColor;
EventFontColor: TColor;
TodayFontColor: TColor;
TodayAttrColor: TColor;
DotDotDotColor: TColor;
FCurrHoliday: String;
FDayHeadHeight: Integer;
FMonthHeadHeight: Integer;
FTodayRect: TRect;
FTodayStr: String;
// These variables were protected in the original monthview, but are needed only for painting
mvEventTextHeight: Integer;
mvDayNumberHeight: Integer;
mvRowHeight: Integer;
mvColWidth: Integer;
mvLineHeight: Integer;
protected
procedure Clear;
procedure DrawBorders;
procedure DrawDayCell(ADate: TDate; ACol, ARow: Integer;
var AIndex, ADayNumber: Integer; var ATextRect: TRect);
procedure DrawDayHead;
procedure DrawDays;
procedure DrawEvents;
procedure DrawFocusRect(ARect: TRect; FixRight: Boolean = false);
procedure DrawHeader;
procedure DrawTodayRect;
procedure FixFontHeights;
procedure InitColors;
procedure SetMeasurements; override;
public
constructor Create(AMonthView: TVpMonthView; ARenderCanvas: TCanvas);
procedure RenderToCanvas(ARenderIn: TRect; AAngle: TVpRotationAngle;
AScale: Extended; ARenderDate: TDateTime; AStartLine, AStopLine: Integer;
AUseGran: TVpGranularity; ADisplayOnly: Boolean); override;
end;
implementation
uses
LazUtf8, Math,
VpCanvasUtils, VpMisc;
type
TVpMonthViewOpener = class(TVpMonthView);
constructor TVpMonthViewPainter.Create(AMonthView: TVpMonthView;
ARenderCanvas: TCanvas);
begin
inherited Create(ARenderCanvas);
FMonthView := AMonthView;
end;
procedure TVpMonthViewPainter.Clear;
begin
RenderCanvas.Brush.Color := RealColor;
RenderCanvas.FillRect(RenderIn);
FMonthView.ClearEventArray;
end;
procedure TVpMonthViewPainter.DrawBorders;
var
R: TRect;
begin
R := TPSRotateRectangle(Angle, RenderIn, Rect(RealLeft, RealTop, RealRight - 1, RealBottom - 1));
RenderCanvas.Pen.Width := 1;
case FMonthView.DrawingStyle of
dsNoBorder: ;
dsFlat: DrawBevelRect(RenderCanvas, R, BevelShadow, BevelShadow);
ds3D: DrawBevelRect(RenderCanvas, R, BevelShadow, BevelHighlight);
end;
end;
procedure TVpMonthViewPainter.DrawDayCell(ADate: TDate; ACol, ARow: Integer;
var AIndex, ADayNumber: Integer; var ATextRect: TRect);
var
tmpRect: TRect;
Y, M, D: Word;
str: String;
todayDate: TDate;
fontStyle: TFontStyles;
textAdjust: Integer;
textHeight: Integer;
begin
todayDate := Date();
DecodeDate(ADate, Y, M, D);
if (ACol = 6) then
ATextRect.Right := ATextRect.Right + 8;
tmpRect := ATextRect;
if ARow = 0 then
inc(tmpRect.Top);
if FCurrHoliday <> '' then begin
RenderCanvas.Brush.Color := FMonthView.HolidayAttributes.Color;
TPSFillRect(RenderCanvas, Angle, RenderIn, tmpRect);
end else if DisplayMonth <> M then begin
RenderCanvas.Brush.Color := RealOffDayColor;
TPSFillRect(RenderCanvas, Angle, RenderIn, tmpRect);
end else if DayOfWeek(ADate) in [1, 7] then begin
RenderCanvas.Brush.Color := FMonthView.WeekendAttributes.Color;
TPSFillRect(RenderCanvas, Angle, RenderIn, tmpRect);
end else
RenderCanvas.Brush.Color := RealColor;
if ACol = 6 then begin
// Draw bottom line
TPSMoveTo(RenderCanvas, Angle, RenderIn, ATextRect.Left, ATextRect.Bottom);
TPSLineTo(RenderCanvas, Angle, RenderIn, RealRight, ATextRect.Bottom);
end else begin
// Draw right side and bottom lines
TPSMoveTo(RenderCanvas, Angle, RenderIn, ATextRect.Right, ATextRect.top);
if ATextRect.Bottom > RealBottom then begin
TPSLineTo(RenderCanvas, Angle, RenderIn, ATextRect.Right, RealBottom);
TPSLineTo(RenderCanvas, Angle, RenderIn, ATextRect.Left - 1, RealBottom);
end else begin
TPSLineTo(RenderCanvas, Angle, RenderIn, ATextRect.Right, ATextRect.Bottom);
TPSLineTo(RenderCanvas, Angle, RenderIn, ATextRect.Left - 1, ATextRect.Bottom);
end;
end;
// Prepare the day number as string
str := FormatDateTime('d', ADate);
// Set the proper font and style
if ADate = todayDate then
RenderCanvas.Font.Assign(FMonthView.TodayAttributes.Font)
else
RenderCanvas.Font.Assign(FMonthView.DayNumberFont);
{$IF VP_LCL_SCALING = 0}
RenderCanvas.Font.Size := ScaleY(RenderCanvas.Font.Size, DesignTimeDPI);
{$ENDIF}
fontstyle := RenderCanvas.Font.style;
if (FDisplayDate = ADate) then begin
if FMonthView.Focused then begin
if ACol = 6 then begin
tmpRect := ATextRect;
dec(tmpRect.Right, 4);
DrawFocusRect(tmpRect, true);
end else
DrawFocusRect(ATextRect);
end;
RenderCanvas.Font.Color := RealSelDayColor;
RenderCanvas.Font.Style := FMonthView.DayNumberFont.Style + [fsBold];
if (FMonthView.EventDayStyle <> []) and (FMonthView.Datastore <> nil) and
(FMonthView.DataStore.Resource <> nil) and
(FMonthView.DataStore.Resource.Schedule.EventCountByDay(ADate) > 0)
then
RenderCanvas.Font.Style := RenderCanvas.Font.Style + FMonthView.EventDayStyle;
end else begin
// Set the font style for days which have events.
if (FMonthView.EventDayStyle <> []) and (FMonthview.Datastore <> nil) and
(FMonthView.DataStore.Resource <> nil) and
(FMonthView.DataStore.Resource.Schedule.EventCountByDay(ADate) > 0)
then
RenderCanvas.Font.Style := RenderCanvas.Font.Style + FMonthView.EventDayStyle
else begin
RenderCanvas.Font.Color := EventFontColor;
RenderCanvas.Font.Style := FMonthView.DayNumberFont.Style;
end;
end;
if DisplayMonth <> M then
RenderCanvas.Font.Color := FMonthView.OffDayFontColor;
if FCurrHoliday <> '' then
RenderCanvas.Font.Assign(FMonthView.HolidayAttributes.Font);
FontStyle := RenderCanvas.Font.Style;
RenderCanvas.Font.Style := [fsBold, fsItalic];
textAdjust := RenderCanvas.TextWidth(str);
textHeight := RenderCanvas.TextHeight(str);
RenderCanvas.Font.Style := FontStyle;
// Calculate size of rect for the day number at the top of the TextRect.
if ACol = 6 then
tmpRect.Left := ATextRect.Left + mvColWidth - TextAdjust - FScaledDaysMargin
else
tmpRect.Left := ATextRect.Right - TextAdjust - FScaledDaysMargin;
if fsItalic in RenderCanvas.Font.Style then
dec(tmpRect.Left, 2);
tmpRect.Top := ATextRect.Top + FScaledDaysMargin;
tmpRect.Right := tmpRect.Left + textAdjust;
tmpRect.Bottom := tmpRect.Top + textHeight;
// Highlight today by a border
if ADate = todayDate then begin
FTodayRect := tmpRect;
OffsetRect(FTodayRect, 2, 0);
InflateRect(FTodayRect, 3, 3);
FTodayStr := Str;
// Will be painted after the events to avoid drawing events over the
// "today" rectangle
end else
// Write the day number at the top of the TextRect
TPSTextOut(RenderCanvas, Angle, RenderIn, tmpRect.Left, tmpRect.Top, Str);
// Update MonthDayArray
with TVpMonthViewOpener(FMonthView) do begin
mvMonthDayArray[AIndex].Rec := ATextRect;
mvMonthDayArray[AIndex].Date := ADate;
mvMonthDayArray[AIndex].OffDay := DisplayMonth <> M;
end;
Inc(ADayNumber);
Inc(AIndex);
if ACol = 6 then begin
// We just painted the last day in the row --> Drop rect down one row and
// then all the way to the left
ATextRect.TopLeft := Point(RealLeft + 1, ATextRect.Bottom + 1);
ATextRect.BottomRight := Point(ATextRect.Left + mvColWidth, ATextRect.Top + mvRowHeight);
if (ATextRect.Bottom > RealBottom - 1) then
ATextRect.Bottom := RealBottom - 1;
end else begin
// Slide rect one column to the right
ATextRect.Left := ATextRect.Right + 1;
ATextRect.Right := ATextRect.Right + mvColWidth;
end;
end;
procedure TVpMonthViewPainter.DrawDayHead;
var
dhRect, R: TRect;
P: TPoint;
I: Integer;
DayTAG: Integer;
str: string;
strLen: Integer;
strHeight: Integer;
begin
{ clear day head area }
RenderCanvas.Font.Assign(FMonthView.DayHeadAttributes.Font);
{$IF VP_LCL_SCALING = 0}
RenderCanvas.Font.Size := ScaleY(RenderCanvas.Font.Size, DesignTimeDPI);
{$ENDIF}
RenderCanvas.Brush.Color := DayHeadAttrColor;
RenderCanvas.Pen.Color := RealLineColor;
strHeight := RenderCanvas.TextHeight('00');
{ build rect }
dhRect.Left := RealLeft;
dhRect.Top := RealTop + FMonthHeadHeight;
dhRect.Right := RealRight;
dhRect.Bottom := dhRect.Top + FDayHeadHeight;
if FMonthView.DrawingStyle = ds3d then begin
inc(dhRect.Left, 2);
inc(dhRect.Top, 2);
dec(dhRect.Right, 2);
dhRect.Bottom := dhRect.Top + FDayHeadHeight;
TPSFillRect(RenderCanvas, Angle, RenderIn, dhRect);
R := TPSRotateRectangle(Angle, RenderIn, dhRect);
DrawBevelRect(RenderCanvas, R, BevelHighlight, BevelShadow);
end else
if FMonthView.DrawingStyle = dsFlat then begin
TPSFillRect(RenderCanvas, Angle, RenderIn, dhRect);
R := TPSRotateRectangle(Angle, RenderIn, dhRect);
DrawBevelRect(RenderCanvas, R, BevelShadow, BevelShadow);
end else
begin
dhRect.Left := RealLeft;
TPSFillRect(RenderCanvas, Angle, RenderIn, dhRect);
end;
DayTAG := Ord(FMonthView.WeekStartsOn);
dhRect.Right := dhRect.Left + mvColWidth;
for I := 0 to 6 do begin
{ draw the little vertical lines between each day }
if I < 6 then begin
if FMonthView.DrawingStyle = ds3d then
begin
R := Rect(dhRect.Right-1, dhRect.Top + 3, dhRect.Right, dhRect.Bottom - 3);
R := TPSRotateRectangle(Angle, RenderIn, R);
DrawBevelRect(RenderCanvas, TPSRotateRectangle(Angle, RenderIn, R), BevelShadow, BevelHighlight);
end else
begin
TPSMoveTo(RenderCanvas, Angle, RenderIn, dhRect.Right + 1, dhRect.Top + 4);
TPSLineTo(RenderCanvas, Angle, RenderIn, dhRect.Right + 1, dhRect.Bottom - 3);
end;
end;
{$IFDEF LCL}
case FMonthView.DayNameStyle of
dsLong : { Draw each day's full caption... }
str := FormatSettings.LongDayNames[DayTAG+1];
dsShort: { Draw each day's abbreviated caption... }
str := FormatSettings.ShortDayNames[DayTAG+1];
dsLetter: { Draw each day's first letter only }
str := FormatSettings.ShortDayNames[DayTAG+1, 1];
end;
{$ELSE}
case FMontheView.DayNameStyle of
dsLong: { Draw each day's full caption... }
case DayTAG of
0: str := RSSunday;
1: str := RSMonday;
2: str := RSTuesday;
3: str := RSWednesday;
4: str := RSThursday;
5: str := RSFriday;
6: str := RSSaturday;
end
dsShort: { Draw each day's abbreviated caption... }
case DayTAG of
0: str := RSASunday;
1: str := RSAMonday;
2: str := RSATuesday;
3: str := RSAWednesday;
4: str := RSAThursday;
5: str := RSAFriday;
6: str := RSASaturday;
end
dsLetter: { Draw each day's first letter only }
case DayTAG of
0: str := RSLSunday;
1: str := RSLMonday;
2: str := RSLTuesday;
3: str := RSLWednesday;
4: str := RSLThursday;
5: str := RSLFriday;
6: str := RSLSaturday;
end;
end;
{$ENDIF}
{ Fix header string }
strLen := RenderCanvas.TextWidth(str);
if (strLen > mvColWidth - FScaledDaysMargin * 2) then
str := GetDisplayString(RenderCanvas, str, 0, mvColWidth - FScaledDaysMargin * 2);
strLen := RenderCanvas.TextWidth(str);
{ Draw header text }
P := Point(
(dhRect.Left + dhRect.Right - strLen) div 2,
(dhRect.Top + dhRect.Bottom - strHeight) div 2
);
TPSTextOut(RenderCanvas, Angle, RenderIn, P.X, P.Y, str);
DayTAG := (DayTAG + 1) mod 7;
dhRect.Left := dhRect.Right;
dhRect.Right := dhRect.Left + mvColWidth;
end; // for I ...
end;
procedure TVpMonthViewPainter.DrawDays;
var
TextRect: TRect;
Col, Row: Integer;
DayNumber: Integer;
M, D, Y: Word;
MonthStartsOn: Integer;
DayTag: Integer;
DayOffset: Integer;
headHeight: Integer;
StartingDate: TDateTime;
ThisDate: TDateTime;
I: Integer;
Drawn: Boolean;
OldBrush: TBrush;
OldPen: TPen;
OldFont: TFont;
begin
// Initialize the MonthDayArray
with TVpMonthViewOpener(FMonthView) do begin
for I := 0 to Pred(Length(mvMonthDayArray)) do begin
mvMonthDayArray[I].Rec := Rect(-1, -1, -1, -1);
mvMonthDayArray[I].Date := 0.0;
end;
end;
RenderCanvas.Pen.Color := RealLineColor;
RenderCanvas.Brush.Color := RealColor;
headHeight := FMonthHeadHeight + FDayHeadHeight;
if FMonthView.DrawingStyle = ds3d then
begin
mvRowHeight := (RealHeight - headHeight - 2) div 6;
TextRect.TopLeft := Point(RealLeft + 1, RealTop + headHeight + 2);
end else
begin
mvRowHeight := (RealHeight - headHeight) div 6;
TextRect.TopLeft := Point(RealLeft + 1, RealTop + headHeight);
end;
TextRect.BottomRight := Point(TextRect.Left + mvColWidth, TextRect.Top + mvRowHeight);
// Determine the starting date and offset
DecodeDate(FDisplayDate, Y, DisplayMonth, D);
StartingDate := EncodeDate(Y, DisplayMonth, 1);
MonthStartsOn := DayOfWeek(StartingDate);
DayTag := Ord(FMonthView.WeekStartsOn);
DayOffset := DayTag - MonthStartsOn;
if DayOffset = 0 then
DayOffset := -7;
I := 0;
DayNumber := DayOffset + 1;
// Iterate through each column row by row, drawing each day in numerical order.
OldBrush := TBrush.Create;
OldPen := TPen.Create;
OldFont := TFont.Create;
try
for Row := 0 to 5 do begin
for Col := 0 to 6 do begin
ThisDate := Trunc(StartingDate + DayNumber);
// Check and store if this date is a holiday
FMonthView.IsHoliday(ThisDate, FCurrHoliday);
OldBrush.Assign(RenderCanvas.Brush);
OldPen.Assign(RenderCanvas.Pen);
OldFont.Assign(RenderCanvas.Font);
try
// Allow the user to draw the day
if Assigned(FMonthView.OwnerDrawCells) then begin
Drawn := false;
DecodeDate(ThisDate, Y,M,D);
FMonthView.OwnerDrawCells(self, RenderCanvas, TextRect, D, Drawn);
if Drawn then
Continue;
end else
DrawDayCell(ThisDate, Col, Row, I, DayNumber, TextRect);
finally
RenderCanvas.Brush.Assign(OldBrush);
RenderCanvas.Pen.Assign(OldPen);
RenderCanvas.Font.Assign(OldFont);
end;
end;
end;
finally
OldFont.Free;
OldPen.Free;
OldBrush.Free;
end;
DrawEvents;
DrawTodayRect;
end;
procedure TVpMonthViewPainter.DrawEvents;
var
I, J: Integer;
EventList: TList;
event: TVpEvent;
eventCat: TVpCategoryInfo;
dayRect: TRect;
TextRect: TRect;
txtMargin: Integer;
tmpRect: TRect;
Str: String;
StrLen: Integer;
P: TPoint;
visibleEvents: Integer;
brushCol: TColor;
begin
RenderCanvas.Pen.Color := RealLineColor;
RenderCanvas.Pen.Style := psSolid;
RenderCanvas.Brush.Color := RealColor;
txtMargin := FScaledDaysMargin;
{ write the events }
if (FMonthView.DataStore <> nil) and FMonthView.ShowEvents and
(FMonthView.DataStore.Resource <> nil) and
(FMonthView.DataStore.Resource.Schedule.EventCount <> 0)
then begin
visibleEvents := 0;
EventList := TList.Create;
try
for I := 0 to 43 do begin
EventList.Clear;
FMonthView.DataStore.Resource.Schedule.EventsByDate(TVpMonthViewOpener(FMonthView).mvMonthDayArray[I].Date, EventList);
if EventList.Count > 0 then begin
{ there are events scheduled for this day }
dayRect := TVpMonthViewOpener(FMonthView).mvMonthDayArray[I].Rec;
{ initialize TextRect for this day }
TextRect.TopLeft := Point(dayRect.Left+1, dayRect.Top+1);
TextRect.BottomRight := Point(
TextRect.Left + mvColWidth,
TextRect.Top + mvEventTextHeight + txtMargin
);
{ set canvas color }
if TVpMonthViewOpener(FMonthView).mvMonthDayArray[I].OffDay then
RenderCanvas.Brush.Color := RealOffDayColor
else
RenderCanvas.Brush.Color := RealColor;
{ spin through the events and paint them }
for J := 0 to Pred(EventList.Count) do begin
event := TVpEvent(EventList[j]);
if (TextRect.Bottom > dayRect.Bottom) and (J <= Pred(EventList.Count)) then
begin
{ draw a little red square with a (...) at the bottom right }
{ corner of the day to indicate that there are more events }
{ than can be listed in the available space. }
DrawDotDotDot(dayRect, DotDotDotColor);
Break;
end;
{ shorten events that are next to the day number, in order }
{ to give the day number enough room }
if (TextRect.Top < dayRect.Top + mvDayNumberHeight + txtMargin)
then
TextRect.Right := TextRect.Left + mvColWidth - mvDayNumberHeight - txtMargin * 2
else
TextRect.Right := TextRect.Left + mvColWidth - 3;
if Assigned(FMonthView.Datastore) and FMonthView.ApplyCategoryInfos then
begin
brushCol := RenderCanvas.Brush.Color;
eventCat := FMonthView.Datastore.CategoryColorMap.GetCategory(event.Category);
if Assigned(eventCat) then
begin
tmpRect := TextRect;
InflateRect(tmpRect, -1, -1);
RenderCanvas.Brush.Color := eventCat.BackgroundColor;
TPSFillRect(RenderCanvas, Angle, RenderIn, tmpRect);
end;
RenderCanvas.Brush.Color := brushCol;
end;
{ Construct the display text }
Str := FMonthView.BuildEventString(event, FMonthView.ShowEventTime, true);
{ set the event font }
RenderCanvas.Font.Assign(FMonthView.EventFont);
{$IF VP_LCL_SCALING = 0}
RenderCanvas.Font.Size := ScaleY(RenderCanvas.Font.Size, DesignTimeDPI);
{$ENDIF}
if TVpMonthViewOpener(FMonthView).mvMonthDayArray[I].OffDay then
RenderCanvas.Font.Color := FMonthView.OffDayFontColor;
if Assigned(FMonthView.OnPrepareEventFont) then
FMonthView.OnPrepareEventFont(FMonthView, event, RenderCanvas.Font);
StrLen := RenderCanvas.TextWidth(Str);
if StrLen > WidthOf(TextRect) - txtMargin * 2 then
Str := GetDisplayString(RenderCanvas, Str, 0, WidthOf(TextRect) - txtMargin * 2);
{ write the event text }
P := Point(TextRect.Left + txtMargin div 2, TextRect.Top + txtMargin div 2);
TPSTextOut(RenderCanvas, Angle, RenderIn, P.X, P.Y, Str);
{ Store TextRect and Event in EventArray }
with TVpMonthViewOpener(FMonthView) do begin
mvEventArray[visibleEvents].Rec := TextRect;
mvEventArray[visibleEvents].Event := TVpEvent(EventList.List^[j]);
Inc(visibleEvents);
end;
{ Move TextRect down one line for the next item... }
TextRect.Top := TextRect.Bottom + 1;
TextRect.Bottom := TextRect.Top + mvLineHeight;
end;
end;
end;
finally
EventList.Free;
end;
end;
end;
procedure TVpMonthViewPainter.DrawFocusRect(ARect: TRect; FixRight: Boolean = false);
var
tmpRect: TRect;
begin
(*
tmpRect := ARect;
InflateRect(tmpRect, 2, 2);
TPSDrawFocusRect(RenderCanvas, Angle, RenderIn, tmpRect);
*)
tmpRect := ARect;
// InflateRect(tmpRect, -2, -2);
InflateRect(tmpRect, -1, -1);
if FixRight then
inc(tmpRect.Right);
TPSDrawFocusRect(RenderCanvas, Angle, RenderIn, tmpRect);
end;
procedure TVpMonthViewPainter.DrawHeader;
var
headRect: TRect;
HeadTextRect: TRect;
HeadStr: string;
HeadStrLen : Integer;
R: TRect;
txtstart: Integer;
begin
RenderCanvas.Brush.Color := HeadAttrColor;
headRect := Rect(RealLeft, RealTop, RealRight, RealTop + FMonthHeadHeight);
// Draw the header cell and borders
if FMonthView.DrawingStyle = dsFlat then begin
// Draw a flat rectangular border
TPSFillRect(RenderCanvas, Angle, RenderIn, headRect);
R := TPSRotateRectangle(Angle, RenderIn, headRect);
DrawBevelRect(RenderCanvas, R, BevelShadow, BevelShadow);
end else
if FMonthView.DrawingStyle = ds3d then begin
// Draw a 3d bevel
InflateRect(headRect, -1, -1);
dec(headRect.Right);
headRect.Bottom := headRect.Top + FMonthHeadHeight;
TPSFillRect(RenderCanvas, Angle, RenderIn, headRect);
R := TPSRotateRectangle(Angle, RenderIn, headRect);
DrawBevelRect(RenderCanvas, R, BevelHighlight, BevelShadow);
end else
TPSFillRect(RenderCanvas, Angle, RenderIn, headRect);
// Position the spinner buttons
with TVpMonthViewOpener(FMonthView) do begin
FPrevYearBtn.Visible := not DisplayOnly;
FPrevMonthBtn.Visible := not DisplayOnly;
FNextMonthBtn.Visible := not DisplayOnly;
FNextYearBtn.Visible := not DisplayOnly;
if not DisplayOnly then
begin
FPrevYearBtn.Width := FPrevYearBtn.Height;
FPrevYearBtn.Left := FScaledMonthMargin;
FPrevYearBtn.Top := (HeadRect.Top + HeadRect.Bottom - FPrevYearBtn.Height) div 2 + 1;
FPrevMonthBtn.Height := FPrevYearBtn.Height;
FPrevMonthBtn.Width := FPrevYearBtn.Height;
FPrevMonthBtn.Left := FPrevYearBtn.Left + FPrevYearBtn.Width;
FPrevMonthBtn.Top := FPrevYearBtn.Top;
FNextMonthBtn.Height := FPrevYearBtn.Height;
FNextMonthBtn.Width := FPrevYearBtn.Height;
FNextMonthBtn.Left := FPrevMonthBtn.Left + FPrevMonthBtn.Width;
FNextMonthBtn.Top := FPrevYearBtn.Top;
FNextYearBtn.Height := FPrevYearBtn.Height;
FNextYearBtn.Width := FPrevYearBtn.Height;
FNextYearBtn.Left := FNextMonthBtn.Left + FNextMonthBtn.Width;
FNextYearBtn.Top := FPrevYearBtn.Top;
txtStart := FNextYearBtn.Left + FNextYearBtn.Width + 2*FScaledMonthMargin;
end else
txtStart := RealLeft + FScaledMonthMargin;
end;
{ Acquire startdate and end date }
HeadStr := FormatDateTime(FMonthView.DateLabelFormat, FDisplayDate);
{$IFDEF FPC}{$IF FPC_FULLVERSION < 30000}
HeadStr := SysToUTF8(HeadStr);
{$ENDIF}{$ENDIF}
{ Calculate the text rectangle }
RenderCanvas.Font.Assign(FMonthView.HeadAttributes.Font);
{$IF VP_LCL_SCALING = 0}
RenderCanvas.Font.Size := ScaleY(RenderCanvas.Font.Size, DesignTimeDPI);
{$ENDIF}
if DisplayOnly and (RenderCanvas.TextWidth(HeadStr) >= RealWidth) then
HeadTextRect.Left := RealLeft + FScaledMonthMargin * 2
else
if DisplayOnly then
HeadTextRect.Left := RealLeft + (RealWidth - RenderCanvas.TextWidth(HeadStr)) div 2
else
HeadTextRect.Left := RealLeft + 30 + FScaledMonthMargin * 2;
HeadTextRect.Top := (HeadRect.Top + HeadRect.Bottom - RenderCanvas.TextHeight('Tg')) div 2;
HeadTextRect.BottomRight := HeadRect.BottomRight;
{ Fix Header String }
HeadStrLen := RenderCanvas.TextWidth(HeadStr);
if HeadStrLen > HeadTextRect.Right - HeadTextRect.Left then begin
HeadStr := GetDisplayString(
RenderCanvas,
HeadStr,
0,
HeadTextRect.Right - HeadTextRect.Left - FScaledMonthMargin
);
end;
// Draw the text
RenderCanvas.Font.Assign(FMonthView.HeadAttributes.Font);
{$IF VP_LCL_SCALING = 0}
RenderCanvas.Font.Size := ScaleY(RenderCanvas.Font.Size, DesignTimeDPI);
{$ENDIF}
TPSTextOut(
RenderCanvas,
Angle,
RenderIn, // Viewport
txtstart, // Horizontal text position, after the spin buttons
HeadTextRect.Top, // this vertical position is already centered
HeadStr
);
end;
procedure TVpMonthViewPainter.DrawTodayRect;
begin
// Highlight toay by a border defined by FTodayRect (it was measured in
// the DrawDayCell method).
RenderCanvas.Pen.Assign(FMonthView.TodayAttributes.BorderPen);
RenderCanvas.Brush.Color := FMonthView.TodayAttributes.Color;
RenderCanvas.Brush.Style := bsSolid;
RenderCanvas.Rectangle(FTodayRect);
// Write the day number into the TodayRect.
RenderCanvas.Font.Color := FMonthView.TodayAttributes.Font.Color;
TPSTextOut(RenderCanvas, Angle, RenderIn, FTodayRect.Left+3, FTodayRect.Top+3, FTodayStr);
end;
procedure TVpMonthViewPainter.FixFontHeights;
begin
with FMonthView do begin
{$IF VP_LCL_SCALING = 0}
HeadAttributes.Font.Height := GetRealFontHeight(HeadAttributes.Font);
DayHeadAttributes.Font.Height := GetRealFontHeight(DayHeadAttributes.Font);
DayNumberFont.Height := GetRealFontHeight(DayNumberFont);
EventFont.Height := GetRealFontHeight(EventFont);
Font.Height := GetRealFontHeight(Font);
{$ELSE}
HeadAttributes.Font.Height := FixFontHeight(HeadAttributes.Font);
DayHeadAttributes.Font.Height := FixFontHeight(DayHeadAttributes.Font);
DayNumberFont.Height := FixFontHeight(DayNumberFont);
EventFont.Height := FixFontHeight(EventFont);
Font.Height := FixFontHeight(Font);
{$IFEND}
end;
end;
procedure TVpMonthViewPainter.InitColors;
begin
if DisplayOnly then begin
BevelHighlight := clBlack;
BevelShadow := clBlack;
BevelDarkShadow := clBlack;
BevelFace := clBlack;
RealColor := clWhite;
DayHeadAttrColor := clSilver;
HeadAttrColor := clSilver;
RealLineColor := clBlack;
RealOffDayColor := clSilver;
RealSelDayColor := clWhite;
EventFontColor := clBlack;
TodayFontColor := clBlack;
TodayAttrColor := clWhite;
end else begin
BevelHighlight := clBtnHighlight;
BevelShadow := clBtnShadow;
BevelDarkShadow := cl3DDkShadow;
BevelFace := clBtnFace;
RealColor := FMonthView.Color;
HeadAttrColor := FMonthView.HeadAttributes.Color;
DayHeadAttrColor := FMonthView.DayHeadAttributes.Color;
RealLineColor := FMonthView.LineColor;
RealOffDayColor := FMonthView.OffDayColor;
RealSelDayColor := FMonthView.SelectedDayColor;
EventFontColor := FMonthView.DayNumberFont.Color;
TodayFontColor := FMonthView.TodayAttributes.Font.Color;
TodayAttrColor := FMonthView.TodayAttributes.Color;
end;
DotDotDotColor := clBlack;
end;
procedure TVpMonthViewPainter.RenderToCanvas(ARenderIn: TRect;
AAngle: TVpRotationAngle; AScale: Extended; ARenderDate: TDateTime;
AStartLine, AStopLine: Integer; AUseGran: TVpGranularity; ADisplayOnly: Boolean);
begin
inherited;
InitColors;
SavePenBrush;
InitPenBrush;
if ADisplayOnly then
FixFontHeights;
Rgn := CreateRectRgn(RenderIn.Left, RenderIn.Top, RenderIn.Right, RenderIn.Bottom);
try
SelectClipRgn(RenderCanvas.Handle, Rgn);
{ clear client area and event array }
Clear;
{ measure the row heights }
SetMeasurements;
{ draw headers }
DrawHeader;
DrawDayHead;
{ draw days }
DrawDays;
{ draw the borders }
DrawBorders;
finally
SelectClipRgn(RenderCanvas.Handle, 0);
DeleteObject(Rgn);
end;
{ reinstate canvas settings}
RestorePenBrush;
end;
procedure TVpMonthViewPainter.SetMeasurements;
var
h: Integer;
txt: String = VpProductName;
// We use the VpProductName since it is a good representation of some generic text
begin
inherited;
FDisplayDate := RenderDate;
with TVpMonthViewOpener(FMonthView) do
begin
FScaledMonthMargin := round(Scale * MonthMargin);
FScaledDaysMargin := round(Scale * DaysMargin);
h := GetCanvasTextHeight(RenderCanvas, HeadAttributes.Font, txt);
mvMonthHeadHeight := Max(h, FPrevYearBtn.Height) + FScaledMonthMargin;
h := GetCanvasTextHeight(RenderCanvas, DayHeadAttributes.Font, txt);
mvDayHeadHeight := Max(h, FPrevYearBtn.Height) + FScaledDaysMargin;
mvHeaderHeight := mvMonthHeadHeight + mvDayHeadHeight;
mvDayNumberHeight := GetCanvasTextHeight(RenderCanvas, DayNumberFont, '00');
mvEventTextHeight := GetCanvasTextHeight(RenderCanvas, EventFont, txt);
mvLineHeight := GetCanvasTextHeight(RenderCanvas, Font, txt) + 2;
mvColWidth := (RealWidth - 2) div 7;
FMonthHeadHeight := mvMonthHeadHeight;
FDayHeadHeight := mvDayHeadHeight;
end;
end;
end.
Reference in New Issue View Git Blame Copy Permalink