TRichEdit一部重複の装飾変更
解決お世話になります
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
試してみました。
アンダーラインを設定する処理
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;
これで太字とアンダーラインが保持できました。
うまいこと解除も盛り込んで、
できたらサンプルも載せていただけると助かります。
ありがとうございます、完璧です
>できたらサンプルも
と仰るので出来るだけ短くまとめました
//事前に数値を入れておく
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
あ、解除だったのですね（ぎゃあ恥ずかしい）
出直します
ワードパッドで確認しましたら
文字列の一部にスタイルが含まれている場合には解除されないようですので
（「太普通太」を選択してボールドボタンをクリックすると全て太字になります）
解除の方は普通に
if Style in SelAttributes.Style then
で False なら設定してしまうという仕様とします
ありがとうございました。
Protected と Link は見なかったことにしてください
何度もスレ汚しすみませんでした
やっぱり気になったのでちゃんと書きました
冗長ですがこれでどうでしょう
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;
まったりもっこりさん、こんにちわ。
お役に立ててよかったです。
また、サンプルありがとうございました。
解除もできてしまうなんて便利ですね！
結構RichEditをつかった編集があるので参考にさせていただきます。
| ツイート |  |