From 3b7adafe739e3afeba9d29c838998fde2b7fd8bf Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Wed, 22 Jun 2016 22:37:44 +0000 Subject: [PATCH] tvplanit: Move MonthView painting code into a separate unit (VpMonthViewPainter). Some minor fixes in demo. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4808 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../tvplanit/examples/demo/demomain.pas | 5 +- .../tvplanit/packages/laz_visualplanit.lpk | 6 +- components/tvplanit/source/vpmonthview.pas | 758 +----------------- 3 files changed, 16 insertions(+), 753 deletions(-) diff --git a/components/tvplanit/examples/demo/demomain.pas b/components/tvplanit/examples/demo/demomain.pas index 3e8f53343..5d8bc851d 100644 --- a/components/tvplanit/examples/demo/demomain.pas +++ b/components/tvplanit/examples/demo/demomain.pas @@ -409,7 +409,7 @@ begin SetLanguage(lang); SetActiveView(ini.ReadInteger('Settings', 'ActiveView', 0)); - VpNavBar1.ActiveFolder := FActiveView mod 1000; + VpNavBar1.ActiveFolder := FActiveView div 1000; CbTimeFormat.ItemIndex := ini.ReadInteger('Settings', 'TimeFormat', ord(VpDayView1.TimeFormat)); CbTimeFormatChange(nil); @@ -444,9 +444,12 @@ begin ini.WriteInteger('Form', 'Height', Height); ini.WriteInteger('Left', 'Left', Left); ini.WriteInteger('Form', 'Top', Top); + end; + if FActiveView = 0 then begin ini.WriteInteger('Form', 'LeftPanel_Width', LeftPanel.Width); ini.WriteInteger('Form', 'BottomPanel_Height', VpMonthView1.Height); end; + ini.WriteString('Settings', 'Language', FLang); ini.WriteInteger('Settings', 'ActiveView', FActiveView); ini.WriteInteger('Settings', 'TimeFormat', ord(VpDayView1.TimeFormat)); diff --git a/components/tvplanit/packages/laz_visualplanit.lpk b/components/tvplanit/packages/laz_visualplanit.lpk index f0997c137..416968d24 100644 --- a/components/tvplanit/packages/laz_visualplanit.lpk +++ b/components/tvplanit/packages/laz_visualplanit.lpk @@ -32,7 +32,7 @@ Portions created by TurboPower Software Inc. are Copyright (C) 2002 TurboPower S Contributor(s): "/> - + @@ -298,6 +298,10 @@ Contributor(s): "/> + + + + diff --git a/components/tvplanit/source/vpmonthview.pas b/components/tvplanit/source/vpmonthview.pas index 094d8c4b8..f246e0d15 100644 --- a/components/tvplanit/source/vpmonthview.pas +++ b/components/tvplanit/source/vpmonthview.pas @@ -268,7 +268,7 @@ type implementation uses - SysUtils, Math, LazUTF8, Forms, Dialogs, VpEvntEditDlg; + SysUtils, Math, LazUTF8, Forms, Dialogs, VpEvntEditDlg, VpMonthViewPainter; (*****************************************************************************) { TVpContactHeadAttr } @@ -486,761 +486,17 @@ procedure TVpMonthView.RenderToCanvas (RenderCanvas : TCanvas; UseGran : TVpGranularity; DisplayOnly : Boolean); var - HeadRect : TRect; - SaveBrushColor : TColor; - SavePenStyle : TPenStyle; - SavePenColor : TColor; - DisplayDate : TDateTime; - - RealWidth : Integer; - RealHeight : Integer; - RealLeft : Integer; - RealRight : Integer; - RealTop : Integer; - RealBottom : Integer; - Rgn : HRGN; - - RealColor : TColor; - BevelHighlight : TColor; - BevelShadow : TColor; - BevelDarkShadow : TColor; - BevelFace : TColor; - DayHeadAttrColor : TColor; - RealLineColor : TColor; - RealOffDayColor : TColor; - RealSelDayColor : TColor; - EventFontColor : TColor; - DotDotDotColor : TColor; - - procedure Clear; - begin - RenderCanvas.Brush.Color := RealColor; - RenderCanvas.FillRect(RenderIn); - end; - {-} - - procedure SetMeasurements; - begin - RealWidth := TPSViewportWidth (Angle, RenderIn); - RealHeight := TPSViewportHeight (Angle, RenderIn); - RealLeft := TPSViewportLeft (Angle, RenderIn); - RealRight := TPSViewportRight (Angle, RenderIn); - RealTop := TPSViewportTop (Angle, RenderIn); - RealBottom := TPSViewportBottom (Angle, RenderIn); - - if RenderDate = 0 then - DisplayDate := Date - else - DisplayDate := RenderDate; - - { we use the VpProductName because is is a good representation of some } - { generic text } - RenderCanvas.Font.Assign(FDayHeadAttributes.Font); - mvDayHeadHeight := RenderCanvas.TextHeight(VpProductName) + TextMargin + 2; - RenderCanvas.Font.Assign(FDayNumberFont); - mvDayNumberHeight := RenderCanvas.TextHeight('00'); - RenderCanvas.Font.Assign(FEventFont); - mvEventTextHeight := RenderCanvas.TextHeight(VpProductName); - RenderCanvas.Font.Assign(Font); - mvLineHeight := RenderCanvas.TextHeight(VpProductName) + 2; - mvColWidth := (RealWidth - 4) div 7; - end; - {-} - - procedure DrawHeader; - var - HeadTextRect: TRect; - HeadStr: string; - HeadStrLen : Integer; - begin - RenderCanvas.Brush.Color := DayHeadAttrColor; - { draw the header cell and borders } - - if FDrawingStyle = dsFlat then begin - { draw an outer and inner bevel } - HeadRect.Left := RealLeft + 1; - HeadRect.Top := RealTop + 1; - HeadRect.Right := RealRight - 1; - HeadRect.Bottom := RealTop + mvDayHeadHeight; - TPSFillRect (RenderCanvas, Angle, RenderIn, HeadRect); - DrawBevelRect (RenderCanvas, - TPSRotateRectangle (Angle, RenderIn, HeadRect), - BevelHighlight, BevelShadow); - end else if FDrawingStyle = ds3d then begin - { draw a 3d bevel } - HeadRect.Left := RealLeft + 2; - HeadRect.Top := RealTop + 2; - HeadRect.Right := RealRight - 3; - HeadRect.Bottom := RealTop + mvDayHeadHeight; - TPSFillRect (RenderCanvas, Angle, RenderIn, HeadRect); - DrawBevelRect (RenderCanvas, - TPSRotateRectangle (Angle, RenderIn, HeadRect), - BevelHighlight, BevelDarkShadow); - end - else begin - HeadRect.Left := RealLeft + 1; - HeadRect.Top := RealTop + 1; - HeadRect.Right := RealRight - 1; - HeadRect.Bottom := RealTop + mvDayHeadHeight; - end; - - { Acquire startdate and end date } - {$IF FPC_FULLVERSION >= 30000} - HeadStr := FormatDateTime(DateLabelFormat, DisplayDate); - {$ELSE} - HeadStr := SysToUTF8(FormatDateTime(DateLabelFormat, DisplayDate)); - {$ENDIF} - - { draw the text } - if (DisplayOnly) and - (RenderCanvas.TextWidth (HeadStr) >= RealWidth) then - HeadTextRect.TopLeft:= Point (RealLeft + TextMargin * 2, - HeadRect.Top) - else if DisplayOnly then - HeadTextRect.TopLeft := Point (RealLeft + - (RealWidth - - RenderCanvas.TextWidth (HeadStr)) div 2, - HeadRect.Top) - else - HeadTextRect.TopLeft := Point (RealLeft + 30 + TextMargin * 2, - HeadRect.Top); - 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 - TextMargin); - end; - - { position the spinner } - mvSpinButtons.Height := Trunc(mvDayHeadHeight * 0.8); - mvSpinButtons.Width := mvSpinButtons.Height * 2; - mvSpinButtons.Left := TextMargin; - mvSpinButtons.Top := (mvDayHeadHeight - mvSpinButtons.Height) div 2 + 2; - - RenderCanvas.Font.Assign (FDayHeadAttributes.Font); - TPSTextOut (RenderCanvas, Angle, RenderIn, - RealLeft + mvSpinButtons.Width + TextMargin * 2, - HeadTextRect.Top + TextMargin, HeadStr); - end; - {-} - - procedure DrawDayHead; - var - dhRect : TRect; - I : Integer; - DayTag : Integer; - Str : string; - StrL : Integer; - begin - { clear day head area } - RenderCanvas.Font.Assign(DayHeadAttributes.Font); - RenderCanvas.Brush.Color := DayHeadAttrColor; - - { build rect } - if DrawingStyle = ds3D then begin - dhRect.Left := RealLeft + 1; - dhRect.Top := RealTop + mvDayHeadHeight + 3; - dhRect.Right := RealRight - 3; - dhRect.Bottom := dhRect.Top + mvDayHeadHeight; - TPSFillRect (RenderCanvas, Angle, RenderIn, dhRect); - DrawBevelRect (RenderCanvas, - TPSRotateRectangle (Angle, RenderIn, dhRect), - BevelHighlight, BevelDarkShadow); - end else begin - dhRect.Left := RealLeft + 1; - dhRect.Top := RealTop + mvDayHeadHeight + 2; - dhRect.Right := RealRight - 1; - dhRect.Bottom := dhRect.Top + mvDayHeadHeight; - TPSFillRect (RenderCanvas, Angle, RenderIn, dhRect); - DrawBevelRect (RenderCanvas, - TPSRotateRectangle (Angle, RenderIn, dhRect), - BevelHighlight, BevelShadow); - end; - - DayTag := Ord(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 - DrawBevelRect (RenderCanvas, - TPSRotateRectangle (Angle, RenderIn, - Rect (dhRect.Right, - dhRect.Top + 3, - dhRect.Right + 1, - dhRect.Bottom - 3)), - BevelShadow, BevelHighlight); - - if FDayNameStyle = dsLong then - { Draw each day's full caption... } - {$IFDEF LCL} - str := FormatSettings.LongDayNames[DayTag+1] - {$ELSE} - 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 - {$ENDIF } - else if FDayNameStyle = dsShort then - { Draw each day's abbreviated caption... } - {$IFDEF LCL} - str := FormatSettings.ShortDayNames[DayTag+1] - {$ELSE} - 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 - {$ENDIF} - else if FDayNameStyle = dsLetter then - { Draw each day's first letter only } - {$IFDEF LCL} - str := FormatSettings.ShortDayNames[DayTag+1, 1]; - {$ELSE} - 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; - {$ENDIF} - - { Fix Header String } - StrL := RenderCanvas.TextWidth(Str); - if (StrL > mvColWidth - (TextMargin * 2)) then begin - Str := GetDisplayString (RenderCanvas, Str, 0, - mvColWidth - (TextMargin * 2)); - end; - StrL := RenderCanvas.TextWidth(Str); - - TPSTextOut (RenderCanvas, Angle, RenderIn, - dhRect.Left + (dhRect.Right - dhRect.Left) div 2 - - (Strl div 2), dhRect.Top + TextMargin - 1, Str); - - if DayTag = 6 then - DayTag := 0 - else - Inc(DayTag); - dhRect.Left := dhRect.Right; - dhRect.Right := dhRect.Left + mvColWidth; - end; - - end; - {-} - - procedure DrawDays; - var - TextRect : TRect; - Col, Row : Integer; - DayNumber : Integer; - M, D, Y, Tmp : Word; - MonthStartsOn : Integer; - DayTag : Integer; - DayOffset : Integer; - StartingDate : TDateTime; - ThisDate : TDateTime; - Str : string; - StrLn : Integer; - I, J : Integer; - EventList : TList; - Drawn : Boolean; - TextAdjust : Integer; - FontStyle : TFontStyles; - OldBrush : TBrush; - OldPen : TPen; - OldFont : TFont; - begin - { initialize the MonthDayArray } - for I := 0 to Pred(Length(mvMonthDayArray)) do begin - mvMonthDayArray[I].Rec := Rect(-1, -1, -1, -1); - mvMonthDayArray[I].Date := 0.0; - end; - - RenderCanvas.Pen.Color := RealLineColor; - RenderCanvas.Brush.Color := RealColor; - mvRowHeight := (RealHeight - (mvDayHeadHeight * 2) - 4) div 6; - TextRect.TopLeft := Point (RealLeft + 1, - RealTop + (mvDayHeadHeight * 2) + 4); - TextRect.BottomRight := Point (TextRect.Left + mvColWidth, - TextRect.Top + mvRowHeight); - - { Determine the starting date and offset } - DecodeDate(DisplayDate, Y, M, D); - StartingDate := EncodeDate(Y, M, 1); - MonthStartsOn := DayOfWeek(StartingDate); - DayTag := Ord(WeekStartsOn); - DayOffset := DayTag - MonthStartsOn; - - I := 0; - DayNumber := DayOffset + 1; - - { iterate through each column, row by row, drawing each day in numerical } - { order. } - - OldBrush := TBrush.Create; - try - OldPen := TPen.Create; - try - OldFont := TFont.Create; - 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); - - { Allow the user to draw the day } - Drawn := false; - if Assigned(FOwnerDrawCells) then begin - OldBrush.Assign (Canvas.Brush); - OldPen.Assign (Canvas.Pen); - OldFont.Assign (Canvas.Font); - try - FOwnerDrawCells(self, RenderCanvas, TextRect, D, Drawn); - if Drawn then continue; - finally - Canvas.Brush.Assign (OldBrush); - Canvas.Pen.Assign (OldPen); - Canvas.Font.Assign (OldFont); - end; - end; - - TextRect.Right := TextRect.Right + 8; - 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)); - end else - RenderCanvas.Brush.Color := RealColor; - { draw bottom line } - TPSMoveTo (RenderCanvas, Angle, RenderIn, - TextRect.Left, TextRect.Bottom); - TPSLineTo (RenderCanvas, Angle, RenderIn, RealRight - 2, - TextRect.Bottom); - { Paint the day number } - Str := FormatDateTime('d', ThisDate); - - { set the proper font and style } - RenderCanvas.Font.Assign(FDayNumberFont); - if (DisplayDate = ThisDate) then begin - if 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; - RenderCanvas.Font.Color := RealSelDayColor; - RenderCanvas.Font.Style := FDayNumberFont.Style + [fsBold]; - if (FEventDayStyle <> []) and (DataStore.Resource <> nil) - and (DataStore.Resource.Schedule.EventCountByDay(ThisDate) > 0) - then - RenderCanvas.Font.Style := RenderCanvas.Font.Style - + FEventDayStyle; - end else begin - { Set the font style for days which have events. } - if (FEventDayStyle <> []) and (DataStore.Resource <> nil) - and (DataStore.Resource.Schedule.EventCountByDay(ThisDate) > 0) - then - RenderCanvas.Font.Style := RenderCanvas.Font.Style - + FEventDayStyle - else begin - RenderCanvas.Font.Color := EventFontColor; - RenderCanvas.Font.Style := FDayNumberFont.Style; - end; - end; - - FontStyle := RenderCanvas.Font.Style; - RenderCanvas.Font.Style := [fsBold, fsItalic]; - TextAdjust := RenderCanvas.TextWidth (Str); - RenderCanvas.Font.Style := FontStyle; - if Tmp <> M then - RenderCanvas.Font.Color := FOffDayFontColor; - - { write the day number at the top of the square. } - if fsItalic in RenderCanvas.Font.Style then - TPSTextOut (RenderCanvas, Angle, RenderIn, - TextRect.Left + mvColWidth - TextAdjust - - TextMargin - 2, - TextRect.Top + (TextMargin div 2), Str) - else - TPSTextOut (RenderCanvas, Angle, RenderIn, - TextRect.Left + mvColWidth - TextAdjust - - TextMargin, TextRect.Top + (TextMargin div 2), - Str); - - - { Update MonthDayArray } - mvMonthDayArray[I].Rec := TextRect; - mvMonthDayArray[I].Date := ThisDate; - mvMonthDayArray[I].OffDay := Tmp <> M; - Inc(DayNumber); - Inc(I); - - { drop rect down one row and all the way to the left } - TextRect.TopLeft := Point(RealLeft + 1, TextRect.Bottom + 1); - TextRect.BottomRight := Point(TextRect.Left + mvColWidth, - TextRect.Top + mvRowHeight); - end 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(FOwnerDrawCells) then begin - OldBrush.Assign (Canvas.Brush); - OldPen.Assign (Canvas.Pen); - OldFont.Assign (Canvas.Font); - try - FOwnerDrawCells(self, RenderCanvas, TextRect, D, Drawn); - if Drawn then continue; - finally - Canvas.Brush.Assign (OldBrush); - Canvas.Pen.Assign (OldPen); - Canvas.Font.Assign (OldFont); - end; - end; - - if Tmp <> M then begin - RenderCanvas.Brush.Color := RealOffDayColor; - TPSFillRect (RenderCanvas, Angle, RenderIn, TextRect); - end else - RenderCanvas.Brush.Color := RealColor; - { draw right side and bottom lines } - TPSMoveTo (RenderCanvas, Angle, RenderIn, TextRect.Right, - TextRect.top); - if TextRect.Bottom > RealBottom then begin - TPSLineTo (RenderCanvas, Angle, RenderIn, TextRect.Right, - RealBottom); - TPSLineTo (RenderCanvas, Angle, RenderIn, TextRect.Left - 1, - RealBottom); - end else begin - TPSLineTo (RenderCanvas, Angle, RenderIn, TextRect.Right, - TextRect.Bottom); - TPSLineTo (RenderCanvas, Angle, RenderIn, TextRect.Left - 1, - TextRect.Bottom); - end; - { paint the day number } - Str := FormatDateTime('d', ThisDate); - - { set the proper font and style } - RenderCanvas.Font.Assign(FDayNumberFont); - if (DisplayDate = ThisDate) then begin - if 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; - RenderCanvas.Font.Color := RealSelDayColor; - RenderCanvas.Font.Style := FDayNumberFont.Style + [fsBold]; - if (FEventDayStyle <> []) and (DataStore.Resource <> nil) - and (DataStore.Resource.Schedule.EventCountByDay(ThisDate) > 0) - then - RenderCanvas.Font.Style := RenderCanvas.Font.Style - + FEventDayStyle; - end else begin - { Set the font style for days which have events. } - if (FEventDayStyle <> []) and (DataStore.Resource <> nil) - and (DataStore.Resource.Schedule.EventCountByDay(ThisDate) > 0) - then - RenderCanvas.Font.Style := RenderCanvas.Font.Style - + FEventDayStyle - else begin - RenderCanvas.Font.Color := EventFontColor; - RenderCanvas.Font.Style := FDayNumberFont.Style; - end; - end; - - FontStyle := RenderCanvas.Font.Style; - RenderCanvas.Font.Style := [fsBold, fsItalic]; - TextAdjust := RenderCanvas.TextWidth (Str); - RenderCanvas.Font.Style := FontStyle; - if Tmp <> M then - RenderCanvas.Font.Color := FOffdayFontColor; - - if fsItalic in RenderCanvas.Font.Style then - TPSTextOut (RenderCanvas, Angle, RenderIn, - TextRect.Right - TextAdjust - TextMargin - 2, - TextRect.Top + (TextMargin div 2), Str) - else - TPSTextOut (RenderCanvas, Angle, RenderIn, - TextRect.Right - TextAdjust - TextMargin, - TextRect.Top + (TextMargin div 2), Str); - - { Update Array } - mvMonthDayArray[I].Rec := TextRect; - mvMonthDayArray[I].Date := ThisDate; - mvMonthDayArray[I].OffDay := Tmp <> M; - Inc(DayNumber); - Inc(I); - { slide rect one column to the right } - TextRect.Left := TextRect.Right + 1; - TextRect.Right := TextRect.Right + mvColWidth; - end; - end; - end; - - finally - OldFont.Free; - end; - finally - OldPen.Free; - end; - finally - OldBrush.Free; - end; - - RenderCanvas.Pen.Color := RealLineColor; - RenderCanvas.Pen.Style := psSolid; - RenderCanvas.Brush.Color := RealColor; - - { write the events } - if (DataStore <> nil) and FShowEvents and (DataStore.Resource <> nil) - and (DataStore.Resource.Schedule.EventCount <> 0) then begin - EventList := TList.Create; - try - for I := 0 to 43 do begin - EventList.Clear; - DataStore.Resource.Schedule.EventsByDate(mvMonthDayArray[I].Date, EventList); - if EventList.Count > 0 then begin - { there are events scheduled for this day } - - { initialize TextRect for this day } - TextRect.TopLeft := Point(mvMonthDayArray[I].Rec.Left, - mvMonthDayArray[I].Rec.Top); - TextRect.BottomRight := Point(TextRect.Left + mvColWidth, - TextRect.Top + mvEventTextHeight + (TextMargin div 2)); - - { set canvas color } - if 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 - - if (TextRect.Bottom > mvMonthDayArray[I].Rec.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. } - RenderCanvas.Brush.Color := DotDotDotColor; - { draw dot dot dot } - TPSFillRect (RenderCanvas, Angle, RenderIn, - Rect(mvMonthDayArray[I].Rec.Right - 20, - mvMonthDayArray[I].Rec.Bottom - 7, - mvMonthDayArray[I].Rec.Right - 17, - mvMonthDayArray[I].Rec.Bottom - 4)); - TPSFillRect (RenderCanvas, Angle, RenderIn, - Rect(mvMonthDayArray[I].Rec.Right - 13, - mvMonthDayArray[I].Rec.Bottom - 7, - mvMonthDayArray[I].Rec.Right - 10, - mvMonthDayArray[I].Rec.Bottom - 4)); - TPSFillRect (RenderCanvas, Angle, RenderIn, - Rect(mvMonthDayArray[I].Rec.Right - 6, - mvMonthDayArray[I].Rec.Bottom - 7, - mvMonthDayArray[I].Rec.Right - 3, - mvMonthDayArray[I].Rec.Bottom - 4)); - Break; - end; - - { shorten events that are next to the day number, in order } - { to give the day number enough room } - if (TextRect.Top < mvMonthDayArray[I].Rec.Top - + mvDayNumberHeight + (TextMargin div 2)) - then - TextRect.Right := TextRect.Left + mvColWidth - - mvDayNumberHeight - TextMargin - else - TextRect.Right := TextRect.Left + mvColWidth; - - { format the display text } - if ShowEventTime then begin - if (TimeFormat = tf24Hour) then - Str := FormatDateTime('hh:nn', - TVpEvent(EventList.List^[j]).StartTime) - else - Str := FormatDateTime('hh:nn AM/PM', - TVpEvent(EventList.List^[j]).StartTime); - Str := Str + ' - ' + TVpEvent(EventList.List^[j]).Description; - end else - Str := TVpEvent(EventList.List^[j]).Description; - - { set the event font } - RenderCanvas.Font.Assign(FEventFont); - if mvMonthDayArray[I].OffDay then - RenderCanvas.Font.Color := FOffDayFontColor; - - StrLn := RenderCanvas.TextWidth(Str); - if (StrLn > TextRect.Right - TextRect.Left - (TextMargin * 2)) then - begin - Str := GetDisplayString(RenderCanvas, Str, 0, TextRect.Right - - TextRect.Left - (TextMargin * 2)); - end; - - { write the event text } - TPSTextOut (RenderCanvas, Angle, RenderIn, TextRect.Left + (TextMargin div 2), - TextRect.Top + (TextMargin div 2), Str); - - { - begin block} - Inc(mvVisibleEvents); - mvEventArray[mvVisibleEvents - 1].Rec := TextRect; - mvEventArray[mvVisibleEvents - 1].Event := TVpEvent(EventList.List^[j]); - { - end block} - - { 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 DrawBorders; - begin - if FDrawingStyle = dsFlat then begin - { draw an outer and inner bevel } - DrawBevelRect (RenderCanvas, - TPSRotateRectangle (Angle, - RenderIn, - Rect (RealLeft, - RealTop, - RealRight - 1, - RealBottom - 1)), - BevelShadow, - BevelShadow); - end else if FDrawingStyle = ds3d then begin - { draw a 3d bevel } - DrawBevelRect (RenderCanvas, - TPSRotateRectangle (Angle, - RenderIn, - Rect (RealLeft, - RealTop, - RealRight - 1, - RealBottom - 1)), - BevelShadow, - BevelHighlight); - DrawBevelRect (RenderCanvas, - TPSRotateRectangle (Angle, - RenderIn, - Rect (RealLeft + 1, - RealTop + 1, - RealRight - 2, - RealBottom - 2)), - BevelDarkShadow, - BevelFace); - end; - end; - {-} + painter: TVpMonthViewPainter; begin - if DisplayOnly then begin - BevelHighlight := clBlack; - BevelShadow := clBlack; - BevelDarkShadow := clBlack; - BevelFace := clBlack; - RealColor := clWhite; - DayHeadAttrColor := clSilver; - RealLineColor := clBlack; - RealOffDayColor := clSilver; - RealSelDayColor := clWhite; - EventFontColor := clBlack; - end else begin - BevelHighlight := clBtnHighlight; - BevelShadow := clBtnShadow; - BevelDarkShadow := cl3DDkShadow; - BevelFace := clBtnFace; - RealColor := Color; - DayHeadAttrColor := DayHeadAttributes.Color; - RealLineColor := LineColor; - RealOffDayColor := OffDayColor; - RealSelDayColor := FSelectedDayColor; - EventFontColor := FDayNumberFont.Color; - end; - DotDotDotColor := clBlack; - mvPainting := true; - SavePenStyle := RenderCanvas.Pen.Style; - SaveBrushColor := RenderCanvas.Brush.Color; - SavePenColor := RenderCanvas.Pen.Color; - - RenderCanvas.Pen.Style := psSolid; - RenderCanvas.Pen.Width := 1; - RenderCanvas.Pen.Mode := pmCopy; - RenderCanvas.Brush.Style := bsSolid; - - Rgn := CreateRectRgn (RenderIn.Left, RenderIn.Top, - RenderIn.Right, RenderIn.Bottom); + painter := TVpMonthViewPainter.Create(Self, RenderCanvas); try - SelectClipRgn (RenderCanvas.Handle, Rgn); - - { clear client area } - Clear; - - { measure the row heights } - SetMeasurements; - - { draw headers } - DrawHeader; - DrawDayHead; - - { draw days } - mvVisibleEvents := 0; - DrawDays; - - { draw the borders } - DrawBorders; - + painter.RenderToCanvas(RenderIn, Angle, Scale, RenderDate, StartLine, + StopLine, UseGran, DisplayOnly); finally - SelectClipRgn (RenderCanvas.Handle, 0); - DeleteObject (Rgn); + painter.Free; + mvPainting := false; end; - - { reinstate canvas settings} - RenderCanvas.Pen.Style := SavePenStyle; - RenderCanvas.Brush.Color := SaveBrushColor; - RenderCanvas.Pen.Color := SavePenColor; - mvPainting := false; end; procedure TVpMonthView.mvPopulate;