Solved

Get the actual Text RECT in a TMemo

Posted on 2003-12-04
6
1,052 Views
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 !!

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!
0
Comment
Question by:prefix
  • 3
  • 2
6 Comments
 
LVL 1

Author Comment

by:prefix
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);
0
 
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...
0
 
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;

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

0
Announcing the Most Valuable Experts of 2016

MVEs are more concerned with the satisfaction of those they help than with the considerable points they can earn. They are the types of people you feel privileged to call colleagues. Join us in honoring this amazing group of Experts.

 
LVL 22

Expert Comment

by:Ferruccio Accalai
ID: 9881427
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 :)
0
 
LVL 1

Accepted Solution

by:
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;
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;
0
 

Expert Comment

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

YensidMod
Experts Exchange Moderator
0

Featured Post

Gigs: Get Your Project Delivered by an Expert

Select from 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

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…
This Micro Tutorial hows how you can integrate  Mac OSX to a Windows Active Directory Domain. Apple has made it easy to allow users to bind their macs to a windows domain with relative ease. The following video show how to bind OSX Mavericks to …
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…

806 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