MathgeomGLS

1
unit fHalfSphere;
2

3
interface
4

5
uses
6
  Winapi.Windows,
7
  Winapi.Messages,
8
  System.SysUtils,
9
  System.Variants,
10
  System.Classes,
11

12
  Vcl.Graphics,
13
  Vcl.Controls,
14
  Vcl.Forms,
15
  Vcl.Dialogs,
16

17
  GLS.Scene,
18
  GLS.Coordinates,
19
  GLS.Objects,
20
  GLS.State,
21
  GLS.SimpleNavigation,
22
  GLS.SceneViewer,
23
  GLS.BaseClasses,
24
  GLS.Material,
25
  GLS.RenderContextInfo,
26
  GLSL.UserShader;
27

28
type
29
  TFormHalfSphere = class(TForm)
30
    GLScene1: TGLScene;
31
    GLSceneViewer1: TGLSceneViewer;
32
    GLMaterialLibrary1: TGLMaterialLibrary;
33
    GLSimpleNavigation1: TGLSimpleNavigation;
34
    GLSphere1: TGLSphere;
35
    GLCamera1: TGLCamera;
36
    GLLightSource1: TGLLightSource;
37
    GLUserShader1: TGLUserShader;
38
    procedure GLUserShader1DoUnApply(Sender: TObject; Pass: Integer; var rci: TGLRenderContextInfo;
39
      var Continue: Boolean);
40
    procedure GLUserShader1DoApply(Sender: TObject; var rci: TGLRenderContextInfo);
41
  private
42
  public
43
  end;
44

45
var
46
  FormHalfSphere: TFormHalfSphere;
47

48
implementation
49

50
{$R *.dfm}
51

52
procedure TFormHalfSphere.GLUserShader1DoApply(Sender: TObject; var rci: TGLRenderContextInfo);
53
begin
54
  rci.GLStates.Enable(stCullFace);
55
  rci.GLStates.CullFaceMode := cmBack;
56
end;
57

58
procedure TFormHalfSphere.GLUserShader1DoUnApply(Sender: TObject; Pass: Integer;
59
  var rci: TGLRenderContextInfo; var Continue: Boolean);
60
begin
61
  if Pass > 1 then
62
  begin
63
    Continue := False;
64
    rci.GLStates.FrontFace := fwCounterClockWise;
65
  end
66
  else
67
  begin
68
    rci.GLStates.PolygonMode := pmLines;
69
    rci.GLStates.CullFaceMode := cmFront;
70
    Continue := True;
71
  end;
72
end;
73

74
end.
75