LZScene

1
//
2
// This unit is part of the GLScene Engine https://github.com/glscene
3
//
4
{
5
   Allows choosing a material in a material library
6
}
7

8
unit FLibMaterialPicker;
9

10
interface
11

12
{$I GLScene.inc}
13

14
uses
15
  lresources, 
16
  LCLIntf,
17
  Controls, 
18
  Classes, 
19
  Forms, 
20
  StdCtrls, 
21
  Buttons, 
22
  Dialogs, 
23
  Graphics,
24
  GLViewer, 
25
  GLMaterial, 
26
  GLScene, 
27
  GLObjects, 
28
  GLTexture,
29
  GLHUDObjects, 
30
  GLTeapot, 
31
  GLGeomObjects, 
32
  GLColor,
33
  GLCoordinates;
34

35
type
36

37
  { TLibMaterialPicker }
38

39
  TLibMaterialPicker = class(TForm)
40
    LBMaterials: TListBox;
41
    Label1: TLabel;
42
    Label2: TLabel;
43
    BBOk: TBitBtn;
44
    BBCancel: TBitBtn;
45
    GLScene1: TGLScene;
46
    SceneViewer: TGLSceneViewer;
47
    CBObject: TComboBox;
48
    Camera: TGLCamera;
49
    Cube: TGLCube;
50
    Sphere: TGLSphere;
51
    LightSource: TGLLightSource;
52
    CBBackground: TComboBox;
53
    BackGroundSprite: TGLHUDSprite;
54
    Cone: TGLCone;
55
    Teapot: TGLTeapot;
56
    World: TGLDummyCube;
57
    Light: TGLDummyCube;
58
    FireSphere: TGLSphere;
59
    GLMaterialLibrary: TGLMaterialLibrary;
60
    procedure LBMaterialsClick(Sender: TObject);
61
    procedure LBMaterialsKeyPress(Sender: TObject; var Key: char);
62
    procedure LBMaterialsDblClick(Sender: TObject);
63
    procedure CBObjectChange(Sender: TObject);
64
    procedure CBBackgroundChange(Sender: TObject);
65
    procedure SceneViewerMouseMove(Sender: TObject; Shift: TShiftState;
66
      X, Y: integer);
67
    procedure SceneViewerMouseDown(Sender: TObject; Button: TMouseButton;
68
      Shift: TShiftState; X, Y: integer);
69
    procedure SceneViewerMouseWheel(Sender: TObject; Shift: TShiftState;
70
      WheelDelta: integer; MousePos: TPoint; var Handled: boolean);
71
  private
72
    function GetMaterial: TGLMaterial;
73
    procedure SetMaterial(const Value: TGLMaterial);
74
    property Material: TGLMaterial read GetMaterial write SetMaterial;
75
    
76
  public
77
    
78
    constructor Create(AOwner: TComponent); override;
79
    function Execute(var materialName: TGLLibMaterialName;
80
      materialLibrary: TGLAbstractMaterialLibrary): boolean;
81

82
  end;
83

84
function LibMaterialPicker: TLibMaterialPicker;
85
procedure ReleaseLibMaterialPicker;
86

87
//====================================================
88
implementation
89
//====================================================
90

91

92
var
93
  vLibMaterialPicker: TLibMaterialPicker;
94

95
function LibMaterialPicker: TLibMaterialPicker;
96
begin
97
  if not Assigned(vLibMaterialPicker) then
98
    vLibMaterialPicker := TLibMaterialPicker.Create(nil);
99
  Result := vLibMaterialPicker;
100
end;
101

102
procedure ReleaseLibMaterialPicker;
103
begin
104
  if Assigned(vLibMaterialPicker) then
105
  begin
106
    vLibMaterialPicker.Free;
107
    vLibMaterialPicker := nil;
108
  end;
109
end;
110

111
// Execute
112

113
function TLibMaterialPicker.Execute(var materialName: TGLLibMaterialName;
114
  materialLibrary: TGLAbstractMaterialLibrary)
115
: boolean;
116
begin
117
  with LBMaterials do
118
  begin
119
    materialLibrary.SetNamesToTStrings(LBMaterials.Items);
120
    ItemIndex := Items.IndexOf(materialName);
121
    if (ItemIndex < 0) and (Items.Count > 0) then
122
      ItemIndex := 0;
123
    BBOk.Enabled := (Items.Count > 0);
124
  end;
125
  LBMaterialsClick(Self);
126
  Result := (ShowModal = mrOk);
127
  if Result then
128
  begin
129
    with LBMaterials do
130
      if ItemIndex >= 0 then
131
        materialName := Items[ItemIndex]
132
      else
133
        materialName := '';
134
  end;
135
end;
136

137
var
138
  MX, MY: integer;
139

140
constructor TLibMaterialPicker.Create(AOwner: TComponent);
141
begin
142
  inherited;
143
   {$IFDEF UNIX}
144
  SceneViewer.Height := 160;
145
  SceneViewer.Top := 64;
146
   {$ENDIF}
147
  BackGroundSprite.Position.X := SceneViewer.Width div 2;
148
  BackGroundSprite.Position.Y := SceneViewer.Height div 2;
149
  BackGroundSprite.Width := SceneViewer.Width;
150
  BackGroundSprite.Height := SceneViewer.Height;
151

152
  CBObject.ItemIndex := 0;
153
  CBObjectChange(Self);
154
  CBBackground.ItemIndex := 0;
155
  CBBackgroundChange(Self);
156
end;
157

158
procedure TLibMaterialPicker.LBMaterialsClick(Sender: TObject);
159
begin
160
  with LBMaterials do
161
    if ItemIndex >= 0 then
162
      Material := TGLLibMaterial(Items.Objects[ItemIndex]).Material;
163
end;
164

165
procedure TLibMaterialPicker.LBMaterialsKeyPress(Sender: TObject; var Key: char);
166
begin
167
  LBMaterialsClick(Sender);
168
end;
169

170
procedure TLibMaterialPicker.LBMaterialsDblClick(Sender: TObject);
171
begin
172
  BBOk.Click;
173
end;
174

175
procedure TLibMaterialPicker.CBObjectChange(Sender: TObject);
176
var
177
  i: integer;
178
begin
179
  i := CBObject.ItemIndex;
180
  Cube.Visible := I = 0;
181
  Sphere.Visible := I = 1;
182
  Cone.Visible := I = 2;
183
  Teapot.Visible := I = 3;
184
end;
185

186
procedure TLibMaterialPicker.CBBackgroundChange(Sender: TObject);
187
var
188
  bgColor: TColor;
189
begin
190
  case CBBackground.ItemIndex of
191
    1: bgColor := clWhite;
192
    2: bgColor := clBlack;
193
    3: bgColor := clBlue;
194
    4: bgColor := clRed;
195
    5: bgColor := clGreen;
196
    else
197
      bgColor := clNone;
198
  end;
199
  with BackGroundSprite.Material do
200
  begin
201
    Texture.Disabled := (bgColor <> clNone);
202
    FrontProperties.Diffuse.Color := ConvertWinColor(bgColor);
203
  end;
204
end;
205

206
procedure TLibMaterialPicker.SceneViewerMouseMove(Sender: TObject;
207
  Shift: TShiftState; X, Y: integer);
208
begin
209
  if (ssRight in Shift) and (ssLeft in Shift) then
210
    Camera.AdjustDistanceToTarget(1 - 0.01 * (MY - Y))
211
  else
212
  if (ssRight in Shift) or (ssLeft in Shift) then
213
    Camera.MoveAroundTarget(Y - MY, X - MX);
214

215
  MX := X;
216
  MY := Y;
217
end;
218

219
procedure TLibMaterialPicker.SceneViewerMouseDown(Sender: TObject;
220
  Button: TMouseButton; Shift: TShiftState; X, Y: integer);
221
begin
222
  MX := X;
223
  MY := Y;
224
end;
225

226
procedure TLibMaterialPicker.SceneViewerMouseWheel(Sender: TObject;
227
  Shift: TShiftState; WheelDelta: integer; MousePos: TPoint; var Handled: boolean);
228
begin
229
  Camera.AdjustDistanceToTarget(1 - 0.1 * (Abs(WheelDelta) / WheelDelta));
230
end;
231

232
function TLibMaterialPicker.GetMaterial: TGLMaterial;
233
begin
234
  Result := GLMaterialLibrary.Materials[0].Material;
235
end;
236

237
procedure TLibMaterialPicker.SetMaterial(const Value: TGLMaterial);
238
begin
239
  GLMaterialLibrary.Materials[0].Material.Assign(Value);
240
end;
241

242
initialization
243

244
  {$I FLibMaterialPicker.lrs}
245

246
finalization
247
  ReleaseLibMaterialPicker;
248

249
end.
250

251