fDuckyD.pas 2.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130
  1. unit fDuckyD;
  2. interface
  3. uses
  4. Winapi.OpenGL,
  5. System.SysUtils,
  6. System.Classes,
  7. Vcl.Graphics,
  8. Vcl.Controls,
  9. Vcl.Forms,
  10. Vcl.Dialogs,
  11. Vcl.ExtCtrls,
  12. Vcl.ComCtrls,
  13. Vcl.StdCtrls,
  14. GLS.Scene,
  15. GLScene.VectorTypes,
  16. GLS.PersistentClasses,
  17. GLS.VectorFileObjects,
  18. GLS.Objects,
  19. GLS.SceneViewer,
  20. GLS.ParametricSurfaces,
  21. GLScene.VectorGeometry,
  22. GLS.VectorLists,
  23. GLS.Texture,
  24. GLS.Coordinates,
  25. GLS.Material,
  26. GLS.State,
  27. GLS.BaseClasses,
  28. GLS.FileNurbs,
  29. GLScene.Utils;
  30. type
  31. TFormDucky = class(TForm)
  32. GLScene1: TGLScene;
  33. GLCamera1: TGLCamera;
  34. GLDummyCube1: TGLDummyCube;
  35. GLLightSource1: TGLLightSource;
  36. Panel1: TPanel;
  37. GLSceneViewer1: TGLSceneViewer;
  38. TrackBar1: TTrackBar;
  39. Label1: TLabel;
  40. CheckBox1: TCheckBox;
  41. GLActor1: TGLActor;
  42. procedure GLSceneViewer1MouseDown(Sender: TObject; Button: TMouseButton;
  43. Shift: TShiftState; X, Y: Integer);
  44. procedure GLSceneViewer1MouseMove(Sender: TObject; Shift: TShiftState;
  45. X, Y: Integer);
  46. procedure FormCreate(Sender: TObject);
  47. procedure TrackBar1Change(Sender: TObject);
  48. procedure CheckBox1Click(Sender: TObject);
  49. private
  50. public
  51. mx, my: Integer;
  52. end;
  53. var
  54. FormDucky: TFormDucky;
  55. implementation
  56. {$R *.dfm}
  57. procedure TFormDucky.FormCreate(Sender: TObject);
  58. var
  59. cp: TGLAffineVectorList;
  60. begin
  61. var Path: TFileName := GetCurrentAssetPath();
  62. SetCurrentDir(Path + '\model');
  63. // Load the nurbs data
  64. GLActor1.LoadFromFile('duck1.nurbs');
  65. GLActor1.AddDataFromFile('duck2.nurbs');
  66. GLActor1.AddDataFromFile('duck3.nurbs');
  67. { Translate Actor based on the first mesh object's average
  68. control point. Quick and dirty ... or maybe just dirty :P }
  69. cp := TMOParametricSurface(GLActor1.MeshObjects[0]).ControlPoints;
  70. GLActor1.Position.Translate(VectorNegate(VectorScale(cp.Sum, 1 / cp.Count)));
  71. end;
  72. procedure TFormDucky.GLSceneViewer1MouseDown(Sender: TObject; Button: TMouseButton;
  73. Shift: TShiftState; X, Y: Integer);
  74. begin
  75. mx := X;
  76. my := Y;
  77. end;
  78. procedure TFormDucky.GLSceneViewer1MouseMove(Sender: TObject; Shift: TShiftState;
  79. X, Y: Integer);
  80. begin
  81. if ssLeft in Shift then
  82. GLCamera1.MoveAroundTarget(my - Y, mx - X);
  83. mx := X;
  84. my := Y;
  85. end;
  86. procedure TFormDucky.TrackBar1Change(Sender: TObject);
  87. var
  88. i: Integer;
  89. begin
  90. for i := 0 to 2 do
  91. TMOParametricSurface(GLActor1.MeshObjects[i]).Resolution :=
  92. TrackBar1.Position;
  93. GLActor1.StructureChanged;
  94. end;
  95. procedure TFormDucky.CheckBox1Click(Sender: TObject);
  96. begin
  97. with GLActor1.Material do
  98. begin
  99. if CheckBox1.Checked then
  100. begin
  101. PolygonMode := pmLines;
  102. FaceCulling := fcNoCull;
  103. end
  104. else
  105. begin
  106. PolygonMode := pmFill;
  107. FaceCulling := fcBufferDefault;
  108. end;
  109. end;
  110. end;
  111. end.