diff --git a/components/tvplanit/source/vpganttview.pas b/components/tvplanit/source/vpganttview.pas index 378e73fec..9b1ef685e 100644 --- a/components/tvplanit/source/vpganttview.pas +++ b/components/tvplanit/source/vpganttview.pas @@ -442,9 +442,15 @@ begin end; procedure TVpGanttView.CalcColHeaderHeight; +var + s: String; begin FMonthColHeaderHeight := GetCanvasTextHeight(Canvas, FColHeaderAttributes.MonthFont) + 2 * FTextMargin; - FDayColHeaderHeight := GetCanvasTextHeight(Canvas, FColHeaderAttributes.DayFont) + 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; + FTotalColHeaderHeight := FMonthColHeaderHeight + FDayColHeaderHeight; end; diff --git a/components/tvplanit/source/vpganttviewpainter.pas b/components/tvplanit/source/vpganttviewpainter.pas index b6c32c1a0..1f4be2492 100644 --- a/components/tvplanit/source/vpganttviewpainter.pas +++ b/components/tvplanit/source/vpganttviewpainter.pas @@ -280,6 +280,12 @@ begin 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); + + // To do: replace above code for multi-line text, ie. + // strLen := GetCanvasTextWidth(RenderCanvas, FDayFont, str); + // TPSTextRect(RencerCanvas, Angle, RenderIn, R, P.X, P.Y, str); + // BUT: TPSTextRect does not yet exist... + end; end; diff --git a/components/tvplanit/source/vpmisc.pas b/components/tvplanit/source/vpmisc.pas index 4030ef745..2e2de3a9e 100644 --- a/components/tvplanit/source/vpmisc.pas +++ b/components/tvplanit/source/vpmisc.pas @@ -175,7 +175,8 @@ function GranularityToStr(Gran: TVpGranularity): string; function TaskPriorityToStr(APriority: TVpTaskPriority): String; -function GetCanvasTextHeight(ACanvas: TCanvas; AFont: TFont): Integer; +function GetCanvasTextHeight(ACanvas: TCanvas; AFont: TFont; AText: String = ''): Integer; +function GetCanvasTextWidth(ACanvas: TCanvas; AFont: TFont; AText: String): Integer; function GetLabelWidth(ALabel: TLabel): Integer; function GetRealFontHeight(AFont: TFont): Integer; @@ -912,10 +913,12 @@ begin end; end; -function GetCanvasTextHeight(ACanvas: TCanvas; AFont: TFont): Integer; +function GetCanvasTextHeight(ACanvas: TCanvas; AFont: TFont; AText: String = ''): Integer; var lCanvas: TCanvas; bmp: TBitmap = nil; + flags: Integer; + R: TRect; begin if not ACanvas.HandleAllocated then begin @@ -929,7 +932,38 @@ begin {$IF VP_LCL_SCALING = 0} lCanvas.Font.Size := ScaleY(lCanvas.Font.Size, DesignTimeDPI); {$ENDIF} - Result := lCanvas.TextHeight('Tg'); + flags := DT_WORDBREAK or DT_CALCRECT; + R := Rect(0,0, MaxInt, 0); + if AText = '' then AText := 'Tg'; + DrawText(lCanvas.Handle, PChar(AText), Length(AText), R, flags); + Result := R.Bottom; + bmp.Free; +end; + +function GetCanvasTextWidth(ACanvas: TCanvas; AFont: TFont; AText: String): Integer; +var + lCanvas: TCanvas; + bmp: TBitmap = nil; + flags: Integer; + R: TRect; +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} + flags := DT_WORDBREAK or DT_CALCRECT; + R := Rect(0,0, MaxInt, 0); + if AText = '' then AText := 'Tg'; + DrawText(lCanvas.Handle, PChar(AText), Length(AText), R, flags); + Result := R.Right; bmp.Free; end;