仕事で、名前を登録して使用するプログラムを作って使っています。

今までは、unicodeのBMPだけを使用してそれ以外は、外字で対処していたんですが、最近、サロゲート文字やIVSというものがあることに遅ればせながら気がつきました。昨年末に仕事場のパソコンがWindows8.1になってから、このことに気がつき、辻の１点しんにょうと２点しんにょうの２つをかき分けることが可能となりました。

しかし、私の自作のプログラムは、これに対応していず、基底文字の後に??がつくという不具合がでてしまいました。これは、length, copy 関数が正常に動作していないことに原因があることがわかったので、早速、インターネットでサロゲートとIVSについて検索してみましたが、深みにはまってしまいました。そして、何とか、関数を作り上げたものの、さらに結合文字というものがあることに気がつき、挫折と妥協をしかけましたが、エンバカエロのサイトにサンプルコードがあり、これを拝借することにより、ほぼ思う通りの動作が可能になりました。

とりあえず、私のプログラムに必要な、length, copy関数のみ作成したものを（ど素人の全く洗練されていないコードですが）参考として上げたいと思います。

const
  surrogate_high_Start = $D800;
  surrogate_high_End   = $DBFF;
  surrogate_low_Start  = $DC00;
  surrogate_low_End    = $DFFF;

  LangSelect = $DB40;

---------------------------------------------------------

function IVS_copy(str: String; s0, e0: Integer): String;
var
  i : Integer;
  n, n1, len : Integer;
  ch : array of Integer;
  s1, e1, e2 : Integer;
  str0 : string;
begin
  if MecsNormalize(str, str0, NormalizationC) then
    str := str0;

  len := IVS_Length(str);

  SetLength(ch, len+1);
  for i := 0 to len do
    ch[i] := 0;

  n := 1;
  n1 := 1;
  repeat
    if (ord(str[n]) < surrogate_high_Start) or (ord(str[n]) > surrogate_high_End) then
    begin
      ch[n1] := 1;
      n1 := n1 + 1;
      n := n + 1;
    end
    else if ord(str[n]) = LangSelect then
    begin
      ch[n1-1] := ch[n1-1] + 2;
      n := n + 2;
    end
    else
    begin
      ch[n1] := 2;
      n1 := n1 + 1;
      n := n + 2;
    end;
  until n > length(str);

  s1 := 0;
  for i := 1 to s0-1 do
    s1 := s1 + ch[i];
  s1 := s1 + 1;

  e1 := 0;
  e2 := s0 + e0 - 1;
  if e2 > len then
    e2 := len;
  for i := s0 to e2 do
    e1 := e1 + ch[i];

  result := copy(str, s1, e1);
end;

//  サロゲート文字、IVS付きの文字でも、文字列の長さを正確に出す
function IVS_length(s: String): Integer;
var
  i : Integer;
  count : Integer;
  s0 : String;
begin
  if MecsNormalize(s, s0, NormalizationC) then
    s := s0;

  count := 0;
  for i := 1 to length(s) do
    if not((ord(s[i]) = LangSelect) or (ord(s[i]) >= surrogate_low_Start)and(ord(s[i]) <= surrogate_low_End)) then
    begin
      inc(count);
    end;

  result := count;
end;