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

Question

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

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

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

这是我第一次加强像这样的视觉控制,我问是否有人可以大致勾勒出如何做到这一点.无需深入了解具体细节:)

ps:我不想使用richedit控件.

Answer 1

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

在2K,XP和7上测试,XP上的外观如下:

带下划线文本的备忘录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;

编辑:忘记提及,在键入时你可能会删除下划线.我不知道它在键入时应该如何表现,并且可能很难实现所期望的行为.

Answer 2

Delphi中的"默认备忘录控件"只是Windows标准文本框控件的包装器.因此,无法在此控件中实现自定义行为.(如果你确实需要自定义行为,你总是可以从头开始编写自己的文本框控件.我在做这样的文本编辑器,同时也支持语法高亮.或者,你可以使用一个第三方的控制.有很多德尔福先进的文本编辑器控件在那里.)当谈到这个控制只能使用操作系统提供的功能.

你应该真的使用一个TRichEdit.这是标准Windows Rich Edit控件的包装器,它支持下划线等格式.(而且,它也支持很多不是由德尔福的包装,如自动URL高亮,除其他事项提出其他的东西,但这是另一个故事.)