diff --git a/components/tvplanit/source/vpganttview.pas b/components/tvplanit/source/vpganttview.pas index 011325fed..3acbc4f30 100644 --- a/components/tvplanit/source/vpganttview.pas +++ b/components/tvplanit/source/vpganttview.pas @@ -11,6 +11,23 @@ uses type TVpGanttView = class; + TVpGanttEventRec = record + Event: TVpEvent; + Caption: String; + HeadRect: TRect; + EventRect: TRect; + end; + + TVpGanttDayRec = record + Date: TDateTime; + Rect: TRect; + end; + + TVpGanttMonthRec = record + Date: TDateTime; + Rect: TRect; + end; + TVpGanttHeaderAttributes = class(TPersistent) private FGanttView: TVpGanttView; @@ -72,15 +89,25 @@ type FRowHeaderAttributes: TVpGanttRowHeaderAttributes; FDrawingStyle: TVpDrawingStyle; + FDateFormat: array[0..2] of String; + function GetDateFormat(AIndex: Integer): String; + function IsStoredColWidth: Boolean; + function IsStoredDateFormat(AIndex: Integer): Boolean; procedure SetColor(Value: TColor); reintroduce; procedure SetColWidth(AValue: Integer); procedure SetDate(AValue: TDateTime); + procedure SetDateFormat(AIndex: Integer; AValue: String); procedure SetDrawingStyle(AValue: TVpDrawingStyle); procedure SetFixedColWidth(AValue: Integer); procedure SetLineColor(Value: TColor); protected + // Needed by the painter + FEventRecords: array of TVpGanttEventRec; + FDayRecords: array of TVpGanttDayRec; + FMonthRecords: array of TVpGanttMonthRec; + { internal methods } procedure Hookup; procedure Populate; @@ -89,6 +116,7 @@ type class function GetControlClassDefaultSize: TSize; override; procedure Loaded; override; procedure Paint; override; + procedure Resize; override; public constructor Create(AOwner: TComponent); override; @@ -101,14 +129,23 @@ type DisplayOnly: Boolean); override; property Date: TDateTime read FDate write SetDate; + property StartDate: TDateTime read FStartDate write FStartDate; + property EndDate: TDateTime read FEndDate write FEndDate; published + property Align; + property Anchors; + property BorderSpacing; + property ColHeaderAttributes: TVpGanttColHeaderAttributes read FColHeaderAttributes write FColHeaderAttributes; property Color: TColor read FColor write SetColor default DEFAULT_COLOR; - property ColWidth: Integer read FColWidth write SetColWidth default 32; + property ColWidth: Integer read FColWidth write SetColWidth stored IsStoredColWidth; + property DayFormat: String index 0 read GetDateFormat write SetDateFormat stored IsStoredDateFormat; property DrawingStyle: TVpDrawingStyle read FDrawingStyle write SetDrawingStyle default ds3d; property FixedColWidth: Integer read FFixedColWidth write SetFixedColWidth default 120; property LineColor: TColor read FLineColor write SetLineColor default DEFAULT_LINECOLOR; + property MonthFormat: String index 1 read GetDateFormat write SetDateFormat stored IsStoredDateFormat; + property MonthFormat_short: String index 2 read GetDateFormat write SetDateFormat stored IsStoredDateFormat; property RowHeaderAttributes: TVpGanttRowHeaderAttributes read FRowHeaderAttributes write FRowHeaderAttributes; end; @@ -118,6 +155,12 @@ implementation uses VpGanttViewPainter; +const + DEFAULT_DAYFORMAT = 'd'; + DEFAULT_MONTHFORMAT = 'mmmm yyyy'; + DEFAULT_MONTHFORMAT_SHORT = 'mmm yyyy'; + DEFAULT_COLWIDTH = 20; + {******************************************************************************} { TVpGanttHeaderAttributes } {******************************************************************************} @@ -227,7 +270,7 @@ begin SetDate(Now); FStartDate := FDate; - FColWidth := 32; + FColWidth := DEFAULT_COLWIDTH; FFixedColWidth := 120; FColor := DEFAULT_COLOR; @@ -237,6 +280,9 @@ begin FColHeaderAttributes := TVpGanttColHeaderAttributes.Create(self); FDrawingStyle := ds3d; + FDateFormat[0] := DEFAULT_DAYFORMAT; + FDateFormat[1] := DEFAULT_MONTHFORMAT; + FDateFormat[2] := DEFAULT_MONTHFORMAT_SHORT; with GetControlClassDefaultSize do SetInitialBounds(0, 0, CX, CY); @@ -255,6 +301,11 @@ begin Result.CY := 200; end; +function TVpGanttView.GetDateFormat(AIndex: Integer): String; +begin + Result := FDateFormat[AIndex]; +end; + { If the component is being dropped on a form at designtime, then automatically hook up to the first datastore component found. } procedure TVpGanttView.HookUp; @@ -270,6 +321,20 @@ begin end; end; +function TVpGanttView.IsStoredColWidth: Boolean; +begin + Result := FColWidth <> DEFAULT_COLWIDTH; +end; + +function TVpGanttView.IsStoredDateFormat(AIndex: Integer): Boolean; +begin + case AIndex of + 0: Result := FDateFormat[0] <> DEFAULT_DAYFORMAT; + 1: Result := FDateFormat[1] <> DEFAULT_MONTHFORMAT; + 2: Result := FDateFormat[2] <> DEFAULT_MONTHFORMAT_SHORT; + end; +end; + procedure TVpGanttView.LinkHandler(Sender: TComponent; NotificationType: TVpNotificationType; const Value: Variant); begin @@ -330,6 +395,12 @@ begin end; end; +procedure TVpGanttView.Resize; +begin + inherited; + Invalidate; +end; + procedure TVpGanttView.SetColor(Value: TColor); begin if FColor <> Value then begin @@ -369,9 +440,19 @@ begin end; end; +procedure TVpGanttView.SetDateFormat(AIndex: Integer; AValue: String); +begin + if FDateFormat[AIndex] <> AValue then + begin + FDateFormat[AIndex] := AValue; + Invalidate; + end; +end; + procedure TVpGanttView.SetDrawingStyle(AValue: TVpDrawingStyle); begin - if FDrawingStyle <> AValue then begin + if FDrawingStyle <> AValue then + begin FDrawingStyle := AValue; Invalidate; end; diff --git a/components/tvplanit/source/vpganttviewpainter.pas b/components/tvplanit/source/vpganttviewpainter.pas index 0a2afc8c9..ffe8bfdd5 100644 --- a/components/tvplanit/source/vpganttviewpainter.pas +++ b/components/tvplanit/source/vpganttviewpainter.pas @@ -22,13 +22,19 @@ type RealLineColor: TColor; RealRowHeadAttrColor: TColor; - FColHeadRowHeight: Integer; + FColHeadHeightTotal: Integer; + FColHeadRowHeightMonth: Integer; + FColHeadRowHeightDay: Integer; FRowHeight: Integer; + FTextMargin: Integer; + + function CountMonths(ADate1, ADate2: TDateTime): Integer; protected procedure Clear; procedure DrawBorders; procedure DrawColHeader; + procedure DrawEvents; procedure DrawGrid; procedure DrawRowHeader; procedure FixFontHeights; @@ -47,14 +53,18 @@ type implementation uses - Grids, - VpMisc, VpCanvasUtils; + DateUtils, + VpConst, VpMisc, VpCanvasUtils, VpData; + +type + TVpGanttViewOpener = class(TVpGanttView); constructor TVpGanttViewPainter.Create(AGanttView: TVpGanttView; ARenderCanvas: TCanvas); begin inherited Create(ARenderCanvas); FGanttView := AGanttView; + FTextMargin := 2; end; procedure TVpGanttViewPainter.Clear; @@ -63,6 +73,22 @@ begin RenderCanvas.FillRect(RenderIn); end; +function TVpGanttViewPainter.CountMonths(ADate1, ADate2: TDateTime): Integer; +var + dt: TDateTime; +begin + if ADate1 > ADate2 then + raise Exception.Create('[TVpGanttViewPainter.CountMonts] Dates not in order.'); + + Result := 0; + dt := ADate1; + while dt <= ADate2 do + begin + inc(Result); + dt := StartOfTheMonth(IncMonth(dt)); + end; +end; + procedure TVpGanttViewPainter.DrawBorders; var R: TRect; @@ -70,6 +96,8 @@ begin R := Rect(RealLeft, RealTop, RealRight - 1, RealBottom - 1); case FGanttView.DrawingStyle of + dsNoBorder: + ; // no border dsFlat: // Draw a simple rectangular border DrawBevelRect( RenderCanvas, @@ -85,101 +113,260 @@ begin BevelShadow, BevelHighlight ); + (* InflateRect(R, -1, -1); DrawBevelRect( RenderCanvas, TPSRotateRectangle(Angle, RenderIn, R), BevelDarkShadow, - BevelFace + clRed //BevelFace ); + *) end; end; end; procedure TVpGanttViewPainter.DrawColHeader; var - headRect: TRect; + i: Integer; + R, R1: TRect; + P: TPoint; + monthRec: TVpGanttMonthRec; + dayRec: TVpGanttDayRec; + str: String; + strLen, strH: Integer; begin RenderCanvas.Brush.Color := RealColHeadAttrColor; + RenderCanvas.Pen.Color := RealLineColor; - if FGanttView.DrawingStyle = ds3d then begin - // Draw a 3d bevel - headRect.Left := RealLeft + 2; - headRect.Top := RealTop + 2; - headRect.Right := RealLeft + FGanttView.FixedColWidth; // RealRight - 3; - headRect.Bottom := RealTop + FColHeadRowHeight; - TPSFillRect(RenderCanvas, Angle, RenderIn, headRect); + R := Rect(RealLeft, RealTop, RealRight, FColHeadHeightTotal); + 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, headRect), + TPSRotateRectangle(Angle, RenderIn, R1), BevelHighlight, - BevelDarkShadow + BevelShadow ); - headRect.Left := headRect.Right + 1; - headRect.Right := RealRight - 3; - TPSFillRect(RenderCanvas, Angle, RenderIn, headRect); + R1.Left := FGanttView.FixedColWidth; + R1.Right := RealRight-2; DrawBevelRect( RenderCanvas, - TPSRotateRectangle(Angle, RenderIn, headRect), + TPSRotateRectangle(Angle, RenderIn, R1), BevelHighlight, - BevelDarkShadow + BevelShadow ); - end else begin - // Draw simple border rectangle - headRect := Rect(RealLeft, RealTop, RealRight, RealTop + FColHeadRowHeight-1); - TPSFillRect(RenderCanvas, Angle, RenderIn, HeadRect); - RenderCanvas.Pen.Color := RealLineColor; - RenderCanvas.Line(headRect.Left, headRect.Bottom, headRect.Right, headRect.Bottom); - headRect.Left := headRect.Left + FGanttView.FixedColWidth; - RenderCanvas.Line(headRect.Left, headRect.Top, headRect.Left, headRect.Bottom); + 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; + + // Draw month rectangles and month captions + for i := 0 to High(TVpGanttViewOpener(FGanttView).FMonthRecords) do + begin + monthRec := TVpGanttViewOpener(FGanttView).FMonthRecords[i]; + R := monthRec.Rect; + OffsetRect(R, FGanttView.FixedColWidth, 0); + 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; + + str := FormatDateTime(FGanttView.MonthFormat, monthRec.Date); + strLen := RenderCanvas.TextWidth(str); + if strLen > R.Width - 2 * FTextMargin then + begin + str := FormatDateTime(FGanttView.MonthFormat_short, monthRec.Date); + strLen := RenderCanvas.TextWidth(str); + end; + if strLen > R.Width - 2 * FTextMargin then + str := ''; + if str <> '' then + begin + P := Point((R.Left + R.Right - strLen) div 2, R.Top + FTextMargin); + TPSTextOut(RenderCanvas, Angle, RenderIn, P.X, P.Y, str); + end; + end; + + // Draw day dividing lines and day captions. Always at right side. + RenderCanvas.Font.Assign(FGanttView.ColHeaderAttributes.DayFont); + strH := RenderCanvas.TextHeight('Tg'); + for dayRec in TVpGanttViewOpener(FGanttView).FDayRecords do + begin + R := dayRec.Rect; + OffsetRect(R, FGanttView.FixedColWidth, 0); + 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; + 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; +begin + for i := 0 to High(TVpGanttViewOpener(FGanttView).FEventRecords) do + begin + eventRec := TVpGanttViewOpener(FGanttView).FEventRecords[i]; + event := eventRec.Event; + cat := FGanttView.DataStore.CategoryColorMap.GetCategory(event.Category); + RenderCanvas.Pen.Color := cat.Color; + RenderCanvas.Brush.Color := cat.BackgroundColor; + R := eventRec.EventRect; + if R.Left = R.Right then R.Right := R.Left + 1; + OffsetRect(R, FGanttView.FixedColWidth, FColHeadHeightTotal); + InflateRect(R, 0, -2); + TPSRectangle(RenderCanvas, Angle, RenderIn, R); end; end; procedure TVpGanttViewPainter.DrawGrid; var - x1, x2, y1, y2: Integer; + x1, x2, y0, y1, y2: Integer; + i: Integer; + eventRec: TVpGanttEventRec; + dayRec: TVpGanttDayRec; + monthRec: TVpGanttMonthRec; + numDays, numMonths, numEvents: Integer; begin - exit; RenderCanvas.Pen.Color := RealLineColor; - x1 := RenderIn.Left; - x2 := RenderIn.Right; - y1 := RenderIn.Top + FColHeadRowHeight; - y2 := y1; - RenderCanvas.Line(x1, y1, x2, y2); + numDays := Length(TVpGanttViewOpener(FGanttView).FDayRecords); + numMonths := Length(TVpGanttViewOpener(FGanttView).FMonthRecords); + numEvents := Length(TVpGanttViewOpener(FGanttView).FEventRecords); - x1 := RenderIn.Left + FGanttView.FixedColWidth; - x2 := x1; - y1 := RenderIn.Top; - y2 := RenderIn.Bottom; - RenderCanvas.Line(x1, y1, x2, y2); + // Horizontal lines + x1 := RealLeft + FGanttView.FixedColWidth; + if numMonths > 0 then + begin + monthRec := TVpGanttViewOpener(FGanttView).FMonthRecords[numMonths-1]; + x2 := monthRec.Rect.Right + FGanttView.FixedColWidth; + end else + x2 := RealRight; + + y0 := FColHeadHeightTotal; + if FGanttView.DrawingStyle = ds3D then dec(y0); + + RenderCanvas.Line(x1, y0, x2, y0); + + for i := 0 to numEvents-1 do + begin + eventRec := TVpGanttViewOpener(FGanttView).FEventRecords[i]; + y1 := y0 + eventRec.EventRect.Bottom; + RenderCanvas.Line(x1, y1, x2, y1); + end; + + // Vertical lines + y1 := RealTop + FColHeadHeightTotal; + if numEvents > 0 then + begin + eventRec := TVpGanttViewOpener(FGanttView).FEventRecords[numEvents-1]; + y2 := eventRec.EventRect.Bottom + FColHeadHeightTotal; + end else + y2 := RealBottom; + for i := 0 to numDays-1 do + begin + dayRec := TVpGanttViewOpener(FGanttView).FDayRecords[i]; + x1 := dayRec.Rect.Right + FGanttView.FixedColWidth; + x2 := x1; + RenderCanvas.Line(x1, y1, x2, y2); + end; end; procedure TVpGanttViewPainter.DrawRowHeader; var - headRect: TRect; + R: TRect; + P: TPoint; + strH: Integer; + str: String; + i: Integer; begin RenderCanvas.Brush.Color := RealRowHeadAttrColor; if FGanttView.DrawingStyle = ds3d then begin - // Draw a 3d bevel - headRect.Left := RealLeft + 2; - headRect.Top := RealTop + FColHeadRowHeight + 1; - headRect.Right := RealLeft + FGanttView.FixedColWidth; - headRect.Bottom := RealBottom - 3; - TPSFillRect(RenderCanvas, Angle, RenderIn, headRect); + R.Left := RealLeft + 1; + R.Top := RealTop + FColHeadHeightTotal; + R.Right := RealLeft + FGanttView.FixedColWidth-1; + R.Bottom := RealBottom - 1; + TPSFillRect(RenderCanvas, Angle, RenderIn, R); DrawBevelRect( RenderCanvas, - TPSRotateRectangle(Angle, RenderIn, headRect), + TPSRotateRectangle(Angle, RenderIn, R), BevelHighlight, - BevelDarkShadow + BevelShadow ); end else begin - // Draw simple border rectangle - headRect := Rect(RealLeft, RealTop + FColHeadRowHeight, RealLeft + FGanttView.FixedColWidth, RealBottom); - TPSFillRect(RenderCanvas, Angle, RenderIn, HeadRect); + R := Rect(RealLeft, RealTop + FColHeadHeightTotal + 1, RealLeft + FGanttView.FixedColWidth, RealBottom); + TPSFillRect(RenderCanvas, Angle, RenderIn, R); RenderCanvas.Pen.Color := RealLineColor; - RenderCanvas.Line(headRect.Right, headRect.Top, headrect.Right, headRect.Bottom); + RenderCanvas.Line(R.Right, R.Top, R.Right, R.Bottom); + end; + + RenderCanvas.Font.Assign(FGanttView.RowHeaderAttributes.EventFont); + strH := RenderCanvas.TextHeight('Tg'); + RenderCanvas.Pen.Color := RealLineColor; + for i := 0 to High(TVpGanttViewOpener(FGanttView).FEventRecords) do + begin + str := TVpGanttViewOpener(FGanttView).FEventRecords[i].Caption; + R := TVpGanttViewOpener(FGanttView).FEventRecords[i].HeadRect; + OffsetRect(R, 0, FColHeadHeightTotal); + 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 + FTextMargin, (R.Top + R.Bottom - strH) div 2); + TPSTextOut(RenderCanvas, Angle, RenderIn, P.X, P.Y, Str); end; end; @@ -245,8 +432,8 @@ begin { Draw grid } DrawGrid; - { draw days } - //DrawDays; + { draw events } + DrawEvents; { Draw the borders } DrawBorders; @@ -264,17 +451,153 @@ begin 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; + // Height of the event rows RenderCanvas.Font.Assign(FGanttView.RowHeaderAttributes.EventFont); - FRowHeight := RenderCanvas.TextHeight('Tg') + 2 * varCellPadding; + FRowHeight := RenderCanvas.TextHeight('Tg') + 2 * FTextMargin; + // Height of the month part in the column header RenderCanvas.Font.Assign(FGanttView.ColHeaderAttributes.MonthFont); - FColHeadRowHeight := RenderCanvas.TextHeight('Tg') + 2 * varCellPadding; + FColHeadRowHeightMonth := RenderCanvas.TextHeight('Tg') + FTextMargin; + // Height of the day part in the column header RenderCanvas.Font.Assign(FGanttView.ColHeaderAttributes.DayFont); - FColHeadRowHeight := FColHeadRowHeight + RenderCanvas.TextHeight('Tg') + varCellPadding; + FColHeadRowHeightDay := RenderCanvas.TextHeight('Tg') + 2 * FTextMargin; + + // total height of header: month row + day row + FColHeadHeightTotal := FColHeadRowHeightMonth + FColHeadRowHeightDay; + + // 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); + 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 + FRowHeight; + 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 + FColHeadRowHeightMonth; + y2 := RealTop + FColHeadHeightTotal; + 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 + FColHeadHeightTotal; + 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; + end; end; end. diff --git a/components/tvplanit/source/vpmisc.pas b/components/tvplanit/source/vpmisc.pas index 8b7e333dc..7dc6e518a 100644 --- a/components/tvplanit/source/vpmisc.pas +++ b/components/tvplanit/source/vpmisc.pas @@ -40,7 +40,7 @@ uses Windows, Consts, Messages, {$ENDIF} SysUtils, Buttons, Classes, Controls, StdCtrls, ExtCtrls, Forms, Graphics, Menus, - VpBase, VpData, VpConst; + VpBase, VpData, VpConst, VpCanvasUtils; type TDayList = array[1..12] of Word; @@ -115,9 +115,13 @@ function GetDisplayString(Canvas : TCanvas; const S : string; function GetDateDisplayString(ACanvas: TCanvas; ADate: TDateTime; AFormat, AHoliday: String; AWidth: Integer): String; +{ Draws a bevel in the specified TRect, using the specified colors } procedure DrawBevelRect(const Canvas: TCanvas; R: TRect; Shadow, Highlight: TColor); - { Draws a bevel in the specified TRect, using the specified colors } + +{ Draws a bevelled vertical line using the specified colors } +procedure DrawBevelLine(const Canvas: TCanvas; P1, P2: TPoint; + Shadow, Highlight: TColor); procedure AlignOKCancel(OKButton, CancelButton: TButton; APanel: TPanel); { Aligns the OK and Cancel buttons to the right of the panel. In Windows the @@ -471,7 +475,27 @@ begin Point(R.Left, R.Bottom)]); end; end; -{=====} + + +procedure DrawBevelLine(const Canvas: TCanvas; P1, P2: TPoint; + Shadow, Highlight: TColor); +begin + with Canvas do + begin + Pen.Color := Shadow; + Line(P1.X, P1.Y, P2.X, P2.Y); + Pen.Color := Highlight; + if P1.X = P2.X then + // vertical line + Line(P1.X+1, P1.Y, P2.X+1, P2.Y) + else if (P1.Y = P2.Y) then + // horizontal line + Line(P1.X, P1.Y+1, P2.X, P2.Y+1) + else + Line(P1.X+1, P1.Y+1, P2.X+1, P2.Y+1) + end; +end; + procedure AlignOKCancel(OKButton, CancelButton: TButton; APanel: TPanel); var