4

I need to be able to select the whole word of a TMemo if the caret is directly adjacent or in a word in the memo.

Consider the following (where | is a caret)

Here is some text| = Select text

Here is so|me text = Select some

|Here is some text = Select Here

Here is some text | = Select ''

Simon
  • 9,197
  • 13
  • 72
  • 115

1 Answers1

11

Check this code with comments to explain how works.

function SelectWordUnderCaret(AMemo:TMemo):string;
var
   Line    : Integer;
   Column  : Integer;
   LineText: string;
   InitPos : Integer;
   EndPos  : Integer;
begin
   //Get the caret position
   Line   := AMemo.Perform(EM_LINEFROMCHAR,AMemo.SelStart, 0) ;
   Column := AMemo.SelStart - AMemo.Perform(EM_LINEINDEX, Line, 0) ;
   //Validate the line number
   if AMemo.Lines.Count-1 < Line then Exit;

   //Get the text of the line
   LineText := AMemo.Lines[Line];

   Inc(Column);
   InitPos := Column;
   //search the initial position using the space symbol as separator
   while (InitPos > 0) and (LineText[InitPos] <> ' ') do Dec(InitPos);
   Inc(Column);

   EndPos := Column;
   //search the final position using the space symbol as separator
   while (EndPos <= Length(LineText)) and (LineText[EndPos] <> ' ') do Inc(EndPos);

   //Get the text
   Result := Trim(Copy(LineText, InitPos, EndPos - InitPos));

   //Finally select the text in the Memo
   AMemo.SelStart  := AMemo.Perform(EM_LINEINDEX, Line, 0)+InitPos;
   AMemo.SelLength := Length(Result);
end;

and you can use like this

procedure TForm1.Button1Click(Sender: TObject);
begin
     Caption := SelectWordUnderCaret(Memo1) ;
end;
RRUZ
  • 134,889
  • 20
  • 356
  • 483
  • To get caret position you can use AMemo.CaretPos – SimaWB Jun 14 '11 at 06:18
  • +1. This algorithm is very good for actual use, that is, if you really want to use it for a TMemo: it only reads the required line of text, not the whole memo as mine does. It's probably unicode-enabled because it tests for whitespace, and that's something the OP needs to think about (what constitutes a word?). – Cosmin Prund Jun 14 '11 at 07:05
  • Brilliant, Thanks RRUZ. I had a similar one to Cosmins but this looks more efficient. – Simon Jun 14 '11 at 07:52
  • RangeCheck Error when you have empty lines. you need to change this line: while (InitPos > 0) and (InitPos <= Length(LineText)) AND (LineText[InitPos] <> ' ') – Gabriel Nov 28 '19 at 18:37