Skip to content

Bezier Surface Visualization (from Turbo Pascal to Delphi FireMonkey)

Today I have been presenting "FireMonkey 3D Programming" session on the SDE event in Zeist in the Netherlands. Bob Swart was so kind and invited me to present on the first session of the day in the "Delphi" conference track and I wanted to prepare a brand new demo to show off the power of FireMonkey.

There is more and more FireMonkey resources available online, including new "FireMonkey blog", FireMonkey Info page, FireMonkey quickstart tutorials and many more. Some of the best FireMonkey code pieces can be found at Anders Ohlsson blog. I especially like his EDN article on "Visualizing 3D mathematical functions using FireMonkey" that explains how to programmatically create mesh data for visualization using "TMesh" FireMonkey component. The source code for this demo is available at the Code Central.

Two decades ago I have been studying computer graphics at the Warsaw Institute of Technology and I still have some of my Turbo Pascal 5.5 source code with graphics applications for DOS. One of the projects for the labs on programming digitally controlled devices was to visualize a bicubic surface also known a "Bezier Surface". Using DosBox I was able to run my original, compiled DOS application inside my Windows 7 64-bit virtual machine.

The whole program is just one file with Turbo Pascal 5.5 code ("puns5.pas") and is using BGI for displaying graphics on the SVGA-compatible graphics card. It would not be possible to reuse the actual painting code, however I was able to extract three procedures, and some constants and variables from the the original Turbo Pascal code responsible for generating the 2-dimensional 11×11 matrix of 3D points that make up the wireframe. Bezier surface is a special case of NURBS surface that is very commonly used in 3D modeling. The shape of the surface is controlled by a 4×4 matrix of 3D control points as illustrated on wikipedia:

Below is the source code responsible for generating the 4×4 matrix of control points ("CreateBicubicMatrix2") and the resulting 11×11 matrix that approximates the bezier surface ("CountBicu" and "CreateNet").


const
  nx = 10;
  ny = 10;

type
  p3 = array[0..2] of single;
  Net = array[0..nx,0..ny] of p3;
  BicubicMatrix = array[0..3, 0..3] of p3;

procedure CreateBicubicMatrix2 (var G : BicubicMatrix) ;
var x,y,z : real; i,j : byte;
begin
  y:=-150;
  for i:=0 to 3 do
  begin
    x:=-150;
    for j:=0 to 3 do
    begin
      G[i,j,0]:=x;
      G[i,j,1]:=y;
      G[i,j,2]:=0;
      x:=x+100;
    end;
    y:=y+100
  end;
  G[0,0,2]:=250;
  G[3,0,2]:=50;
  G[0,3,2]:=50;
  G[3,3,2]:=-200;
  G[3,2,2]:=-200;
  G[2,3,2]:=-200;
end;

function CountBicu( wsp : integer; u,v: real; G : BicubicMatrix) : real;
var c,vb,u2,u3,t,t2,t3,v2,v3,k,k2,k3: real; j : byte;
begin
  c:=0;
  u2:=sqr(u);
  u3:=u*u2;
  t:=1-u;
  t2:=sqr(t);
  t3:=t*t2;
  v2:=sqr(v);
  v3:=v*v2;
  k:=1-v;
  k2:=sqr(k);
  k3:=k*k2;
  for j:=0 to 3 do
  begin
    case j of
      0: vb:=k3;
      1: vb:=3*k2*v;
      2: vb:=3*k*v2;
      3: vb:=v3
    end;
    c:= c + vb * (G[j,0,wsp]*t3 + G[j,1,wsp]*3*t2*u + G[j,2,wsp]*3*t*u2 + G[j,3,wsp]*u3 )
   end;
  Result:=c;
end;

procedure CreateNet(var N : Net; G : BicubicMatrix);
var u,v: real; i,e,f: integer;
begin
  for e:=0 to nx do
    for f:=0 to ny do
    begin
      u:=e/nx;
      v:=f/ny;
      for i:=0 to 2 do
        N[e,f,i]:=CountBicu(i,u,v,G);   { i - coord id: x, y or z }
    end;
end;

I have started from the original Anders Ohlsson source code for 3D mathematical function visualizations with FireMonkey and did some refactoring. There is a new button added for selecting "Bicubic Surface" and scroll bars for rotating the mesh in X, Y and Z dimensions.

Below is the actual source code for filling in "TMesh" component passed as the parameter with vertices, indices and material information. Below is the code responsible for creating the bezier surface programmatically using the original Anders’ texture.


const
  s = 0.1; // scale factor for display

function ScaleCol(c: single): single;
begin
  // scale color value "c" from "-25..25" to "0..1"
  c := c + 25;
  Result := c / 50;
end;

procedure GenerateBicuMesh(const AMesh: TMesh);
var G: BicubicMatrix; N: Net; bmp: TBitmap;
  i,j: integer; p: TPoint3D;
  sizeN: integer; vertid, ixid: integer;
  verts : array [0..3] of TPoint3D;
begin
  CreateBicubicMatrix2(G);
  CreateNet(N,G);

  bmp := TBitmap.Create(1,360);
  for i := 0 to 359 do
    bmp.Pixels[0,i] := CorrectColor(HSLtoRGB(i/360,0.75,0.5));

  AMesh.Material.Texture := bmp;

  sizeN := (nx+1) * (ny+1);
  AMesh.Data.VertexBuffer.Length := 4 * sizeN;
  AMesh.Data.IndexBuffer.Length := 6 * sizeN;

  for i := 0 to nx-1 do
    for j := 0 to ny-1 do
    begin
      vertid := (i*(ny+1) + j) * 4;
      ixid := (i*(ny+1) + j) * 6;

      verts[0] := Point3D( N[i,j,0]*s, N[i,j,1]*s, N[i,j,2]*s);
      verts[1] := Point3D( N[i+1,j,0]*s, N[i+1,j,1]*s, N[i+1,j,2]*s);
      verts[2] := Point3D( N[i,j+1,0]*s, N[i,j+1,1]*s, N[i,j+1,2]*s);
      verts[3] := Point3D( N[i+1,j+1,0]*s, N[i+1,j+1,1]*s, N[i+1,j+1,2]*s);

      with AMesh.Data do begin
        with VertexBuffer do begin
          Vertices[vertid]   := verts[0];
          Vertices[vertid+1] := verts[1];;
          Vertices[vertid+2] := verts[2];;
          Vertices[vertid+3] := verts[3];;
        end;

        with VertexBuffer do begin
          TexCoord0[vertid]   := PointF(0, ScaleCol(verts[0].Z));
          TexCoord0[vertid+1] := PointF(0, ScaleCol(verts[1].Z));
          TexCoord0[vertid+2] := PointF(0, ScaleCol(verts[2].Z));
          TexCoord0[vertid+3] := PointF(0, ScaleCol(verts[3].Z));
        end;

        IndexBuffer[ixid]   := vertid;
        IndexBuffer[ixid+1] := vertid+1;
        IndexBuffer[ixid+2] := vertid+2;
        IndexBuffer[ixid+3] := vertid+2;
        IndexBuffer[ixid+4] := vertid+1;
        IndexBuffer[ixid+5] := vertid+3;
      end;
    end;
end;

Below is the screenshot from the "Bezier Surface" visualization in Delphi FireMonkey 3D application.

The full source code of the "Bezier Surface" demo can be found at the Embarcadero Code Central.

Post a Comment

Your email is never published nor shared. Required fields are marked *

Bad Behavior has blocked 2 access attempts in the last 7 days.

Close