How to change a font programatically?

Comments

• nicocizik

  July 2018

  Hi Bruce,
  
  Take a look at the following example on finding the right font size to fit in a static area. It uses the Band.BeforePrint event to compare the text width to the width of the control, then begins shrinking the font in a loop and re-testing until it fits. Doing something similar is RAP should be fairly easy however the text measurement aspect may need to be moved outside RAP into a pass-thru function.
  
  See the main RAP demos for how to create and use pass-thru functions.
  
  http://www.digital-metaphors.com/tips/AutoFontSize.zip

  Best Regards,
  
  Nico Cizik
  Digital Metaphors
  http://www.digital-metaphors.com
• Bruce

  July 2018

  Thank you for the prompt reply, I will give this a try.
• Bruce

  July 2018

  Nico, Thank you for the sample code, it has provided sufficient details to resolve the issue I had.
  Many thanks.
• FabioBS85

  December 2021

  Hello,
  I am facing the same issue, for the first time.
  I went through Nico's sample code, but I don't understand it fully.
  Should my ppDBText1have the Autosize property true?
  If I set it to false, it never reduces the font size even for very long texts; if I set it to true, it reduces it a bit too much, aka it does not use the whole space available.
  
  In the function ppToMMThousandths, why are you using the parametrs utInches in the first call, and utPrinterPixels in the second one?
  
  Thank you very much!
  

  var
  liTextWidth: Integer;
  liComponentWidth: Integer;
  lbKeepShrinking: Boolean;
  lsText: String;
  
  aDBText: TppDBText;
  aPPReport: TppReport;
  begin
  inherited;
  liComponentWidth := 0;
  liTextWidth := 0;
  
  aDBText := ppDBText8;
  aPPReport := ppReport_15A4;
  
  aDBText.Font.Size := 20;
  aPPReport.Printer.Canvas.Font.Size := 20;
  
  lbKeepShrinking := True;
  
  while lbKeepShrinking do
  begin
  
  liComponentWidth := ppToMMThousandths(aDBText.Width, utInches, pprtHorizontal, aPPReport.Printer);
  
  lsText := aPPReport.DataPipeline['DsProduct'];
  liTextWidth := aPPReport.Printer.Canvas.TextWidth(lsText);
  liTextWidth := ppToMMThousandths(liTextWidth, utPrinterPixels, pprtHorizontal, aPPReport.Printer);
  
  if (liTextWidth > liComponentWidth) then
  begin
  aPPReport.Printer.Canvas.Font.Size := aPPReport.Printer.Canvas.Font.Size - 1;
  aDBText.Font.Size := aDBText.Font.Size - 1;
  end
  else
  lbKeepShrinking := False;
  end;
  end;