Results 1 to 5 of 5

Thread: 3D Bollen in de ruimte voorbeeldje met lijnen tussen de bollen XE2

  1. #1

    3D Bollen in de ruimte voorbeeldje met lijnen tussen de bollen XE2

    Tijdens de kerst een beetje aan het stoeien geweest met Firemonkey XE2
    Aangezien ik niet veel code kan vinden rondom 3D en Firemonkey dump ik hier graag een voorbeeld voor één ieder die er wellicht ook eens iets mee wil rommelen.
    Het is vast niet optimaal maar bollen in 3D renderen en dan met een lijn verbinden is gelukt!

    Pas File:

    Code:
    unit uMain;
    
    interface
    
    uses
      System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
      FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.Types3D, FMX.Objects3D, codesitelogging, FMX.Edit, FMX.Layers3D,
      FMX.Objects, FMX.Layouts, FMX.Memo;
    
    type
      TForm1 = class(TForm3D)
        Light1: TLight;
        Sphere1: TSphere;
        Text3D1: TText3D;
        Camera1: TCamera;
        Layer3D1: TLayer3D;
        Button1: TButton;
        Edit1: TEdit;
        Memo1: TMemo;
        procedure SphereRender(Sender: TObject; Context: TContext3D);
        procedure Form3DCreate(Sender: TObject);
        procedure Button1Click(Sender: TObject);
        procedure Form3DRender(Sender: TObject; Context: TContext3D);
        procedure Form3DMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean);
      private
        PriorPos: TPoint3d;
        { Private declarations }
      public
        mySphere3: TSphere;
        mySphere1: TSphere;
        mySphere2: TSphere;
        { Public declarations }
    
      end;
    
    var
      Form1: TForm1;
    
    implementation
    
    {$R *.fmx}
    
    procedure TForm1.Button1Click(Sender: TObject);
    begin
      if not assigned(mySphere3) then
      begin
        mySphere3 := TSphere.Create(Form1);
        mySphere3.Parent := Form1;
        mySphere3.Name := 'MySphere3';
        mySphere3.Position.point := Point3D(0, 0, 0);
        mySphere3.Width := 2;
        mySphere3.Height := 2;
        mySphere3.Depth := 2;
        mySphere3.OnRender := SphereRender;
    //    mySphere3.OnMouseDown := SphereMouseDown;
    //    mySphere3.OnMouseMove := SphereMouseMove;
        mySphere3.RotationCenter.point := Point3D(Vector3DSubtract(Vector3D(0, 0, 0), Vector3D(mySphere3.Position.point)));
      end;
    end;
    
    procedure TForm1.Form3DCreate(Sender: TObject);
    begin
      mySphere1 := TSphere.Create(self);
      mySphere1.Parent := self;
      mySphere1.Name := 'MySphere1';
      mySphere1.OnRender := SphereRender;
      mySphere1.Position.point := Point3D(-10, 2, 0);
    //  mySphere1.OnMouseDown := SphereMouseDown;
    //  mySphere1.OnMouseMove := SphereMouseMove;
      mySphere1.Width := 2;
      mySphere1.Height := 2;
      mySphere1.Depth := 2;
    
    
      mySphere2 := TSphere.Create(self);
      mySphere2.Parent := self;
      mySphere2.Name := 'MySphere2';
      mySphere2.Position.point := Point3D(-5, 5.5, 0);
      mySphere2.OnRender := SphereRender;
      // mySphere2.OnMouseDown := SphereMouseDown;
      // mySphere2.OnMouseMove := SphereMouseMove;
      mySphere2.Width := 1;
      mySphere2.Height := 1;
      mySphere2.Depth := 1;
    end;
    
    procedure TForm1.Form3DMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean);
    Const
      step: Integer = -4;
    begin
      if ssctrl in Shift then
      begin
        if assigned(mySphere3) then
        begin
          if WheelDelta > 0 then
            mySphere3.Position.z := mySphere3.Position.z + step
          else
            mySphere3.Position.z := mySphere3.Position.z - step
        end;
        if WheelDelta > 0 then
        begin
          mySphere1.Position.z := mySphere1.Position.z + step;
          mySphere2.Position.z := mySphere2.Position.z + step;
        end
        else
        begin
          mySphere1.Position.z := mySphere1.Position.z - step;
          mySphere2.Position.z := mySphere2.Position.z - step;
        end;
      end
      else if ssShift in Shift then
      begin
        if assigned(mySphere3) then
        begin
          if WheelDelta > 0 then
            mySphere3.Position.X := mySphere3.Position.X + step
          else
            mySphere3.Position.X := mySphere3.Position.X - step
        end;
        if WheelDelta > 0 then
        begin
          mySphere1.Position.X := mySphere1.Position.X + step;
          mySphere2.Position.X := mySphere2.Position.X + step;
        end
        else
        begin
          mySphere1.Position.X := mySphere1.Position.X - step;
          mySphere2.Position.X := mySphere2.Position.X - step;
        end;
      end
      else
      begin
        if assigned(mySphere3) then
        begin
          if WheelDelta > 0 then
            mySphere3.Position.Y := mySphere3.Position.Y + step
          else
            mySphere3.Position.Y := mySphere3.Position.Y - step
        end;
        if WheelDelta > 0 then
        begin
          mySphere1.Position.Y := mySphere1.Position.Y + step;
          mySphere2.Position.Y := mySphere2.Position.Y + step;
        end
        else
        begin
          mySphere1.Position.Y := mySphere1.Position.Y - step;
          mySphere2.Position.Y := mySphere2.Position.Y - step;
        end;
      end;
    end;
    
    procedure TForm1.Form3DRender(Sender: TObject; Context: TContext3D);
    var
      W: Extended;
    begin
      { Geen idee waar de W voor dient }
      if not TryStrToFloat(Edit1.text, W) then
        W := 1.0;
    end;
    
    procedure TForm1.SphereRender(Sender: TObject; Context: TContext3D);
    var
      p1, p2: TPoint3d;
      Dir: TVector3D;
      tmpSphere: TSphere;
      Factor: Extended;
      idx1: TIndexBuffer;
      ver1: TVertexBuffer;
      i: Integer;
      Y: Integer;
    begin
      if TSphere(Sender).Name = 'MySphere1' then
        exit;
    
      if TSphere(Sender).Name = 'MySphere2' then
        tmpSphere := mySphere1
      else if TSphere(Sender).Name = 'MySphere3' then
        tmpSphere := mySphere2;
    
      p1 := TSphere(Sender).Position.point;
      p2 := tmpSphere.Position.point;
    
      Factor := 1 / TSphere(Sender).Height;
    
      Dir := Vector3DSubtract(Vector3D(p2), Vector3D(p1));
      Dir := Vector3DScale(Dir, Factor);
    
      Context.DrawLine(Vector3D(0, 0, 0), Dir, 1);
    
      { Demo hoe je 500 individuele punten in de 3d ruimte krijgt }
      ver1 := TVertexBuffer.Create([TVertexFormat.vfVertex], 500);
      idx1 := TIndexBuffer.Create(500);
      try
        for i := 0 to 500 do
          idx1[i] := i;
    
        for i := 0 to 250 do
        begin
          ver1.Vertices[i] := Point3D(i * 0.05, i * 0.01, 0);
        end;
        Y := 250;
        for i := 251 to 500 do
        begin
          ver1.Vertices[i] := Point3D(i * 0.05, ver1.Vertices[Y].Y, 0);
          Y := Y - 1;
        end;
        Context.DrawPointsList(ver1, idx1, 1);
      finally
        FreeAndNil(idx1);
        FreeAndNil(ver1);
      end;
    end;
    
    end.
    DFM file:

    Code:
    object Form1: TForm1
      Left = 0
      Top = 0
      Caption = 'Form1'
      ClientHeight = 401
      ClientWidth = 910
      Visible = False
      OnCreate = Form3DCreate
      OnMouseWheel = Form3DMouseWheel
      Camera = Camera1
      OnRender = Form3DRender
      object Light1: TLight
        Position.Point = '(-9.88584995269775,2.13471555709839,0)'
        RotationAngle.Point = '(-13.3279266357422,4.84241104125977,0)'
        Width = 1.000000000000000000
        Height = 1.000000000000000000
        Depth = 1.000000000000000000
        Opacity = 1.000000000000000000
        Ambient = xFF202020
        Diffuse = xFFA0A0A0
        ConstantAttenuation = 1.000000000000000000
        LightType = ltDirectional
        Specular = claWhite
        SpotCutOff = 180.000000000000000000
        Quanternion = 
          '(-0.115942277014256,0.0419601984322071,0.00490236887708306,0.992' +
          '355585098267)'
      end
      object Sphere1: TSphere
        Position.Point = '(-4.39738941192627,-5.19587326049805,0)'
        RotationAngle.Point = '(166.364059448242,0,0)'
        Width = 1.000000000000000000
        Height = 1.000000000000000000
        Depth = 1.000000000000000000
        Opacity = 1.000000000000000000
        Quanternion = '(0.992928266525269,0,0,0.118715420365334)'
      end
      object Text3D1: TText3D
        Width = 6.399355888366699000
        Height = 3.365466117858887000
        Depth = 0.300000011920929000
        Opacity = 1.000000000000000000
        Flatness = 1.000000000000000000
        Sides = [esFront, esBack, esShaft]
        Font.Size = 1.000000000000000000
        Text = 'Hallo wereld'
        Quanternion = '(0,0,0,1)'
      end
      object Camera1: TCamera
        Position.Point = '(0,0,-5)'
        Width = 1.000000000000000000
        Height = 1.000000000000000000
        Depth = 1.000000000000000000
        Opacity = 1.000000000000000000
        Quanternion = '(0,0,0,1)'
      end
      object Layer3D1: TLayer3D
        Position.Point = '(821,200.5,0)'
        Width = 178.000000000000000000
        Height = 401.000000000000000000
        Depth = 0.009999999776482582
        Opacity = 1.000000000000000000
        Projection = pjScreen
        Align = alRight
        StyleLookup = 'backgroundstyle'
        Quanternion = '(0,0,0,1)'
        object Button1: TButton
          Position.Point = '(56,32)'
          Width = 80.000000000000000000
          Height = 22.000000000000000000
          OnClick = Button1Click
          TabOrder = 0
          Text = 'Nog een bol'
        end
        object Edit1: TEdit
          Position.Point = '(40,64)'
          Width = 100.000000000000000000
          Height = 22.000000000000000000
          TabOrder = 1
          KeyboardType = vktDefault
          Password = False
        end
        object Memo1: TMemo
          Position.Point = '(8,104)'
          Width = 169.000000000000000000
          Height = 225.000000000000000000
          TabOrder = 3
          Lines.Strings = (
            'Probeer :'
            '1) CTRL + Scroll wheel (ZOOM)'
            '2) SHIFT + Scroll wheel (L+R)'
            '3) Scroll wheel (UP + DOWN)'
            '')
          KeyboardType = vktDefault
        end
      end
    end

  2. #2
    John Kuiper
    Join Date
    Apr 2007
    Location
    Almere
    Posts
    8,747
    Mooi dat andere eens gaan stoeien met FM.
    Rover, in dit geval is het makkelijker om een zip te maken van je project (.dproj, .dpr, .dfm, .pas) en dan als bijlage meegeven. Dan kan iedereen met FM deze makkelijker opstarten in zijn Delphi.
    Delphi is great. Lazarus is more powerfull

  3. #3
    Kan ik nu als nog doen.. alleen in mijn balk zie ik geen attachement mogelijkheid.
    Behalve Film en Pictures.

  4. #4
    Gevonden kan alleen bij het aanleggen van een nieuw topic.
    Misschien kan een moderator de twee topics mergen of één deleten. Persoonlijk ben ik niet zo van de ZIP's ik zie liever een post met code.

  5. #5
    John Kuiper
    Join Date
    Apr 2007
    Location
    Almere
    Posts
    8,747
    Code is prima, zolang het overzichtelijk blijft. Op het moment dat er een dfm wordt gepost, is de bijlage de uitkomst. Maar voor de volgende keer
    Delphi is great. Lazarus is more powerfull

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •