获取屏幕行与TMemo后代中的TStrings行的对应关系

时间:2019-04-25 15:52:27

标签: delphi-10-seattle tmemo

TRichEdit在设置样式时导致过多的访问冲突和弹出菜单中的问题,因此,我尝试制作一个简单的彩色TMemo后代,其中Lines中的每一行都可能是整体上涂有自己的颜色。

我不能影响Windows的编辑控件,但可以在其上绘制字符串。

起初,我尝试遍历Lines属性,但它导致了滚动问题。因此,我决定直接使用Win API从编辑控件中查询字符串。

目前,除了颜色之外,其他所有东西都被涂上了精细的颜色:Windows编辑控件请求的行是屏幕行,而不是LinesWordWrap := True;时来自ScrollBars := ssVertical;属性的行。

如何查找屏幕-> Lines行号对应?

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.

更新

我一直认为TMemo将原始行保留在其Lines集合中,但是实际上,它在添加项目之后就破坏了其Lines。启用自动换行时,添加很长的行会将其转换为几行屏幕。

但是!令人惊讶的是,Windows edit控件在内部将原始行作为控件调整大小的整体。

0 个答案:

没有答案