Cómo mejorar el control de notas predeterminado en Delphi con la capacidad de subrayar el texto

Question

Estoy intentando construir un editor de scripts simple con la capacidad de mostrar errores. Busqué en la web un componente que pueda mostrar/subrayar los errores, pero no pude encontrar ninguno. Así que he decidido crear uno yo mismo basado en el control de notas que se incluye en Delphi.

que estaba planeando añadir la siguiente función para el control de memos:

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

ser la primera vez para mí para facilitar un control visual como este me estoy preguntando si alguien podría describir en términos generales para mí como hacer esto. No es necesario entrar en detalles específicos :)

ps: No quiero usar un control richedit.

Answer 1

A continuación se muestra un ejemplo de código D2007 con winapi común, que le mostrará cómo encontrar dónde dibujar en un memo desplazable y cómo dibujar un subrayado simple. Para abreviar, no tiene errores de captura/manejo. También permite solo un alcance de subrayado, ya que la usabilidad como componente no es el propósito de la muestra. Intentó con una nota de desplazamiento vertical pero, si lo desea, debería poder ajustar los detalles si surgen problemas.

Probado en 2K, XP y 7, la expresión de XP es así:

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

Y el código:

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; 

edición: olvidó mencionar, cuando escribiendo probablemente eliminaría el subrayado. No tengo idea de cómo debería comportarse al tipear, y probablemente sería difícil lograr ese comportamiento deseado.

Answer 2

El "control de memo predeterminado" en Delphi es solo un contenedor para un control de cuadro de texto estándar de Windows. Como tal, no hay forma de implementar un comportamiento personalizado en este control. (Si necesita un comportamiento realmente personalizado, siempre puede escribir su propio control de cuadro de texto desde cero. Lo he hecho en mi text editor, que también es compatible con el resaltado de sintaxis. O bien, puede usar un control de terceros. Hay muchas funciones avanzadas controles de editor de texto para Delphi.) Solo puede usar las funciones proporcionadas por el sistema operativo cuando se trata de este control.

Realmente debería usar un TRichEdit en su lugar. Este es un contenedor para el control estándar Rich Edit de Windows, que admite el formateo como subrayado. (Y, además, es compatible con muchas otras cosas no presentadas por Delphi, como el resaltado automático de URL, entre otras cosas, pero esa es otra historia)