{$I vp.inc} unit VpDayViewPainter; interface uses SysUtils, LCLType, LCLIntf, LCLVersion, Types, Classes, Graphics, ImgList, VpConst, VPBase, VpData, VpBasePainter, VpDayView; type { 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; TVpDayViewPainter = class(TVpBasePainter) private FDayView: TVpDayView; FScaledGutterWidth: Integer; FScaledIconMargin: Integer; FScaledTickDist: Integer; // local parameters of the old render procedure ColHeadRect: TRect; CellsRect: TRect; RowHeadRect: TRect; ADEventsRect: TRect; Drawn: Boolean; ScrollBarOffset: Integer; EventCount: Integer; DayWidth: Integer; RealNumDays: Integer; 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; FRenderHoliday: String; // variables from local procedures for better access dvBmpRecurring: TBitmap; dvBmpCategory: TBitmap; dvBmpAlarm: TBitmap; dvBmpCustom: TBitmap; RecurringW: Integer; RecurringH: Integer; CategoryW: Integer; CategoryH: Integer; AlarmW: Integer; AlarmH: Integer; CustomW: Integer; CustomH: Integer; EventArray: TVpDvEventArray; VisibleRect: TRect; LineDuration, PixelDuration: Double; IconRect: TRect; OldPen: TPen; OldBrush: TBrush; OldFont: TFont; protected procedure CalcRowHeadRect(out ARect: TRect); function CalcRowHeadWidth: Integer; function CountOverlappingEvents(Event: TVpEvent; const EArray: TVpDvEventArray): Integer; procedure CreateBitmaps; function DetermineIconRect(AEventRect: TRect): TRect; function GetImageList: TCustomImageList; function GetMaxOLEvents(Event: TVpEvent; const EArray: TVpDvEventArray): Integer; procedure DrawAllDayEvents; procedure DrawBorders; 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); procedure DrawEvent(AEvent: TVpEvent; var AEventRec: TVpDvEventRec; ARenderDate: TDateTime; Col: Integer); procedure DrawEvents(ARenderDate: TDateTime; Col: Integer); procedure DrawEventText(const AText: String; const AEventRect, AIconRect: TRect; ALevel: Integer); procedure DrawIcons(AIconRect: TRect); procedure DrawNavBtns; procedure DrawNavBtnBackground; procedure DrawRegularEvents; procedure DrawRowHeader(R: TRect); procedure DrawRowHeaderBackground(R: TRect); procedure DrawRowHeaderLabels(R: TRect); procedure DrawRowHeaderTicks(R: TRect); procedure FixFontHeights; procedure FreeBitmaps; procedure GetIcons(Event: TVpEvent); function InitAllDayEventsRect: TRect; procedure InitColors; procedure InitializeEventRectangles; procedure PopulateEventArray(ARenderDate: TDateTime); procedure PrepareEventRect(AWidthDivisor, ALevel: Integer; var AEventRect: TRect); procedure PrepareEventTimes(AEvent: TVpEvent; ARenderDate: TDateTime; out AStartTime, AEndTime: TDateTime); procedure ScaleIcons(EventRect: TRect); procedure SetMeasurements; override; procedure VerifyMaxWidthDevisors; public constructor Create(ADayView: TVpDayview; ARenderCanvas: TCanvas); procedure RenderToCanvas(ARenderIn: TRect; AAngle: TVpRotationAngle; AScale: Extended; ARenderDate: TDateTime; AStartLine, AStopLine: Integer; AUseGran: TVpGranularity; ADisplayOnly: Boolean); override; end; implementation uses StrUtils, Math, LazUtf8, VpCanvasUtils, VpMisc; const ICON_MARGIN = 4; MINUTES_BORDER = 7; MINUTES_HOUR_DISTANCE = 4; TICK_DIST = 6; type TVpDayViewOpener = class(TVpDayView); constructor TVpDayViewPainter.Create(ADayView: TVpDayView; ARenderCanvas: TCanvas); begin inherited Create(ARenderCanvas); FDayView := ADayView; end; { returns the number of events which overlap the specified event } function TVpDayViewPainter.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; { 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; procedure TVpDayViewPainter.CreateBitmaps; begin dvBmpRecurring := TBitmap.Create; dvBmpCategory := TBitmap.Create; dvBmpAlarm := TBitmap.Create; dvBmpCustom := TBitmap.Create; end; function TVpDayViewPainter.DetermineIconRect(AEventRect: TRect): TRect; var MaxHeight: Integer; w: Integer; begin w := 0; if AlarmW <> 0 then inc(w, AlarmW + FScaledIconMargin); if RecurringW <> 0 then inc(w, RecurringW + FScaledIconMargin); if CategoryW <> 0 then inc(w, CategoryW + FScaledIconMargin); if CustomW <> 0 then inc(w, CustomW + FScaledIconMargin); if w <> 0 then inc(w, FScaledIconMargin); Result := AEventRect; Result.Right := Result.Left + w; MaxHeight := AlarmH + FScaledIconMargin; if RecurringH + FScaledIconMargin > MaxHeight then MaxHeight := dvBmpRecurring.Height; if CategoryH + FScaledIconMargin > MaxHeight then MaxHeight := dvBmpCategory.Height; if CustomH + FScaledIconMargin > MaxHeight then MaxHeight := dvBmpCustom.Height; if MaxHeight > AEventRect.Bottom - AEventRect.Top then MaxHeight := AEventRect.Bottom - AEventRect.Top; Result.Bottom := AEventRect.Top + MaxHeight; if Result.Right > AEventRect.Right then Result.Right := AEventRect.Right; end; { Returns the imagelist attached to the datastore of the dayview. } function TVpDayViewPainter.GetImageList: TCustomImageList; begin if (FDayView <> nil) and (FDayView.Datastore <> nil) then Result := FDayView.Datastore.Images else Result := nil; end; { returns the maximum OLEvents value from all overlapping neighbors } function TVpDayViewPainter.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 { 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; { Draws the all-day events at the top of the DayView in a special manner } procedure TVpDayViewPainter.DrawAllDayEvents; var ADEventsList: TList; TempList: TList; I, J, K: Integer; Event: TVpEvent; ADEvRect: TRect; StartsBeforeRange : Boolean; NumADEvents: Integer; Skip: Boolean; ADTextHeight: Integer; EventStr: string; I2: Integer; DI: Integer; AllDayWidth: Integer; OldTop: LongInt; txtDist: Integer; begin // Initialize the rectangle to be used for all-day events ADEventsRect := InitAllDayEventsRect; if (FDayView.DataStore = nil) or (FDayView.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. NumADEvents := 0; AllDayWidth := RealWidth - RealRowHeadWidth - TextMargin - ScrollBarOffset; DayWidth := AllDayWidth div FDayView.NumDays; ADEventsList := TList.Create; try TempList := TList.Create; try for I := 0 to pred(RealNumDays) do begin // Skip weekends if (not FDayView.IncludeWeekends) and IsWeekend(RenderDate + i) then Continue; // Get the all day events for the day specified by RenderDate + I FDayView.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 > NumADEvents then NumADEvents := TempList.Count; end; finally TempList.Free; end; if NumADEvents > 0 then begin // Measure the AllDayEvent text height RenderCanvas.Font.Assign(FDayView.AllDayEventAttributes.Font); {$IF VP_LCL_SCALING = 0} RenderCanvas.Font.Size := ScaleY(RenderCanvas.Font.Size, DesignTimeDPI); {$ENDIF} ADTextHeight := RenderCanvas.TextHeight(VpProductName) + TextMargin; // Distance between text and border txtDist := TextMargin div 2; // Store the top of the event's rect OldTop := ADEventsRect.Top; // Build the AllDayEventsRect based on the count of all-day events ADEventsRect.Bottom := AdEventsRect.Top + 2*txtDist + NumADEvents * (ADTextHeight + txtDist); // Clear the AllDayEvents area using its background color RenderCanvas.Brush.Color := RealADEventBkgColor; 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 DateInRange(RenderDate + I, Event.StartTime, Event.EndTime, true) then begin // See if the event began before the start of the range if (Event.StartTime < trunc(RenderDate)) then StartsBeforeRange := true; // Set the event's rect AdEvRect.Top := OldTop + txtDist + DI * (ADTextHeight + txtDist); AdEvRect.Bottom := ADEvRect.Top + ADTextHeight + txtDist*2; AdEvRect.Left := AdEventsRect.Left + DayWidth * I + txtDist; AdEvRect.Right := AdEventsRect.Left + DayWidth * (I + 1) - txtDist; RenderCanvas.Brush.Color := ADEventAttrBkgColor; RenderCanvas.Pen.Color := ADEventBorderColor; TPSRectangle(RenderCanvas, Angle, RenderIn, ADEvRect.Left + txtDist, ADEvRect.Top + txtDist, ADEvRect.Right - txtDist, ADEvRect.Top + ADTextHeight // + txtDist*2 ); EventStr := IfThen(StartsBeforeRange, '>> ', '') + Event.Description; EventStr := GetDisplayString(RenderCanvas, EventStr, 0, WidthOf(ADEvRect) - 2*TextMargin); TPSTextOut(RenderCanvas,Angle, RenderIn, AdEvRect.Left + TextMargin, AdEvRect.Top + txtDist, // AdEvRect.Bottom - ADTextHeight) div 2, //TextMargin, EventStr ); TVpDayViewOpener(FDayView).dvEventArray[EventCount].Rec := Rect( ADEvRect.Left, ADEvRect.Top - 2, ADEvRect.Right - TextMargin, ADEvRect.Bottom ); TVpDayViewOpener(FDayView).dvEventArray[EventCount].Event := Event; Inc(EventCount); inc(DI); end; end; { for I2 := 0 to pred(ADEventsList.Count) do ... } end; end; { if MaxADEvents > 0 } finally ADEventsList.Free; end; end; procedure TVpDayViewPainter.DrawBorders; var tmpRect: TRect; begin tmpRect := Rect(RealLeft, RealTop, RealRight-1, RealBottom-1); tmpRect := TPSRotateRectangle(Angle, RenderIn, tmpRect); if FDayView.DrawingStyle = dsFlat then begin { Draw a simple border } DrawBevelRect(RenderCanvas, tmpRect, BevelShadow, BevelShadow); end else if FDayView.DrawingStyle = ds3d then begin { Draw a 3d bevel } DrawBevelRect(RenderCanvas, tmpRect, BevelShadow, BevelHighlight); InflateRect(tmpRect, -1, -1); DrawBevelRect(RenderCanvas, tmpRect, BevelDarkShadow, BevelFace); end; end; procedure TVpDayViewPainter.DrawCells(R: TRect; ColDate: TDateTime; Col: Integer); var I: Integer; LineRect: TRect; SavedFont: TFont; GutterRect: TRect; tmpRect: TRect; LineStartTime: Double; lineIndex: Integer; begin if StartLine < 0 then StartLine := FDayView.TopLine; dec(R.Top); inc(R.Bottom); { Set GutterRect size } GutterRect.Left := R.Left; GutterRect.Top := R.Top; GutterRect.Bottom := R.Bottom; GutterRect.Right := GutterRect.Left + FScaledGutterWidth; R.Left := R.Left + FScaledGutterWidth + 1; { paint gutter area } RenderCanvas.Brush.Color := RealColor; tmpRect := GutterRect; if FDayView.DrawingStyle = dsNoBorder then inc(tmpRect.Bottom); TPSFillRect(RenderCanvas, Angle, RenderIn, tmpRect); { 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 FDayView.LineCount do begin // don't subtract 1 because of partially filled last line with TVpDayViewOpener(FDayView) do begin 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; end; SavedFont := TFont.Create; SavedFont.Assign(RenderCanvas.Font); try RenderCanvas.Font.Assign(FDayView.Font); {$IF VP_LCL_SCALING = 0} RenderCanvas.Font.Size := ScaleY(RenderCanvas.Font.Size, DesignTimeDPI); {$ENDIF} 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 := FDayView.LineColor; { Paint the client area } I := 0; while true do begin lineIndex := StartLine + I; if (I > pred(FDayView.LineCount)) then Break; if lineIndex >= FDayView.LineCount then Break; if (StopLine <> -1) and (lineIndex >= StopLine) then Break; RenderCanvas.Brush.Color := RealColor; RenderCanvas.Font.Assign(SavedFont); // no further scaling needed here LineRect.Top := Round(R.Top + i * RealRowHeight); LineRect.Bottom := Round(LineRect.Top + RealRowHeight); TVpDayViewOpener(FDayView).dvLineMatrix[Col, lineIndex].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 i = 0 then dec(LineRect.Top); if (not DisplayOnly) and // this means: during screen output FDayView.Focused and (FDayView.ActiveCol = Col) and (FDayView.ActiveRow = lineIndex) then begin { Paint background hilight color } RenderCanvas.Brush.Color := HighlightBkg; RenderCanvas.Font.Color := HighlightText; end else if (FRenderHoliday <> '') then RenderCanvas.Brush.Color := FDayview.TimeSlotColors.Holiday else if IsWeekend(ColDate) then { weekend color } RenderCanvas.Brush.Color := FDayView.TimeSlotColors.Weekend else { 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 FDayView.TimeSlotColors.ActiveRange.RangeBegin = FDayView.TimeSlotColors.ActiveRange.RangeEnd then { There is no active range --> Paint all time slots in the weekday color } RenderCanvas.Brush.Color := FDayView.TimeSlotColors.Weekday 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 := TVpDayViewOpener(FDayView).dvLineMatrix[Col, lineIndex].Time; if TimeInRange( LineStartTime, FDayView.TimeSlotColors.ActiveRange.StartTime, FDayView.TimeSlotColors.ActiveRange.EndTime - OneMinute, true ) then RenderCanvas.Brush.Color := FDayView.TimeSlotColors.Active else RenderCanvas.Brush.Color := FDayView.TimeSlotColors.Inactive; end; TPSFillRect (RenderCanvas, Angle, RenderIn, LineRect); { Draw the lines } RenderCanvas.Pen.Color := FDayView.LineColor; TPSMoveTo(RenderCanvas, Angle, RenderIn, LineRect.Left, LineRect.Bottom - 1); if (lineIndex + 1) mod FDayView.RowLinesStep = 0 then TPSLineTo(RenderCanvas, Angle, RenderIn, LineRect.Right - 1, LineRect.Bottom - 1); inc(I); end; // while true ... { 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); finally RenderCanvas.Font.Assign(SavedFont); SavedFont.Free; end; end; procedure TVpDayViewPainter.DrawColHeader(R: TRect; ARenderDate: TDateTime; Col: Integer); var SaveFont: TFont; DateStr, ResStr: string; DateStrLen, ResStrLen: integer; DateStrHt: Integer; TextRect: TRect; X, Y: Integer; tmpRect: TRect; begin SaveFont := TFont.Create; try SaveFont.Assign(RenderCanvas.Font); { Draw Column Header } RenderCanvas.Font.Assign(FDayView.HeadAttributes.Font); {$IF VP_LCL_SCALING = 0} RenderCanvas.Font.Size := ScaleY(RenderCanvas.Font.Size, DesignTimeDPI); {$ENDIF} RenderCanvas.Brush.Color := RealHeadAttrColor; RenderCanvas.Pen.Style := psClear; tmpRect := R; InflateRect(tmpRect, 1, 1); inc(tmpRect.Left); if FDayView.DrawingStyle = dsNoBorder then InflateRect(tmpRect, 1, 1); TPSRectangle(RenderCanvas, Angle, RenderIn, tmpRect); 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 for best usage of the available width } DateStr := GetDateDisplayString(RenderCanvas, ARenderDate, FDayView.DateLabelFormat, FRenderHoliday, WidthOf(TextRect)); DateStrLen := RenderCanvas.TextWidth(DateStr); DateStrHt := RenderCanvas.TextHeight(DateStr); if (FDayView.DataStore <> nil) and (FDayView.DataStore.Resource <> nil) and FDayView.ShowResourceName then begin { fix Res String } ResStr := FDayView.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, FDayView.DataStore.Resource.Description); end; { center the date string } X := TextRect.Left + (TextRect.Right - TextRect.Left) div 2 - DateStrLen div 2; Y := TextRect.Top + (TextMargin * 2) + DateStrHt; end else begin { center the date string } Y := TextRect.Top + TextMargin; X := TextRect.Left + (TextRect.Right - TextRect.Left) div 2 - DateStrLen div 2; end; { Write the date string } TPSTextOut(RenderCanvas, Angle, RenderIn, X, Y, DateStr); {Draw Column Head Borders } if FDayView.DrawingStyle = dsFlat then begin // bottom RenderCanvas.Pen.Color := BevelShadow; TPSMoveTo(RenderCanvas, Angle, RenderIn, R.Right, R.Bottom - 1); TPSLineTo(RenderCanvas, Angle, RenderIn, R.Left - 2, R.Bottom - 1); // right side TPSMoveTo(RenderCanvas, Angle, RenderIn, R.Right, R.Bottom - 1); RenderCanvas.Pen.Color := RealHeadAttrColor; TPSLineTo(RenderCanvas, Angle, RenderIn, R.Right, R.Bottom - 4); RenderCanvas.Pen.Color := BevelShadow; TPSLineTo(RenderCanvas, Angle, RenderIn, R.Right, R.Top + 2); RenderCanvas.Pen.Color := RealHeadAttrColor; TPSLineTo(RenderCanvas, Angle, RenderIn, R.Right, R.Top); end else if FDayView.DrawingStyle = ds3d then begin dec(R.Bottom); if Col = FDayView.NumDays - 1 then dec(R.Right, 4); R := TPSRotateRectangle(Angle, RenderIn, R); DrawBevelRect(RenderCanvas, R, BevelHighlight, BevelDarkShadow); end; RenderCanvas.Font.Assign(SaveFont); finally SaveFont.Free; end; end; { paint extra borders around the editor } procedure TVpDayViewPainter.DrawEditFrame(R: TRect; AGutter, ALevel: Integer; AColor: TColor); begin RenderCanvas.Pen.Color := clWindowFrame; RenderCanvas.Brush.Color := AColor; if ALevel = 0 then with R do begin TPSFillRect(RenderCanvas, Angle, RenderIn, Rect(Left, Top-AGutter, Right, Top)); TPSFillRect(RenderCanvas, Angle, RenderIn, Rect(Left-AGutter, Top, Left, Bottom)); TPSFillRect(RenderCanvas, Angle, RenderIn, Rect(Left, Bottom, Right, Bottom + AGutter)); TPSFillRect(RenderCanvas, Angle, RenderIn, Rect(Right, Top, Right+AGutter, Bottom)); end else with R do begin TPSFillRect(RenderCanvas, Angle, RenderIn, Rect(Left+AGutter, Top-AGutter, Right, Top)); TPSFillRect(RenderCanvas, Angle, RenderIn, Rect(Left, Top, Left, Bottom)); TPSFillRect(RenderCanvas, Angle, RenderIn, Rect(Left+AGutter, Bottom, Right, Bottom + AGutter)); TPSFillRect(RenderCanvas, Angle, RenderIn, Rect(Right, Top, Right+AGutter, Bottom)); end; end; procedure TVpDayViewPainter.DrawEvent(AEvent: TVpEvent; var AEventRec: TVpDvEventRec; ARenderDate: TDateTime; Col: Integer); var EventCategory: TVpCategoryInfo; EventIsEditing: Boolean; EventIsOverlayed: Boolean; EventSTime, EventETime: Double; EventDuration: Double; EventSLine, EventELine, EventLineCount: Integer; EventRect, GutterRect: TRect; StartPixelOffset, EndPixelOffset: Integer; StartOffset, EndOffset: Double; EventString: String; tmpRect: TRect; maxW: Integer; grp: TVpResourceGroup; begin { Initialize, collect useful information needed later } if Assigned(FDayView.Datastore) then begin EventCategory := FDayView.Datastore.CategoryColorMap.GetCategory(AEvent.Category); grp := FDayView.Datastore.Resource.Group; end else begin EventCategory := nil; grp := nil; end; EventIsOverlayed := AEvent.IsOverlayed; with TVpDayViewOpener(FDayView) do if (dvInplaceEditor <> nil) and dvInplaceEditor.Visible then EventIsEditing := (ActiveEvent = AEvent) else EventIsEditing := false; { remove the date portion from the start and end times } PrepareEventTimes(AEvent, ARenderDate, EventSTime, EventETime); AEventRec.RealStartTime := EventSTime; AEventRec.RealEndTime := EventETime; { Find the lines on which this event starts and ends } EventSLine := GetStartLine(EventSTime, UseGran); EventELine := GetEndLine(EventETime, UseGran); { If the event doesn't occupy area that is currently visible, then skip it. } if (EventELine < StartLine) or (EventSLine > StartLine + RealVisibleLines + 1) then Exit; { Calculate the number of lines this event will cover } EventLineCount := EventELine - EventSLine + 1; EventDuration := EventETime - EventSTime; { Build the rectangle in which the event will be painted. } EventRect := TVpDayViewOpener(FDayView).dvLineMatrix[Col, EventSLine].Rec; EventRect.Bottom := TVpDayViewOpener(FDayView).dvLineMatrix[Col, EventELine].Rec.Bottom; PrepareEventRect(AEventRec.WidthDivisor, AEventRec.Level, EventRect); { Draw the event rectangle } RenderCanvas.Brush.Color := WindowColor; if Assigned(FDayView.DataStore) then begin if EventIsEditing then RenderCanvas.Brush.Color := WindowColor else if Assigned(EventCategory) then RenderCanvas.Brush.Color := EventCategory.BackgroundColor end; if EventIsOverlayed then begin if (grp <> nil) and (not (odEventCategory in grp.ShowDetails)) then RenderCanvas.Brush.Color := FDayView.Datastore.HiddenCategories.BackgroundColor else RenderCanvas.Brush.Style := OverlayPatternToBrushStyle(AEvent.GetResource.Group.Pattern); end; TPSFillRect(RenderCanvas, Angle, RenderIn, EventRect); RenderCanvas.Brush.Style := bsSolid; { 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 } RenderCanvas.Brush.Color := clNavy; if Assigned(FDayView.Datastore) then begin RenderCanvas.Brush.Color := EventCategory.Color; if EventIsOverlayed and (grp <> nil) and (not (odEventCategory in grp.ShowDetails)) then RenderCanvas.Brush.Color := FDayView.Datastore.HiddenCategories.Color; end; { 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(FDayView.Granularity) * EventLineCount) if (PixelDuration > 0) and (EventDuration < GetLineDuration(UseGran) * EventLineCount) then begin if (EventSLine >= StartLine) and (EventSTime > TVpDayViewOpener(FDayView).dvLineMatrix[0, EventSLine].Time) then begin { Get the start offset in TDateTime format } StartOffset := EventSTime - TVpDayViewOpener(FDayView).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 < TVpDayViewOpener(FDayView).dvLineMatrix[0, EventELine + 1].Time) then begin { Get the end offset in TDateTime format } EndOffset := TVpDayViewOpener(FDayView).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 of all events } if (AEventRec.Level = 0) then GutterRect.Left := EventRect.Left - Trunc(FDayView.GutterWidth * Scale) // wp: use FGutterWidth? It uses round, though... else GutterRect.Left := EventRect.Left; GutterRect.Right := GutterRect.Left + FScaledGutterWidth; GutterRect.Top := EventRect.Top + StartPixelOffset; GutterRect.Bottom := EventRect.Bottom - EndPixelOffset + 1; TPSFillRect(RenderCanvas, Angle, RenderIn, GutterRect); RenderCanvas.Brush.Color := WindowColor; IconRect.Left := EventRect.Left; IconRect.Top := EventRect.Top; IconRect.Right := EventRect.Left; IconRect.Bottom := EventRect.Top; if FDayView.IconAttributes.ShowInPrint then begin GetIcons(AEvent); if AEventRec.Level = 0 then begin ScaleIcons(EventRect); IconRect := DetermineIconRect(EventRect); end else begin tmpRect := EventRect; inc(tmpRect.Left, FDayView.GutterWidth); ScaleIcons(tmpRect); IconRect := DetermineIconRect(tmpRect); end; end; OldPen.Assign(RenderCanvas.Pen); // wp: Original code had "Canvas" here which does not look correct OldBrush.Assign(RenderCanvas.Brush); OldFont.Assign(RenderCanvas.Font); if Assigned(FDayView.OnBeforeDrawEvent) then begin tmpRect := EventRect; if (AEventRec.Level <> 0) then inc(tmpRect.Left, FDayView.GutterWidth); FDayView.OnBeforeDrawEvent(Self, AEvent, FDayView.ActiveEvent = AEvent, RenderCanvas, GutterRect, tmpRect, IconRect); end; if FDayView.IconAttributes.ShowInPrint then DrawIcons(IconRect); { Build the event string } EventString := FDayView.BuildEventString(AEvent, false); { If the string is longer than the availble space then chop off the end and place those little '...'s at the end } if FDayView.WrapStyle = wsNone then begin maxW := EventRect.Right - IconRect.Right - FScaledGutterWidth - TextMargin; if RenderCanvas.TextWidth(EventString) > maxW then EventString := GetDisplayString(RenderCanvas, EventString, 0, maxW); end; { Draw the event string } DrawEventText(EventString, EventRect, IconRect, AEventRec.Level); { 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 AEventRec.Level > 0 then begin TPSMoveTo(RenderCanvas, Angle, RenderIn, EventRect.Left + FScaledGutterWidth, EventRect.Top); TPSLineTo(RenderCanvas, Angle, RenderIn, EventRect.Left + FScaledGutterWidth, EventRect.Bottom); end; if Assigned(FDayView.OnAfterDrawEvent) then begin tmpRect := EventRect; if (AEventRec.Level <> 0) then inc(tmpRect.Left, FDayView.GutterWidth); FDayView.OnAfterDrawEvent(Self, AEvent, FDayView.ActiveEvent = AEvent, RenderCanvas, GutterRect, tmpRect, IconRect); end; RenderCanvas.Brush.Assign(OldBrush); // wp: Original code had "Canvas" here which does not look correct. RenderCanvas.Pen.Assign(OldPen); RenderCanvas.Font.Assign(OldFont); tmpRect := EventRect; inc(tmpRect.Bottom); TVpDayViewOpener(FDayView).dvEventArray[EventCount].Rec := tmpRect; TVpDayViewOpener(FDayView).dvEventArray[EventCount].IconRect := IconRect; TVpDayViewOpener(FDayView).dvEventArray[EventCount].Event := AEvent; Inc(EventCount); end; procedure TVpDayViewPainter.DrawEvents(ARenderDate: TDateTime; Col: Integer); var I: Integer; Event: TVpEvent; SaveFont: TFont; SaveColor: TColor; OKToDrawEditFrame: Boolean; tmpRect: TRect; level: Integer; begin if (FDayView.DataStore = nil) or (FDayView.DataStore.Resource = nil) or (not FDayView.DataStore.Connected) then Exit; { Save the canvas color and font } SaveColor := RenderCanvas.Brush.Color; SaveFont := TFont.Create; SaveFont.Assign(RenderCanvas.Font); {Get all of the events for this day} PopulateEventArray(ARenderDate); // 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 VerifyMaxWidthDevisors; // 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 := TVpDayViewOpener(FDayView).dvLineMatrix[Col, StartLine].Rec; VisibleRect.Bottom := FDayView.ClientRect.Bottom; LineDuration := GetLineDuration(FDayView.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. } with TVpDayViewOpener(FDayView) do if HeightOf(dvLineMatrix[Col, StartLine].Rec) > 0 then PixelDuration := LineDuration / HeightOf(dvLineMatrix[Col, StartLine].Rec) else PixelDuration := 0; { Iterate through events and paint them } level := -1; 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; DrawEvent(Event, EventArray[i], ARenderDate, Col); if Event = FDayView.ActiveEvent then level := i; end; { paint extra borders around the editor } OKToDrawEditFrame := True; if Assigned(FDayView.ActiveEvent) then OKToDrawEditFrame := not FDayView.ActiveEvent.AllDayEvent; with TVpDayViewOpener(FDayView) do if (dvInPlaceEditor <> nil) and dvInplaceEditor.Visible and OKToDrawEditFrame then begin tmpRect := dvActiveEventRec; DrawEditFrame(tmpRect, GutterWidth, level, Datastore.CategoryColorMap.GetColor(ActiveEvent.Category)); end; finally { Clean Up } 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; procedure TVpDayViewPainter.DrawIcons(AIconRect: TRect); var DrawPos: Integer; procedure DrawIcon(ABitmap: TBitmap; w, h: Integer; IncDrawPos: Boolean = false); var R: TRect; bmp: TBitmap; begin if (ABitmap.Width <> 0) and (ABitmap.Height <> 0) then begin ABitmap.Transparent := True; R := Rect(0, 0, w, h); OffsetRect(R, AIconRect.Left + FScaledIconMargin + DrawPos, AIconRect.Top + FScaledIconMargin ); bmp := TBitmap.Create; try bmp.Assign(ABitmap); bmp.Transparent := true; {$IFDEF FPC} RotateBitmap(Bmp, Angle); {$ENDIF} TPSStretchDraw(RenderCanvas, Angle, RenderIn, R, Bmp); finally bmp.Free; end; if IncDrawPos then inc(DrawPos, w + FScaledIconMargin); end; end; begin DrawPos := 0; DrawIcon(dvBmpAlarm, AlarmW, AlarmH, true); DrawIcon(dvBmpRecurring, RecurringW, RecurringH, true); DrawIcon(dvBmpCustom, CustomW, CustomH, true); DrawIcon(dvBmpCategory, CategoryW, CategoryH, true); end; procedure TVpDayViewPainter.DrawEventText(const AText: String; const AEventRect, AIconRect: TRect; ALevel: Integer); var WorkRegion1: HRGN = 0; WorkRegion2: HRGN = 0; TextRegion: HRGN = 0; CW: Integer; begin if (FDayView.WrapStyle <> wsNone) then begin if (AEventRect.Bottom <> AIconRect.Bottom) and (AEventRect.Left <> AIconRect.Right) then begin if FDayView.WrapStyle = wsIconFlow then begin WorkRegion1 := CreateRectRgn(AIconRect.Right, AEventRect.Top, AEventRect.Right, AIconRect.Bottom); WorkRegion2 := CreateRectRgn(AEventRect.Left + FDayView.GutterWidth, AIconRect.Bottom, AEventRect.Right, AEventRect.Bottom); TextRegion := CreateRectRgn(AIconRect.Right, AEventRect.Top, AEventRect.Right, AIconRect.Bottom); CombineRgn(TextRegion, WorkRegion1, WorkRegion2, RGN_OR); end else TextRegion := CreateRectRgn(AIconRect.Right, AEventRect.Top, AEventRect.Right, AEventRect.Bottom); end else TextRegion := CreateRectRgn(AIconRect.Right + FDayView.GutterWidth, AEventRect.Top, AEventRect.Right, AEventRect.Bottom); try CW := RenderTextToRegion(RenderCanvas, Angle, RenderIn, TextRegion, AText); { write the event string to the proper spot in the EventRect } if CW < Length(AText) then begin RenderCanvas.Brush.Color := FDayView.DotDotDotColor; { draw dot dot dot } TPSFillRect(RenderCanvas, Angle, RenderIn, Rect(AEventRect.Right - 20, AEventRect.Bottom - 7, AEventRect.Right - 17, AEventRect.Bottom - 4) ); TPSFillRect(RenderCanvas, Angle, RenderIn, Rect(AEventRect.Right - 13, AEventRect.Bottom - 7, AEventRect.Right - 10, AEventRect.Bottom - 4)); TPSFillRect(RenderCanvas, Angle, RenderIn, Rect(AEventRect.Right - 6, AEventRect.Bottom - 7, AEventRect.Right - 3, AEventRect.Bottom - 4)); end; finally if WorkRegion1 <> 0 then DeleteObject(WorkRegion1); if WorkRegion2 <> 0 then DeleteObject(WorkRegion2); if TextRegion <> 0 then DeleteObject(TextRegion); end; end else begin if ALevel = 0 then { don't draw the gutter in the EventRect for level 0 events. } TPSTextOut(RenderCanvas, // wp: both cases are the same ?! Angle, RenderIn, AIconRect.Right + FDayView.GutterWidth + TextMargin, AEventRect.Top + TextMargin, AText ) else TPSTextOut(RenderCanvas, Angle, RenderIn, AIconRect.Right + FDayView.GutterWidth + TextMargin, AEventRect.Top + TextMargin, AText ); end; end; procedure TVpDayViewPainter.DrawNavBtns; var w: Integer; begin { size and place the Today button first. } with TVpDayViewOpener(FDayView) do begin dvDayUpBtn.Visible := FShowNavButtons; dvDayDownBtn.Visible := FShowNavButtons; dvTodayBtn.Visible := FShowNavButtons; dvWeekUpBtn.Visible := FShowNavButtons; dvWeekDownBtn.Visible := FShowNavButtons; { In order to hide the nav btns in designmode move them out of their parent } if (csDesigning in ComponentState) and not FShowNavButtons then begin dvTodayBtn.Left := -Width; dvWeekDownBtn.Left := -Width; dvWeekUpBtn.Left := -Width; dvDayDownBtn.Left := -Width; dvDayUpBtn.Left := -Width; exit; end; { Calculate width of buttons } dvTodayBtn.Height := trunc(RealColHeadHeight div 2); dvTodayBtn.Width := RealRowHeadWidth; dvWeekDownBtn.Width := RealRowHeadWidth div 4 + 2; dvWeekUpBtn.Width := dvWeekDownBtn.Width; dvDaydownBtn.Width := dvWeekdownBtn.Width - 4; dvDayUpBtn.Width := dvDayDownBtn.Width; w := dvWeekDownBtn.Width + dvWeekUpBtn.Width + dvDaydownBtn.Width + dvDayUpBtn.Width; if DrawingStyle = ds3d then begin dvTodayBtn.Left := 2 + (RealRowHeadWidth - w) div 2; dvTodayBtn.Top := 2; end else begin dvTodayBtn.Left := 1 + (RealRowHeadWidth - w) div 2; dvTodayBtn.Top := 1; end; { size and place the WeekDown button } dvWeekDownBtn.Height := dvTodayBtn.Height; dvWeekDownBtn.Left := dvTodayBtn.Left; dvWeekDownBtn.Top := dvTodayBtn.Top + dvTodayBtn.Height; { size and place the DayDown button } dvDayDownBtn.Height := dvTodayBtn.Height; dvDayDownBtn.Left := dvWeekDownBtn.Left + dvWeekDownBtn.Width; dvDayDownBtn.Top := dvWeekDownBtn.Top; { size and place the DayUp button } dvDayUpBtn.Height := dvTodayBtn.Height; dvDayUpBtn.Left := dvDayDownBtn.Left + dvDayDownBtn.Width; dvDayUpBtn.Top := dvWeekDownBtn.Top; { size and place the WeekUp button } dvWeekUpBtn.Height := dvTodayBtn.Height; dvWeekUpBtn.Left := dvDayUpBtn.Left + dvDayUpBtn.Width; dvWeekUpBtn.Top := dvWeekDownBtn.Top; end; end; procedure TVpDayViewPainter.DrawNavBtnBackground; var R: TRect; begin // Draw the background RenderCanvas.Brush.Color := RealHeadAttrColor; R := Rect( RealLeft + 1, RealTop, RealLeft + 3 + RealRowHeadWidth, RealTop + RealColHeadHeight // + 1 ); if FDayView.DrawingStyle = dsNoBorder then begin InflateRect(R, 1, 1); TPSFillRect(RenderCanvas, Angle, RenderIn, R); exit; end; TPSFillRect(RenderCanvas, Angle, RenderIn, R); // Draw the border if FDayView.DrawingStyle = ds3d then begin R := Rect(R.Left + 1, R.Top + 2, R.Right - 2, R.Bottom - 1); DrawBevelRect( RenderCanvas, TPSRotateRectangle(Angle, RenderIn, R), BevelHighlight, BevelShadow ) end else if FDayView.DrawingStyle = dsFlat then begin RenderCanvas.Pen.Color := BevelShadow; TPSMoveTo(RenderCanvas, Angle, RenderIn, R.Right - 6, R.Bottom- 1); TPSLineTo(RenderCanvas, Angle, RenderIn, R.Left + 3, R.Bottom - 1); TPSMoveTo(RenderCanvas, Angle, RenderIn, R.Right - 2, R.Top + 6); TPSLineTo(RenderCanvas, Angle, RenderIn, R.Right - 2, R.Bottom - 5); { RenderCanvas.Pen.Color := BevelHighlight; TPSLineTo(RenderCanvas, Angle, RenderIn, R.Left, R.Top); TPSLineTo(RenderCanvas, Angle, RenderIn, R.Right - 2, R.Top); } 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 { Check if the currently rendered day is a holiday and store its name } FDayView.IsHoliday(RenderDate + i, FRenderHoliday); { Calculate Column Header rectangle } ColHeadRect := Rect(RPos, RealTop + 2, RPos + DayWidth - 1, RealTop + RealColHeadHeight); if (i = RealNumDays - 1) and (ExtraSpace > 0) then ColHeadRect.Right := ColHeadRect.Right + ExtraSpace; { Calculate the column rect for this day } RenderCanvas.Font.Assign(FDayView.Font); {$IF VP_LCL_SCALING = 0} RenderCanvas.Font.Size := ScaleY(RenderCanvas.Font.Size, DesignTimeDPI); {$ENDIF} 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); { Draw the column header } 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); Inc(RPos, DayWidth); Inc(RealDay); end; end; end; procedure TVpDayViewPainter.DrawRowHeader(R: TRect); begin if StartLine < 0 then StartLine := FDayView.TopLine; // Draw background and border DrawRowHeaderBackground(R); // Draw time ticks DrawRowHeaderTicks(R); // Draw time labels DrawRowHeaderLabels(R); end; procedure TVpDayViewPainter.DrawRowHeaderBackground(R: TRect); var tmpRect: TRect; begin // Expand rect to include the area left of the all-day events dec(R.Top, HeightOf(ADEventsRect)); // Draw row header background if FDayView.DrawingStyle = dsNoBorder then InflateRect(R, 1,1); RenderCanvas.Pen.Style := psClear; RenderCanvas.Brush.Color := RealRowHeadAttrColor; TPSFillRect(RenderCanvas, Angle, RenderIn, R); RenderCanvas.Pen.Style := psSolid; if FDayView.DrawingStyle = dsNoBorder then InflateRect(R, -1,-1); // Draw row header borders if FDayView.DrawingStyle = dsFlat then begin RenderCanvas.Pen.Color := BevelShadow; TPSMoveTo(RenderCanvas, Angle, RenderIn, R.Right - 1, R.Top); TPSLineTo(RenderCanvas, Angle, RenderIn, R.Right - 1, R.Bottom - 1); end else if FDayView.DrawingStyle = ds3d then begin tmpRect := TPSRotateRectangle(Angle, RenderIn, Rect(R.Left + 1, R.Top, R.Right - 1, R.Bottom - 1) ); DrawBevelRect(RenderCanvas, tmpRect, BevelHighlight, BevelDarkShadow); end; end; procedure TVpDayViewPainter.DrawRowHeaderLabels(R: TRect); var I: Integer; x, y: Integer; lineRect: TRect; lineIndex: Integer; maxIndex: Integer; hour, prevHour: Integer; hourStr, minuteStr, timeStr: String; isFullHour: boolean; begin // Calculate the rectangle occupied by a row lineRect := Rect(R.Left, R.Top, R.Right, R.Top + RealRowHeight); maxIndex := High(TVpDayViewOpener(FDayView).dvLineMatrix[0]); y := LineRect.Top; I := 0; prevHour := 0; while true do begin lineIndex := StartLine + I; if lineIndex > maxIndex then break; isFullHour := TVpDayViewOpener(FDayView).dvLineMatrix[0, LineIndex].Minute = 0; if isFullHour then begin hour := Ord(TVpDayViewOpener(FDayView).dvLineMatrix[0, LineIndex].Hour); if (hour < prevHour) then break; if (hour = 0) and (I > 0) then break; if (StopLine > -1) and (lineIndex >= StopLine) then break; prevHour := hour; case FDayView.TimeFormat of tf24Hour: minuteStr := '00'; tf12Hour: minuteStr := IfThen(hour < 12, 'am', 'pm'); end; if (Hour > 12) and (FDayView.TimeFormat = tf12Hour) then hourStr := IntToStr(hour - 12) else begin hourStr := IntToStr(hour); if (FDayView.TimeFormat = tf12Hour) and (hourStr = '0') then hourStr := '12'; end; if (UseGran = gr60Min) or FDayView.SimpleRowTime then begin // In case of 60-min granularity paint time as simple string RenderCanvas.Font.Assign(FDayView.RowHeadAttributes.MinuteFont); {$IF VP_LCL_SCALING = 0} RenderCanvas.Font.Size := ScaleY(RenderCanvas.Font.Size, DesignTimeDPI); {$ENDIF} timeStr := Format('%s:%s', [hourStr, minuteStr]); x := lineRect.Left + FScaledTickDist; TPSTextOut(RenderCanvas, Angle, RenderIn, x, y + TextMargin, timeStr); end else begin // In all other cases, paint large hour and small minutes (or am/pm) // Draw minutes RenderCanvas.Font.Assign(FDayView.RowHeadAttributes.MinuteFont); {$IF VP_LCL_SCALING = 0} RenderCanvas.Font.Size := ScaleY(RenderCanvas.Font.Size, DesignTimeDPI); {$ENDIF} x := lineRect.Right - RenderCanvas.TextWidth(MinuteStr) - MINUTES_BORDER; TPSTextOut(RenderCanvas, Angle, RenderIn, x, y + TextMargin, minuteStr); // Draw hours RenderCanvas.Font.Assign(FDayView.RowHeadAttributes.HourFont); {$IF VP_LCL_SCALING = 0} RenderCanvas.Font.Size := ScaleY(RenderCanvas.Font.Size, DesignTimeDPI); {$ENDIF} dec(x, RenderCanvas.TextWidth(HourStr) + MINUTES_HOUR_DISTANCE); TPSTextOut(RenderCanvas, Angle, RenderIn, x, y + TextMargin{ - 2}, hourStr); end; end; inc(y, RealRowHeight); inc(I); end; // while end; procedure TVpDayViewPainter.DrawRowHeaderTicks(R: TRect); var I: Integer; y: Integer; isFullHour: Boolean; lineRect: TRect; adEvHeight: Integer; lineIndex: Integer; maxIndex: Integer; midnightIndex: Integer; minutesLen: Integer; hour: Integer; begin // Calculate the rectangle occupied by a row lineRect := Rect(R.Left, R.Top, R.Right, R.Top + RealRowHeight); // Calculate height of all-day events rectangle adEvHeight := HeightOf(ADEventsRect); // Calculate length of minutes ticks RenderCanvas.Font.Assign(FDayView.RowHeadAttributes.MinuteFont); {$IF VP_LCL_SCALING = 0} RenderCanvas.Font.Size := ScaleY(RenderCanvas.Font.Size, DesignTimeDPI); {$ENDIF} minutesLen := RenderCanvas.TextWidth('00') + MINUTES_BORDER + MINUTES_HOUR_DISTANCE div 2; // Prepare pen RenderCanvas.Pen.Style := psSolid; RenderCanvas.Pen.Color := RealLineColor; y := lineRect.Top; // The top-most tick is not drawn, it is identical with the lower edge of // the NavBar block. Only if there are all-day events we must paint it. if adEvHeight > 0 then begin TPSMoveTo(RenderCanvas, Angle, RenderIn, lineRect.Right - FScaledTickDist, y); TPSLineTo(RenderCanvas, Angle, RenderIn, lineRect.Left + FScaledTickdist, y); end; // Begin with I = 1 because top-most tick already has been handled I := 1; maxIndex := High(TVpDayViewOpener(FDayView).dvLineMatrix[0]); midnightIndex := GetEndLine(0.9999, UseGran); while true do begin lineIndex := StartLine + I; if lineIndex > maxIndex then break; if (StopLine > -1) and (lineIndex > StopLine) then break; inc(y, RealRowHeight); if y > R.Bottom then break; hour := Ord(TVpDayViewOpener(FDayView).dvLineMatrix[0, LineIndex].Hour); if (hour = 0) and (lineIndex > midnightIndex) then // midnight isFullHour := true // to draw the 0:00 tick else if lineIndex = StopLine then isFullHour := true // to draw the last hour tick else isFullHour := TVpDayViewOpener(FDayView).dvLineMatrix[0, lineIndex].Minute = 0; TPSMoveTo(RenderCanvas, Angle, RenderIn, lineRect.Right - FScaledTickDist, y - 1); if lineIndex mod FDayView.RowLinesStep = 0 then if isFullHour then // Hour tick line TPSLineTo(RenderCanvas, Angle, RenderIn, lineRect.Left + FScaledTickDist, y - 1) else // Minutes tick lines TPSLineTo(RenderCanvas, Angle, RenderIn, lineRect.Right - MinutesLen, y - 1); inc(I); end; end; procedure TVpDayViewPainter.CalcRowHeadRect(out ARect: TRect); begin ARect := Rect( RealLeft, ADEventsRect.Bottom, RealLeft + 2 + RealRowHeadWidth, RealBottom ); if FDayView.DrawingStyle <> ds3d then inc(ARect.Left); end; function TVpDayViewPainter.CalcRowHeadWidth: integer; begin Result := 2 * MINUTES_BORDER + MINUTES_HOUR_DISTANCE; RenderCanvas.Font.Assign(FDayView.RowHeadAttributes.MinuteFont); {$IF VP_LCL_SCALING = 0} RenderCanvas.Font.Size := ScaleY(RenderCanvas.Font.Size, DesignTimeDPI); {$ENDIF} inc(Result, RenderCanvas.TextWidth('00')); RenderCanvas.Font.Assign(FDayView.RowHeadAttributes.HourFont); {$IF VP_LCL_SCALING = 0} RenderCanvas.Font.Size := ScaleY(RenderCanvas.Font.Size, DesignTimeDPI); {$ENDIF} inc(Result, RenderCanvas.TextWidth('33')); with TVpDayViewOpener(FDayView) do Result := Max(Result, dvDayUpBtn.Glyph.Width + dvDayDownBtn.Glyph.Width + dvWeekUpBtn.Glyph.Width + dvWeekDownBtn.Glyph.Width); end; procedure TVpDayViewPainter.FixFontHeights; begin with FDayView do begin AllDayEventAttributes.Font.Height := GetRealFontHeight(AllDayEventAttributes.Font); Font.Height := GetRealFontHeight(Font); HeadAttributes.Font.Height := GetRealFontHeight(HeadAttributes.Font); RowHeadAttributes.HourFont.Height := GetRealFontHeight(RowHeadAttributes.HourFont); RowHeadAttributes.MinuteFont.Height := GetRealFontHeight(RowHeadAttributes.MinuteFont); end; end; procedure TVpDayViewPainter.FreeBitmaps; begin dvBmpRecurring.Free; dvBmpCategory.Free; dvBmpAlarm.Free; dvBmpCustom.Free; end; procedure TVpDayViewPainter.GetIcons(Event: TVpEvent); var ShowAlarm: Boolean; ShowRecurring: Boolean; ShowCategory: Boolean; ShowCustom: Boolean; Icons: TVpDVIcons; cat: TVpCategoryInfo; w: Integer; isOverlayed: Boolean; grp: TVpResourceGroup; imgList: TCustomImageList; {$IFDEF LCL} {$IF LCL_FullVersion >= 1090000} ppi: Integer; f: Double; w96: Integer; {$IFEND} {$ENDIF} begin ShowAlarm := False; ShowRecurring := False; ShowCategory := False; ShowCustom := False; imgList := GetImageList; {$IFDEF LCL} {$IF LCL_FullVersion >= 1090000} ppi := FDayView.Font.PixelsPerInch; f := FDayView.GetCanvasScaleFactor; w96 := FDayView.DataStore.ImagesWidth; if imgList <> nil then w := imgList.SizeForPPI[w96, ppi].CX else w := w96; {$IFEND} {$ENDIF} if Event.AlarmSet then begin if (FDayView.IconAttributes.AlarmImageIndex > -1) and (imgList <> nil) then begin {$IFDEF LCL} {$IF LCL_FullVersion >= 1090000} dvBmpAlarm.PixelFormat := pf32Bit; dvBmpAlarm.SetSize(w, w); imgList.DrawForPPI(dvBmpAlarm.Canvas, 0, 0, FDayView.IconAttributes.AlarmImageIndex, w96, ppi, f); {$ELSE} imgList.GetBitmap(FDayView.IconAttributes.AlarmImageIndex, dvBmpAlarm) {$IFEND} {$ENDIF} end else dvBmpAlarm.Assign(FDayView.IconAttributes.AlarmBitmap); ShowAlarm := (dvBmpAlarm.Width <> 0) and (dvBmpAlarm.Height <> 0); end; if Event.RepeatCode <> rtNone then begin if (FDayView.IconAttributes.RecurringImageIndex > -1) and (imgList <> nil) then begin {$IFDEF LCL} {$IF LCL_FullVersion >= 1090000} dvBmpRecurring.PixelFormat := pf32Bit; dvBmpRecurring.SetSize(w, w); imgList.DrawForPPI(dvBmpRecurring.Canvas, 0, 0, FDayView.IconAttributes.RecurringImageIndex, w96, ppi, f); {$ELSE} imgList.GetBitmap(FDayview.IconAttributes.RecurringImageIndex, dvBmpRecurring) {$IFEND} {$ENDIF} end else dvBmpRecurring.Assign(FDayView.IconAttributes.RecurringBitmap); ShowRecurring := (dvBmpRecurring.Width <> 0) and (dvBmpRecurring.Height <> 0); end; if Assigned(FDayView.DataStore) then begin isOverlayed := Event.IsOverlayed; grp := FDayView.Datastore.Resource.Group; if isOverlayed and (grp <> nil) and (not (odEventCategory in grp.ShowDetails)) then begin dvBmpCategory.Width := 0; dvBmpCategory.Height := 0; end else if Event.Category < 10 then begin cat := FDayView.Datastore.CategoryColorMap.GetCategory(Event.Category); if (cat.ImageIndex > -1) and (imgList <> nil) then begin {$IFDEF LCL} {$IF LCL_FullVersion >= 1090000} dvBmpCategory.PixelFormat := pf32Bit; dvBmpCategory.SetSize(w, w); imgList.DrawForPPI(dvBmpCategory.Canvas, 0, 0, cat.ImageIndex, w96, ppi, f); {$ELSE} imgList.GetBitmap(cat.ImageIndex, dvBmpCategory) {$IFEND} {$ENDIF} end else dvBmpCategory.Assign(cat.Bitmap); 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 FDayView.IconAttributes.ShowAlarmBitmap then ShowAlarm := False; if not FDayView.IconAttributes.ShowCategoryBitmap then ShowCategory := False; if not FDayView.IconAttributes.ShowRecurringBitmap then ShowRecurring := False; if Assigned(FDayView.OnDrawIcons) 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; FDayView.OnDrawIcons (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 := Round(dvBmpAlarm.Width * Scale); RecurringW := Round(dvBmpRecurring.Width * Scale); CategoryW := Round(dvBmpCategory.Width * Scale); CustomW := Round(dvBmpCustom.Width); AlarmH := Round(dvBmpAlarm.Height * Scale); RecurringH := Round(dvBmpRecurring.Height * Scale); CategoryH := Round(dvBmpCategory.Height * Scale); CustomH := Round(dvBmpCustom.Height * Scale); end; { initialize the all-day events area } function TVpDayViewPainter.InitAllDayEventsRect: TRect; begin Result.Left := RealLeft + 2 + RealRowHeadWidth; // wp: was 3 Result.Top := RealTop + RealColHeadHeight; Result.Right := FDayView.ClientRect.Right; Result.Bottom := Result.Top; end; procedure TVpDayViewPainter.InitColors; 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 := FDayView.HeadAttributes.Color; RealRowHeadAttrColor := FDayView.RowHeadAttributes.Color; RealLineColor := FDayView.LineColor; RealColor := FDayView.Color; RealADEventBkgColor := FDayView.AllDayEventAttributes.BackgroundColor; ADEventAttrBkgColor := FDayView.AllDayEventAttributes.EventBackgroundColor; ADEventBorderColor := FDayView.AllDayEventAttributes.EventBorderColor; end; end; procedure TVpDayViewPainter.InitializeEventRectangles; var I : Integer; begin EventCount := 0; with TVpDayViewOpener(FDayView) do 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; procedure TVpDayViewPainter.RenderToCanvas(ARenderIn: TRect; AAngle: TVpRotationAngle; AScale: Extended; ARenderDate: TDateTime; AStartLine, AStopLine: Integer; AUseGran: TVpGranularity; ADisplayOnly: Boolean); {wp: DisplayOnly is poorly-named. It is false during screen output in the form, it is true during printing and in print preview } begin inherited; // Make sure to use only the date part ARenderDate := trunc(ARenderDate); InitColors; SavePenBrush; InitPenBrush; InitializeEventRectangles; if ADisplayOnly then FixFontHeights; SetMeasurements; ScrollbarOffset := 0; with TVpDayViewOpener(FDayView) do if ADisplayOnly then begin // use printer settings SetTimeIntervals(ControlLink.Printer.Granularity); TopLine := StartLine; StartLine := TopLine; end else begin // use screen settings SetTimeIntervals(Granularity); if StartLine < 0 then StartLine := FDayView.TopLine; if VisibleLines < LineCount then ScrollbarOffset := GetSystemMetrics(SM_CYHSCROLL); end; Rgn := CreateRectRgn(RenderIn.Left, RenderIn.Top, RenderIn.Right, RenderIn.Bottom); try SelectClipRgn(RenderCanvas.Handle, Rgn); // Calculate the RealNumDays (The number of days the control covers) RealNumDays := TVpDayViewOpener(FDayView).GetRealNumDays(RenderDate); // Calculate row and column header RealRowHeight := TVpDayViewOpener(FDayView).dvCalcRowHeight(Scale, UseGran); RealRowHeadWidth := CalcRowHeadWidth; RealColHeadHeight := TVpDayViewOpener(FDayView).dvCalcColHeadHeight(Scale); // RowHeadRect and RealVisibleLines are calculated below... // Draw the all-day events DrawAllDayEvents; // Draw the area in the top left corner, where the nav buttons go. DrawNavBtnBackground; // Draw row headers CalcRowHeadRect(RowHeadRect); RealVisibleLines := TVpDayViewOpener(FDayView).dvCalcVisibleLines( HeightOf(RowHeadRect), RealColHeadHeight, RealRowHeight, Scale, StartLine, StopLine ); if Assigned(FDayView.OwnerDrawRowHeader) then begin Drawn := false; FDayView.OwnerDrawRowHeader(self, RenderCanvas, RowHeadRect, RealRowHeight, Drawn); if not Drawn then DrawRowHeader(RowHeadRect); end else DrawRowHeader(RowHeadRect); // Draw the regular events DrawRegularEvents; // Draw borders DrawBorders; // Place and draw navigation buttons DrawNavBtns; // Restore RenderCanvas settings RestorePenBrush; finally SelectClipRgn(RenderCanvas.Handle, 0); DeleteObject(Rgn); end; end; procedure TVpDayViewPainter.PopulateEventArray(ARenderDate: TDateTime); var EventList: TList; event: TVpEvent; level: Integer; I, J: Integer; thisTime: TTime; begin { Set the event array's max size } SetLength(EventArray, MaxVisibleEvents); // EventArray is global within painter { 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} FDayView.DataStore.Resource.Schedule.EventsByDate(ARenderDate, EventList); { Discard AllDayEvents, because they are drawn separately. } for I := pred(EventList.Count) downto 0 do begin event := EventList[I]; if event.AllDayEvent then EventList.Delete(I); end; { Now sort times in ascending order. This must be done because the event list can contain recurring events which have the wrong date part } EventList.Sort(@CompareEventsByTimeOnly); { Arrange this day's events in the event matrix } level := 0; I := 0; while EventList.Count > 0 do begin { Iterate through the (corrected) events, and place them all at the proper place in the EventMatrix, according to their start and end times } J := 0; ThisTime := 0.0; 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; end; procedure TVpDayViewPainter.PrepareEventRect(AWidthDivisor, ALevel: Integer; var AEventRect: TRect); var eventWidth: Integer; begin if AEventRect.Left < VisibleRect.Left then AEventRect.Left := VisibleRect.Left; if AEventRect.Top < VisibleRect.Top then AEventRect.Top := VisibleRect.Top; if AEventRect.Bottom = -1 then AEventRect.Bottom := AEventRect.Top + RealRowHeight else if (AEventRect.Bottom < VisibleRect.Top) then AEventRect.Bottom := VisibleRect.Bottom; eventWidth := WidthOf(VisibleRect) div AWidthDivisor; { Slide the rect over to correspond with the level } if ALevel > 0 then AEventRect.Left := AEventRect.Left + eventWidth * ALevel { added because level 0 events were one pixel too far to the right } else AEventRect.Left := AEventRect.Left - 1; AEventRect.Right := AEventRect.Left + eventWidth;; // + 1; -- wp: removed to avoid painting over the right border line dec(AEventRect.Top); // wp: without this, the top border line of the event is thicker than the others end; { remove the date portion from the start and end times } procedure TVpDayViewPainter.PrepareEventTimes(AEvent: TVpEvent; ARenderDate: TDateTime; out AStartTime, AEndTime: TDateTime); begin (* -- original { remove the date portion from the start and end times } EventSTime := Event.StartTime; EventETime := Event.EndTime; if trunc(EventSTime) < trunc(ARenderDate) then //First Event EventSTime := 0+trunc(ARenderDate); if trunc(EventETime) > trunc(ARenderDate) then //First Event EventETime := 0.999+trunc(ARenderDate); EventSTime := EventSTime - ARenderDate; EventETime := EventETime - ARenderDate; { 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); *) AStartTime := AEvent.StartTime; AEndTime := AEvent.EndTime; if (AStartTime < trunc(ARenderDate)) and (AEvent.RepeatCode = rtNone) then // First Event AStartTime := trunc(ARenderDate) else if (AEvent.RepeatCode <> rtNone) then AStartTime := frac(AStartTime) + trunc(ARenderDate); if (trunc(AEndTime) > trunc(ARenderDate)) and (AEvent.RepeatCode = rtNone) then // First Event // wp: wouldn't this be better? // AEndtime := trunc(ARenderDate) + 1 - 1.0 / (24 * 60 * 60) // 1 sec before midnight AEndTime := 0.999 + trunc(ARenderDate) else if (AEvent.RepeatCode <> rtNone) then AEndTime := frac(AEndTime) + trunc(ARenderDate); AStartTime := AStartTime - trunc(ARenderDate); AEndTime := AEndTime - trunc(ARenderDate); { Handle End Times of Midnight } if AEndTime = 0 then AEndTime := EncodeTime(23, 59, 59, 0); // wp: Is the date part correct here? end; procedure TVpDayViewPainter.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 TVpDayViewPainter.SetMeasurements; begin inherited; TVpDayViewOpener(FDayView).dvCalcColHeadHeight(Scale); FScaledGutterWidth := Round(FDayView.GutterWidth * Scale); FScaledIconMargin := Round(ICON_MARGIN * Scale); FScaledTickdist := Round(TICK_Dist * Scale); end; procedure TVpDayViewPainter.VerifyMaxWidthDevisors; var I, K: Integer; Event1, Event2: TVpEvent; tStart1, tEnd1, tStart2, tEnd2: TTime; 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; { get start and end times without the date part } tStart1 := frac(Event1.StartTime); tEnd1 := frac(Event1.EndTime); { 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; tStart2 := frac(Event2.StartTime); tEnd2 := frac(Event2.EndTime); { if the Tmp event overlaps with Event, then check its WidthDivisor } if TimeInRange(tStart2, tStart1, tEnd1, false) or TimeInRange(tEnd2, tStart1, tEnd1, false) or ((tStart2 <= tStart1) and (tEnd2 >= tEnd1)) then begin if EventArray[I].WidthDivisor < EventArray[K].WidthDivisor then EventArray[I].WidthDivisor := EventArray[K].WidthDivisor; end; end; { -- 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.