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

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8429 8e941d3f-bd1b-0410-a28a-d453659cc2b4

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;
 

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;
 

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;