文字の輪郭のパス座標を取得する ～Delphiソースコード集

文字の輪郭のパス座標を取得する ～Delphiソースコード集

文字の輪郭のパス座標（直線の座標とベジェ曲線の座標と制御点）の取得

procedure TForm1.Button1Click(Sender: TObject);
var bmp:TBitmap;
    PathCount:Integer;
    p,pp:TArray<TPoint>;
    b:TBytes;
    i,j,k:Integer;
    s:string;
begin
  //■文字の輪郭のパス座標（直線、ベジェ曲線）を取得する
  bmp:=TBitmap.Create;
  try
    bmp.Width:=100;
    bmp.Height:=100;
    //フォントの設定
    bmp.Canvas.Font.Name:='ＭＳ ゴシック';
    //フォントサイズを設定する(ピクセル単位)
    bmp.Canvas.Font.Height:=-80;

    //背景モードを透明にする
    //SetBkMode(Image1.Picture.Bitmap.Canvas.Handle,TRANSPARENT);
    bmp.Canvas.Brush.Style:=bsClear;

    //パスブラケットを開く
    BeginPath(bmp.Canvas.Handle);
    //輪郭パス座標を取得したい文字を描画
    bmp.Canvas.TextOut(10,10,'鷗');
    //パスブラケットを閉じる
    EndPath(bmp.Canvas.Handle);

    //パスの数を取得
    PathCount:=GetPath(bmp.Canvas.Handle, nil, nil, 0);

    if PathCount>0 then
    begin
      SetLength(p,PathCount);
      SetLength(b,PathCount);
      //パスを取得
      GetPath(bmp.Canvas.Handle,@p[0],@b[0],PathCount);
    end;
  finally
    bmp.Free;
  end;

  //■取得したパス座標をTMemoに出力する
  for i := 0 to PathCount-1 do
  begin
    s:='';
    if b[i]=PT_MOVETO then
      s:='MoveTo'
    else if (b[i]=PT_LINETO) or
            (b[i]=(PT_LINETO or PT_CLOSEFIGURE)) then
      s:='LIneTo'
    else if b[i]=PT_BEZIERTO then
      s:='Bezier';
    Memo1.Lines.Add(
      Format('種類:%s 座標:%d,%d',[s,p[i].X,p[i].Y])
    );
  end;


  //■取得したパス座標をTBitmapに描画する
  Image1.Picture.Bitmap.Width:=100;
  Image1.Picture.Bitmap.Height:=100;
  //白色で塗り潰す
  Image1.Picture.Bitmap.Canvas.Brush.Style:=bsSolid;
  Image1.Picture.Bitmap.Canvas.Brush.Color:=clWhite;
  Image1.Picture.Bitmap.Canvas.FillRect(Image1.Picture.Bitmap.Canvas.ClipRect);
  Image1.Picture.Bitmap.Canvas.Pen.Color:=rgb(255,0,0);
  //取得したパスを描画
  i:=0;
  while i < PathCount do
  begin
    if b[i]=PT_MOVETO then //6
    begin
      //描画座標の移動
      Image1.Picture.Bitmap.Canvas.MoveTo(p[i].X,p[i].Y);
      inc(i);
    end
    else if (b[i]=PT_LINETO) or
            (b[i]=(PT_LINETO+PT_CLOSEFIGURE)) then //2 or 3
    begin
      //線を引く
      Image1.Picture.Bitmap.Canvas.LineTo(p[i].X,p[i].Y);
      inc(i);
    end
    else if b[i] =PT_BEZIERTO then //4
    begin
      //ベジェ曲線を描く
      j:=0;
      while (b[i+j] and PT_BEZIERTO)=PT_BEZIERTO do inc(j);
      SetLength(pp,j);
      for k := 0 to j-1 do
        pp[k]:=p[i+k];
      Image1.Picture.Bitmap.Canvas.PolyBezierTo(pp);
      inc(i,j);
    end;
  end;
end;