Sign in Join
Wiki copytemporary

BGRABitmap tutorial 9/ru: what changed

Revision 1 to 2. Removed lines have a minus sign; added lines have a plus sign.

OldNewLine
11В этом уроке показано, как использовать затенение по Фонгу (фонгирование) для создания текстур.
22
33### Создаём новый проект
44
55Создайте новый проект и добавьте ссылку на модуль [[BGRABitmap]], так же, как в [[BGRABitmap tutorial 1/ru|первом уроке]].
66
77### Затенение по Фонгу и освещённость
88
99Для использования фонгирования, Вам необходимо создать экземпляр класса TPhongShading. Он находится в модуле BGRAGradients.
1010
1111Давайте добавим переменную в определение формы:
1212
1313``` pascal
1414TForm1 = class(TForm)
1515 ...
1616 phong: TPhongShading;
1717```
1818
1919Теперь в обработчике события создания формы (OnCreate) создадим необходимый класс и укажем параметры:
2020
2121``` pascal
2222procedure TForm1.FormCreate(Sender: TObject);
2323begin
2424 phong := TPhongShading.Create;
2525 phong.LightPositionZ := 150;
2626 phong.SpecularIndex := 20;
2727 phong.AmbientFactor := 0.4;
2828 phong.LightSourceIntensity := 250;
2929 phong.LightSourceDistanceTerm := 200;
3030end;
3131```
3232
3333SpecularIndex "индекс зеркальности" указывает на концентрацию отраженного света.
3434
3535А в обработчике события уничтожения формы (OnDestroy) освободим память, выделенную под класс:
3636
3737``` pascal
3838procedure TForm1.FormDestroy(Sender: TObject);
3939begin
4040 phong.Free;
4141end;
4242```
4343
4444Когда форма будет прорисовываться, добавим некоторый фонгированный объект:
4545
4646``` pascal
4747procedure TForm1.FormPaint(Sender: TObject);
4848var
4949 image: TBGRABitmap;
5050
5151begin
5252 image := TBGRABitmap.Create(ClientWidth,ClientHeight,ColorToBGRA(ColorToRGB(clBtnFace)));
5353
5454 phong.DrawSphere(image,rect(20,20,120,120),50,BGRA(255,0,0));
5555
5656 image.Draw(Canvas,0,0,True);
5757 image.free;
5858end;
5959```
6060
6161Параметры DrawSphere - это: целевое изображение, границы объекта, максимальная высота и цвет. Диаметр сферы равен 100, поэтому максимальная высота полушария равна 50.
6262
6363Наконец, когда мышь перемещается, было бы неплохо, чтобы источник света следовал за курсором:
6464
6565``` pascal
6666procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
6767 Y: Integer);
6868begin
6969 phong.LightPosition := point(X,Y); //координаты источника
7070 FormPaint(Sender); //перепрорисовка формы
7171end;
7272```
7373
7474### Запустим программу
7575
7676Вы должны получить возможность играть со светом на сфере:
7777
78-<figure>
79-<img src="BGRATutorial9a.png" title="BGRATutorial9a.png" />
80-<figcaption>BGRATutorial9a.png</figcaption>
81-</figure>
78+![](/wiki-images/f/fd/BGRATutorial9a.png)
8279
8380### Используем фонгирование для создания текстур
8481
8582Следующая процедура создает кусок шоколада:
8683
8784``` pascal
8885function CreateChocolateTexture(tx,ty: integer): TBGRABitmap;
8986var
9087 square,map: TBGRABitmap;
9188 phong: TPhongShading;
9289 margin: integer;
9390begin
9491 margin := tx div 20; //empty space around the square
9592 square := CreateRectangleMap(tx-2*margin,ty-2*margin,tx div 8);
9693
9794 //создаём карту с квадратом посередине
9895 map := TBGRABitmap.Create(tx,ty,BGRABlack);
9996 map.PutImage(margin,margin,square,dmDrawWithTransparency);
10097
10198 //применим размытие, чтобы сделать его более гладким
10299 BGRAReplace(map,map.FilterBlurRadial(tx div 40,rbFast));
103100 square.free;
104101
105102 //создаём результирующий растровый рисунок
106103 result := TBGRABitmap.Create(tx,ty);
107104
108105 //используем фонгирование
109106 phong := TPhongShading.Create;
110107 phong.LightSourceDistanceFactor := 0;
111108 phong.LightDestFactor := 0;
112109 phong.LightSourceIntensity := 200;
113110 phong.AmbientFactor := 0.5;
114111 phong.LightPosition := Point(-50,-100);
115112 phong.LightPositionZ := 80;
116113
117114 //нарисуем кусок шоколада с максимальной высотой 20
118115 phong.Draw(result,map,20,0,0,BGRA(86,41,38));
119116 map.Free;
120117 phong.Free;
121118end;
122119```
123120
124121Фонгировщик использует карту высот для визуализации световых эффектов. Здесь карта содержит квадрат.
125122
126123Среди свойств фонгировщика есть LightSourceDistanceFactor и LightDestFactor. Приведение этих значений в ноль делает результат неровным. Действительно, когда коэффициент расстояния равен нулю, расстояние между светом и объектом не учитывается, а когда коэффициент назначения света равен нулю, позиция объекта не учитывается при вычислении угла света.
127124
128125Теперь, когда форма создана, создадим текстуру шоколада:
129126
130127``` pascal
131128 chocolate := CreateChocolateTexture(80,80);
132129```
133130
134131А когда форма уничтожается:
135132
136133``` pascal
137134 chocolate.Free;
138135```
139136
140137Перед phong.DrawSphere в OnPaint событии, добавим следующую строку:
141138
142139``` pascal
143140 image.FillRect(0,0,80*7,80*4,chocolate,dmSet);
144141```
145142
146143### Весь код
147144
148145``` pascal
149146unit UMain;
150147
151148{$mode objfpc}{$H+}
152149
153150interface
154151
155152uses
156153 Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
157154 ExtCtrls, Buttons, BGRABitmap, BGRABitmapTypes, BGRAGradients;
158155
159156type
160157 { TForm1 }
161158
162159 TForm1 = class(TForm)
163160 Timer1: TTimer;
164161 procedure FormCreate(Sender: TObject);
165162 procedure FormDestroy(Sender: TObject);
166163 procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
167164 procedure FormPaint(Sender: TObject);
168165 private
169166 { private declarations }
170167 public
171168 { public declarations }
172169 phong: TPhongShading;
173170 chocolate: TBGRABitmap;
174171 end;
175172
176173var
177174 Form1: TForm1;
178175
179176implementation
180177
181178function CreateChocolateTexture(tx,ty: integer): TBGRABitmap;
182179var
183180 square,map: TBGRABitmap;
184181 phong: TPhongShading;
185182 margin: integer;
186183begin
187184 margin := tx div 20;
188185 square := CreateRectangleMap(tx-2*margin,ty-2*margin,tx div 8);
189186 map := TBGRABitmap.Create(tx,ty,BGRABlack);
190187 map.PutImage(margin,margin,square,dmDrawWithTransparency);
191188 BGRAReplace(map,map.FilterBlurRadial(tx div 40,rbFast));
192189 square.free;
193190
194191 result := TBGRABitmap.Create(tx,ty);
195192 phong := TPhongShading.Create;
196193 phong.LightSourceDistanceFactor := 0;
197194 phong.LightDestFactor := 0;
198195 phong.LightSourceIntensity := 200;
199196 phong.AmbientFactor := 0.5;
200197 phong.LightPosition := Point(-50,-100);
201198 phong.LightPositionZ := 80;
202199 phong.Draw(result,map,20,0,0,BGRA(86,41,38));
203200 map.Free;
204201 phong.Free;
205202end;
206203
207204{ TForm1 }
208205
209206procedure TForm1.FormCreate(Sender: TObject);
210207begin
211208 phong := TPhongShading.Create;
212209 phong.LightPositionZ := 150;
213210 phong.SpecularIndex := 20;
214211 phong.AmbientFactor := 0.4;
215212 phong.LightSourceIntensity := 250;
216213 phong.LightSourceDistanceTerm := 200;
217214
218215 chocolate := CreateChocolateTexture(80,80);
219216end;
220217
221218procedure TForm1.FormDestroy(Sender: TObject);
222219begin
223220 phong.Free;
224221 chocolate.Free;
225222end;
226223
227224procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
228225 Y: Integer);
229226begin
230227 phong.LightPosition := point(X,Y);
231228 FormPaint(Sender);
232229end;
233230
234231procedure TForm1.FormPaint(Sender: TObject);
235232var
236233 image: TBGRABitmap;
237234begin
238235 image := TBGRABitmap.Create(ClientWidth,ClientHeight,ColorToBGRA(ColorToRGB(clBtnFace)));
239236
240237 image.FillRect(0,0,80*7,80*4,chocolate,dmSet);
241238 phong.DrawSphere(image,rect(20,20,120,120),50,BGRA(255,0,0));
242239
243240 image.Draw(Canvas,0,0,True);
244241 image.free;
245242end;
246243
247244initialization
248245 {$I UMain.lrs}
249246
250247end.
251248```
252249
253250### Запустим программу
254251
255252Вы должны увидеть хорошую плитку шоколада с большой вишней: ![](/wiki-images/6/6f/BGRATutorial9b.png)
256253
257254### Совместное использование шума Перлина и затенения Фонга
258255
259256Идея состоит в том, чтобы создать карту с шумом Перлина, а затем использовать фонгирование для рендеринга. Вот как создать каменную текстуру:
260257
261258``` pascal
262259function CreateStoneTexture(tx,ty: integer): TBGRABitmap;
263260 var
264261 temp: TBGRABitmap;
265262 phong: TPhongShading;
266263 begin
267264 result := CreateCyclicPerlinNoiseMap(tx,ty,1,1,0.6);
268265 temp:= result.GetPart(rect(-2,-2,tx+2,ty+2)) as TBGRABitmap;
269266
270267 phong := TPhongShading.Create;
271268 phong.LightSourceDistanceFactor := 0;
272269 phong.LightDestFactor := 0;
273270 phong.LightSourceIntensity := 100;
274271 phong.LightPositionZ := 100;
275272 phong.NegativeDiffusionFactor := 0.3;
276273 phong.AmbientFactor := 0.5;
277274 phong.Draw(result,temp,30,-2,-2,BGRA(170,170,170));
278275
279276 phong.Free;
280277 temp.Free;
281278 end;
282279```
283280
284281First, we create a cyclic map. It's important that it be cyclic in order to make a tilable texture. But then, when we will apply phong shading, we need to make the shader aware of the cycle. So, with GetPart, we extract the generated map with 2 more pixels on each border, so the shader can be applied to the map with the cycle.
285282
286283The call to phong.Draw with offset (-2,-2) renders the map at the correct location, taking into account that we've added two pixels.
287284
288285Now in the OnPaint event :
289286
290287``` pascal
291288procedure TForm1.FormPaint(Sender: TObject);
292289var
293290 image: TBGRABitmap;
294291 stone: TBGRABitmap;
295292begin
296293 image := TBGRABitmap.Create(ClientWidth,ClientHeight,ColorToBGRA(ColorToRGB(clBtnFace)));
297294
298295 stone := CreateStoneTexture(100,100);
299296 image.FillEllipseAntialias(200,100,150,50,stone);
300297 stone.free;
301298
302299 image.Draw(Canvas,0,0,True);
303300 image.free;
304301end;
305302```
306303
307304### Run the program
308305
309306You should see a form with a stoned background.
310307
311-<figure>
312-<img src="BGRATutorial9c.png" title="BGRATutorial9c.png" />
313-<figcaption>BGRATutorial9c.png</figcaption>
314-</figure>
308+![](/wiki-images/a/af/BGRATutorial9c.png)
315309
316310### Rendering water
317311
318312It is almost the same procedure to generate water texture :
319313
320314``` pascal
321315function CreateWaterTexture(tx,ty: integer): TBGRABitmap;
322316const blurSize = 5;
323317var
324318 temp: TBGRABitmap;
325319 phong: TPhongShading;
326320begin
327321 result := CreateCyclicPerlinNoiseMap(tx,ty,1,1,1.2);
328322 temp:= result.GetPart(rect(-blurSize,-blurSize,tx+blurSize,ty+blurSize)) as TBGRABitmap;
329323 BGRAReplace(temp,temp.FilterBlurRadial(blurSize,rbFast));
330324
331325 phong := TPhongShading.Create;
332326 phong.LightSourceDistanceFactor := 0;
333327 phong.LightDestFactor := 0;
334328 phong.LightSourceIntensity := 150;
335329 phong.LightPositionZ := 80;
336330 phong.LightColor := BGRA(105,233,240);
337331 phong.NegativeDiffusionFactor := 0.3;
338332 phong.SpecularIndex := 20;
339333 phong.AmbientFactor := 0.4;
340334
341335 phong.Draw(result,temp,20,-blurSize,-blurSize,BGRA(28,139,166));
342336 phong.Free;
343337 temp.Free;
344338end;
345339```
346340
347341The main difference is that we apply a blur filter to make it the water smooth and set the light color.
348342
349-<figure>
350-<img src="BGRATutorial9d.png" title="BGRATutorial9d.png" />
351-<figcaption>BGRATutorial9d.png</figcaption>
352-</figure>
343+![](/wiki-images/f/f1/BGRATutorial9d.png)
353344
354345### Using thresholds to render snow prints
355346
356347It is possible to keep only a small subrange of altitudes, to have a texture that shows foot prints in the snow.
357348
358349``` pascal
359350function CreateSnowPrintTexture(tx,ty: integer): TBGRABitmap;
360351var
361352 v: integer;
362353 p: PBGRAPixel;
363354 i: Integer;
364355
365356 temp: TBGRABitmap;
366357 phong: TPhongShading;
367358begin
368359 //here a random map is generated
369360 result := CreateCyclicPerlinNoiseMap(tx,ty,1,1,1.2);
370361
371362 //now we apply thresholds
372363 p := result.Data;
373364 for i := 0 to result.NbPixels-1 do
374365 begin
375366 v := p^.red;
376367 //if the value is above 80 or under 50, then we divide it by 10 to make it almost horizontal
377368 if v > 80 then v := (v-80) div 10+80;
378369 if v < 50 then v := 50-(50-v) div 10;
379370 p^.red := v;
380371 p^.green := v;
381372 p^.blue := v;
382373 inc(p);
383374 end;
384375
385376 //to make phong shader aware of the cycle
386377 temp:= result.GetPart(rect(-2,-2,tx+2,ty+2)) as TBGRABitmap;
387378 //apply a radial blur
388379 BGRAReplace(temp,temp.FilterBlurRadial(2,rbFast));
389380 phong := TPhongShading.Create;
390381 phong.LightSourceDistanceFactor := 0;
391382 phong.LightDestFactor := 0;
392383 phong.LightSourceIntensity := 100;
393384 phong.LightPositionZ := 100;
394385 phong.NegativeDiffusionFactor := 0.3; //want shadows
395386 phong.Draw(result,temp,30,-2,-2,BGRAWhite);
396387 phong.Free;
397388 temp.Free;
398389end;
399390```
400391
401392We obtain this :
402393
403-<figure>
404-<img src="BGRATutorial9e.png" title="BGRATutorial9e.png" />
405-<figcaption>BGRATutorial9e.png</figcaption>
406-</figure>
394+![](/wiki-images/d/de/BGRATutorial9e.png)
407395
408396[[BGRABitmap tutorial 8|Previous tutorial (textures)]] [[BGRABitmap tutorial 10|Next tutorial (texture mapping)]]
409397
410398---
411399*From the Free Pascal wiki, page "BGRABitmap tutorial 9/ru", as it stood on 2020-02-10 after a change by Trev, out of the wiki's dump of 2024-05-26. Copyright stays with the author who wrote it, according to the old wiki's [[Licensing]] page. If you have concerns about this material, [message the admin](/wiki-contact).*

Back to history