フォントの属性を指定した文字検索
以前、フォントの属性を指定した文字検索の仕方を質問させていただいた者です。もう少し知恵をお貸しいただきたいです。
RichEditにBold体、Italic体混在した文書があります。
RadioGroupに指定した属性をチェックしてBottonを押すと、その属性を持った文字列を反転させて位置を示すようにしたいです。
RadioGroupに
○太文字
○イタリック体
○下線
○打ち消し線
と指定して
procedure TForm1.Button1Click(Sender: TObject);
var
i:integer;
begin
with RichEdit1 do
begin
for i:=0 to Length(RichEdit1.Lines.Text)-2 do
begin
SelStart:=i;
SelLength:=1;
case RadioGroup1.ItemIndex of
0:if fsBold in SelAttributes.Style then Break;
1:if fsItalic in SelAttributes.Style then Break;
2:if fsUnderline in SelAttributes.Style then Break;
3:if fsStrikeout in SelAttributes.Style then Break;
end;
end;
SelStart:=i;
SelLength:=1;
SetFocus;
end;
end;
やりたいこと
①最初の一つ目で検索が終わってしまうのを、複数の文字ができるようにしたい。
②SelLengthの取得（きちんと文字全体を反転表示させたい）
③SelAttributes.Sizeでフォントサイズ（整数型）を指定して同じように検索できるようにしたい。
自分で考えてやってみていますが、なかなか動いてくれません・・・よろしくお願いします。
環境は、Delphi6 Xpです。
とりあえず
unit Unit3;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls;
type
TForm3 = class(TForm)
RichEdit1: TRichEdit;
Button1: TButton;
Button2: TButton;
Button3: TButton;
Memo1: TMemo;
procedure Button2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private 宣言 }
public
function CheckAttrib(StartIndex,EndIndex: Integer; FontStyle: TFontStyle): Integer;
end;
var
Form3: TForm3;
CheckIndex: Integer;
implementation
{$R *.dfm}
//検索
procedure TForm3.Button1Click(Sender: TObject);
var
SaveCheckIndex: Integer;
begin
SaveCheckIndex := CheckIndex;
if CheckIndex = -1 then CheckIndex := 0;
CheckIndex := CheckAttrib(CheckIndex,Length(RichEdit1.Lines.Text)-2,fsBold);
if CheckIndex = -1 then
begin
if SaveCheckIndex > 1 then
begin
//1文字目以降の検索で見つからなかったのでもう一度先頭から検索する
CheckIndex := CheckAttrib(0,SaveCheckIndex,fsBold);
if CheckIndex = -1 then
begin
//先頭から検索しなおしても見つからなかった
Caption := '見つかりませんでした';
end;
end
else
begin
//1文字目の検索から見つからなかった
Caption := '見つかりませんでした';
end;
end;
end;
procedure TForm3.Button2Click(Sender: TObject);
begin
RichEdit1.SelAttributes.Style := [fsBold];
end;
function TForm3.CheckAttrib(StartIndex,EndIndex: Integer; FontStyle: TFontStyle): Integer;
var
StartAttrib,EndAttrib: Integer;
begin
Result := -1;
StartAttrib := -1;
EndAttrib := -1;
while (StartIndex < Length(RichEdit1.Lines.Text)-2) and (EndAttrib = -1) do
begin
RichEdit1.SelStart := StartIndex;
RichEdit1.SelLength := 1;
if StartAttrib = -1 then
begin
if FontStyle in RichEdit1.SelAttributes.Style then
begin
StartAttrib := StartIndex;
end;
end
else
begin
if not (FontStyle in RichEdit1.SelAttributes.Style) then
begin
EndAttrib := StartIndex;
end;
end;
Inc(StartIndex);
end;
if StartAttrib = -1 then
begin
RichEdit1.SelLength := 0;
end
else
begin
if EndAttrib = -1 then
begin
EndAttrib := Length(RichEdit1.Lines.Text) - StartIndex;
end;
RichEdit1.SelStart := StartAttrib;
RichEdit1.SelLength := EndAttrib - StartAttrib;
Result := EndAttrib;
RichEdit1.SetFocus;
end;
end;
procedure TForm3.FormCreate(Sender: TObject);
begin
CheckIndex := 0;
end;
end.
>KHE00221さん
ありがとうございます。
①最初の一つ目で検索が終わってしまうのを、複数の文字ができるようにしたい。
②SelLengthの取得（きちんと文字全体を反転表示させたい）
は解決できました！
後はフォントサイズ（整数型）を指定しての検索ですが、、、文字列検索でinteger型の指定検索は難しいでしょうか？何とかやってみようと思いますが、なにかアイディアがあれば教えてください。お願いします。
procedure TForm1.Button1Click(Sender: TObject);
var
RequestSize:integer;
NewString:string;
begin
if not InputQuery('Font','Size',NewString) then exit;
RequestSize:=StrToIntDef(NewString,0);
if RequestSize<1 then exit;
で、RequestSize と RichEdit1.SelAttributes.Size を比べてみては？
| ツイート |  |