Get correspondence of screen line to TStrings line in TMemo descendant

Question

TRichEdit is causing too much access violations and issues in popup menu when styles are set, therefore I am trying to make a simple colorful TMemo descendant where each line from Lines could be painted with its own color as a whole.

I cannot influence the edit control from Windows, but can paint strings over it.

At first I tried to iterate through Lines property, but it caused problems with scrolling. So I decided to query strings from edit control directly using Win API.

For now everything is painted fine except colors: The lines requested from Windows edit control are the screen lines, not the lines from Lines property when WordWrap := True; and ScrollBars := ssVertical;.

How to find out the screen -> Lines line number correspondence?

unit ColoredEditMain;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  TMyMemo = class(TMemo)
  private
    procedure WMPaint(var msg: TWMPaint); message WM_PAINT;
  end;

  TForm1 = class(TForm)
  private
    _memo: TMyMemo;
  public
    constructor Create(AOwner: TComponent); override;
  end;

var
  Form1: TForm1;

implementation

uses
  Vcl.Themes;

{$R *.dfm}

{ TMyMemo }

procedure TMyMemo.WMPaint(var msg: TWMPaint);
var
  Buffer: Pointer;
  PS: TPaintStruct;
  DC: HDC;
  i: Integer;
  X, Y: Integer;
  OldColor: LongInt;
  firstLineIdx: Integer;
  charsCopied, lineCount: Integer;
  lineLength: Word;
  bufLength: Integer;
begin
  try
  DC := msg.DC;
  if DC = 0 then
    DC := BeginPaint(Handle, PS);
  try
    X := 5;
    Y := 1;
    SetBkColor(DC, Color);
    SetBkMode(DC, Transparent);
    OldColor := Font.Color;
    firstLineIdx := SendMessage(Handle, EM_GETFIRSTVISIBLELINE, 0, 0);
    lineCount := SendMessage(Handle, EM_GETLINECOUNT, 0, 0);
    for i:=firstLineIdx to lineCount-1 do begin
      SelectObject(DC, Font.Handle);
      if odd(i) then
        SetTextColor(DC, clRed)
      else
        SetTextColor(DC, OldColor);
      lineLength := SendMessage(Handle, EM_LINELENGTH, WPARAM(i), 0);
      bufLength := lineLength*2 + 2;
      GetMem(Buffer, bufLength);
      try
        ZeroMemory(Buffer, bufLength);
        PWord(Buffer)^ := lineLength;
        charsCopied := SendMessage(Handle, EM_GETLINE, WPARAM(i), LPARAM(Buffer));
        //ShowMessage(IntToStr(lineLength) + ' ' + IntToStr(charsCopied) + '=' + Strpas(PWideChar(Buffer)));
        if Y > ClientHeight then Exit();
        TextOut(DC, X, Y, PWideChar(Buffer), lineLength);
      finally
        FreeMem(Buffer, bufLength);
      end;
      Inc(Y, Abs(Font.Height) + 2);
    end;
  finally
    if msg.DC = 0 then
      EndPaint(Handle, PS);
  end;
  except
    on ex: Exception do MessageBox(Handle, PWideChar('WMPaint: ' + ex.Message), nil, MB_ICONERROR);
  end;
end;

{ TForm1 }

constructor TForm1.Create(AOwner: TComponent);
var
  i, j: Integer;
  txt: string;
begin
  inherited;
  Left := 5;
  Top := 5;
  _memo := TMyMemo.Create(Self);
  _memo.Parent := Self;
  _memo.Align := alClient;
  _memo.WordWrap := True;
  _memo.ReadOnly := True;
  _memo.ScrollBars := ssVertical;

  for i := 0 to 10 do begin
    txt := '';
    for j := 0 to 100 do
      txt := txt + 'Line ' + IntToStr(i) + '.' + IntToStr(j) + ' ';
    _memo.Lines.Add(txt);
  end;
end;

end.

Update

I always thought that TMemo keeps original lines in its Lines collection, but in fact it spoils its Lines just after adding an item. When Word wrapping is on, adding a really long line converts it to several screen lines.

BUT! Surprisingly Windows edit control internally keeps the original lines as a whole on control resize.