Lazarus

Programming => LCL => Topic started by: hakahl on September 08, 2014, 08:43:23 pm

Title: TMemo, count lines
Post by: hakahl on September 08, 2014, 08:43:23 pm
Hi!

I'm going crazy over this!

Is there any way to calculate the number of lines that the TMemo component contains _after_ wordwrapping? The memo1.lines.count get the row count before wordwrap.

I want to use this to automagically adjust the height of the TMemo component avoiding scrollbars (so other approaches are also welcome ;)  )

Thanks in advance!

-H
Title: Re: TMemo, count lines
Post by: howardpc on September 09, 2014, 12:14:11 am
Hoepfully there is an easier way than this...
You can create a descendant of TMemo (called TAutoHeightMemo in the following example) and override a few methods.
Start a new Lazarus project, and add an OnCreate handler to the main form. Then paste this into the skeleton main
form unit:

Code: [Select]
unit mainMemoWordwrap;

{$mode objfpc}{$H+}

interface

uses
  Classes, Forms, Controls, Graphics, StdCtrls;

type

  { TAutoHeightMemo }

  TAutoHeightMemo=class(TCustomMemo)
  private
    lineHeight: integer;
    procedure RespondToStringsChange(Sender: TObject);
  protected
    procedure TextChanged; override;
    procedure SetParent(NewParent: TWinControl); override;
  end;

  { TForm1 }

  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    ahm: TAutoHeightMemo;
    btnWordWrap: TButton;
    procedure DoToggleWordwrap(Sender: TObject);
  end;

  procedure Wrap(cnv: TCanvas; AText: PChar; MaxWidthInPixel: integer;
  out Lines: PPChar; out LineCount: integer);

var
  Form1: TForm1;

implementation

uses LCLProc, strutils, sysutils;

{$R *.lfm}

procedure Wrap(cnv: TCanvas; AText: PChar; MaxWidthInPixel: integer; out
  Lines: PPChar; out LineCount: integer);

  function FindLineEnd(LineStart: integer): integer;
  var
    CharLen, LineStop, LineWidth, WordWidth, WordEnd, CharWidth: integer;
  begin
    Result := LineStart;
    while not (AText[Result] in [#0, #10, #13]) do
      Inc(Result);
    if Result <= LineStart + 1 then
      exit;
    lineStop := Result;
    LineWidth := cnv.TextWidth(AText);
    if LineWidth > MaxWidthInPixel then
    begin
      LineWidth := 0;
      WordEnd := LineStart;
      WordWidth := 0;
      repeat
        Result := WordEnd;
        Inc(LineWidth, WordWidth);
        while AText[WordEnd] in [' ', #9] do
          Inc(WordEnd);
        while not (AText[WordEnd] in [#0, ' ', #9, #10, #13]) do
          Inc(WordEnd);
        if wordEnd = Result then break;
        WordWidth := cnv.TextWidth(MidStr(AText, Result, WordEnd - Result));
      until LineWidth + WordWidth > MaxWidthInPixel;
      if LineWidth = 0 then
      begin
        Result := LineStart;
        LineWidth := 0;
        repeat
          charLen := UTF8CharacterLength(@AText[Result]);
          CharWidth := cnv.TextWidth(MidStr(AText, Result, charLen));
          Inc(LineWidth, CharWidth);
          if LineWidth > MaxWidthInPixel then
            break;
          if Result >= lineStop then
            break;
          Inc(Result, charLen);
        until False;
        if Result = LineStart then
        begin
          charLen := UTF8CharacterLength(@AText[Result]);
          Inc(Result, charLen);
        end;
      end;
    end;
  end;

  function IsEmptyText: boolean;
    begin
      if (AText = nil) or (AText[0] = #0) then
      begin
        GetMem(Lines, SizeOf(PChar));
        Lines[0] := nil;
        LineCount := 0;
        Result := True;
      end
      else
        Result := False;
    end;

  var
    LinesList: TFPList;
    LineStart, LineEnd, LineLen: integer;
    ArraySize, TotalSize: integer;
    i: integer;
    CurLineEntry: PPChar;
    CurLineStart: PChar;

  begin
    if IsEmptyText then
    begin
      Lines := nil;
      LineCount := 0;
      exit;
    end;
    LinesList := TFPList.Create;
    LineStart := 0;
    repeat
      LinesList.Add({%H-}Pointer(PtrInt(LineStart)));
      LineEnd := FindLineEnd(LineStart);
      LinesList.Add({%H-}Pointer(PtrInt(LineEnd)));
      LineStart := LineEnd;
      if AText[LineStart] in [#10, #13] then
      begin
        Inc(LineStart);
        if (AText[LineStart] in [#10, #13]) and
          (AText[LineStart] <> AText[LineStart - 1]) then
          Inc(LineStart);
      end
      else if AText[LineStart] in [' ', #9] then
      begin
        while AText[LineStart] in [' ', #9] do
          Inc(LineStart);
      end;
    until AText[LineStart] = #0;
    LineCount := LinesList.Count shr 1;
    ArraySize := (LineCount + 1) * SizeOf(PChar);
    TotalSize := ArraySize;
    i := 0;
    while i < LinesList.Count do
    begin
      LineLen :={%H-}PtrUInt(LinesList[i + 1]) -{%H-}PtrUInt(LinesList[i]) + 1;
      Inc(TotalSize, LineLen);
      Inc(i, 2);
    end;
    GetMem(Lines, TotalSize);
    FillChar(Lines^, TotalSize, 0);
    CurLineEntry := Lines;
    CurLineStart := PChar(CurLineEntry) + ArraySize;
    i := 0;
    while i < LinesList.Count do
    begin
      CurLineEntry[i shr 1] := CurLineStart;
      LineStart := integer({%H-}PtrUInt(LinesList[i]));
      LineEnd := integer({%H-}PtrUInt(LinesList[i + 1]));
      LineLen := LineEnd - LineStart;
      if LineLen > 0 then
        Move(AText[LineStart], CurLineStart^, LineLen);
      Inc(CurLineStart, LineLen);
      CurLineStart^ := #0;
      Inc(CurLineStart);
      Inc(i, 2);
    end;
    CurLineEntry[i shr 1] := nil;
    LinesList.Free;
  end;

{ TForm1 }

procedure TForm1.DoToggleWordwrap(Sender: TObject);
begin
  ahm.WordWrap:=not ahm.WordWrap;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  ahm:=TAutoHeightMemo.Create(Self);
  ahm.Anchors:=[akLeft, akTop];
  ahm.Width:=200;
  ahm.Text:='For everything there is a season, and a time for every matter under heaven: '+
            'a time to be born, and a time to die; a time to plant, and a time to pluck up '+
            'what is planted; a time to kill, and a time to heal; a time to break down, '+
            'and a time to build up; a time to weep, and a time to laugh; a time to mourn, '+
            'and a time to dance; a time to cast away stones, and a time to gather stones '+
            'together; a time to embrace, and a time to refrain from embracing; '+
            'a time to seek, and a time to lose; a time to keep...';
  ahm.Color:=clMoneyGreen;
  ahm.Parent:=Self;

  btnWordWrap:=TButton.Create(Self);
  btnWordWrap.AutoSize:=True;
  btnWordWrap.Caption:='Toggle Wordwrap';
  btnWordWrap.OnClick:=@DoToggleWordwrap;
  btnWordWrap.Top:=10;
  btnWordWrap.Left:=200;
  btnWordWrap.Parent:=Self;
end;

{ TAutoHeightMemo }

procedure TAutoHeightMemo.TextChanged;
begin
  inherited TextChanged;
  if (lineHeight > 0) then
    RespondToStringsChange(nil);
end;

procedure TAutoHeightMemo.RespondToStringsChange(Sender: TObject);
var
  plines: ppchar;
  lineCount: integer;
  bmp: TBitmap;
begin
  if (lineHeight <= 0) then
    Exit;
  bmp:=TBitmap.Create;
  try
    text:=Trim(Text);
    Wrap(bmp.Canvas, PChar(Text), Width, plines, lineCount);
    Height:=lineHeight*lineCount;
  finally
    bmp.Free;
  end;
end;

procedure TAutoHeightMemo.SetParent(NewParent: TWinControl);
var
  bmp: TBitmap;
begin
  inherited SetParent(NewParent);
  bmp:=TBitMap.Create;
  try
    bmp.Canvas.Font.Assign(Self.Font);
    lineHeight:=bmp.Canvas.TextHeight('Ag')+2;
  finally
    bmp.Free;
  end;
end;

end.

Title: Re: TMemo, count lines
Post by: typo on September 09, 2014, 12:28:34 am
@hakahl

So you would like to have a little cosmetic editable window too? An editable window that should contain a few text, but that should work pretty well (no caret/selection problems, for example)?
Title: Re: TMemo, count lines
Post by: engkin on September 09, 2014, 01:19:56 am
Is there any way to calculate the number of lines that the TMemo component contains _after_ wordwrapping?
If you don't mind a Windows only solution, get the number of lines from the edit itself using EM_GETLINECOUNT message.
Title: Re: TMemo, count lines
Post by: typo on September 09, 2014, 01:53:00 am
I think the TMemo is not worth it, at least in Windows.
Title: Re: TMemo, count lines
Post by: engkin on September 09, 2014, 02:18:18 am
I think the TMemo is not worth it, at least in Windows.
Huh? Sounds like you have a better alternative already. Am I right?
Title: Re: TMemo, count lines
Post by: typo on September 09, 2014, 02:32:42 am
Well, I work on it right now. I think about a SynEdit descendant or something similar. But a very small text window.
Title: Re: TMemo, count lines
Post by: engkin on September 09, 2014, 02:53:27 am
It sounds great. Although I'm not sure why "small text window". It gives me the impression that there wont be scroll bars or something.
Title: Re: TMemo, count lines
Post by: typo on September 09, 2014, 02:56:05 am
Maybe yes.
Title: Re: TMemo, count lines
Post by: skalogryz on September 09, 2014, 05:08:13 am
Hoepfully there is an easier way than this...
I think you're referring to LCLIntf.GetTextExtentExPoint() function? The returned Size paremeter is only for a single line, rather than the whole text, but with MaxCount value avaiable it shouldn't be hard to calculate the number of lines for the whole text.
Title: Re: TMemo, count lines
Post by: rvk on September 09, 2014, 10:33:47 am
Something like this should work too:
Code: [Select]
procedure TForm1.Button1Click(Sender: TObject);
var
  Rc1: TRect;
  S: string;
begin

  S := Memo1.Text;
  if (Length(S) > 0) and (S[Length(S)] = #10) then
    S := S + ' ';

  // PostMessage(Memo1.Handle, EM_GETRECT, 0, lparam(@Rc1)); // <-- doesn't work?
  Rc1 := Memo1.ClientRect;
  Canvas.Font := Memo1.Font;

  DrawText(Canvas.Handle, PChar(S), Length(S), Rc1,
    DT_CALCRECT or DT_EDITCONTROL or DT_WORDBREAK or DT_NOPREFIX or
    DT_EXPANDTABS or DT_LEFT);

  Memo1.Height := (Rc1.bottom - Rc1.top) + 10; // <-- just a bit too short ;)

end;
But somehow it's not exactly accurate in my tests.
Maybe because i can't seem to get the proper rectangle result from EM_GETRECT.
Or maybe we need to create a separate Canvas especially for this.
Title: Re: TMemo, count lines
Post by: engkin on September 09, 2014, 04:45:02 pm
@rvk, PostMessage does not wait for the result. Maybe if you replace it with SendMessage?
Title: Re: TMemo, count lines
Post by: rvk on September 09, 2014, 05:18:32 pm
@rvk, PostMessage does not wait for the result. Maybe if you replace it with SendMessage?
Aaaaarghh. I keep mixing those up. (The original code was with Perform)

I adjusted the code and this one works a lot better:
(I used the old .bottom and the new to see how much the Height needs to be adjusted so the original margins are kept. That way there is no need to add 10 for the upper and lower margins)
Code: [Select]
procedure TForm1.Button1Click(Sender: TObject);
var
  Rc1, Rc2: TRect;
  S: string;
begin

  S := Memo1.Text;
  if (Length(S) > 0) and (S[Length(S)] = #10) then
    S := S + ' ';

  SendMessage(Memo1.Handle, EM_GETRECT, 0, lparam(@Rc1));
  Rc2 := Rc1;
  Canvas.Font := Memo1.Font;

  DrawText(Canvas.Handle, PChar(S), Length(S), Rc2,
    DT_CALCRECT or DT_EDITCONTROL or DT_WORDBREAK or DT_NOPREFIX or
    DT_EXPANDTABS or DT_LEFT);

  if (Rc1.bottom <> Rc2.bottom) then
    Memo1.Height := Memo1.Height + (Rc2.bottom - Rc1.bottom);

end;
Title: Re: TMemo, count lines
Post by: hakahl on September 09, 2014, 07:53:50 pm
Thanks for all answers!

@typo: Not necessary for it beeing editable. I thought i was an easy way to display text (will be loaded from a DB): many TMemos on a TScrollbox. My idea is that the user (double)click and the text will be edited in a db-aware popup.

Maybe I should go with a canvas/PaintBox os simliar? I still have a lot of text records loaded from a DB that I want to display in chronological order.

My "plan B" is to load the text in a TRichMemo and keep track of ..caretpos.Y. But that requires me to have an array where I keep track on what DB record starts on what RichMemo row.

-H

Title: Re: TMemo, count lines
Post by: kupferstecher on February 07, 2020, 09:10:03 pm
Sorry for digging out that old topic.

The solution by rvk works fine under Windows, but I also need it under Linux. Any solution there?

Thanks~
Title: Re: TMemo, count lines
Post by: winni on February 07, 2020, 09:57:05 pm
Hi!

Two solutions:

* Disable wordwrap. Now the visible lines and the Stringlist memo.lines go synchronus.

* Set the caret at the last char of the memo.text and ask the memo.caretpos.
Memo.selstart := UTF8Length(memo.text);
Now LineCount := caretpos.y div memo.Font.Height + 1

But anyway: working with Memos is not a good idea.

Winni
Title: Re: TMemo, count lines
Post by: kupferstecher on February 07, 2020, 11:05:55 pm
Hello Winni,

thanks for the advice, I'll try!

"But anyway: working with Memos is not a good idea."
What is a better alternative?
Title: Re: TMemo, count lines
Post by: winni on February 08, 2020, 01:16:17 am
Hi!

I'll try it again with this steamboat forum.

What do you want to do with the Memo?

If it is for a few words an some remarks a Memo is enough - but I would not invest to much enery and code in it to give it real editor functions.

If you are looking for some textengine then I would take the RichMemo component. It's a real richtext editor.

But If you need an editor for coding - then take synedit - the editor from the IDE.

Let's see how many reloads are needed to send this text ........

Winni
Title: Re: TMemo, count lines
Post by: Thaddy on February 08, 2020, 08:48:22 am
Property TForum.Attempts.Count
Title: Re: TMemo, count lines
Post by: rvk on February 08, 2020, 10:35:59 am
* Disable wordwrap. Now the visible lines and the Stringlist memo.lines go synchronus.

* Set the caret at the last char of the memo.text and ask the memo.caretpos.
Memo.selstart := UTF8Length(memo.text);
Now LineCount := caretpos.y div memo.Font.Height + 1
Did you just read the title and made this suggestion?

If you read the complete topic you'll see it's about adjusting the height of the TMemo when the lines are wrapped (autosize). It's not about 'counting lines'.

Now I'm not sure what kupferstecher is after exactly, but (s)he mentioned my snippet worked on Windows. And that snippet has nothing to do with counting lines.

Granted... The question wasn't really that clear so matbe kupferstecher can clarify it.

Title: Re: TMemo, count lines
Post by: kupferstecher on February 08, 2020, 11:06:45 am
Probably its the best I describe in detail what I try to achive:

I made myself a component to modally display forms embedded into the main window. The background of the main form is captured, gray shaded and the embedded form is displayed in the center. That part is already finished and works fine.
The component also should have a functionality like 'ShowMessage', i.e. the message text is centered in the main form. Attached a screenshot how it looks under Windows, as said, there it works with rvk's solution.
So what I need is to know the actual height of the text in the Memo so that I can do the size adjustment and centering.

If I have the (actual) number of lines instead of the height, I can easily calculate the height. But it also has to work when the Memo is not fully extended, but in a scrolling mode because of the limited area.

As you can see, the Memo is in ReadOnly configuration, the user still can mark and copy the text.

Regards~
Title: Re: TMemo, count lines
Post by: rvk on February 08, 2020, 02:43:21 pm
If I have the (actual) number of lines instead of the height, I can easily calculate the height. But it also has to work when the Memo is not fully extended, but in a scrolling mode because of the limited area.
Yes, having the count of lines doesn't work for height if you have wrapped enabled.
You'll need to calculate the height yourself.

My earlier solution only works on Windows because it directly queries the Windows-component for the height.

On Linux/Mac you might have better luck just trying DrawText (on a temporary canvas) and seeing what the drawn size is.

This post does that:
https://forum.lazarus.freepascal.org/index.php?topic=22531.msg283352#msg283352

Another option would be to AdjustSize for a temp component but I'm not sure if that works for wrapped lines. Just try it if the other doesn't work.
https://forum.lazarus.freepascal.org/index.php/topic,22531.msg283593.html#msg283593
Title: Re: TMemo, count lines
Post by: winni on February 08, 2020, 02:46:05 pm
Hi!

I would do it this way:

make Memo invisible
Assign your message to Memo.text
Compute the linecount with caret.position as shown above
Resize the Memo height to your needs
Enable scrolling if necessary
make Memo visble

Winni
Title: Re: TMemo, count lines
Post by: kupferstecher on February 09, 2020, 11:36:04 am
It finally works!

On Linux/Mac you might have better luck just trying DrawText (on a temporary canvas) and seeing what the drawn size is.
In your link there was a link to this topic:
https://forum.lazarus.freepascal.org/index.php/topic,21305.msg124432.html#msg124432

In the DrawText-options I needed to set DT_WORDBREAK, otherwise it wouldn't wordwrap a single line.

This is my code, I tested and it works under Windows, Linux/gtk2 and Linux/qt4.

Code: Pascal  [Select][+][-]
  1. function TEmbeddedModalFormManager.GetMemoHeight(AMemo: TMemo): Integer;
  2. var
  3.   aText: string;
  4.   vRect: TRect;
  5.   vFont: TFont;
  6. const
  7.   DrawTextFlags = DT_NOPREFIX or DT_EDITCONTROL or DT_CALCRECT or DT_WORDBREAK;
  8. begin
  9.   Result:= 1;
  10.   aText:= AMemo.Text;
  11.   if (aText = '') then EXIT;
  12.   if aMemo.Width < 10 then EXIT;
  13.  
  14.   vFont:= self.Canvas.Font;
  15.   self.Canvas.Font := AMemo.Font;
  16.   vRect:= Rect(0,0,AMemo.Width,self.Height);
  17.  
  18.   LCLIntf.DrawText(self.Canvas.Handle, PChar(aText), Length(aText),vRect, DrawTextFlags);
  19.  
  20.   self.Canvas.Font:= vFont;
  21.   Result:= vRect.Height;
  22.  
  23. end;

--
Before, I also tested winni's suggestion, under Windows it works.  (The caret.position is returning the line, not the pixel position, but the height can be calculated).
Under Linux/gtk2 a call to caret.position returns an error (missing handle), so it's not usable. (Should I file a bug report?)

rvk, winni: Thank You!
Title: Re: TMemo, count lines
Post by: lazdeveloper on April 14, 2020, 08:14:28 pm
Hi all,
I have stuck in a same problem but for a different purpose.
I have two Memos say M1 and M2. The M1 will have the name and address as one line fed to it. while M2 will correspond the name in M1 with the price.
The width of M1 is more than M2 since M1 will have text while M2 just a number
I want to show the name in the first memo and the price in the second memo. If the text in the M1 is more than one lines I have to manually fill M2 with empty lines so that both memos can
Start new row equally.
Since M1 is wordwarpped I cannot know how many lines are shown there that have to be applied to M2
Unfortunately  (lines.count) is not the property that helps in this.
Any help?
Title: Re: TMemo, count lines
Post by: winni on April 14, 2020, 10:10:47 pm
Hi!

Solution 1: Turn wordwrap of and activate the horizontal scrolling for the memos

Solution 2: Replace the Memos with Listboxes.

Winni
Title: Re: TMemo, count lines
Post by: lucamar on April 14, 2020, 10:18:13 pm
Solution 3: Use a TStringGrid instead of memos; it's tailor-made for that kind of situations :)
Title: Re: TMemo, count lines
Post by: jamie on April 14, 2020, 11:59:28 pm
You can't do screen line counting with a Tmemo and get a reliable results , at least not in windows because windows does not really care what you are seeing on the screen, all it does is maintains accurate values for number of lines in a buffer..

  If you are in windows there are messages you can send to the memo to get all the info you need..
Title: Re: TMemo, count lines
Post by: lazdeveloper on April 15, 2020, 12:50:17 am
Many thanks for the replies.
I have to use memo since this is a report and the Memo is the report component.
The report is fortes CE report available via OPM.
I have like max of four different length text for M1 and corresponding number for M2 something like
MEMO1        | MEMO2|
name            |  number|
Tony Smith  |  233       |
and Jones   |                |
William.        |               |
Sara Anagn  |  444      |
Niven.           |               |

I can't use StringGrid since I am limited to the report component

Thanks
Title: Re: TMemo, count lines
Post by: jamie on April 15, 2020, 01:40:10 am
That's pretty cruddy looking   :o

 have you tried inserting tab character characters after each group ?

 That would be the value #9 in the text...

 For example:

    'A Word or Line'+#9+' |'+#9+'Another Word' etc...
Title: Re: TMemo, count lines
Post by: lazdeveloper on April 15, 2020, 03:25:07 pm
Oh no..
This is a quick way to show what I am doing in report
The "|" is just there to represent memo borders.
No special characters at all.
Consider yourself looking at two Memos next to each others.
I hope its clear now
TinyPortal © 2005-2018