ArenaZ

Форк
0
/
Unit1.pas 
145 строк · 3.7 Кб
1
unit Unit1;
2

3
{$MODE Delphi}
4

5
interface
6

7
uses
8
  Windows,
9
  Messages,
10
  SysUtils,
11
  Variants,
12
  Classes,
13
  Graphics,
14
  Controls,
15
  Forms,
16
  Dialogs,
17

18
  GLCadencer, GLTexture,  GLScene, GLVectorGeometry, GLGraphics,
19
  GLKeyboard, GLParticleFX, GLObjects, GLHUDObjects, GLAsyncTimer, GLPerlinPFX,
20
  GLMaterial, GLCoordinates, GLCrossPlatform, GLBaseClasses, GLFireFX,
21
  GLLCLViewer, GLGeomObjects, StdCtrls, ExtCtrls;
22

23
type
24

25
  { TForm1 }
26

27
  TForm1 = class(TForm)
28
    GLScene1: TGLScene;
29
    GLMaterialLibrary1: TGLMaterialLibrary;
30
    cad: TGLCadencer;
31
    pfx1: TGLPointLightPFXManager;
32
    cur: TGLHUDSprite;
33
    dc_cur: TGLDummyCube;
34
    AsyncTimer1: TGLAsyncTimer;
35
    rend: TGLParticleFXRenderer;
36
    dc1: TGLDummyCube;
37
    dc2: TGLDummyCube;
38
    GLPointLightPFXManager2: TGLPointLightPFXManager;
39
    GLPointLightPFXManager3: TGLPointLightPFXManager;
40
    pfx2: TGLCustomSpritePFXManager;
41
    vp: TGLSceneViewer;
42
    dc3: TGLDummyCube;
43
    pfx3: TGLCustomSpritePFXManager;
44
    GLDummyCube3: TGLDummyCube;
45
    GLCone1: TGLCone;
46
    GLDummyCube1: TGLDummyCube;
47
    GLCone2: TGLCone;
48
    GLDummyCube2: TGLDummyCube;
49
    Light1: TGLLightSource;
50
    Panel1: TPanel;
51
    RadioGroup1: TRadioGroup;
52
    RadioGroup2: TRadioGroup;
53
    GLCamera1: TGLCamera;
54
    GLPerlinPFXManager1: TGLPerlinPFXManager;
55
    GLFireFXManager1: TGLFireFXManager;
56
    GLParticleFXRenderer1: TGLParticleFXRenderer;
57
    procedure cadProgress(Sender: TObject; const deltaTime, newTime: Double);
58
    procedure pfx2PrepareTextureImage(Sender: TObject; destBmp32: TGLImage;
59
      var texFormat: Integer);
60
    procedure pfx3PrepareTextureImage(Sender: TObject; destBmp32: TGLImage;
61
      var texFormat: Integer);
62
    procedure AsyncTimer1Timer(Sender: TObject);
63
    procedure FormShow(Sender: TObject);
64
    procedure RadioGroup1Click(Sender: TObject);
65
    procedure RadioGroup2Click(Sender: TObject);
66
  end;
67

68
var
69
  Form1: TForm1;
70

71
implementation
72

73
{$R *.lfm}
74

75

76

77
procedure TForm1.RadioGroup1Click(Sender: TObject);
78
begin
79
  if RadioGroup1.ItemIndex = 0 then
80
    GLFireFXManager1.Disabled := False
81
  else
82
    GLFireFXManager1.Disabled := True;
83
end;
84

85
procedure TForm1.RadioGroup2Click(Sender: TObject);
86
begin
87
  if RadioGroup2.ItemIndex = 0 then
88
    GLPerlinPFXManager1.Renderer.Visible := True
89
  else
90
    GLPerlinPFXManager1.Renderer.Visible := False;
91
end;
92

93
procedure TForm1.cadProgress(Sender: TObject; const deltaTime, newTime: Double);
94
var
95
  m: TPoint;
96
  v: TVector;
97
begin
98
  with mouse.CursorPos do
99
    cur.Position.SetPoint(x - left, y - top, 0);
100
  cur.Rotation := cur.Rotation - deltaTime * 50;
101
  v := cur.AbsolutePosition;
102
  v.y := vp.Height - v.y;
103
  vp.Buffer.ScreenVectorIntersectWithPlaneXY(v, 0, v);
104
  dc_cur.AbsolutePosition := v;
105
  dc1.Visible := iskeydown(vk_lbutton);
106
  dc2.Visible := iskeydown(vk_rbutton);
107
  dc3.Visible := iskeydown(vk_mbutton);
108
  GLDummyCube3.Turn(1.5 * deltaTime * 60);
109
end;
110

111
procedure TForm1.pfx2PrepareTextureImage(Sender: TObject; destBmp32: TGLImage; var texFormat: Integer);
112
var
113
  bmp: TBitmap;
114
begin
115
  bmp := TBitmap.Create;
116
  bmp.LoadFromFile('skull.bmp');
117
  destBmp32.Assign(bmp);
118
end;
119

120
procedure TForm1.pfx3PrepareTextureImage(Sender: TObject; destBmp32: TGLImage; var texFormat: Integer);
121
var
122
  bmp: TBitmap;
123
begin
124
  bmp := TBitmap.Create;
125
  bmp.LoadFromFile('rose.bmp');
126
  destBmp32.Assign(bmp);
127
  bmp.Free;
128
end;
129

130
//
131
// fps
132
//
133
procedure TForm1.AsyncTimer1Timer(Sender: TObject);
134
begin
135
  caption := 'PFX Cursor Demo: ' + vp.FramesPerSecondText(2) +
136
    ' / use the mouse left and right buttons';
137
  vp.ResetPerformanceMonitor;
138
end;
139

140
procedure TForm1.FormShow(Sender: TObject);
141
begin
142
  cad.Enabled := true;
143
end;
144

145
end.
146

Использование cookies

Мы используем файлы cookie в соответствии с Политикой конфиденциальности и Политикой использования cookies.

Нажимая кнопку «Принимаю», Вы даете АО «СберТех» согласие на обработку Ваших персональных данных в целях совершенствования нашего веб-сайта и Сервиса GitVerse, а также повышения удобства их использования.

Запретить использование cookies Вы можете самостоятельно в настройках Вашего браузера.