How to enhance the default memo control in Delphi with the ability to underline text
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 开发者_如何学Pythonuse a richedit control.
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;
edit: 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.
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.)
精彩评论