リッチエディットの話(３)(1999/09/26)
新着情報 トップメニュー ボートメニュー 掲示板 お手紙はここ！

と言うわけで(いきなり？)、リッチエディットの着色を API で実行するように改良してみたら……コレがもう、早いの何のってEFINAKI1　やっぱり SelAttribute 遅すぎますねぇ。着色範囲の設定も SelStart と SelLength を使っていましたから、その遅さも決して引けは取らないのでしょうが……

情報源は About Delhi と言うところで、記事番号２１６番を参考にしてみました。


実際に使用しているコードを次に掲載します。要するにブロックを非タグ/タグの２つとして、指定位置から幾らか遡った位置からフロックごとに色をつける、と言う処理です。既にスパゲッチに近いものがあり、書き換えの余地が有るように思いますが……まぁ気にせんで下さい……


// Public,Method,文書の修正イベントへの割り込み処理
procedure TCustomTagEdit.Change;
begin
  (* テキストの変更がクリップボードからのペーストなら、
   * テキスト構造の変化を全部監視して再着色させる。
   * ここより先のメソッドで文字列その物に手を加えると EOutOfResources 例外が発生する！
   *)
  if (FPasteLength=0) then
  begin
    inherited;
  end else begin
    (* ペーストされた場合の処理 *)
    DyeingPartialText(FPasteStart,FPasteLength);
    FPasteLength  := 0;
  end;
end;

// Public,Method,ペーストされた範囲と、その前後のタグの色を再設定する
procedure TCustomTagEdit.DyeingPartialText( StartPos,RangeSize:Integer );
var
  Text: TCaption;
  I   : Integer;
  Max : Integer;
begin
  Text := Self.Text;

  (* 再着色の終了点を取得する *)
  I := StartPos + RangeSize + 1;
  while (I<Length(Text)) do
  begin
    if (Text[I]='>') then Break; // ←'<'を許可すると、着色が変になる。
    Inc(I);                       // 　1999-08-22の変更点を参照。
  end;
  Max := I;

  (* 同じく開始点を取得 *)
  I := StartPos;
  while (I>0) do
  begin
    if (Text[I]='>') then Break;
    Dec(I);
  end;

  (* その範囲内でタグに着色 *)
  while (I<Max)and(I<Length(Text)) do
    SetTextAttribute(Text,I,(Text[I]='<'));

  (* カーソル位置を然るべき位置に戻す *)
  Self.SelStart := StartPos+RangeSize;
  Self.SelLength:= 0;
end;

// Public,Method,テキストに着色する
procedure TCustomTagEdit.SetTextAttribute( AText:String; var Pos:Integer; TagFlag:Boolean );
var
  EventMask: LongInt;
  Range    : TCharRange;
  FontData : TCharFormat;
  TagString: String;
  TagName  : String;
  I        : Integer;
begin
  EventMask := SendMessage(Handle,EM_GETEVENTMASK,0,0);
  SendMessage(Handle,EM_SETEVENTMASK,0,0);

  TagString := '';
  TagName   := '';

  if (TagFlag) then
  begin
    (* タグとして着色する *)

    (* 着色する範囲を決める *)
    Range.cpMin := Pos-1;
    while (ATExt[Pos]<>'>') do
    begin
      TagString := TagString + AText[Pos];
      if (Pos>=Length(AText)) then Break; (* ファイル終端チェック *)
      Inc(Pos);
    end;
    Range.cpMax := Pos;

    (* タグによって体裁が違うのでタグを調べまする〜 *)
    I := 2;
    while ((TagString[I]<>' ')and(TagString[I]<>'>')and(I<=Length(TagString))) do
    begin
      TagName := TagName+TagString[I];
      Inc(I);
    end;
    if ExistWord(TagName,'BR', 0) then FontData := ConvertFontData(Self.Fonts.fntReturn)
    else if ExistWord(TagString,'!--',3) then FontData := ConvertFontData(Self.Fonts.fntComment)
    else FontData := ConvertFontData(Self.Fonts.fntTag);

    Self.Perform(EM_EXSETSEL,      0, lParam(@Range));
    Self.Perform(EM_SETCHARFORMAT, 1, lParam(@FontData));
    
  end else begin
    (* 文章として着色する *)

    Range.cpMin := Pos;
    while (Text[Pos]<>'<') do
    begin
      if (Pos>=Length(Text)) then Break;
      Inc(Pos);
    end;
    Range.cpMax := Pos;
    FontData := ConvertFontData(Self.Fonts.fntNormal);
    
    Self.Perform(EM_EXSETSEL,      0, lParam(@Range));
    Self.Perform(EM_SETCHARFORMAT, 1, lParam(@FontData));
  end;

  SendMessage(Handle,EM_SETEVENTMASK,0,EventMask);  (* マスク解除 *)
end;


TRichEdit に API で色をつける(SelAttribute の真似をする)ための注意点など。

まぁ、メッセージを投げるのは上記の通りの「呪文」で良いわけだが、それに渡すパラメータについてはそうそう資料もないので、およその説明だけしておくと言ううコトで。

コード中の Range:TCharRange という構造体は、テキストを選択する範囲を指定するためにある。その宣言は
　TCharRange = record
　　cpMin: Longint;
　　cpMax: LongInt;
　end;

となっておいて、cpMin は TRichEdit.SelStart と全く同じであり、cpMax は TRichEdit.SelStart+TRichEdit.SelLength と同じ意味を持つ。

FontData:TCharFormat 構造体はその宣言が
　TCharFormat = record
　　cbSize: UINT;
　　dwMask: Longint;
　　dwEffects: Longint;
　　yHeight: Longint;
　　yOffset: Longint;
　　crTextColor: TColorRef;
　　bCharSet: Byte;
　　bPitchAndFamily: Byte;
　　szFaceName: array[0..LF_FACESIZE - 1] of AnsiChar;
　end;

となっている(簡略化してあるが)。TFont からこの構造体への変換は手動で行うしかなくコツを要するので、以下のことに注意して作業していただきたい。

cbSize
　　構造体のサイズを格納する。これはまぁ cbSize := SizeOf(TCharFormat) でよい。

dwMask
　　有効にしたい装飾フラグを指定する。特定のフラグを指定しない場合、それに対応するフラグは dwEffects やその他に指定してあっても実際の変更を受けず、直前の状態を維持する。設定を変えたい場合は該当するフラグを設定し、必ず該当する変数を初期化すること。
　　dwMask には以下の値を設定できる。
　　　　CFM_BOLD
　　　　　太字／非太字を認識させる

　　　　CFM_ITALIC
　　　　　斜体／非斜体を認識させる

　　　　CFM_UNDERLINE
　　　　　下線をつけるかどうかを認識させる

　　　　CFM_STRIKEOUT
　　　　　取り消し線をつけるかどうか認識させる

　　　　CFM_PROTECTED
　　　　　(不明)

　　　　CFM_LINK
　　　　　(不明)

　　　　CFM_SIZE
　　　　　フォントのサイズを認識させる

　　　　CFM_COLOR
　　　　　フォントの色を認識させる

　　　　CFM_FACE
　　　　　フォント名を有効にする

　　　　CFM_OFFSET
　　　　　表示オフセット設定を有効にする

　　　　CFM_CHARSET
　　　　　キャラクタセットを設定できるようにする

dwEffects
　　dwEffects はテキストに対する装飾フラグを指定する。ただし、ただ設定しても前述の dwMask で有効化する設定を指定しなければ無視されるので注意されたい。
　　dwEffects には以下の値が設定できる。
　　　　CFE_BOLD
　　　　　テキストを太字にする

　　　　CFE_ITALIC
　　　　　テキストを斜体にする

　　　　CFE_UNDERLINE
　　　　　テキストに下線を加える

　　　　CFE_STRIKEOUT
　　　　　テキストに取り消し線を加える

　　　　CFE_PROTECTED
　　　　　(不明)

　　　　CFE_LINK
　　　　　(不明)

　　　　CFE_AUTOCOLOR
　　　　　色の設定を無効にし、Windowsで設定北「テキストの色」を使用する

yHeight
　　yHeight はフォントの大きさを 0.05 ピクセル単位で設定する。つまり、TFont.Size*20 を代入すれば良い。

crTextColor
　　crTextColor はフォントの色を指定する。これも単純に TFont.Color に相当する。

bCharSet
　　bCharSet はフォントのキャラクタセットを設定する。TFont.Charset に相当する。

bPitchAndFamily
　　良くはわからないが、TFont.Pitch に対応する値　DEFAULT_PITCH　VARIABLE_PITCH　FIXED_PITCH を使用するらしい。TFont.Pitch のヘルプを確認していただきたい。

szFaceName
　　szFaceName にはフォントの名前が入る。String型ではないので、単純に代入する事ができない事に注意。StrPLCopy(szFaceName, TFont.Name, SizeOf(szFaceName)) 等とするのが正しいようだ。


と、まぁ、ざっと調べたところじゃこんなところ。しかし……Delphiの場合、着色や検索に使うメッセージが WM_USER を使ったものなんだよな……なんだろう。インプライズが自前で用意しているってことなのだろうか？　うーむ……。

新着情報 トップメニュー ボートメニュー 掲示板 お手紙はここ！