☆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倍

Re1



行間標準

Re2



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名前空間を使い、エディットコントロールでカーソル下のテキストを選択させます。

実行させるとこんな感じです。

Undermouse


ここで問題になるのが、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が違うでしょうし、当たり前かな?)

|

その他のカテゴリー

ADO | ADT | API | ArrayList | ASP.NET | BDE | BDP.NET | BdpConnection | Borland Developer Studio 2006 | CAPICOM | class | ClipBoard | CodeEditor | Convert.ToString | Custom component | DBExpress | Delphi 2005 | Delphi 2006 | Delphi 2007 | Delphi XE2 | Delphi7 | Delphi8 | Device Driver | Dialog | Docking | DocuWorks | Docuworks SDK | Drag&Drop | Evernote | EXCEL | Firebird | FireMonkey | Game | General | Generics | Google Earth COM API | Google Maps | Google SketchUp | Graphic | IDE | Imm | Indy | InstallAware Express6 | InterBase Admin | JWW | Microsoft SQL Server | MyBase | OnMouseDown | Oracle XE | Paradox | PreviewHandler | PrintDialog | PrintPreviewDialog | PropertyGrid | PSDファイル | Ribbon Controls | RichTextBox | Servers | SubClass | TAction | TActionList | TAnimate | TButton | TCategoryButtons | TClientDataSet | TComboBox | TComboBoxEx | TCustomEdit | TDBGrid | TDockTabSet | TDrawGrid | TEdit | TExcelApplication | TFont | TForm | third party | TImage | TLabel | TList | TListBox | TListView | TMemo | TOpenDialog | TOutlookApplication | TPageControl | TPanel | TRichEdit | TShellResources | TStringGrid | TTabControl | TToolBar | TToolButton | TTreeView | TWebBrowser | Update | VCL Styles | WinInet | XE2 | XPman | オープン配列パラメータ | グループ化 | トランスレーションマネージャー | ファイル処理 | ファイル名処理 | 動的配列 | 投票 | 文字列処理 | 日本語入力 | 暗号 | | 音声合成利用