ホーム >プログラム >Delphi 6 ローテクTips

Unicode対応のRichEdit

Delphi 6でウムラウトのようなUnicode文字の入力を行うためにUnicode入力対応のリッチエディットコントロールを作ろうというページ。
ただし文字装飾については全く考慮に入れていません。
プレーンテキストの扱いについてのみの記述になります。

実はVCLのTRichEditはそのままでもUnicode対応であることが後で分かりました。

参考サイト

CreateWindow
http://msdn.microsoft.com/library/ja/jpwinui/html/_win32_createwindow.asp?frame=true

AB-024：リッチエディットコントロールの作成
http://abfan.mxm-wk.com/024.html

かつてリッチエディット用ライブラリのロードの説明のあったサイト。

始めに

Unicode対応のRichEditはそれ用のライブラリを別に読み込まないといけないのでその分Unicode対応のEditとMemoより面倒になります。
また右クリックしてもデフォルトでポップアップメニューが出ません。
Unicode対応のEditやMemoであれば特別なことをしなくても右クリックすればポップアップメニューが出てくれるのですがRichEditの場合はどうやら自前で作ってやらないといけないようです。
考えようによってはオリジナルのメニューを表示させられるというメリットでもあるのですが。

それとEditやMemoではウムラウトのようなUnicode文字はコピペでしか入力できませんでしたが、RichEditではIMEパッドからの入力や単語登録したウムラウトのようなUnicode文字の入力も文字化けせずちゃんと入力できます。
がんばって自作メニューを作る価値はあるようです。

作成

リッチエディットを作成するにはリッチエディット用のライブラリをロードしたり開放する必要があります。

まずライブラリのロード用の変数を宣言します。
プログラムの終了時にユニットの終了部で開放するのでこの位置（というかスコープ）で。

implementation
uses
  RichEdit;

var
  lhRichEditModule: THandle;

作成。
ライブラリのロードが加わります。
ライブラリは一度だけ読み込めばOKです。
RicheditをCreateする度に読み込む必要はありません。

  //ライブラリのロード
  if (lhRichEditModule = 0) then begin
    lhRichEditModule := LoadLibrary('Riched20.dll');
    if (lhRichEditModule <= HINSTANCE_ERROR) then begin
      lhRichEditModule := 0;
    end;
  end;

  //シングルライン
  F_hEditHandle := CreateWindowW(
      RICHEDIT_CLASSW,
      nil,
      WS_CHILD
      or WS_HSCROLL
      or ES_AUTOHSCROLL
      or ES_NOHIDESEL
      or WS_VISIBLE,
      8,       //Left
      8,       //Top
      121,     //幅
      20,      //高さ
      Handle,  //親ウィンドウのハンドル
      0,
      0,
      nil
  );
  //マルチライン
  F_hEditHandle := CreateWindowW(
      RICHEDIT_CLASSW,
      nil,
      WS_CHILD
      or ES_MULTILINE
      or ES_AUTOVSCROLL
      or ES_AUTOHSCROLL
      or WS_VSCROLL
      or WS_HSCROLL
      or ES_WANTRETURN
      or ES_NOHIDESEL
      or WS_VISIBLE,
      8,       //Left
      8,       //Top
      185,     //幅
      89,      //高さ
      Handle,  //親ウィンドウのウィンドウハンドル
      0,
      0,
      nil
  );

作成ではCreateWindowWの第一引数の値が'Edit'からRICHEDIT_CLASSWに変わっただけです。
RICHEDIT_CLASSWはRichEdit.pasに宣言されているのでusesにRichEditを加える必要があります。
ちなみにリッチエディットコントロールもウィンドウスタイルにES_MULTILINEを指定しなければ一行入力のエディットボックスになります。

後始末。
ロードしたライブラリはプログラムの終了時に開放しなければなりません。
ということでユニットの末尾、finalizationに付け足します。

initialization
  lhRichEditModule := 0;

finalization
  if (lhRichEditModule <> 0) then begin
    FreeLibrary(lhRichEditModule);
  end;


end.

使い方

Unicode対応のEditやMemoと同じようにDrawGridを親ウィンドウにして運用するのが良いかと思います。
VCLコントロールが他にない場合であればDrawGridを使う必要もないとは思いますが。

下記ではフォーム内ですべてまかなっているためOnCreateイベントでRichEdit用のライブラリをロードしてOnDestroyでライブラリを開放するという簡便な方法をとっています。

type
  TForm1 = class(TForm)

   ...

  private
    { Private 宣言 }
    F_hRichEditModule: THandle;
    F_hEditHandle: HWND;

   ...

implementation
uses
  RichEdit;


procedure TForm1.FormCreate(Sender: TObject);
begin
  //ライブラリのロード
  F_hRichEditModule := LoadLibrary('Riched20.dll');

  //マルチライン
  F_hEditHandle := CreateWindowW(
      RICHEDIT_CLASSW,
      nil,
      WS_CHILD
      or ES_MULTILINE
      or ES_AUTOVSCROLL
      or ES_AUTOHSCROLL
      or WS_VSCROLL
      or WS_HSCROLL
      or ES_WANTRETURN
//      or ES_NOHIDESEL
      or WS_VISIBLE,
      0,             //Left
      0,             //Top
      ClientWidth,   //幅
      ClientHeight,  //高さ
      Handle,        //親ウィンドウのウィンドウハンドル
      0,
      0,
      nil
  );

    ...

end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  //終了処理
  DestroyWindow(F_hEditHandle);
  FreeLibrary(F_hRichEditModule);
end;

ポップアップメニュー

ポップアップメニューは自作しないとなりません。
とはいえCreatePopupMenu APIなどを使う必要はなく、普通にDelphiのメニューデザイナで作ったものを親ウィンドウにしたコントロールのPopupMenuプロパティにセットすればOKです。
「元に戻す」「やり直し」「切り取り」「コピー」「貼り付け」「削除」「全て選択」など一通りのものは揃っていますしちょっと手を加えれば「検索」もできます。

まずは肝心のメニューの作成ですがこれはDelphiのメニューデザイナで作ります。

type
  TForm1 = class(TForm)
    PopupMenu1: TPopupMenu;
    Edit_Undo: TMenuItem;
    Edit_Redo: TMenuItem;
    N1: TMenuItem;
    Edit_Cut: TMenuItem;
    Edit_Copy: TMenuItem;
    Edit_Paste: TMenuItem;
    Edit_Delete: TMenuItem;
    N2: TMenuItem;
    Edit_SelectAll: TMenuItem;

  ...

とりあえずこんな感じで。
次にUnicode対応のクリップボード関数を作ります。

function gfnsStrFromClipboard: WideString;
//クリップボードの文字列を取得して返す
var
  li_Format: array[0..1] of Integer;
  li_Text: Integer;
  lh_Clip, lh_Data: THandle;
  lp_Clip, lp_Data: Pointer;
begin
  Result := '';
  li_Format[0] := CF_UNICODETEXT;
  li_Format[1] := CF_TEXT;
  li_Text := GetPriorityClipboardFormat(li_Format, 2);
  if (li_Text > 0) then begin
    if (OpenClipboard(Application.Handle)) then begin
      lh_Clip := GetClipboardData(li_Text);
      if (lh_Clip <> 0) then begin
        lh_Data := 0;
        if (GlobalFlags(lh_Clip) <> GMEM_INVALID_HANDLE) then begin
          try
            if (li_Text = CF_UNICODETEXT) then begin
              //Unicode文字列を優先
              lh_Data := GlobalAlloc(GHND or GMEM_SHARE, GlobalSize(lh_Clip));
              lp_Clip := GlobalLock(lh_Clip);
              lp_Data := GlobalLock(lh_Data);
              lstrcpyW(lp_Data, lp_Clip);
              Result := WideString(PWideChar(lp_Data));
              GlobalUnlock(lh_Data);
              GlobalFree(lh_Data);
              GlobalUnlock(lh_Clip);  //GlobalFreeはしてはいけない
            end else if (li_Text = CF_TEXT) then begin
              lh_Data := GlobalAlloc(GHND or GMEM_SHARE, GlobalSize(lh_Clip));
              lp_Clip := GlobalLock(lh_Clip);
              lp_Data := GlobalLock(lh_Data);
              lstrcpy(lp_Data, lp_Clip);
              Result := AnsiString(PAnsiChar(lp_Data));
              GlobalUnlock(lh_Data);
              GlobalFree(lh_Data);
              GlobalUnlock(lh_Clip);  //GlobalFreeはしてはいけない
            end;
          finally
            if (lh_Data <> 0) then GlobalUnlock(lh_Data);
            CloseClipboard;
          end;
        end;
      end;
    end;
  end;
end;

procedure gpcStrToClipboard(sText: WideString);
//クリップボードへ文字列をセットする
//Unicode文字列としてセットすると同時に（Unicodeでない）プレーンテキストとしてもセットする
var
  li_WLen, li_Len: Integer;
  ls_Text: AnsiString;
  lh_Mem:  THandle;
  lp_Data: Pointer;
begin
  li_WLen := (Length(sText) + 1) * 2;
  ls_Text := AnsiString(sText);
  li_Len  := Length(ls_Text) + 1;
  if (sText <> '') then begin
    if (OpenClipboard(Application.Handle)) then begin
      try
        EmptyClipboard;
        //CF_UNICODETEXT
        lh_Mem  := GlobalAlloc(GHND or GMEM_SHARE, li_WLen);
        lp_Data := GlobalLock(lh_Mem);
        lstrcpyW(lp_Data, PWideChar(sText));
        GlobalUnlock(lh_Mem);
        SetClipboardData(CF_UNICODETEXT, lh_Mem);
        //CF_TEXT
        lh_Mem  := GlobalAlloc(GHND or GMEM_SHARE, li_Len);
        lp_Data := GlobalLock(lh_Mem);
        lstrcpy(lp_Data, PChar(ls_Text));
        GlobalUnlock(lh_Mem);
        SetClipboardData(CF_TEXT, lh_Mem);
      finally
        CloseClipboard;
      end;
    end;
  end;
end;

各メニュー項目を実装します。

//元に戻す
procedure TForm1.Edit_UndoClick(Sender: TObject);
begin
  SendMessageW(F_hEditHandle, EM_UNDO, 0, 0);
end;

//やり直し
procedure TForm1.Edit_RedoClick(Sender: TObject);
begin
  SendMessageW(F_hEditHandle, EM_REDO, 0, 0);
end;

//切り取り
procedure TForm1.Edit_CutClick(Sender: TObject);
begin
  Edit_CopyClick(nil);
  Edit_DeleteClick(nil)
end;

//コピー
procedure TForm1.Edit_CopyClick(Sender: TObject);
var
  lr_Range: TCharRange;
  li_Len:   Cardinal;
  lp_Buff:  PWideChar;
begin
  FillChar(lr_Range, SizeOf(lr_Range), 0);
  SendMessageW(F_hEditHandle, EM_EXGETSEL, 0, LPARAM(@lr_Range));
  li_Len := (lr_Range.cpMax - lr_Range.cpMin +1) * 2;
  lp_Buff := AllocMem(li_Len);
  try
    SendMessageW(F_hEditHandle, EM_GETSELTEXT, 0, LPARAM(lp_Buff));
    gpcStrToClipboard(WideString(lp_Buff));
  finally
    FreeMem(lp_Buff);
  end;
end;

//貼り付け
procedure TForm1.Edit_PasteClick(Sender: TObject);
begin
  SendMessageW(F_hEditHandle, EM_REPLACESEL, WPARAM(1), LPARAM(PWideChar(gfnsStrFromClipboard)));
end;

//削除
procedure TForm1.Edit_DeleteClick(Sender: TObject);
begin
  SendMessageW(F_hEditHandle, EM_REPLACESEL, WPARAM(1), LPARAM(PWideChar(WideString(''))));
end;

//全て選択
procedure TForm1.Edit_SelectAllClick(Sender: TObject);
begin
  SendMessageW(F_hEditHandle, EM_SETSEL, 0, -1);
end;


状況に応じてメニュー項目のEnabledプロパティを変更するならポップアップメニューのOnPopupイベントを利用します。

procedure TForm1.PopupMenu1Popup(Sender: TObject);
var
  li_Start, li_End: Longint;
begin
  Edit_Undo.Enabled      := BOOL(SendMessageW(F_hEditHandle, EM_CANUNDO, 0, 0));
  Edit_Redo.Enabled      := BOOL(SendMessageW(F_hEditHandle, EM_CANREDO, 0, 0));
  Edit_Paste.Enabled     := BOOL(SendMessageW(F_Memo.Handle, EM_CANPASTE, WPARAM(CF_TEXT), 0));
  Edit_SelectAll.Enabled := SendMessageW(F_Memo.Handle, EM_GETLINECOUNT, 0, 0) > 0;
  //範囲選択の長さを取得
  li_Start := 0; li_End := 0;
  SendMessageW(F_hEditHandle, EM_GETSEL, WPARAM(@li_Start), LPARAM(@li_End));
  Edit_Cut.Enabled    := (li_End - li_Start) > 0;
  Edit_Copy.Enabled   := Edit_Cut.Enabled;
  Edit_Delete.Enabled := Edit_Cut.Enabled;
end;

注意点

一つ注意する点はTabが入力できないということです。
どうもVCLに横取りされてしまうようで、回避策としてダミーでメニュー項目を作りショートカットにTabキーを割り当て、Tabコードを挿入するようにします。

//Tabの入力
procedure TForm1.Edit_TabClick(Sender: TObject);
//タブキーをVCLコントロールに奪われてしまうために対策
var
  ls_Tab : WideString;
begin
  ls_Tab := #9;
  SendMessageW(F_hEditHandle, EM_REPLACESEL, WPARAM(1), LPARAM(PWideChar(ls_Tab)));
end;

Richeditが一つだけならそう面倒でもないのですが、二つ三つと増えると一つのメニュー項目のショートカットで処理を振り分けないといけなくなるのでややこしくなります。
例えば上述のTabを入力する場合でもフォーカスがどのRicheditにあるのか判定して振り分けるとか、あるいはTabコードの入力にするのかコントロールの移動にするのかも考慮しないといけなくなってくるとなおさら複雑になります。

サイズ

LeftやTop、WidthやHeightの変更はSetWindowPos APIを使います。

//常にフォームのクライアント領域いっぱいにするサンプル。
procedure TForm1.FormResize(Sender: TObject);
begin
  SetWindowPos(F_hEditHandle, HWND_TOP, 0, 0, ClientWidth, ClientHeight, SWP_NOACTIVATE or SWP_NOZORDER);
end;

ClientRectの取得。
GetClientRect APIを使います。

var
  lrc_ClientRect: TRect;
begin
  GetClientRect(F_hEditHandle, lrc_ClientRect);

スクロールバーはクライアント領域外になります。
つまりスクロールバーがある場合はその内側の領域が返ります。

BoundsRectの取得。

var
  lrc_BoundsRect: TRect;
  lpt_Pos: TPoint;
begin
  GetWindowRect(F_hEditHandle, lrc_BoundsRect);  //スクリーン座標のRect値を取得
  lpt_Pos := Point(0, 0);
  ClientToScreen(Handle, lpt_Pos); //Handleは親ウィンドウのウィンドウハンドル
  OffsetRect(lrc_BoundsRect, -lpt_Pos.X, -lpt_Pos.Y);


LeftやTop、WidthやHeightの取得はまずBoundsRectの値を取得し、その値から算出します。

var
  lrc_BoundsRect: TRect;
  lpt_Pos: TPoint;
  iLeft, iTop, iWidth, iHeight: Integer;
begin
  GetWindowRect(F_hEditHandle, lrc_BoundsRect);  //スクリーン座標のRect値を取得
  lpt_Pos := Point(0, 0);
  ClientToScreen(Handle, lpt_Pos); //Handleは親ウィンドウのウィンドウハンドル
  OffsetRect(lrc_BoundsRect, -lpt_Pos.X, -lpt_Pos.Y);

  iLeft   := lrc_BoundsRect.Left;
  iTop    := lrc_BoundsRect.Top;
  iWidth  := lrc_BoundsRect.Right  - lrc_BoundsRect.Left;
  iHeight := lrc_BoundsRect.Bottom - lrc_BoundsRect.Top;

フォームのサイズが変わったときにRicheditのサイズも変更しなければならないときはOnFormResizeイベントに記述します。

procedure TForm1.FormResize(Sender: TObject);
begin
  //フォームのクライアントに合わせる
  SetWindowPos(F_hEditHandle, HWND_TOP, 0, 0, ClientWidth, ClientHeight, SWP_NOACTIVATE or SWP_NOZORDER);
end;

フォント

フォントの設定はTFontのHandleをセットします。

  //フォントのセット
  SendMessageW(F_hEditHandle, WM_SETFONT, WPARAM(Self.Font.Handle), 0);

セットしたフォントにウムラウトのようなUnicode文字がない場合、自動でフォントを変更してウムラウトのようなUnicode文字を表示する機能があります。
フォントの見た目が変わってしまうのが難点ですが表示できないよりはましでしょうと。
デフォルトはオンです。

オンにする場合。

var
  li_Opt: Integer;
begin
  //オートフォントのセット
  li_Opt := SendMessageW(F_hEditHandle, EM_GETLANGOPTIONS, 0, 0) or IMF_AUTOFONT;
  SendMessageW(F_hEditHandle, EM_SETLANGOPTIONS, 0, LPARAM(li_Opt));


オフにする場合。

var
  li_Opt: Integer;
begin
  //オートフォントの解除
  li_Opt := SendMessageW(F_hEditHandle, EM_GETLANGOPTIONS, 0, 0);
  if ((li_Opt and IMF_AUTOFONT) <> 0) then Dec(li_Opt, IMF_AUTOFONT);
  SendMessageW(F_hEditHandle, EM_SETLANGOPTIONS, 0, LPARAM(li_Opt));


オンのときにTrueを返す場合。

  //オートフォントが設定されているか
  Result := (SendMessageW(F_hEditHandle, EM_GETLANGOPTIONS, 0, 0) and IMF_AUTOFONT) <> 0;

文字色、背景色

//文字色
//http://www.interq.or.jp/chubu/r6/masm32/tute/tute033_Jp.html
var
  lr_Info: TCharFormatW;
begin
  FillChar(lr_Info, SizeOf(lr_Info), 0);
  lr_Info.cbSize := SizeOf(lr_Info);
  lr_Info.dwMask := CFM_COLOR;
  lr_Info.crTextColor := ColorToRGB(Font.Color); //文字色をセット
  SendMessageW(F_hEditHandle, EM_SETCHARFORMAT, SCF_ALL, LPARAM(@lr_Info));
//背景色
  SendMessageW(F_hEditHandle, EM_SETBKGNDCOLOR, 0, LPARAM(ColorToRGB(F_clBkColor)));

Unicode対応のRichEditクラスにしてみました。