[ 文字列の操作 ] - Halbow 資料館

Delphi は、どちらかといえば文字列の操作が得意ではない。Perl や Python などのスクリプト言語は、言語の仕様レベルで文字列の操作がやりやすくなっている。ここでは、Delphi をつかって、文字列の操作をする関数を作ってみよう。

原理的には、AnsiPos() と Copy() を使えば、どんな文字列操作もできるだろうが、部分文字列の連続検索や置換などにつかうには、部分的な文字列のコピーが頻発するので効率がよくない。すこしでも高速であることが望ましいが、そのためにコードが複雑になって保守が困難になるのもいやだし、簡単すぎて低速なのも癪にさわる。だいたいのところで妥協するしかないだろう。Grep の実装のような本格的な高速検索アルゴリズムは知らないので、ここでは地道にポインタをずらしながら比較する、という素朴なアプローチをしている。

我々は日本に住んでいるので、文字列というと日本語のテキストを想定しなければならない。そうすると、必然的に、１バイト文字と２バイト文字が混じり合っているテキストを前提にして、操作をしなければならなくなる。このことに起因する様々な面倒くささが、文字列操作の関数の実装を複雑にしている。文頭や、エディットのキャレット位置は、２バイト文字の中間に位置することはないので、これを手がかりにして１バイト文字と２バイト文字をいちいち判断しながら全体を走査する必要がある。ここでは、TMemo や TRichEdit に表示されているテキストの中の部分文字列を連続的に検索・置換・加工するための関数を実装する。筆者が、このホームページ専用の HTML エディタをつくったときの副産物である。

５－０この章の内容

５－１部分文字列を数える

某ＢＢＳで、文字列の中の特定の部分文字列の数をかぞえるにはどうしたらよいか、という質問を読んで考えたことがそもそもの始まりである。いろいろな方法が思い浮かぶだろうが、ここでは以下のような関数をつくった。

function HowManyWords(const str,substr:string):Integer;
var
  PStr,PSubStr:PChar;
  s:string;
  L:integer;
begin
  result := 0;
  L := Length(substr);
  s  := str+StringOfChar(#0,L);
  PStr := PChar(s);
  PSubStr := PChar(substr);
  while byte(PStr^) <> 0 do begin
    if AnsiStrLComp(PStr,PSubStr,L)=0 then begin
      Inc(result);
      Inc(PStr,L);
    end else if Char(PStr^) in LeadBytes then
      Inc(PStr,2)
    else
      Inc(PStr);
  end;
end;

これはいまのところ期待通り動作している。コードを読んでみよう。日本語のテキストを検索する典型例である。一致判断には、AnsiStrLComp() を使っている。Ｄ５のヘルプから引用してみる。

AnsiStrLComp 関数

AnsiStrLComp は，大文字と小文字を区別して，2 つのヌルで終る文字列の最初の MaxLen バイトを
比較します。

ユニット SysUtils

カテゴリ 文字列処理ルーチン（ヌルで終わる）

function AnsiStrLComp(S1, S2: PChar; MaxLen: Cardinal): Integer;

説明

AnsiStrLComp は，大文字と小文字を区別して S1 と S2 を比較します。S1 または S2 が MaxLen 
バイトよりも大きい場合，AnsiStrLComp は最初の MaxLen バイトだけを比較します。比較演算は，
現在の Windows ロケールによって制御されます。戻り値は以下のとおりです。

条件	戻り値

S1 > S2	> 0
S1 < S2	< 0
S1 = S2（MaxLen 文字まで）	= 0


注意	この関数はマルチバイト文字セット（MBCS）をサポートします。
注意	AnsiStrLComp は，S1 と S2 がヌル文字まで等しく，そのヌル文字が MaxLen バイトの前にあ
     る場合，ヌルターミネータ以降も比較を継続できます。
注意	文字の大小関係は，ほとんどの Windows ロケールでは大文字 > 小文字ですが，ASCII では大
     文字 < 小文字となります。AnsiStrLComp('A'，'a'，1) は 1 を返しますが，'A'>'a' は 
     False となります。

比較する文字列の型は string ではなく PChar である。部分文字列の比較を string 型で行うのは、関数に渡すために文字列をコピーしなければならないので、我慢できないくらい非効率的である。これに対して、部分文字列を、関数に渡された文字列のなかの「位置」と長さで指定すると、コピーをする必要がない。したがって、文字列の走査はポインタをずらしながら位置を指定することで簡単に行うことができる。

    if AnsiStrLComp(PStr,PSubStr,L)=0 then begin
      Inc(result);
      Inc(PStr,L);
    end else if Char(PStr^) in LeadBytes then
      Inc(PStr,2)
    else
      Inc(PStr);

このように、一致したら result 値をインクリメントし、その部分文字列の長さ分だけ前進する。一致しないときは、２バイト文字の最初のバイトであるかどうかを判断し、そうであるときは２バイト前進し、そうでないときは１バイト前進する。これを while ループで繰り返す。

  while byte(PStr^) <> 0 do begin
    ：
    ：
  end;

終端は、#0 （ヌル文字）かどうかで判断する。かぞえる部分文字列は、１バイト文字一文字だけかもしれないので終端まできっちり走査する必要がある。しかし、長い部分文字列を探すときに、終端付近では、本当の終端を越えてアクセスすることがないように、検索文字列の長さ分だけ予め末尾にヌル文字を付け加えている。

  s  := str+StringOfChar(#0,L);
  PStr := PChar(s);

ここまでのキーポイントは、ポインタを使って位置走査をおこなうことと、LeadBytes を使って１バイト文字か、２バイト文字の最初の１バイトであるかを判断していることである。

５－２一括検索

前節では一致検索をしながらテキスト全体を走査することにより、特定の文字列の出現回数を数えた。一致したときは、ポインタの値からその位置が分かるので回数だけでなく位置のリストも同じ論理で取得できそうである。試してみよう。

type
  TIntArray = array[1..2000] of integer;

function SearchPos(const str,substr:string;var PosArray:TIntArray):integer;
var
  PStr,PSubStr:PChar;
  s:string;
  L,Indx:integer;
begin
  result := 0;
  Indx := 0;
  L := Length(substr);
  s := str+StringOfChar(#0,L);
  PStr := PChar(s);
  PSubStr := PChar(substr);
  while byte(PStr^) <> 0 do begin
    if AnsiStrLComp(PStr,PSubStr,L)=0 then begin
      Inc(result);
      PosArray[result] := Indx;
      Inc(PStr,L);Inc(Indx,L);
    end else if (Char(PStr^) in LeadBytes) then begin
      Inc(PStr,2);Inc(Indx,2);
    end else begin
      Inc(PStr); Inc(Indx);
    end;
  end;
end;

この関数は、前項の関数と論理は同じなので説明はいらないだろう。ポインタの値から（つまりアドレスから）一致したときの位置は計算できるが、ここでは、文字列のおのおののインデックスに相当する Indx をつかってポインタとともに前進させ位置を常時示すようにしている。おのおのの出現位置は、integer の配列型である TIntArray 型の変数を使って返す。また関数の戻り値は回数である。

procedure TForm1.Button1Click(Sender: TObject);
var
  PA:TIntArray;
  i,Num:integer;
  s:string;
begin
  s := Edit1.Text;
  Num := SearchPos(RichEdit1.Text,s,PA);
  Label1.Caption := IntToStr(Num);
  if Num > 0 then begin
    RichEdit1.Lines.BeginUpdate;
    for i := 1 to Num do begin
      RichEdit1.SelStart := PA[i];
      RichEdit1.SelLength := Length(s);
      RichEdit1.SelAttributes.Color := clRed;
    end;
    RichEdit1.Lines.EndUpdate;
  end;
  RichEdit1.SelStart := 0;
  RichEdit1.Perform(EM_SCROLLCARET,0,0);
  RichEdit1.SetFocus;
end;

実行の様子を右図に示す。RichEdit1 で、検索文字列を赤く表示している。SelStart を変更すると RichEdit は勝手にスクロールするので、色変換後に文頭にキャレットを持っていき、それが見えるまでスクロールしている。

RichEdit で色の変更後もスクロールの位置を変更されたくない場合には、次のようにする。

function GetVScrollPos(WC:TWinControl):integer;
var
  SI:TScrollinfo;
begin
  SI.cbSize := SizeOf(TScrollinfo);
  SI.fMask := SIF_POS;
  GetScrollInfo(WC.Handle,SB_VERT,SI);
  result := SI.nPos;
end;

procedure ControlVScroll(WC:TWinControl;ThumbPos:integer);
var
  Msg:TWMScroll;
begin
  Msg.Msg := WM_VSCROLL;
  Msg.Pos := ThumbPos;
  Msg.ScrollBar := 0;
  Msg.ScrollCode := SB_THUMBPOSITION;
  WC.Dispatch(Msg);
  Msg.ScrollCode := SB_ENDSCROLL;
  WC.Dispatch(Msg);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  PA:TIntArray;
  i,Num,ScrollPos:integer;
  s:string;
begin
  ScrollPos := GetVScrollPos(RichEdit1);
  s := Edit1.Text;
  Num := SearchPos(RichEdit1.Text,s,PA);
  Label1.Caption := IntToStr(Num);
  if Num > 0 then begin
    RichEdit1.Lines.BeginUpdate;
    for i := 1 to Num do begin
      RichEdit1.SelStart := PA[i];
      RichEdit1.SelLength := Length(s);
      RichEdit1.SelAttributes.Color := clRed;
    end;
    RichEdit1.Lines.EndUpdate;
  end;
  ControlVScroll(RichEdit1,ScrollPos);
  RichEdit1.SetFocus;
end;

実行の様子を右図にしめした。まず、スクロールが起こる前に、スクロールバーのつまみの位置を取得する。このために、GetScrollInfo() API をラップして GetVScrollPos 関数をつくった。これをつかって、スクロールが起こる前に、あらかじめつまみの位置を取得しておく。そして、色変換後に、その位置にスクロールさせるために、ControlVScroll を使っている。期待通り動作している。

５－３逐次検索

通常のエディタの「検索」のように、文頭から順次文字列を検索する機能を実現しよう。このためには任意の位置から検索をはじめて見つかった最初の位置を戻す関数を作るとよいだろう。しかし、「任意の位置」と言っても２バイト文字の真ん中の位置では困る。TMemo や TRichEdhit のキャレットの位置は、決して２バイト文字の中間になることはないので、キャレットの文字インデックスを示す SelStart の値を使えばよいだろう。さっそくつくってみよう。

function SearchNextPos(const str,substr:string;InitPos:integer):Integer;
var
  PStr,PSubStr:PChar;
  s:string;
  L,Indx:integer;
begin
  L := Length(substr);
  s := str+StringOfChar(#0,L);
  PStr := PChar(s);
  PSubStr := PChar(substr);

  Inc(PStr,InitPos);Indx := InitPos;
  result := -1;
  repeat
    if AnsiStrLComp(PStr,PSubStr,L)=0 then begin
      result := Indx;
      Break;
    end else if (Char(PStr^) in LeadBytes) then begin
      Inc(PStr,2);Inc(Indx,2);
    end else begin
      Inc(PStr); Inc(Indx);
    end;
  until byte(PStr^) = 0;
end;

この関数は、前節の SearchPos() とほとんど同じである。違う点は、検索開始位置 InitPos を受け取り、開始ポインタと Indx をその位置にインクリメントし、見つかったら repeat ループを抜けてすぐ復帰するところである。見つからなかったら、結果は -1 を返す。これを試してみよう。

procedure TForm1.Button1Click(Sender: TObject);
var
  CurPos:integer;
begin
  if RichEdit1.SelStart = 0 then begin
    if RichEdit1.SelLength = 0 then CurPos := 0
    else CurPos := RichEdit1.SelLength;
  end else
  if RichEdit1.SelLength = 0 then CurPos := RichEdit1.SelStart
  else
    CurPos := RichEdit1.SelStart+RichEdit1.SelLength;

  CurPos := SearchNextPos(RichEdit1.Text,Edit1.Text,CurPos);
  if CurPos <> -1 then begin
    RichEdit1.SelStart := CurPos;
    RichEdit1.SelLength := Length(Edit1.Text);
    RichEdit1.Perform(EM_SCROLLCARET,0,0);
    RichEdit1.SetFocus;
  end else
    ShowMessage('検索が終了しました');
end;

実行時の様子を右図に示す。コードを読んでみよう。最初の７行は InitPos を SelStart から渡すいろいろな状況を考慮している。

１）キャレットが文頭にあって選択されていない場合は、その位置から。
２）キャレットが文頭にあって選択済みだったら、その後から。
３）キャレットが文頭以外で、選択されていなければ、その位置から。
４）キャレットが文頭以外で、選択されていれば、その次の位置から。

というふうにして順次検索するための開始位置を決めている。

５－４逐次逆検索

前節とは逆の方向、つまりテキストを任意の位置から文頭の方向へ逐次検索する関数をつくろう。

function SearchRevNextPos(const str,substr:string;InitPos:integer):Integer;
var
  PStr,PSubStr:PChar;
  s:string;
  L,Indx:integer;
begin
  result := -1;
  Indx := 0;
  L := Length(substr);
  s := str+StringOfChar(#0,L);
  PStr := PChar(s);
  PSubStr := PChar(substr);
  while (byte(PStr^) <> 0) and (Indx < InitPos+1) do begin
    if AnsiStrLComp(PStr,PSubStr,L)=0 then begin
      result := Indx;
      Inc(PStr,L);Inc(Indx,L);
    end else if (Char(PStr^) in LeadBytes) then begin
      Inc(PStr,2);Inc(Indx,2);
    end else begin
      Inc(PStr); Inc(Indx);
    end;
  end;
end;

これは前々節の SearchPos 関数を改造して、文頭から検索して InitPos までで打ち切り、その直前に見つかった位置を返している。ポインタをデクリメントして検索するためには、直前の文字が１バイト文字か２バイト文字かを判断しなければならない。ByteType 関数を使えばできるが、これは判断するために文脈を遡るため、ポインタをデクリメントするたびに毎回使うのは、想像しただけで非効率であるのが我慢できない。それなら、文頭から一回だけ走査した方が論理的にもすっきりするだろう。（2003/01/28 訂正）

procedure TForm1.Button1Click(Sender: TObject);
var
  CurPos:integer;
begin
  CurPos := RichEdit1.SelStart;
  RichEdit1.SelStart := CurPos-1;
  if CurPos = RichEdit1.SelStart then RichEdit1.SelStart := CurPos-2;
  CurPos := SearchRevNextPos(RichEdit1.Text,Edit1.Text,RichEdit1.SelStart);
  if CurPos <> -1 then begin
    RichEdit1.SelStart := CurPos;
    RichEdit1.SelLength := Length(Edit1.Text);
    RichEdit1.Perform(EM_SCROLLCARET,0,0);
    RichEdit1.SetFocus;
  end else
    ShowMessage('検索が終了しました');
end;

実行時の様子を右図に示す。最初の３行は何をしているのだろうか？
TMemo や TRichEdit に２バイト文字を含むテキストを貼り付けて以下のコードを試してほしい。

procedure TForm1.Button1Click(Sender: TObject);
begin
  Memo1.SelStart := Memo1.SelStart-1;
  memo1.SetFocus;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  RichEdit1.SelStart := RichEdit1.SelStart-1;
  RichEdit1.SetFocus;
end;

試してみると分かるように、キャレットの直前の文字が１バイト文字であるときは、期待通り一つだけキャレットがバックする。しかし、直前の文字が２バイト文字であるときは、動作が分かれる。Win95、WinMe、Win2000 で試したところ、２バイト分バックするときもあれば全く移動しないときもあった。そこで、

  CurPos := RichEdit1.SelStart;
  RichEdit1.SelStart := CurPos-1;
  if CurPos = RichEdit1.SelStart then RichEdit1.SelStart := CurPos-2;

のようにして、移動しなければ２つだけバックするようにすると、どの場合もキャレットが文字の切れ目に位置して都合がよいのである。

５－５１バイト文字列の一括変換

長さ不定の文字列の一括検索の例として、１バイト文字列の一括検索をしてみよう。このホームページをご覧になると分かるように、１バイト文字列は太字で表示されている。はじめの頃は手作業で太字のタグを挿入していたのであるが、最近、こんなことはコンピュータにやらせようと思いたち、前節までの関数を応用してみたのである。

type
TIntArray = array[1..2000] of integer;

function IsNormalChar(const c:Char):Boolean;
begin
  result := Ord(c) in [Ord('!')..Ord('~')];
end;

function SearchNormalCharsPos(const str:string;
                              var Start,Lngth:TIntArray):integer;
var
  PStr:PChar;
  Indx,St:integer;
begin
  result := 0;
  Indx := 0;
  St := -1;
  PStr := PChar(str);
  while byte(PStr^) <> 0 do begin
    if (Char(PStr^) in LeadBytes)  then begin
      if St <> -1 then begin
        Inc(result);
        Start[result] := St;
        Lngth[result] := Indx-St;
        St := -1;
      end;
      Inc(PStr,2);Inc(Indx,2);
    end else begin
      if IsNormalChar(Char(PStr^)) then begin
        if (St = -1) then St := Indx;
        Inc(PStr); Inc(Indx);
      end else
        if St <> -1 then begin
          Inc(result);
          Start[result] := St;
          Lngth[result] := Indx-St;
          St := -1;
        end else begin
          Inc(PStr); Inc(Indx);
        end;
    end;
  end;
  if St <> -1 then begin
    Inc(result);
    Start[result] := St;
    Lngth[result] := Indx-St;
  end
end;

この関数は、TIntArray 型のパラメータを二つとり１バイト文字列の位置とその長さを返す。さっそくためしてみよう。

function GetVScrollPos(WC:TWinControl):integer;
var
  SI:TScrollinfo;
begin
  SI.cbSize := SizeOf(TScrollinfo);
  SI.fMask := SIF_POS;
  GetScrollInfo(WC.Handle,SB_VERT,SI);
  result := SI.nPos;
end;

procedure ControlVScroll(WC:TWinControl;ThumbPos:integer);
var
  Msg:TWMScroll;
begin
  Msg.Msg := WM_VSCROLL;
  Msg.Pos := ThumbPos;
  Msg.ScrollBar := 0;
  Msg.ScrollCode := SB_THUMBPOSITION;
  WC.Dispatch(Msg);
  Msg.ScrollCode := SB_ENDSCROLL;
  WC.Dispatch(Msg);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  St,L:TIntArray;
  Num,i,ScrollPos:integer;
begin
  ScrollPos := GetVScrollPos(RichEdit1);
  Num := SearchNormalCharsPos(RichEdit1.Text,St,L);
  if Num > 0 then begin
    RichEdit1.Lines.BeginUpdate;
    for i := 1 to Num do begin
      RichEdit1.SelStart := St[i];
      RichEdit1.SelLength := L[i];
      RichEdit1.SelAttributes.Color := clRed;
    end;
    RichEdit1.Lines.EndUpdate;
    ControlVScroll(RichEdit1,ScrollPos);
  end;
  RichEdit1.SetFocus;
end;

実行時の様子を右図に示す。ここでは１バイト文字列を検索して一括して文字列を赤に変換している。実際の太字タグの挿入は次のようにして行う。

procedure TForm1.Button1Click(Sender: TObject);
var
  St,L:TIntArray;
  Num,i:integer;
begin
  Num := SearchNormalCharsPos(RichEdit1.Text,St,L);
  if Num > 0 then begin
    RichEdit1.Lines.BeginUpdate;
    for i := Num downto 1 do begin
      RichEdit1.SelStart := St[i];
      RichEdit1.SelLength := L[i];
      RichEdit1.SelText := '<B>'+RichEdit1.SelText+'</B>';
    end;
    RichEdit1.Lines.EndUpdate;
  end;
  RichEdit1.SelStart := 0;
  RichEdit1.Perform(EM_SCROLLCARET,0,0);
  RichEdit1.SetFocus;
end;

実行時の様子を右図に示した。色の変換とは違って、タグの挿入は文字列の長さを変更することになるので、検索位置の末尾の方向から変換する。

５－６まとめ

スクリプト言語も正規表現も Grep の仕組みもよく知らないので非常に素朴な実装となったが、自分用の HTML エディタをつくるのに必要だった関数を作ってみた。最後に、ここで作った関数をユニットファイルにまとめたものをリンクしておく。