TMemo, count lines

[hakahl]

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

[howardpc]

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.


[typo]

@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)?

[engkin]

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.

[typo]

I think the TMemo is not worth it, at least in Windows.

[engkin]

I think the TMemo is not worth it, at least in Windows.

Huh? Sounds like you have a better alternative already. Am I right?

[typo]

Well, I work on it right now. I think about a SynEdit descendant or something similar. But a very small text window.

[engkin]

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.

[typo]

Maybe yes.

[skalogryz]

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.

[rvk]

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.

[engkin]

@rvk, PostMessage does not wait for the result. Maybe if you replace it with SendMessage?

[rvk]

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


[hakahl]

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

[kupferstecher]

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~