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

Question

I'm trying to build a simple script editor with the ability to show errors. I've searched the web for a component that can show/underline the errors for me, but i couldn't found one. So i've decided to build one myself based on the memo control that's included in Delphi.

I was planning to add the following function to the memo control:

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

Being the first time for me to enhance a visual control like this i'm asking if someone could broadly outline for me how to do this. No need to go into specific details :)

ps: I don't want to use a richedit control.

Answer 1

Below is some D2007 code sample using regular winapi, that would show you how to find where to draw in a scrollable memo and how to draw a simple underline. For brevity it has no error catching/handling. Also lets only one underline scope, since usability as a component is not the purpose of the sample. Tried with a vertical-scrolling memo but if you want you should be able to fine tune details if problems arise otherwise.

Tested on 2K, XP and 7, the look on XP is like this:

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

And the code:

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;

Forgot to mention, when typing you would probably remove underlining. I don't have any idea how it should behave when typing, and probably it would be difficult to achieve that desired behavior.

Answer 2

The "default memo control" in Delphi is just a wrapper for a Windows standard text box control. As such, there is no way to implement custom behaviour in this control. (If you need really custom behaviour, you can always write your own text box control from scratch. I have done so in my text editor , which also supports syntax highlighting. Or, you could use a third-party control. There are plenty of advanced text editor controls for Delphi out there.) You can only use functions provided by the operating system when it comes to this control.

You should really use a TRichEdit instead. This is a wrapper for the standard Windows Rich Edit control, which supports formatting such as underlining. (And, it also supports a lot of other stuff not presented by the Delphi wrapper, such as automatic URL highlighting, among other things, but that's another story.)