Get the actual Text RECT in a TMemo

Posted on 2003-12-04
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
  • 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 22

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 22

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

Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

LVL 22

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

Free Tool: Postgres Monitoring System

A PHP and Perl based system to collect and display usage statistics from PostgreSQL databases.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
How to convert memory stream to PDF file 6 103
Delphi and Access based Enumeration 9 70
Tvertscrollbox like a whatsapp layout 5 34
Microsoft Access 97 and Delphi XE2 9 50
The uses clause is one of those things that just tends to grow and grow. Most of the time this is in the main form, as it's from this form that all others are called. If you have a big application (including many forms), the uses clause in the in…
Introduction I have seen many questions in this Delphi topic area where queries in threads are needed or suggested. I know bumped into a similar need. This article will address some of the concepts when dealing with a multithreaded delphi database…
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…
I've attached the XLSM Excel spreadsheet I used in the video and also text files containing the macros used below.…

792 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