From 716c47854968a33a4094cd7961718ace46234cf6 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Tue, 28 Jun 2016 11:08:29 +0000 Subject: [PATCH] tvplanit: Some clean-up in VpDayView git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4851 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- components/tvplanit/source/vpdayview.pas | 1861 +---------------- .../tvplanit/source/vpdayviewpainter.pas | 183 +- 2 files changed, 74 insertions(+), 1970 deletions(-) diff --git a/components/tvplanit/source/vpdayview.pas b/components/tvplanit/source/vpdayview.pas index 74ef5e924..c80fdfb95 100644 --- a/components/tvplanit/source/vpdayview.pas +++ b/components/tvplanit/source/vpdayview.pas @@ -223,18 +223,6 @@ type read FShowRecurringBitmap write SetShowRecurringBitmap default True; end; - { Defines matrix of event records for managing how events overlap with each other. } - TVpDvEventRec = packed record - Event: Pointer; - Level: Integer; - OLLevels: Integer; { Number of levels which overlap with the event represented by this record. } - WidthDivisor: Integer; { Maximum OLEvents of all of this event's overlapping neighbors. } - RealStartTime: TDateTime; - RealEndTime: TDateTime; - end; - - TVpDvEventArray = array of TVpDvEventRec; - { TVpDayView } TVpDayView = class(TVpLinkableControl) @@ -389,9 +377,6 @@ type procedure EndEdit(Sender: TObject); procedure KeyDown(var Key: Word; Shift: TShiftState); override; procedure SetTimeIntervals(UseGran: TVpGranularity); - { helpers for painting } - function CountOverlappingEvents(Event: TVpEvent; const EArray: TVpDvEventArray): Integer; - function GetMaxOLEvents(Event: TVpEvent; const EArray: TVpDvEventArray): Integer; { message handlers } procedure VpDayViewInit(var Msg: {$IFDEF DELPHI}TMessage{$ELSE}TLMessage{$ENDIF}); message Vp_DayViewInit; {$IFNDEF LCL} @@ -399,7 +384,7 @@ type procedure WMSize(var Msg: TWMSize); message WM_SIZE; procedure WMVScroll(var Msg: TWMVScroll); message WM_VSCROLL; procedure WMSetFocus(var Msg : TWMSetFocus); message WM_SETFOCUS; - procedure WMEraseBackground (var Msg : TWMERASEBKGND); // ??? wp: missing "message WM_ERASEBKGN"? + procedure WMEraseBackground (var Msg : TWMERASEBKGND); // ??? wp: missing "message WM_ERASEBKGND"? procedure CMWantSpecialKey(var Msg: TCMWantSpecialKey); message CM_WANTSPECIALKEY; {$ELSE} function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean; override; @@ -408,7 +393,7 @@ type procedure WMSize(var Msg: TLMSize); message LM_SIZE; procedure WMVScroll(var Msg: TLMVScroll); message LM_VSCROLL; procedure WMSetFocus(var Msg: TLMSetFocus); message LM_SETFOCUS; - procedure WMEraseBackground(var Msg: TLMERASEBKGND); // ??? wp: missing "message WM_ERASEBKGN"? + procedure WMEraseBackground(var Msg: TLMERASEBKGND); message LM_ERASEBKGND; procedure WMLButtonDblClk(var Msg: TLMLButtonDblClk); message LM_LBUTTONDBLCLK; {$ENDIF} @@ -2272,1736 +2257,6 @@ begin dvPainting := false; end; end; - (* -var - TextWidth: Integer; - ColHeadRect: TRect; - CellsRect: TRect; - RowHeadRect: TRect; - ADEventsRect: TRect; - SaveBrushColor: TColor; - SavePenStyle: TPenStyle; - SavePenColor: TColor; - Drawn: Boolean; - ScrollBarOffset: Integer; - EventCount: Integer; - RealWidth: Integer; - RealHeight: Integer; - RealLeft: Integer; - RealRight: Integer; - RealTop: Integer; - RealBottom: Integer; - DayWidth: Integer; - RealNumDays: Integer; - Rgn: HRGN; - RealRowHeight: Integer; - RealColHeadHeight: Integer; - RealRowHeadWidth: Integer; - RealVisibleLines: Integer; - BevelShadow: TColor; - BevelHighlight: TColor; - BevelDarkShadow: TColor; - WindowColor: TColor; - HighlightText: TColor; - RealHeadAttrColor: TColor; - RealRowHeadAttrColor: TColor; - RealLineColor: TColor; - RealColor: TColor; - BevelFace: TColor; - HighlightBkg: TColor; - RealADEventBkgColor: TColor; - ADEventAttrBkgColor: TColor; - ADEventBorderColor: TColor; - - 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); - dvCalcColHeadHeight(Scale); - end; - - procedure dvDrawColHeader(R: TRect; RenderDate: TDateTime; Col: Integer); - var - SaveFont: TFont; - DateStr, ResStr: string; - DateStrLen, ResStrLen: integer; - StrHt: Integer; - TextRect: TRect; - X, Y: Integer; - begin - SaveFont := TFont.Create; - try - SaveFont.Assign(RenderCanvas.Font); - { Draw Column Header } - RenderCanvas.Font.Assign(FHeadAttr.FFont); - RenderCanvas.Brush.Color := RealHeadAttrColor; - RenderCanvas.Pen.Style := psClear; - TPSRectangle(RenderCanvas, Angle, RenderIn, R); - RenderCanvas.Pen.Style := psSolid; - - { Size text rect } - TextRect.TopLeft := R.TopLeft; - TextRect.BottomRight := R.BottomRight; - TextRect.Right := TextRect.Right - 3; - TextRect.Left := TextRect.Left + 2; - - { Fix Date String } - DateStr := FormatDateTime(FDateLabelFormat, RenderDate); - DateStrLen := RenderCanvas.TextWidth(DateStr); - StrHt := RenderCanvas.TextHeight(DateStr); - if DateStrLen > TextRect.Right - TextRect.Left then begin - DateStr := GetDisplayString(RenderCanvas, DateStr, 0, TextRect.Right - TextRect.Left); - DateStrLen := RenderCanvas.TextWidth(DateStr); - end; - - if (DataStore <> nil) and (DataStore.Resource <> nil) and FShowResourceName - then begin - { fix Res String } - ResStr := DataStore.Resource.Description; - ResStrLen := RenderCanvas.TextWidth(ResStr); - if ResStrLen > TextRect.Right - TextRect.Left then begin - ResStr := GetDisplayString(RenderCanvas, ResStr, 0, TextRect.Right - TextRect.Left); - ResStrLen := RenderCanvas.TextWidth(ResStr); - end; - { center and write the resource name in the first column } - if (Col = 0) then begin - X := TextRect.Left + (TextRect.Right - TextRect.Left) div 2 - ResStrLen div 2; - Y := TextRect.Top + TextMargin; - TPSTextOut(RenderCanvas, Angle, RenderIn, X, Y, DataStore.Resource.Description); - end; - { center and write the date string } - X := TextRect.Left + (TextRect.Right - TextRect.Left) div 2 - DateStrLen div 2; - Y := TextRect.Top + (TextMargin * 2) + StrHt; - TPSTextOut(RenderCanvas, Angle, RenderIn, X, Y, DateStr); - end else begin - { center and write the date string } - Y := TextRect.Top + TextMargin; - X := TextRect.Left + (TextRect.Right - TextRect.Left) div 2 - DateStrLen div 2; - TPSTextOut(RenderCanvas, Angle, RenderIn, X, Y, DateStr); - end; - - {Draw Column Head Borders } - if FDrawingStyle = dsFlat then begin - RenderCanvas.Pen.Color := BevelShadow; - {bottom} - TPSMoveTo(RenderCanvas, Angle, RenderIn, R.Right, R.Bottom); - TPSLineTo(RenderCanvas, Angle, RenderIn, R.Left - 1, R.Bottom); - {right side} - TPSMoveTo(RenderCanvas, Angle, RenderIn, R.Right, R.Bottom - 4); - TPSLineTo(RenderCanvas, Angle, RenderIn, R.Right, R.Top + 3); - RenderCanvas.Pen.Color := BevelHighlight; - {left side} - TPSMoveTo(RenderCanvas, Angle, RenderIn, R.Left, R.Bottom - 4); - TPSLineTo(RenderCanvas, Angle, RenderIn, R.Left, R.Top + 3); - end - else - if FDrawingStyle = ds3d then begin - DrawBevelRect( - RenderCanvas, - TPSRotateRectangle(Angle, RenderIn, Rect (R.Left, R.Top, R.Right, R.Bottom)), - BevelHighlight, - BevelDarkShadow - ); - end; - RenderCanvas.Font.Assign(SaveFont); - finally - SaveFont.Free; - end; - end; - - procedure dvDrawRowHeader(R: TRect); - var - Temp , I: Integer; - LineRect: TRect; - LastHour, Hour: Integer; - MinuteStr, HourStr: string; - SaveFont: TFont; - begin - if StartLine < 0 then - StartLine := TopLine; - - SaveFont := TFont.Create; - try - RenderCanvas.Pen.Style := psClear; - RenderCanvas.Brush.Color := RealRowHeadAttrColor; - TPSFillRect(RenderCanvas, Angle, RenderIn, R); - RenderCanvas.Pen.Style := psSolid; - - RenderCanvas.Font.Assign(FRowHeadAttr.MinuteFont); - RealVisibleLines := dvCalcVisibleLines( - R.Bottom - R.Top, - RealColHeadHeight, - RealRowHeight, - Scale, - StartLine, - StopLine - ); - Temp := RenderCanvas.TextWidth('33'); - Temp := Temp + 10; - RenderCanvas.Pen.Style := psSolid; - RenderCanvas.Pen.Color := RealLineColor; - LineRect := Rect(R.Left, R.Top, R.Right, R.Top + RealRowHeight); - Hour := Ord(dvLineMatrix[0, StartLine].Hour); - - for I := 0 to RealVisibleLines do begin - { prevent any extranneous drawing below the last hour } - if (I + FTopLine >= FLineCount) or (Hour > 23) then - Break; - - if I = 0 then begin - if Hour < 12 then - MinuteStr := 'am' - else - MinuteStr := 'pm'; - end - else if Ord(Hour) = 12 then - MinuteStr := 'pm' - else - MinuteStr := '00'; - - if TimeFormat = tf24Hour then - MinuteStr := '00'; - - { Position the rect } - LineRect.Top := R.Top + i * RealRowHeight; - LineRect.Bottom := LineRect.Top + RealRowHeight; - - if (Hour > 12) and (TimeFormat = tf12Hour) then - HourStr := IntToStr(Hour - 12) - else begin - HourStr := IntToStr(Hour); - if (TimeFormat = tf12Hour) and (HourStr = '0') then - HourStr := '12'; - end; - - if UseGran = gr60Min then begin - { Paint time } - RenderCanvas.Font.Assign(FRowHeadAttr.MinuteFont); - TPSTextOut(RenderCanvas, Angle, RenderIn, - LineRect.Right - RenderCanvas.TextWidth(HourStr + ':' + MinuteStr) - 7, - LineRect.Top + TextMargin, - HourStr + ':' + MinuteStr - ); - LastHour := Hour; - Inc(Hour); - end else begin - { Paint Minute Text} - if dvLineMatrix[0, StartLine + i].Minute = 0 then begin - RenderCanvas.Font.Assign(FRowHeadAttr.MinuteFont); - TPSTextOut(RenderCanvas, Angle, RenderIn, - LineRect.Right - RenderCanvas.TextWidth(MinuteStr) - 7, - LineRect.Top + TextMargin, - MinuteStr - ); - { Paint Hour Text } - RenderCanvas.Font.Assign(FRowHeadAttr.HourFont); - TPSTextOut(RenderCanvas, Angle, RenderIn, - LineRect.Right - RenderCanvas.TextWidth(HourStr) - 2 - Temp, - LineRect.Top + TextMargin - 2, - HourStr - ); - end; - LastHour := Hour; - Hour := Ord(dvLineMatrix[0, StartLine + i + 1].Hour); - end; - - TPSMoveTo(RenderCanvas, Angle, RenderIn, LineRect.Right-6, LineRect.Bottom); - if LastHour <> Hour then - TPSLineTo(RenderCanvas, Angle, RenderIn, LineRect.Left + 6, LineRect.Bottom) - else - TPSLineTo(RenderCanvas, Angle, RenderIn, LineRect.Right-Temp, LineRect.Bottom); - end; {for} - - { Draw Row Header Borders } - if FDrawingStyle = dsFlat then begin - DrawBevelRect(RenderCanvas, TPSRotateRectangle (Angle, RenderIn, - Rect(R.Left - 1, R.Top, R.Right - 1, R.Bottom - 2)), - BevelHighlight, - BevelShadow - ); - end - else if FDrawingStyle = ds3d then begin - DrawBevelRect(RenderCanvas, - TPSRotateRectangle (Angle, RenderIn, Rect(R.Left + 1, R.Top, R.Right - 1, R.Bottom - 3)), - BevelHighlight, - BevelDarkShadow - ); - end; - - RenderCanvas.Font.Assign(SaveFont); - - finally - SaveFont.Free; - end; - end; - - { Draws the all-day events at the top of the DayView in a special manner } - procedure DrawAllDayEvents; - var - ADEventsList: TList; - TempList: TList; - I, J, K: Integer; - Event: TVpEvent; - ADEventRect: TRect; - StartsBeforeRange : Boolean; - MaxADEvents: Integer; - Skip: Boolean; - ADTextHeight: Integer; - EventStr: string; - I2: Integer; - DI: Integer; - AllDayWidth: Integer; - OldTop: LongInt; - begin - if (DataStore = nil) or (DataStore.Resource = nil) then - Exit; - - { Collect all of the events for this range and determine the maximum } - { number of all day events for the range of days covered by the control. } - MaxADEvents := 0; - - AllDayWidth := RealWidth - RealRowHeadWidth - 1 - ScrollBarOffset; - DayWidth := AllDayWidth div FNumDays; - - ADEventsList := TList.Create; - try - TempList := TList.Create; - try - for I := 0 to pred(RealNumDays) do begin - { skip weekends } - if ((DayOfWeek (RenderDate + i) = 1) or (DayOfWeek (RenderDate + i) = 7)) and - (not FIncludeWeekends) - then - Continue; - - { get the all day events for the day specified by RenderDate + I } - DataStore.Resource.Schedule.AllDayEventsByDate(RenderDate + I, TempList); - - { Iterate through these events and place them in ADEventsList } - Skip := false; - for J := 0 to pred(TempList.Count) do begin - if AdEventsList.Count > 0 then begin - for K := 0 to pred(AdEventsList.Count) do begin - if TVpEvent(AdEventsList[K]) = TVpEvent(TempList[J]) then begin - Skip := true; - Break; - end; - end; - if not Skip then - AdEventsList.Add(TempList[J]); - end else - AdEventsList.Add(TempList[J]); - end; - - if TempList.Count > MaxADEvents then - MaxADEvents := TempList.Count; - end; - finally - TempList.Free; - end; - - if MaxADEvents > 0 then begin - RenderCanvas.Brush.Color := RealADEventBkgColor; - RenderCanvas.Font.Assign (AllDayEventAttributes.Font); - - { Measure the AllDayEvent TextHeight } - ADTextHeight := RenderCanvas.TextHeight(VpProductName) + TextMargin; - - { set the top of the event's rect } - OldTop := ADEventsRect.Top; - AdEventRect.Top := OldTop + TextMargin + I * ADTextHeight; - - { Build the AllDayEvent rect based on the value of MaxADEvents } - ADEventsRect.Bottom := AdEventsRect.Top + MaxADEvents * ADTextHeight + TextMargin * 2; - - { Clear the AllDayEvents area } - TpsFillRect(RenderCanvas, Angle, RenderIn, ADEventsRect); - - for I := 0 to pred(RealNumDays) do begin - { Set attributes } - StartsBeforeRange := false; - DI := 0; - { Cycle through the all day events and draw them appropriately } - for I2 := 0 to pred(ADEventsList.Count) do begin - Event := ADEventsList[I2]; - if (trunc(Event.StartTime)<=(trunc(RenderDate)+I)) and - (trunc(Event.EndTime)>=(trunc(RenderDate)+I)) - then begin - { set the top of the event's rect } - AdEventRect.Top := OldTop + TextMargin + DI * ADTextHeight; - inc(DI); - - { see if the event began before the start of the range } - if (Event.StartTime < trunc(RenderDate)) then - StartsBeforeRange := true; - - AdEventRect.Bottom := ADEventRect.Top + ADTextHeight; - AdEventRect.Left := AdEventsRect.Left + DayWidth*I + TextMargin div 2; - AdEventRect.Right := AdEventRect.Left+DayWidth; - - if StartsBeforeRange then - EventStr := '>> ' - else - EventStr := ''; - - EventStr := EventStr + Event.Description; - - RenderCanvas.Brush.Color := ADEventAttrBkgColor; - RenderCanvas.Pen.Color := ADEventBorderColor; - TPSRectangle(RenderCanvas, Angle, RenderIn, - ADEventRect.Left + TextMargin, - ADEventRect.Top + TextMargin div 2, - ADEventRect.Right - TextMargin, - ADEventRect.Top + ADTextHeight + TextMargin div 2 - ); - TPSTextOut(RenderCanvas,Angle, RenderIn, - AdEventRect.Left + TextMargin * 2 + TextMargin div 2, - AdEventRect.Top + TextMargin div 2, - EventStr - ); - - dvEventArray[EventCount].Rec := Rect( - ADEventRect.Left, - ADEventRect.Top - 2, - ADEventRect.Right - TextMargin, - ADEventRect.Bottom - ); - dvEventArray[EventCount].Event := Event; - Inc(EventCount); - end; - end; { for I2 := 0 to pred(ADEventsList.Count) do ... } - end; - end; { if MaxADEvents > 0 } - - finally - ADEventsList.Free; - end; - end; - - { original version - // Draws the all-day events at the top of the DayView in a special manner - procedure DrawAllDayEvents; - var - ADEventsList : TList; - TempList : TList; - I, J, K : Integer; - Event : TVpEvent; - ADEventRect : TRect; - StartsBeforeRange : Boolean; - MaxADEvents : Integer; - Skip : Boolean; - ADTextHeight : Integer; - EventStr : string; - - begin - if (DataStore = nil) or (DataStore.Resource = nil) then - Exit; - - // Collect all of the events for this range and determine the maximum - // number of all day events for the range of days covered by the control. - MaxADEvents := 0; - - ADEventsList := TList.Create; - try - TempList := TList.Create; - try - for I := 0 to pred(RealNumDays) do begin - // skip weekends - if ((DayOfWeek (RenderDate + i) = 1) or - (DayOfWeek (RenderDate + i) = 7)) and - (not FIncludeWeekends) then - Continue; - - // get the all day events for the day specified by RenderDate + I - DataStore.Resource.Schedule.AllDayEventsByDate(RenderDate + I, - TempList); - - // Iterate through these events and place them in ADEventsList - Skip := false; - for J := 0 to pred(TempList.Count) do begin - if AdEventsList.Count > 0 then begin - for K := 0 to pred(AdEventsList.Count) do begin - if TVpEvent(AdEventsList[K]) = TVpEvent(TempList[J]) then begin - Skip := true; - Break; - end; - end; - if not Skip then - AdEventsList.Add(TempList[J]); - end else - AdEventsList.Add(TempList[J]); - end; - - if TempList.Count > MaxADEvents then - MaxADEvents := TempList.Count; - end; - finally - TempList.Free; - end; - - if MaxADEvents > 0 then begin - // Set attributes - RenderCanvas.Brush.Color := RealADEventBkgColor; - RenderCanvas.Font.Assign (AllDayEventAttributes.Font); - - // Measure the AllDayEvent TextHeight - ADTextHeight := RenderCanvas.TextHeight(VpProductName) + TextMargin; - - // Build the AllDayEvent rect based on the value of MaxADEvents - ADEventsRect.Bottom := AdEventsRect.Top - + (MaxADEvents * ADTextHeight) + TextMargin * 2; - - // Clear the AllDayEvents area - TpsFillRect(RenderCanvas, Angle, RenderIn, ADEventsRect); - - StartsBeforeRange := false; - // Cycle through the all day events and draw them appropriately - for I := 0 to pred(ADEventsList.Count) do begin - - Event := ADEventsList[I]; - - // set the top of the event's rect - AdEventRect.Top := ADEventsRect.Top + TextMargin - + (I * ADTextHeight); - - // see if the event began before the start of the range - if (Event.StartTime < trunc(RenderDate)) then - StartsBeforeRange := true; - - AdEventRect.Bottom := ADEventRect.Top + ADTextHeight; - AdEventRect.Left := AdEventsRect.Left + (TextMargin div 2); - AdEventRect.Right := RealRight; - - if (StartsBeforeRange) then - EventStr := '>> ' - else - EventStr := ''; - - EventStr := EventStr + Event.Description; - - RenderCanvas.Brush.Color := ADEventAttrBkgColor; - RenderCanvas.Pen.Color := ADEventBorderColor; - TPSRectangle (RenderCanvas, Angle, RenderIn, - ADEventRect.Left + TextMargin, - ADEventRect.Top + TextMargin div 2, - ADEventRect.Right - TextMargin, - ADEventRect.Top + ADTextHeight + TextMargin div 2); - TPSTextOut (RenderCanvas,Angle, RenderIn, - AdEventRect.Left + TextMargin * 2 + TextMargin div 2, - AdEventRect.Top + TextMargin div 2, - EventStr); - - dvEventArray[EventCount].Rec := Rect (ADEventRect.Left, - ADEventRect.Top - 2, - ADEventRect.Right - TextMargin, - ADEventRect.Bottom); - dvEventArray[EventCount].Event := Event; - Inc (EventCount); - end; // for I := 0 to pred(ADEventsList.Count) do ... - - end; // if MaxADEvents > 0 - - finally - ADEventsList.Free; - end; - end; } - - - procedure DrawEvents(RenderDate: TDateTime; Col: Integer); - var - I,J, StartPixelOffset, EndPixelOffset: Integer; - Level, EventWidth, EventSLine, EventELine: Integer; - EventLineCount: Integer; - EventSTime, EventETime, ThisTime: Double; - EventDuration, LineDuration, PixelDuration: Double; - StartOffset, EndOffset, STime, ETime: Double; - EventRect, VisibleRect, GutterRect: TRect; - EventString, Format: string; - Event: TVpEvent; - SaveFont: TFont; - SaveColor: TColor; - EventArray: TVpDvEventArray; - EventList: TList; - IconRect: TRect; - dvBmpRecurring: TBitmap; - dvBmpCategory: TBitmap; - dvBmpAlarm: TBitmap; - dvBmpCustom: TBitmap; - RecurringW: Integer; - RecurringH: Integer; - CategoryW: Integer; - CategoryH: Integer; - AlarmW: Integer; - AlarmH: Integer; - CustomW: Integer; - CustomH: Integer; - {$IFDEF DEBUGDV} - SL : TStringList; - {$ENDIF} - - procedure VerifyMaxWidthDivisors; - var - I, K: Integer; - Event1, Event2: TVpEvent; - begin - for I := 0 to pred(MaxVisibleEvents) do begin - { if we hit a null event, then we're through } - if EventArray[I].Event = nil then - Break; - - { otherwise keep going } - Event1 := EventArray[I].Event; - - { initialize the WidthDivisor for this record } - EventArray[I].WidthDivisor := 1; - - {now iterate through all events and get the maximum OLEvents value of } - { all the overlapping events } - for K := 0 to pred(MaxVisibleEvents) do begin - { if we hit a null event, then we're through } - if EventArray[K].Event = nil then - Break; - - Event2 := EventArray[K].Event; - - { if the Tmp event overlaps with Event, then check it's Width divisor } - {-- original - if (TimeInRange(Event2.StartTime, Event1.StartTime, Event1.EndTime, false) - or TimeInRange(Event2.EndTime, Event1.StartTime, Event1.EndTime, false)) - or ((Event2.StartTime <= Event1.StartTime) - and (Event2.EndTime >= Event1.EndTime)) - } - if TimeInRange(frac(Event2.StartTime), frac(Event1.StartTime), frac(Event1.EndTime), false) or - TimeInRange(frac(Event2.EndTime), frac(Event1.StartTime), frac(Event1.EndTime), false) or - ((frac(Event2.StartTime) <= frac(Event1.StartTime)) and (frac(Event2.EndTime) >= frac(Event1.EndTime))) - then begin - if EventArray[I].WidthDivisor < EventArray[K].WidthDivisor then - EventArray[I].WidthDivisor := EventArray[K].WidthDivisor; - end; - end; - end; - end; - - procedure CreateBitmaps; - begin - dvBmpRecurring := TBitmap.Create; - dvBmpCategory := TBitmap.Create; - dvBmpAlarm := TBitmap.Create; - dvBmpCustom := TBitmap.Create; - end; - - procedure FreeBitmaps; - begin - dvBmpRecurring.Free; - dvBmpCategory.Free; - dvBmpAlarm.Free; - dvBmpCustom.Free; - end; - - procedure GetIcons(Event: TVpEvent); - var - ShowAlarm: Boolean; - ShowRecurring: Boolean; - ShowCategory: Boolean; - ShowCustom: Boolean; - Icons: TVpDVIcons; - cat: TVpCategoryInfo; - w, h: Integer; - begin - ShowAlarm := False; - ShowRecurring := False; - ShowCategory := False; - ShowCustom := False; - - if Event.AlarmSet then begin - dvBmpAlarm.Assign(IconAttributes.AlarmBitmap); - ShowAlarm := (dvBmpAlarm.Width <> 0) and (dvBmpAlarm.Height <> 0); - end; - - if Event.RepeatCode <> rtNone then begin - dvBmpRecurring.Assign (IconAttributes.RecurringBitmap); - ShowRecurring := (dvBmpRecurring.Width <> 0) and (dvBmpRecurring.Height <> 0); - end; - - if Assigned(DataStore) then begin - if Event.Category < 10 then begin - cat := Datastore.CategoryColorMap.GetCategory(Event.Category); - w := cat.Bitmap.Width; - h := cat.Bitmap.Height; - dvBmpCategory.Width := w; - dvBmpCategory.Height := h; - dvBmpCategory.Canvas.CopyRect( - Rect(0, 0, w, h), - cat.Bitmap.Canvas, - Rect(0, 0, w, h) - ); - end else - begin - dvBmpCategory.Width := 0; - dvBmpCategory.Height := 0; - end; - ShowCategory := (dvBmpCategory.Width <> 0) and (dvBmpCategory.Height <> 0); - end; - - dvBmpCustom.Width := 0; - dvBmpCustom.Height := 0; - - if not IconAttributes.ShowAlarmBitmap then - ShowAlarm := False; - if not IconAttributes.ShowCategoryBitmap then - ShowCategory := False; - if not IconAttributes.ShowRecurringBitmap then - ShowRecurring := False; - - if Assigned(FOnDrawIcons) then begin - Icons[itAlarm].Show := ShowAlarm; - Icons[itAlarm].Bitmap := dvBmpAlarm; - Icons[itRecurring].Show := ShowRecurring; - Icons[itRecurring].Bitmap := dvBmpRecurring; - Icons[itCategory].Show := ShowCategory; - Icons[itCategory].Bitmap := dvBmpCategory; - Icons[itCustom].Show := ShowCustom; - Icons[itCustom].Bitmap := dvBmpCustom; - - FOnDrawIcons (Self, Event, Icons); - - ShowAlarm := Icons[itAlarm].Show; - ShowRecurring := Icons[itRecurring].Show; - ShowCategory := Icons[itCategory].Show; - ShowCustom := Icons[itCustom].Show; - end; - - if not ShowAlarm then begin - dvBmpAlarm.Width := 0; - dvBmpAlarm.Height := 0; - end; - - if not ShowRecurring then begin - dvBmpRecurring.Width := 0; - dvBmpRecurring.Height := 0; - end; - - if not ShowCategory then begin - dvBmpCategory.Width := 0; - dvBmpCategory.Height := 0; - end; - - if not ShowCustom then begin - dvBmpCustom.Width := 0; - dvBmpCustom.Height := 0; - end; - - AlarmW := dvBmpAlarm.Width; - RecurringW := dvBmpRecurring.Width; - CategoryW := dvBmpCategory.Width; - CustomW := dvBmpCustom.Width; - AlarmH := dvBmpAlarm.Height; - RecurringH := dvBmpRecurring.Height; - CategoryH := dvBmpCategory.Height; - CustomH := dvBmpCustom.Height; - end; - - procedure ScaleIcons(EventRect: TRect); - var - h: Integer; - begin - h := EventRect.Bottom - EventRect.Top - 2; - if (dvBmpAlarm.Height > h) and (dvBmpAlarm.Height * dvBmpAlarm.Width <> 0) - then begin - AlarmW := Trunc((h / dvBmpAlarm.Height) * dvBmpAlarm.Width); - AlarmH := h; - end; - - if (dvBmpRecurring.Height > h) and (dvBmpRecurring.Height * dvBmpRecurring.Width <> 0) - then begin - RecurringW := Trunc((h / dvBmpRecurring.Height) * dvBmpRecurring.Width); - RecurringH := h; - end; - - if (dvBmpCategory.Height > h) and (dvBmpCategory.Height * dvBmpCategory.Width <> 0) - then begin - CategoryW := Trunc((h / dvBmpCategory.Height) * dvBmpCategory.Width); - CategoryH := h; - end; - - if (dvBmpCustom.Height > h) and (dvBmpCustom.Height * dvBmpCustom.Width <> 0) - then begin - CustomW := Trunc((h / dvBmpCustom.Height) * dvBmpCustom.Width); - CustomH := h; - end; - end; - - procedure DetermineIconSize(EventRect: TRect; Event: TVpEvent); - var - MaxHeight: Integer; - begin - IconRect.Left := EventRect.Left; - IconRect.Top := EventRect.Top; - IconRect.Bottom := EventRect.Bottom; - IconRect.Right := EventRect.Left + AlarmW + RecurringW + CategoryW + CustomW + 2; - - MaxHeight := AlarmH; - if RecurringH > MaxHeight then - MaxHeight := dvBmpRecurring.Height; - if CategoryH > MaxHeight then - MaxHeight := dvBmpCategory.Height; - if CustomH > MaxHeight then - MaxHeight := dvBmpCustom.Height; - if MaxHeight > EventRect.Bottom - EventRect.Top then - MaxHeight := EventRect.Bottom - EventRect.Top; - - IconRect.Bottom := EventRect.Top + MaxHeight; - if IconRect.Right > EventRect.Right then - IconRect.Right := EventRect.Right; - end; - - procedure DrawIcon(bmp: TBitmap; w, h: Integer; var DrawPos: Integer; IncDrawPos: Boolean = false); - begin - if (bmp.Width <> 0) and (bmp.Height <> 0) then - begin - Canvas.CopyRect( - Rect(IconRect.Left + 1, IconRect.Top +1, IconRect.Left + w + 1, IconRect.Top + h + 1), - bmp.Canvas, - Rect(0, 0, bmp.Width, bmp.Height) - ); - if IncDrawPos then - inc(DrawPos, w); - end; - end; - - procedure DrawIcons; - var - DrawPos: Integer; - begin - DrawPos := 1; - DrawIcon(dvBmpCustom, CustomW, CustomH, DrawPos); - DrawIcon(dvBmpCategory, CategoryW, CategoryH, DrawPos); - DrawIcon(dvBmpAlarm, AlarmW, AlarmH, DrawPos); - DrawIcon(dvBmpRecurring, RecurringW, RecurringH, DrawPos, false); - end; - - var - OKToDrawEditFrame : Boolean; - TextRegion : HRGN; - WorkRegion1: HRGN; - WorkRegion2: HRGN; - CW: Integer; - EventIsEditing: Boolean; - OldPen: TPen; - OldBrush: TBrush; - OldFont: TFont; - begin - if (DataStore = nil) or (DataStore.Resource = nil) or (not DataStore.Connected) then - Exit; - - { Save the canvas color and font } - SaveColor := RenderCanvas.Brush.Color; - SaveFont := TFont.Create; - SaveFont.Assign(RenderCanvas.Font); - - { Initialize some stuff } - if TimeFormat = tf24Hour then - Format := 'h:nn' - else - Format := 'h:nnam/pm'; - - { set the event array's size } - SetLength(EventArray, MaxVisibleEvents); - - { Initialize the new matrix } - for I := 0 to pred(MaxVisibleEvents) do begin - EventArray[I].Event := nil; - EventArray[I].Level := 0; - EventArray[I].OLLevels := 0; - EventArray[I].WidthDivisor := 0; - end; - - EventList := TList.Create; - try - {Get all of the events for this day} - DataStore.Resource.Schedule.EventsByDate(RenderDate, EventList); - - { Discard AllDayEvents, because they are drawn above. } - for I := pred(EventList.Count) downto 0 do begin - Event := EventList[I]; - if Event.AllDayEvent then - EventList.Delete(I); - end; - - { Arrange this day's events in the event matrix } - Level := 0; - I := 0; - while EventList.Count > 0 do begin - { Iterate through the events, and place them all in the proper } - { place in the EventMatrix, according to their start and end times } - J := 0; - ThisTime := 0.0;//Trunc(RenderDate); - while (J < EventList.Count) and (J < MaxVisibleEvents) do begin - Event := EventList[J]; - if frac(Event.StartTime) >= ThisTime then begin - ThisTime := frac(Event.EndTime); - { Handle end times of midnight } - if ThisTime = 0 then - ThisTime := EncodeTime(23, 59, 59, 0); - EventList.Delete(J); - EventArray[I].Event := Event; - EventArray[I].Level := Level; - Inc(I); - Continue; - end - else - Inc(J); - end; - Inc(Level); - end; - - finally - EventList.Free; - end; - - { Count the number of events which all share some of the same time } - for I := 0 to pred(MaxVisibleEvents) do begin - if EventArray[I].Event = nil then - Break; - EventArray[I].OLLevels := 1 + { it is necessary to count this event too } - CountOverlappingEvents(TVpEvent(EventArray[I].Event), EventArray); - end; - - { Calculate the largest width divisor of all overlapping events, } - { for each event. } - for I := 0 to pred(MaxVisibleEvents) do begin - if EventArray[I].Event = nil then - Break; - EventArray[I].WidthDivisor := GetMaxOLEvents(TVpEvent(EventArray[I].Event), EventArray); - end; - - {Make one last pass, to make sure that we have set up the width divisors properly } - VerifyMaxWidthDivisors; - -/////// Debug Code ///////// - { Dump a debug report to drive C } - {$IFDEF DEBUGDV} - SL := TStringList.Create; - try - I := 0; - while EventArray[I].Event <> nil do begin - SL.Add('Description: ' + TVpEvent(EventArray[I].Event).Description - + #13#10 + ' Level: ' + IntToStr(EventArray[I].Level) - + #13#10 + ' OLLevels: ' + IntToStr(EventArray[I].OLLevels) - + #13#10 + ' WidthDivisor: ' + IntToStr(EventArray[I].WidthDivisor)); - Inc(I); - end; - SL.SaveToFile('C:\EventList' + IntToStr(Col) + '.txt'); - finally - Sl.Free; - end; - {$ENDIF} -/////// Debug Code ///////// - - { Time to paint 'em. Let's see if we calculated their placements correctly } - IconRect := Rect(0, 0, 0, 0); - CreateBitmaps; - OldFont := TFont.Create; - OldPen := TPen.Create; - OldBrush := TBrush.Create; - try - { get a rectangle of the visible area } - VisibleRect := dvLineMatrix[Col, StartLine].Rec; - VisibleRect.Bottom := ClientRect.Bottom; - - STime := dvLineMatrix[0, StartLine].Time; - ETime := dvLineMatrix[0, StartLine + RealVisibleLines].Time; - - LineDuration := GetLineDuration(Granularity); - { Determine how much time is represented by one pixel. It is the } - { amount of time represented by one line, divided by the height of } - { a line in pixels. } - if (dvLineMatrix[Col, StartLine].Rec.Bottom - dvLineMatrix[Col, StartLine].Rec.Top) > 0 then - PixelDuration := (LineDuration / (dvLineMatrix[Col, StartLine].Rec.Bottom - dvLineMatrix[Col, StartLine].Rec.Top)) - else - PixelDuration := 0; - - { Iterate through events and paint them } - for I := 0 to pred(MaxVisibleEvents) do begin - { get the next event } - Event := TVpEvent(EventArray[I].Event); - - { if we have hit the end of the events, then bail out } - if Event = nil then - Break; - { -- original - // remove the date portion from the start and end times - EventSTime := Event.StartTime; - EventETime := Event.EndTime; - if trunc(EventSTime) < trunc(RenderDate) then //First Event - EventSTime := 0+trunc(RenderDate); - if trunc(EventETime) > trunc(RenderDate) then //First Event - EventETime := 0.999+trunc(RenderDate); - EventSTime := EventSTime - RenderDate; - EventETime := EventETime - RenderDate; - // Find the line on which this event starts - EventSLine := GetStartLine(EventSTime, Granularity); - // Handle End Times of Midnight - if EventETime = 0 then - EventETime := EncodeTime (23, 59, 59, 0); - } - - { remove the date portion from the start and end times } - EventSTime := Event.StartTime; - EventETime := Event.EndTime; - if (EventSTime < trunc(RenderDate)) and (Event.RepeatCode=rtNone) then //First Event - EventSTime := trunc(RenderDate) - else if (Event.RepeatCode <> rtNone) then - EventSTime := frac(EventSTime) + trunc(RenderDate); - if (trunc(EventETime) > trunc(RenderDate)) and (Event.RepeatCode = rtNone) then //First Event - EventETime := 0.999+trunc(RenderDate) - else if (Event.RepeatCode<>rtNone) then - EventETime := frac(EventETime) + trunc(RenderDate); - EventSTime := EventSTime - trunc(RenderDate); - EventETime := EventETime - trunc(RenderDate); - { Find the line on which this event starts } - EventSLine := GetStartLine(EventSTime, Granularity); - { Handle End Times of Midnight } - if EventETime = 0 then - EventETime := EncodeTime (23, 59, 59, 0); - - { calculate the number of lines this event will cover } - EventELine := GetEndLine(EventETime {Event.EndTime}, Granularity); - EventLineCount := EventELine - EventSLine + 1; - EventDuration := EventETime - EventSTime; - - { if the event doesn't occupy area that is currently visible, then skip it. } - if (EventELine < StartLine) or (EventSLine > StartLine + RealVisibleLines) then - Continue; - - { Build the rectangle in which the event will be painted. } - EventRect := dvLineMatrix[Col, EventSLine].Rec; - if EventRect.Left < VisibleRect.Left then - EventRect.Left := VisibleRect.Left; - if EventRect.Top < VisibleRect.Top then - EventRect.Top := VisibleRect.Top; - EventRect.Bottom := dvLineMatrix[Col, EventELine].Rec.Bottom; - if EventRect.Bottom < VisibleRect.Top then - EventRect.Bottom := VisibleRect.Bottom; - EventWidth := (VisibleRect.Right - VisibleRect.Left) div EventArray[I].WidthDivisor; - - { Slide the rect over to correspond with the level } - if EventArray[I].Level > 0 then - EventRect.Left := EventRect.Left + (EventWidth * EventArray[I].Level) - { added because level 0 events were one pixel too far to the right } - else - EventRect.Left := EventRect.Left - 1; - - EventRect.Right := EventRect.Left + EventWidth - GutterWidth; - - { Draw the event rectangle } - { paint Event text area clWindow } - if Assigned(DataStore) then - RenderCanvas.Brush.Color := Datastore.CategoryColorMap.GetCategory(Event.Category).BackgroundColor - else - RenderCanvas.Brush.Color := WindowColor; - TPSFillRect(RenderCanvas, Angle, RenderIn, EventRect); - - { paint the little area to the left of the text the color } - { corresponding to the event's category } - { These colors are used even when printing } - if Assigned(DataStore) then - RenderCanvas.Brush.Color := DataStore.CategoryColorMap.GetColor(Event.Category); - - { find the pixel offset to use for determining where to start and } - { stop drawing colored area according to the start time and end time of the event. } - StartPixelOffset := 0; - EndPixelOffset := 0; - - if (PixelDuration > 0) and (EventDuration < GetLineDuration(Granularity) * EventLineCount) - then begin - if (EventSLine >= StartLine) and (EventSTime > dvLineMatrix[0, EventSLine].Time) - then begin - { Get the start offset in TDateTime format } - StartOffset := EventSTime - dvLineMatrix[0, EventSLine].Time; - - { determine how many pixels to scooch down before painting the event's color code. } - StartPixelOffset := trunc(StartOffset / PixelDuration); - end; - - if (EventELine <= StartLine + RealVisibleLines) and - (EventETime < dvLineMatrix[0, EventELine + 1].Time ) - then begin - { Get the end offset in TDateTime format } - EndOffset := dvLineMatrix[0, EventELine + 1].Time - EventETime; - - { determine how many pixels to scooch down before painting the } - { event's color code. } - EndPixelOffset := trunc(EndOffset / PixelDuration); - end; - end; - - { Paint the gutter inside the EventRect all events } - if (EventArray[I].Level = 0) then - GutterRect.Left := EventRect.Left - Trunc (FGutterWidth * Scale) - else - GutterRect.Left := EventRect.Left; - GutterRect.Right := GutterRect.Left + Round (FGutterWidth * Scale); - GutterRect.Top := EventRect.Top + StartPixelOffset; - GutterRect.Bottom := EventRect.Bottom - EndPixelOffset; - - TPSFillRect(RenderCanvas, Angle, RenderIn, GutterRect); - - RenderCanvas.Brush.Color := WindowColor; - - if (dvInPlaceEditor <> nil) and dvInplaceEditor.Visible then begin - if FActiveEvent = Event then - EventIsEditing := True - else - EventIsEditing := False; - end else - EventIsEditing := False; - - { build the event string } - IconRect.Left := EventRect.Left; - IconRect.Top := EventRect.Top; - IconRect.Right := EventRect.Left; - IconRect.Bottom := EventRect.Top; - if not DisplayOnly then begin - GetIcons(Event); - if EventArray[I].Level = 0 then begin - ScaleIcons (EventRect); - DetermineIconSize(EventRect, Event); - end else begin - ScaleIcons(Rect( - EventRect.Left + GutterWidth, - EventRect.Top, - EventRect.Right, - EventRect.Bottom - )); - DetermineIconSize(Rect( - EventRect.Left + GutterWidth, - EventRect.Top, - EventRect.Right, - EventRect.Bottom), Event - ); - end; - end; - - OldPen.Assign(Canvas.Pen); - OldBrush.Assign(Canvas.Brush); - OldFont.Assign(Canvas.Font); - if Assigned(FOnBeforeDrawEvent) and (EventArray[I].Level = 0) then - FOnBeforeDrawEvent(Self, Event, FActiveEvent = Event, RenderCanvas, EventRect, IconRect) - else if Assigned (FOnBeforeDrawEvent) then - FOnBeforeDrawEvent(Self, Event, FActiveEvent = Event, RenderCanvas, - Rect(EventRect.Left + FGutterWidth, EventRect.Top, EventRect.Right, EventRect.Bottom), - IconRect - ); - - if not DisplayOnly then - DrawIcons; - - if ShowEventTimes then - EventString := FormatDateTime(Format, Event.StartTime) + '-' + - FormatDateTime(Format, Event.EndTime) + ' ' + Event.Description - else - EventString := Event.Description; - - if WrapStyle = wsNone then begin - { if the string is longer than the availble space then chop } - { off the and and place those little '...'s at the end } - - if RenderCanvas.TextWidth(EventString) > EventRect.Right - IconRect.Right - Round(FGutterWidth * Scale) - TextMargin - then - EventString := GetDisplayString( - RenderCanvas, - EventString, - 0, - EventRect.Right - IconRect.Right - Round (FGutterWidth * Scale) - TextMargin - ); - end; - - if (WrapStyle <> wsNone) and (not EventIsEditing) then begin - if (EventRect.Bottom <> IconRect.Bottom) and (EventRect.Left <> IconRect.Right) - then begin - if WrapStyle = wsIconFlow then - begin - WorkRegion1 := CreateRectRgn(IconRect.Right, EventRect.Top, EventRect.Right, IconRect.Bottom); - WorkRegion2 := CreateRectRgn(EventRect.Left + GutterWidth, IconRect.Bottom, EventRect.Right, EventRect.Bottom); - TextRegion := CreateRectRgn(IconRect.Right, EventRect.Top, EventRect.Right, IconRect.Bottom); - CombineRgn(TextRegion, WorkRegion1, WorkRegion2, RGN_OR); - end else - TextRegion := CreateRectRgn(IconRect.Right, EventRect.Top, EventRect.Right, EventRect.Bottom); - end else - TextRegion := CreateRectRgn(IconRect.Right + GutterWidth, EventRect.Top, EventRect.Right, EventRect.Bottom); - try - CW := RenderTextToRegion(RenderCanvas, Angle, RenderIn, TextRegion, EventString); - { write the event string to the proper spot in the EventRect } - if CW < Length (EventString) then begin - RenderCanvas.Brush.Color := DotDotDotColor; - { draw dot dot dot } - TPSFillRect(RenderCanvas, Angle, RenderIn, - Rect(EventRect.Right - 20, EventRect.Bottom - 7, EventRect.Right - 17, EventRect.Bottom - 4) - ); - TPSFillRect(RenderCanvas, Angle, RenderIn, - Rect(EventRect.Right - 13, EventRect.Bottom - 7, EventRect.Right - 10, EventRect.Bottom - 4)); - TPSFillRect(RenderCanvas, Angle, RenderIn, - Rect(EventRect.Right - 6, EventRect.Bottom - 7, EventRect.Right - 3, EventRect.Bottom - 4)); - end; - - finally - if ((EventRect.Bottom > IconRect.Bottom) and (EventRect.Left > IconRect.Right)) or - (WrapStyle = wsIconFlow) - then begin - DeleteObject(WorkRegion1); - DeleteObject(WorkRegion2); - DeleteObject(TextRegion); - end else begin - DeleteObject(TextRegion); - end; - end; - end - else - if (not EventIsEditing) then begin - if EventArray[I].Level = 0 then - { don't draw the gutter in the EventRest for level 0 events. } - TPSTextOut(RenderCanvas, - Angle, - RenderIn, - IconRect.Right + GutterWidth + TextMargin, - EventRect.Top + TextMargin, - EventString - ) - else - TPSTextOut(RenderCanvas, - Angle, - RenderIn, - IconRect.Right + GutterWidth + TextMargin, - EventRect.Top + TextMargin, - EventString - ); - end; - - { paint the borders around the event text area } - TPSPolyline(RenderCanvas, Angle, RenderIn, [ - Point(EventRect.Left, EventRect.Top), - Point(EventRect.Right, EventRect.Top), - Point(EventRect.Right, EventRect.Bottom), - Point(EventRect.Left, EventRect.Bottom), - Point(EventRect.Left, EventRect.Top) - ]); - { don't paint gutter area on level 0 items } - if EventArray[I].Level > 0 then begin - TPSMoveTo(RenderCanvas, Angle, RenderIn, EventRect.Left + Round(FGutterWidth * Scale), EventRect.Top); - TPSLineTo(RenderCanvas, Angle, RenderIn, EventRect.Left + Round(FGutterWidth * Scale), EventRect.Bottom); - end; - - if Assigned (FOnAfterDrawEvent) and (EventArray[I].Level = 0) then - FOnAfterDrawEvent(Self, Event, FActiveEvent = Event, RenderCanvas, EventRect, IconRect) - else - if Assigned (FOnAfterDrawEvent) then - FOnAfterDrawEvent(Self, Event, FActiveEvent = Event, RenderCanvas, - Rect(EventRect.Left + FGutterWidth, EventRect.Top, EventRect.Right, EventRect.Bottom), - IconRect - ); - - Canvas.Brush.Assign(OldBrush); - Canvas.Pen.Assign(OldPen); - Canvas.Font.Assign(OldFont); - - dvEventArray[EventCount].Rec := Rect( - EventRect.Left, EventRect.Top, EventRect.Right, EventRect.Bottom + 1 - ); - dvEventArray[EventCount].IconRect := IconRect; - dvEventArray[EventCount].Event := Event; - Inc(EventCount); - end; - - OKToDrawEditFrame := True; - if Assigned (FActiveEvent) then - OKToDrawEditFrame := not (FActiveEvent.AllDayEvent); - - if (dvInPlaceEditor <> nil) and dvInplaceEditor.Visible and OKToDrawEditFrame then begin - { paint extra borders around the editor } - if Assigned (DataStore) then - RenderCanvas.Brush.Color := DataStore.CategoryColorMap.GetColor(FActiveEvent.Category); - RenderCanvas.Pen.Color := clWindowFrame; - TPSFillRect(RenderCanvas, Angle, RenderIn, - Rect(dvActiveEventRec.Left, dvActiveEventRec.Top - FGutterWidth, dvActiveEventRec.Right, dvActiveEventRec.Top) - ); - TPSPolyline(RenderCanvas, Angle, RenderIn, [ - Point(dvActiveEventRec.Left, dvActiveEventRec.Top), - Point(dvActiveEventRec.Left, dvActiveEventRec.Top - FGutterWidth), - Point(dvActiveEventRec.Right, dvActiveEventRec.Top - FGutterWidth), - Point(dvActiveEventRec.Right, dvActiveEventRec.Top) - ]); - TPSFillRect(RenderCanvas, Angle, RenderIn, Rect( - dvActiveEventRec.Left, - dvActiveEventRec.Bottom, - dvActiveEventRec.Right, - dvActiveEventRec.Bottom + FGutterWidth - )); - TPSPolyline(RenderCanvas, Angle, RenderIn, [ - Point(dvActiveEventRec.Left, dvActiveEventRec.Bottom), - Point(dvActiveEventRec.Left, dvActiveEventRec.Bottom + FGutterWidth), - Point(dvActiveEventRec.Right, dvActiveEventRec.Bottom + FGutterWidth), - Point(dvActiveEventRec.Right, dvActiveEventRec.Bottom) - ]); - end; - - { Clean Up } - finally - try - SetLength(EventArray, 0); - FreeBitmaps; - finally - { restore canvas color and font } - RenderCanvas.Brush.Color := SaveColor; - RenderCanvas.Font.Assign(SaveFont); - SaveFont.Free; - OldFont.Free; - OldPen.Free; - OldBrush.Free; - end; - end; - end; // DrawEvents (begins at line 2832 . OMG - 1000 lines per local proc!!!) - - procedure DrawCells(R: TRect; ColDate: TDateTime; Col: Integer); - var - I: Integer; - LineRect: TRect; - SavedFont: TFont; - GutterRect: TRect; - LineStartTime: Double; - begin - if StartLine < 0 then - StartLine := TopLine; - - { Set GutterRect size } - GutterRect.Left := R.Left; - GutterRect.Top := R.Top; - GutterRect.Bottom := R.Bottom; - GutterRect.Right := GutterRect.Left + Round (GutterWidth * Scale); - R.Left := R.Left + Round (GutterWidth * Scale) + 1; - - { paint gutter area } - RenderCanvas.Brush.Color := RealColor; - TPSFillRect (RenderCanvas, Angle, RenderIn, GutterRect); - { draw the line down the right side of the gutter } - RenderCanvas.Pen.Color := BevelShadow; - RenderCanvas.Pen.Style := psSolid; - TPSMoveTo(RenderCanvas, Angle, RenderIn, GutterRect.Right, GutterRect.Top); - TPSLineTo(RenderCanvas, Angle, RenderIn, GutterRect.Right, GutterRect.Bottom); - - for I := 0 to LineCount-1 do begin // this was "LineCount", without -1 --> IDE crash - dvLineMatrix[Col, I].Rec.Left := -1; - dvLineMatrix[Col, I].Rec.Top := -1; - dvLineMatrix[Col, I].Rec.Right := -1; - dvLineMatrix[Col, I].Rec.Bottom := -1; - end; - - SavedFont := TFont.Create; - SavedFont.Assign(RenderCanvas.Font); - try - RenderCanvas.Font.Assign(Font); - RenderCanvas.Brush.Color := RealColor; - TPSFillRect(RenderCanvas, Angle, RenderIn, R); - - LineRect := Rect(R.left, R.top, R.Right, R.Top + RealRowHeight); - RenderCanvas.Pen.Style := psSolid; - RenderCanvas.Pen.Color := LineColor; - - { Paint the client area } - for I := 0 to RealVisibleLines do begin - - if (I > pred(FLineCount)) then - Break; - - if TopLine + i >= FLineCount then - Break; - - RenderCanvas.Brush.Color := RealColor; - RenderCanvas.Font.Assign(SavedFont); - LineRect.Top := Round (R.Top + (i * RealRowHeight)); - LineRect.Bottom := Round (LineRect.Top + (RealRowHeight)); - if I + StartLine < LineCount then - dvLineMatrix[Col, I + StartLine].Rec := LineRect; - - { color-code cells } - - // !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - // !!!! This causes problems at design time - implement a better !!!! - // !!!! Fix - check the value after the component is streamed in !!!! - // !!!! May be a good use for ... loaded or in my message !!!! - // !!!! Handler (the message handler would be better !!!! - // !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -// if ActiveRow = -1 then -// ActiveRow := TopLine; - - if not DisplayOnly then begin - if Focused and (FActiveCol = col) and (FActiveRow = StartLine + I) then - begin - { Paint background hilight color } - RenderCanvas.Brush.Color := HighlightBkg; - RenderCanvas.Font.Color := HighlightText; - TPSFillRect(RenderCanvas, Angle, RenderIn, LineRect); - end else begin - { paint the active, inactive, weekend, and holiday colors } - - { HOLIDAY COLORS ARE NOT IMPLEMENTED YET } - - { if ColDate is a weekend, then paint all rows the weekend } - { color. } - if (DayOfWeek(ColDate) = 1) or (DayOfWeek(ColDate) = 7) then begin - { this is a weekend } - RenderCanvas.Brush.Color := TimeSlotColors.Weekend; - TPSFillRect(RenderCanvas, Angle, RenderIn, LineRect); - end - - else begin - { ColDate is a weekday, so check to see if the active } - { range is set. If it isn't then paint all rows the color } - { corresponding to Weekday. If it is, then paint inactive } - { rows the color corresponding to inactive and the active } - { rows the color corresponding to Active Rows. } - if TimeSlotColors.ActiveRange.RangeBegin = TimeSlotColors.ActiveRange.RangeEnd then - begin - { there is no active range, so all time slots are to be } - { painted the color of Weekday } - RenderCanvas.Brush.Color := TimeSlotColors.Weekday; - TPSFillRect(RenderCanvas, Angle, RenderIn, LineRect); - end - else begin - { there is an active range defined, so we need to see if } - { the current line falls in the active range or not, and } - { paint it accordingly } - LineStartTime := dvLineMatrix[Col, StartLine + I].Time; - if TimeInRange(LineStartTime, - TimeSlotColors.ActiveRange.StartTime, - TimeSlotColors.ActiveRange.EndTime - (1/MinutesInDay), true) - then begin - RenderCanvas.Brush.Color := TimeSlotColors.Active; - TPSFillRect (RenderCanvas, Angle, RenderIn, LineRect); - end else begin - RenderCanvas.Brush.Color := TimeSlotColors.Inactive; - TPSFillRect (RenderCanvas, Angle, RenderIn, LineRect); - end; - end; - end; - end; - end; - - { Draw the lines } - if I + StartLine <= LineCount then begin - RenderCanvas.Pen.Color := LineColor; - TPSMoveTo(RenderCanvas, Angle, RenderIn, LineRect.Left, LineRect.Top); - TPSLineTo(RenderCanvas, Angle, RenderIn, LineRect.Right - 1, LineRect.Top); - TPSMoveTo(RenderCanvas, Angle, RenderIn, LineRect.Left, LineRect.Bottom); - TPSLineTo(RenderCanvas, Angle, RenderIn, LineRect.Right - 1, LineRect.Bottom); - end; - end; - - { Draw a line down the right side of the column to close the } - { cells right sides } - RenderCanvas.Pen.Color := BevelShadow; - RenderCanvas.Pen.Style := psSolid; - TPSMoveTo(RenderCanvas, Angle, RenderIn, R.Right - 1, R.Bottom); - TPSLineTo(RenderCanvas, Angle, RenderIn, R.Right - 1, R.Top - 1); - - RenderCanvas.Font.Assign(SavedFont); - finally - SavedFont.Free; - end; - end; - - procedure DrawAllDays; - var - i: Integer; - RPos: Integer; - AllDayWidth: Integer; - ExtraSpace: Integer; - DrawMe: Boolean; - RealDay: Integer; - begin - if RealNumDays = 0 then begin - while (DayOfWeek(RenderDate) = 1) or (DayOfWeek(RenderDate) = 7) do - RenderDate := RenderDate + 1; - RealNumDays := FNumDays; - end; - AllDayWidth := RealWidth - RealRowHeadWidth - 1 - ScrollBarOffset; - - DayWidth := AllDayWidth div FNumDays; - ExtraSpace := AllDayWidth mod FNumDays; - - RPos := RowHeadRect.Right; - - RealDay := 0; - for i := 0 to RealNumDays - 1 do begin - DrawMe := True; - if not FIncludeWeekends then begin - if (DayOfWeek(RenderDate + i) = 1) or (DayOfWeek(RenderDate + i) = 7) then - DrawMe := False - end; - if DrawMe then begin - { Draw Column Header } - ColHeadRect := Rect(RPos, RealTop + 2, RPos + DayWidth - 1, RealTop + RealColHeadHeight); - if (i = RealNumDays - 1) and (ExtraSpace > 0) then - ColHeadRect.Right := ColHeadRect.Right + ExtraSpace; - - if Assigned(FOwnerDrawColHead) then begin - Drawn := false; - FOwnerDrawColHead (self, RenderCanvas, ColHeadRect, Drawn); - if not Drawn then - dvDrawColHeader(ColHeadRect, RenderDate + i, RealDay); - end else - dvDrawColHeader(ColHeadRect, RenderDate + i, RealDay); - - { Calculate the column rect for this day } - RenderCanvas.Font.Assign(Font); - CellsRect := Rect(RPos, ADEventsRect.Bottom + 1, RPos + DayWidth, RealBottom - 2); - if (i = RealNumDays - 1) and (ExtraSpace > 0) then - CellsRect.Right := CellsRect.Right + ExtraSpace; - - { set the ColRectArray } - dvColRectArray[RealDay].Rec := CellsRect; - dvColRectArray[RealDay].Date := RenderDate + i; - - { Draw the cells } - if Assigned(FOwnerDrawCells) then begin - FOwnerDrawCells(self, RenderCanvas, CellsRect, RealRowHeight, Drawn); - if not Drawn then - DrawCells(CellsRect, RenderDate + i, RealDay); - end else - DrawCells(CellsRect, RenderDate + i, RealDay); - - { Draw the regular events } - DrawEvents(RenderDate + i, RealDay); - - Inc(RPos, DayWidth); - Inc(RealDay); - end; - end; - end; - - procedure InitializeEventRectangles; - var - I : Integer; - begin - EventCount := 0; - for I := 0 to pred(Length(dvEventArray)) do begin - dvEventArray[I].Rec.Left := -1; - dvEventArray[I].Rec.Top := -1; - dvEventArray[I].Rec.Right := -1; - dvEventArray[I].Rec.Bottom := -1; - dvEventArray[I].Event := nil; - end; - end; - -begin - if DisplayOnly then begin - BevelShadow := clBlack; - BevelHighlight := clBlack; - BevelDarkShadow := clBlack; - BevelFace := clBlack; - WindowColor := clWhite; - HighlightText := clBlack; - RealHeadAttrColor := clSilver; - RealRowHeadAttrColor := clSilver; - RealLineColor := clBlack; - RealColor := clWhite; - HighlightBkg := clWhite; - RealADEventBkgColor := clWhite; - ADEventAttrBkgColor := clWhite; - ADEventBorderColor := clBlack; - end else begin - BevelShadow := clBtnShadow; - BevelHighlight := clBtnHighlight; - BevelDarkShadow := cl3DDkShadow; - BevelFace := clBtnFace; - WindowColor := clWindow; - HighlightText := clHighlightText; - HighlightBkg := clHighlight; - RealHeadAttrColor := FHeadAttr.Color; - RealRowHeadAttrColor := FRowHeadAttr.Color; - RealLineColor := LineColor; - RealColor := Color; - RealADEventBkgColor := AllDayEventAttributes.BackgroundColor; - ADEventAttrBkgColor := AllDayEventAttributes.EventBackgroundColor; - ADEventBorderColor := AllDayEventAttributes.EventBorderColor; - end; - - SetMeasurements; - - if StartLine < 0 then - StartLine := TopLine; - - if DisplayOnly then - ScrollBarOffset := 2 - else - ScrollBarOffset := 14; - - dvPainting := true; - SavePenStyle := RenderCanvas.Pen.Style; - SaveBrushColor := RenderCanvas.Brush.Color; - SavePenColor := RenderCanvas.Pen.Color; - - Rgn := CreateRectRgn(RenderIn.Left, RenderIn.Top, RenderIn.Right, RenderIn.Bottom); - try - SelectClipRgn(RenderCanvas.Handle, Rgn); - - { Calculate Row Header } - RealRowHeight := dvCalcRowHeight (Scale, UseGran); - RealColHeadHeight := dvCalcColHeadHeight (Scale); - - RenderCanvas.Font.Assign(FRowHeadAttr.FHourFont); - TextWidth := RenderCanvas.TextWidth('33'); - RealRowHeadWidth := TextWidth * 2 + 10; - - { initialize the All Day Events area... } - ADEventsRect.Left := RealLeft + 3 + RealRowHeadWidth; - ADEventsRect.Top := RealTop + RealColHeadHeight; - ADEventsRect.Right := ClientRect.Right; - ADEventsRect.Bottom := AdEventsRect.Top; - - { Calculate the RealNumDays (The number of days the control covers) } - RealNumDays := GetRealNumDays (RenderDate); - - InitializeEventRectangles; - - { Draw the All Day Events } - DrawAllDayEvents; - - { draw the area in the top left corner, where the nav buttons go. } - RowHeadRect := Rect( - RealLeft + 1, - RealTop, - RealLeft + 3 + RealRowHeadWidth, - RealTop + RealColHeadHeight + 2 - ); - - RenderCanvas.Brush.Color := RealHeadAttrColor; - TPSFillRect(RenderCanvas, Angle, RenderIn, RowHeadRect); - - if DrawingStyle = ds3d then - DrawBevelRect( - RenderCanvas, - TPSRotateRectangle(Angle, RenderIn, Rect( - RowHeadRect.Left + 1, - RowHeadRect.Top + 2, - RowHeadRect.Right - 2, - RowHeadRect.Bottom - 2 - )), - BevelHighlight, - BevelShadow - ) - else begin - RenderCanvas.Pen.Color := BevelShadow; - TPSMoveTo(RenderCanvas, Angle, RenderIn, RowHeadRect.Right - 2, RowHeadRect.Bottom - 2); - TPSLineTo(RenderCanvas, Angle, RenderIn, RowHeadRect.Left, RowHeadRect.Bottom - 2); - RenderCanvas.Pen.Color := BevelHighlight; - TPSLineTo(RenderCanvas, Angle, RenderIn, RowHeadRect.Left, RowHeadRect.Top); - TPSLineTo(RenderCanvas, Angle, RenderIn, RowHeadRect.Right - 2, RowHeadRect.Top); - RenderCanvas.Pen.Color := BevelShadow; - TPSMoveTo(RenderCanvas, Angle, RenderIn, RowHeadRect.Right - 2, RowHeadRect.Top + 6); - TPSLineTo(RenderCanvas, Angle, RenderIn, RowHeadRect.Right - 2, RowHeadRect.Bottom - 5); - end; - - RenderCanvas.Font.Assign(FRowHeadAttr.FHourFont); - if DrawingStyle = dsFlat then - RowHeadRect := Rect(RealLeft + 2, ADEventsRect.Bottom + 1, RealLeft + 2 + RealRowHeadWidth, RealBottom) - else - RowHeadRect := Rect(RealLeft + 1, ADEventsRect.Bottom + 1, RealLeft + 2 + RealRowHeadWidth, RealBottom); - - if Assigned(FOwnerDrawRowHead) then begin - Drawn := false; - FOwnerDrawRowHead(self, RenderCanvas, RowHeadRect, RealRowHeight, Drawn); - if not Drawn then - dvDrawRowHeader(RowHeadRect); - end else - dvDrawRowHeader(RowHeadRect); - - { Draw the regular events } - DrawAllDays; - - { Draw Borders } - if FDrawingStyle = dsFlat then begin - { Draw an outer and inner 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)), - BevelHighlight, - 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; - - { Place navigation buttons } - { size and place the Today button first. } - dvTodayBtn.Height := trunc(RealColHeadHeight div 2); - if DrawingStyle = dsFlat then begin - dvTodayBtn.Left := 1; - dvTodayBtn.Top := 1; - dvTodayBtn.Width := RealRowHeadWidth + 1; - end else begin - dvTodayBtn.Left := 2; - dvTodayBtn.Top := 2; - dvTodayBtn.Width := RealRowHeadWidth; - end; - { size and place the WeekDown button } - dvWeekDownBtn.Height := dvTodayBtn.Height; - dvWeekDownBtn.Width := trunc(RealRowHeadWidth * 0.25) + 2; - dvWeekDownBtn.Left := dvTodayBtn.Left; - dvWeekDownBtn.Top := dvTodayBtn.Top + dvTodayBtn.Height; - { size and place the DayDown button } - dvDayDownBtn.Height := dvTodayBtn.Height; - dvDayDownBtn.Width := dvWeekDownBtn.Width - 4; - dvDayDownBtn.Left := dvWeekDownBtn.Left + dvWeekDownBtn.Width; - dvDayDownBtn.Top := dvTodayBtn.Top + dvTodayBtn.Height; - { size and place the DayUp button } - dvDayUpBtn.Height := dvTodayBtn.Height; - dvDayUpBtn.Width := dvWeekDownBtn.Width - 4; - dvDayUpBtn.Left := dvDayDownBtn.Left + dvDayDownBtn.Width; - dvDayUpBtn.Top := dvTodayBtn.Top + dvTodayBtn.Height; - { size and place the WeekUp button } - dvWeekUpBtn.Height := dvTodayBtn.Height; - dvWeekUpBtn.Width := dvTodayBtn.Width - dvWeekDownBtn.Width - dvDayDownBtn.Width - dvDayUpBtn.Width; - dvWeekUpBtn.Left := dvDayUpBtn.Left + dvDayUpBtn.Width; - dvWeekUpBtn.Top := dvTodayBtn.Top + dvTodayBtn.Height; - - { Reinstate RenderCanvas settings } - RenderCanvas.Pen.Style := SavePenStyle; - RenderCanvas.Brush.Color := SaveBrushColor; - RenderCanvas.Pen.Color := SavePenColor; - - finally - SelectClipRgn(RenderCanvas.Handle, 0); - DeleteObject(Rgn); - end; - - dvPainting := false; -end; - *) -{=====} {.$IFNDEF LCL} procedure TVpDayView.VpDayViewInit(var Msg: {$IFDEF DELPHI}TMessage{$ELSE}TLMessage{$ENDIF}); @@ -4018,118 +2273,6 @@ begin end; {.$ENDIF} -{ returns the number of events which overlap the specified event } -function TVpDayView.CountOverlappingEvents(Event: TVpEvent; const EArray: TVpDvEventArray): Integer; -var - K, SelfLevel: Integer; - Tmp: TVpEvent; - Levels: array of Integer; -begin - { initialize the levels array } - SetLength(Levels, MaxEventDepth); - for K := 0 to pred(MaxEventDepth) do - Levels[K] := 0; - result := 0; - { First, simply count the number of overlapping events. } - K := 0; - SelfLevel := -1; - Tmp := TVpEvent(EArray[K].Event); - while Tmp <> nil do begin - if Tmp = Event then begin - SelfLevel := K; - Inc(K); - Tmp := TVpEvent(EArray[K].Event); - Continue; - end; - { --- original - // if the Tmp event's StartTime or EndTime falls within the range of Event... - if (TimeInRange(Tmp.StartTime, Event.StartTime, Event.EndTime, false) - or TimeInRange(Tmp.EndTime, Event.StartTime, Event.EndTime, false) - // or the Tmp event's StartTime is before or equal to the Event's - // start time AND its end time is after or equal to the Event's - // end time, then the events overlap and we will need to increment - // the value of K. - or ((Tmp.StartTime <= Event.StartTime) - and (Tmp.EndTime >= Event.EndTime)) - then begin - // Count this event at this level - Inc(Levels[EArray[K].Level]); - Inc(result); - end; } - - { if the Tmp event's StartTime or EndTime falls within the range of } - { Event... } - if TimeInRange(frac(Tmp.StartTime), frac(Event.StartTime), frac(Event.EndTime), false) or - TimeInRange(frac(Tmp.EndTime), frac(Event.StartTime), frac(Event.EndTime), false) or - { or the Tmp event's StartTime is before or equal to the Event's } - { start time AND its end time is after or equal to the Event's } - { end time, then the events overlap and we will need to increment } - { the value of K. } - ((frac(Tmp.StartTime) <= frac(Event.StartTime)) and (frac(Tmp.EndTime) >= frac(Event.EndTime))) - then begin - { Count this event at this level } - Inc(Levels[EArray[K].Level]); - Inc(result); - end; - - Inc(K); - Tmp := TVpEvent(EArray[K].Event); - end; - { Then adjust count for overlapping events which share a level. } - for K := 0 to pred(MaxEventDepth) do begin - if K = SelfLevel then Continue; - if Levels[K] = 0 then Continue; - result := result - (Levels[K] - 1); - end; -end; - -{ returns the maximum OLEvents value from all overlapping neighbors } -function TVpDayView.GetMaxOLEvents(Event: TVpEvent; const EArray: TVpDvEventArray): Integer; -var - K: Integer; - Tmp: TVpEvent; -begin - result := 1; - K := 0; - Tmp := TVpEvent(EArray[K].Event); - while Tmp <> nil do begin - (* original - { if the Tmp event's StartTime or EndTime falls within the range of } - { Event... } - if (TimeInRange(Tmp.StartTime, Event.StartTime, Event.EndTime, false) - or TimeInRange(Tmp.EndTime, Event.StartTime, Event.EndTime, false)) - { or the Tmp event's StartTime is before or equal to the Event's } - { start time AND its end time is after or equal to the Event's } - { end time, then the events overlap and we will need to check the } - { value of OLLevels. If it is bigger than result, then modify } - { Result accordingly. } - or ((Tmp.StartTime <= Event.StartTime) - and (Tmp.EndTime >= Event.EndTime)) - then begin - if EArray[K].OLLevels > result then - Result := EArray[K].OLLevels; - end; - *) - - { if the Tmp event's StartTime or EndTime falls within the range of Event. } - if TimeInRange(frac(Tmp.StartTime), frac(Event.StartTime), frac(Event.EndTime), false) or - TimeInRange(frac(Tmp.EndTime), frac(Event.StartTime), frac(Event.EndTime), false) or - { or the Tmp event's StartTime is before or equal to the Event's } - { start time AND its end time is after or equal to the Event's } - { end time, then the events overlap and we will need to check the } - { value of OLLevels. If it is bigger than result, then modify } - { Result accordingly. } - ((frac(Tmp.StartTime) <= frac(Event.StartTime)) and (frac(Tmp.EndTime) >= frac(Event.EndTime))) - then begin - if EArray[K].OLLevels > result then - Result := EArray[K].OLLevels; - end; - - Inc(K); - Tmp := TVpEvent(EArray[K].Event); - end; -end; - (*****************************************************************************) { TVpCHAttributes } diff --git a/components/tvplanit/source/vpdayviewpainter.pas b/components/tvplanit/source/vpdayviewpainter.pas index da5211f24..f12892ca4 100644 --- a/components/tvplanit/source/vpdayviewpainter.pas +++ b/components/tvplanit/source/vpdayviewpainter.pas @@ -82,7 +82,6 @@ type function DetermineIconRect(AEventRect: TRect): TRect; function GetMaxOLEvents(Event: TVpEvent; const EArray: TVpDvEventArray): Integer; procedure DrawAllDayEvents; - procedure DrawAllDays; procedure DrawCells(R: TRect; ColDate: TDateTime; Col: Integer); procedure DrawColHeader(R: TRect; ARenderDate: TDateTime; Col: Integer); procedure DrawEditFrame(R: TRect; AGutter, ALevel: Integer; AColor: TColor); @@ -94,6 +93,7 @@ type procedure DrawIcons(AIconRect: TRect); procedure DrawNavBtns; procedure DrawNavBtnBackground; + procedure DrawRegularEvents; procedure DrawRowHeader(R: TRect); procedure FreeBitmaps; procedure GetIcons(Event: TVpEvent); @@ -159,6 +159,7 @@ begin end; end; +{ returns the number of events which overlap the specified event } function TVpDayViewPainter.CountOverlappingEvents(Event: TVpEvent; const EArray: TVpDvEventArray): Integer; var @@ -415,75 +416,6 @@ begin end; end; -procedure TVpDayViewPainter.DrawAllDays; -var - i: Integer; - RPos: Integer; - AllDayWidth: Integer; - ExtraSpace: Integer; - DrawMe: Boolean; - RealDay: Integer; -begin - if RealNumDays = 0 then begin - while (DayOfWeek(RenderDate) = 1) or (DayOfWeek(RenderDate) = 7) do - RenderDate := RenderDate + 1; - RealNumDays := FDayView.NumDays; - end; - AllDayWidth := RealWidth - RealRowHeadWidth - 1 - ScrollBarOffset; - - DayWidth := AllDayWidth div FDayView.NumDays; - ExtraSpace := AllDayWidth mod FDayView.NumDays; - - RPos := RowHeadRect.Right; - - RealDay := 0; - for i := 0 to RealNumDays - 1 do begin - DrawMe := True; - if not FDayView.IncludeWeekends then begin - if (DayOfWeek(RenderDate + i) = 1) or (DayOfWeek(RenderDate + i) = 7) then - DrawMe := False - end; - if DrawMe then begin - { Draw Column Header } - ColHeadRect := Rect(RPos, RealTop + 2, RPos + DayWidth - 1, RealTop + RealColHeadHeight); - if (i = RealNumDays - 1) and (ExtraSpace > 0) then - ColHeadRect.Right := ColHeadRect.Right + ExtraSpace; - - if Assigned(FDayView.OwnerDrawColHeader) then begin - Drawn := false; - FDayView.OwnerDrawColHeader(self, RenderCanvas, ColHeadRect, Drawn); - if not Drawn then - DrawColHeader(ColHeadRect, RenderDate + i, RealDay); - end else - DrawColHeader(ColHeadRect, RenderDate + i, RealDay); - - { Calculate the column rect for this day } - RenderCanvas.Font.Assign(FDayView.Font); - CellsRect := Rect(RPos, ADEventsRect.Bottom + 1, RPos + DayWidth, RealBottom - 2); - if (i = RealNumDays - 1) and (ExtraSpace > 0) then - CellsRect.Right := CellsRect.Right + ExtraSpace; - - { set the ColRectArray } - TVpDayViewOpener(FDayView).dvColRectArray[RealDay].Rec := CellsRect; - TVpDayViewOpener(FDayView).dvColRectArray[RealDay].Date := RenderDate + i; - - { Draw the cells } - if Assigned(FDayView.OwnerDrawCells) then begin - FDayView.OwnerDrawCells(self, RenderCanvas, CellsRect, RealRowHeight, Drawn); - if not Drawn then - DrawCells(CellsRect, RenderDate + i, RealDay); - end else - DrawCells(CellsRect, RenderDate + i, RealDay); - - { Draw the regular events } - DrawEvents(RenderDate + i, RealDay); - - Inc(RPos, DayWidth); - Inc(RealDay); - end; - end; -end; - procedure TVpDayViewPainter.DrawCells(R: TRect; ColDate: TDateTime; Col: Integer); var I: Integer; @@ -1209,6 +1141,75 @@ begin end; end; +procedure TVpDayViewPainter.DrawRegularEvents; +var + i: Integer; + RPos: Integer; + AllDayWidth: Integer; + ExtraSpace: Integer; + DrawMe: Boolean; + RealDay: Integer; +begin + if RealNumDays = 0 then begin + while (DayOfWeek(RenderDate) = 1) or (DayOfWeek(RenderDate) = 7) do + RenderDate := RenderDate + 1; + RealNumDays := FDayView.NumDays; + end; + AllDayWidth := RealWidth - RealRowHeadWidth - 1 - ScrollBarOffset; + + DayWidth := AllDayWidth div FDayView.NumDays; + ExtraSpace := AllDayWidth mod FDayView.NumDays; + + RPos := RowHeadRect.Right; + + RealDay := 0; + for i := 0 to RealNumDays - 1 do begin + DrawMe := True; + if not FDayView.IncludeWeekends then begin + if (DayOfWeek(RenderDate + i) = 1) or (DayOfWeek(RenderDate + i) = 7) then + DrawMe := False + end; + if DrawMe then begin + { Draw Column Header } + ColHeadRect := Rect(RPos, RealTop + 2, RPos + DayWidth - 1, RealTop + RealColHeadHeight); + if (i = RealNumDays - 1) and (ExtraSpace > 0) then + ColHeadRect.Right := ColHeadRect.Right + ExtraSpace; + + if Assigned(FDayView.OwnerDrawColHeader) then begin + Drawn := false; + FDayView.OwnerDrawColHeader(self, RenderCanvas, ColHeadRect, Drawn); + if not Drawn then + DrawColHeader(ColHeadRect, RenderDate + i, RealDay); + end else + DrawColHeader(ColHeadRect, RenderDate + i, RealDay); + + { Calculate the column rect for this day } + RenderCanvas.Font.Assign(FDayView.Font); + CellsRect := Rect(RPos, ADEventsRect.Bottom + 1, RPos + DayWidth, RealBottom - 2); + if (i = RealNumDays - 1) and (ExtraSpace > 0) then + CellsRect.Right := CellsRect.Right + ExtraSpace; + + { set the ColRectArray } + TVpDayViewOpener(FDayView).dvColRectArray[RealDay].Rec := CellsRect; + TVpDayViewOpener(FDayView).dvColRectArray[RealDay].Date := RenderDate + i; + + { Draw the cells } + if Assigned(FDayView.OwnerDrawCells) then begin + FDayView.OwnerDrawCells(self, RenderCanvas, CellsRect, RealRowHeight, Drawn); + if not Drawn then + DrawCells(CellsRect, RenderDate + i, RealDay); + end else + DrawCells(CellsRect, RenderDate + i, RealDay); + + { Draw the regular events } + DrawEvents(RenderDate + i, RealDay); + + Inc(RPos, DayWidth); + Inc(RealDay); + end; + end; +end; + procedure TVpDayViewPainter.DrawRowHeader(R: TRect); var Temp, I, len: Integer; @@ -1557,46 +1558,6 @@ begin { Draw row headers } CalcRowHeadRect(RowHeadRect); - (* - RowHeadRect := Rect( - RealLeft + 1, - RealTop, - RealLeft + 3 + RealRowHeadWidth, - RealTop + RealColHeadHeight + 2 - ); - - RenderCanvas.Brush.Color := RealHeadAttrColor; - TPSFillRect(RenderCanvas, Angle, RenderIn, RowHeadRect); - - if FDayView.DrawingStyle = ds3d then - DrawBevelRect( - RenderCanvas, - TPSRotateRectangle(Angle, RenderIn, Rect( - RowHeadRect.Left + 1, - RowHeadRect.Top + 2, - RowHeadRect.Right - 2, - RowHeadRect.Bottom - 2 - )), - BevelHighlight, - BevelShadow - ) - else begin - RenderCanvas.Pen.Color := BevelShadow; - TPSMoveTo(RenderCanvas, Angle, RenderIn, RowHeadRect.Right - 2, RowHeadRect.Bottom - 2); - TPSLineTo(RenderCanvas, Angle, RenderIn, RowHeadRect.Left, RowHeadRect.Bottom - 2); - RenderCanvas.Pen.Color := BevelHighlight; - TPSLineTo(RenderCanvas, Angle, RenderIn, RowHeadRect.Left, RowHeadRect.Top); - TPSLineTo(RenderCanvas, Angle, RenderIn, RowHeadRect.Right - 2, RowHeadRect.Top); - RenderCanvas.Pen.Color := BevelShadow; - TPSMoveTo(RenderCanvas, Angle, RenderIn, RowHeadRect.Right - 2, RowHeadRect.Top + 6); - TPSLineTo(RenderCanvas, Angle, RenderIn, RowHeadRect.Right - 2, RowHeadRect.Bottom - 5); - end; - - RenderCanvas.Font.Assign(FDayView.RowHeadAttributes.HourFont); - RowHeadRect := Rect(RealLeft + 1 , ADEventsRect.Bottom + 1, RealLeft + 2 + RealRowHeadWidth, RealBottom); - if FDayView.DrawingStyle = dsFlat then - inc(RowHeadRect.Left);*) - if Assigned(FDayView.OwnerDrawRowHeader) then begin Drawn := false; FDayView.OwnerDrawRowHeader(self, RenderCanvas, RowHeadRect, RealRowHeight, Drawn); @@ -1606,7 +1567,7 @@ begin DrawRowHeader(RowHeadRect); { Draw the regular events } - DrawAllDays; + DrawRegularEvents; { Draw borders } tmpRect := Rect(RealLeft, RealTop, RealRight-1, RealBottom-1);