diff --git a/components/tvplanit/examples/fulldemo/demomain.lfm b/components/tvplanit/examples/fulldemo/demomain.lfm index 625275f78..8ad84ab11 100644 --- a/components/tvplanit/examples/fulldemo/demomain.lfm +++ b/components/tvplanit/examples/fulldemo/demomain.lfm @@ -66,6 +66,10 @@ object MainForm: TMainForm HeadAttributes.Color = clBtnFace LineColor = clGray TimeFormat = tf12Hour + TodayAttributes.Color = clSkyBlue + TodayAttributes.Font.Color = clBlue + TodayAttributes.BorderPen.Color = clBlue + TodayAttributes.BorderPen.Width = 3 OffDayColor = clSilver SelectedDayColor = clRed ShowEvents = True diff --git a/components/tvplanit/source/vpmonthview.pas b/components/tvplanit/source/vpmonthview.pas index 479df848e..e4a3c0beb 100644 --- a/components/tvplanit/source/vpmonthview.pas +++ b/components/tvplanit/source/vpmonthview.pas @@ -59,7 +59,7 @@ type TVpOnEventClick = procedure(Sender: TObject; Event: TVpEvent) of object; - TVpMvHeadAttributes = class(TPersistent) + TVpMvHeadAttr = class(TPersistent) protected{ private } FOwner: TVpMonthView; FColor: TColor; @@ -91,6 +91,25 @@ type property Font: TVpFont read FFont write SetFont; end; + TVpMvTodayAttr = class(TPersistent) + protected + FMonthView: TVpMonthView; + FFont: TVpFont; + FColor: TColor; + FBorderPen: TPen; + procedure SetColor(Value: TColor); + procedure SetFont(Value: TVpFont); + procedure SetBorderPen(Value: TPen); + public + constructor Create(AOwner: TVpMonthView); + destructor Destroy; override; + property MonthView: TVpMonthView read FMonthView; + published + property Color: TColor read FColor write SetColor; + property Font: TVpFont read FFont write FFont; + property BorderPen: TPen read FBorderPen write SetBorderPen; + end; + { TVpMonthView } TVpMonthView = class(TVpLinkableControl) @@ -111,8 +130,9 @@ type FDateLabelFormat : string; FShowEventTime : Boolean; FTopLine : Integer; - FDayHeadAttributes : TVpDayHeadAttr; - FHeadAttr : TVpMvHeadAttributes; + FDayHeadAttr : TVpDayHeadAttr; + FHeadAttr : TVpMvHeadAttr; + FTodayAttr : TVpMvTodayAttr; FDayNumberFont : TVpFont; FEventFont : TVpFont; FTimeFormat : TVpTimeFormat; @@ -165,6 +185,7 @@ type procedure SetWeekStartsOn(Value: TVpDayType); { internal methods } procedure mvHookUp; + procedure mvPenChanged(Sender: TObject); // procedure mvFontChanged(Sender: TObject); procedure Paint; override; @@ -245,7 +266,7 @@ type property DateLabelFormat: string read FDateLabelFormat write SetDateLabelFormat; property DayHeadAttributes: TVpDayHeadAttr - read FDayHeadAttributes write FDayHeadAttributes; + read FDayHeadAttr write FDayHeadAttr; property DayNameStyle: TVpMVDayNameStyle read FDayNameStyle write SetDayNameStyle; property DayNumberFont: TVpFont @@ -256,12 +277,14 @@ type read FEventDayStyle write SetEventDayStyle; property EventFont: TVpFont read FEventFont write SetEventFont; - property HeadAttributes: TVpMvHeadAttributes + property HeadAttributes: TVpMvHeadAttr read FHeadAttr write FHeadAttr; property LineColor: TColor read FLineColor write SetLineColor; property TimeFormat: TVpTimeFormat read FTimeFormat write SetTimeFormat; + property TodayAttributes: TVpMvTodayAttr + read FTodayAttr write FTodayAttr; property OffDayColor: TColor read FOffDayColor write SetOffDayColor; property OffDayFontColor: TColor @@ -293,9 +316,9 @@ uses (*****************************************************************************) -{ TVpMvHeadAttributes } +{ TVpMvHeadAttr } -constructor TVpMvHeadAttributes.Create(AOwner: TVpMonthView); +constructor TVpMvHeadAttr.Create(AOwner: TVpMonthView); begin inherited Create; FOwner := AOwner; @@ -303,13 +326,13 @@ begin FFont := TVpFont.Create(AOwner); end; -destructor TVpMvHeadAttributes.Destroy; +destructor TVpMvHeadAttr.Destroy; begin FFont.Free; inherited; end; -procedure TVpMvHeadAttributes.SetColor(const Value: TColor); +procedure TVpMvHeadAttr.SetColor(const Value: TColor); begin if FColor <> Value then begin FColor := Value; @@ -317,7 +340,7 @@ begin end; end; -procedure TVpMvHeadAttributes.SetFont(Value: TVpFont); +procedure TVpMvHeadAttr.SetFont(Value: TVpFont); begin FFont.Assign(Value); end; @@ -358,7 +381,54 @@ begin MonthView.Invalidate; end; end; -{=====} + + +(*****************************************************************************) +{ TVpMvTodayAttr } + +constructor TVpMvTodayAttr.Create(AOwner: TVpMonthView); +begin + inherited Create; + FMonthView := AOwner; + FFont := TVpFont.Create(AOwner); + FFont.Assign(FMonthView.Font); + FColor := clSilver; + FBorderPen := TPen.Create; + FBorderPen.Color := clRed; + FBorderPen.Width := 3; + FBorderPen.OnChange := FMonthView.mvPenChanged; +end; + +destructor TVpMvTodayAttr.Destroy; +begin + FBorderPen.Free; + inherited; +end; + +procedure TVpMvTodayAttr.SetColor(Value: TColor); +begin + if Value <> FColor then begin + FColor := Value; + MonthView.Invalidate; + end; +end; + +procedure TVpMvTodayAttr.SetFont(Value: TVpFont); +begin + if Value <> FFont then begin + FFont.Assign(Value); + MonthView.Invalidate; + end; +end; + +procedure TVpMvTodayAttr.SetBorderPen(Value: TPen); +begin + if Value <> FBorderPen then begin + FBorderPen.Assign(Value); + MonthView.Invalidate; + end; +end; + (*****************************************************************************) { TVpMonthView } @@ -369,8 +439,9 @@ begin ControlStyle := [csCaptureMouse, csOpaque, csDoubleClicks]; { Create internal classes and stuff } - FHeadAttr := TVpMvHeadAttributes.Create(self); - FDayHeadAttributes := TVpDayHeadAttr.Create(self); + FHeadAttr := TVpMvHeadAttr.Create(self); + FDayHeadAttr := TVpDayHeadAttr.Create(self); + FTodayAttr := TVpMvTodayAttr.Create(self); mvEventList := TList.Create; mvSpinButtons := TUpDown.Create(self); @@ -406,7 +477,7 @@ begin // FDayHeadAttributes.Font.Name := 'Tahoma'; wp: better use defaults // FDayHeadAttributes.Font.Size := 10; // FDayHeadAttributes.Font.Style := []; - FDayHeadAttributes.Color := clBtnFace; + FDayHeadAttr.Color := clBtnFace; { Assign default font to DayNumberFont and EventFont } FDayNumberFont := TVpFont.Create(AOwner); @@ -434,7 +505,8 @@ end; destructor TVpMonthView.Destroy; begin - FDayHeadAttributes.Free; + FTodayAttr.Free; + FDayHeadAttr.Free; FDayNumberFont.Free; FEventFont.Free; mvSpinButtons.Free; @@ -487,13 +559,11 @@ begin end; end; end; -{=====} - { -procedure TVpMonthView.mvFontChanged(Sender: TObject); + +procedure TVpMonthView.mvPenChanged(Sender: TObject); begin Invalidate; -end; } -{=====} +end; procedure TVpMonthView.Loaded; begin diff --git a/components/tvplanit/source/vpmonthviewpainter.pas b/components/tvplanit/source/vpmonthviewpainter.pas index 3c718b36e..e61ae011b 100644 --- a/components/tvplanit/source/vpmonthviewpainter.pas +++ b/components/tvplanit/source/vpmonthviewpainter.pas @@ -26,6 +26,8 @@ type RealOffDayColor: TColor; RealSelDayColor: TColor; EventFontColor: TColor; + TodayFontColor: TColor; + TodayAttrColor: TColor; DotDotDotColor: TColor; protected @@ -33,6 +35,7 @@ type procedure DrawBorders; procedure DrawDayHead; procedure DrawDays; + procedure DrawFocusRect(ARect: TRect; FixRight: Boolean = false); procedure DrawHeader; procedure FixFontHeights; procedure InitColors; @@ -243,12 +246,16 @@ var EventList: TList; Drawn: Boolean; TextAdjust: Integer; + TextH: Integer; FontStyle: TFontStyles; OldBrush: TBrush; OldPen: TPen; OldFont: TFont; - dx: Integer; + todayDate: TDate; + tmpRect: TRect; begin + todayDate := Date(); + { initialize the MonthDayArray } with TVpMonthViewOpener(FMonthView) do for I := 0 to Pred(Length(mvMonthDayArray)) do begin @@ -291,52 +298,46 @@ begin try for Row := 0 to 5 do begin for Col := 0 to 6 do begin - if (Col = 6) then begin - { draws the far right day for this week } - ThisDate := trunc(StartingDate + DayNumber); - DecodeDate(ThisDate, Y, Tmp, D); + ThisDate := Trunc(StartingDate + DayNumber); + DecodeDate(ThisDate, Y, Tmp, D); - { Allow the user to draw the day } - Drawn := false; - if Assigned(FMonthView.OwnerDrawCells) then begin - { wp: Using Canvas here does not seem correct ... - OldBrush.Assign(Canvas.Brush); - OldPen.Assign(Canvas.Pen); - OldFont.Assign(Canvas.Font); } - OldBrush.Assign(RenderCanvas.Brush); - OldPen.Assign(RenderCanvas.Pen); - OldFont.Assign(RenderCanvas.Font); - try - FMonthView.OwnerDrawCells(self, RenderCanvas, TextRect, D, Drawn); - if Drawn then continue; - finally - { wp: Again, using Canvas here does not seem correct ... - Canvas.Brush.Assign (OldBrush); - Canvas.Pen.Assign (OldPen); - Canvas.Font.Assign (OldFont); } - RenderCanvas.Brush.Assign(OldBrush); - RenderCanvas.Pen.Assign(OldPen); - RenderCanvas.Font.Assign(OldFont); - end; + { Allow the user to draw the day } + Drawn := false; + if Assigned(FMonthView.OwnerDrawCells) then begin + { wp: Using Canvas here does not look correct... + OldBrush.Assign (Canvas.Brush); + OldPen.Assign (Canvas.Pen); + OldFont.Assign (Canvas.Font); } + OldBrush.Assign(RenderCanvas.Brush); + OldPen.Assign(RenderCanvas.Pen); + OldFont.Assign(RenderCanvas.Font); + try + FMonthView.OwnerDrawCells(self, RenderCanvas, TextRect, D, Drawn); + if Drawn then continue; + finally + { wp: Using Canvas here does not look correct... + Canvas.Brush.Assign (OldBrush); + Canvas.Pen.Assign (OldPen); + Canvas.Font.Assign (OldFont); } + RenderCanvas.Brush.Assign(OldBrush); + RenderCanvas.Pen.Assign(OldPen); + RenderCanvas.Font.Assign(OldFont); end; + end; + { draws the far right day for this week } + if (Col = 6) then begin TextRect.Right := TextRect.Right + 8; + tmpRect := TextRect; + if TextRect.Bottom > RealBottom then + tmpRect.Bottom := RealBottom; if Tmp <> M then begin RenderCanvas.Brush.Color := RealOffDayColor; - if TextRect.Bottom > RealBottom then - TPSFillRect( - RenderCanvas, - Angle, - RenderIn, - Rect(TextRect.Left, TextRect.Top, RealRight, RealBottom) - ) - else - TPSFillRect( - RenderCanvas, - Angle, - RenderIn, - Rect(TextRect.Left, TextRect.Top, RealRight, TextRect.Bottom) - ); + TPSFillRect(RenderCanvas, Angle, RenderIn, tmpRect); + end else + if ThisDate = todayDate then begin + RenderCanvas.Brush.Color := TodayAttrColor; + TPSFillRect(RenderCanvas, Angle, RenderIn, tmpRect); end else RenderCanvas.Brush.Color := RealColor; @@ -348,24 +349,17 @@ begin Str := FormatDateTime('d', ThisDate); { set the proper font and style } - RenderCanvas.Font.Assign(FMonthView.DayNumberFont); + if ThisDate = todayDate then + RenderCanvas.Font.Assign(FMonthView.TodayAttributes.Font) + else + RenderCanvas.Font.Assign(FMonthView.DayNumberFont); fontstyle := Rendercanvas.Font.style; - if (DisplayDate = ThisDate) then begin if FMonthView.Focused then begin - TPSDrawFocusRect( - RenderCanvas, - Angle, - RenderIn, - Rect(TextRect.Left - 2, TextRect.Top - 2, TextRect.Right + 2, TextRect.Bottom + 2) - ); - TPSDrawFocusRect( - RenderCanvas, - Angle, - RenderIn, - Rect(TextRect.Left + 2, TextRect.Top + 2, TextRect.Right - 2, TextRect.Bottom - 2) - ); + tmpRect := TextRect; + dec(tmpRect.Right, 4); + DrawFocusRect(tmpRect, true); end; RenderCanvas.Font.Color := RealSelDayColor; RenderCanvas.Font.Style := FMonthView.DayNumberFont.Style + [fsBold]; @@ -388,23 +382,29 @@ begin FontStyle := RenderCanvas.Font.Style; RenderCanvas.Font.Style := [fsBold, fsItalic]; TextAdjust := RenderCanvas.TextWidth(Str); + TextH := RenderCanvas.TextHeight(Str); RenderCanvas.Font.Style := FontStyle; if Tmp <> M then RenderCanvas.Font.Color := FMonthView.OffDayFontColor; - { write the day number at the top of the square. } + { Write the day number at the top of the TextRect. } + tmpRect.Left := TextRect.Left + TVpMonthViewOpener(FMonthView).mvColWidth - TextAdjust - TextMargin; if fsItalic in RenderCanvas.Font.Style then - dx := -2 - else - dx := 0; - TPSTextOut( - RenderCanvas, - Angle, - RenderIn, - TextRect.Left + TVpMonthViewOpener(FMonthView).mvColWidth - TextAdjust - TextMargin + dx, - TextRect.Top + TextMargin div 2, - Str - ); + dec(tmpRect.Left, 2); + tmpRect.Top := TextRect.Top + TextMargin div 2; + tmpRect.Right := tmpRect.Left + TextAdjust; + tmpRect.Bottom := tmpRect.Top + RenderCanvas.TextHeight(Str); + TPSTextOut(RenderCanvas, Angle, RenderIn, tmpRect.Left, tmpRect.Top, Str); + + { Highlight today by a border } + if ThisDate = todayDate then begin + InflateRect(tmpRect, 3, 3); + RenderCanvas.Pen.Assign(FMonthView.TodayAttributes.BorderPen); + RenderCanvas.Brush.Style := bsClear; + RenderCanvas.Rectangle(tmpRect); + RenderCanvas.Pen.Assign(OldPen); + RenderCanvas.Brush.Assign(OldBrush); + end; { Update MonthDayArray } with TVpMonthViewOpener(FMonthView) do begin @@ -425,38 +425,16 @@ begin TextRect.Top + TVpMonthViewOpener(FMonthView).mvRowHeight ); end // if Col = 6 ... - else begin - { draws all days for the week, except the far right one } - ThisDate := Trunc(StartingDate + DayNumber); - DecodeDate(ThisDate, Y, Tmp, D); - - { Allow the user to draw the day } - Drawn := false; - if Assigned(FMonthView.OwnerDrawCells) then begin - { wp: Using Canvas here does not look correct... - OldBrush.Assign (Canvas.Brush); - OldPen.Assign (Canvas.Pen); - OldFont.Assign (Canvas.Font); } - OldBrush.Assign(RenderCanvas.Brush); - OldPen.Assign(RenderCanvas.Pen); - OldFont.Assign(RenderCanvas.Font); - try - FMonthView.OwnerDrawCells(self, RenderCanvas, TextRect, D, Drawn); - if Drawn then continue; - finally - { wp: Using Canvas here does not look correct... - Canvas.Brush.Assign (OldBrush); - Canvas.Pen.Assign (OldPen); - Canvas.Font.Assign (OldFont); } - RenderCanvas.Brush.Assign(OldBrush); - RenderCanvas.Pen.Assign(OldPen); - RenderCanvas.Font.Assign(OldFont); - end; - end; - + else + { draws all days for the week, except the far right one } + begin if Tmp <> M then begin RenderCanvas.Brush.Color := RealOffDayColor; TPSFillRect(RenderCanvas, Angle, RenderIn, TextRect); + end else + if ThisDate = todayDate then begin + RenderCanvas.Brush.Color := TodayAttrColor; + TPSFillRect(RenderCanvas, Angle, RenderIn, TextRect); end else RenderCanvas.Brush.Color := RealColor; @@ -474,22 +452,15 @@ begin Str := FormatDateTime('d', ThisDate); { set the proper font and style } - RenderCanvas.Font.Assign(FMonthView.DayNumberFont); + if ThisDate = todayDate then + RenderCanvas.Font.Assign(FMonthView.TodayAttributes.Font) + else + RenderCanvas.Font.Assign(FMonthView.DayNumberFont); + fontstyle := Rendercanvas.Font.style; + if (DisplayDate = ThisDate) then begin - if FMonthView.Focused then begin - TPSDrawFocusRect( - RenderCanvas, - Angle, - RenderIn, - Rect(TextRect.Left - 2, TextRect.Top - 2, TextRect.Right + 2, TextRect.Bottom + 2) - ); - TPSDrawFocusRect( - RenderCanvas, - Angle, - RenderIn, - Rect(TextRect.Left + 2, TextRect.Top + 2, TextRect.Right - 2, TextRect.Bottom - 2) - ); - end; + if FMonthView.Focused then + DrawFocusRect(TextRect); RenderCanvas.Font.Color := RealSelDayColor; RenderCanvas.Font.Style := FMonthView.DayNumberFont.Style + [fsBold]; if (FMonthView.EventDayStyle <> []) and (FMonthView.DataStore.Resource <> nil) and @@ -510,23 +481,30 @@ begin FontStyle := RenderCanvas.Font.Style; RenderCanvas.Font.Style := [fsBold, fsItalic]; - TextAdjust := RenderCanvas.TextWidth (Str); + TextAdjust := RenderCanvas.TextWidth(Str); + TextH := RenderCanvas.TextHeight(Str); RenderCanvas.Font.Style := FontStyle; if Tmp <> M then RenderCanvas.Font.Color := FMonthView.OffdayFontColor; + { Write the day number at the top of the TextRect. } + tmpRect.Left := TextRect.Right - TextAdjust - TextMargin; if fsItalic in RenderCanvas.Font.Style then - dx := -2 - else - dx := 0; - TPSTextOut( - RenderCanvas, - Angle, - RenderIn, - TextRect.Right - TextAdjust - TextMargin + dx, - TextRect.Top + TextMargin div 2, - Str - ); + dec(tmpRect.Left, 2); + tmpRect.Top := TextRect.Top + TextMargin div 2; + tmpRect.Right := tmpRect.Left + TextAdjust; + tmpRect.Bottom := tmpRect.Top + TextH; + TPSTextOut(RenderCanvas, Angle, RenderIn, tmpRect.Left, tmpRect.Top, Str); + + { Highlight today by a border } + if ThisDate = todayDate then begin + InflateRect(tmpRect, 3, 3); + RenderCanvas.Pen.Assign(FMonthView.TodayAttributes.BorderPen); + RenderCanvas.Brush.Style := bsClear; + RenderCanvas.Rectangle(tmpRect); + RenderCanvas.Pen.Assign(OldPen); + RenderCanvas.Brush.Assign(OldBrush); + end; { Update Array } with TVpMonthViewOpener(FMonthView) do begin @@ -700,6 +678,21 @@ begin 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); + if FixRight then + inc(tmpRect.Right); + TPSDrawFocusRect(RenderCanvas, Angle, RenderIn, tmpRect); +end; + procedure TVpMonthViewPainter.DrawHeader; var HeadRect: TRect; @@ -807,6 +800,8 @@ begin RealOffDayColor := clSilver; RealSelDayColor := clWhite; EventFontColor := clBlack; + TodayFontColor := clBlack; + TodayAttrColor := clWhite; end else begin BevelHighlight := clBtnHighlight; BevelShadow := clBtnShadow; @@ -819,6 +814,8 @@ begin RealOffDayColor := FMonthView.OffDayColor; RealSelDayColor := FMonthView.SelectedDayColor; EventFontColor := FMonthView.DayNumberFont.Color; + TodayFontColor := FMonthView.TodayAttributes.Font.Color; + TodayAttrColor := FMonthView.TodayAttributes.Color; end; DotDotDotColor := clBlack; end;