Solved

Get the actual Text RECT in a TMemo

Posted on 2003-12-04
6
1,056 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
[X]
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
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
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
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

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

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

Have you ever had your Delphi form/application just hanging while waiting for data to load? This is the article to read if you want to learn some things about adding threads for data loading in the background. First, I'll setup a general applica…
In my programming career I have only very rarely run into situations where operator overloading would be of any use in my work.  Normally those situations involved math with either overly large numbers (hundreds of thousands of digits or accuracy re…
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…

752 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