fdProjection.pas 3.5 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135
  1. unit fdProjection;
  2. interface
  3. uses
  4. Winapi.OpenGL,
  5. System.SysUtils,
  6. System.Classes,
  7. System.Types,
  8. Vcl.Controls,
  9. Vcl.Forms,
  10. GLS.Scene,
  11. GLS.Objects,
  12. GLS.SceneViewer,
  13. GLS.Texture,
  14. Stage.VectorGeometry,
  15. GLS.VectorLists,
  16. GLS.RenderContextInfo,
  17. GLS.State,
  18. Stage.VectorTypes,
  19. GLS.Coordinates,
  20. GLS.BaseClasses,
  21. GLS.GeomObjects,
  22. GLS.Graph;
  23. type
  24. TFormProjection = class(TForm)
  25. GLScene1: TGLScene;
  26. SceneViewer: TGLSceneViewer;
  27. GLCamera: TGLCamera;
  28. GLDummyCube: TGLDummyCube;
  29. GLPlane: TGLPlane;
  30. GLPoints: TGLPoints;
  31. DirectOpenGL: TGLDirectOpenGL;
  32. GLArrowLine1: TGLArrowLine;
  33. GLLightSource1: TGLLightSource;
  34. GLXYZGrid1: TGLXYZGrid;
  35. procedure FormCreate(Sender: TObject);
  36. procedure DirectOpenGLRender(Sender: TObject;
  37. var rci: TGLRenderContextInfo);
  38. procedure SceneViewerMouseDown(Sender: TObject; Button: TMouseButton;
  39. Shift: TShiftState; X, Y: Integer);
  40. procedure SceneViewerMouseMove(Sender: TObject; Shift: TShiftState;
  41. X, Y: Integer);
  42. procedure FormMouseWheel(Sender: TObject; Shift: TShiftState;
  43. WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
  44. private
  45. public
  46. mx, my: Integer;
  47. end;
  48. var
  49. FormProjection: TFormProjection;
  50. implementation
  51. {$R *.dfm}
  52. procedure TFormProjection.FormCreate(Sender: TObject);
  53. var
  54. i: Integer;
  55. begin
  56. // generate a bunch of random points
  57. for i := 1 to 1000 do
  58. begin
  59. GLPoints.Positions.Add((Random - 0.5) * 5, (Random - 0.5) * 5, (Random - 0.5) * 5);
  60. GLPoints.Colors.Add(Random, Random, Random, 0.8);
  61. end;
  62. end;
  63. procedure TFormProjection.DirectOpenGLRender(Sender: TObject; var rci: TGLRenderContextInfo);
  64. var
  65. i: Integer;
  66. mat: TGLMatrix;
  67. p, pProj: TGLVector;
  68. planePoint, planeNormal: TGLVector;
  69. plane: THmgPlane;
  70. begin
  71. // Here we recover our plane point and normal...
  72. planePoint := GLPlane.Position.AsVector;
  73. planeNormal := GLPlane.Direction.AsVector;
  74. // ...which we use to create a plane (equation)
  75. plane := PlaneMake(planePoint, planeNormal);
  76. // from that plane equation and our pojection direction
  77. // (which is here the plane normal)
  78. mat := MakeParallelProjectionMatrix(plane, planeNormal);
  79. // save state, turn off lighting
  80. rci.GLStates.Disable(stLighting);
  81. // and specify the lines color
  82. glColor3f(1, 1, 0);
  83. // we'll be drawing a bunch of lines, to specify a line in OpenGL,
  84. // you only need to specify the line start and end vertices
  85. glBegin(GL_LINES);
  86. for i := 0 to GLPoints.Positions.Count - 1 do
  87. begin
  88. // read the point coordinates, directly from the TGLPoints list
  89. MakePoint(p, GLPoints.Positions.List[i]);
  90. // project this point on the plane with the matrix
  91. pProj := VectorTransform(p, mat);
  92. // specify the two vertices for a line
  93. glVertex3fv(@p);
  94. glVertex3fv(@pProj);
  95. end;
  96. glEnd;
  97. end;
  98. procedure TFormProjection.SceneViewerMouseDown(Sender: TObject; Button: TMouseButton;
  99. Shift: TShiftState; X, Y: Integer);
  100. begin
  101. mx := X;
  102. my := Y;
  103. end;
  104. procedure TFormProjection.SceneViewerMouseMove(Sender: TObject; Shift: TShiftState;
  105. X, Y: Integer);
  106. begin
  107. if Shift = [ssLeft] then
  108. GLCamera.MoveAroundTarget(my - Y, mx - X)
  109. else if Shift = [ssRight] then
  110. GLCamera.RotateObject(GLPlane, my - Y, mx - X);
  111. mx := X;
  112. my := Y;
  113. end;
  114. procedure TFormProjection.FormMouseWheel(Sender: TObject; Shift: TShiftState;
  115. WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
  116. begin
  117. GLPlane.Position.Y := GLPlane.Position.Y + WheelDelta * 0.001;
  118. end;
  119. end.