☆RichEditの行間を広げる。

TMemoを使ったプログラムで、行間が狭くて読みづらいのでなんとかならないかと言われたので、 調べてみるとTRichEditなら行間を広げられるということで試してみました。

uses RichEdit;

// 行間の設定
procedure SetGyokan(RichEdit: TRichEdit; bLineSpacingRule: Byte);
var
  ParaFormat2: TParaFormat2;
begin
  RichEdit.SelectAll;
  FillChar(ParaFormat2, SizeOf(ParaFormat2), 0);
  ParaFormat2.cbSize := SizeOf(ParaFormat2);
  ParaFormat2.dwMask := PFM_LINESPACING;
  ParaFormat2.bLineSpacingRule := bLineSpacingRule;
  SendMessage(RichEdit.Handle, EM_SETPARAFORMAT, 0, Longint(@ParaFormat2));
  RichEdit.SelStart := 0;
end;

// 行間を広げる。
procedure TForm1.Button1Click(Sender: TObject);
begin
  SetGyokan(RichEdit1, 1); // 行間を1.5倍にする。
end;

// 行間を戻す。
procedure TForm1.Button2Click(Sender: TObject);
begin
  SetGyokan(RichEdit1, 0); // 行間を標準にする。
end;

行間1.5倍

行間標準

Rich Edit
http://msdn2.microsoft.com/en-us/library/bb787605%28VS.85%29.aspx

PARAFORMAT2 Structure
http://msdn2.microsoft.com/en-us/library/bb787942.aspx

☆TRichEditでハイパーリンク

URLやメールアドレスを含んだ文書を扱うとき、私はすぐにHTMLとWebBrowserの組み合わせを考えてしまうのですが、WebBrowserを使うと表示が遅いため、Wordのように文章中のリンクを操作できないかなと思いました。

ちょうど先日、マウス下の単語や文節を力技で取得するコードを書いたので、それとTRichEditを組み合わせればできるかなと思い、作業を開始しました。しかし、TRichEditでリンク文字を表現する方法を探していたところ、既にエレガントに、その機能を実装したサンプルを見つけてしまいました(笑)
ということで、そのサイトを紹介しておきますね。


About.com Delphi Programming
TRichEditURL - hyperlink aware RichEdit
http://delphi.about.com/od/vclwriteenhance/l/aa051804a.htm

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

☆メモ上でマウス下のテキスト取得で使った 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

★RichEdit と '×'

[Delphi 7]
フォームにTButtonとTRichEditを貼り付けて、次の処理を記述します。

procedure TForm1.Button1Click(Sender: TObject);
const
　S = '×';
begin
　RichEdit1.Lines.Add(S);
end;

これを実行すると次のメッセージのようなエラーになります。 RichEdit での行の挿入エラー

× の前か後ろに全角の文字を組み合わせるとエラーにならないのですが、エディターにそのような制限をするのは不適切でしょうし、具体的な解決方法を見つけられずにいます。

※Windows 2000 Pro(SP3) でもWindows XP Pro(SP2) でも同じ結果でした。
※Delphi8では、問題なく実行できます。（DLLが違うでしょうし、当たり前かな？）