diff --git a/components/tvplanit/source/vpganttview.pas b/components/tvplanit/source/vpganttview.pas index 3e7e039ff..1c1ca39cb 100644 --- a/components/tvplanit/source/vpganttview.pas +++ b/components/tvplanit/source/vpganttview.pas @@ -260,8 +260,8 @@ type {$ENDIF} // Methods to be called by painter - function CalcVisibleCols(AWidth: Integer): Integer; - function CalcVisibleRows(AHeight: Integer): Integer; + function CalcVisibleCols(AWidth, AFixedColWidth, AColWidth: Integer): Integer; + function CalcVisibleRows(AHeight, AHeaderHeight, ARowHeight: Integer): Integer; property ActiveCol: Integer read FActiveCol write SetActiveCol; property ActiveEvent: TVpEvent read FActiveEvent write SetActiveEvent; @@ -542,39 +542,53 @@ end; procedure TVpGanttView.CalcColHeaderHeight; var s: String; + h: Integer; begin - FMonthColHeaderHeight := GetCanvasTextHeight(Canvas, FColHeaderAttributes.MonthFont) + 2 * FTextMargin; + h := GetCanvasTextHeight(Canvas, FColHeaderAttributes.MonthFont); + FMonthColHeaderHeight := h + 2 * FTextMargin; // A typical date string to measure the text height (line breaks in DayFormat allowed) s := FormatDateTime(DayFormat, EncodeDate(2000, 12, 28)); - FDayColHeaderHeight := GetCanvasTextHeight(Canvas, FColHeaderAttributes.DayFont, s) + FTextMargin; + h := GetCanvasTextHeight(Canvas, FColHeaderAttributes.DayFont, s); + FDayColHeaderHeight := h + FTextMargin; FTotalColHeaderHeight := FMonthColHeaderHeight + FDayColHeaderHeight; end; procedure TVpGanttView.CalcRowHeight; +var + h: Integer; begin - FRowHeight := GetCanvasTextHeight(Canvas, FRowHeaderAttributes.EventFont) + 2 * FTextMargin; + h := GetCanvasTextHeight(Canvas, FRowHeaderAttributes.EventFont); + FRowHeight := h + 2 * FTextMargin; end; -function TVpGanttView.CalcVisibleCols(AWidth: Integer): Integer; +function TVpGanttView.CalcVisibleCols(AWidth, AFixedColWidth, AColWidth: Integer): Integer; var d: Integer = 0; // Result of div m: Integer = 0; // Result of mod begin - DivMod(AWidth - FixedColWidth, ColWidth, d, m); - if (m = 0) and (d > 1) then dec(d); - Result := d; + if AColWidth <> 0 then + begin + DivMod(AWidth - AFixedColWidth, AColWidth, d, m); + if (m = 0) and (d > 1) then dec(d); + Result := d; + end else + Result := 0; end; -function TVpGanttView.CalcVisibleRows(AHeight: Integer): Integer; +function TVpGanttView.CalcVisibleRows(AHeight, AHeaderHeight, ARowHeight: Integer): Integer; var d: Integer = 0; // Result of div m: Integer = 0; // Result of mod begin - DivMod(AHeight - TotalColHeaderHeight, FRowHeight, d, m); - if (m = 0) and (d > 1) then dec(d); - Result := d; + if ARowHeight <> 0 then + begin + DivMod(AHeight - AHeaderHeight, ARowHeight, d, m); + if (m = 0) and (d > 1) then dec(d); + Result := d; + end else + Result := 0; end; procedure TVpGanttView.CreateParams(var AParams: TCreateParams); @@ -736,12 +750,12 @@ begin if (FRowHeight > 0) and (Length(FEventRecords) > 0) then begin - VisibleRows := CalcVisibleRows(ClientHeight); + VisibleRows := CalcVisibleRows(ClientHeight, FTotalColHeaderHeight, FRowHeight); emptyRows := VisibleRows - (Length(FEventRecords) - FTopRow); if emptyRows > 0 then ScrollVertical(-emptyRows); - VisibleCols := CalcVisibleCols(ClientWidth); + VisibleCols := CalcVisibleCols(ClientWidth, FFixedColWidth, FColWidth); emptyCols := VisibleCols - (Length(FDayRecords) - FLeftCol); if emptyCols > 0 then ScrollHorizontal(-emptyCols); diff --git a/components/tvplanit/source/vpganttviewpainter.pas b/components/tvplanit/source/vpganttviewpainter.pas index ab6ea3172..2591dcf97 100644 --- a/components/tvplanit/source/vpganttviewpainter.pas +++ b/components/tvplanit/source/vpganttviewpainter.pas @@ -17,6 +17,12 @@ type FMonthFont: TFont; FEventFont: TFont; + FScaledColWidth: Integer; + FScaledFixedColWidth: Integer; + FScaledTextMargin: Integer; + FScaledTotalColHeaderHeight: Integer; + FScaledRowHeight: Integer; + BevelHighlight: TColor; BevelShadow: TColor; BevelDarkShadow: TColor; @@ -26,6 +32,8 @@ type RealLineColor: TColor; RealRowHeadAttrColor: TColor; + function ScaleRect(ARect: TRect): TRect; + protected procedure Clear; procedure DrawActiveDate; @@ -86,8 +94,8 @@ begin dayRec := DayRecords[ActiveCol]; eventRec := EventRecords[ActiveRow]; - dx := LeftCol * ColWidth; - dy := TopRow * RowHeight; + dx := LeftCol * FScaledColWidth; + dy := TopRow * FScaledRowHeight; end; R := Rect( @@ -95,7 +103,7 @@ begin ); OffsetRect(R, -dx, -dy); - if R.Top < FGanttView.TotalColHeaderHeight then + if R.Top < FScaledTotalColHeaderHeight then exit; pw := RenderCanvas.Pen.Width; @@ -141,22 +149,22 @@ begin RenderCanvas.Brush.Color := RealColHeadAttrColor; RenderCanvas.Pen.Color := RealLineColor; - R := Rect(RealLeft, RealTop, RealRight, FGanttView.TotalColHeaderHeight); + R := Rect(RealLeft, RealTop, RealRight, RealTop + FScaledTotalColHeaderHeight); TPSFillRect(RenderCanvas, Angle, RenderIn, R); if FGanttView.DrawingStyle = ds3D then begin R1 := R; InflateRect(R1, -1, -1); - R1.Right := FGanttView.FixedColWidth-1; + R1.Right := RealLeft + FScaledFixedColWidth - 1; DrawBevelRect( RenderCanvas, TPSRotateRectangle(Angle, RenderIn, R1), BevelHighlight, BevelShadow ); - R1.Left := FGanttView.FixedColWidth; - R1.Right := RealRight-2; + R1.Left := RealLeft + FScaledFixedColWidth; + R1.Right := RealRight - 2; DrawBevelRect( RenderCanvas, TPSRotateRectangle(Angle, RenderIn, R1), @@ -165,14 +173,14 @@ begin ); end else begin - TPSMoveTo(RenderCanvas, Angle, RenderIn, FGanttView.FixedColWidth, R.Top); - TPSLineTo(RenderCanvas, Angle, RenderIn, FGanttView.FixedColWidth, R.Bottom); + TPSMoveTo(RenderCanvas, Angle, RenderIn, RealLeft + FScaledFixedColWidth, R.Top); + TPSLineTo(RenderCanvas, Angle, RenderIn, RealLeft + FScaledFixedColWidth, 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; + dx := FGanttView.LeftCol * FScaledColWidth; // Draw month rectangles and month captions RenderCanvas.Font.Assign(FMonthFont); @@ -181,11 +189,12 @@ begin begin monthRec := FGanttView.MonthRecords[i]; R := monthRec.Rect; + R := ScaleRect(R); OffsetRect(R, -dx , 0); // Clip at fixed col edge - if R.Left < FGanttView.FixedColWidth then - R.Left := FGanttView.FixedColWidth; + if R.Left < RealLeft + FScaledFixedColWidth then + R.Left := RealLeft + FScaledFixedColWidth; // Draw month box if FGanttView.DrawingStyle = ds3D then @@ -209,16 +218,16 @@ begin // 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 + if strLen > R.Width - 2 * FScaledTextMargin then begin str := FormatDateTime(FGanttView.MonthFormat_short, monthRec.Date); strLen := RenderCanvas.TextWidth(str); end; - if strLen > R.Width - 2 * FGanttView.TextMargin then + if strLen > R.Width - 2 * FScaledTextMargin then str := ''; if str <> '' then begin - P := Point((R.Left + R.Right - strLen) div 2, R.Top + FGanttView.TextMargin); + P := Point((R.Left + R.Right - strLen) div 2, R.Top + FScaledTextMargin); TPSTextOut(RenderCanvas, Angle, RenderIn, P.X, P.Y, str); end; end; @@ -230,9 +239,9 @@ begin for i := 0 to n - 1 do begin dayRec := FGanttView.DayRecords[i]; - R := dayRec.Rect; + R := ScaleRect(dayRec.Rect); OffsetRect(R, -dx, 0); - if R.Left < FGanttView.FixedColWidth then + if R.Left < RealLeft + FScaledFixedColWidth then Continue; // In sdmHeader SpecialDayMode we must repaint the background of the @@ -301,9 +310,14 @@ var dx, dy: Integer; top_margin, bottom_margin: Integer; begin - dx := FGanttView.LeftCol * FGanttView.ColWidth; - dy := FGanttView.TopRow * FGanttView.RowHeight; + dx := FGanttView.LeftCol * FScaledColWidth; + dy := FGanttView.TopRow * FScaledRowHeight; + if DisplayOnly then + begin + top_margin := round(2*scale); + bottom_margin := top_margin; + end else if FGanttView.DrawingStyle = ds3D then begin top_margin := 1; @@ -313,23 +327,25 @@ begin top_margin := 2; bottom_margin := 1; end; + RenderCanvas.Font.Assign(FEventFont); for i := 0 to FGanttView.NumEvents-1 do begin eventRec := FGanttView.EventRecords[i]; event := eventRec.Event; - R := eventRec.EventRect; + R := ScaleRect(eventRec.EventRect); OffsetRect(R, -dx, -dy); inc(R.Top, top_margin); dec(R.Bottom, bottom_margin); - if R.Top < FGanttView.TotalColHeaderHeight then + if R.Top < FScaledTotalColHeaderHeight then Continue; - if R.Right < FGanttView.FixedColWidth then + if R.Right < FScaledFixedColWidth then Continue; - if R.Left < FGanttView.FixedColWidth then - R.Left := FGanttView.FixedColWidth; + if R.Left < FScaledFixedColWidth then + R.Left := FScaledFixedColWidth; cat := FGanttView.DataStore.CategoryColorMap.GetCategory(event.Category); RenderCanvas.Pen.Color := cat.Color; + RenderCanvas.Pen.Width := round(Scale); RenderCanvas.Brush.Color := cat.BackgroundColor; TPSRectangle(RenderCanvas, Angle, RenderIn, R); end; @@ -343,24 +359,27 @@ var eventRec: TVpGanttEventRec; dayRec: TVpGanttDayRec; monthRec: TVpGanttMonthRec; + R: TRect; begin RenderCanvas.Pen.Color := RealLineColor; - dx := FGanttView.LeftCol * FGanttView.ColWidth; - dy := FGanttView.TopRow * FGanttView.RowHeight; + dx := FGanttView.LeftCol * FScaledColWidth; + dy := FGanttView.TopRow * FScaledRowHeight; // Horizontal line terminating the col header block - x1 := RealLeft + FGanttView.FixedColWidth; + x1 := RealLeft + FScaledFixedColWidth; n := FGanttView.NumMonths; if n > 0 then begin monthRec := FGanttView.MonthRecords[n-1]; - x2 := monthRec.Rect.Right - dx; + R := ScaleRect(monthRec.Rect); + x2 := R.Right - dx; end else x2 := RealRight; - y0 := FGanttView.TotalColHeaderHeight; + y0 := RealTop + FScaledTotalColHeaderHeight; if FGanttView.DrawingStyle = ds3D then dec(y0); - RenderCanvas.Line(x1, y0, x2, y0); + TPSMoveTo(RenderCanvas, Angle, RenderIn, x1, y0); + TPSLineTo(RenderCanvas, Angle, RenderIn, x2, y0); // Horizontal lines if (gvoHorizGrid in FGanttView.Options) then @@ -371,30 +390,38 @@ begin for i := 0 to numEvents - 1 do begin eventRec := FGanttView.EventRecords[i]; - y1 := y0 + eventRec.EventRect.Bottom; - if y1 >= FGanttView.TotalColHeaderHeight then - RenderCanvas.Line(x1, y1, x2, y1); + R := ScaleRect(eventRec.EventRect); + y1 := y0 + R.Bottom; + if y1 >= FScaledTotalColHeaderHeight then + begin + TPSMoveTo(RenderCanvas, Angle, RenderIn, x1, y1); + TPSLineTo(RenderCanvas, Angle, RenderIn, x2, y1); + end; end; end; // Vertical lines if (gvoVertGrid in FGanttView.Options) then begin - y1 := RealTop + FGanttView.TotalColHeaderHeight; + y1 := RealTop + FScaledTotalColHeaderHeight; if numEvents > 0 then begin eventRec := FGanttView.EventRecords[numEvents-1]; - y2 := eventRec.EventRect.Bottom - dy; + R := ScaleRect(eventRec.EventRect); + y2 := R.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); + R := ScaleRect(dayRec.Rect); + x1 := R.Right - dx; + if x1 >= FScaledFixedColWidth then + begin + TPSMoveTo(RenderCanvas, Angle, RenderIn, x1, y1); + TPSLineTo(RenderCanvas, Angle, RenderIn, x1, y2) + end; end; end; end; @@ -414,7 +441,7 @@ begin if FGanttView.DrawingStyle = ds3d then begin R.Left := RealLeft + 1; R.Top := RealTop; - R.Right := RealLeft + FGanttView.FixedColWidth - 1; + R.Right := RealLeft + FScaledFixedColWidth - 1; R.Bottom := RealBottom - 1; TPSFillRect(RenderCanvas, Angle, RenderIn, R); DrawBevelRect( @@ -424,10 +451,11 @@ begin BevelShadow ); end else begin - R := Rect(RealLeft, RealTop + 1, RealLeft + FGanttView.FixedColWidth, RealBottom); + R := Rect(RealLeft, RealTop + 1, RealLeft + FScaledFixedColWidth, RealBottom); TPSFillRect(RenderCanvas, Angle, RenderIn, R); RenderCanvas.Pen.Color := RealLineColor; - RenderCanvas.Line(R.Right, R.Top, R.Right, R.Bottom); + TPSMoveTo(RenderCanvas, Angle, RenderIn, R.Right, R.Top); + TPSLineTo(RenderCanvas, Angle, RenderIn, R.Right, R.Bottom); end; RenderCanvas.Font.Assign(FEventFont); @@ -435,15 +463,15 @@ begin RenderCanvas.Pen.Color := RealLineColor; // Offset due to scrolling - dy := FGanttView.TopRow * FGanttView.RowHeight; + dy := FGanttView.TopRow * FScaledRowHeight; for i := 0 to FGanttView.NumEvents-1 do begin eventRec := FGanttView.EventRecords[i]; str := eventRec.Caption; - R := eventRec.HeadRect; + R := ScaleRect(eventRec.HeadRect); OffsetRect(R, 0, -dy); - if R.Top < FGanttView.TotalColHeaderHeight then + if R.Top < FScaledTotalColHeaderHeight then Continue; if FGanttView.DrawingStyle = ds3D then begin @@ -456,11 +484,12 @@ begin ); end else begin - RenderCanvas.Line(R.Left, R.Bottom, R.Right, R.Bottom); + TPSMoveTo(RenderCanvas, Angle, RenderIn, R.Left, R.Bottom); + TPSLineTo(RenderCanvas, Angle, RenderIn, R.Right, R.Bottom); end; // Paint event description as header - inc(R.Left, FGanttView.TextMargin + 2); + inc(R.Left, FScaledTextMargin + 2); P := Point(R.Left, (R.Top + R.Bottom - strH) div 2); TPSTextOut(RenderCanvas, Angle, RenderIn, P.X, P.Y, Str); end; @@ -474,6 +503,7 @@ var clr: TColor; dayRec: TVpGanttDayRec; holiday: String; + R: TRect; begin with FGanttView do begin @@ -482,11 +512,12 @@ begin nEvents := NumEvents; nDays := NumDays; - dx := LeftCol * ColWidth; - dy := TopRow * RowHeight; + dx := LeftCol * FScaledColWidth; + dy := TopRow * FScaledRowHeight; - y1 := TotalColHeaderHeight; - y2 := EventRecords[nEvents-1].HeadRect.Bottom - dy; + R := ScaleRect(EventRecords[nEvents-1].HeadRect); + y1 := RealTop + FScaledTotalColHeaderHeight; + y2 := R.Bottom - dy; RenderCanvas.Brush.style := bsSolid; for i := 0 to nDays-1 do @@ -501,8 +532,9 @@ begin if clr <> clNone then begin RenderCanvas.Brush.Color := clr; - x1 := dayRec.Rect.Left - dx; - x2 := dayRec.Rect.Right - dx; + R := ScaleRect(dayRec.Rect); + x1 := R.Left - dx; + x2 := R.Right - dx; RenderCanvas.FillRect(x1, y1, x2, y2); end; end; @@ -595,17 +627,30 @@ begin { Restore canvas settings} RestorePenBrush; +end; - //RenderCanvas.Textout(0, 0, FormatDateTime('c', ARenderDate)); - //RenderCanvas.TextOut(0, 20, FormatDateTime('c', FGanttView.Date)); +function TVpGanttViewPainter.ScaleRect(ARect: TRect): TRect; +begin + Result.Left := RealLeft + round(ARect.Left * Scale); + Result.Top := RealTop + round(ARect.Top * Scale); + Result.Right := RealLeft + round(ARect.Right * Scale); + Result.Bottom := RealTop + round(ARect.Bottom * Scale); end; procedure TVpGanttViewPainter.SetMeasurements; begin inherited; + FGanttView.Init; - FGanttView.VisibleCols := FGanttView.CalcVisibleCols(RealRight - RealLeft); - FGanttView.VisibleRows := FGanttView.CalcVisibleRows(RealBottom - RealTop); + + FScaledFixedColWidth := round(FGanttView.FixedColWidth * Scale); + FScaledColWidth := round(FGanttView.ColWidth * Scale); + FScaledTextMargin := round(FGanttView.TextMargin * Scale); + FScaledTotalColHeaderHeight := round(FGanttView.TotalColHeaderHeight * Scale); + FScaledRowHeight := round(FGanttView.RowHeight * Scale); + + FGanttView.VisibleCols := FGanttView.CalcVisibleCols(RealRight - RealLeft, FScaledFixedColWidth, FScaledColWidth); + FGanttView.VisibleRows := FGanttView.CalcVisibleRows(RealBottom - RealTop, FScaledTotalColHeaderHeight, FScaledRowHeight); end; end.