Question

我正在尝试构建一个能够显示错误的简单脚本编辑器。我在网上搜索了一个可以为我显示/下划线错误的组件，但我找不到一个。所以我决定根据Delphi中包含的备忘录控件自己构建一个。

我打算在备忘录控件中添加以下功能：

function Underline(startline, startchar, endline, endchar : integer);

这是我第一次加强像这样的视觉控制，我问是否有人可以概括地告诉我如何做到这一点。无需详细说明：）

ps：我不想使用richedit控件。

Answer 1

Delphi中的“默认备忘录控件”只是Windows标准文本框控件的包装器。因此，无法在此控件中实现自定义行为。（如果你需要真正的自定义行为，你总是可以从头开始编写自己的文本框控件。我在我的text editor中也这样做了，它也支持语法高亮。或者，你可以使用第三方控件。有很多用于Delphi的高级文本编辑器控件。）当涉及到这个控件时，你只能使用操作系统提供的功能。

您应该使用TRichEdit代替。这是标准Windows Rich Edit控件的包装器，它支持下划线等格式。（而且，它还支持Delphi包装器未提供的许多其他内容，例如自动URL突出显示等，但这是另一个故事。）

Answer 2

下面是一些使用常规winapi的D2007代码示例，它将向您展示如何在可滚动的备忘录中找到绘制位置以及如何绘制简单的下划线。为简洁起见，它没有错误捕获/处理。还只允许一个下划线范围，因为作为组件的可用性不是样本的目的。尝试使用垂直滚动备忘录，但如果您愿意，如果出现问题，您应该能够微调细节。

在2K，XP和7上测试过，XP的外观如下：

memo with underlined text http://img687.imageshack.us/img687/8176/20101210061602.png

代码：

type
  TMemo = class(stdctrls.TMemo)
  private
    FStartChar, FEndChar: Integer;
    procedure WMPaint(var Msg: TWMPaint); message WM_PAINT;
  public
    procedure Underline(StartLine, StartChar, EndLine, EndChar: Integer);
  end;

  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TMemo }

procedure TMemo.Underline(StartLine, StartChar, EndLine, EndChar: Integer);
begin
  FStartChar := SendMessage(Handle, EM_LINEINDEX, StartLine, 0) + StartChar;
  FEndChar := SendMessage(Handle, EM_LINEINDEX, EndLine, 0) + EndChar;
  Invalidate;
end;

procedure TMemo.WMPaint(var Msg: TWMPaint);

  function GetLine(CharPos: Integer): Integer;
  begin
    Result := SendMessage(Handle, EM_LINEFROMCHAR, CharPos, 0);
  end;

  procedure DrawLine(First, Last: Integer);
  var
    LineHeight: Integer;
    Pt1, Pt2: TSmallPoint;
    DC: HDC;
    Rect: TRect;
    ClipRgn: HRGN;
  begin
    // font height approximation (compensate 1px for internal leading)
    LineHeight := Abs(Font.Height) - Abs(Font.Height) div Font.Height;

    // get logical top-left coordinates for line bound characters
    Integer(Pt1) := SendMessage(Handle, EM_POSFROMCHAR, First, 0);
    Integer(Pt2) := SendMessage(Handle, EM_POSFROMCHAR, Last, 0);

    DC := GetDC(Handle);

    // clip to not to draw to non-text area (internal margins)
    SendMessage(Handle, EM_GETRECT, 0, Integer(@Rect));
    ClipRgn := CreateRectRgn(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom);
    SelectClipRgn(DC, ClipRgn);
    DeleteObject(ClipRgn); // done with region

    // set pen color to red and draw line
    SelectObject(DC, GetStockObject(DC_PEN));
    SetDCPenColor(DC, RGB(255, 0 ,0));
    MoveToEx(DC, Pt1.x, Pt1.y + LineHeight, nil);
    LineTo(DC, Pt2.x, Pt2.y + LineHeight);

    ReleaseDC(Handle, DC); // done with dc
  end;

var
  StartChar, CharPos, LinePos: Integer;
begin
  inherited;
  if FEndChar > FStartChar then begin

    // Find out where to draw.
    // Can probably optimized a bit by using EM_LINELENGTH
    StartChar := FStartChar;
    CharPos := StartChar;
    LinePos := GetLine(CharPos);
    while True do begin
      Inc(CharPos);
      if GetLine(CharPos) > LinePos then begin
        DrawLine(StartChar, CharPos - 1);
        StartChar := CharPos;
        Dec(CharPos);
        Inc(LinePos);
        Continue;
      end else
        if CharPos >= FEndChar then begin
          DrawLine(StartChar, FEndChar);
          Break;
        end;
    end;
  end;
end;

{  --end TMemo-- }

procedure TForm1.Button1Click(Sender: TObject);
begin
  Memo1.Underline(7, 14, 8, 17);
end;

编辑：忘记提及，在输入时你可能会删除下划线。我不知道打字时应该怎么做，可能很难达到预期的行为。

如何增强Delphi中的默认备忘录控件，并能够为文本加下划线

2 个答案: