フォントの属性を指定した文字検索 (ID:37310)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

とりあえず

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.

←解決時は質問者本人がここをチェックしてください。

戻る