AutoSize TMemo.Height?

[Avishai]

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]

http://forum.lazarus.freepascal.org/index.php/topic,21305.msg124432.html#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]

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]

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]

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]

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]

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]

1. function QueryTextRect(const Canvas:TCanvas; const aText:String; const aFont:TFont; const MaxRect: TRect):TRect;
2. const
3.   DrawTextFlags = DT_NOPREFIX or DT_EDITCONTROL or DT_CALCRECT;
4. begin
5.   if (Text <> '') then
6.   begin
7.     Canvas.Font := aFont;
8.     Result := MaxRect;
9.     LCLIntf.DrawText(vCanvas.Handle, PChar(aText), Length(aText),  //calculate the text's rectangle required for painting.
10.       Result, DrawTextFlags);
11.   end
12.   else
13.     FillChar(Result, SizeOf(Result), 0);
14. end;

[taazz]

I tried Taaz's solution (from the other thread).

which thread that might be?

[CM630]

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

[taazz]

The thread quoted by Taazz in post 2
http://forum.lazarus.freepascal.org/index.php/topic,21305.msg124432.html#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]

1.   TEvsCompatibleCanvas = class(TCanvas)               //WORKS
2.    public
3.      constructor Create;                            //CreateCompatibleDC -- MAPS TO LCLINTF
4.      destructor Destroy; override;
5.    end;
6. function QueryTextRect(const aText:String; const aFont:TFont; const MaxRect: TRect):TRect;
7. implementation
8. uses lclintf;
9.  
10. function QueryTextRect(const aText:String; const aFont:TFont; const MaxRect: TRect):TRect;
11. const
12.   DrawTextFlags = DT_NOPREFIX or DT_EDITCONTROL or DT_CALCRECT;
13. var
14.   vCnv : TCanvas;
15. begin
16.   vCnv := TEvsCompatibleCanvas.Create;
17.   try
18.     if (Text <> '') then
19.     begin
20.       Canvas.Font := aFont;
21.       Result := MaxRect;
22.       LCLIntf.DrawText(vCanvas.Handle, PChar(aText), Length(aText),  //calculate the text's rectangle required for painting.
23.         Result, DrawTextFlags);
24.     end
25.     else
26.       FillChar(Result, SizeOf(Result), 0);
27.   finally
28.     vCnv.Free
29.   end;
30. end;
31.  
32. {$REGION ' TCompatibleCanvas '}
33. { TEvsCompatibleCanvas }
34. constructor TEvsCompatibleCanvas.Create;
35. begin
36.   inherited Create;
37.   Handle := LCLIntf.CreateCompatibleDC(0);                                      //LCLINTF
38. end;
39.  
40. destructor TEvsCompatibleCanvas.Destroy;
41. var
42.   DC: HDC;
43. begin
44.   DC := Handle;
45.   Handle := 0;
46.   if DC <> 0 then
47.   {$IFDEF LCLWIN32}
48.     DeleteObject(DC);
49.   {$ELSE}
50.     DeleteDC(DC);
51.   {$ENDIF}
52.   inherited Destroy;
53. end;
54. {$ENDREGION}
55.  

Be warned everything was pieced together on the browser no compilation or testing took place.

[CM630]

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]

Code: Pascal  [Select]

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
9.   LCLIntf, LCLType, StdCtrls;
10.  
11. type
12.  
13.   { TForm1 }
14.  
15.   TForm1 = class(TForm)
16.     Button1: TButton;
17.     Button2: TButton;
18.     Memo1: TMemo;
19.     Memo2: TMemo;
20.     procedure Button1Click(Sender: TObject);
21.     procedure Button2Click(Sender: TObject);
22.   private
23.  
24.   public
25.  
26.   end;
27.  
28. var
29.   Form1: TForm1;
30.  
31. implementation
32.  
33. {$R *.lfm}
34. { TForm1 }
35. Function WordWrapHeight(S: String; Ft: TFont; cMaxWidth: Cardinal): Integer;
36.   Var
37.    R  : TRect;
38.    BMP: TBitmap;
39.  Begin
40.   Result:= -1;
41.   R  := Rect(0, 0, cMaxWidth, 0);
42.   BMP:= TBitmap.Create;
43.    Try
44.     BMP.Canvas.Font.Assign(Ft);
45.     Result:= DrawText
46.     (BMP.Canvas.Handle, PChar(S), Length(S), R, dt_CalcRect Or dt_WordBreak);
47.    Finally
48.     BMP.Free;
49.    End;
50.  End;
51.  
52. procedure TForm1.Button1Click(Sender: TObject);
53. var
54.  str: String;
55.  i: Integer;
56. begin
57.   For i:= 1 To 50
58.   Do str:= str+'This Is Some Text '+IntToStr(i);
59.  
60.   Memo2.Text:= str;
61. end;
62.  
63. procedure TForm1.Button2Click(Sender: TObject);
64. begin
65.   If WordWrapHeight(Memo2.Text, Memo1.Font, Memo1.ClientWidth)
66.      < Memo1.ClientHeight
67.   Then Memo1.ScrollBars:= ssNone
68.   Else Memo1.ScrollBars:= ssVertical;
69.  
70.   Memo1.Text:= Memo2.Text;
71. end;
72.  
73. end.

[howardpc]

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]

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, Forms, Controls, Graphics, StdCtrls, LCLIntf, LCLType, Types;
9.  
10. type
11.  
12.   TForm1 = class(TForm)
13.     Button1: TButton;
14.     Memo1: TMemo;
15.     procedure Button1Click(Sender: TObject);
16.   end;
17.  
18.   function WrapAnsiText(Canvas: TCanvas; const Text: String; MaxWidth: Integer): String;
19.  
20.   function GetAnsiTextWrappedMemoHeight(aMemo: TMemo): Integer;
21.  
22. var
23.   Form1: TForm1;
24.  
25. implementation
26.  
27. {$R *.lfm}
28.  
29. function WrapAnsiText(Canvas: TCanvas; const Text: String; MaxWidth: Integer): String;
30. var
31.   DC: HDC;
32.   TextExtent: TSize;
33.   S, P, E: PChar;
34.   Line: String;
35.   IsFirstLine: Boolean;
36. begin
37.   Result := '';
38.   DC := Canvas.Handle;
39.   IsFirstLine := True;
40.   P := PChar(Text);
41.   while P^ = ' ' do
42.     Inc(P);
43.   while P^ <> #0 do
44.   begin
45.     S := P;
46.     E := Nil;
47.     while (P^ <> #0) and (P^ <> #13) and (P^ <> #10) do
48.     begin
49.       GetTextExtentPoint(DC, S, P - S + 1, TextExtent{%H-});
50.       if (TextExtent.CX > MaxWidth) and (E <> Nil) then
51.       begin
52.         if (P^ <> ' ') and (P^ <> ^I) then
53.         begin
54.           while (E >= S) do
55.             case E^ of
56.               '.', ',', ';', '?', '!', '-', ':',
57.               ')', ']', '}', '>', '/', '\', ' ':
58.                 Break;
59.               else
60.                 Dec(E);
61.             end;
62.           if E < S then
63.             E := P - 1;
64.         end;
65.         Break;
66.       end;
67.       E := P;
68.       Inc(P);
69.     end;
70.     if E <> Nil then
71.     begin
72.       while (E >= S) and (P^ = ' ') do
73.         Dec(E);
74.     end;
75.     if E <> Nil then
76.       SetString(Line, S, E - S + 1)
77.     else
78.       SetLength(Line, 0);
79.     if (P^ = #13) or (P^ = #10) then
80.       begin
81.         Inc(P);
82.         if (P^ <> (P - 1)^) and ((P^ = #13) or (P^ = #10)) then
83.           Inc(P);
84.         if P^ = #0 then
85.           Line := Line + LineEnding;
86.       end
87.     else if P^ <> ' ' then
88.       P := E + 1;
89.     while P^ = ' ' do
90.       Inc(P);
91.     if IsFirstLine then
92.     begin
93.       Result := Line;
94.       IsFirstLine := False;
95.     end
96.     else
97.       Result := Result + LineEnding + Line;
98.   end;
99. end;
100.  
101. function GetAnsiTextWrappedMemoHeight(aMemo: TMemo): Integer;
102. const
103.   flags = DT_NOPREFIX or DT_EDITCONTROL or DT_CALCRECT or DT_WORDBREAK;
104. var
105.   wrappedText: String;
106.   pWrap: PChar absolute wrappedText;
107.   cnv: TControlCanvas;
108.   r: TRect;
109. begin
110.   if not Assigned(aMemo) or (aMemo.Text = '') then
111.     Exit(0);
112.   cnv := TControlCanvas.Create;
113.   try
114.     cnv.Control := aMemo;
115.     r := aMemo.ClientRect;
116.     wrappedText := WrapAnsiText(cnv, aMemo.Text, aMemo.Width);
117.     DrawText(cnv.Handle, pWrap, Length(aMemo.Text), r, flags);
118.     Result := r.Height;
119.   finally
120.     cnv.Free;
121.   end;
122. end;
123.  
124. procedure TForm1.Button1Click(Sender: TObject);
125. begin
126.   Memo1.Text := 'afdлкйслакдф йдсалкйфдлксайфдклйдсайлкдасйлкдйклсдалкйдлс,асдфласйдфлксадйфлкдаслдфк асдфклйасдлкдфйклас асдлкфйсадлкфдйсавияуроиевяу асфлкдйлкдфсайдс';
127.   Memo1.Height := GetAnsiTextWrappedMemoHeight(Memo1);
128. end;
129.  
130. end.

[taazz]

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]

Okay, I did:

Code: Pascal  [Select]

1.   Memo1.Text := 'afdлкйслакдф йдсалкйфдлксайфдклйдсайлкдасйлкдйклсдалкйдлс,асдфласйдфлксадйфлкдаслдфк асдфклйасдлкдфйклас асдлкфйсадлкфдйсавияуроиевяу асфлкдйлкдфсайдс';
2.   label1.AutoSize:=true;
3.   label1.WordWrap:=True;
4.   label1.Constraints.MinWidth:=memo1.Width;
5.   label1.Constraints.MaxWidth:=memo1.Width;
6.   label1.caption := 'afdлкйслакдф йдсалкйфдлксайфдклйдсайлкдасйлкдйклсдалкйдлс,асдфласйдфлксадйфлкдаслдфк асдфклйасдлкдфйклас асдлкфйсадлкфдйсавияуроиевяу асфлкдйлкдфсайдс';
7.   Memo1.Height:= Label1.Height;
8.  

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.

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