unit VpGanttViewPainter; {$mode objfpc}{$H+} interface uses Classes, SysUtils, Graphics, LCLType, LCLIntf, Types, VpBase, VpBasePainter, VpGanttView; type TVpGanttViewPainter = class(TVpBasePainter) private FGanttView: TVpGanttView; FDayFont: TFont; FMonthFont: TFont; FEventFont: TFont; BevelHighlight: TColor; BevelShadow: TColor; BevelDarkShadow: TColor; BevelFace: TColor; RealColHeadAttrColor: TColor; RealColor: TColor; RealLineColor: TColor; RealRowHeadAttrColor: TColor; protected procedure Clear; procedure DrawBorders; procedure DrawColHeader; procedure DrawEvents; procedure DrawGrid; procedure DrawRowHeader; procedure FixFontHeights; procedure InitColors; procedure SetMeasurements; override; public constructor Create(AGanttView: TVpGanttView; ARenderCanvas: TCanvas); procedure RenderToCanvas(ARenderIn: TRect; AAngle: TVpRotationAngle; AScale: Extended; ARenderDate: TDateTime; AStartLine, AStopLine: Integer; AUseGran: TVpGranularity; ADisplayOnly: Boolean); override; end; implementation uses DateUtils, VpConst, VpMisc, VpCanvasUtils, VpData; type TVpGanttViewOpener = class(TVpGanttView); constructor TVpGanttViewPainter.Create(AGanttView: TVpGanttView; ARenderCanvas: TCanvas); begin inherited Create(ARenderCanvas); FGanttView := AGanttView; end; procedure TVpGanttViewPainter.Clear; begin RenderCanvas.Brush.Color := RealColor; RenderCanvas.FillRect(RenderIn); end; procedure TVpGanttViewPainter.DrawBorders; var R: TRect; begin R := Rect(RealLeft, RealTop, RealRight - 1, RealBottom - 1); case FGanttView.DrawingStyle of dsNoBorder: ; // no border dsFlat: // Draw a simple rectangular border DrawBevelRect( RenderCanvas, TPSRotateRectangle(Angle, RenderIn, R), BevelShadow, BevelShadow ); ds3D: // Draw a 3d bevel begin DrawBevelRect( RenderCanvas, TPSRotateRectangle(Angle, RenderIn, R), BevelShadow, BevelHighlight ); (* InflateRect(R, -1, -1); DrawBevelRect( RenderCanvas, TPSRotateRectangle(Angle, RenderIn, R), BevelDarkShadow, clRed //BevelFace ); *) end; end; end; procedure TVpGanttViewPainter.DrawColHeader; var i, n: Integer; R, R1: TRect; P: TPoint; monthRec: TVpGanttMonthRec; dayRec: TVpGanttDayRec; str: String; strLen, strH: Integer; dx: Integer; begin RenderCanvas.Brush.Color := RealColHeadAttrColor; RenderCanvas.Pen.Color := RealLineColor; R := Rect(RealLeft, RealTop, RealRight, FGanttView.TotalColHeaderHeight); TPSFillRect(RenderCanvas, Angle, RenderIn, R); if FGanttView.DrawingStyle = ds3D then begin R1 := R; InflateRect(R1, -1, -1); R1.Right := FGanttView.FixedColWidth-1; DrawBevelRect( RenderCanvas, TPSRotateRectangle(Angle, RenderIn, R1), BevelHighlight, BevelShadow ); R1.Left := FGanttView.FixedColWidth; R1.Right := RealRight-2; DrawBevelRect( RenderCanvas, TPSRotateRectangle(Angle, RenderIn, R1), BevelHighlight, BevelShadow ); end else begin TPSMoveTo(RenderCanvas, Angle, RenderIn, FGanttView.FixedColWidth, R.Top); TPSLineTo(RenderCanvas, Angle, RenderIn, FGanttView.FixedColWidth, R.Bottom); TPSMoveTo(RenderCanvas, Angle, RenderIn, RealLeft, R.Bottom); TPSLineTo(RenderCanvas, Angle, RenderIn, RealRight, R.Bottom); end; // Offset due to scrolling dx := FGanttView.LeftCol * FGanttView.ColWidth; // Draw month rectangles and month captions RenderCanvas.Font.Assign(FMonthFont); n := FGanttView.NumMonths; for i := 0 to n-1 do begin monthRec := FGanttView.MonthRecords[i]; R := monthRec.Rect; OffsetRect(R, -dx , 0); // Clip at fixed col edge if R.Left < FGanttView.FixedColWidth then R.Left := FGanttView.FixedColWidth; // Draw month box if FGanttView.DrawingStyle = ds3D then begin R1 := R; if i > 0 then inc(R1.Left); dec(R1.Bottom); DrawBevelRect( RenderCanvas, TPSRotateRectangle(Angle, RenderIn, R1), BevelHighlight, BevelShadow ) end else begin TPSMoveTo(RenderCanvas, Angle, RenderIn, R.Right, R.Top); TPSLineTo(RenderCanvas, Angle, RenderIn, R.Right, R.Bottom); end; // Paint month name. Use short format if space is too small for long format. str := FormatDateTime(FGanttView.MonthFormat, monthRec.Date); strLen := RenderCanvas.TextWidth(str); if strLen > R.Width - 2 * FGanttView.TextMargin then begin str := FormatDateTime(FGanttView.MonthFormat_short, monthRec.Date); strLen := RenderCanvas.TextWidth(str); end; if strLen > R.Width - 2 * FGanttView.TextMargin then str := ''; if str <> '' then begin P := Point((R.Left + R.Right - strLen) div 2, R.Top + FGanttView.TextMargin); TPSTextOut(RenderCanvas, Angle, RenderIn, P.X, P.Y, str); end; end; // Draw day captions (always centered) and dividing lines (always at right side). RenderCanvas.Font.Assign(FDayFont); strH := RenderCanvas.TextHeight('Tg'); n := FGanttView.NumDays; for i := 0 to n - 1 do begin dayRec := FGanttView.DayRecords[i]; R := dayRec.Rect; OffsetRect(R, -dx, 0); if R.Left < FGanttView.FixedColWidth then Continue; // No dividing line at last day of month because it already has been // drawn as the month divider. if (DayOf(dayRec.Date) <> DaysInMonth(dayRec.Date)) then begin if FGanttView.DrawingStyle = ds3D then DrawBevelLine( RenderCanvas, TPSRotatePoint(Angle, RenderIn, Point(R.Right, R.Top)), TPSRotatePoint(Angle, RenderIn, Point(R.Right, R.Bottom)), BevelShadow, BevelHighlight ) else begin TPSMoveTo(RenderCanvas, Angle, RenderIn, R.Right, R.Top); TPSLineTo(RenderCanvas, Angle, RenderIn, R.Right, R.Bottom); end; end; // Paint day name str := FormatDateTime(FGanttView.DayFormat, dayRec.Date); strLen := RenderCanvas.TextWidth(str); P := Point((R.Left + R.Right - strLen) div 2, (R.Top + R.Bottom - strH) div 2); TPSTextOut(RenderCanvas, Angle, RenderIn, P.X, P.Y, str); end; end; procedure TVpGanttViewPainter.DrawEvents; var i: Integer; eventRec: TVpGanttEventRec; event: TVpEvent; cat: TVpCategoryInfo; R: TRect; dx, dy: Integer; begin dx := FGanttView.LeftCol * FGanttView.ColWidth; dy := FGanttView.TopRow * FGanttView.RowHeight; RenderCanvas.Font.Assign(FEventFont); for i := 0 to FGanttView.NumEvents-1 do begin eventRec := FGanttView.EventRecords[i]; event := eventRec.Event; R := eventRec.EventRect; OffsetRect(R, -dx, -dy); inc(R.Top, 2); dec(R.Bottom, 1); // 1 less than top due to grid linewidth. if R.Top < FGanttView.TotalColHeaderHeight then Continue; if R.Left < FGanttView.FixedColWidth then Continue; cat := FGanttView.DataStore.CategoryColorMap.GetCategory(event.Category); RenderCanvas.Pen.Color := cat.Color; RenderCanvas.Brush.Color := cat.BackgroundColor; TPSRectangle(RenderCanvas, Angle, RenderIn, R); end; end; procedure TVpGanttViewPainter.DrawGrid; var x1, x2, y0, y1, y2: Integer; dx, dy: Integer; i, n, numEvents: Integer; eventRec: TVpGanttEventRec; dayRec: TVpGanttDayRec; monthRec: TVpGanttMonthRec; begin RenderCanvas.Pen.Color := RealLineColor; // Horizontal lines x1 := RealLeft + FGanttView.FixedColWidth; dx := FGanttView.LeftCol * FGanttView.ColWidth; n := FGanttView.NumMonths; if n > 0 then begin monthRec := FGanttView.MonthRecords[n-1]; x2 := monthRec.Rect.Right - dx; end else x2 := RealRight; y0 := FGanttView.TotalColHeaderHeight; if FGanttView.DrawingStyle = ds3D then dec(y0); RenderCanvas.Line(x1, y0, x2, y0); numEvents := FGanttView.NumEvents; y0 := 0; for i := 0 to numEvents - 1 do begin eventRec := FGanttView.EventRecords[i]; y1 := y0 + eventRec.EventRect.Bottom; RenderCanvas.Line(x1, y1, x2, y1); end; // Vertical lines y1 := RealTop + FGanttView.TotalColHeaderHeight; dy := FGanttView.TopRow * FGanttView.RowHeight; if numEvents > 0 then begin eventRec := FGanttView.EventRecords[numEvents-1]; y2 := eventRec.EventRect.Bottom - dy; end else y2 := RealBottom; n := FGanttView.NumDays; for i := 0 to n-1 do begin dayRec := FGanttView.DayRecords[i]; x1 := dayRec.Rect.Right - dx; x2 := x1; if x1 >= FGanttView.FixedColWidth then RenderCanvas.Line(x1, y1, x2, y2); end; end; procedure TVpGanttViewPainter.DrawRowHeader; var R: TRect; P: TPoint; strH: Integer; str: String; i: Integer; dy: Integer; eventRec: TVpGanttEventRec; begin RenderCanvas.Brush.Color := RealRowHeadAttrColor; if FGanttView.DrawingStyle = ds3d then begin R.Left := RealLeft + 1; R.Top := RealTop; R.Right := RealLeft + FGanttView.FixedColWidth - 1; R.Bottom := RealBottom - 1; TPSFillRect(RenderCanvas, Angle, RenderIn, R); DrawBevelRect( RenderCanvas, TPSRotateRectangle(Angle, RenderIn, R), BevelHighlight, BevelShadow ); end else begin R := Rect(RealLeft, RealTop + 1, RealLeft + FGanttView.FixedColWidth, RealBottom); TPSFillRect(RenderCanvas, Angle, RenderIn, R); RenderCanvas.Pen.Color := RealLineColor; RenderCanvas.Line(R.Right, R.Top, R.Right, R.Bottom); end; RenderCanvas.Font.Assign(FEventFont); strH := RenderCanvas.TextHeight('Tg'); RenderCanvas.Pen.Color := RealLineColor; // Offset due to scrolling dy := FGanttView.TopRow * FGanttView.RowHeight; for i := 0 to FGanttView.NumEvents-1 do begin eventRec := FGanttView.EventRecords[i]; str := eventRec.Caption; R := eventRec.HeadRect; OffsetRect(R, 0, -dy); if R.Top < FGanttView.TotalColHeaderHeight then Continue; if FGanttView.DrawingStyle = ds3D then begin R.BottomRight := R.BottomRight - Point(1, 1); DrawBevelRect( RenderCanvas, TPSRotateRectangle(Angle, RenderIn, R), BevelHighlight, BevelShadow ); end else RenderCanvas.Line(R.Left, R.Bottom, R.Right, R.Bottom); // Paint event description as header P := Point(R.Left + FGanttView.TextMargin, (R.Top + R.Bottom - strH) div 2); TPSTextOut(RenderCanvas, Angle, RenderIn, P.X, P.Y, Str); end; end; procedure TVpGanttViewPainter.FixFontHeights; begin with FGanttView do begin ColHeaderAttributes.DayFont.Height := GetRealFontHeight(ColHeaderAttributes.DayFont); ColHeaderAttributes.MonthFont.Height := GetRealFontHeight(ColHeaderAttributes.MonthFont); RowHeaderAttributes.EventFont.Height := GetRealFontHeight(RowHeaderAttributes.EventFont); end; end; procedure TVpGanttViewPainter.InitColors; begin if DisplayOnly then begin BevelShadow := clBlack; BevelDarkShadow := clBlack; BevelFace := clBlack; RealColHeadAttrColor := clSilver; RealRowHeadAttrColor := clSilver; RealColor := clWhite; RealLineColor := clSilver; end else begin BevelHighlight := clBtnHighlight; BevelShadow := clBtnShadow; BevelDarkShadow := cl3DDkShadow; BevelFace := clBtnFace; RealColHeadAttrColor := ColorToRGB(FGanttView.ColHeaderAttributes.Color); RealRowHeadAttrColor := ColorToRGB(FGanttView.RowHeaderAttributes.Color); RealColor := ColorToRGB(FGanttView.Color); RealLineColor := ColorToRGB(FGanttView.LineColor); end; FDayFont := FGanttView.ColHeaderAttributes.DayFont; FMonthFont := FGanttView.ColHeaderAttributes.MonthFont; FEventFont := FGanttView.RowHeaderAttributes.EventFont; end; procedure TVpGanttViewPainter.RenderToCanvas(ARenderIn: TRect; AAngle: TVpRotationAngle; AScale: Extended; ARenderDate: TDateTime; AStartLine, AStopLine: Integer; AUseGran: TVpGranularity; ADisplayOnly: Boolean); begin inherited; InitColors; SavePenBrush; InitPenBrush; if ADisplayOnly then FixFontHeights; Rgn := CreateRectRgn(RenderIn.Left, RenderIn.Top, RenderIn.Right, RenderIn.Bottom); try SelectClipRgn(RenderCanvas.Handle, Rgn); { Clear client area } Clear; { Measure the row heights } SetMeasurements; { Draw headers } DrawRowHeader; DrawColHeader; { Draw grid } DrawGrid; { draw events } DrawEvents; { Draw the borders } DrawBorders; finally SelectClipRgn(RenderCanvas.Handle, 0); DeleteObject(Rgn); end; { Restore canvas settings} RestorePenBrush; //RenderCanvas.Textout(0, 0, FormatDateTime('c', ARenderDate)); //RenderCanvas.TextOut(0, 20, FormatDateTime('c', FGanttView.Date)); end; procedure TVpGanttViewPainter.SetMeasurements; var firstEvent: TVpEvent; firstDay, lastDay: TDateTime; firstMonth, lastMonth: TDateTime; eventCount, numDays, numMonths: Integer; x1, x2, y1, y2: Integer; i: Integer; dt, t1, t2: TDateTime; totalWidth: double; event: TVpEvent; begin inherited; FGanttView.Init; (* // Determine range of dates as well as the rectangles containing the day, // column and event headers and the event data. if (FGanttView.Datastore = nil) or (FGanttView.Datastore.Resource = nil) or (FGanttView.Datastore.Resource.Schedule.EventCount = 0) then begin eventCount := 0; FGanttView.StartDate := NO_DATE; FGanttView.EndDate := NO_DATE; SetLength(TVpGanttViewOpener(FGanttView).FEventRecords, 0); SetLength(TVpGanttViewOpener(FGanttView).FDayRecords, 0); SetLength(TVpGanttViewOpener(FGanttView).FMonthRecords, 0); FGanttView.VisibleRows := 0; FGanttView.VisibleCols := 0; end else begin eventCount := FGanttView.Datastore.Resource.Schedule.EventCount; firstEvent := FGanttView.DataStore.Resource.Schedule.GetEvent(0); // Find date range needed for the GanttView firstDay := trunc(firstEvent.StartTime); lastDay := trunc(firstEvent.EndTime); if frac(lastDay) = 0.0 then lastDay := lastDay + 1; for i := 1 to FGanttView.Datastore.Resource.Schedule.EventCount-1 do begin event := FGanttView.Datastore.Resource.Schedule.GetEvent(i); if event.AllDayEvent then begin t1 := trunc(event.StartTime); t2 := trunc(event.EndTime); end else begin t1 := event.StartTime; t2 := event.EndTime; end; if t1 < firstDay then firstDay := trunc(t1); if t2 > lastDay then lastDay := trunc(t2); end; lastDay := lastDay + 1; FGanttView.StartDate := firstDay; FGanttView.EndDate := lastDay; // Prepare the event, day and month records for painting the cells numdays := DaysBetween(FGanttView.StartDate, FGanttView.EndDate); totalWidth := numdays * FGanttView.ColWidth; // Populate event records SetLength(TVpGanttViewOpener(FGanttView).FEventRecords, eventCount); y1 := 0; // this dimension is scrollable for i := 0 to eventCount-1 do begin event := FGanttView.DataStore.Resource.Schedule.GetEvent(i); if event.AllDayEvent then begin t1 := trunc(event.StartTime); t2 := trunc(event.EndTime); if frac(t2) = 0 then t2 := t2 + 1; end else begin t1 := event.StartTime; t2 := event.EndTime; end; x1 := round((t1 - FGanttView.StartDate) / numDays * totalWidth); x2 := round((t2 - FGanttView.StartDate) / numDays * totalWidth); y2 := y1 + FGanttView.RowHeight; with TVpGanttViewOpener(FGanttView) do begin FEventRecords[i].Event := event; FEventRecords[i].Caption := event.Description; FEventRecords[i].HeadRect := Rect(RealLeft, y1, RealLeft + FixedColWidth, y2); FEventRecords[i].EventRect := Rect(x1, y1, x2, y2); end; y1 := y2; end; // Populate day records SetLength(TVpGanttViewOpener(FGanttView).FDayRecords, numDays); x1 := 0; // Scrollable dimension y1 := RealTop + FGanttView.MonthColHeaderHeight; y2 := RealTop + FGanttView.TotalColHeaderHeight; dt := trunc(FGanttView.StartDate); for i := 0 to numDays-1 do begin x2 := x1 + FGanttView.ColWidth; with TVpGanttViewOpener(FGanttView) do begin FDayRecords[i].Date := dt; FDayRecords[i].Rect := Rect(x1, y1, x2, y2); end; dt := IncDay(dt, 1); x1 := x2; end; // Populate month records firstMonth := FGanttView.StartDate; lastMonth := FGanttView.EndDate; numMonths := CountMonths(firstMonth, lastMonth); SetLength(TVpGanttViewOpener(FGanttView).FMonthRecords, numMonths); dt := firstMonth; x1 := 0; // Scrollable dimension; y1 := RealTop; y2 := RealTop + FGanttView.TotalColHeaderHeight; for i := 0 to numMonths - 1do begin numDays := DaysInMonth(dt); if i = 0 then // partial first month numDays := numDays - DayOf(dt) + 1 else if i = numMonths-1 then numDays := DayOf(lastMonth) - 1; x2 := x1 + numDays * FGanttView.ColWidth; with TVpGanttViewOpener(FGanttView) do begin FMonthRecords[i].Date := dt; FMonthRecords[i].Rect := Rect(x1, y1, x2, y2); end; dt := IncMonth(dt, 1); x1 := x2; end; *) FGanttView.VisibleCols := (RealRight - RealLeft - FGanttView.FixedColWidth) div FGanttView.ColWidth; FGanttView.VisibleRows := (RealBottom - RealTop - FGanttView.TotalColHeaderHeight) div FGanttView.RowHeight; end; end.