0

TRichEdit设置样式时会在弹出菜单中造成过多的访问冲突和问题,因此我正在尝试制作一个简单的彩色TMemo后代,其中每一行都Lines可以用自己的颜色作为一个整体进行绘制。

我无法从 Windows 影响编辑控件,但可以在其上绘制字符串。

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

现在除了颜色之外,一切都画得很好:从 Windows 编辑控件请求的行是屏幕行,而不是Lines属性 whenWordWrap := 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只是在添加一个项目后就破坏了它。当自动换行打开时,添加一个非常长的行会将其转换为多个屏幕行。

但!令人惊讶的是,Windowsedit控件内部在控件调整大小时将原始行保持为一个整体。

4

0 回答 0