pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

tvplanit: Preparing for multi-line day captions in TVpGanttView. Not working yet.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8429 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2022-08-30 21:39:47 +00:00
parent b915c3008e
commit dcfa500d6e
3 changed files with 50 additions and 4 deletions
Download Patch File Download Diff File Expand all files Collapse all files

8
components/tvplanit/source/vpganttview.pas
View File

@ -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;

6
components/tvplanit/source/vpganttviewpainter.pas
View File

@ -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;

40
components/tvplanit/source/vpmisc.pas
View File

@ -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;