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

Canvas.TextWidth is not correct!

Problems with exactly scaling a Font:

I tried to fit a text into an Image, so that it starts on the left side and ends on the right side of the Image (as excactly as possible; I know, that
Font.Size is not available for all integer values!).

I used the following simple code:


  cvs:=Image.Canvas;
  tw:=cvs.TextWidth(ed_Text.Text);
  cvs.Font.Size:=30;
  while ((tw>=Image.Width) and (cvs.Font.Size>3))   do begin
    cvs.Font.Size:=cvs.Font.Size-1;
    tw:=cvs.TextWidth(ed_Text.Text);
  end; // while ...
  cvs.Textout(0,0,s);


(Hereby I will assume, that the Image is high enough to contain
the text, so I do not have to check this here).

The result: the text starts on the left, but does only fill about 80%
of the window leaving blanks on the right side. So it seems to me, that cvs.TextWidth returns a value,
which is too small (I can always find an existing Font.Size, which has a better fit!).

I could solve the problem this way:
  tw:=round(1.2 * cvs.TextWidth(ed_Text.Text);
but I think, there must be a more exact way to get the correct
size of the Font on the canvas to ensure exact scaling.

100 Points for a different approach to solve the problem of fitting
the text in width (or also in height), which results in a more exact
fit.

Thanks for any help

Gamba


0
Gamba
Asked:
Gamba
1 Solution
 
ITugayCommented:
Hi Gamba,

try this sample
-----------
var tw,fs : integer;
    S     : string;
    cnv   : TCanvas;
begin
   cnv:=Image1.Canvas;
   cnv.Font.Size:=6;
   S:='sample';
   repeat
      cnv.Font.Size:=cnv.Font.Size+1;
      tw:=cnv.TextWidth(S);
   until Image1.Width < tw;
   cnv.Font.Size:=cnv.Font.Size-1; // you miss it in your sample
   cnv.TextOut(0,0,S);
end;
-----

Igor.
0
 
shenqwCommented:
s=what?

I think you forgot s:=ed_Text.Text
0
 
ITugayCommented:
S:='sample';) It's working sample, I check it before public.
----
Igor.
0
[Webinar] Kill tickets & tabs using PowerShell

Are you tired of cycling through the same browser tabs everyday to close the same repetitive tickets? In this webinar JumpCloud will show how you can leverage RESTful APIs to build your own PowerShell modules to kill tickets & tabs using the PowerShell command Invoke-RestMethod.

 
GambaAuthor Commented:
Thanks, ITugay,
this works o.k., I added the
Height-Part and changed the line
with Font.Size:=Font.Size-1 (see comment). I did not expect it to be
a problem of the missed line!

Do you think, finding the correct Font.Size has to be done iterative
or can it be calculated somehow??

(please add a answer statement and
you will receive the points in any case).




procedure Draw;
var tw,th: integer;
    s     : string;
    cnv   : TCanvas;
    prevsize : word;
    prevw,prevh : integer;
begin
   cnv:=Image.Canvas;
   cnv.Rectangle(0,0,Image.Width,Image.Height);
   cnv.Font.Size:=5;
   prevw:=cnv.TextWidth(s);
   prevh:=cnv.TextHeight(s);
   tw:=prevw;
   th:=prevh;
   s:=ed_Text.Text;
   repeat
     if ((tw<>prevw) or (th<>prevh)) and ((Image.Width >= tw) or (Image.Height >= th))
     then begin
       prevsize:=cnv.Font.Size;
       prevw:=tw;
       prevh:=th;
     end; // if (tw<>prevw) or (th<>prevh)
     cnv.Font.Size:=cnv.Font.Size+1;
     tw:=cnv.TextWidth(s);
     th:=cnv.TextHeight(s);
   until ((Image.Width < tw) or (Image.Height < th));
   cnv.Font.Size:=prevsize;
     (* instead of cnv.Font.Size:=cnv.Font.Size-1, cause cnv.Font.Size-1 has not necessary other
      tw and th *)
   cnv.TextOut(0,0,S);
end;



Gamba


0
 
ITugayCommented:
Ok, just a moment...
0
 
mullet_attackCommented:
If you want an exact fit, use a truetype font. Using the default windows font cause Windows to perform a best-fit calculation of a scaled up/down font.

TextWidth returns the correct width in pixels only for truetype fonts and the pre-defined sizes of system fonts.

ITugay's sample doesn't work properly without a true-type font.
0
 
ITugayCommented:
mulet_attack,
try it at first then make your insennuations.
-----------

Hi Gamba,
Sorry for delay. Calculation of text metrics is very difficult, let TextWidth and TextHeight do it for you. I simplifyed your algorythm, now it look like this:
---------

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
   with Image do with Canvas do
   begin
     Font.Name:='MS Serif'; // not truetype font (for mullet_attack especially)
     Font.Size:=6;
     repeat
        Font.Size:=Font.Size+1;
     until (Width < TextWidth(Ed_text.Text))
        or (Height < TextHeight(Ed_text.Text));
     Font.Size:=Font.Size-1;
     TextOut(0,0,Ed_text.Text);
   end;
end;
----------

Best regards,
Igor.
0
 
GambaAuthor Commented:
Thanks

Gamba
0

Featured Post

2018 Annual Membership Survey

Here at Experts Exchange, we strive to give members the best experience. Help us improve the site by taking this survey today! (Bonus: Be entered to win a great tech prize for participating!)

Tackle projects and never again get stuck behind a technical roadblock.
Join Now