Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17


Get the actual Text RECT in a TMemo

Posted on 2003-12-04
Medium Priority
Last Modified: 2013-12-03
Hi all:
    I wanted to get the text in a TMemo control to know if the TMemo needs a scrollbar -- To show scrollbars when it needs and to hide when no need. So I used DrawText to calculate the text's Rect in the memo, but the returned rect was incorrect !!

  rcText                :         TRect;
  hMemoDC               :         HDC;
  hMemoDC := GetDC(memo.Handle);
  DrawText(hMemoDC, PAnsiChar(memo.Text + #0), -1, rcText, DT_CALCRECT + DT_EDITCONTROL);

rcText always smaller than the actual text rect in the memo, I think it's because of each character has a different width, but this API count them by using an average width.

Now, I need the actual rect, how to do? Thank you!
Question by:prefix
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
  • 3
  • 2

Author Comment

ID: 9879519
Oh, this line:

DrawText(hMemoDC, PAnsiChar(memo.Text + #0), -1, rcText, DT_CALCRECT + DT_EDITCONTROL);

it was
DrawText(hMemoDC, PAnsiChar(memo.Text + #0), -1, rcText, DT_CALCRECT);
LVL 23

Expert Comment

by:Ferruccio Accalai
ID: 9881155
why don't you use a TRichedit instead of a Tmemo?
With proprerties ScrollBars = ssVertical and HidSCrollBars = true it does exactly what you need...
LVL 23

Expert Comment

by:Ferruccio Accalai
ID: 9881394
btw, as TMemo have not a Canvas property, you can check the displayed lines number using a Bitmap canvas assigning the same memo font...

Look this example: (put a tmemo and 2 tbutton on a form)

unit Unit1;


  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls;
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Memo1Change(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    { Private declarations }
    function MemoLinesShowed(Memo: TMemo): integer;
    { Public declarations }

  Form1: TForm1;

{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
memo1.Lines.Add('new line');

procedure TForm1.Memo1Change(Sender: TObject);
 if MemoLinesShowed(Memo1) < memo1.Lines.Count then
    Memo1.ScrollBars := ssvertical
    MEmo1.ScrollBars := ssnone;

function TForm1.MemoLinesShowed(Memo: TMemo): integer;
  Oldfont: HFont;  {the old font}
  DC: THandle;     {Device context handle}
  i: integer;      {loop variable}
  Tm: TTextMetric; {text metric structure}
  TheRect: TRect;
  DC := GetDC(Memo.Handle); {Get the memo's device context}
   {Select the memo's font}
    OldFont := SelectObject(DC, Memo.Font.Handle);
      GetTextMetrics(DC, Tm); {Get the text metric info}
      Memo.Perform(EM_GETRECT, 0, longint(@TheRect));
      Result := (TheRect.Bottom - TheRect.Top) div
         (Tm.tmHeight + Tm.tmExternalLeading);
      SelectObject(DC, Oldfont); {Select the old font}
    ReleaseDC(Memo.Handle, DC); {Release the device context}
procedure TForm1.Button2Click(Sender: TObject);
    memo1.Lines.Add('another new line');


This also works if you resize the Tmemo...

F68 ;-)

Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

LVL 23

Expert Comment

by:Ferruccio Accalai
ID: 9881427 -> btw, as TMemo have not a Canvas property, you can check the displayed lines number using a Bitmap canvas assigning the same memo font...
i mean the DC canvas of course...sorry for the typo :)

Accepted Solution

prefix earned 0 total points
ID: 9977075
    Sorry for the delay, my e-mail box was having some problems so it could not receive any notify mails.
    I have solve the problem by myself many days before but I have forgotten to checkout here, your method was similar to mine. But this method always retrieve an incorrect RECT. I have found it was the problem of the font of the text. Using GetObject or any other way to get the textfont always make the RECT incorrect, so I created another font using the same font name and same size and it got correct.
    And you didn't solve the Horizontal scrollbar. But, thank you for being aware of my question. Below is my solution:

function GetMemoTextRect(ctl : TMemo) : TRect;
    // Structure for DrawText calc
    rcText : TRect;
    // Handle to Report's window
    hMemo : HWND;
    // Reports Device Context
    hMemoDC : HDC;
    // Holds the current screen resolution
    lngYdpi : integer;
    newfont : HGDIOBJ;
    // Handle to our Font Object we created.
    // We must destroy it before exiting main function
    oldfont : HGDIOBJ;
    // Device Context's Font we must Select back into the DC
    // before we exit this function.

    // Calculate screen Font height
    fheight : integer;
    // Temporary Information Context for Screen info.
    lngIC : integer;
    // If the font italic and underline
    italic, underline:integer;
    //tm : TTextMetrica;

    // Get Control's Window handle
    hMemo := ctl.Handle;
    If hMemo = 0 Then Exit;
    // retrieve a handle to a display device context (DC)
    // for the client area of the specified window
    hMemoDC := GetDC(hMemo);
    //GetTextMetrics(hMemoDC, tm);

    // Clear our return value
    //lngRet := 0;

    // Modified to allow for different screen resolutions
    // and printer output. Needed to Calculate Font size
    lngIC := CreateIC('DISPLAY', nil, nil, nil);

    if lngIC <> 0 then
        lngYdpi := GetDeviceCaps(lngIC, LOGPIXELSY);
        DeleteDC (lngIC);
        lngYdpi := 120; //Default average value

    // Calculate/Convert requested Font Height
    // into Font's Device Coordinate space
    fheight := MulDiv(ctl.Font.Size, lngYdpi, 72);

    // We use a negative value to signify
    // to the CreateFont function that we want a Glyph
    // outline of this size not a bounding box.

    if (fsItalic in ctl.Font.Style) then
      italic := 1
      italic := 0;

    if (fsUnderline in ctl.Font.Style) then
      underline := 1
      underline := 0;

    //GetObject(ctl.Font.Handle, SizeOf(newfont), @newfont); // Now this is no way

    newfont := CreateFont(-fheight, 0, 0, 0, 400{Use Normal Weight, this is why I always retrieve an incorrect RECT because GetObject retrieved 700 for the weight},
      italic, underline,
      0, 0, 0, 0, 0, 0, PAnsiChar(ctl.Font.Name));

    // Select the new font into our DC.
    oldfont := SelectObject(hMemoDC, newfont);

    // Use DrawText to Calculate height of Rectangle required to hold
    // the current contents of the Control passed to this function
    with rcText do
      Left := 0;
      Top := 0;
      Bottom := 0; //ctl.Height / (TWIPSPERINCH / lngYdpi)
      Right := 0; //ctl.Width / (TWIPSPERINCH / lngYdpi)
      DrawText(hMemoDC, PAnsiChar(ctl.Text) , -1, rcText, DT_CALCRECT);

      // Cleanup
      SelectObject(hMemoDC, oldfont);
      // Delete the Font we created
      DeleteObject (newfont);

      ReleaseDC(hMemo, hMemoDC);
    result := rcText;


Expert Comment

ID: 9978734
Question has been PAQed and 50 points refunded.

Experts Exchange Moderator

Featured Post

Hire Technology Freelancers with Gigs

Work with freelancers specializing in everything from database administration to programming, who have proven themselves as experts in their field. Hire the best, collaborate easily, pay securely, and get projects done right.

Question has a verified solution.

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

Creating an auto free TStringList The TStringList is a basic and frequently used object in Delphi. On many occasions, you may want to create a temporary list, process some items in the list and be done with the list. In such cases, you have to…
Ever visit a website where you spotted a really cool looking Font, yet couldn't figure out which font family it belonged to, or how to get a copy of it for your own use? This article explains the process of doing exactly that, as well as showing how…
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…
If you’ve ever visited a web page and noticed a cool font that you really liked the look of, but couldn’t figure out which font it was so that you could use it for your own work, then this video is for you! In this Micro Tutorial, you'll learn yo…
Suggested Courses

721 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