unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, Windows, LazUtf8 ;
type
{ TForm1 }
TForm1 = class(TForm)
Button1: TButton;
Label1: TLabel;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
private
public
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
function SelectWordUnderCaret(AMemo:TMemo):string;
var
Line : Integer;
Column : Integer;
LineText: string;
InitPos : Integer;
EndPos : Integer;
begin
//Get the caret position
Line := SendMessage(AMemo.Handle, EM_LINEFROMCHAR,AMemo.SelStart, 0) ;
Column := AMemo.SelStart - SendMessage(AMemo.Handle, 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 (InitPos <= UTF8Length(LineText)) AND (LineText[InitPos] <> ' ') do Dec(InitPos);
Inc(Column);
EndPos := Column;
//search the final position using the space symbol as separator
while (EndPos <= UTF8Length(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 := SendMessage(AMemo.Handle, EM_LINEINDEX, Line, 0)+InitPos;
AMemo.SelLength := UTF8Length(Result);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Caption := SelectWordUnderCaret(Memo1) ; //the word will be shown in Form caption
end;
end.