ブラウザでの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;
//全角スペースの1バイト目
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の場合は、全角スペースの2バイト目はありえないので処理を終了します。
if Index = 0 then
begin
Result := False;
Exit;
end;
//全角スペースの2バイト目
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
// 全角かどうかのチェック -- 2バイト目かどうか
// 前方検索なので、1バイト目が先に出てくることはない。
// 2バイト目が確認できたら、1バイト目分も移動させる。
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が全角の2バイトの場合一つ戻しておきます。
if (Index > 0) and IsDBCSLeadByte(Byte(P[Index-1])) then Exit;
repeat
// 全角の場合
if IsDBCSLeadByte(Byte(P[Index])) then //1バイト目かどうかのチェック
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が2バイト目の先頭バイトの場合には、一つ進めておきます。
if IsDBCSLeadByte(Byte(P[Index])) then
begin
if Index = 0 then
begin
Result := 0;
Exit;
end;
Dec(Index);
end;
repeat
// 全角かどうかのチェック -- 2バイト目かどうか
// 前方検索なので、1バイト目が先に出てくることはない。
// 2バイト目が確認できたら、1バイト目分も移動させる。
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が2バイト文字だと確認できたら一つ戻して終了する。
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が全角の2バイトの場合一つ戻しておきます。
if (Index > 0) and IsDBCSLeadByte(Byte(P[Index-1])) then
Dec(Index);
repeat
// 全角の場合
if IsDBCSLeadByte(Byte(P[Index])) then //1バイト目かどうかのチェック
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.
上記、関数の利用例です。
メモとタイマーを各1個ずつ配置して、それぞれの手続きを設定します。
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)、句読点(。、)としています。