From 31a3ed6a147c3d1c3449696dcff94f81771ee1b3 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Sun, 28 Aug 2022 18:17:04 +0000 Subject: [PATCH] tvplanit: refactor handling of day/month/event rectangles in TVpGanttView. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8421 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- components/tvplanit/source/vpganttview.pas | 286 ++++++++++++++++-- .../tvplanit/source/vpganttviewpainter.pas | 204 ++++++------- components/tvplanit/source/vpmisc.pas | 22 ++ 3 files changed, 386 insertions(+), 126 deletions(-) diff --git a/components/tvplanit/source/vpganttview.pas b/components/tvplanit/source/vpganttview.pas index d6ddfb1ad..029e5b76b 100644 --- a/components/tvplanit/source/vpganttview.pas +++ b/components/tvplanit/source/vpganttview.pas @@ -5,8 +5,9 @@ unit VpGanttView; interface uses - LCLType, LCLIntf, LMessages, Classes, SysUtils, Graphics, Types, StdCtrls, - VpConst, VpBase, VpBaseDS, VpData; + LCLType, LCLIntf, LMessages, + Classes, SysUtils, Graphics, Types, Controls, StdCtrls, + VpConst, VpMisc, VpBase, VpBaseDS, VpData; type TVpGanttView = class; @@ -73,7 +74,6 @@ type FDate: TDateTime; // Selected date FStartDate: TDateTime; // Date of the first event FEndDate: TDateTime; // Date of the last event - FLeftDate: TDateTime; // Date of the left-most event (after scrolling > FStartDate) FLeftCol: Integer; // Index of the left-most day column FTopRow: Integer; // Index of the top-most event row @@ -89,6 +89,11 @@ type FColWidth: Integer; FFixedColWidth: Integer; + FRowHeight: Integer; + FMonthColHeaderHeight: Integer; + FDayColHeaderHeight: Integer; + FTotalColHeaderHeight: Integer; + FTextMargin: Integer; FColor: TColor; FLineColor: TColor; @@ -100,6 +105,12 @@ type FDateFormat: array[0..2] of String; function GetDateFormat(AIndex: Integer): String; + function GetDayRec(AIndex: Integer): TVpGanttDayRec; + function GetEventRec(AIndex: Integer): TVpGanttEventRec; + function GetMonthRec(AIndex: Integer): TVpGanttMonthRec; + function GetNumDays: Integer; + function GetNumEvents: Integer; + function GetNumMonths: Integer; function IsStoredColWidth: Boolean; function IsStoredDateFormat(AIndex: Integer): Boolean; procedure SetColor(Value: TColor); reintroduce; @@ -110,6 +121,7 @@ type procedure SetFixedColWidth(AValue: Integer); procedure SetLeftCol(AValue: Integer); procedure SetLineColor(AValue: TColor); + procedure SetTextMargin(AValue: Integer); procedure SetTopRow(AValue: Integer); protected @@ -119,8 +131,14 @@ type FMonthRecords: array of TVpGanttMonthRec; { internal methods } + procedure CalcColHeaderHeight; + procedure CalcRowHeight; + procedure GetEventDateRange; procedure Hookup; procedure Populate; + procedure PopulateDayRecords; + procedure PopulateEventRecords; + procedure PopulateMonthRecords; procedure ScrollHorizontal(ANumCols: Integer); procedure ScrollVertical(ANumRows: Integer); procedure SetHScrollPos; @@ -141,6 +159,7 @@ type public constructor Create(AOwner: TComponent); override; destructor Destroy; override; + procedure Init; procedure LinkHandler(Sender: TComponent; NotificationType: TVpNotificationType; const Value: Variant); override; procedure RenderToCanvas(RenderCanvas: TCanvas; RenderIn: TRect; @@ -158,6 +177,18 @@ type property LeftCol: Integer read FLeftCol write SetLeftCol; property TopRow: Integer read FTopRow write SetTopRow; + property RowHeight: Integer read FRowHeight; + property DayColHeaderHeight: Integer read FDayColHeaderHeight; + property MonthColHeaderHeight: Integer read FMonthColHeaderHeight; + property TotalColHeaderHeight: Integer read FTotalColHeaderHeight; + + property DayRecords[AIndex: Integer]: TVpGanttDayRec read GetDayRec; + property EventRecords[AIndex: Integer]: TVpGanttEventRec read GetEventRec; + property MonthRecords[AIndex: Integer]: TVpGanttMonthRec read GetMonthRec; + + property NumDays: Integer read GetNumDays; + property NumEvents: Integer read GetNumEvents; + property NumMonths: Integer read GetNumMonths; published property Align; property Anchors; @@ -173,12 +204,14 @@ type 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; + property TextMargin: Integer read FTextMargin write SetTextMargin default 2; end; implementation uses + DateUtils, VpGanttViewPainter; const @@ -288,6 +321,7 @@ end; constructor TVpGanttView.Create(AOwner: TComponent); begin inherited; + ControlStyle := [csCaptureMouse, csOpaque, csDoubleClicks]; FInLinkHandler := false; FLoaded := false; @@ -298,6 +332,7 @@ begin FColWidth := DEFAULT_COLWIDTH; FFixedColWidth := 120; + FTextMargin := 2; FColor := DEFAULT_COLOR; FLineColor := DEFAULT_LINECOLOR; @@ -323,6 +358,18 @@ begin inherited; end; +procedure TVpGanttView.CalcColHeaderHeight; +begin + FMonthColHeaderHeight := GetCanvasTextHeight(Canvas, FColHeaderAttributes.MonthFont) + 2 * FTextMargin; + FDayColHeaderHeight := GetCanvasTextHeight(Canvas, FColHeaderAttributes.DayFont) + FTextMargin; + FTotalColHeaderHeight := FMonthColHeaderHeight + FDayColHeaderHeight; +end; + +procedure TVpGanttView.CalcRowHeight; +begin + FRowHeight := GetCanvasTextHeight(Canvas, FRowHeaderAttributes.EventFont) + 2 * FTextMargin; +end; + procedure TVpGanttView.CreateParams(var AParams: TCreateParams); begin inherited CreateParams(AParams); @@ -364,6 +411,7 @@ begin end; end; +{ Defines the initial size of the control. } class function TVpGanttView.GetControlClassDefaultSize: TSize; begin Result.CX := 300; @@ -375,6 +423,82 @@ begin Result := FDateFormat[AIndex]; end; +function TVpGanttView.GetDayRec(AIndex: Integer): TVpGanttDayRec; +begin + Result := FDayRecords[AIndex]; +end; + +{ Determines the date when the earliest event starts, and the date when the + latest event ends. + Stores them in the internal variables FStartdate and FEndDate. } +procedure TVpGanttView.GetEventDateRange; +var + i: Integer; + event: TVpEvent; + d: TDateTime; +begin + if (Datastore = nil) or (Datastore.Resource = nil) or (Datastore.Resource.Schedule.EventCount = 0) then + begin + FStartDate := NO_DATE; + FEndDate := NO_DATE; + end else + begin + event := Datastore.Resource.Schedule.GetEvent(0); + FStartDate := trunc(event.StartTime); + FEndDate := -99999; + for i := 0 to Datastore.Resource.Schedule.EventCount-1 do + begin + event := Datastore.Resource.Schedule.GetEvent(i); + d := trunc(event.EndTime); + if d > FEndDate then FEndDate := d; + end; + end; +end; + +function TVpGanttView.GetEventRec(AIndex: Integer): TVpGanttEventRec; +begin + Result := FEventRecords[AIndex]; +end; + +function TVpGanttView.GetMonthRec(AIndex: Integer): TVpGanttMonthRec; +begin + Result := FMonthRecords[AIndex]; +end; + +{ Determines the number days between the first and last Gantt event. This is + the number of day columns in the view. } +function TVpGanttView.GetNumDays: Integer; +begin + if (FStartDate <> NO_DATE) then + Result := trunc(FEndDate) - trunc(FStartDate) + 1 + else + Result := 0; +end; + +{ Determines the number of events (= rows) to be displayed in the GanttView. } +function TVpGanttView.GetNumEvents: Integer; +begin + if (Datastore <> nil) and (Datastore.Resource <> nil) then + Result := Datastore.Resource.Schedule.EventCount + else + Result := 0; +end; + +{ Determines the number of months (complete or partial) between the first and + last Gantt event. } +function TVpGanttView.GetNumMonths: Integer; +var + dm1, dm2: Integer; +begin + if (FStartDate <> NO_DATE) then + begin + dm1 := trunc(StartOfTheMonth(FStartDate)); + dm2 := trunc(StartOfTheMonth(FEndDate)); + Result := MonthsBetween(dm1, dm2) + 1; + end else + Result := 0; +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; @@ -390,6 +514,20 @@ begin end; end; +procedure TVpGanttView.Init; +begin + CalcRowHeight; + CalcColHeaderHeight; + + GetEventDateRange; + FColCount := GetNumDays; + FRowCount := GetNumEvents; + + PopulateDayRecords; + PopulateMonthRecords; + PopulateEventRecords; +end; + procedure TVpGanttView.KeyDown(var Key: Word; Shift: TShiftState); var PopupPoint : TPoint; @@ -471,12 +609,6 @@ begin Populate; end; -procedure TVpGanttView.Populate; -begin - if DataStore <> nil then - DataStore.Date := FDate; -end; - procedure TVpGanttView.Paint; begin RenderToCanvas( @@ -494,6 +626,109 @@ begin SetHScrollPos; end; +procedure TVpGanttView.Populate; +begin + if DataStore <> nil then + DataStore.Date := FDate; +end; + +// Populates the array of TVpGanttRec records containing the date of each day +// cell and the *unscrolled* cell rectangle coordinates. +procedure TVpGanttView.PopulateDayRecords; +var + i: Integer; + x1, y1, x2, y2: Integer; +begin + SetLength(FDayRecords, GetNumDays); + x1 := FixedColWidth; + y1 := FMonthColHeaderHeight; + y2 := FTotalColHeaderHeight; + for i := 0 to High(FDayRecords) do + begin + x2 := x1 + ColWidth; + FDayRecords[i].Rect := Rect(x1, y1, x2, y2); + FDayRecords[i].Date := FStartDate + i; + x1 := x2; + end; +end; + +procedure TVpGanttView.PopulateEventRecords; +var + eventRec: TVpGanttEventRec; + event: TVpEvent; + i: Integer; + xh1, xh2, y1, xe1, xe2, y2: Integer; + t1, t2: TDateTime; + totalWidth: Integer; +begin + SetLength(FEventRecords, GetNumEvents); + if (Datastore = nil) or (DataStore.Resource = nil) then + exit; + + xh1 := 0; + xh2 := FixedColWidth; + y1 := FTotalColHeaderHeight; + totalWidth := GetNumDays * ColWidth; + eventRec := Default(TVpGanttEventRec); + for i := 0 to High(FEventRecords) do + begin + event := Datastore.Resource.Schedule.GetEvent(i); + if event.AllDayEvent then + begin + t1 := trunc(event.StartTime); + t2 := trunc(event.EndTime) + 1; + if frac(event.EndTime) = 0 then t2 := t2 + 1; + end else + begin + t1 := event.StartTime; + t2 := event.EndTime; + end; + y2 := y1 + FRowHeight; + xe1 := round((t1 - FStartDate) / numDays * totalWidth) + FixedColWidth; + xe2 := round((t2 - FStartDate) / numDays * totalWidth) + FixedColWidth; + if xe1 = xe2 then xe2 := xe1 + 1; + FEventRecords[i].Event := event; + FEventRecords[i].Caption := event.Description; + FEventRecords[i].HeadRect := Rect(xh1, y1, xh2, y2); + FEventRecords[i].EventRect := Rect(xe1, y1, xe2, y2); + y1 := y2; + end; +end; + +procedure TVpGanttView.PopulateMonthRecords; +var + i, n: Integer; + x1, y1, x2, y2: Integer; + dm: TDateTime; + ndays: Integer; +begin + n := GetNumMonths; + SetLength(FMonthRecords, n); + if (Datastore = nil) or (Datastore.Resource = nil) then + exit; + + x1 := FixedColWidth; + y1 := 0; + y2 := FTotalColHeaderHeight; + dm := FStartDate; + for i := 0 to n - 1 do + begin + if i = 0 then begin + nDays := DaysInMonth(dm) - DayOf(dm) + 1; + dm := StartOfTheMonth(dm); + end else + if i = n-1 then + nDays := DayOf(FEndDate) + else + nDays := DaysInMonth(dm); + x2 := x1 + nDays * ColWidth; + FMonthRecords[i].Rect := Rect(x1, y1, x2, y2); + FMonthRecords[i].Date := dm; + dm := IncMonth(dm, 1); + x1 := x2; + end; +end; + procedure TVpGanttView.RenderToCanvas(RenderCanvas: TCanvas; RenderIn: TRect; Angle: TVpRotationAngle; Scale: Extended; RenderDate: TDateTime; StartLine, StopLine: Integer; UseGran: TVpGranularity; DisplayOnly: Boolean); @@ -519,13 +754,13 @@ end; procedure TVpGanttView.ScrollHorizontal(ANumCols: Integer); begin - FLeftCol := FLeftCol + ANumCols; + SetLeftCol(FLeftCol + ANumCols); Invalidate; end; procedure TVpGanttView.ScrollVertical(ANumRows: Integer); begin - TopRow := FTopRow + ANumRows; + SetTopRow(FTopRow + ANumRows); Invalidate; end; @@ -625,13 +860,13 @@ end; procedure TVpGanttView.SetHScrollPos; var - SI: TScrollInfo; + scrollInfo: TScrollInfo; begin if not HandleAllocated then Exit; - with SI do + with scrollInfo do begin - cbSize := SizeOf(SI); + cbSize := SizeOf(scrollInfo); fMask := SIF_RANGE or SIF_PAGE or SIF_POS; nMin := 0; nMax := FColCount; @@ -645,7 +880,16 @@ begin nPos := FLeftCol; nTrackPos := nPos; end; - SetScrollInfo(Handle, SB_HORZ, SI, True); + SetScrollInfo(Handle, SB_HORZ, scrollInfo, True); +end; + +procedure TVpGanttView.SetTextMargin(AValue: Integer); +begin + if FTextMargin <> AValue then + begin + FTextMargin := AValue; + Invalidate; + end; end; procedure TVpGanttView.SetTopRow(AValue: Integer); @@ -663,6 +907,8 @@ begin FTopRow := 0 else FTopRow:= AValue; + + WriteLn('TopRow = ', TopRow); Invalidate; SetVScrollPos; end; @@ -670,13 +916,13 @@ end; procedure TVpGanttView.SetVScrollPos; var - SI: TScrollInfo; + scrollInfo: TScrollInfo; begin if not HandleAllocated then Exit; - with SI do + with scrollInfo do begin - cbSize := SizeOf(SI); + cbSize := SizeOf(scrollInfo); fMask := SIF_RANGE or SIF_PAGE or SIF_POS; nMin := 0; nMax := FRowCount; @@ -685,12 +931,12 @@ begin else nPage := FVisibleRows; if FTopRow = pred(RowCount) - VisibleRows then - nPos := RowCount + nPos := FRowCount else nPos := FTopRow; nTrackPos := nPos; end; - SetScrollInfo(Handle, SB_VERT, SI, True); + SetScrollInfo(Handle, SB_VERT, scrollInfo, True); end; procedure TVpGanttView.WMHScroll(var Msg: TLMHScroll); diff --git a/components/tvplanit/source/vpganttviewpainter.pas b/components/tvplanit/source/vpganttviewpainter.pas index cff893310..ee7b8378d 100644 --- a/components/tvplanit/source/vpganttviewpainter.pas +++ b/components/tvplanit/source/vpganttviewpainter.pas @@ -13,6 +13,10 @@ type private FGanttView: TVpGanttView; + FDayFont: TFont; + FMonthFont: TFont; + FEventFont: TFont; + BevelHighlight: TColor; BevelShadow: TColor; BevelDarkShadow: TColor; @@ -22,14 +26,6 @@ type RealLineColor: TColor; RealRowHeadAttrColor: TColor; - FColHeadHeightTotal: Integer; - FColHeadRowHeightMonth: Integer; - FColHeadRowHeightDay: Integer; - FRowHeight: Integer; - FTextMargin: Integer; - - function CountMonths(ADate1, ADate2: TDateTime): Integer; - protected procedure Clear; procedure DrawBorders; @@ -64,7 +60,6 @@ constructor TVpGanttViewPainter.Create(AGanttView: TVpGanttView; begin inherited Create(ARenderCanvas); FGanttView := AGanttView; - FTextMargin := 2; end; procedure TVpGanttViewPainter.Clear; @@ -73,23 +68,6 @@ begin RenderCanvas.FillRect(RenderIn); end; -function TVpGanttViewPainter.CountMonths(ADate1, ADate2: TDateTime): Integer; -var - dt: TDateTime; -begin - if ADate1 > ADate2 then - exit; -// 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; @@ -129,7 +107,7 @@ end; procedure TVpGanttViewPainter.DrawColHeader; var - i: Integer; + i, n: Integer; R, R1: TRect; P: TPoint; monthRec: TVpGanttMonthRec; @@ -141,7 +119,7 @@ begin RenderCanvas.Brush.Color := RealColHeadAttrColor; RenderCanvas.Pen.Color := RealLineColor; - R := Rect(RealLeft, RealTop, RealRight, FColHeadHeightTotal); + R := Rect(RealLeft, RealTop, RealRight, FGanttView.TotalColHeaderHeight); TPSFillRect(RenderCanvas, Angle, RenderIn, R); if FGanttView.DrawingStyle = ds3D then @@ -171,16 +149,23 @@ begin TPSLineTo(RenderCanvas, Angle, RenderIn, RealRight, R.Bottom); end; - dx := FGanttView.FixedColWidth - FGanttView.LeftCol * FGanttView.ColWidth; + // Offset due to scrolling + dx := FGanttView.LeftCol * FGanttView.ColWidth; // Draw month rectangles and month captions - for i := 0 to High(TVpGanttViewOpener(FGanttView).FMonthRecords) do + RenderCanvas.Font.Assign(FMonthFont); + n := FGanttView.NumMonths; + for i := 0 to n-1 do begin - monthRec := TVpGanttViewOpener(FGanttView).FMonthRecords[i]; + monthRec := FGanttView.MonthRecords[i]; R := monthRec.Rect; - OffsetRect(R, dx , 0); + 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; @@ -199,31 +184,37 @@ begin 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 * FTextMargin then + 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 * FTextMargin then + if strLen > R.Width - 2 * FGanttView.TextMargin then str := ''; if str <> '' then begin - P := Point((R.Left + R.Right - strLen) div 2, R.Top + FTextMargin); + 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 dividing lines and day captions. Always at right side. - RenderCanvas.Font.Assign(FGanttView.ColHeaderAttributes.DayFont); + // Draw day captions (always centered) and dividing lines (always at right side). + RenderCanvas.Font.Assign(FDayFont); strH := RenderCanvas.TextHeight('Tg'); - for dayRec in TVpGanttViewOpener(FGanttView).FDayRecords do + n := FGanttView.NumDays; + for i := 0 to n - 1 do begin + dayRec := FGanttView.DayRecords[i]; R := dayRec.Rect; - OffsetRect(R, dx, 0); + 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 @@ -240,6 +231,8 @@ begin 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); @@ -256,21 +249,25 @@ var R: TRect; dx, dy: Integer; begin - dx := FGanttView.FixedColWidth - FGanttView.LeftCol * FGanttView.ColWidth; - dy := FColHeadHeightTotal - FGanttView.TopRow * FRowHeight; - for i := 0 to High(TVpGanttViewOpener(FGanttView).FEventRecords) do + dx := FGanttView.LeftCol * FGanttView.ColWidth; + dy := FGanttView.TopRow * FGanttView.RowHeight; + + RenderCanvas.Font.Assign(FEventFont); + for i := 0 to FGanttView.NumEvents-1 do begin - eventRec := TVpGanttViewOpener(FGanttView).FEventRecords[i]; + 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; - R := eventRec.EventRect; - if R.Left = R.Right then R.Right := R.Left + 1; - OffsetRect(R, dx, dy); - InflateRect(R, 0, -2); - if (R.Top < FColHeadHeightTotal) or (R.Left < FGanttView.FixedColWidth) then - Continue; TPSRectangle(RenderCanvas, Angle, RenderIn, R); end; end; @@ -278,53 +275,54 @@ end; procedure TVpGanttViewPainter.DrawGrid; var x1, x2, y0, y1, y2: Integer; - i: Integer; + dx, dy: Integer; + i, n, numEvents: Integer; eventRec: TVpGanttEventRec; dayRec: TVpGanttDayRec; monthRec: TVpGanttMonthRec; - numDays, numMonths, numEvents: Integer; begin RenderCanvas.Pen.Color := RealLineColor; - numDays := Length(TVpGanttViewOpener(FGanttView).FDayRecords); - numMonths := Length(TVpGanttViewOpener(FGanttView).FMonthRecords); - numEvents := Length(TVpGanttViewOpener(FGanttView).FEventRecords); - // Horizontal lines x1 := RealLeft + FGanttView.FixedColWidth; - if numMonths > 0 then + dx := FGanttView.LeftCol * FGanttView.ColWidth; + n := FGanttView.NumMonths; + if n > 0 then begin - monthRec := TVpGanttViewOpener(FGanttView).FMonthRecords[numMonths-1]; - x2 := monthRec.Rect.Right + FGanttView.FixedColWidth; + monthRec := FGanttView.MonthRecords[n-1]; + x2 := monthRec.Rect.Right - dx; end else x2 := RealRight; - - y0 := FColHeadHeightTotal; + y0 := FGanttView.TotalColHeaderHeight; if FGanttView.DrawingStyle = ds3D then dec(y0); - RenderCanvas.Line(x1, y0, x2, y0); - for i := 0 to numEvents-1 do + numEvents := FGanttView.NumEvents; + y0 := 0; + for i := 0 to numEvents - 1 do begin - eventRec := TVpGanttViewOpener(FGanttView).FEventRecords[i]; + eventRec := FGanttView.EventRecords[i]; y1 := y0 + eventRec.EventRect.Bottom; RenderCanvas.Line(x1, y1, x2, y1); end; // Vertical lines - y1 := RealTop + FColHeadHeightTotal; + y1 := RealTop + FGanttView.TotalColHeaderHeight; + dy := FGanttView.TopRow * FGanttView.RowHeight; if numEvents > 0 then begin - eventRec := TVpGanttViewOpener(FGanttView).FEventRecords[numEvents-1]; - y2 := eventRec.EventRect.Bottom + FColHeadHeightTotal; + eventRec := FGanttView.EventRecords[numEvents-1]; + y2 := eventRec.EventRect.Bottom - dy; end else y2 := RealBottom; - for i := 0 to numDays-1 do + n := FGanttView.NumDays; + for i := 0 to n-1 do begin - dayRec := TVpGanttViewOpener(FGanttView).FDayRecords[i]; - x1 := dayRec.Rect.Right + FGanttView.FixedColWidth; + dayRec := FGanttView.DayRecords[i]; + x1 := dayRec.Rect.Right - dx; x2 := x1; - RenderCanvas.Line(x1, y1, x2, y2); + if x1 >= FGanttView.FixedColWidth then + RenderCanvas.Line(x1, y1, x2, y2); end; end; @@ -336,13 +334,14 @@ var 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 + FColHeadHeightTotal; - R.Right := RealLeft + FGanttView.FixedColWidth-1; + R.Top := RealTop; + R.Right := RealLeft + FGanttView.FixedColWidth - 1; R.Bottom := RealBottom - 1; TPSFillRect(RenderCanvas, Angle, RenderIn, R); DrawBevelRect( @@ -352,22 +351,26 @@ begin BevelShadow ); end else begin - R := Rect(RealLeft, RealTop + FColHeadHeightTotal + 1, RealLeft + FGanttView.FixedColWidth, RealBottom); + 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(FGanttView.RowHeaderAttributes.EventFont); + RenderCanvas.Font.Assign(FEventFont); strH := RenderCanvas.TextHeight('Tg'); RenderCanvas.Pen.Color := RealLineColor; - dy := FColHeadHeightTotal - FGanttView.TopRow * FRowHeight; - for i := 0 to High(TVpGanttViewOpener(FGanttView).FEventRecords) do + + // Offset due to scrolling + dy := FGanttView.TopRow * FGanttView.RowHeight; + + for i := 0 to FGanttView.NumEvents-1 do begin - str := TVpGanttViewOpener(FGanttView).FEventRecords[i].Caption; - R := TVpGanttViewOpener(FGanttView).FEventRecords[i].HeadRect; - OffsetRect(R, 0, dy); - if R.Top < FColHeadHeightTotal then + 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 @@ -382,7 +385,7 @@ begin 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); + P := Point(R.Left + FGanttView.TextMargin, (R.Top + R.Bottom - strH) div 2); TPSTextOut(RenderCanvas, Angle, RenderIn, P.X, P.Y, Str); end; end; @@ -417,6 +420,10 @@ begin 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; @@ -443,8 +450,8 @@ begin SetMeasurements; { Draw headers } - DrawColHeader; DrawRowHeader; + DrawColHeader; { Draw grid } DrawGrid; @@ -481,21 +488,8 @@ var begin inherited; - // Height of the event rows - RenderCanvas.Font.Assign(FGanttView.RowHeaderAttributes.EventFont); - FRowHeight := RenderCanvas.TextHeight('Tg') + 2 * FTextMargin; - - // Height of the month part in the column header - RenderCanvas.Font.Assign(FGanttView.ColHeaderAttributes.MonthFont); - FColHeadRowHeightMonth := RenderCanvas.TextHeight('Tg') + FTextMargin; - - // Height of the day part in the column header - RenderCanvas.Font.Assign(FGanttView.ColHeaderAttributes.DayFont); - FColHeadRowHeightDay := RenderCanvas.TextHeight('Tg') + 2 * FTextMargin; - - // total height of header: month row + day row - FColHeadHeightTotal := FColHeadRowHeightMonth + FColHeadRowHeightDay; - + 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 @@ -561,7 +555,7 @@ begin end; x1 := round((t1 - FGanttView.StartDate) / numDays * totalWidth); x2 := round((t2 - FGanttView.StartDate) / numDays * totalWidth); - y2 := y1 + FRowHeight; + y2 := y1 + FGanttView.RowHeight; with TVpGanttViewOpener(FGanttView) do begin FEventRecords[i].Event := event; @@ -575,8 +569,8 @@ begin // Populate day records SetLength(TVpGanttViewOpener(FGanttView).FDayRecords, numDays); x1 := 0; // Scrollable dimension - y1 := RealTop + FColHeadRowHeightMonth; - y2 := RealTop + FColHeadHeightTotal; + y1 := RealTop + FGanttView.MonthColHeaderHeight; + y2 := RealTop + FGanttView.TotalColHeaderHeight; dt := trunc(FGanttView.StartDate); for i := 0 to numDays-1 do begin @@ -598,7 +592,7 @@ begin dt := firstMonth; x1 := 0; // Scrollable dimension; y1 := RealTop; - y2 := RealTop + FColHeadHeightTotal; + y2 := RealTop + FGanttView.TotalColHeaderHeight; for i := 0 to numMonths - 1do begin numDays := DaysInMonth(dt); @@ -617,12 +611,10 @@ begin dt := IncMonth(dt, 1); x1 := x2; end; + *) - FGanttView.VisibleCols := (RealRight - RealLeft + FGanttView.FixedColWidth) div FGanttView.ColWidth; - FGanttView.VisibleRows := (RealBottom - RealTop + FColHeadHeightTotal) div FRowHeight; - FGanttView.RowCount := eventCount; - FGanttView.ColCount := numdays; - end; + FGanttView.VisibleCols := (RealRight - RealLeft - FGanttView.FixedColWidth) div FGanttView.ColWidth; + FGanttView.VisibleRows := (RealBottom - RealTop - FGanttView.TotalColHeaderHeight) div FGanttView.RowHeight; end; end. diff --git a/components/tvplanit/source/vpmisc.pas b/components/tvplanit/source/vpmisc.pas index 7dc6e518a..4030ef745 100644 --- a/components/tvplanit/source/vpmisc.pas +++ b/components/tvplanit/source/vpmisc.pas @@ -175,6 +175,7 @@ function GranularityToStr(Gran: TVpGranularity): string; function TaskPriorityToStr(APriority: TVpTaskPriority): String; +function GetCanvasTextHeight(ACanvas: TCanvas; AFont: TFont): Integer; function GetLabelWidth(ALabel: TLabel): Integer; function GetRealFontHeight(AFont: TFont): Integer; @@ -911,6 +912,27 @@ begin end; end; +function GetCanvasTextHeight(ACanvas: TCanvas; AFont: TFont): Integer; +var + lCanvas: TCanvas; + bmp: TBitmap = nil; +begin + if not ACanvas.HandleAllocated then + begin + bmp := TBitmap.Create; + bmp.SetSize(1, 1); + lCanvas := bmp.Canvas; + end else + lCanvas := ACanvas; + lCanvas.Font.Assign(AFont); + lCanvas.Font.Height := GetRealFontHeight(lCanvas.Font); + {$IF VP_LCL_SCALING = 0} + lCanvas.Font.Size := ScaleY(lCanvas.Font.Size, DesignTimeDPI); + {$ENDIF} + Result := lCanvas.TextHeight('Tg'); + bmp.Free; +end; + function GetLabelWidth(ALabel: TLabel): Integer; var canvas: TControlCanvas;