Comment améliorer le contrôle mémo par défaut dans Delphi avec la possibilité de souligner le texte

Question

J'essaye de construire un éditeur de script simple avec la possibilité d'afficher les erreurs. J'ai cherché sur le Web un composant qui peut montrer/souligner les erreurs pour moi, mais je ne pouvais pas en trouver un. J'ai donc décidé d'en construire un moi-même en me basant sur le contrôle mémo inclus dans Delphi.

Je comptais d'ajouter la fonction suivante au contrôle mémo:

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

Étant la première fois pour moi de mettre en valeur un contrôle visuel comme cela, je me demande si quelqu'un pourrait largement décrire pour moi comment faire ça Pas besoin d'entrer dans les détails spécifiques :)

ps: Je ne veux pas utiliser un contrôle richedit.

Answer 1

Ci-dessous un échantillon de code D2007 en utilisant winapi régulière, qui serait vous montre comment trouver où dessiner dans un mémo déroulant et comment dessiner un soulignement simple. Par souci de brièveté, il n'y a pas d'erreur d'accrochage/manipulation. Ne permet également qu'une seule portée de soulignement, puisque l'utilisabilité en tant que composant n'est pas le but de l'échantillon. Essayé avec un mémo à défilement vertical, mais si vous voulez, vous devriez être en mesure d'affiner les détails si des problèmes surviennent autrement.

Testé sur 2K, XP et 7, le regard sur XP est comme ceci:

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

Et le 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; 

modifier: oublié de mentionner, quand en tapant, vous supprimerez probablement le soulignement. Je n'ai aucune idée de comment il devrait se comporter en tapant, et probablement il serait difficile d'obtenir ce comportement désiré.

Answer 2

Le "contrôle mémo par défaut" dans Delphi est juste un wrapper pour un contrôle de zone de texte standard Windows. En tant que tel, il n'existe aucun moyen d'implémenter un comportement personnalisé dans ce contrôle. (Si vous avez vraiment besoin d'un comportement personnalisé, vous pouvez toujours écrire votre propre contrôle de zone de texte à partir de rien, dans mon text editor, qui prend également en charge la coloration syntaxique ou utiliser un contrôle tiers. les contrôles de l'éditeur de texte pour Delphi là-bas.) Vous pouvez uniquement utiliser les fonctions fournies par le système d'exploitation quand il s'agit de ce contrôle.

Vous devriez vraiment utiliser un TRichEdit à la place. Ceci est un wrapper pour le contrôle Windows Rich Edit standard, qui prend en charge le formatage tel que le soulignement. (Et, il prend également en charge beaucoup d'autres choses non présentées par le wrapper Delphi, comme la mise en évidence automatique d'URL, entre autres, mais c'est une autre histoire.)