TableIRCの開発時、TRichEditでUnicodeを表示する方法を説明したこのサイトは相当役に立ったのですが、
残念なことに、ほとんどの情報をクリップボード経由で取得するようになっています。
しかし、開発中にいろいろ調べた結果コードによって回避可能なことが判明したので
ここにそれらのコードを書いていきたいと思います。
全て Useｓ RichEdit; を加えないと動きません。
ソース中に使われている gfnsStrFromClipboard 関数などは上記のサイトにあります。
このコードを作るに当たり、このサイトを参考にさせていただきました。
【追記】
文字列の取得と設定関数にバグがあったので修正しました。
現在のバージョンではMath.min関数は使用していません。そのまま使用できます。
ダウンロード
Delphi 2006で動作確認していますが、Mathライブラリを削ったのでDelphi 6でも動くと思います。
UnicodeRichEdit.pas
UnicodeRichEdit.pas.txt
ソースコード
type
CTextStreamBuffer = record
lpszPos : LPCWSTR;
dwLeftLen: DWORD;
end;
PTextStreamBuffer = ^CTextStreamBuffer;
implementation
//元に戻す
procedure DoRichEditUndo(const RichEdit : TRichEdit);
begin
SendMessageW(RichEdit.Handle, EM_UNDO, 0, 0);
end;
//やり直し
procedure DoRichEditRedo(const RichEdit : TRichEdit);
begin
SendMessageW(RichEdit.Handle, EM_REDO, 0, 0);
end;
//切り取り
procedure DoRichEditCut(const RichEdit : TRichEdit);
begin
DoRichEditCopy(RichEdit);
DoRichEditDelete(RichEdit);
end;
//コピー
procedure DoRichEditCopy(const RichEdit : TRichEdit);
var
S : WideString;
begin
S := GetRichEditSelText(RichEdit);
gpcStrToClipboard(S);
end;
//貼り付け
procedure DoRichEditPaste(const RichEdit : TRichEdit);
var
Tmp :WideString;
begin
Tmp := gfnsStrFromClipboard;
WriteToSelected(RichEdit,Tmp);
end;
//削除
procedure DoRichEditDelete(const RichEdit : TRichEdit);
begin
SendMessageW(RichEdit.Handle, EM_REPLACESEL, WPARAM(1), LPARAM(PWideChar(WideString(”))));
end;
//全て選択
procedure DoRichEditSelAll(const RichEdit : TRichEdit);
begin
SendMessageW(RichEdit.Handle, EM_SETSEL, 0, – 1);
end;
function GetRichEditTextLength(const Dest:TRichEdit):Integer;
var
ST : GETTEXTLENGTHEX;
begin
ST.flags := GTL_USECRLF OR GTL_NUMBYTES;
ST.codepage := 1200;
Result := SendMessageW(Dest.Handle, EM_GETTEXTLENGTHEX,
Integer(@ST), 0) + SIZEOF(WideChar);
end;
//全テキスト取得
function GetRichEditText(const Dest:TRichEdit):WideString;
var
SzText : Array of Byte;
dwSize : DWORD;
P : GETTEXTEX;
begin
dwSize := GetRichEditTextLength(Dest);
SetLength(SzText,dwSize);
P.cb := dwSize;
P.flags := GT_USECRLF;
P.codepage := 1200;
P.lpDefaultChar := NIL;
P.lpUsedDefChar := 0;
SendMessageW(Dest.Handle, EM_GETTEXTEX, Integer(@P),Integer(@SzText[0]));
Result := PWideChar(SzText);
end;
//選択テキスト取得
//テキスト選択に関してバグを修正しています。このまま使用してください。
function GetStreamCallBack(dwCookie: Integer; pbBuff: PByte;
cb: Longint; var pcb: Longint): Longint; stdcall;
var TempCookie : LPCWStr;
begin
Result:= 0;
try
TempCookie := LPCWStr(dwCookie);
TempCookie := Pointer((dwCookie + Length(TempCookie) * SizeOf(WideChar)));
copymemory(TempCookie,pbBuff,DWord(cb));
pcb := cb;
except
Result:= 1;
end;
end;
function GetRichEditSelText(const Dest:TRichEdit):WideString;
var
FStreamRec : TEditStream;
lr_Range: TCharRange;
li_Len: Cardinal;
lp_Buff: PWideChar;
const
GT_SELECTION : Integer = 2;
begin
FillChar(lr_Range, SizeOf(lr_Range), 0);
SendMessageW(Dest.Handle, EM_EXGETSEL, 0, LPARAM(@lr_Range));
li_Len := (lr_Range.cpMax – lr_Range.cpMin);
//単位Byteであって文字ではない
lp_Buff := AllocMem((li_Len + 1) * SizeOf(WideChar));
//過剰だが不足よりマシ
try
FStreamRec.dwCookie := Integer(lp_Buff);
FStreamRec.pfnCallback := GetStreamCallBack;
Dest.Perform( EM_STREAMOUT,SF_TEXT or SF_UNICODE OR SFF_SELECTION,
Longint(@FStreamRec));
Result := lp_Buff;
finally
FreeMem(lp_Buff);
end;
end;
//キャレットを最後に強制移動
procedure DoLastCaret(const RE:TRichEdit);
begin
RE.SelStart := $7fffffff;
end;
//下記の関数に必要な処理
function EditStreamCallBack(dwCookie: Integer; pbBuff: PByte;
cb: Longint; var pcb: Longint): Longint; stdcall;
var
MinS : Int64;
Dat : CTextStreamBuffer;
begin
Dat := PTextStreamBuffer(dwCookie)^;
try
Result:= 0;
if (Dat.dwLeftLen <= 0) then begin
pcb := 0;
Exit;
end;
MinS := DWord(cb);
if Dat.dwLeftLen <= MinS then MinS := Dat.dwLeftLen);
copymemory(pbBuff,Pointer(Dat.lpszpos),MinS);
if Dat.dwLeftLen < MinS then
PTextStreamBuffer(dwCookie)^.dwLeftLen := 0
else PTextStreamBuffer(dwCookie)^.dwLeftLen := dat.dwLeftLen – MinS;
PTextStreamBuffer(dwCookie)^.lpszPos := Pointer(Integer(Dat.lpszPos) + MinS);
pcb := MinS;
except
Result:= 1;
end;
end;
//選択テキストの置き換え
procedure WriteToSelected(const Dest:TRichEdit;const Text : WideString);
var
FStreamRec : TEditStream;
T : CTextStreamBuffer;
begin
T.lpszPos := PWideChar(Text);
T.dwLeftLen:= Length(Text) * 2;
FStreamRec.dwCookie := Integer(@T);
FStreamRec.pfnCallback := EditStreamCallBack;
Dest.Perform( EM_STREAMIN,SF_TEXT or SF_UNICODE OR SFF_SELECTION,
Longint(@FStreamRec));
end;
//↓これだけ全くテストが出来ていないので使用は自己責任でお願いします
//行取得
function DoRichEditGetLine(const RichEdit : TRichEdit;
const Index:Integer):WideString;
var
PC: PWideChar;
PCLen: Word;
Len: integer;
function LineLength(line: integer):integer;
var
CharPos: integer;
begin
CharPos := SendMessageW(RichEdit.Handle,EM_LINEINDEX,line,0);
result := SendMessageW(RichEdit.Handle,EM_LINELENGTH,CharPos,0);
end;
begin
PCLen := LineLength(Index);
PCLen := PCLen+2;
PC := AllocMem(PCLen * 2);
PC[0] := wideChar(PCLen * 2);
try
SendMessageW(RichEdit.Handle,EM_GETLINE,Index,integer(PC));
Result := PC;
finally
FreeMem(PC);
end;
end;
