Solved

Changing TPanel fontsize to fit the caption

Posted on 2015-01-26
9
275 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 4
  • 2
  • 2
  • +1
9 Comments
 
LVL 27

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
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 27

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

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

"Disruption" is the most feared word for C-level executives these days. They agonize over their industry being disturbed by another player - most likely by startups.
I've attached the XLSM Excel spreadsheet I used in the video and also text files containing the macros used below. https://filedb.experts-exchange.com/incoming/2017/03_w12/1151775/Permutations.txt https://filedb.experts-exchange.com/incoming/201…

737 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