AutoSize TMemo.Height?
lazarus / 31-LCL

----------------------------------------------------------------------
Avishai · 2013-11-04 06:19

Does someone know how to AutoSize the height of TMemo so that it
displays all Lines?  I've tried several calculations but none of them
seem to work.  I'm trying to avoid showing the scrollbars.

----------------------------------------------------------------------
taazz · 2013-11-04 08:20

http://forum.lazarus.freepascal.org/index.php/topic,21305.msg124432.ht
ml#msg124432 the link provided has a sample that calculates the lines
for a multiline grid along with word wrap to show the complete data of
a memo field regardless the size of the column. You should be able to
adapt it to your needs.

----------------------------------------------------------------------
Avishai · 2013-11-04 09:13

Thanks Taazz.  I'll look at it and see if I can use it some way.

In the meantime, I think I may have found at least part of the
solution.

Code: [Select]procedure TForm1.BitBtn3Click(Sender: TObject);
var
  c: TBitmap;
begin
  c := TBitmap.Create;
  try
    c.Canvas.Font.Assign(Memo1.Font);
    Edit2.Caption := IntToStr(c.Canvas.TextHeight('My String'));
  finally
    c.Free;
  end;
end;

For the font I'm using this returns 16 and the line spacing of the
TMemo is 17 so I think I can get what I need from this.

----------------------------------------------------------------------
Avishai · 2013-11-04 14:00

OK, this is what I have come up with and it seems to work.

Code: [Select]function GetTextHeight(ACtrl: TControl): Integer;
var
  C: TBitMap;
begin
  Result:= -1;
  C := TBitmap.Create;
  try
    C.Canvas.Font.Assign(ACtrl.Font);
    Result:= C.Canvas.TextHeight('TextHeight');
  finally
    C.Free;
  end;
end;

procedure TForm1.BitBtn3Click(Sender: TObject);
var
  H: Integer;
begin
  H:= GetTextHeight(Memo1);
  If H>-1 then
    Memo1.Height:= (H*Memo1.Lines.Count)+H div 2;
end;

----------------------------------------------------------------------
engkin · 2013-11-04 17:45

Avishai, nice solution. I can still see one problem, in long lines
words wrap and that will add extra visible lines that
Memo1.Lines.Count does *NOT* count for. I believe taazz has already
produced a solution, DT_CALC is meant to do that math for you. Did you
see his solution?

----------------------------------------------------------------------
Avishai · 2013-11-04 17:57

engkin, what I am seeing is that Lines.Count does see word wrap, but I
think I should give more info.  This is a read-only TMemo that
displays predefined text.  TabStop is set False, but the user can
select all or part of the text and copy it.

----------------------------------------------------------------------
CM630 · 2018-04-17 10:04

I tried Taazz's solution (from the other thread).
Sample project won't compile.
Provided function (below) requires Canvas as a parameter, but TMemo
does not have a (visible) Canvas property.
Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i function
QueryTextRect(const Canvas:TCanvas; const aText:String; const
aFont:TFont; const MaxRect: TRect):TRect;const  DrawTextFlags =
DT_NOPREFIX or DT_EDITCONTROL or DT_CALCRECT;begin  if (Text <> '')
then  begin    Canvas.Font := aFont;    Result := MaxRect;   
LCLIntf.DrawText(vCanvas.Handle, PChar(aText), Length(aText),
 //calculate the text's rectangle required for painting.      Result,
DrawTextFlags);  end  else    FillChar(Result, SizeOf(Result), 0);end;

----------------------------------------------------------------------
taazz · 2018-04-17 10:25

Quote from: CM630 on April 17, 2018, 12:04:24 pmI tried Taaz's
solution (from the other thread).


which thread that might be?

----------------------------------------------------------------------
CM630 · 2018-04-17 10:59

The thread quoted by Taazz in post 2
http://forum.lazarus.freepascal.org/index.php/topic,21305.msg124432.ht
ml#msg124432
Maybe I should have said „topic‟.

----------------------------------------------------------------------
taazz · 2018-04-17 11:18

Quote from: CM630 on April 17, 2018, 12:59:59 pmThe thread quoted by
Taazz in post 2
http://forum.lazarus.freepascal.org/index.php/topic,21305.msg124432.ht
ml#msg124432
Maybe I should have said „topic‟.
oops  missed it. well if there is no canvas just create one here is a
custom canvas that needs no controls used internally by simplegraph
with the approprietly redefined function.
Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i  
TEvsCompatibleCanvas = class(TCanvas)               //WORKS   public 
  constructor Create;                            //CreateCompatibleDC
-- MAPS TO LCLINTF     destructor Destroy; override;   end;function
QueryTextRect(const aText:String; const aFont:TFont; const MaxRect:
TRect):TRect;implementationuses lclintf; function QueryTextRect(const
aText:String; const aFont:TFont; const MaxRect: TRect):TRect;const 
DrawTextFlags = DT_NOPREFIX or DT_EDITCONTROL or DT_CALCRECT;var  vCnv
: TCanvas;begin  vCnv := TEvsCompatibleCanvas.Create;  try    if (Text
<> '') then    begin      Canvas.Font := aFont;      Result :=
MaxRect;      LCLIntf.DrawText(vCanvas.Handle, PChar(aText),
Length(aText),  //calculate the text's rectangle required for
painting.        Result, DrawTextFlags);    end    else     
FillChar(Result, SizeOf(Result), 0);  finally    vCnv.Free 
end;end; {$REGION ' TCompatibleCanvas '}{ TEvsCompatibleCanvas
}constructor TEvsCompatibleCanvas.Create;begin  inherited Create; 
Handle := LCLIntf.CreateCompatibleDC(0);                             
       //LCLINTFend; destructor TEvsCompatibleCanvas.Destroy;var  DC:
HDC;begin  DC := Handle;  Handle := 0;  if DC <> 0 then  {$IFDEF
LCLWIN32}    DeleteObject(DC);  {$ELSE}    DeleteDC(DC);  {$ENDIF} 
inherited Destroy;end;{$ENDREGION} 
Be warned everything was pieced together on the browser no compilation
or testing took place.

----------------------------------------------------------------------
CM630 · 2018-04-17 13:03

I have fixed some issues and tried.
It does not work, but I think it should not- I suppose in order to
works I have to set width of the canvas somehow, but it is not
settable.
I have attached the sample.

----------------------------------------------------------------------
RAW · 2018-04-17 15:02

Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i unit
Unit1; {$mode objfpc}{$H+} interface uses  Classes, SysUtils,
FileUtil, Forms, Controls, Graphics, Dialogs,  LCLIntf, LCLType,
StdCtrls; type   { TForm1 }   TForm1 = class(TForm)    Button1:
TButton;    Button2: TButton;    Memo1: TMemo;    Memo2: TMemo;   
procedure Button1Click(Sender: TObject);    procedure
Button2Click(Sender: TObject);  private   public   end; var  Form1:
TForm1; implementation {$R *.lfm}{ TForm1 }Function WordWrapHeight(S:
String; Ft: TFont; cMaxWidth: Cardinal): Integer;  Var   R  : TRect; 
 BMP: TBitmap; Begin  Result:= -1;  R  := Rect(0, 0, cMaxWidth, 0); 
BMP:= TBitmap.Create;   Try    BMP.Canvas.Font.Assign(Ft);    Result:=
DrawText    (BMP.Canvas.Handle, PChar(S), Length(S), R, dt_CalcRect Or
dt_WordBreak);   Finally    BMP.Free;   End; End; procedure
TForm1.Button1Click(Sender: TObject);var str: String; i:
Integer;begin  For i:= 1 To 50  Do str:= str+'This Is Some Text
'+IntToStr(i);   Memo2.Text:= str;end; procedure
TForm1.Button2Click(Sender: TObject);begin  If
WordWrapHeight(Memo2.Text, Memo1.Font, Memo1.ClientWidth)     <
Memo1.ClientHeight  Then Memo1.ScrollBars:= ssNone  Else
Memo1.ScrollBars:= ssVertical;   Memo1.Text:= Memo2.Text;end; end.

----------------------------------------------------------------------
howardpc · 2018-04-17 15:26

As engkin pointed out in the thread referenced earlier, to
successfully calculate the required height of a memo with wrapped text
requires some way of emulating the widgetset wrapping, in order to
know how many visible lines are present.
The following uses a routine taazz provided long ago. Unfortunately it
works well only for ANSI text, and does not do so well with the
Bulgarian text CM630 wants to use. So I have copied it and renamed it
to make clear its limitations.
However, what follows is a start.
There are plenty of forum users who have the skill to write a fully
utf8-aware wrapping emulation routine.

Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i unit
Unit1; {$mode objfpc}{$H+} interface uses  Classes, Forms, Controls,
Graphics, StdCtrls, LCLIntf, LCLType, Types; type   TForm1 =
class(TForm)    Button1: TButton;    Memo1: TMemo;    procedure
Button1Click(Sender: TObject);  end;   function WrapAnsiText(Canvas:
TCanvas; const Text: String; MaxWidth: Integer): String;   function
GetAnsiTextWrappedMemoHeight(aMemo: TMemo): Integer; var  Form1:
TForm1; implementation {$R *.lfm} function WrapAnsiText(Canvas:
TCanvas; const Text: String; MaxWidth: Integer): String;var  DC: HDC; 
TextExtent: TSize;  S, P, E: PChar;  Line: String;  IsFirstLine:
Boolean;begin  Result := '';  DC := Canvas.Handle;  IsFirstLine :=
True;  P := PChar(Text);  while P^ = ' ' do    Inc(P);  while P^ <> #0
do  begin    S := P;    E := Nil;    while (P^ <> #0) and (P^ <> #13)
and (P^ <> #10) do    begin      GetTextExtentPoint(DC, S, P - S + 1,
TextExtent{%H-});      if (TextExtent.CX > MaxWidth) and (E <> Nil)
then      begin        if (P^ <> ' ') and (P^ <> ^I) then       
begin          while (E >= S) do            case E^ of             
'.', ',', ';', '?', '!', '-', ':',              ')', ']', '}', '>',
'/', '\', ' ':                Break;              else               
Dec(E);            end;          if E < S then            E := P - 1; 
      end;        Break;      end;      E := P;      Inc(P);    end; 
 if E <> Nil then    begin      while (E >= S) and (P^ = ' ') do     
 Dec(E);    end;    if E <> Nil then      SetString(Line, S, E - S +
1)    else      SetLength(Line, 0);    if (P^ = #13) or (P^ = #10)
then      begin        Inc(P);        if (P^ <> (P - 1)^) and ((P^ =
#13) or (P^ = #10)) then          Inc(P);        if P^ = #0 then     
   Line := Line + LineEnding;      end    else if P^ <> ' ' then     
P := E + 1;    while P^ = ' ' do      Inc(P);    if IsFirstLine then 
 begin      Result := Line;      IsFirstLine := False;    end    else 
    Result := Result + LineEnding + Line;  end;end; function
GetAnsiTextWrappedMemoHeight(aMemo: TMemo): Integer;const  flags =
DT_NOPREFIX or DT_EDITCONTROL or DT_CALCRECT or DT_WORDBREAK;var 
wrappedText: String;  pWrap: PChar absolute wrappedText;  cnv:
TControlCanvas;  r: TRect;begin  if not Assigned(aMemo) or (aMemo.Text
= '') then    Exit(0);  cnv := TControlCanvas.Create;  try   
cnv.Control := aMemo;    r := aMemo.ClientRect;    wrappedText :=
WrapAnsiText(cnv, aMemo.Text, aMemo.Width);    DrawText(cnv.Handle,
pWrap, Length(aMemo.Text), r, flags);    Result := r.Height;  finally 
  cnv.Free;  end;end; procedure TForm1.Button1Click(Sender:
TObject);begin  Memo1.Text := 'afdлкйслакдф йдсалкйфдлксайфдклйдсайлкд
асйлкдйклсдалкйдлс,асдфласйдфлксадйфлкдаслдфк асдфклйасдлкдфйклас
асдлкфйсадлкфдйсавияуроиевяу асфлкдйлкдфсайдс';  Memo1.Height :=
GetAnsiTextWrappedMemoHeight(Memo1);end; end.

----------------------------------------------------------------------
taazz · 2018-04-17 19:39

OK, here is my quick and dirty solution. Add a label behind the memo,
set its wrap and autosize property to true, make sure it has the same
width and font as the memo, now set the label's caption to the memo's
text and resize the memo to cover the label. Easy fast and no need to
waste time with the pesky utf8 strings, or you could look up how the
label does it. well I did my duty posted my 5 seconds wisdom back
under my rock now

----------------------------------------------------------------------
CM630 · 2018-04-18 06:05

Okay, I did:
Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i  
Memo1.Text := 'afdлкйслакдф йдсалкйфдлксайфдклйдсайлкдасйлкдйклсдалкйд
лс,асдфласйдфлксадйфлкдаслдфк асдфклйасдлкдфйклас
асдлкфйсадлкфдйсавияуроиевяу асфлкдйлкдфсайдс'; 
label1.AutoSize:=true;  label1.WordWrap:=True; 
label1.Constraints.MinWidth:=memo1.Width; 
label1.Constraints.MaxWidth:=memo1.Width;  label1.caption :=
'afdлкйслакдф йдсалкйфдлксайфдклйдсайлкдасйлкдйклсдалкйдлс,асдфласйдфл
ксадйфлкдаслдфк асдфклйасдлкдфйклас асдлкфйсадлкфдйсавияуроиевяу
асфлкдйлкдфсайдс';  Memo1.Height:= Label1.Height; 
Guess if it works?
No

1. There seems to be a bug in both TLabel and TMemo:
None of them wraps on the comma in „йдсалкйфдлксайфдклйдсайлкдасйлкдйк
лсдалкйдлс,асдфласйдфлксадйфлкдаслдфк‟.
2. TLabel does not wrap „йдсалкйфдлксайфдклйдсайлкдасйлкдйклсдалкйдлс,
асдфласйдфлксадйфлкдаслдфк‟ at all, while TMemo does, when it comes to
the end of the line.

Such long strings are likely to happen in file paths, so this case is
not ignorable.
Maybe I could force additional wrappping for long words in TLabel (add
a CrLf when widths exceeds characters). I should better look in
TLabels code...

Just for the record, this is not Bulgarian, but just some randomly
typed Cyrillic letters  

Still, I have not tried or checked @RAW's code.

Quote from: taazz on April 17, 2018, 09:39:57 pm...or you could look
up how the label does it...
Probably no need to look- it wraps first and then counts the lines and
resizes. Should be pretty simple, when done internally.

BUT, I still cannot find in the source of LCL the word wrap routines
used by TMemo.

----------------------------------------------------------------------
ASerge · 2018-04-19 18:38

Quote from: Avishai on November 04, 2013, 07:19:36 amDoes someone know
how to AutoSize the height of TMemo so that it displays all Lines? 
I've tried several calculations but none of them seem to work.  I'm
trying to avoid showing the scrollbars.
I have this function works:
Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i procedure
ChangeMemoHeightToFitLines(Memo: TMemo);var  TestMemo: TMemo;begin 
TestMemo := TMemo.Create(nil);  try    TestMemo.Parent :=
Memo.Parent;    TestMemo.Width := Memo.Width;   
TestMemo.Font.Assign(Memo.Font);    TestMemo.Text := Memo.Text;   
TestMemo.AdjustSize;    if TestMemo.Height > Memo.Height then     
Memo.Height := TestMemo.Height;  finally    TestMemo.Free;  end;end;

----------------------------------------------------------------------
laz_one_or2 · 2026-03-15 08:51

Aserge, your solution works.
i try in all directions  with adjustsize, without success.
Thanks

----------------------------------------------------------------------
wp · 2026-03-15 16:55

Quote from: CM630 on April 18, 2018, 08:05:50 am1. There seems to be a
bug in both TLabel and TMemo:
None of them wraps on the comma in „йдсалкйфдлксайфдклйдсайлкдасйлкдйк
лсдалкйдлс,асдфласйдфлксадйфлкдаслдфк‟.
No. Add a space after the comma, and the word-wrap will work. Without
the space it won't even wrap with purely ASCII characters.