CODEWITHSUNDEEP
delphi3dfiremonkey
Rick Wheeler
Rick Wheeler

Reputation: 1132

Delphi Firemonkey draw and fill an arbitrary 3D shape or polygon

I'm trying to figure out how to fill a 3D polygon using Delphi XE7 Firemonkey. After using GLScene which had in-built components for this, Firemonkey seems to be a health hazard for me since there are less in-built controls, very few samples and less than helpful documentation.

My polygon is generated using this code:

Context.BeginScene;
try
  Context.DrawLine(TPoint3D.Create(1, -1, 0), TPoint3D.Create(1, 1, 0), 0.5, TAlphaColorRec.Black);
  Context.DrawLine(TPoint3D.Create(1, 1, 0), TPoint3D.Create(0, 1, 0), 0.5, TAlphaColorRec.Black);
  Context.DrawLine(TPoint3D.Create(0, 1, 0), TPoint3D.Create(-1, 0.5, 0), 0.5, TAlphaColorRec.Black);
  Context.DrawLine(TPoint3D.Create(-1, 0.5, 0), TPoint3D.Create(-1, 0, 0), 0.5, TAlphaColorRec.Black);
  Context.DrawLine(TPoint3D.Create(-1, 0, 0), TPoint3D.Create(-0.5, 0, 0), 0.5, TAlphaColorRec.Black);
  Context.DrawLine(TPoint3D.Create(-0.5, 0, 0), TPoint3D.Create(-0.5, -1, 0), 0.5, TAlphaColorRec.Black);
  Context.DrawLine(TPoint3D.Create(-0.5, -1, 0), TPoint3D.Create(1, -1, 0), 0.5, TAlphaColorRec.Black);
finally
  Context.EndScene;
end;

This code generate a polygon like this: https://cyberflexsoftware.tinytake.com/sf/NDQ5NTIxXzI0MjgzNjg

However I need to fill this shape with a color material and I have no idea how to do this. I think I need to create a TMesh but it is hard to figure out without a PHD in maths and I'm completely lost. Any help would be great.

Upvotes: 1

Views: 2700

Answers (2)

Rick Wheeler
Rick Wheeler

Reputation: 1132

After a bit of digging and playing around, I came up with this solution:

procedure TForm1.DummyObjectRender(Sender: TObject; Context: TContext3D);
var
  MyPolygon: TPolygon;
  I: Integer;
begin
  Context.BeginScene;
  try

    // creates the polygon
    SetLength(MyPolygon, 8);

    MyPolygon[0] := TPointF.Create(1, -1);
    MyPolygon[1] := TPointF.Create(1, 1);
    MyPolygon[2] := TPointF.Create(0, 1);
    MyPolygon[3] := TPointF.Create(-1, 0.5);
    MyPolygon[4] := TPointF.Create(-1, 0);
    MyPolygon[5] := TPointF.Create(-0.5, 0);
    MyPolygon[6] := TPointF.Create(-0.5, -1);
    MyPolygon[7] := TPointF.Create(1, -1);

    // Draw the polygon lines
    for I := 0 to Length(MyPolygon) - 1 do
      if I = Length(MyPolygon) - 1 then
        Context.DrawLine(TPoint3D.Create(MyPolygon[I].X, MyPolygon[I].Y, 0),
          TPoint3D.Create(MyPolygon[0].X, MyPolygon[0].Y, 0), 1, TAlphaColorRec.Red)
      else
        Context.DrawLine(TPoint3D.Create(MyPolygon[I].X, MyPolygon[I].Y, 0),
          TPoint3D.Create(MyPolygon[I + 1].X, MyPolygon[I + 1].Y, 0), 1, TAlphaColorRec.Red);

    // Fill the polygon shape
    Context.FillPolygon(TPoint3D.Create(0, 0, 0), TPoint3D.Create(2, 2, 0), MyPolygon.MaxEntents, MyPolygon,
      TMaterialSource.ValidMaterial(ColorMaterialSource1), 1);

  finally
    Context.EndScene;
  end;

end;

I also created a Polygon Helper for the MaxEntents of the polygon:

TPolygonHelper = record helper for TPolygon
  function MaxEntents: TRectF;
end;

{ TPolygonHelper }

function TPolygonHelper.MaxEntents: TRectF;
var
  I: Integer;
begin
  for I := 0 to Length(Self) - 1 do
  begin
    Result.Left := Min(Result.Left, Self[I].X);
    Result.Right := Max(Result.Right, Self[I].X);
    Result.Top := Max(Result.Top, Self[I].Y);
    Result.Bottom := Min(Result.Bottom, Self[I].Y);
  end;

end;

Hope this helps someone, somewhere, somehow...

Upvotes: 1

Sam z
Sam z

Reputation: 153

Try the FillPolyton method of TCanvas: http://docwiki.embarcadero.com/Libraries/XE7/en/FMX.Graphics.TCanvas.FillPolygon

Sample: 

var
  p1, p2, p3, p4, p5: TPointF;
  MyPolygon: TPolygon;
begin
 Image1.Bitmap.Clear($FFFFFF);
  // sets the points that define the polygon
  p1 := TPointF.Create(210, 220);
  p2 := TPointF.Create(330, 360);
  p3 := TPointF.Create(380, 260);
  p4 := TPointF.Create(200, 180);
  p5 := TPointF.Create(140, 160);
  // creates the polygon
  SetLength(MyPolygon, 5);
  MyPolygon[0] := p1;
  MyPolygon[1] := p2;
  MyPolygon[2] := p3;
  MyPolygon[3] := p4;
  MyPolygon[4] := p5;
  // fills and draws the polygon on the canvas
  Image1.Bitmap.Canvas.BeginScene;
  Image1.Bitmap.Canvas.FillPolygon(MyPolygon, 50);
  Image1.Bitmap.Canvas.EndScene;

Upvotes: 1

Related Questions