Get the actual Text RECT in a TMemo

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

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


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!
LVL 1
prefixAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

prefixAuthor Commented:
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);
Ferruccio AccalaiSenior developer, analyst and customer assistance Commented:
why don't you use a TRichedit instead of a Tmemo?
With proprerties ScrollBars = ssVertical and HidSCrollBars = true it does exactly what you need...
Ferruccio AccalaiSenior developer, analyst and customer assistance Commented:
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;

interface

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

var
  Form1: TForm1;

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

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

function TForm1.MemoLinesShowed(Memo: TMemo): integer;
Var
  Oldfont: HFont;  {the old font}
  DC: THandle;     {Device context handle}
  i: integer;      {loop variable}
  Tm: TTextMetric; {text metric structure}
  TheRect: TRect;
begin
  DC := GetDC(Memo.Handle); {Get the memo's device context}
  try
   {Select the memo's font}
    OldFont := SelectObject(DC, Memo.Font.Handle);
    try
      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);
    finally
      SelectObject(DC, Oldfont); {Select the old font}
    end;
  finally
    ReleaseDC(Memo.Handle, DC); {Release the device context}
  end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
    memo1.Lines.Add('another new line');
end;

end.

This also works if you resize the Tmemo...

F68 ;-)

Microsoft Azure 2017

Azure has a changed a lot since it was originally introduce by adding new services and features. Do you know everything you need to about Azure? This course will teach you about the Azure App Service, monitoring and application insights, DevOps, and Team Services.

Ferruccio AccalaiSenior developer, analyst and customer assistance Commented:
mmm....here -> 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 :)
prefixAuthor Commented:
    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;
var
    // 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;

begin
    // 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
    begin
        lngYdpi := GetDeviceCaps(lngIC, LOGPIXELSY);
        DeleteDC (lngIC);
    end
    else
        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
    else
      italic := 0;

    if (fsUnderline in ctl.Font.Style) then
      underline := 1
    else
      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
    begin
      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);
    end;
    result := rcText;

end;

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
YensidModCommented:
Question has been PAQed and 50 points refunded.

YensidMod
Experts Exchange Moderator
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Fonts Typography

From novice to tech pro — start learning today.