LZScene

1
//
2
// This unit is part of the GLScene Engine https://github.com/glscene
3
//
4
{
5
   Basic editing frame for TGLTexture
6
}
7
{ TODO : Replace STImageClass with a dropdown (polymorphism) }
8

9
unit FRTextureEdit;
10

11
interface
12

13
{$I GLScene.inc}
14

15
uses
16
  lresources, 
17
  SysUtils,
18
  Forms, 
19
  StdCtrls, 
20
  Buttons, 
21
  Controls, 
22
  Classes, 
23
  TypInfo,
24
  GLTexture, 
25
  GLGraphics;
26

27
type
28

29
  TRTextureEdit = class(TFrame)
30
    CBFilteringQuality: TComboBox;
31
    Label2: TLabel;
32
    Label7: TLabel;
33
    SBEditImage: TSpeedButton;
34
    CBMagFilter: TComboBox;
35
    Label3: TLabel;
36
    Label4: TLabel;
37
    CBMinFilter: TComboBox;
38
    CBTextureMode: TComboBox;
39
    Label1: TLabel;
40
    Label5: TLabel;
41
    CBTextureWrap: TComboBox;
42
    CBDisabled: TCheckBox;
43
    CBImageClass: TComboBox;
44
    CBImageAlpha: TComboBox;
45
    Label6: TLabel;
46
    procedure CBFilteringQualityChange(Sender: TObject);
47
    procedure CBMagFilterChange(Sender: TObject);
48
    procedure CBMinFilterChange(Sender: TObject);
49
    procedure CBTextureModeChange(Sender: TObject);
50
    procedure CBTextureWrapChange(Sender: TObject);
51
    procedure CBDisabledClick(Sender: TObject);
52
    procedure SBEditImageClick(Sender: TObject);
53
    procedure CBImageClassChange(Sender: TObject);
54
    procedure CBImageAlphaChange(Sender: TObject);
55
  private
56
    FTexture: TGLTexture;
57
    FOnChange: TNotifyEvent;
58
    changeing: boolean;
59
  protected
60
    procedure SetTexture(const val: TGLTexture);
61
    procedure DoOnChange; dynamic;
62
  public
63
    constructor Create(AOwner: TComponent); override;
64
    destructor Destroy; override;
65
    property Texture: TGLTexture read FTexture write SetTexture;
66
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
67

68
  end;
69

70
//======================================================
71
implementation
72
//======================================================
73

74

75
uses
76
  GLTextureImageEditors, GLTextureFormat;
77

78
constructor TRTextureEdit.Create(AOwner: TComponent);
79
var
80
  I: integer;
81
begin
82
  inherited;
83
  FTexture := TGLTexture.Create(Self);
84
  SetTexture(FTexture);
85
  SetGLTextureImageClassesToStrings(CBImageClass.Items);
86

87
  for i := 0 to integer(High(TGLTextureImageAlpha)) do
88
    CBImageAlpha.Items.Add(GetEnumName(TypeInfo(TGLTextureImageAlpha), i));
89
  for i := 0 to integer(High(TGLMagFilter)) do
90
    CBMagFilter.Items.Add(GetEnumName(TypeInfo(TGLMagFilter), i));
91
  for i := 0 to integer(High(TGLMinFilter)) do
92
    CBMinFilter.Items.Add(GetEnumName(TypeInfo(TGLMinFilter), i));
93
  for i := 0 to Integer(High(TGLTextureFilteringQuality)) do
94
    CBFilteringQuality.Items.Add(GetEnumName(TypeInfo(TGLTextureFilteringQuality), i));
95
  for i := 0 to integer(High(TGLTextureMode)) do
96
    CBTextureMode.Items.Add(GetEnumName(TypeInfo(TGLTextureMode), i));
97
  for i := 0 to integer(High(TGLTextureWrap)) do
98
    CBTextureWrap.Items.Add(GetEnumName(TypeInfo(TGLTextureWrap), i));
99
end;
100

101
// Destroy
102

103
destructor TRTextureEdit.Destroy;
104
begin
105
  FTexture.Free;
106
  inherited;
107
end;
108

109
// SetTexture
110

111
procedure TRTextureEdit.SetTexture(const val: TGLTexture);
112
begin
113
  FTexture.Assign(val);
114
  changeing := True;
115
  try
116
    with CBImageClass do
117
      ItemIndex := Items.IndexOfObject(Pointer(FTexture.Image.ClassType));
118
    CBImageAlpha.ItemIndex := integer(FTexture.ImageAlpha);
119
    CBMagFilter.ItemIndex := integer(FTexture.MagFilter);
120
    CBMinFilter.ItemIndex := integer(FTexture.MinFilter);
121
    CBFilteringQuality.ItemIndex:=Integer(FTexture.FilteringQuality);
122
    CBTextureMode.ItemIndex := integer(FTexture.TextureMode);
123
    CBTextureWrap.ItemIndex := integer(FTexture.TextureWrap);
124
    CBDisabled.Checked := FTexture.Disabled;
125
  finally
126
    changeing := False;
127
    DoOnChange;
128
  end;
129
end;
130

131
// DoOnChange
132

133
procedure TRTextureEdit.DoOnChange;
134
begin
135
  if (not changeing) and Assigned(FOnChange) then
136
    OnChange(Self);
137
end;
138

139
// CBImageClassChange
140

141
procedure TRTextureEdit.CBImageClassChange(Sender: TObject);
142
var
143
  tic: TGLTextureImageClass;
144
  ti: TGLTextureImage;
145
begin
146
  if not changeing then
147
  begin
148
    with CBImageClass do
149
      tic := TGLTextureImageClass(Items.Objects[ItemIndex]);
150
    if FTexture.Image.ClassType <> tic then
151
    begin
152
      ti := TGLTextureImageClass(tic).Create(FTexture);
153
      FTexture.Image := ti;
154
      ti.Free;
155
    end;
156
    DoOnChange;
157
  end;
158
end;
159

160
// CBImageAlphaChange
161

162
procedure TRTextureEdit.CBImageAlphaChange(Sender: TObject);
163
begin
164
  FTexture.ImageAlpha := TGLTextureImageAlpha(CBImageAlpha.ItemIndex);
165
  DoOnChange;
166
end;
167

168
// CBMagFilterChange
169

170
procedure TRTextureEdit.CBMagFilterChange(Sender: TObject);
171
begin
172
  FTexture.MagFilter := TGLMagFilter(CBMagFilter.ItemIndex);
173
  DoOnChange;
174
end;
175

176
procedure TRTextureEdit.CBFilteringQualityChange(Sender: TObject);
177
begin
178
  FTexture.FilteringQuality:=TGLTextureFilteringQuality(CBFilteringQuality.ItemIndex);
179
  DoOnChange;
180
end;
181

182
// CBMinFilterChange
183

184
procedure TRTextureEdit.CBMinFilterChange(Sender: TObject);
185
begin
186
  FTexture.MinFilter := TGLMinFilter(CBMinFilter.ItemIndex);
187
  DoOnChange;
188
end;
189

190
// CBTextureModeChange
191

192
procedure TRTextureEdit.CBTextureModeChange(Sender: TObject);
193
begin
194
  FTexture.TextureMode := TGLTextureMode(CBTextureMode.ItemIndex);
195
  DoOnChange;
196
end;
197

198
// CBTextureWrapChange
199

200
procedure TRTextureEdit.CBTextureWrapChange(Sender: TObject);
201
begin
202
  FTexture.TextureWrap := TGLTextureWrap(CBTextureWrap.ItemIndex);
203
  DoOnChange;
204
end;
205

206
// CBDisabledClick
207

208
procedure TRTextureEdit.CBDisabledClick(Sender: TObject);
209
begin
210
  FTexture.Disabled := CBDisabled.Checked;
211
  DoOnChange;
212
end;
213

214
// SBEditImageClick
215

216
procedure TRTextureEdit.SBEditImageClick(Sender: TObject);
217
begin
218
  EditGLTextureImage(FTexture.Image);
219
  DoOnChange;
220
end;
221

222

223
initialization
224

225
  {$I FRTextureEdit.lrs}
226

227
end.
228

229