TRichEdit一部重複の装飾変更

解決

まったりもっこり  2012-06-17 20:45:27  No: 42499  IP: 192.*.*.*

お世話になります
TRichEditにて
一部を選択→ボールド
そのまた一部から始めて後ろに続く文字まで選択して→下線
したとき、重なった部分のボールドが解除されてしまいます
「太字で」の「太字」をボールド
その後「字で」を下線に変換です

var
  Style:TFontStyle;
begin
  if (Sender as TComponent).Tag=0 then//B
    Style:=fsBold else Style:=fsUnderline;
  with RichEdit1 do
  begin
    if Style in SelAttributes.Style then
    begin
      SelAttributes.Style:=SelAttributes.Style - [Style];
    end else
    begin
      SelAttributes.Style:=SelAttributes.Style + [Style];
    end;
  end;
end;
装飾の方法は全くの基礎通りだと思うのですがワードパッドでは出来るので
何か方法があるとは思うのですが、SelAttributes を一文字ずつ調べていくしかないのでしょうか
開発環境は Win7-64 Delphi2009 ですが D5 でも確認しています

以上、よろしくお願いいたしますm(_ _)m

編集 削除
Atchoum  2012-06-18 16:08:33  No: 42500  IP: 192.*.*.*

試してみました。


アンダーラインを設定する処理
var CFormat: CHARFORMAT2;//RichEditをusesにいれる
begin
  FillChar(CFormat, SizeOf(CFormat), 0);
  CFormat.cbSize := SizeOf(CFormat);

  //アンダーライン
  CFormat.dwEffects := CFormat.dwEffects or CFE_UNDERLINE;
  CFormat.dwMask := CFM_UNDERLINE;

  RichEdit1.Perform(EM_SETCHARFORMAT, SCF_SELECTION, Longint(@CFormat));
end;

ボールドを設定する処理
var CFormat: CHARFORMAT2;//RichEditをusesにいれる
begin
  FillChar(CFormat, SizeOf(CFormat), 0);
  CFormat.cbSize := SizeOf(CFormat);

  //ボールド
  CFormat.dwEffects := CFormat.dwEffects or CFE_BOLD;
  CFormat.dwMask := CFM_BOLD;

  RichEdit1.Perform(EM_SETCHARFORMAT, SCF_SELECTION, Longint(@CFormat));
end;

これで太字とアンダーラインが保持できました。

うまいこと解除も盛り込んで、
できたらサンプルも載せていただけると助かります。

編集 削除
まったりもっこり  2012-06-18 18:57:43  No: 42501  IP: 192.*.*.*

ありがとうございます、完璧です
>できたらサンプルも
と仰るので出来るだけ短くまとめました

//事前に数値を入れておく
procedure TForm1.FormCreate(Sender: TObject);
begin//uses RichEdit
  BoldSpeedButton.Tag:=CFE_BOLD;
  ItalicSpeedButton.Tag:=CFE_ITALIC;
  UnderlineSpeedButton.Tag:=CFE_UNDERLINE;
  StrikeoutSpeedButton.Tag:=CFE_STRIKEOUT;
  ProtectedSpeedButton.Tag:=CFE_PROTECTED;
  LinkSpeedButton.Tag:=CFE_LINK;
end;

//共通イベントハンドラ
procedure TForm1.BoldSpeedButtonClick(Sender: TObject);
var
  CFormat: CHARFORMAT2;//RichEditをusesにいれる
  CEffects:integer;
begin
  FillChar(CFormat, SizeOf(CFormat), 0);
  CFormat.cbSize := SizeOf(CFormat);
  CEffects:=(Sender as TComponent).Tag;

  CFormat.dwEffects := CFormat.dwEffects or CEffects;
  CFormat.dwMask := CEffects;
  RichEdit1.Perform(EM_SETCHARFORMAT, SCF_SELECTION, Longint(@CFormat));
end;

以上、ありがとうございましたm(_ _)m

編集 削除
まったりもっこり  2012-06-18 19:00:44  No: 42502  IP: 192.*.*.*

あ、解除だったのですね（ぎゃあ恥ずかしい）
出直します

編集 削除
まったりもっこり  2012-06-18 21:05:32  No: 42503  IP: 192.*.*.*

ワードパッドで確認しましたら
文字列の一部にスタイルが含まれている場合には解除されないようですので
（「太普通太」を選択してボールドボタンをクリックすると全て太字になります）
解除の方は普通に
 if Style in SelAttributes.Style then
で False なら設定してしまうという仕様とします
ありがとうございました。

編集 削除
まったりもっこり  2012-06-18 21:07:15  No: 42504  IP: 192.*.*.*

Protected と Link は見なかったことにしてください
何度もスレ汚しすみませんでした

編集 削除
まったりもっこり  2012-06-19 01:34:30  No: 42505  IP: 192.*.*.*

やっぱり気になったのでちゃんと書きました
冗長ですがこれでどうでしょう
procedure TForm1.SetFontStyle(Style: TFontStyle);
var
  CFormat: CHARFORMAT2;//RichEditをusesにいれる
  CEffects:integer;
begin
  FillChar(CFormat, SizeOf(CFormat), 0);
  CFormat.cbSize := SizeOf(CFormat);

  if Style=fsBold then CEffects:=CFE_BOLD else
  if Style=fsItalic then CEffects:=CFE_ITALIC else
  if Style=fsUnderline then CEffects:=CFE_UNDERLINE else
  {if Style=fsStrikeOut then }CEffects:=CFE_STRIKEOUT;
  if Style in RichEdit1.SelAttributes.Style then//一部でも違ったら False になる
  begin
    RichEdit1.Perform(EM_GETCHARFORMAT, SCF_SELECTION, Longint(@CFormat));
    CFormat.dwEffects := CFormat.dwEffects - CEffects;
  end else
  begin
    CFormat.dwEffects := CFormat.dwEffects or CEffects;
  end;
  CFormat.dwMask := CEffects;
  RichEdit1.Perform(EM_SETCHARFORMAT, SCF_SELECTION, Longint(@CFormat));
end;

編集 削除
Atchoum  2012-06-19 09:41:26  No: 42506  IP: 192.*.*.*

まったりもっこりさん、こんにちわ。

お役に立ててよかったです。
また、サンプルありがとうございました。

解除もできてしまうなんて便利ですね！
結構RichEditをつかった編集があるので参考にさせていただきます。

編集 削除