Geek Answers Handbook

How to increase control over the default entry in Delphi with the ability to underline text

I am trying to create a simple script editor with the ability to show errors. I searched the Internet for a component that could show / emphasize errors for me, but I could not find it. So I decided to create it myself based on the recording control that is included in Delphi.

I planned to add the following function to the memo control:

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

Being the first time for me to improve visual control like this, I ask if anyone can outline for me how to do it. No need to go into details :)

ps: I do not want to use the richedit control.

+5
source share
2 answers

D2007 winapi, , , . . , . , , , .

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;

edit: , , , . , , , , .

+7

" " Delphi - Windows. , . ( , . , . Delphi ). , , .

TRichEdit. Windows Rich Edit, , , . ( , Delphi, URL, , .)

+7

More articles:


All Articles