FitTextBox

Message Topic Search Topic Options Post Reply Create New Topic Printable Version Translate Topic

   a sample code from "rweetch".How to reduce fontsize to fit into the area of a fix textbox:

I couldn't see how to do this using the methods, so rolled my own and added it to my TDebenuPDFLibrary Helper. Here's the code if you are interested:

procedure TsmDebenuPDFLibraryHelper.DrawDownScaledText(const aText: string; const X, Y aWidth, aHeight: Double);var lTextSize, lStartSize: Double;
begin

  lStartSize := GetTextSize;
  lTextSize := lStartSize;

  if GetWrappedTextHeight(aWidth, aText) > aHeight then
  begin

     lTextSize := lStartSize;

    repeat

       lTextSize := lTextSize * 0.95;

       SetTextSize(lTextSize);

       until (GetWrappedTextHeight(aWidth, aText) <= aHeight);

  end;

  DrawWrappedText(X, Y, aWidth, aText);

   if lTextSize < lStartSize then
      SetTextSize(lStartSize);

end; 

Author	Message Topic Search Topic Options Post Reply Create New Topic Printable Version Translate Topic
Ingo Members Profile Find Members Posts Moderator Group Joined: 29 Oct 05 Status: Offline Points: 3527	Post Options Post Reply Quote Ingo Report Post Thanks(0) Quote Reply Topic: FitTextBox Posted: 18 Jun 16 at 9:07AM
	a sample code from "rweetch". How to reduce fontsize to fit into the area of a fix textbox: I couldn't see how to do this using the methods, so rolled my own and added it to my TDebenuPDFLibrary Helper. Here's the code if you are interested: procedure TsmDebenuPDFLibraryHelper.DrawDownScaledText(const aText: string; const X, Y aWidth, aHeight: Double); var lTextSize, lStartSize: Double; begin lStartSize := GetTextSize; lTextSize := lStartSize; if GetWrappedTextHeight(aWidth, aText) > aHeight then begin lTextSize := lStartSize; repeat lTextSize := lTextSize * 0.95; SetTextSize(lTextSize); until (GetWrappedTextHeight(aWidth, aText) <= aHeight); end; DrawWrappedText(X, Y, aWidth, aText); if lTextSize < lStartSize then SetTextSize(lStartSize); end;
	Cheers, Ingo