☆カーソル下のテキストを選択する。

☆メモ上でマウス下のテキスト取得で使った GetWordAndPhrase名前空間を使い、エディットコントロールでカーソル下のテキストを選択させます。

実行させるとこんな感じです。

ここで問題になるのが、TEdit、TMemoは「ランタイムテーマの影響を受けてしまう」ことです。 TRichEditは、ランタイムテーマの影響を受けず、常にバイト数で扱いますが、TEdit、TMemoは ランタイムテーマが有効時－文字数、無効時－バイト数となります。 今回、ランタイムテーマが有効、無効にかかわらず、バイト数で扱う処理を考えてみます。

uses
 GetWordAndPhrase, AdjustedEdit;

procedure TForm1.Edit1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  CursolPos, sp, ep: Integer;
  S: String;
begin
  Exit;
  CursolPos := LoWord(Edit1.Perform(EM_CHARFROMPOS, 0, MakeLParam(X, Y)));
  CursolPos := GetSelStart_Byte(Edit1.Text, CursolPos);
  S := GetWordAndPhraseUnderMouse(CursolPos, Edit1.Text, sp, ep);
  if S <> ''then
  begin
    if GetSelStart(Edit1) <> sp then
    begin
      SetSelStart(Edit1, sp);
      SetSelLength(Edit1, ep-sp+1);
    end;
  end;
  if ActiveControl <> Edit1 then
    ActiveControl := Edit1;
end;

procedure TForm1.Memo1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  CursolPos, sp, ep: Integer;
  S: String;
begin
  CursolPos := LoWord(Memo1.Perform(EM_CHARFROMPOS, 0, MakeLParam(X, Y)));
  CursolPos := GetSelStart_Byte(Memo1.Text, CursolPos);
  S := GetWordAndPhraseUnderMouse(CursolPos, Memo1.Text, sp, ep);
  if S <> ''then
  begin
    if GetSelStart(Memo1) <> sp then
    begin
      SetSelStart(Memo1, sp);
      SetSelLength(Memo1, ep-sp+1);
    end;
  end;
  if ActiveControl <> Memo1 then
    ActiveControl := Memo1;
end;

procedure TForm1.RichEdit1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  CursolPos, sp, ep: Integer;
  S: String;
  Pt:TPoint;
begin
  Pt := Point(X,Y);
  CursolPos := RichEdit1.Perform(EM_CHARFROMPOS, 0, Integer(@Pt));
  S := GetWordAndPhraseUnderMouse(CursolPos, RichEdit1.Text, sp, ep);
  if S <> ''then
  begin
    if RichEdit1.SelStart <> sp then
    begin
      RichEdit1.SelStart := sp;
      RichEdit1.SelLength := ep-sp+1;
    end;
  end;
  if ActiveControl <> RichEdit1 then
    ActiveControl := RichEdit1;
end;

ランタイムテーマの設定にかかわらず、バイト単位で扱うための処理を集めた名前空間 AdjustedEdit （名前が変なのは無視して～）

unit AdjustedEdit;

{ ランタイムテーマの設定にかかわらず、バイト単位で扱います。 }

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  StdCtrls, Buttons, ExtCtrls, Themes;

  // SelTextを取得します。
  function GetSelText(CustomEdit: TCustomEdit): String;

  // SelStartをバイト数で設定します。
  procedure SetSelStart(Edit: TCustomEdit; Position_Byte: Integer);

  // SelStartをバイト数で取得します。
  function GetSelStart(Edit: TCustomEdit): Integer;

  // SelLengthをバイト数で設定します。
  procedure SetSelLength(Edit: TCustomEdit; Length_Byte: Integer);

  // SelLengthをバイト数で取得します。
  function GetSelLength(Edit: TCustomEdit): Integer;

  // 文字数で指定された位置のバイト数を返します。
  function GetSelStart_Byte(S: WideString; Position_Moji: Integer): Integer;

implementation

// 指定位置のバイト数分の文字数を返します。
function GetMoji(S: String; Position: Integer): Integer;
var
  P: PChar;
  I: Integer;
  Check: String;
begin
  if not ThemeServices.ThemesEnabled then
  begin
    Result := Position;
    Exit;
  end;

  Check := Copy(S, 1, Position);
  P := PChar(Check+#0);
  I := 0;
  while (P^ <> #0) do
  begin
    if IsDBCSLeadByte(Byte(P^)) then
      Inc(P,2)
    else
      Inc(P);
    Inc(I);
  end;
  Result := I;
end;

// SelTextを取得します。
function GetSelText(CustomEdit: TCustomEdit): String;
var
  S, Str: WideString;
  I, Start, Len: Integer;
begin
  if not ThemeServices.ThemesEnabled then
  begin
    Result := CustomEdit.SelText;
    Exit;
  end;

  S := WideString(CustomEdit.Text);
  Start := CustomEdit.SelStart + 1;
  Len := Start + CustomEdit.SelLength -1;

  Str := '';
  for I := Start to Len do
    Str := Str + S[I];
  Result := Str;
end;

// SelStartをバイト数で設定します。
procedure SetSelStart(Edit: TCustomEdit; Position_Byte: Integer);
begin
  Edit.SelStart := GetMoji(Edit.Text, Position_Byte);
end;

// SelStartをバイト数で取得します。
function GetSelStart(Edit: TCustomEdit): Integer;
begin
  Result := GetSelStart_Byte(Edit.Text, Edit.SelStart);
end;

// SelLengthをバイト数で設定します。
procedure SetSelLength(Edit: TCustomEdit; Length_Byte: Integer);
var
  I,J: Integer;
begin
  I := GetSelStart(Edit);
  if I = 0 then I := 1;
  J := GetMoji(Edit.Text, I + Length_Byte);
  Edit.SelLength := J-GetMoji(Edit.Text,I);
end;

// SelLengthをバイト数で取得します。
function GetSelLength(Edit: TCustomEdit): Integer;
begin
  Result := Length(GetSelText(Edit));
end;

// 文字数で指定された位置のバイト数を返します。
function GetSelStart_Byte(S: WideString; Position_Moji: Integer): Integer;
var
  Check: String;
begin
  if not ThemeServices.ThemesEnabled then
    Result := Position_Moji
  else
  begin
    Check := Copy(S, 1, Position_Moji);
    Result := Length(Check);
  end;
end;

end.

上記、名前空間にSetSelTextという処理がないのは、次の処理がランタイムの設定に関係なく正常に動作するからです。

  Edit1.Seltext := 'ややこしい！';

SelTextを表示させたら、でたらめなのに、この処理が正常に動作する理由がわかりません。

こんなややこしい処理で悩むのなら、TMemoだけでなく、TEditもTRichEditを次の設定にして代用した方が簡単なのかも知れませんね。

  RichEdit1.WantReturns := False;
  RichEdit1.WordWrap := False;

☆EM_CHARFROMPOSでカーソル位置を取得する。

TRichEditとTEdit、TMemoでは、EM_CHARFROMPOSの仕様が違うことを思い出しました。

// TEditの場合(TMemoも同じ)

procedure TForm1.Edit1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  CursolPos: Integer;
begin
  CursolPos := LoWord(Edit1.Perform(EM_CHARFROMPOS, 0, MakeLParam(X, Y)));
end;

// TRichEditの場合

procedure TForm1.RichEdit1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  Pt:TPoint;
  CursolPos: Integer;
begin
  Pt := Point(X,Y);
  CursolPos := RichEdit1.Perform(EM_CHARFROMPOS, 0, Integer(@Pt));
end;

TEdit、TMemoは、ランタイムテーマが有効時－文字数、無効時－バイト数を返しますが、TRichEditは、常にバイト数で返します。


MSDN
EM_CHARFROMPOS Message
http://msdn2.microsoft.com/en-us/library/ms672066.aspx

☆行単位でテキストを取得する。

Memoのテキストをマウス位置で行単位に取得するために、EM_CHARFROMPOS、EM_GETLINEを使えばいいことは知っていました。でもいざ使うとなると、EM_GETLINE部分で、文字化けしたりして、なかなかうまくいかなったので、今更ですが、メモしておきますね。
（Memo1.Linesを行番号で取得しようかと思ったほど、はまっていました。）

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Edit1: TEdit;
    procedure Memo1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Memo1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  I, J: Integer;
  Text : array[0..4095] of Char;
  S: String;
begin
   I := HiWord(SendMessage(Memo1.Handle, EM_CHARFROMPOS, 0, MakeLParam(X, Y)));
   Word((@Text)^) := SizeOf(Text);  //←これに注意！
   J := SendMessage(Memo1.Handle, EM_GETLINE, I, Longint(@Text));
   SetString(S, Text, J);
   Edit1.Text := S;
end;

end.

☆メモ上でマウス下のテキスト取得

ブラウザでのGoogleの翻訳機能ってどうしてるのかなという疑問から、マウス下のテキストの取得に挑戦してみましたが、ブラウザでの取得は全くわかりませんでした。ということで簡単なところから、エディットコントロールでのサンプルです(笑)

実行するとこんな感じです。






ごちゃごちゃと検索する関数です。（日本語の処理は面倒ですね）
きちんとまとめるともう少しすっきりしそうですが、サンプルということで・・・。

unit GetWordAndPhrase;

interface

uses
  Windows;

//マウス下の語句を返します。＜Delimiterで区切られているか英単語単位＞
//Ptには、語句の開始位置と終了位置を返します。
function GetWordAndPhraseUnderMouse(const Index: Integer;const  S: String;
  var StartPos, EndPos: Integer): String;

implementation

//半角アルファベットかどうか
function IsAlphabet(C: Byte): Boolean;
begin
  Result := (C in [65..90, 97..122]);
end;

//英単語を取得するかどうか
function IsAlphabetMode(Index: Integer; S: String): Boolean;
var
  P: PChar;
begin
  P := PChar(S);
  Result := (Ord(P[Index]) in [65..90, 97..122]);
end;

//IndexがDelimiterかどうか
function IsDelimiter(Index: Integer; S: String): Boolean;
var
  P: PChar;
  wc: Word;
begin
  Result := True;
  P := PChar(S);

  //Delimiterの場合には終了
  if Ord(P[Index]) in [9,10,13,32] then Exit;

  //全角スペースの１バイト目
  if IsDBCSLeadByte(Byte(P[Index])) then
  begin
    wc := (Byte(P[Index]) shl 8) or Byte(P[Index+1]);
    //$8140-全角スペース $8141-、$8142-。
    if (wc = $8140) or (wc = $8141) or (wc = $8142) then Exit;
  end;

  //Indexが0の場合は、全角スペースの２バイト目はありえないので処理を終了します。
  if Index = 0 then
  begin
    Result := False;
    Exit;
  end;

  //全角スペースの２バイト目
  if IsDBCSLeadByte(Byte(P[Index-1])) then
  begin
    wc := (Byte(P[Index-1]) shl 8) or Byte(P[Index]);
    //$8140-全角スペース $8141-、$8142-。
    if  (wc = $8140) or (wc = $8141) or (wc = $8142) then Exit;
  end;
  Result := False;
end;

//前方検索
function PrevCheckAlphabetMode(Index: Integer; S: String): Integer;
var
  P: PChar;
begin
  if Index = 0 then
  begin
    Result := 0;
    Exit;
  end;

  P := PChar(S);
  repeat
    // 全角かどうかのチェック -- ２バイト目かどうか
    // 前方検索なので、１バイト目が先に出てくることはない。
    // ２バイト目が確認できたら、１バイト目分も移動させる。
    if (Index > 0) and IsDBCSLeadByte(Byte(P[Index-1])) then
      begin
        //全角の場合は終了する。
        Inc(Index);
        Break;
      end
    else if not IsAlphabet(Byte(P[Index])) then
      begin
        Inc(Index);
        Break;
      end
    else if Ord(P[Index]) in [9,10,13,32] then //半角Delimiter文字のチェック
      begin
        Inc(Index); //IndexがDelimiterなら一つ戻して終了する。
        Break;
      end
    else
      Dec(Index);
  until Index <= 0;
  if Index < 0 then Index := 0;
  Result := Index;
end;

//後方検索
function NextCheckAlphabetMode(Index: Integer; S: String): Integer;
var
  P: PChar;
  max: Integer;
begin
  Result := -1;
  P := PChar(S);
  Max := Length(S);

  //Indexが全角の２バイトの場合一つ戻しておきます。
  if (Index > 0) and IsDBCSLeadByte(Byte(P[Index-1])) then Exit;

  repeat
    // 全角の場合
    if IsDBCSLeadByte(Byte(P[Index])) then //１バイト目かどうかのチェック
      Break
    else if not IsAlphabet(Byte(P[Index])) then
      Break
    else if Ord(P[Index]) in [9,10,13,32] then
      Break
    else
      Inc(Index);
  until Index >= max;  //Index=maxというのは文字列より一つ多い。
  Dec(Index);
  Result := Index;
end;


//前方検索 -- Delimiterのみで判定する
function PrevCheck(Index: Integer; S: String): Integer;
var
  P: PChar;
  wc: Word;
begin
  if Index = 0 then
  begin
    Result := 0;
    Exit;
  end;

  P := PChar(S);
  // Indexが２バイト目の先頭バイトの場合には、一つ進めておきます。
  if IsDBCSLeadByte(Byte(P[Index])) then
  begin
    if Index = 0 then
    begin
      Result := 0;
      Exit;
    end;
    Dec(Index);
  end;

  repeat
    // 全角かどうかのチェック -- ２バイト目かどうか
    // 前方検索なので、１バイト目が先に出てくることはない。
    // ２バイト目が確認できたら、１バイト目分も移動させる。
    if (Index > 0) and IsDBCSLeadByte(Byte(P[Index-1])) then
      begin
        wc := (Byte(P[Index-1]) shl 8) or Byte(P[Index]);
        //$8140-全角スペース $8141-、$8142-。
        if  (wc = $8140) or (wc = $8141) or (wc = $8142) then
          begin
            Inc(Index); //Indexが２バイト文字だと確認できたら一つ戻して終了する。
            Break;
          end
        else
          Index := Index - 2; //全角文字の一つ前に進める。
      end
    else if Ord(P[Index]) in [9,10,13,32] then //半角Delimiter文字のチェック
      begin
        Inc(Index); //IndexがDelimiterなら一つ戻して終了する。
        Break;
      end
    else
      Dec(Index);
  until Index <= 0;
  if Index < 0 then Index := 0;
  Result := Index;
end;

//後方検索 -- Delimiterのみ判定する
function NextCheck(Index: Integer; S: String): Integer;
var
  P: PChar;
  wc: Word;
  max: Integer;
begin
  P := PChar(S);
  Max := Length(S);

  //Indexが全角の２バイトの場合一つ戻しておきます。
  if (Index > 0) and IsDBCSLeadByte(Byte(P[Index-1])) then
    Dec(Index);

  repeat
    // 全角の場合
    if IsDBCSLeadByte(Byte(P[Index])) then //１バイト目かどうかのチェック
      begin
        //全角スペースのチェック
        wc := (Byte(P[Index]) shl 8) or Byte(P[Index+1]);
        //$8140-全角スペース $8141-、$8142-。
        if  (wc = $8140) or (wc = $8141) or (wc = $8142) then
          Break;
        Index := Index + 2;
      end
    else if Ord(P[Index]) in [9,10,13,32] then
      Break
    else
      Inc(Index);
  until Index >= max;  //Index=maxというのは文字列より一つ多い。
  Dec(Index);
  Result := Index;
end;


//マウス下の語句を返します。＜Delimiterで区切られているか英単語単位＞
//Ptには、語句の開始位置と終了位置を返します。
function GetWordAndPhraseUnderMouse(const Index: Integer;const  S: String;
  var StartPos, EndPos: Integer): String;
begin
  StartPos := -1;
  EndPos := -1;
  Result := '';
  if not IsDelimiter(Index,S) then
  begin
    if IsAlphabetMode(Index,S)  then
      begin
        // 英単語のみの取得
        StartPos := PrevCheckAlphabetMode(Index,S);
        EndPos := NextCheckAlphabetMode(Index,S);
      end
    else
      begin
        // delimiterによる語句の取得
        StartPos := PrevCheck(Index,S);
        EndPos := NextCheck(Index,S);
      end;
  end;
  if (StartPos = -1) and (EndPos = -1) then
    Result := ''
  else
    Result := Copy(S, StartPos+1, EndPos-StartPos+1);
end;

end.

上記、関数の利用例です。
メモとタイマーを各１個ずつ配置して、それぞれの手続きを設定します。

unit Sample2_UseMemo;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ExtCtrls;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Timer1: TTimer;
    procedure Memo1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    HW: THintWindow;
    procedure ShowHintWindow(X, Y: Integer; S: String);
    procedure HideHintWindow;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses GetWordAndPhrase;

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  HW := THintWindow.Create(Self);
end;

var
  bkPos: TPoint;

procedure TForm1.Memo1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
const
  A = 5; //マウスの感度調整
begin
  if ((X < bkPos.X -A) or (X > bkPos.X +A)) or
     ((Y < bkPos.Y -A) or (Y > bkPos.Y +A)) then
    HideHintWindow;
end;

// ヒントウィンドウの表示
procedure TForm1.Timer1Timer(Sender: TObject);
var
  I, sp, ep: Integer;
  S: String;
  csPos,clPos: TPoint;
begin
  GetCursorPos(csPos);
  clPos := Memo1.ScreenToClient(csPos);
  bkPos := clPos;
  I := LoWord(Memo1.Perform(EM_CHARFROMPOS, 0, MakeLParam(clPos.X, clPos.Y)));
  S := GetWordAndPhraseUnderMouse(I, Memo1.Text, sp, ep);
  if (S <> '') then
  begin
    ShowHintWindow(csPos.X, csPos.Y, S);
    Timer1.Enabled := False;
  end;
end;

// ヒントウィンドウ
procedure TForm1.ShowHintWindow(X, Y: Integer; S: String);
var
  Rect: TRect;
begin
  if not HW.HandleAllocated then
    HW.HandleNeeded;

  Rect := Bounds(0, 0, 0, 0);
  DrawText(HW.Canvas.Handle, PChar(S), -1, Rect, DT_CALCRECT or DT_LEFT);
  OffsetRect(Rect, X,Y + 10);
  //ヒントウィンドウの微調整
  Inc(Rect.Right, 6);
  Inc(Rect.Bottom, 2);
  //表示
  HW.ActivateHint(Rect, S);
end;

procedure TForm1.HideHintWindow;
begin
  if HW.HandleAllocated then
  begin
    HW.ReleaseHandle;
    Timer1.Enabled := True;
  end;
end;

end.

delimiterは、全角スペース、半角スペース、改行(CRLF)、句読点（。、）としています。