Solved

Changing TPanel fontsize to fit the caption

Posted on 2015-01-26
9
217 Views
Last Modified: 2015-02-16
I am using Delphi XE5 and I have a TPanel

Caption: 0,00 USD
Width: 185
Height: 41

What i need to do is to change the fontsize according to text width / height to fit the panel.

Let's say the panel should show 1,25 USD, Fontsize will be 25 but if panel shows 1.425,18 USD the Fontsize will be 18 automatically. Is there anyway to change the fontsize automatically according to text size?
0
Comment
Question by:karagunes
  • 4
  • 2
  • 2
  • +1
9 Comments
 
LVL 25

Expert Comment

by:Sinisa Vuk
ID: 40572436
No, not autmatically. You should do some calc.
Iterate font size and compare w/h.

I wrote function for getting max font size:
function CalcMaxFontSize4Box(w, h: Integer; c: TCanvas; sText: String): Integer;
var
  i: Integer;
  sz: TSize;
  TxMet: TTextMetric;
begin
  Result := 2;
  iOffsY := 0;
  iWidth := w;

  for i := 2 to 50 do
  begin
    c.Font.Size := i;
    sz.cx := 0;
    sz.cy := 0;
    GetTextExtentPoint32(c.Handle, PChar(sText), Length(sText), sz);
    GetTextMetrics(c.Handle, TxMet);
    sz.cy := TxMet.tmAscent;
    sz.cy := TxMet.tmAscent {TxMet.tmHeight}-TxMet.tmInternalLeading;

    if (sz.cx < w) and (sz.cy < h) then
    begin
      Result := i;
    end
    else
    begin
      Break;
    end;
  end;
end;

Open in new window


call it:
Label1.Font,Size := CalcMaxFontSize4Box(Panel1.Width, Panel1.Height, Panel1.Canvas, 'Text');

Open in new window

0
 
LVL 1

Author Comment

by:karagunes
ID: 40580136
Hi,

This does not work. Actually TPanel doesn't have canvas property
0
 
LVL 24

Expert Comment

by:jimyX
ID: 40581071
<am just thinking here>

I do not know if there would be a custom Panel or other component that allows effortless automatic way, but am just trying a simple thing here, but not necessarily the best nor the only way though.

//PnlTxtLen= Length of Panel's caption.
//Min_FS= Smallest FontSize.
//Min_Ch= Min Char length.
//Max_FS= Biggest FontSize.
//Max_Ch= Max Char length.

function SetPanelFS(PnlTxtLen, Min_FS, Min_Ch, Max_FS, Max_Ch: integer):integer;
begin
  if PnlTxtLen <= 7 then      //To avoid surprises add validation conditions
    Result:= 28
  else
    Result:= round((((Min_FS * Min_Ch) + (Max_FS * Max_Ch)) / 2) / PnlTxtLen);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Panel1.Caption:= Edit1.Text;                                              // assign text to the panel's caption
  Panel1.Font.Size:= SetPanelFS(Length(Panel1.Caption), 8, 25, 12, 18);     //set the FontSize
  Label1.Caption:= IntToStr(Panel1.Font.Size);                              //View the current FontSize
end;

Open in new window


The FontSize (min & max) constants I used above, are based on your suggestion at the width of 185.
So if you changed the width new constants should be used (Math can help again).
The only thing that this does not cover is the height.

Anyways wish it helps.
0
 
LVL 25

Expert Comment

by:Sinisa Vuk
ID: 40581743
There is Canvas property - just you need some work to access it. So, this time I test my work.
...
type
  TMyPanelHelper = class(TPanel);

function CalcMaxFontSize4Box(w, h, iMinFontSz, iMaxFontSz: Integer; lblFont: TFont;
  parentPnl: TMyPanelHelper; sText: String): Integer;
var
  i: Integer;
  Flags: Cardinal;
  Rect: TRect;
begin
  Result := 2;
  parentPnl.Canvas.Font.Assign(lblFont);

  for i := iMinFontSz to iMaxFontSz do
  begin
    parentPnl.Canvas.Font.Size := i;
    Rect.Left := 0;
    Rect.Top := 0;
    Rect.Right := w;
    Rect.Bottom := h;
    Flags := DT_EXPANDTABS or DT_WORDBREAK or DT_NOCLIP or DT_CALCRECT;
    Flags := parentPnl.DrawTextBiDiModeFlags(Flags);
    DrawText(parentPnl.Canvas.Handle, PChar(sText), -1, Rect, Flags);

        //width                            //hight
    if ((Rect.Right - Rect.Left) < w) and ((Rect.Bottom - Rect.Top) < h) then
    begin
      Result := i;
    end
    else
    begin
      Break;
    end;
  end;
end;

procedure TForm1.Button8Click(Sender: TObject);
var
  sText: String;
begin
  sText := 'This is my long Text,'#13#10'very long Text';
  Label1.Font.Size := CalcMaxFontSize4Box(Panel1.Width - Label1.Left, Panel1.Height - Label1.Top,
    2, 50, Label1.Font, TMyPanelHelper(Panel1), sText);
  Label1.Caption := sText;
end;

Open in new window


Calc function takes more parameters now - so it is more flexible.
Take a note - I use left,top property of label because in my example I put label in center of panel.
0
Highfive Gives IT Their Time Back

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 
LVL 19

Accepted Solution

by:
MerijnB earned 500 total points
ID: 40586122
Please see this code snippet, which works here in XE7 (I can sent complete project + compiled binary if required).

unit AutoSizePanel_main;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TAutoSizePanel = class(TPanel)
  private
   procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;

   procedure UpdateFontSize;
  protected
   procedure Resize; override;
   end;

  TForm2 = class(TForm)
    Edit1: TEdit;
    procedure Edit1Change(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
  protected
  private
   fAutoSizePanel: TAutoSizePanel;
  public
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation

{$R *.dfm}

{ TAutoSizePanel }

procedure TAutoSizePanel.CMTextChanged(var Message: TMessage);
begin
 inherited;

 UpdateFontSize();
end;

procedure TAutoSizePanel.Resize;
begin
 inherited;

 UpdateFontSize();
end;

procedure TAutoSizePanel.UpdateFontSize;

 function CheckFontSize(FontSize: integer): boolean;
 var OrgFontSize: integer;
     Size: TSize;
 begin
  OrgFontSize := Canvas.Font.Size;

  Canvas.Font.Size := FontSize;
  Size := Canvas.TextExtent(Caption);
  result := (Size.cx < Width) and (Size.cy < Height);

  Canvas.Font.Size := OrgFontSize;
 end;

begin
 if (Caption = '') or (not assigned(Parent)) then
  exit;

 while not CheckFontSize(Font.Size) do
  Font.Size := Font.Size - 1;

 while CheckFontSize(Font.Size + 1) do
  Font.Size := Font.Size + 1;
end;

procedure TForm2.Edit1Change(Sender: TObject);
begin
 fAutoSizePanel.Caption := Edit1.Text;
end;

procedure TForm2.FormCreate(Sender: TObject);
begin
 fAutoSizePanel := TAutoSizePanel.Create(Self);
 fAutoSizePanel.Parent := Self;
 fAutoSizePanel.Align := alClient;
end;

procedure TForm2.FormShow(Sender: TObject);
begin
 Edit1Change(nil);
end;

end.

Open in new window

0
 
LVL 1

Author Comment

by:karagunes
ID: 40610200
MerijnB - Than ks for the code. It works great. One question, how can i add some padding?
0
 
LVL 1

Author Comment

by:karagunes
ID: 40610205
Ok I have changed this:

 result := (Size.cx < Width - Padding.Left - Padding.Right) and (Size.cy < Height - Padding.Top - Padding.Bottom);

Thanks for this solution which works great!
0
 
LVL 1

Author Closing Comment

by:karagunes
ID: 40610211
Works great
0
 
LVL 19

Expert Comment

by:MerijnB
ID: 40611807
Padding code looks good to me! :)
0

Featured Post

Threat Intelligence Starter Resources

Integrating threat intelligence can be challenging, and not all companies are ready. These resources can help you build awareness and prepare for defense.

Join & Write a Comment

Hello everybody This Article will show you how to validate number with TEdit control, What's the TEdit control? TEdit is a standard Windows edit control on a form, it allows to user to write, read and copy/paste single line of text. Usua…
The Fluent Interface Design Pattern You can use the Fluent Interface (http://en.wikipedia.org/wiki/Fluent_interface) design pattern to make your PHP code easier to read and maintain.  "Fluent Interface" is an object-oriented design pattern that r…
Sending a Secure fax is easy with eFax Corporate (http://www.enterprise.efax.com). First, Just open a new email message.  In the To field, type your recipient's fax number @efaxsend.com. You can even send a secure international fax — just include t…
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…

760 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

17 Experts available now in Live!

Get 1:1 Help Now