B-スプライン曲線(B-Spline)で点を補完して曲線を描く ～Delphiソースコード集

• ホーム
• Delphiでお手軽プログラミング
• B-スプライン曲線(B-Spline)で点を補完して曲線を描く ～Delphiソースコード集

B-スプライン曲線(B-Spline)で点を補完して曲線を描く ～Delphiソースコード集

B-スプライン曲線（2次）のユニット

unit UBSpline;

interface

uses System.Types,System.Math.Vectors;

type
  TBSplineControlPoint = Array Of Array Of Double;

  TBSpline=class(TObject)
  private
    pts:TPolygon;
    ptsNum:Integer;
    function calcBasis(PointNo:Integer;tt:Double):Double;
  protected
  public
    procedure setPoly(p:TBSplineControlPoint);
    function calc(t:Double):TPointF;
  end;

implementation

function TBSpline.calc(t: Double): TPointF;
var tt,fSum:Double;
    f:Array Of Double;
    i:Integer;
    pt:TPointF;
begin
  tt:=t*ptsNum-0.5;
  fSum:=0;
  setLength(f,ptsNum);
  for i:=0 to ptsNum-1 do
  begin
    f[i]:=calcBasis(i,tt);
    fSum:=fSum+f[i];
  end;
  for i:=0 to ptsNum-1 do
  begin
    f[i]:=f[i]/fSum;
  end;
  pt.X:=0;
  pt.Y:=0;
  for i:=0 to ptsNum-1 do
  begin
    pt.X:=pt.X+pts[i].X*f[i];
    pt.Y:=pt.Y+pts[i].Y*f[i];
  end;
  Result:=pt;
end;

function TBSpline.calcBasis(PointNo: Integer; tt: Double): Double;
var nt:Double;
begin
  if tt<(PointNo-1.5) then
  begin
    Result:=0
  end
  else if tt<(PointNo-0.5) then
  begin
    nt:=tt-(PointNo-1.5);
    Result:=0.5*nt*nt;
  end
  else if tt<(PointNo+0.5) then
  begin
    nt:=tt-PointNo;
    Result:=0.75-(nt*nt);
  end
  else if tt<(PointNo+1.5) then
  begin
    nt:=tt-(PointNo+1.5);
    Result:=0.5*nt*nt;
  end
  else
  begin
    Result:=0;
  end;
end;

procedure TBSpline.setPoly(p: TBSplineControlPoint);
var i:Integer;
begin
  setLength(pts,length(p));
  for i := Low(pts) to High(pts) do
  begin
    pts[i].X:=p[i][0];
    pts[i].Y:=p[i][1];
  end;
  ptsNum:=Length(pts);
end;

end.

使用例

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics, Vcl.Controls,
  Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls,
  System.Types, UBSpline;

type

  TForm1 = class(TForm)
    Button1: TButton;
    Image1: TImage;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private 宣言 }
    BSpline:TBSpline;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

const
  Hiragana:Array of TBSplineControlPoint=
  [ //「あ」の文字の制御点
    [ [4,5], [8 ,4.8], [13.4, 3.8] ],
    [ [8.5,1.4],[7,10.4],[8.2,18] ],
    [
      [13,7],[9,15.4],[5,18],[2.5,16.5],[3,12.5],[9.5,8.5],
      [14.5,9],[18,11.5],[18,16],[15,18],[12.5,18.7]
    ]
  ];


implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var t:Double;
    OldPoint, NewPoint:TPointF;
    i:Integer;
    step:Double;
begin
  Image1.Picture.Bitmap.Width:=20*32;
  Image1.Picture.Bitmap.Height:=20*32;
  Image1.Stretch:=True;
  Image1.Proportional:=True;
  Image1.Picture.Bitmap.Canvas.Pen.Width:=16;
  Image1.Picture.Bitmap.Canvas.Pen.Color:=clBlack;

  for i := Low(Hiragana) to High(Hiragana) do
  begin
    BSpline.setPoly(Hiragana[i]);
    step:=0.05/Length(Hiragana[i]);
    t:=0;
    OldPoint:=BSpline.calc(t);
    t:=t+step;
    while t<=1 do
    begin
      NewPoint:=BSpline.calc(t);
      Image1.Picture.Bitmap.Canvas.MoveTo(
        Trunc(OldPoint.X*32), Trunc(OldPoint.Y*32)
      );
      Image1.Picture.Bitmap.Canvas.LineTo(
        Trunc(NewPoint.X*32), Trunc(NewPoint.Y*32)
      );
      OldPoint:=NewPoint;
      t:=t+step;
    end;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  BSpline:=TBSpline.Create();
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  BSpline.free;
end;

end.

実行する