• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 368
  • Last Modified:

Changing TPanel fontsize to fit the caption

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
karagunes
Asked:
karagunes
  • 4
  • 2
  • 2
  • +1
1 Solution
 
Sinisa VukCommented:
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
 
karagunesAuthor Commented:
Hi,

This does not work. Actually TPanel doesn't have canvas property
0
 
jimyXCommented:
<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
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 
Sinisa VukCommented:
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
 
MerijnBSr. Software EngineerCommented:
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
 
karagunesAuthor Commented:
MerijnB - Than ks for the code. It works great. One question, how can i add some padding?
0
 
karagunesAuthor Commented:
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
 
karagunesAuthor Commented:
Works great
0
 
MerijnBSr. Software EngineerCommented:
Padding code looks good to me! :)
0

Featured Post

What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

  • 4
  • 2
  • 2
  • +1
Tackle projects and never again get stuck behind a technical roadblock.
Join Now