unit UnicodeRichEdit; { Ansi版DelphiでUnicodeテキストを扱うRichEditをコントロールするクラス Unicode Text Controler for RichEdit in ANSI Delphi Author: くるみ( http://www.vampire-blood.net/ ) Oridinal Source: http://www.vampire-blood.net/837.html } interface uses Types, Windows, RichEdit, ComCtrls, Messages, Forms; type CTextStreamBuffer = record lpszPos : LPCWSTR; dwLeftLen: DWORD; end; PTextStreamBuffer = ^CTextStreamBuffer; { function gfnsStrFromClipboard: WideString; procedure gpcStrToClipboard(sText: WideString); } procedure DoRichEditUndo(const RichEdit : TRichEdit); procedure DoRichEditRedo(const RichEdit : TRichEdit); procedure DoRichEditCut(const RichEdit : TRichEdit); procedure DoRichEditCopy(const RichEdit : TRichEdit); procedure DoRichEditPaste(const RichEdit : TRichEdit); procedure DoRichEditDelete(const RichEdit : TRichEdit); procedure DoRichEditSelAll(const RichEdit : TRichEdit); function GetRichEditText(const Dest:TRichEdit):WideString; function GetRichEditSelText(const Dest:TRichEdit):WideString; procedure DoLastCaret(const RE:TRichEdit); procedure WriteToSelected(const Dest:TRichEdit;const Text : WideString); function DoRichEditGetLine(const RichEdit : TRichEdit; const Index:Integer):WideString; implementation //ここに gfnsStrFromClipboard および gpcStrToClipboard 関数をコピペしてください。 //ソースは http://drang.s4.xrea.com/program/tips/unicode/vcl_richedit.html ここにあります。 //元に戻す 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); //SendMessageW(RichEdit.Handle, EM_REPLACESEL, WPARAM(1), LPARAM(PWideChar(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 := SendMessage(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; SendMessage(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 Mins > Dat.dwLeftLen 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; 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; end.