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;