unit UMessRichEdit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, ExtDlgs, ImgList, ExtCtrls;

type
  TForm1 = class(TForm)
    RichEdit1: TRichEdit;
    RichEdit2: TRichEdit;
    Label1: TLabel;
    RichEdit3: TRichEdit;
    StatusBar1: TStatusBar;
    Label2: TLabel;
    Memo1: TMemo;
    Label3: TLabel;
    procedure RichEdit1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure RichEdit2MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure RichEdit3MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Memo1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Memo1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure Memo1KeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
   procedure SelectText(Sender: TCustomMemo);
   procedure UnSelectText(Sender: TCustomMemo);
   procedure UpdateSelectText(Sender: TCustomMemo);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//----------------------------------------------------------
// Выделение  в RichEdit1 слова,
// над которым перемещается курсор мыши
//----------------------------------------------------------

uses RichEdit;
procedure TForm1.RichEdit1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var p:TPoint;
    ind, indbeg, l: longint;
begin
if not(ssAlt in Shift) then exit;
// определяется индекс символа ind,
// ближайшего к координатам курсора X и Y
p := Point(x,y);
ind := RichEdit1.Perform(EM_CHARFROMPOS,0,LongInt(@p));
// анализ символов в данной и предыдущей позициях
 if (RichEdit1.Perform(EM_FINDWORDBREAK,WB_CLASSIFY,ind) or
    RichEdit1.Perform(EM_FINDWORDBREAK,WB_CLASSIFY,ind-1)) and
   (WBF_BREAKLINE or WBF_ISWHITE) <> 0
 then begin
// один из символов пробельный
  RichEdit1.SelLength := 0;
  exit;
 end;
// индекс начала слова
 indbeg := RichEdit1.Perform(EM_FINDWORDBREAK, WB_MOVEWORDLEFT,
                             ind);
// длина слова
 l := RichEdit1.Perform(EM_FINDWORDBREAK, WB_RIGHTBREAK,
                        ind) - indbeg;
// если слово прежнее, выход
 if (indbeg = RichEdit1.SelStart) and (l = RichEdit1.SelLength)
  then exit;
// выделение слова
 RichEdit1.SelStart := indbeg;
 RichEdit1.SelLength := l;
end;

//----------------------------------------------------------
// Выделение  в RichEdit2 красным цветом слова,
// над которым перемещается курсор мыши
//----------------------------------------------------------

var OldColor: TColor;

procedure TForm1.RichEdit2MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var p:TPoint;
    ind, indbeg, l: longint;
begin
if not(ssAlt in Shift) then exit;
// определяется индекс символа ind,
// ближайшего к координатам курсора X и Y
 p := Point(x,y);
 ind := RichEdit2.Perform(EM_CHARFROMPOS,0,LongInt(@p));
// анализ символов в данной и предыдущей позициях
 if (RichEdit2.Perform(EM_FINDWORDBREAK,WB_CLASSIFY,ind) or
    RichEdit2.Perform(EM_FINDWORDBREAK,WB_CLASSIFY,ind-1)) and
   (WBF_BREAKLINE or WBF_ISWHITE) <> 0
 then begin
// один из символов пробельный, восстановление цвета
  RichEdit2.SelAttributes.Color := OldColor;
  RichEdit2.SelLength := 0;
  exit;
 end;
// выделение временно делается невидимым
 RichEdit2.Perform(EM_HIDESELECTION, 1, 0);
// индекс начала слова
 indbeg := RichEdit1.Perform(EM_FINDWORDBREAK, WB_MOVEWORDLEFT,
                             ind);
// длина слова
 l := RichEdit1.Perform(EM_FINDWORDBREAK, WB_MOVEWORDRIGHT,ind)
      - indbeg;
// если слово прежнее, выход
 if (indbeg = RichEdit2.SelStart) and    (l = RichEdit2.SelLength)
 then exit;
// восстановление прежнего цвета выделения
 RichEdit2.SelAttributes.Color := OldColor;
// новое выделение
 RichEdit2.SelStart := indbeg;
 RichEdit2.SelLength := l;
// запоминание цвета
 OldColor := RichEdit2.SelAttributes.Color;
// выделение красным цветом
 RichEdit2.SelAttributes.Color := clRed;
end;

//----------------------------------------------------------
// Выделение  в RichEdit3 строки,
// над которой перемещается курсор мыши,
// и отбражение в полосе стостояния информации о строке
//----------------------------------------------------------

var OldLine: longint = -1;

procedure TForm1.RichEdit3MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var p:TPoint;
    ind, indline: longint;
begin
p:=Point(x,y);
ind := RichEdit3.Perform(EM_CHARFROMPOS,0,LongInt(@p));
if ind > 0
 then begin
  indline := RichEdit3.Perform(EM_LINEFROMCHAR, ind, 0);
  if OldLine <> indline
   then begin
    OldLine := indline;
    RichEdit3.SelStart := RichEdit3.Perform(
                                  EM_LINEINDEX, indline, 0);
    RichEdit3.SelLength := RichEdit3.Perform(
                                  EM_LINELENGTH, ind, 0);
  end;
 StatusBar1.SimpleText := 'Строка ' +
                 IntToStr(RichEdit3.Perform(
                 EM_LINEFROMCHAR, RichEdit3.SelStart, 0)+1) +
                 ' из ' + IntToStr(RichEdit3.Perform(EM_GETLINECOUNT, 0, 0));
 end;
end;

//----------------------------------------------------------
// Выделение рамкой строки окна Memo1, в которой приводится редактирование
//----------------------------------------------------------

var MyCanvas: TControlCanvas;
    NLine: integer = -1;
    HLine, WLine: integer;
    FirstLine: longint;

procedure TForm1.SelectText(Sender: TCustomMemo);
var tm:TEXTMETRIC;
    R:TRect;
begin
 FirstLine := Sender.Perform(EM_GETFIRSTVISIBLELINE,0,0);
 UnSelectText(Sender);
 NLine := Sender.CaretPos.Y;
 with MyCanvas do begin
  GetTextMetrics(Handle, tm);
  HLine := tm.tmHeight + tm.tmExternalLeading;
  Sender.Perform(EM_GETRECT,0,Longint(@R));
  WLine:=R.Right- R.Left+1;
  Brush.Color := clBlack;
  FrameRect(Rect(1, (NLine-FirstLine)*HLine+1, WLine,
                 (NLine-FirstLine+1)*HLine+1));
 end;
end;

procedure TForm1.UnSelectText(Sender: TCustomMemo);
begin
 if NLine > -1 then
 with MyCanvas do begin
  Brush.Color := Sender.Brush.Color;
  FrameRect(Rect(1, (NLine-FirstLine)*HLine+1, WLine,
                 (NLine-FirstLine+1)*HLine+1));
  NLine := -1;
 end;
end;

procedure TForm1.UpdateSelectText(Sender: TCustomMemo);
var NewFirstLine: longint;
begin
 if NLine > -1
  then begin
   NewFirstLine := Sender.Perform(EM_GETFIRSTVISIBLELINE,0,0);
   if NewFirstLine <> FirstLine
    then with MyCanvas do begin
     Brush.Color := Sender.Brush.Color;
     FrameRect(Rect(1, (NLine-FirstLine)*HLine+1, WLine,
                   (NLine-FirstLine+1)*HLine+1));
     FirstLine := NewFirstLine;
     Brush.Color := clBlack;
     FrameRect(Rect(1, (NLine-FirstLine)*HLine+1, WLine,
                   (NLine-FirstLine+1)*HLine+1));
    end
    else if (NLine = Sender.CaretPos.Y)
     then
      MyCanvas.FrameRect(
             Rect(1, (NLine-FirstLine)*HLine+1,
             WLine, (NLine-FirstLine+1)*HLine+1));
  end;
end;

procedure TForm1.Memo1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
 SelectText(Sender as TCustomMemo);
end;

procedure TForm1.Memo1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 SelectText(Sender as TCustomMemo);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 MyCanvas := TControlCanvas.Create;
 MyCanvas.Control := Memo1;
end;

procedure TForm1.Memo1KeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
 UpdateSelectText(Sender as TCustomMemo);
 SelectText(Sender as TCustomMemo);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
 MyCanvas.Free;
end;

end.
