LZScene

1
//
2
// This unit is part of the GLScene Engine https://github.com/glscene
3
//
4
{
5
   A shader that passes control of the DoApply and DoUnApply
6
   methods through published events. This component is 
7
   designed to make it a little easier to implement a 
8
   customized shader. Be sure to keep the shader balanced
9
   by returning the OpenGL state to how you found it.
10

11
    History :  
12
       25/02/07 - DaStr - Moved registration to GLSceneRegister.pas
13
       05/08/03 - SG - Creation
14
}
15
unit GLUserShader;
16

17
interface
18

19
uses
20
  Classes, GLMaterial, GLRenderContextInfo;
21

22
type
23
  TOnDoApplyEvent = procedure (Sender : TObject; var rci : TGLRenderContextInfo) of Object;
24
  TOnDoUnApplyEvent = procedure (Sender : TObject; Pass:Integer; var rci : TGLRenderContextInfo; var Continue : Boolean) of Object;
25
  
26
  TGLUserShader = class(TGLShader)
27
    private
28
      FPass : Integer;
29
      FOnDoApply : TOnDoApplyEvent;
30
      FOnDoUnApply : TOnDoUnApplyEvent;
31
    protected
32
      procedure DoApply(var rci : TGLRenderContextInfo; Sender : TObject); override;
33
      function DoUnApply(var rci : TGLRenderContextInfo) : Boolean; override;
34
    published
35
      property OnDoApply : TOnDoApplyEvent read FOnDoApply write FOnDoApply;
36
      property OnDoUnApply : TOnDoUnApplyEvent read FOnDoUnApply write FOnDoUnApply;
37
      property ShaderStyle;
38
  end;
39

40
// ------------------------------------------------------------------
41
// ------------------------------------------------------------------
42
// ------------------------------------------------------------------
43
implementation
44
// ------------------------------------------------------------------
45
// ------------------------------------------------------------------
46
// ------------------------------------------------------------------
47

48
// ------------------
49
// ------------------ TGLUserShader ------------------
50
// ------------------
51

52
// DoApply
53
//
54
procedure TGLUserShader.DoApply(var rci: TGLRenderContextInfo; Sender : TObject);
55
begin
56
  FPass:=1;
57
  if Assigned(FOnDoApply) and (not (csDesigning in ComponentState)) then
58
    FOnDoApply(Self,rci);
59
end;
60

61
// DoUnApply
62
//
63
function TGLUserShader.DoUnApply(var rci: TGLRenderContextInfo): Boolean;
64
begin
65
  Result:=False;
66
  if Assigned(FOnDoUnApply) and (not (csDesigning in ComponentState)) then begin
67
    FOnDoUnApply(Self,FPass,rci,Result);
68
    Inc(FPass);
69
  end;
70
end;
71

72
end.
73